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 Committer] "" [mc Comments]]
4663 foreach f $info ty $fldtypes {
4664 if {$ty eq ""} continue
4665 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4667 if {$ty eq [mc "Author"]} {
4674 if {$isbold && [info exists iddrawn($id)]} {
4675 if {![ishighlighted $id]} {
4676 bolden $id mainfontbold
4678 bolden_name $id mainfontbold
4681 if {$markingmatches} {
4682 markrowmatches $row $id
4685 set nhighlights($id) $isbold
4688 proc markrowmatches {row id} {
4689 global canv canv2 linehtag linentag commitinfo findloc
4691 set headline [lindex $commitinfo($id) 0]
4692 set author [lindex $commitinfo($id) 1]
4693 $canv delete match$row
4694 $canv2 delete match$row
4695 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4696 set m [findmatches $headline]
4698 markmatches $canv $row $headline $linehtag($id) $m \
4699 [$canv itemcget $linehtag($id) -font] $row
4702 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4703 set m [findmatches $author]
4705 markmatches $canv2 $row $author $linentag($id) $m \
4706 [$canv2 itemcget $linentag($id) -font] $row
4711 proc vrel_change {name ix op} {
4712 global highlight_related
4715 if {$highlight_related ne [mc "None"]} {
4720 # prepare for testing whether commits are descendents or ancestors of a
4721 proc rhighlight_sel {a} {
4722 global descendent desc_todo ancestor anc_todo
4723 global highlight_related
4725 catch {unset descendent}
4726 set desc_todo [list $a]
4727 catch {unset ancestor}
4728 set anc_todo [list $a]
4729 if {$highlight_related ne [mc "None"]} {
4735 proc rhighlight_none {} {
4738 catch {unset rhighlights}
4742 proc is_descendent {a} {
4743 global curview children descendent desc_todo
4746 set la [rowofcommit $a]
4750 for {set i 0} {$i < [llength $todo]} {incr i} {
4751 set do [lindex $todo $i]
4752 if {[rowofcommit $do] < $la} {
4753 lappend leftover $do
4756 foreach nk $children($v,$do) {
4757 if {![info exists descendent($nk)]} {
4758 set descendent($nk) 1
4766 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4770 set descendent($a) 0
4771 set desc_todo $leftover
4774 proc is_ancestor {a} {
4775 global curview parents ancestor anc_todo
4778 set la [rowofcommit $a]
4782 for {set i 0} {$i < [llength $todo]} {incr i} {
4783 set do [lindex $todo $i]
4784 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4785 lappend leftover $do
4788 foreach np $parents($v,$do) {
4789 if {![info exists ancestor($np)]} {
4798 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4803 set anc_todo $leftover
4806 proc askrelhighlight {row id} {
4807 global descendent highlight_related iddrawn rhighlights
4808 global selectedline ancestor
4810 if {$selectedline eq {}} return
4812 if {$highlight_related eq [mc "Descendant"] ||
4813 $highlight_related eq [mc "Not descendant"]} {
4814 if {![info exists descendent($id)]} {
4817 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4820 } elseif {$highlight_related eq [mc "Ancestor"] ||
4821 $highlight_related eq [mc "Not ancestor"]} {
4822 if {![info exists ancestor($id)]} {
4825 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4829 if {[info exists iddrawn($id)]} {
4830 if {$isbold && ![ishighlighted $id]} {
4831 bolden $id mainfontbold
4834 set rhighlights($id) $isbold
4837 # Graph layout functions
4839 proc shortids {ids} {
4842 if {[llength $id] > 1} {
4843 lappend res [shortids $id]
4844 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4845 lappend res [string range $id 0 7]
4856 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4857 if {($n & $mask) != 0} {
4858 set ret [concat $ret $o]
4860 set o [concat $o $o]
4865 proc ordertoken {id} {
4866 global ordertok curview varcid varcstart varctok curview parents children
4867 global nullid nullid2
4869 if {[info exists ordertok($id)]} {
4870 return $ordertok($id)
4875 if {[info exists varcid($curview,$id)]} {
4876 set a $varcid($curview,$id)
4877 set p [lindex $varcstart($curview) $a]
4879 set p [lindex $children($curview,$id) 0]
4881 if {[info exists ordertok($p)]} {
4882 set tok $ordertok($p)
4885 set id [first_real_child $curview,$p]
4888 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4891 if {[llength $parents($curview,$id)] == 1} {
4892 lappend todo [list $p {}]
4894 set j [lsearch -exact $parents($curview,$id) $p]
4896 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4898 lappend todo [list $p [strrep $j]]
4901 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4902 set p [lindex $todo $i 0]
4903 append tok [lindex $todo $i 1]
4904 set ordertok($p) $tok
4906 set ordertok($origid) $tok
4910 # Work out where id should go in idlist so that order-token
4911 # values increase from left to right
4912 proc idcol {idlist id {i 0}} {
4913 set t [ordertoken $id]
4917 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4918 if {$i > [llength $idlist]} {
4919 set i [llength $idlist]
4921 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4924 if {$t > [ordertoken [lindex $idlist $i]]} {
4925 while {[incr i] < [llength $idlist] &&
4926 $t >= [ordertoken [lindex $idlist $i]]} {}
4932 proc initlayout {} {
4933 global rowidlist rowisopt rowfinal displayorder parentlist
4934 global numcommits canvxmax canv
4936 global colormap rowtextx
4945 set canvxmax [$canv cget -width]
4946 catch {unset colormap}
4947 catch {unset rowtextx}
4951 proc setcanvscroll {} {
4952 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4953 global lastscrollset lastscrollrows
4955 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4956 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4957 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4958 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4959 set lastscrollset [clock clicks -milliseconds]
4960 set lastscrollrows $numcommits
4963 proc visiblerows {} {
4964 global canv numcommits linespc
4966 set ymax [lindex [$canv cget -scrollregion] 3]
4967 if {$ymax eq {} || $ymax == 0} return
4969 set y0 [expr {int([lindex $f 0] * $ymax)}]
4970 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4974 set y1 [expr {int([lindex $f 1] * $ymax)}]
4975 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4976 if {$r1 >= $numcommits} {
4977 set r1 [expr {$numcommits - 1}]
4979 return [list $r0 $r1]
4982 proc layoutmore {} {
4983 global commitidx viewcomplete curview
4984 global numcommits pending_select curview
4985 global lastscrollset lastscrollrows
4987 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4988 [clock clicks -milliseconds] - $lastscrollset > 500} {
4991 if {[info exists pending_select] &&
4992 [commitinview $pending_select $curview]} {
4994 selectline [rowofcommit $pending_select] 1
4999 # With path limiting, we mightn't get the actual HEAD commit,
5000 # so ask git rev-list what is the first ancestor of HEAD that
5001 # touches a file in the path limit.
5002 proc get_viewmainhead {view} {
5003 global viewmainheadid vfilelimit viewinstances mainheadid
5006 set rfd [open [concat | git rev-list -1 $mainheadid \
5007 -- $vfilelimit($view)] r]
5008 set j [reg_instance $rfd]
5009 lappend viewinstances($view) $j
5010 fconfigure $rfd -blocking 0
5011 filerun $rfd [list getviewhead $rfd $j $view]
5012 set viewmainheadid($curview) {}
5016 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5017 proc getviewhead {fd inst view} {
5018 global viewmainheadid commfd curview viewinstances showlocalchanges
5021 if {[gets $fd line] < 0} {
5025 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5028 set viewmainheadid($view) $id
5031 set i [lsearch -exact $viewinstances($view) $inst]
5033 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5035 if {$showlocalchanges && $id ne {} && $view == $curview} {
5041 proc doshowlocalchanges {} {
5042 global curview viewmainheadid
5044 if {$viewmainheadid($curview) eq {}} return
5045 if {[commitinview $viewmainheadid($curview) $curview]} {
5048 interestedin $viewmainheadid($curview) dodiffindex
5052 proc dohidelocalchanges {} {
5053 global nullid nullid2 lserial curview
5055 if {[commitinview $nullid $curview]} {
5056 removefakerow $nullid
5058 if {[commitinview $nullid2 $curview]} {
5059 removefakerow $nullid2
5064 # spawn off a process to do git diff-index --cached HEAD
5065 proc dodiffindex {} {
5066 global lserial showlocalchanges vfilelimit curview
5069 if {!$showlocalchanges || !$hasworktree} return
5071 set cmd "|git diff-index --cached HEAD"
5072 if {$vfilelimit($curview) ne {}} {
5073 set cmd [concat $cmd -- $vfilelimit($curview)]
5075 set fd [open $cmd r]
5076 fconfigure $fd -blocking 0
5077 set i [reg_instance $fd]
5078 filerun $fd [list readdiffindex $fd $lserial $i]
5081 proc readdiffindex {fd serial inst} {
5082 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5086 if {[gets $fd line] < 0} {
5092 # we only need to see one line and we don't really care what it says...
5095 if {$serial != $lserial} {
5099 # now see if there are any local changes not checked in to the index
5100 set cmd "|git diff-files"
5101 if {$vfilelimit($curview) ne {}} {
5102 set cmd [concat $cmd -- $vfilelimit($curview)]
5104 set fd [open $cmd r]
5105 fconfigure $fd -blocking 0
5106 set i [reg_instance $fd]
5107 filerun $fd [list readdifffiles $fd $serial $i]
5109 if {$isdiff && ![commitinview $nullid2 $curview]} {
5110 # add the line for the changes in the index to the graph
5111 set hl [mc "Local changes checked in to index but not committed"]
5112 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5113 set commitdata($nullid2) "\n $hl\n"
5114 if {[commitinview $nullid $curview]} {
5115 removefakerow $nullid
5117 insertfakerow $nullid2 $viewmainheadid($curview)
5118 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5119 if {[commitinview $nullid $curview]} {
5120 removefakerow $nullid
5122 removefakerow $nullid2
5127 proc readdifffiles {fd serial inst} {
5128 global viewmainheadid nullid nullid2 curview
5129 global commitinfo commitdata lserial
5132 if {[gets $fd line] < 0} {
5138 # we only need to see one line and we don't really care what it says...
5141 if {$serial != $lserial} {
5145 if {$isdiff && ![commitinview $nullid $curview]} {
5146 # add the line for the local diff to the graph
5147 set hl [mc "Local uncommitted changes, not checked in to index"]
5148 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5149 set commitdata($nullid) "\n $hl\n"
5150 if {[commitinview $nullid2 $curview]} {
5153 set p $viewmainheadid($curview)
5155 insertfakerow $nullid $p
5156 } elseif {!$isdiff && [commitinview $nullid $curview]} {
5157 removefakerow $nullid
5162 proc nextuse {id row} {
5163 global curview children
5165 if {[info exists children($curview,$id)]} {
5166 foreach kid $children($curview,$id) {
5167 if {![commitinview $kid $curview]} {
5170 if {[rowofcommit $kid] > $row} {
5171 return [rowofcommit $kid]
5175 if {[commitinview $id $curview]} {
5176 return [rowofcommit $id]
5181 proc prevuse {id row} {
5182 global curview children
5185 if {[info exists children($curview,$id)]} {
5186 foreach kid $children($curview,$id) {
5187 if {![commitinview $kid $curview]} break
5188 if {[rowofcommit $kid] < $row} {
5189 set ret [rowofcommit $kid]
5196 proc make_idlist {row} {
5197 global displayorder parentlist uparrowlen downarrowlen mingaplen
5198 global commitidx curview children
5200 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5204 set ra [expr {$row - $downarrowlen}]
5208 set rb [expr {$row + $uparrowlen}]
5209 if {$rb > $commitidx($curview)} {
5210 set rb $commitidx($curview)
5212 make_disporder $r [expr {$rb + 1}]
5214 for {} {$r < $ra} {incr r} {
5215 set nextid [lindex $displayorder [expr {$r + 1}]]
5216 foreach p [lindex $parentlist $r] {
5217 if {$p eq $nextid} continue
5218 set rn [nextuse $p $r]
5220 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5221 lappend ids [list [ordertoken $p] $p]
5225 for {} {$r < $row} {incr r} {
5226 set nextid [lindex $displayorder [expr {$r + 1}]]
5227 foreach p [lindex $parentlist $r] {
5228 if {$p eq $nextid} continue
5229 set rn [nextuse $p $r]
5230 if {$rn < 0 || $rn >= $row} {
5231 lappend ids [list [ordertoken $p] $p]
5235 set id [lindex $displayorder $row]
5236 lappend ids [list [ordertoken $id] $id]
5238 foreach p [lindex $parentlist $r] {
5239 set firstkid [lindex $children($curview,$p) 0]
5240 if {[rowofcommit $firstkid] < $row} {
5241 lappend ids [list [ordertoken $p] $p]
5245 set id [lindex $displayorder $r]
5247 set firstkid [lindex $children($curview,$id) 0]
5248 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5249 lappend ids [list [ordertoken $id] $id]
5254 foreach idx [lsort -unique $ids] {
5255 lappend idlist [lindex $idx 1]
5260 proc rowsequal {a b} {
5261 while {[set i [lsearch -exact $a {}]] >= 0} {
5262 set a [lreplace $a $i $i]
5264 while {[set i [lsearch -exact $b {}]] >= 0} {
5265 set b [lreplace $b $i $i]
5267 return [expr {$a eq $b}]
5270 proc makeupline {id row rend col} {
5271 global rowidlist uparrowlen downarrowlen mingaplen
5273 for {set r $rend} {1} {set r $rstart} {
5274 set rstart [prevuse $id $r]
5275 if {$rstart < 0} return
5276 if {$rstart < $row} break
5278 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5279 set rstart [expr {$rend - $uparrowlen - 1}]
5281 for {set r $rstart} {[incr r] <= $row} {} {
5282 set idlist [lindex $rowidlist $r]
5283 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5284 set col [idcol $idlist $id $col]
5285 lset rowidlist $r [linsert $idlist $col $id]
5291 proc layoutrows {row endrow} {
5292 global rowidlist rowisopt rowfinal displayorder
5293 global uparrowlen downarrowlen maxwidth mingaplen
5294 global children parentlist
5295 global commitidx viewcomplete curview
5297 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5300 set rm1 [expr {$row - 1}]
5301 foreach id [lindex $rowidlist $rm1] {
5306 set final [lindex $rowfinal $rm1]
5308 for {} {$row < $endrow} {incr row} {
5309 set rm1 [expr {$row - 1}]
5310 if {$rm1 < 0 || $idlist eq {}} {
5311 set idlist [make_idlist $row]
5314 set id [lindex $displayorder $rm1]
5315 set col [lsearch -exact $idlist $id]
5316 set idlist [lreplace $idlist $col $col]
5317 foreach p [lindex $parentlist $rm1] {
5318 if {[lsearch -exact $idlist $p] < 0} {
5319 set col [idcol $idlist $p $col]
5320 set idlist [linsert $idlist $col $p]
5321 # if not the first child, we have to insert a line going up
5322 if {$id ne [lindex $children($curview,$p) 0]} {
5323 makeupline $p $rm1 $row $col
5327 set id [lindex $displayorder $row]
5328 if {$row > $downarrowlen} {
5329 set termrow [expr {$row - $downarrowlen - 1}]
5330 foreach p [lindex $parentlist $termrow] {
5331 set i [lsearch -exact $idlist $p]
5332 if {$i < 0} continue
5333 set nr [nextuse $p $termrow]
5334 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5335 set idlist [lreplace $idlist $i $i]
5339 set col [lsearch -exact $idlist $id]
5341 set col [idcol $idlist $id]
5342 set idlist [linsert $idlist $col $id]
5343 if {$children($curview,$id) ne {}} {
5344 makeupline $id $rm1 $row $col
5347 set r [expr {$row + $uparrowlen - 1}]
5348 if {$r < $commitidx($curview)} {
5350 foreach p [lindex $parentlist $r] {
5351 if {[lsearch -exact $idlist $p] >= 0} continue
5352 set fk [lindex $children($curview,$p) 0]
5353 if {[rowofcommit $fk] < $row} {
5354 set x [idcol $idlist $p $x]
5355 set idlist [linsert $idlist $x $p]
5358 if {[incr r] < $commitidx($curview)} {
5359 set p [lindex $displayorder $r]
5360 if {[lsearch -exact $idlist $p] < 0} {
5361 set fk [lindex $children($curview,$p) 0]
5362 if {$fk ne {} && [rowofcommit $fk] < $row} {
5363 set x [idcol $idlist $p $x]
5364 set idlist [linsert $idlist $x $p]
5370 if {$final && !$viewcomplete($curview) &&
5371 $row + $uparrowlen + $mingaplen + $downarrowlen
5372 >= $commitidx($curview)} {
5375 set l [llength $rowidlist]
5377 lappend rowidlist $idlist
5379 lappend rowfinal $final
5380 } elseif {$row < $l} {
5381 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5382 lset rowidlist $row $idlist
5385 lset rowfinal $row $final
5387 set pad [ntimes [expr {$row - $l}] {}]
5388 set rowidlist [concat $rowidlist $pad]
5389 lappend rowidlist $idlist
5390 set rowfinal [concat $rowfinal $pad]
5391 lappend rowfinal $final
5392 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5398 proc changedrow {row} {
5399 global displayorder iddrawn rowisopt need_redisplay
5401 set l [llength $rowisopt]
5403 lset rowisopt $row 0
5404 if {$row + 1 < $l} {
5405 lset rowisopt [expr {$row + 1}] 0
5406 if {$row + 2 < $l} {
5407 lset rowisopt [expr {$row + 2}] 0
5411 set id [lindex $displayorder $row]
5412 if {[info exists iddrawn($id)]} {
5413 set need_redisplay 1
5417 proc insert_pad {row col npad} {
5420 set pad [ntimes $npad {}]
5421 set idlist [lindex $rowidlist $row]
5422 set bef [lrange $idlist 0 [expr {$col - 1}]]
5423 set aft [lrange $idlist $col end]
5424 set i [lsearch -exact $aft {}]
5426 set aft [lreplace $aft $i $i]
5428 lset rowidlist $row [concat $bef $pad $aft]
5432 proc optimize_rows {row col endrow} {
5433 global rowidlist rowisopt displayorder curview children
5438 for {} {$row < $endrow} {incr row; set col 0} {
5439 if {[lindex $rowisopt $row]} continue
5441 set y0 [expr {$row - 1}]
5442 set ym [expr {$row - 2}]
5443 set idlist [lindex $rowidlist $row]
5444 set previdlist [lindex $rowidlist $y0]
5445 if {$idlist eq {} || $previdlist eq {}} continue
5447 set pprevidlist [lindex $rowidlist $ym]
5448 if {$pprevidlist eq {}} continue
5454 for {} {$col < [llength $idlist]} {incr col} {
5455 set id [lindex $idlist $col]
5456 if {[lindex $previdlist $col] eq $id} continue
5461 set x0 [lsearch -exact $previdlist $id]
5462 if {$x0 < 0} continue
5463 set z [expr {$x0 - $col}]
5467 set xm [lsearch -exact $pprevidlist $id]
5469 set z0 [expr {$xm - $x0}]
5473 # if row y0 is the first child of $id then it's not an arrow
5474 if {[lindex $children($curview,$id) 0] ne
5475 [lindex $displayorder $y0]} {
5479 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5480 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5483 # Looking at lines from this row to the previous row,
5484 # make them go straight up if they end in an arrow on
5485 # the previous row; otherwise make them go straight up
5487 if {$z < -1 || ($z < 0 && $isarrow)} {
5488 # Line currently goes left too much;
5489 # insert pads in the previous row, then optimize it
5490 set npad [expr {-1 - $z + $isarrow}]
5491 insert_pad $y0 $x0 $npad
5493 optimize_rows $y0 $x0 $row
5495 set previdlist [lindex $rowidlist $y0]
5496 set x0 [lsearch -exact $previdlist $id]
5497 set z [expr {$x0 - $col}]
5499 set pprevidlist [lindex $rowidlist $ym]
5500 set xm [lsearch -exact $pprevidlist $id]
5501 set z0 [expr {$xm - $x0}]
5503 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5504 # Line currently goes right too much;
5505 # insert pads in this line
5506 set npad [expr {$z - 1 + $isarrow}]
5507 insert_pad $row $col $npad
5508 set idlist [lindex $rowidlist $row]
5510 set z [expr {$x0 - $col}]
5513 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5514 # this line links to its first child on row $row-2
5515 set id [lindex $displayorder $ym]
5516 set xc [lsearch -exact $pprevidlist $id]
5518 set z0 [expr {$xc - $x0}]
5521 # avoid lines jigging left then immediately right
5522 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5523 insert_pad $y0 $x0 1
5525 optimize_rows $y0 $x0 $row
5526 set previdlist [lindex $rowidlist $y0]
5530 # Find the first column that doesn't have a line going right
5531 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5532 set id [lindex $idlist $col]
5533 if {$id eq {}} break
5534 set x0 [lsearch -exact $previdlist $id]
5536 # check if this is the link to the first child
5537 set kid [lindex $displayorder $y0]
5538 if {[lindex $children($curview,$id) 0] eq $kid} {
5539 # it is, work out offset to child
5540 set x0 [lsearch -exact $previdlist $kid]
5543 if {$x0 <= $col} break
5545 # Insert a pad at that column as long as it has a line and
5546 # isn't the last column
5547 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5548 set idlist [linsert $idlist $col {}]
5549 lset rowidlist $row $idlist
5557 global canvx0 linespc
5558 return [expr {$canvx0 + $col * $linespc}]
5562 global canvy0 linespc
5563 return [expr {$canvy0 + $row * $linespc}]
5566 proc linewidth {id} {
5567 global thickerline lthickness
5570 if {[info exists thickerline] && $id eq $thickerline} {
5571 set wid [expr {2 * $lthickness}]
5576 proc rowranges {id} {
5577 global curview children uparrowlen downarrowlen
5580 set kids $children($curview,$id)
5586 foreach child $kids {
5587 if {![commitinview $child $curview]} break
5588 set row [rowofcommit $child]
5589 if {![info exists prev]} {
5590 lappend ret [expr {$row + 1}]
5592 if {$row <= $prevrow} {
5593 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5595 # see if the line extends the whole way from prevrow to row
5596 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5597 [lsearch -exact [lindex $rowidlist \
5598 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5599 # it doesn't, see where it ends
5600 set r [expr {$prevrow + $downarrowlen}]
5601 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5602 while {[incr r -1] > $prevrow &&
5603 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5605 while {[incr r] <= $row &&
5606 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5610 # see where it starts up again
5611 set r [expr {$row - $uparrowlen}]
5612 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5613 while {[incr r] < $row &&
5614 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5616 while {[incr r -1] >= $prevrow &&
5617 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5623 if {$child eq $id} {
5632 proc drawlineseg {id row endrow arrowlow} {
5633 global rowidlist displayorder iddrawn linesegs
5634 global canv colormap linespc curview maxlinelen parentlist
5636 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5637 set le [expr {$row + 1}]
5640 set c [lsearch -exact [lindex $rowidlist $le] $id]
5646 set x [lindex $displayorder $le]
5651 if {[info exists iddrawn($x)] || $le == $endrow} {
5652 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5668 if {[info exists linesegs($id)]} {
5669 set lines $linesegs($id)
5671 set r0 [lindex $li 0]
5673 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5683 set li [lindex $lines [expr {$i-1}]]
5684 set r1 [lindex $li 1]
5685 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5690 set x [lindex $cols [expr {$le - $row}]]
5691 set xp [lindex $cols [expr {$le - 1 - $row}]]
5692 set dir [expr {$xp - $x}]
5694 set ith [lindex $lines $i 2]
5695 set coords [$canv coords $ith]
5696 set ah [$canv itemcget $ith -arrow]
5697 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5698 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5699 if {$x2 ne {} && $x - $x2 == $dir} {
5700 set coords [lrange $coords 0 end-2]
5703 set coords [list [xc $le $x] [yc $le]]
5706 set itl [lindex $lines [expr {$i-1}] 2]
5707 set al [$canv itemcget $itl -arrow]
5708 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5709 } elseif {$arrowlow} {
5710 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5711 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5715 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5716 for {set y $le} {[incr y -1] > $row} {} {
5718 set xp [lindex $cols [expr {$y - 1 - $row}]]
5719 set ndir [expr {$xp - $x}]
5720 if {$dir != $ndir || $xp < 0} {
5721 lappend coords [xc $y $x] [yc $y]
5727 # join parent line to first child
5728 set ch [lindex $displayorder $row]
5729 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5731 puts "oops: drawlineseg: child $ch not on row $row"
5732 } elseif {$xc != $x} {
5733 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5734 set d [expr {int(0.5 * $linespc)}]
5737 set x2 [expr {$x1 - $d}]
5739 set x2 [expr {$x1 + $d}]
5742 set y1 [expr {$y2 + $d}]
5743 lappend coords $x1 $y1 $x2 $y2
5744 } elseif {$xc < $x - 1} {
5745 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5746 } elseif {$xc > $x + 1} {
5747 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5751 lappend coords [xc $row $x] [yc $row]
5753 set xn [xc $row $xp]
5755 lappend coords $xn $yn
5759 set t [$canv create line $coords -width [linewidth $id] \
5760 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5763 set lines [linsert $lines $i [list $row $le $t]]
5765 $canv coords $ith $coords
5766 if {$arrow ne $ah} {
5767 $canv itemconf $ith -arrow $arrow
5769 lset lines $i 0 $row
5772 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5773 set ndir [expr {$xo - $xp}]
5774 set clow [$canv coords $itl]
5775 if {$dir == $ndir} {
5776 set clow [lrange $clow 2 end]
5778 set coords [concat $coords $clow]
5780 lset lines [expr {$i-1}] 1 $le
5782 # coalesce two pieces
5784 set b [lindex $lines [expr {$i-1}] 0]
5785 set e [lindex $lines $i 1]
5786 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5788 $canv coords $itl $coords
5789 if {$arrow ne $al} {
5790 $canv itemconf $itl -arrow $arrow
5794 set linesegs($id) $lines
5798 proc drawparentlinks {id row} {
5799 global rowidlist canv colormap curview parentlist
5800 global idpos linespc
5802 set rowids [lindex $rowidlist $row]
5803 set col [lsearch -exact $rowids $id]
5804 if {$col < 0} return
5805 set olds [lindex $parentlist $row]
5806 set row2 [expr {$row + 1}]
5807 set x [xc $row $col]
5810 set d [expr {int(0.5 * $linespc)}]
5811 set ymid [expr {$y + $d}]
5812 set ids [lindex $rowidlist $row2]
5813 # rmx = right-most X coord used
5816 set i [lsearch -exact $ids $p]
5818 puts "oops, parent $p of $id not in list"
5821 set x2 [xc $row2 $i]
5825 set j [lsearch -exact $rowids $p]
5827 # drawlineseg will do this one for us
5831 # should handle duplicated parents here...
5832 set coords [list $x $y]
5834 # if attaching to a vertical segment, draw a smaller
5835 # slant for visual distinctness
5838 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5840 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5842 } elseif {$i < $col && $i < $j} {
5843 # segment slants towards us already
5844 lappend coords [xc $row $j] $y
5846 if {$i < $col - 1} {
5847 lappend coords [expr {$x2 + $linespc}] $y
5848 } elseif {$i > $col + 1} {
5849 lappend coords [expr {$x2 - $linespc}] $y
5851 lappend coords $x2 $y2
5854 lappend coords $x2 $y2
5856 set t [$canv create line $coords -width [linewidth $p] \
5857 -fill $colormap($p) -tags lines.$p]
5861 if {$rmx > [lindex $idpos($id) 1]} {
5862 lset idpos($id) 1 $rmx
5867 proc drawlines {id} {
5870 $canv itemconf lines.$id -width [linewidth $id]
5873 proc drawcmittext {id row col} {
5874 global linespc canv canv2 canv3 fgcolor curview
5875 global cmitlisted commitinfo rowidlist parentlist
5876 global rowtextx idpos idtags idheads idotherrefs
5877 global linehtag linentag linedtag selectedline
5878 global canvxmax boldids boldnameids fgcolor markedid
5879 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5881 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5882 set listed $cmitlisted($curview,$id)
5883 if {$id eq $nullid} {
5885 } elseif {$id eq $nullid2} {
5887 } elseif {$id eq $mainheadid} {
5890 set ofill [lindex $circlecolors $listed]
5892 set x [xc $row $col]
5894 set orad [expr {$linespc / 3}]
5896 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5897 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5898 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5899 } elseif {$listed == 3} {
5900 # triangle pointing left for left-side commits
5901 set t [$canv create polygon \
5902 [expr {$x - $orad}] $y \
5903 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5904 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5905 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5907 # triangle pointing right for right-side commits
5908 set t [$canv create polygon \
5909 [expr {$x + $orad - 1}] $y \
5910 [expr {$x - $orad}] [expr {$y - $orad}] \
5911 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5912 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5914 set circleitem($row) $t
5916 $canv bind $t <1> {selcanvline {} %x %y}
5917 set rmx [llength [lindex $rowidlist $row]]
5918 set olds [lindex $parentlist $row]
5920 set nextids [lindex $rowidlist [expr {$row + 1}]]
5922 set i [lsearch -exact $nextids $p]
5928 set xt [xc $row $rmx]
5929 set rowtextx($row) $xt
5930 set idpos($id) [list $x $xt $y]
5931 if {[info exists idtags($id)] || [info exists idheads($id)]
5932 || [info exists idotherrefs($id)]} {
5933 set xt [drawtags $id $x $xt $y]
5935 if {[lindex $commitinfo($id) 6] > 0} {
5936 set xt [drawnotesign $xt $y]
5938 set headline [lindex $commitinfo($id) 0]
5939 set name [lindex $commitinfo($id) 1]
5940 set date [lindex $commitinfo($id) 2]
5941 set date [formatdate $date]
5944 set isbold [ishighlighted $id]
5947 set font mainfontbold
5949 lappend boldnameids $id
5950 set nfont mainfontbold
5953 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5954 -text $headline -font $font -tags text]
5955 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5956 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5957 -text $name -font $nfont -tags text]
5958 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5959 -text $date -font mainfont -tags text]
5960 if {$selectedline == $row} {
5963 if {[info exists markedid] && $markedid eq $id} {
5966 set xr [expr {$xt + [font measure $font $headline]}]
5967 if {$xr > $canvxmax} {
5973 proc drawcmitrow {row} {
5974 global displayorder rowidlist nrows_drawn
5975 global iddrawn markingmatches
5976 global commitinfo numcommits
5977 global filehighlight fhighlights findpattern nhighlights
5978 global hlview vhighlights
5979 global highlight_related rhighlights
5981 if {$row >= $numcommits} return
5983 set id [lindex $displayorder $row]
5984 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5985 askvhighlight $row $id
5987 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5988 askfilehighlight $row $id
5990 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5991 askfindhighlight $row $id
5993 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5994 askrelhighlight $row $id
5996 if {![info exists iddrawn($id)]} {
5997 set col [lsearch -exact [lindex $rowidlist $row] $id]
5999 puts "oops, row $row id $id not in list"
6002 if {![info exists commitinfo($id)]} {
6006 drawcmittext $id $row $col
6010 if {$markingmatches} {
6011 markrowmatches $row $id
6015 proc drawcommits {row {endrow {}}} {
6016 global numcommits iddrawn displayorder curview need_redisplay
6017 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6022 if {$endrow eq {}} {
6025 if {$endrow >= $numcommits} {
6026 set endrow [expr {$numcommits - 1}]
6029 set rl1 [expr {$row - $downarrowlen - 3}]
6033 set ro1 [expr {$row - 3}]
6037 set r2 [expr {$endrow + $uparrowlen + 3}]
6038 if {$r2 > $numcommits} {
6041 for {set r $rl1} {$r < $r2} {incr r} {
6042 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6046 set rl1 [expr {$r + 1}]
6052 optimize_rows $ro1 0 $r2
6053 if {$need_redisplay || $nrows_drawn > 2000} {
6057 # make the lines join to already-drawn rows either side
6058 set r [expr {$row - 1}]
6059 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6062 set er [expr {$endrow + 1}]
6063 if {$er >= $numcommits ||
6064 ![info exists iddrawn([lindex $displayorder $er])]} {
6067 for {} {$r <= $er} {incr r} {
6068 set id [lindex $displayorder $r]
6069 set wasdrawn [info exists iddrawn($id)]
6071 if {$r == $er} break
6072 set nextid [lindex $displayorder [expr {$r + 1}]]
6073 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6074 drawparentlinks $id $r
6076 set rowids [lindex $rowidlist $r]
6077 foreach lid $rowids {
6078 if {$lid eq {}} continue
6079 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6081 # see if this is the first child of any of its parents
6082 foreach p [lindex $parentlist $r] {
6083 if {[lsearch -exact $rowids $p] < 0} {
6084 # make this line extend up to the child
6085 set lineend($p) [drawlineseg $p $r $er 0]
6089 set lineend($lid) [drawlineseg $lid $r $er 1]
6095 proc undolayout {row} {
6096 global uparrowlen mingaplen downarrowlen
6097 global rowidlist rowisopt rowfinal need_redisplay
6099 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6103 if {[llength $rowidlist] > $r} {
6105 set rowidlist [lrange $rowidlist 0 $r]
6106 set rowfinal [lrange $rowfinal 0 $r]
6107 set rowisopt [lrange $rowisopt 0 $r]
6108 set need_redisplay 1
6113 proc drawvisible {} {
6114 global canv linespc curview vrowmod selectedline targetrow targetid
6115 global need_redisplay cscroll numcommits
6117 set fs [$canv yview]
6118 set ymax [lindex [$canv cget -scrollregion] 3]
6119 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6120 set f0 [lindex $fs 0]
6121 set f1 [lindex $fs 1]
6122 set y0 [expr {int($f0 * $ymax)}]
6123 set y1 [expr {int($f1 * $ymax)}]
6125 if {[info exists targetid]} {
6126 if {[commitinview $targetid $curview]} {
6127 set r [rowofcommit $targetid]
6128 if {$r != $targetrow} {
6129 # Fix up the scrollregion and change the scrolling position
6130 # now that our target row has moved.
6131 set diff [expr {($r - $targetrow) * $linespc}]
6134 set ymax [lindex [$canv cget -scrollregion] 3]
6137 set f0 [expr {$y0 / $ymax}]
6138 set f1 [expr {$y1 / $ymax}]
6139 allcanvs yview moveto $f0
6140 $cscroll set $f0 $f1
6141 set need_redisplay 1
6148 set row [expr {int(($y0 - 3) / $linespc) - 1}]
6149 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6150 if {$endrow >= $vrowmod($curview)} {
6151 update_arcrows $curview
6153 if {$selectedline ne {} &&
6154 $row <= $selectedline && $selectedline <= $endrow} {
6155 set targetrow $selectedline
6156 } elseif {[info exists targetid]} {
6157 set targetrow [expr {int(($row + $endrow) / 2)}]
6159 if {[info exists targetrow]} {
6160 if {$targetrow >= $numcommits} {
6161 set targetrow [expr {$numcommits - 1}]
6163 set targetid [commitonrow $targetrow]
6165 drawcommits $row $endrow
6168 proc clear_display {} {
6169 global iddrawn linesegs need_redisplay nrows_drawn
6170 global vhighlights fhighlights nhighlights rhighlights
6171 global linehtag linentag linedtag boldids boldnameids
6174 catch {unset iddrawn}
6175 catch {unset linesegs}
6176 catch {unset linehtag}
6177 catch {unset linentag}
6178 catch {unset linedtag}
6181 catch {unset vhighlights}
6182 catch {unset fhighlights}
6183 catch {unset nhighlights}
6184 catch {unset rhighlights}
6185 set need_redisplay 0
6189 proc findcrossings {id} {
6190 global rowidlist parentlist numcommits displayorder
6194 foreach {s e} [rowranges $id] {
6195 if {$e >= $numcommits} {
6196 set e [expr {$numcommits - 1}]
6198 if {$e <= $s} continue
6199 for {set row $e} {[incr row -1] >= $s} {} {
6200 set x [lsearch -exact [lindex $rowidlist $row] $id]
6202 set olds [lindex $parentlist $row]
6203 set kid [lindex $displayorder $row]
6204 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6205 if {$kidx < 0} continue
6206 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6208 set px [lsearch -exact $nextrow $p]
6209 if {$px < 0} continue
6210 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6211 if {[lsearch -exact $ccross $p] >= 0} continue
6212 if {$x == $px + ($kidx < $px? -1: 1)} {
6214 } elseif {[lsearch -exact $cross $p] < 0} {
6221 return [concat $ccross {{}} $cross]
6224 proc assigncolor {id} {
6225 global colormap colors nextcolor
6226 global parents children children curview
6228 if {[info exists colormap($id)]} return
6229 set ncolors [llength $colors]
6230 if {[info exists children($curview,$id)]} {
6231 set kids $children($curview,$id)
6235 if {[llength $kids] == 1} {
6236 set child [lindex $kids 0]
6237 if {[info exists colormap($child)]
6238 && [llength $parents($curview,$child)] == 1} {
6239 set colormap($id) $colormap($child)
6245 foreach x [findcrossings $id] {
6247 # delimiter between corner crossings and other crossings
6248 if {[llength $badcolors] >= $ncolors - 1} break
6249 set origbad $badcolors
6251 if {[info exists colormap($x)]
6252 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6253 lappend badcolors $colormap($x)
6256 if {[llength $badcolors] >= $ncolors} {
6257 set badcolors $origbad
6259 set origbad $badcolors
6260 if {[llength $badcolors] < $ncolors - 1} {
6261 foreach child $kids {
6262 if {[info exists colormap($child)]
6263 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6264 lappend badcolors $colormap($child)
6266 foreach p $parents($curview,$child) {
6267 if {[info exists colormap($p)]
6268 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6269 lappend badcolors $colormap($p)
6273 if {[llength $badcolors] >= $ncolors} {
6274 set badcolors $origbad
6277 for {set i 0} {$i <= $ncolors} {incr i} {
6278 set c [lindex $colors $nextcolor]
6279 if {[incr nextcolor] >= $ncolors} {
6282 if {[lsearch -exact $badcolors $c]} break
6284 set colormap($id) $c
6287 proc bindline {t id} {
6290 $canv bind $t <Enter> "lineenter %x %y $id"
6291 $canv bind $t <Motion> "linemotion %x %y $id"
6292 $canv bind $t <Leave> "lineleave $id"
6293 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6296 proc drawtags {id x xt y1} {
6297 global idtags idheads idotherrefs mainhead
6298 global linespc lthickness
6299 global canv rowtextx curview fgcolor bgcolor ctxbut
6304 if {[info exists idtags($id)]} {
6305 set marks $idtags($id)
6306 set ntags [llength $marks]
6308 if {[info exists idheads($id)]} {
6309 set marks [concat $marks $idheads($id)]
6310 set nheads [llength $idheads($id)]
6312 if {[info exists idotherrefs($id)]} {
6313 set marks [concat $marks $idotherrefs($id)]
6319 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6320 set yt [expr {$y1 - 0.5 * $linespc}]
6321 set yb [expr {$yt + $linespc - 1}]
6325 foreach tag $marks {
6327 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6328 set wid [font measure mainfontbold $tag]
6330 set wid [font measure mainfont $tag]
6334 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6336 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6337 -width $lthickness -fill black -tags tag.$id]
6339 foreach tag $marks x $xvals wid $wvals {
6340 set tag_quoted [string map {% %%} $tag]
6341 set xl [expr {$x + $delta}]
6342 set xr [expr {$x + $delta + $wid + $lthickness}]
6344 if {[incr ntags -1] >= 0} {
6346 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6347 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6348 -width 1 -outline black -fill yellow -tags tag.$id]
6349 $canv bind $t <1> [list showtag $tag_quoted 1]
6350 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6352 # draw a head or other ref
6353 if {[incr nheads -1] >= 0} {
6355 if {$tag eq $mainhead} {
6356 set font mainfontbold
6361 set xl [expr {$xl - $delta/2}]
6362 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6363 -width 1 -outline black -fill $col -tags tag.$id
6364 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6365 set rwid [font measure mainfont $remoteprefix]
6366 set xi [expr {$x + 1}]
6367 set yti [expr {$yt + 1}]
6368 set xri [expr {$x + $rwid}]
6369 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6370 -width 0 -fill "#ffddaa" -tags tag.$id
6373 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6374 -font $font -tags [list tag.$id text]]
6376 $canv bind $t <1> [list showtag $tag_quoted 1]
6377 } elseif {$nheads >= 0} {
6378 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6384 proc drawnotesign {xt y} {
6385 global linespc canv fgcolor
6387 set orad [expr {$linespc / 3}]
6388 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6389 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6390 -fill yellow -outline $fgcolor -width 1 -tags circle]
6391 set xt [expr {$xt + $orad * 3}]
6395 proc xcoord {i level ln} {
6396 global canvx0 xspc1 xspc2
6398 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6399 if {$i > 0 && $i == $level} {
6400 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6401 } elseif {$i > $level} {
6402 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6407 proc show_status {msg} {
6411 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6412 -tags text -fill $fgcolor
6415 # Don't change the text pane cursor if it is currently the hand cursor,
6416 # showing that we are over a sha1 ID link.
6417 proc settextcursor {c} {
6418 global ctext curtextcursor
6420 if {[$ctext cget -cursor] == $curtextcursor} {
6421 $ctext config -cursor $c
6423 set curtextcursor $c
6426 proc nowbusy {what {name {}}} {
6427 global isbusy busyname statusw
6429 if {[array names isbusy] eq {}} {
6430 . config -cursor watch
6434 set busyname($what) $name
6436 $statusw conf -text $name
6440 proc notbusy {what} {
6441 global isbusy maincursor textcursor busyname statusw
6445 if {$busyname($what) ne {} &&
6446 [$statusw cget -text] eq $busyname($what)} {
6447 $statusw conf -text {}
6450 if {[array names isbusy] eq {}} {
6451 . config -cursor $maincursor
6452 settextcursor $textcursor
6456 proc findmatches {f} {
6457 global findtype findstring
6458 if {$findtype == [mc "Regexp"]} {
6459 set matches [regexp -indices -all -inline $findstring $f]
6462 if {$findtype == [mc "IgnCase"]} {
6463 set f [string tolower $f]
6464 set fs [string tolower $fs]
6468 set l [string length $fs]
6469 while {[set j [string first $fs $f $i]] >= 0} {
6470 lappend matches [list $j [expr {$j+$l-1}]]
6471 set i [expr {$j + $l}]
6477 proc dofind {{dirn 1} {wrap 1}} {
6478 global findstring findstartline findcurline selectedline numcommits
6479 global gdttype filehighlight fh_serial find_dirn findallowwrap
6481 if {[info exists find_dirn]} {
6482 if {$find_dirn == $dirn} return
6486 if {$findstring eq {} || $numcommits == 0} return
6487 if {$selectedline eq {}} {
6488 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6490 set findstartline $selectedline
6492 set findcurline $findstartline
6493 nowbusy finding [mc "Searching"]
6494 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6495 after cancel do_file_hl $fh_serial
6496 do_file_hl $fh_serial
6499 set findallowwrap $wrap
6503 proc stopfinding {} {
6504 global find_dirn findcurline fprogcoord
6506 if {[info exists find_dirn]} {
6517 global commitdata commitinfo numcommits findpattern findloc
6518 global findstartline findcurline findallowwrap
6519 global find_dirn gdttype fhighlights fprogcoord
6520 global curview varcorder vrownum varccommits vrowmod
6522 if {![info exists find_dirn]} {
6525 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6528 if {$find_dirn > 0} {
6530 if {$l >= $numcommits} {
6533 if {$l <= $findstartline} {
6534 set lim [expr {$findstartline + 1}]
6537 set moretodo $findallowwrap
6544 if {$l >= $findstartline} {
6545 set lim [expr {$findstartline - 1}]
6548 set moretodo $findallowwrap
6551 set n [expr {($lim - $l) * $find_dirn}]
6556 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6557 update_arcrows $curview
6561 set ai [bsearch $vrownum($curview) $l]
6562 set a [lindex $varcorder($curview) $ai]
6563 set arow [lindex $vrownum($curview) $ai]
6564 set ids [lindex $varccommits($curview,$a)]
6565 set arowend [expr {$arow + [llength $ids]}]
6566 if {$gdttype eq [mc "containing:"]} {
6567 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6568 if {$l < $arow || $l >= $arowend} {
6570 set a [lindex $varcorder($curview) $ai]
6571 set arow [lindex $vrownum($curview) $ai]
6572 set ids [lindex $varccommits($curview,$a)]
6573 set arowend [expr {$arow + [llength $ids]}]
6575 set id [lindex $ids [expr {$l - $arow}]]
6576 # shouldn't happen unless git log doesn't give all the commits...
6577 if {![info exists commitdata($id)] ||
6578 ![doesmatch $commitdata($id)]} {
6581 if {![info exists commitinfo($id)]} {
6584 set info $commitinfo($id)
6585 foreach f $info ty $fldtypes {
6586 if {$ty eq ""} continue
6587 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6596 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6597 if {$l < $arow || $l >= $arowend} {
6599 set a [lindex $varcorder($curview) $ai]
6600 set arow [lindex $vrownum($curview) $ai]
6601 set ids [lindex $varccommits($curview,$a)]
6602 set arowend [expr {$arow + [llength $ids]}]
6604 set id [lindex $ids [expr {$l - $arow}]]
6605 if {![info exists fhighlights($id)]} {
6606 # this sets fhighlights($id) to -1
6607 askfilehighlight $l $id
6609 if {$fhighlights($id) > 0} {
6613 if {$fhighlights($id) < 0} {
6616 set findcurline [expr {$l - $find_dirn}]
6621 if {$found || ($domore && !$moretodo)} {
6637 set findcurline [expr {$l - $find_dirn}]
6639 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6643 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6648 proc findselectline {l} {
6649 global findloc commentend ctext findcurline markingmatches gdttype
6651 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6654 if {$markingmatches &&
6655 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6656 # highlight the matches in the comments
6657 set f [$ctext get 1.0 $commentend]
6658 set matches [findmatches $f]
6659 foreach match $matches {
6660 set start [lindex $match 0]
6661 set end [expr {[lindex $match 1] + 1}]
6662 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6668 # mark the bits of a headline or author that match a find string
6669 proc markmatches {canv l str tag matches font row} {
6672 set bbox [$canv bbox $tag]
6673 set x0 [lindex $bbox 0]
6674 set y0 [lindex $bbox 1]
6675 set y1 [lindex $bbox 3]
6676 foreach match $matches {
6677 set start [lindex $match 0]
6678 set end [lindex $match 1]
6679 if {$start > $end} continue
6680 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6681 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6682 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6683 [expr {$x0+$xlen+2}] $y1 \
6684 -outline {} -tags [list match$l matches] -fill yellow]
6686 if {$row == $selectedline} {
6687 $canv raise $t secsel
6692 proc unmarkmatches {} {
6693 global markingmatches
6695 allcanvs delete matches
6696 set markingmatches 0
6700 proc selcanvline {w x y} {
6701 global canv canvy0 ctext linespc
6703 set ymax [lindex [$canv cget -scrollregion] 3]
6704 if {$ymax == {}} return
6705 set yfrac [lindex [$canv yview] 0]
6706 set y [expr {$y + $yfrac * $ymax}]
6707 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6712 set xmax [lindex [$canv cget -scrollregion] 2]
6713 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6714 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6720 proc commit_descriptor {p} {
6722 if {![info exists commitinfo($p)]} {
6726 if {[llength $commitinfo($p)] > 1} {
6727 set l [lindex $commitinfo($p) 0]
6732 # append some text to the ctext widget, and make any SHA1 ID
6733 # that we know about be a clickable link.
6734 proc appendwithlinks {text tags} {
6735 global ctext linknum curview
6737 set start [$ctext index "end - 1c"]
6738 $ctext insert end $text $tags
6739 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6743 set linkid [string range $text $s $e]
6745 $ctext tag delete link$linknum
6746 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6747 setlink $linkid link$linknum
6752 proc setlink {id lk} {
6753 global curview ctext pendinglinks
6755 if {[string range $id 0 1] eq "-g"} {
6756 set id [string range $id 2 end]
6760 if {[string length $id] < 40} {
6761 set matches [longid $id]
6762 if {[llength $matches] > 0} {
6763 if {[llength $matches] > 1} return
6765 set id [lindex $matches 0]
6768 set known [commitinview $id $curview]
6771 $ctext tag conf $lk -foreground blue -underline 1
6772 $ctext tag bind $lk <1> [list selbyid $id]
6773 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6774 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6776 lappend pendinglinks($id) $lk
6777 interestedin $id {makelink %P}
6781 proc appendshortlink {id {pre {}} {post {}}} {
6782 global ctext linknum
6784 $ctext insert end $pre
6785 $ctext tag delete link$linknum
6786 $ctext insert end [string range $id 0 7] link$linknum
6787 $ctext insert end $post
6788 setlink $id link$linknum
6792 proc makelink {id} {
6795 if {![info exists pendinglinks($id)]} return
6796 foreach lk $pendinglinks($id) {
6799 unset pendinglinks($id)
6802 proc linkcursor {w inc} {
6803 global linkentercount curtextcursor
6805 if {[incr linkentercount $inc] > 0} {
6806 $w configure -cursor hand2
6808 $w configure -cursor $curtextcursor
6809 if {$linkentercount < 0} {
6810 set linkentercount 0
6815 proc viewnextline {dir} {
6819 set ymax [lindex [$canv cget -scrollregion] 3]
6820 set wnow [$canv yview]
6821 set wtop [expr {[lindex $wnow 0] * $ymax}]
6822 set newtop [expr {$wtop + $dir * $linespc}]
6825 } elseif {$newtop > $ymax} {
6828 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6831 # add a list of tag or branch names at position pos
6832 # returns the number of names inserted
6833 proc appendrefs {pos ids var} {
6834 global ctext linknum curview $var maxrefs
6836 if {[catch {$ctext index $pos}]} {
6839 $ctext conf -state normal
6840 $ctext delete $pos "$pos lineend"
6843 foreach tag [set $var\($id\)] {
6844 lappend tags [list $tag $id]
6847 if {[llength $tags] > $maxrefs} {
6848 $ctext insert $pos "[mc "many"] ([llength $tags])"
6850 set tags [lsort -index 0 -decreasing $tags]
6853 set id [lindex $ti 1]
6856 $ctext tag delete $lk
6857 $ctext insert $pos $sep
6858 $ctext insert $pos [lindex $ti 0] $lk
6863 $ctext conf -state disabled
6864 return [llength $tags]
6867 # called when we have finished computing the nearby tags
6868 proc dispneartags {delay} {
6869 global selectedline currentid showneartags tagphase
6871 if {$selectedline eq {} || !$showneartags} return
6872 after cancel dispnexttag
6874 after 200 dispnexttag
6877 after idle dispnexttag
6882 proc dispnexttag {} {
6883 global selectedline currentid showneartags tagphase ctext
6885 if {$selectedline eq {} || !$showneartags} return
6886 switch -- $tagphase {
6888 set dtags [desctags $currentid]
6890 appendrefs precedes $dtags idtags
6894 set atags [anctags $currentid]
6896 appendrefs follows $atags idtags
6900 set dheads [descheads $currentid]
6901 if {$dheads ne {}} {
6902 if {[appendrefs branch $dheads idheads] > 1
6903 && [$ctext get "branch -3c"] eq "h"} {
6904 # turn "Branch" into "Branches"
6905 $ctext conf -state normal
6906 $ctext insert "branch -2c" "es"
6907 $ctext conf -state disabled
6912 if {[incr tagphase] <= 2} {
6913 after idle dispnexttag
6917 proc make_secsel {id} {
6918 global linehtag linentag linedtag canv canv2 canv3
6920 if {![info exists linehtag($id)]} return
6922 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6923 -tags secsel -fill [$canv cget -selectbackground]]
6925 $canv2 delete secsel
6926 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6927 -tags secsel -fill [$canv2 cget -selectbackground]]
6929 $canv3 delete secsel
6930 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6931 -tags secsel -fill [$canv3 cget -selectbackground]]
6935 proc make_idmark {id} {
6936 global linehtag canv fgcolor
6938 if {![info exists linehtag($id)]} return
6940 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6941 -tags markid -outline $fgcolor]
6945 proc selectline {l isnew {desired_loc {}}} {
6946 global canv ctext commitinfo selectedline
6947 global canvy0 linespc parents children curview
6948 global currentid sha1entry
6949 global commentend idtags linknum
6950 global mergemax numcommits pending_select
6951 global cmitmode showneartags allcommits
6952 global targetrow targetid lastscrollrows
6953 global autoselect autosellen jump_to_here
6955 catch {unset pending_select}
6960 if {$l < 0 || $l >= $numcommits} return
6961 set id [commitonrow $l]
6966 if {$lastscrollrows < $numcommits} {
6970 set y [expr {$canvy0 + $l * $linespc}]
6971 set ymax [lindex [$canv cget -scrollregion] 3]
6972 set ytop [expr {$y - $linespc - 1}]
6973 set ybot [expr {$y + $linespc + 1}]
6974 set wnow [$canv yview]
6975 set wtop [expr {[lindex $wnow 0] * $ymax}]
6976 set wbot [expr {[lindex $wnow 1] * $ymax}]
6977 set wh [expr {$wbot - $wtop}]
6979 if {$ytop < $wtop} {
6980 if {$ybot < $wtop} {
6981 set newtop [expr {$y - $wh / 2.0}]
6984 if {$newtop > $wtop - $linespc} {
6985 set newtop [expr {$wtop - $linespc}]
6988 } elseif {$ybot > $wbot} {
6989 if {$ytop > $wbot} {
6990 set newtop [expr {$y - $wh / 2.0}]
6992 set newtop [expr {$ybot - $wh}]
6993 if {$newtop < $wtop + $linespc} {
6994 set newtop [expr {$wtop + $linespc}]
6998 if {$newtop != $wtop} {
7002 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7009 addtohistory [list selbyid $id 0] savecmitpos
7012 $sha1entry delete 0 end
7013 $sha1entry insert 0 $id
7015 $sha1entry selection range 0 $autosellen
7019 $ctext conf -state normal
7022 if {![info exists commitinfo($id)]} {
7025 set info $commitinfo($id)
7026 set date [formatdate [lindex $info 2]]
7027 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
7028 set date [formatdate [lindex $info 4]]
7029 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
7030 if {[info exists idtags($id)]} {
7031 $ctext insert end [mc "Tags:"]
7032 foreach tag $idtags($id) {
7033 $ctext insert end " $tag"
7035 $ctext insert end "\n"
7039 set olds $parents($curview,$id)
7040 if {[llength $olds] > 1} {
7043 if {$np >= $mergemax} {
7048 $ctext insert end "[mc "Parent"]: " $tag
7049 appendwithlinks [commit_descriptor $p] {}
7054 append headers "[mc "Parent"]: [commit_descriptor $p]"
7058 foreach c $children($curview,$id) {
7059 append headers "[mc "Child"]: [commit_descriptor $c]"
7062 # make anything that looks like a SHA1 ID be a clickable link
7063 appendwithlinks $headers {}
7064 if {$showneartags} {
7065 if {![info exists allcommits]} {
7068 $ctext insert end "[mc "Branch"]: "
7069 $ctext mark set branch "end -1c"
7070 $ctext mark gravity branch left
7071 $ctext insert end "\n[mc "Follows"]: "
7072 $ctext mark set follows "end -1c"
7073 $ctext mark gravity follows left
7074 $ctext insert end "\n[mc "Precedes"]: "
7075 $ctext mark set precedes "end -1c"
7076 $ctext mark gravity precedes left
7077 $ctext insert end "\n"
7080 $ctext insert end "\n"
7081 set comment [lindex $info 5]
7082 if {[string first "\r" $comment] >= 0} {
7083 set comment [string map {"\r" "\n "} $comment]
7085 appendwithlinks $comment {comment}
7087 $ctext tag remove found 1.0 end
7088 $ctext conf -state disabled
7089 set commentend [$ctext index "end - 1c"]
7091 set jump_to_here $desired_loc
7092 init_flist [mc "Comments"]
7093 if {$cmitmode eq "tree"} {
7095 } elseif {[llength $olds] <= 1} {
7102 proc selfirstline {} {
7107 proc sellastline {} {
7110 set l [expr {$numcommits - 1}]
7114 proc selnextline {dir} {
7117 if {$selectedline eq {}} return
7118 set l [expr {$selectedline + $dir}]
7123 proc selnextpage {dir} {
7124 global canv linespc selectedline numcommits
7126 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7130 allcanvs yview scroll [expr {$dir * $lpp}] units
7132 if {$selectedline eq {}} return
7133 set l [expr {$selectedline + $dir * $lpp}]
7136 } elseif {$l >= $numcommits} {
7137 set l [expr $numcommits - 1]
7143 proc unselectline {} {
7144 global selectedline currentid
7147 catch {unset currentid}
7148 allcanvs delete secsel
7152 proc reselectline {} {
7155 if {$selectedline ne {}} {
7156 selectline $selectedline 0
7160 proc addtohistory {cmd {saveproc {}}} {
7161 global history historyindex curview
7165 set elt [list $curview $cmd $saveproc {}]
7166 if {$historyindex > 0
7167 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7171 if {$historyindex < [llength $history]} {
7172 set history [lreplace $history $historyindex end $elt]
7174 lappend history $elt
7177 if {$historyindex > 1} {
7178 .tf.bar.leftbut conf -state normal
7180 .tf.bar.leftbut conf -state disabled
7182 .tf.bar.rightbut conf -state disabled
7185 # save the scrolling position of the diff display pane
7186 proc save_position {} {
7187 global historyindex history
7189 if {$historyindex < 1} return
7190 set hi [expr {$historyindex - 1}]
7191 set fn [lindex $history $hi 2]
7193 lset history $hi 3 [eval $fn]
7197 proc unset_posvars {} {
7200 if {[info exists last_posvars]} {
7201 foreach {var val} $last_posvars {
7210 global curview last_posvars
7212 set view [lindex $elt 0]
7213 set cmd [lindex $elt 1]
7214 set pv [lindex $elt 3]
7215 if {$curview != $view} {
7219 foreach {var val} $pv {
7223 set last_posvars $pv
7228 global history historyindex
7231 if {$historyindex > 1} {
7233 incr historyindex -1
7234 godo [lindex $history [expr {$historyindex - 1}]]
7235 .tf.bar.rightbut conf -state normal
7237 if {$historyindex <= 1} {
7238 .tf.bar.leftbut conf -state disabled
7243 global history historyindex
7246 if {$historyindex < [llength $history]} {
7248 set cmd [lindex $history $historyindex]
7251 .tf.bar.leftbut conf -state normal
7253 if {$historyindex >= [llength $history]} {
7254 .tf.bar.rightbut conf -state disabled
7259 global treefilelist treeidlist diffids diffmergeid treepending
7260 global nullid nullid2
7263 catch {unset diffmergeid}
7264 if {![info exists treefilelist($id)]} {
7265 if {![info exists treepending]} {
7266 if {$id eq $nullid} {
7267 set cmd [list | git ls-files]
7268 } elseif {$id eq $nullid2} {
7269 set cmd [list | git ls-files --stage -t]
7271 set cmd [list | git ls-tree -r $id]
7273 if {[catch {set gtf [open $cmd r]}]} {
7277 set treefilelist($id) {}
7278 set treeidlist($id) {}
7279 fconfigure $gtf -blocking 0 -encoding binary
7280 filerun $gtf [list gettreeline $gtf $id]
7287 proc gettreeline {gtf id} {
7288 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7291 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7292 if {$diffids eq $nullid} {
7295 set i [string first "\t" $line]
7296 if {$i < 0} continue
7297 set fname [string range $line [expr {$i+1}] end]
7298 set line [string range $line 0 [expr {$i-1}]]
7299 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7300 set sha1 [lindex $line 2]
7301 lappend treeidlist($id) $sha1
7303 if {[string index $fname 0] eq "\""} {
7304 set fname [lindex $fname 0]
7306 set fname [encoding convertfrom $fname]
7307 lappend treefilelist($id) $fname
7310 return [expr {$nl >= 1000? 2: 1}]
7314 if {$cmitmode ne "tree"} {
7315 if {![info exists diffmergeid]} {
7316 gettreediffs $diffids
7318 } elseif {$id ne $diffids} {
7327 global treefilelist treeidlist diffids nullid nullid2
7328 global ctext_file_names ctext_file_lines
7329 global ctext commentend
7331 set i [lsearch -exact $treefilelist($diffids) $f]
7333 puts "oops, $f not in list for id $diffids"
7336 if {$diffids eq $nullid} {
7337 if {[catch {set bf [open $f r]} err]} {
7338 puts "oops, can't read $f: $err"
7342 set blob [lindex $treeidlist($diffids) $i]
7343 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7344 puts "oops, error reading blob $blob: $err"
7348 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7349 filerun $bf [list getblobline $bf $diffids]
7350 $ctext config -state normal
7351 clear_ctext $commentend
7352 lappend ctext_file_names $f
7353 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7354 $ctext insert end "\n"
7355 $ctext insert end "$f\n" filesep
7356 $ctext config -state disabled
7357 $ctext yview $commentend
7361 proc getblobline {bf id} {
7362 global diffids cmitmode ctext
7364 if {$id ne $diffids || $cmitmode ne "tree"} {
7368 $ctext config -state normal
7370 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7371 $ctext insert end "$line\n"
7374 global jump_to_here ctext_file_names commentend
7376 # delete last newline
7377 $ctext delete "end - 2c" "end - 1c"
7379 if {$jump_to_here ne {} &&
7380 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7381 set lnum [expr {[lindex $jump_to_here 1] +
7382 [lindex [split $commentend .] 0]}]
7383 mark_ctext_line $lnum
7385 $ctext config -state disabled
7388 $ctext config -state disabled
7389 return [expr {$nl >= 1000? 2: 1}]
7392 proc mark_ctext_line {lnum} {
7393 global ctext markbgcolor
7395 $ctext tag delete omark
7396 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7397 $ctext tag conf omark -background $markbgcolor
7401 proc mergediff {id} {
7403 global diffids treediffs
7404 global parents curview
7408 set treediffs($id) {}
7409 set np [llength $parents($curview,$id)]
7414 proc startdiff {ids} {
7415 global treediffs diffids treepending diffmergeid nullid nullid2
7419 catch {unset diffmergeid}
7420 if {![info exists treediffs($ids)] ||
7421 [lsearch -exact $ids $nullid] >= 0 ||
7422 [lsearch -exact $ids $nullid2] >= 0} {
7423 if {![info exists treepending]} {
7431 # If the filename (name) is under any of the passed filter paths
7432 # then return true to include the file in the listing.
7433 proc path_filter {filter name} {
7434 set worktree [gitworktree]
7436 set fq_p [file normalize $p]
7437 set fq_n [file normalize [file join $worktree $name]]
7438 if {[string match [file normalize $fq_p]* $fq_n]} {
7445 proc addtocflist {ids} {
7448 add_flist $treediffs($ids)
7452 proc diffcmd {ids flags} {
7453 global nullid nullid2
7455 set i [lsearch -exact $ids $nullid]
7456 set j [lsearch -exact $ids $nullid2]
7458 if {[llength $ids] > 1 && $j < 0} {
7459 # comparing working directory with some specific revision
7460 set cmd [concat | git diff-index $flags]
7462 lappend cmd -R [lindex $ids 1]
7464 lappend cmd [lindex $ids 0]
7467 # comparing working directory with index
7468 set cmd [concat | git diff-files $flags]
7473 } elseif {$j >= 0} {
7474 set cmd [concat | git diff-index --cached $flags]
7475 if {[llength $ids] > 1} {
7476 # comparing index with specific revision
7478 lappend cmd -R [lindex $ids 1]
7480 lappend cmd [lindex $ids 0]
7483 # comparing index with HEAD
7487 set cmd [concat | git diff-tree -r $flags $ids]
7492 proc gettreediffs {ids} {
7493 global treediff treepending
7495 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7497 set treepending $ids
7499 fconfigure $gdtf -blocking 0 -encoding binary
7500 filerun $gdtf [list gettreediffline $gdtf $ids]
7503 proc gettreediffline {gdtf ids} {
7504 global treediff treediffs treepending diffids diffmergeid
7505 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7510 if {$perfile_attrs} {
7511 # cache_gitattr is slow, and even slower on win32 where we
7512 # have to invoke it for only about 30 paths at a time
7514 if {[tk windowingsystem] == "win32"} {
7518 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7519 set i [string first "\t" $line]
7521 set file [string range $line [expr {$i+1}] end]
7522 if {[string index $file 0] eq "\""} {
7523 set file [lindex $file 0]
7525 set file [encoding convertfrom $file]
7526 if {$file ne [lindex $treediff end]} {
7527 lappend treediff $file
7528 lappend sublist $file
7532 if {$perfile_attrs} {
7533 cache_gitattr encoding $sublist
7536 return [expr {$nr >= $max? 2: 1}]
7539 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7541 foreach f $treediff {
7542 if {[path_filter $vfilelimit($curview) $f]} {
7546 set treediffs($ids) $flist
7548 set treediffs($ids) $treediff
7551 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7553 } elseif {$ids != $diffids} {
7554 if {![info exists diffmergeid]} {
7555 gettreediffs $diffids
7563 # empty string or positive integer
7564 proc diffcontextvalidate {v} {
7565 return [regexp {^(|[1-9][0-9]*)$} $v]
7568 proc diffcontextchange {n1 n2 op} {
7569 global diffcontextstring diffcontext
7571 if {[string is integer -strict $diffcontextstring]} {
7572 if {$diffcontextstring >= 0} {
7573 set diffcontext $diffcontextstring
7579 proc changeignorespace {} {
7583 proc changeworddiff {name ix op} {
7587 proc getblobdiffs {ids} {
7588 global blobdifffd diffids env
7589 global diffinhdr treediffs
7593 global limitdiffs vfilelimit curview
7594 global diffencoding targetline diffnparents
7595 global git_version currdiffsubmod
7598 if {[package vcompare $git_version "1.6.1"] >= 0} {
7599 set textconv "--textconv"
7602 if {[package vcompare $git_version "1.6.6"] >= 0} {
7603 set submodule "--submodule"
7605 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
7609 if {$worddiff ne [mc "Line diff"]} {
7610 append cmd " --word-diff=porcelain"
7612 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7613 set cmd [concat $cmd -- $vfilelimit($curview)]
7615 if {[catch {set bdf [open $cmd r]} err]} {
7616 error_popup [mc "Error getting diffs: %s" $err]
7622 set diffencoding [get_path_encoding {}]
7623 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7624 set blobdifffd($ids) $bdf
7625 set currdiffsubmod ""
7626 filerun $bdf [list getblobdiffline $bdf $diffids]
7629 proc savecmitpos {} {
7630 global ctext cmitmode
7632 if {$cmitmode eq "tree"} {
7635 return [list target_scrollpos [$ctext index @0,0]]
7638 proc savectextpos {} {
7641 return [list target_scrollpos [$ctext index @0,0]]
7644 proc maybe_scroll_ctext {ateof} {
7645 global ctext target_scrollpos
7647 if {![info exists target_scrollpos]} return
7649 set nlines [expr {[winfo height $ctext]
7650 / [font metrics textfont -linespace]}]
7651 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7653 $ctext yview $target_scrollpos
7654 unset target_scrollpos
7657 proc setinlist {var i val} {
7660 while {[llength [set $var]] < $i} {
7663 if {[llength [set $var]] == $i} {
7670 proc makediffhdr {fname ids} {
7671 global ctext curdiffstart treediffs diffencoding
7672 global ctext_file_names jump_to_here targetline diffline
7674 set fname [encoding convertfrom $fname]
7675 set diffencoding [get_path_encoding $fname]
7676 set i [lsearch -exact $treediffs($ids) $fname]
7678 setinlist difffilestart $i $curdiffstart
7680 lset ctext_file_names end $fname
7681 set l [expr {(78 - [string length $fname]) / 2}]
7682 set pad [string range "----------------------------------------" 1 $l]
7683 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7685 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7686 set targetline [lindex $jump_to_here 1]
7691 proc getblobdiffline {bdf ids} {
7692 global diffids blobdifffd ctext curdiffstart
7693 global diffnexthead diffnextnote difffilestart
7694 global ctext_file_names ctext_file_lines
7695 global diffinhdr treediffs mergemax diffnparents
7696 global diffencoding jump_to_here targetline diffline currdiffsubmod
7700 $ctext conf -state normal
7701 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7702 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7706 if {![string compare -length 5 "diff " $line]} {
7707 if {![regexp {^diff (--cc|--git) } $line m type]} {
7708 set line [encoding convertfrom $line]
7709 $ctext insert end "$line\n" hunksep
7712 # start of a new file
7714 $ctext insert end "\n"
7715 set curdiffstart [$ctext index "end - 1c"]
7716 lappend ctext_file_names ""
7717 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7718 $ctext insert end "\n" filesep
7720 if {$type eq "--cc"} {
7721 # start of a new file in a merge diff
7722 set fname [string range $line 10 end]
7723 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7724 lappend treediffs($ids) $fname
7725 add_flist [list $fname]
7729 set line [string range $line 11 end]
7730 # If the name hasn't changed the length will be odd,
7731 # the middle char will be a space, and the two bits either
7732 # side will be a/name and b/name, or "a/name" and "b/name".
7733 # If the name has changed we'll get "rename from" and
7734 # "rename to" or "copy from" and "copy to" lines following
7735 # this, and we'll use them to get the filenames.
7736 # This complexity is necessary because spaces in the
7737 # filename(s) don't get escaped.
7738 set l [string length $line]
7739 set i [expr {$l / 2}]
7740 if {!(($l & 1) && [string index $line $i] eq " " &&
7741 [string range $line 2 [expr {$i - 1}]] eq \
7742 [string range $line [expr {$i + 3}] end])} {
7745 # unescape if quoted and chop off the a/ from the front
7746 if {[string index $line 0] eq "\""} {
7747 set fname [string range [lindex $line 0] 2 end]
7749 set fname [string range $line 2 [expr {$i - 1}]]
7752 makediffhdr $fname $ids
7754 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7755 set fname [encoding convertfrom [string range $line 16 end]]
7756 $ctext insert end "\n"
7757 set curdiffstart [$ctext index "end - 1c"]
7758 lappend ctext_file_names $fname
7759 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7760 $ctext insert end "$line\n" filesep
7761 set i [lsearch -exact $treediffs($ids) $fname]
7763 setinlist difffilestart $i $curdiffstart
7766 } elseif {![string compare -length 2 "@@" $line]} {
7767 regexp {^@@+} $line ats
7768 set line [encoding convertfrom $diffencoding $line]
7769 $ctext insert end "$line\n" hunksep
7770 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7773 set diffnparents [expr {[string length $ats] - 1}]
7776 } elseif {![string compare -length 10 "Submodule " $line]} {
7777 # start of a new submodule
7778 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7779 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7781 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7783 if {$currdiffsubmod != $fname} {
7784 $ctext insert end "\n"; # Add newline after commit message
7786 set curdiffstart [$ctext index "end - 1c"]
7787 lappend ctext_file_names ""
7788 if {$currdiffsubmod != $fname} {
7789 lappend ctext_file_lines $fname
7790 makediffhdr $fname $ids
7791 set currdiffsubmod $fname
7792 $ctext insert end "\n$line\n" filesep
7794 $ctext insert end "$line\n" filesep
7796 } elseif {![string compare -length 3 " >" $line]} {
7797 set $currdiffsubmod ""
7798 set line [encoding convertfrom $diffencoding $line]
7799 $ctext insert end "$line\n" dresult
7800 } elseif {![string compare -length 3 " <" $line]} {
7801 set $currdiffsubmod ""
7802 set line [encoding convertfrom $diffencoding $line]
7803 $ctext insert end "$line\n" d0
7804 } elseif {$diffinhdr} {
7805 if {![string compare -length 12 "rename from " $line]} {
7806 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7807 if {[string index $fname 0] eq "\""} {
7808 set fname [lindex $fname 0]
7810 set fname [encoding convertfrom $fname]
7811 set i [lsearch -exact $treediffs($ids) $fname]
7813 setinlist difffilestart $i $curdiffstart
7815 } elseif {![string compare -length 10 $line "rename to "] ||
7816 ![string compare -length 8 $line "copy to "]} {
7817 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7818 if {[string index $fname 0] eq "\""} {
7819 set fname [lindex $fname 0]
7821 makediffhdr $fname $ids
7822 } elseif {[string compare -length 3 $line "---"] == 0} {
7825 } elseif {[string compare -length 3 $line "+++"] == 0} {
7829 $ctext insert end "$line\n" filesep
7832 set line [string map {\x1A ^Z} \
7833 [encoding convertfrom $diffencoding $line]]
7834 # parse the prefix - one ' ', '-' or '+' for each parent
7835 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7836 set tag [expr {$diffnparents > 1? "m": "d"}]
7837 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7838 set words_pre_markup ""
7839 set words_post_markup ""
7840 if {[string trim $prefix " -+"] eq {}} {
7841 # prefix only has " ", "-" and "+" in it: normal diff line
7842 set num [string first "-" $prefix]
7844 set line [string range $line 1 end]
7847 # removed line, first parent with line is $num
7848 if {$num >= $mergemax} {
7851 if {$dowords && $worddiff eq [mc "Markup words"]} {
7852 $ctext insert end "\[-$line-\]" $tag$num
7854 $ctext insert end "$line" $tag$num
7857 $ctext insert end "\n" $tag$num
7861 if {[string first "+" $prefix] >= 0} {
7863 lappend tags ${tag}result
7864 if {$diffnparents > 1} {
7865 set num [string first " " $prefix]
7867 if {$num >= $mergemax} {
7873 set words_pre_markup "{+"
7874 set words_post_markup "+}"
7876 if {$targetline ne {}} {
7877 if {$diffline == $targetline} {
7878 set seehere [$ctext index "end - 1 chars"]
7884 if {$dowords && $worddiff eq [mc "Markup words"]} {
7885 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7887 $ctext insert end "$line" $tags
7890 $ctext insert end "\n" $tags
7893 } elseif {$dowords && $prefix eq "~"} {
7894 $ctext insert end "\n" {}
7896 # "\ No newline at end of file",
7897 # or something else we don't recognize
7898 $ctext insert end "$line\n" hunksep
7902 if {[info exists seehere]} {
7903 mark_ctext_line [lindex [split $seehere .] 0]
7905 maybe_scroll_ctext [eof $bdf]
7906 $ctext conf -state disabled
7911 return [expr {$nr >= 1000? 2: 1}]
7914 proc changediffdisp {} {
7915 global ctext diffelide
7917 $ctext tag conf d0 -elide [lindex $diffelide 0]
7918 $ctext tag conf dresult -elide [lindex $diffelide 1]
7921 proc highlightfile {loc cline} {
7922 global ctext cflist cflist_top
7925 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7926 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7927 $cflist see $cline.0
7928 set cflist_top $cline
7932 global difffilestart ctext cmitmode
7934 if {$cmitmode eq "tree"} return
7937 set here [$ctext index @0,0]
7938 foreach loc $difffilestart {
7939 if {[$ctext compare $loc >= $here]} {
7940 highlightfile $prev $prevline
7946 highlightfile $prev $prevline
7950 global difffilestart ctext cmitmode
7952 if {$cmitmode eq "tree"} return
7953 set here [$ctext index @0,0]
7955 foreach loc $difffilestart {
7957 if {[$ctext compare $loc > $here]} {
7958 highlightfile $loc $line
7964 proc clear_ctext {{first 1.0}} {
7965 global ctext smarktop smarkbot
7966 global ctext_file_names ctext_file_lines
7969 set l [lindex [split $first .] 0]
7970 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7973 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7976 $ctext delete $first end
7977 if {$first eq "1.0"} {
7978 catch {unset pendinglinks}
7980 set ctext_file_names {}
7981 set ctext_file_lines {}
7984 proc settabs {{firstab {}}} {
7985 global firsttabstop tabstop ctext have_tk85
7987 if {$firstab ne {} && $have_tk85} {
7988 set firsttabstop $firstab
7990 set w [font measure textfont "0"]
7991 if {$firsttabstop != 0} {
7992 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7993 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7994 } elseif {$have_tk85 || $tabstop != 8} {
7995 $ctext conf -tabs [expr {$tabstop * $w}]
7997 $ctext conf -tabs {}
8001 proc incrsearch {name ix op} {
8002 global ctext searchstring searchdirn
8004 $ctext tag remove found 1.0 end
8005 if {[catch {$ctext index anchor}]} {
8006 # no anchor set, use start of selection, or of visible area
8007 set sel [$ctext tag ranges sel]
8009 $ctext mark set anchor [lindex $sel 0]
8010 } elseif {$searchdirn eq "-forwards"} {
8011 $ctext mark set anchor @0,0
8013 $ctext mark set anchor @0,[winfo height $ctext]
8016 if {$searchstring ne {}} {
8017 set here [$ctext search $searchdirn -- $searchstring anchor]
8026 global sstring ctext searchstring searchdirn
8029 $sstring icursor end
8030 set searchdirn -forwards
8031 if {$searchstring ne {}} {
8032 set sel [$ctext tag ranges sel]
8034 set start "[lindex $sel 0] + 1c"
8035 } elseif {[catch {set start [$ctext index anchor]}]} {
8038 set match [$ctext search -count mlen -- $searchstring $start]
8039 $ctext tag remove sel 1.0 end
8045 set mend "$match + $mlen c"
8046 $ctext tag add sel $match $mend
8047 $ctext mark unset anchor
8051 proc dosearchback {} {
8052 global sstring ctext searchstring searchdirn
8055 $sstring icursor end
8056 set searchdirn -backwards
8057 if {$searchstring ne {}} {
8058 set sel [$ctext tag ranges sel]
8060 set start [lindex $sel 0]
8061 } elseif {[catch {set start [$ctext index anchor]}]} {
8062 set start @0,[winfo height $ctext]
8064 set match [$ctext search -backwards -count ml -- $searchstring $start]
8065 $ctext tag remove sel 1.0 end
8071 set mend "$match + $ml c"
8072 $ctext tag add sel $match $mend
8073 $ctext mark unset anchor
8077 proc searchmark {first last} {
8078 global ctext searchstring
8082 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8083 if {$match eq {}} break
8084 set mend "$match + $mlen c"
8085 $ctext tag add found $match $mend
8089 proc searchmarkvisible {doall} {
8090 global ctext smarktop smarkbot
8092 set topline [lindex [split [$ctext index @0,0] .] 0]
8093 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8094 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8095 # no overlap with previous
8096 searchmark $topline $botline
8097 set smarktop $topline
8098 set smarkbot $botline
8100 if {$topline < $smarktop} {
8101 searchmark $topline [expr {$smarktop-1}]
8102 set smarktop $topline
8104 if {$botline > $smarkbot} {
8105 searchmark [expr {$smarkbot+1}] $botline
8106 set smarkbot $botline
8111 proc scrolltext {f0 f1} {
8114 .bleft.bottom.sb set $f0 $f1
8115 if {$searchstring ne {}} {
8121 global linespc charspc canvx0 canvy0
8122 global xspc1 xspc2 lthickness
8124 set linespc [font metrics mainfont -linespace]
8125 set charspc [font measure mainfont "m"]
8126 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8127 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8128 set lthickness [expr {int($linespc / 9) + 1}]
8129 set xspc1(0) $linespc
8137 set ymax [lindex [$canv cget -scrollregion] 3]
8138 if {$ymax eq {} || $ymax == 0} return
8139 set span [$canv yview]
8142 allcanvs yview moveto [lindex $span 0]
8144 if {$selectedline ne {}} {
8145 selectline $selectedline 0
8146 allcanvs yview moveto [lindex $span 0]
8150 proc parsefont {f n} {
8153 set fontattr($f,family) [lindex $n 0]
8155 if {$s eq {} || $s == 0} {
8158 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8160 set fontattr($f,size) $s
8161 set fontattr($f,weight) normal
8162 set fontattr($f,slant) roman
8163 foreach style [lrange $n 2 end] {
8166 "bold" {set fontattr($f,weight) $style}
8168 "italic" {set fontattr($f,slant) $style}
8173 proc fontflags {f {isbold 0}} {
8176 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8177 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8178 -slant $fontattr($f,slant)]
8184 set n [list $fontattr($f,family) $fontattr($f,size)]
8185 if {$fontattr($f,weight) eq "bold"} {
8188 if {$fontattr($f,slant) eq "italic"} {
8194 proc incrfont {inc} {
8195 global mainfont textfont ctext canv cflist showrefstop
8196 global stopped entries fontattr
8199 set s $fontattr(mainfont,size)
8204 set fontattr(mainfont,size) $s
8205 font config mainfont -size $s
8206 font config mainfontbold -size $s
8207 set mainfont [fontname mainfont]
8208 set s $fontattr(textfont,size)
8213 set fontattr(textfont,size) $s
8214 font config textfont -size $s
8215 font config textfontbold -size $s
8216 set textfont [fontname textfont]
8223 global sha1entry sha1string
8224 if {[string length $sha1string] == 40} {
8225 $sha1entry delete 0 end
8229 proc sha1change {n1 n2 op} {
8230 global sha1string currentid sha1but
8231 if {$sha1string == {}
8232 || ([info exists currentid] && $sha1string == $currentid)} {
8237 if {[$sha1but cget -state] == $state} return
8238 if {$state == "normal"} {
8239 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8241 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8245 proc gotocommit {} {
8246 global sha1string tagids headids curview varcid
8248 if {$sha1string == {}
8249 || ([info exists currentid] && $sha1string == $currentid)} return
8250 if {[info exists tagids($sha1string)]} {
8251 set id $tagids($sha1string)
8252 } elseif {[info exists headids($sha1string)]} {
8253 set id $headids($sha1string)
8255 set id [string tolower $sha1string]
8256 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8257 set matches [longid $id]
8258 if {$matches ne {}} {
8259 if {[llength $matches] > 1} {
8260 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8263 set id [lindex $matches 0]
8266 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8267 error_popup [mc "Revision %s is not known" $sha1string]
8272 if {[commitinview $id $curview]} {
8273 selectline [rowofcommit $id] 1
8276 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8277 set msg [mc "SHA1 id %s is not known" $sha1string]
8279 set msg [mc "Revision %s is not in the current view" $sha1string]
8284 proc lineenter {x y id} {
8285 global hoverx hovery hoverid hovertimer
8286 global commitinfo canv
8288 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8292 if {[info exists hovertimer]} {
8293 after cancel $hovertimer
8295 set hovertimer [after 500 linehover]
8299 proc linemotion {x y id} {
8300 global hoverx hovery hoverid hovertimer
8302 if {[info exists hoverid] && $id == $hoverid} {
8305 if {[info exists hovertimer]} {
8306 after cancel $hovertimer
8308 set hovertimer [after 500 linehover]
8312 proc lineleave {id} {
8313 global hoverid hovertimer canv
8315 if {[info exists hoverid] && $id == $hoverid} {
8317 if {[info exists hovertimer]} {
8318 after cancel $hovertimer
8326 global hoverx hovery hoverid hovertimer
8327 global canv linespc lthickness
8330 set text [lindex $commitinfo($hoverid) 0]
8331 set ymax [lindex [$canv cget -scrollregion] 3]
8332 if {$ymax == {}} return
8333 set yfrac [lindex [$canv yview] 0]
8334 set x [expr {$hoverx + 2 * $linespc}]
8335 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8336 set x0 [expr {$x - 2 * $lthickness}]
8337 set y0 [expr {$y - 2 * $lthickness}]
8338 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8339 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8340 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8341 -fill \#ffff80 -outline black -width 1 -tags hover]
8343 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8348 proc clickisonarrow {id y} {
8351 set ranges [rowranges $id]
8352 set thresh [expr {2 * $lthickness + 6}]
8353 set n [expr {[llength $ranges] - 1}]
8354 for {set i 1} {$i < $n} {incr i} {
8355 set row [lindex $ranges $i]
8356 if {abs([yc $row] - $y) < $thresh} {
8363 proc arrowjump {id n y} {
8366 # 1 <-> 2, 3 <-> 4, etc...
8367 set n [expr {(($n - 1) ^ 1) + 1}]
8368 set row [lindex [rowranges $id] $n]
8370 set ymax [lindex [$canv cget -scrollregion] 3]
8371 if {$ymax eq {} || $ymax <= 0} return
8372 set view [$canv yview]
8373 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8374 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8378 allcanvs yview moveto $yfrac
8381 proc lineclick {x y id isnew} {
8382 global ctext commitinfo children canv thickerline curview
8384 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8389 # draw this line thicker than normal
8393 set ymax [lindex [$canv cget -scrollregion] 3]
8394 if {$ymax eq {}} return
8395 set yfrac [lindex [$canv yview] 0]
8396 set y [expr {$y + $yfrac * $ymax}]
8398 set dirn [clickisonarrow $id $y]
8400 arrowjump $id $dirn $y
8405 addtohistory [list lineclick $x $y $id 0] savectextpos
8407 # fill the details pane with info about this line
8408 $ctext conf -state normal
8411 $ctext insert end "[mc "Parent"]:\t"
8412 $ctext insert end $id link0
8414 set info $commitinfo($id)
8415 $ctext insert end "\n\t[lindex $info 0]\n"
8416 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8417 set date [formatdate [lindex $info 2]]
8418 $ctext insert end "\t[mc "Date"]:\t$date\n"
8419 set kids $children($curview,$id)
8421 $ctext insert end "\n[mc "Children"]:"
8423 foreach child $kids {
8425 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8426 set info $commitinfo($child)
8427 $ctext insert end "\n\t"
8428 $ctext insert end $child link$i
8429 setlink $child link$i
8430 $ctext insert end "\n\t[lindex $info 0]"
8431 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8432 set date [formatdate [lindex $info 2]]
8433 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8436 maybe_scroll_ctext 1
8437 $ctext conf -state disabled
8441 proc normalline {} {
8443 if {[info exists thickerline]} {
8450 proc selbyid {id {isnew 1}} {
8452 if {[commitinview $id $curview]} {
8453 selectline [rowofcommit $id] $isnew
8459 if {![info exists startmstime]} {
8460 set startmstime [clock clicks -milliseconds]
8462 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8465 proc rowmenu {x y id} {
8466 global rowctxmenu selectedline rowmenuid curview
8467 global nullid nullid2 fakerowmenu mainhead markedid
8471 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8476 if {$id ne $nullid && $id ne $nullid2} {
8477 set menu $rowctxmenu
8478 if {$mainhead ne {}} {
8479 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8481 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8483 if {[info exists markedid] && $markedid ne $id} {
8484 $menu entryconfigure 9 -state normal
8485 $menu entryconfigure 10 -state normal
8486 $menu entryconfigure 11 -state normal
8488 $menu entryconfigure 9 -state disabled
8489 $menu entryconfigure 10 -state disabled
8490 $menu entryconfigure 11 -state disabled
8493 set menu $fakerowmenu
8495 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8496 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8497 $menu entryconfigure [mca "Make patch"] -state $state
8498 tk_popup $menu $x $y
8502 global rowmenuid markedid canv
8504 set markedid $rowmenuid
8505 make_idmark $markedid
8511 if {[info exists markedid]} {
8516 proc replace_by_kids {l r} {
8517 global curview children
8519 set id [commitonrow $r]
8520 set l [lreplace $l 0 0]
8521 foreach kid $children($curview,$id) {
8522 lappend l [rowofcommit $kid]
8524 return [lsort -integer -decreasing -unique $l]
8527 proc find_common_desc {} {
8528 global markedid rowmenuid curview children
8530 if {![info exists markedid]} return
8531 if {![commitinview $markedid $curview] ||
8532 ![commitinview $rowmenuid $curview]} return
8533 #set t1 [clock clicks -milliseconds]
8534 set l1 [list [rowofcommit $markedid]]
8535 set l2 [list [rowofcommit $rowmenuid]]
8537 set r1 [lindex $l1 0]
8538 set r2 [lindex $l2 0]
8539 if {$r1 eq {} || $r2 eq {}} break
8545 set l1 [replace_by_kids $l1 $r1]
8547 set l2 [replace_by_kids $l2 $r2]
8550 #set t2 [clock clicks -milliseconds]
8551 #puts "took [expr {$t2-$t1}]ms"
8554 proc compare_commits {} {
8555 global markedid rowmenuid curview children
8557 if {![info exists markedid]} return
8558 if {![commitinview $markedid $curview]} return
8559 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8560 do_cmp_commits $markedid $rowmenuid
8563 proc getpatchid {id} {
8566 if {![info exists patchids($id)]} {
8567 set cmd [diffcmd [list $id] {-p --root}]
8568 # trim off the initial "|"
8569 set cmd [lrange $cmd 1 end]
8571 set x [eval exec $cmd | git patch-id]
8572 set patchids($id) [lindex $x 0]
8574 set patchids($id) "error"
8577 return $patchids($id)
8580 proc do_cmp_commits {a b} {
8581 global ctext curview parents children patchids commitinfo
8583 $ctext conf -state normal
8586 for {set i 0} {$i < 100} {incr i} {
8589 if {[llength $parents($curview,$a)] > 1} {
8590 appendshortlink $a [mc "Skipping merge commit "] "\n"
8593 set patcha [getpatchid $a]
8595 if {[llength $parents($curview,$b)] > 1} {
8596 appendshortlink $b [mc "Skipping merge commit "] "\n"
8599 set patchb [getpatchid $b]
8601 if {!$skipa && !$skipb} {
8602 set heada [lindex $commitinfo($a) 0]
8603 set headb [lindex $commitinfo($b) 0]
8604 if {$patcha eq "error"} {
8605 appendshortlink $a [mc "Error getting patch ID for "] \
8606 [mc " - stopping\n"]
8609 if {$patchb eq "error"} {
8610 appendshortlink $b [mc "Error getting patch ID for "] \
8611 [mc " - stopping\n"]
8614 if {$patcha eq $patchb} {
8615 if {$heada eq $headb} {
8616 appendshortlink $a [mc "Commit "]
8617 appendshortlink $b " == " " $heada\n"
8619 appendshortlink $a [mc "Commit "] " $heada\n"
8620 appendshortlink $b [mc " is the same patch as\n "] \
8626 $ctext insert end "\n"
8627 appendshortlink $a [mc "Commit "] " $heada\n"
8628 appendshortlink $b [mc " differs from\n "] \
8630 $ctext insert end [mc "Diff of commits:\n\n"]
8631 $ctext conf -state disabled
8638 set kids [real_children $curview,$a]
8639 if {[llength $kids] != 1} {
8640 $ctext insert end "\n"
8641 appendshortlink $a [mc "Commit "] \
8642 [mc " has %s children - stopping\n" [llength $kids]]
8645 set a [lindex $kids 0]
8648 set kids [real_children $curview,$b]
8649 if {[llength $kids] != 1} {
8650 appendshortlink $b [mc "Commit "] \
8651 [mc " has %s children - stopping\n" [llength $kids]]
8654 set b [lindex $kids 0]
8657 $ctext conf -state disabled
8660 proc diffcommits {a b} {
8661 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8663 set tmpdir [gitknewtmpdir]
8664 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8665 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8667 exec git diff-tree -p --pretty $a >$fna
8668 exec git diff-tree -p --pretty $b >$fnb
8670 error_popup [mc "Error writing commit to file: %s" $err]
8674 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8676 error_popup [mc "Error diffing commits: %s" $err]
8679 set diffids [list commits $a $b]
8680 set blobdifffd($diffids) $fd
8682 set currdiffsubmod ""
8683 filerun $fd [list getblobdiffline $fd $diffids]
8686 proc diffvssel {dirn} {
8687 global rowmenuid selectedline
8689 if {$selectedline eq {}} return
8691 set oldid [commitonrow $selectedline]
8692 set newid $rowmenuid
8694 set oldid $rowmenuid
8695 set newid [commitonrow $selectedline]
8697 addtohistory [list doseldiff $oldid $newid] savectextpos
8698 doseldiff $oldid $newid
8701 proc doseldiff {oldid newid} {
8705 $ctext conf -state normal
8707 init_flist [mc "Top"]
8708 $ctext insert end "[mc "From"] "
8709 $ctext insert end $oldid link0
8710 setlink $oldid link0
8711 $ctext insert end "\n "
8712 $ctext insert end [lindex $commitinfo($oldid) 0]
8713 $ctext insert end "\n\n[mc "To"] "
8714 $ctext insert end $newid link1
8715 setlink $newid link1
8716 $ctext insert end "\n "
8717 $ctext insert end [lindex $commitinfo($newid) 0]
8718 $ctext insert end "\n"
8719 $ctext conf -state disabled
8720 $ctext tag remove found 1.0 end
8721 startdiff [list $oldid $newid]
8725 global rowmenuid currentid commitinfo patchtop patchnum NS
8727 if {![info exists currentid]} return
8728 set oldid $currentid
8729 set oldhead [lindex $commitinfo($oldid) 0]
8730 set newid $rowmenuid
8731 set newhead [lindex $commitinfo($newid) 0]
8734 catch {destroy $top}
8736 make_transient $top .
8737 ${NS}::label $top.title -text [mc "Generate patch"]
8738 grid $top.title - -pady 10
8739 ${NS}::label $top.from -text [mc "From:"]
8740 ${NS}::entry $top.fromsha1 -width 40
8741 $top.fromsha1 insert 0 $oldid
8742 $top.fromsha1 conf -state readonly
8743 grid $top.from $top.fromsha1 -sticky w
8744 ${NS}::entry $top.fromhead -width 60
8745 $top.fromhead insert 0 $oldhead
8746 $top.fromhead conf -state readonly
8747 grid x $top.fromhead -sticky w
8748 ${NS}::label $top.to -text [mc "To:"]
8749 ${NS}::entry $top.tosha1 -width 40
8750 $top.tosha1 insert 0 $newid
8751 $top.tosha1 conf -state readonly
8752 grid $top.to $top.tosha1 -sticky w
8753 ${NS}::entry $top.tohead -width 60
8754 $top.tohead insert 0 $newhead
8755 $top.tohead conf -state readonly
8756 grid x $top.tohead -sticky w
8757 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8758 grid $top.rev x -pady 10 -padx 5
8759 ${NS}::label $top.flab -text [mc "Output file:"]
8760 ${NS}::entry $top.fname -width 60
8761 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8763 grid $top.flab $top.fname -sticky w
8764 ${NS}::frame $top.buts
8765 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8766 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8767 bind $top <Key-Return> mkpatchgo
8768 bind $top <Key-Escape> mkpatchcan
8769 grid $top.buts.gen $top.buts.can
8770 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8771 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8772 grid $top.buts - -pady 10 -sticky ew
8776 proc mkpatchrev {} {
8779 set oldid [$patchtop.fromsha1 get]
8780 set oldhead [$patchtop.fromhead get]
8781 set newid [$patchtop.tosha1 get]
8782 set newhead [$patchtop.tohead get]
8783 foreach e [list fromsha1 fromhead tosha1 tohead] \
8784 v [list $newid $newhead $oldid $oldhead] {
8785 $patchtop.$e conf -state normal
8786 $patchtop.$e delete 0 end
8787 $patchtop.$e insert 0 $v
8788 $patchtop.$e conf -state readonly
8793 global patchtop nullid nullid2
8795 set oldid [$patchtop.fromsha1 get]
8796 set newid [$patchtop.tosha1 get]
8797 set fname [$patchtop.fname get]
8798 set cmd [diffcmd [list $oldid $newid] -p]
8799 # trim off the initial "|"
8800 set cmd [lrange $cmd 1 end]
8801 lappend cmd >$fname &
8802 if {[catch {eval exec $cmd} err]} {
8803 error_popup "[mc "Error creating patch:"] $err" $patchtop
8805 catch {destroy $patchtop}
8809 proc mkpatchcan {} {
8812 catch {destroy $patchtop}
8817 global rowmenuid mktagtop commitinfo NS
8821 catch {destroy $top}
8823 make_transient $top .
8824 ${NS}::label $top.title -text [mc "Create tag"]
8825 grid $top.title - -pady 10
8826 ${NS}::label $top.id -text [mc "ID:"]
8827 ${NS}::entry $top.sha1 -width 40
8828 $top.sha1 insert 0 $rowmenuid
8829 $top.sha1 conf -state readonly
8830 grid $top.id $top.sha1 -sticky w
8831 ${NS}::entry $top.head -width 60
8832 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8833 $top.head conf -state readonly
8834 grid x $top.head -sticky w
8835 ${NS}::label $top.tlab -text [mc "Tag name:"]
8836 ${NS}::entry $top.tag -width 60
8837 grid $top.tlab $top.tag -sticky w
8838 ${NS}::label $top.op -text [mc "Tag message is optional"]
8839 grid $top.op -columnspan 2 -sticky we
8840 ${NS}::label $top.mlab -text [mc "Tag message:"]
8841 ${NS}::entry $top.msg -width 60
8842 grid $top.mlab $top.msg -sticky w
8843 ${NS}::frame $top.buts
8844 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8845 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8846 bind $top <Key-Return> mktaggo
8847 bind $top <Key-Escape> mktagcan
8848 grid $top.buts.gen $top.buts.can
8849 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8850 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8851 grid $top.buts - -pady 10 -sticky ew
8856 global mktagtop env tagids idtags
8858 set id [$mktagtop.sha1 get]
8859 set tag [$mktagtop.tag get]
8860 set msg [$mktagtop.msg get]
8862 error_popup [mc "No tag name specified"] $mktagtop
8865 if {[info exists tagids($tag)]} {
8866 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8871 exec git tag -a -m $msg $tag $id
8873 exec git tag $tag $id
8876 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8880 set tagids($tag) $id
8881 lappend idtags($id) $tag
8889 proc redrawtags {id} {
8890 global canv linehtag idpos currentid curview cmitlisted markedid
8891 global canvxmax iddrawn circleitem mainheadid circlecolors
8893 if {![commitinview $id $curview]} return
8894 if {![info exists iddrawn($id)]} return
8895 set row [rowofcommit $id]
8896 if {$id eq $mainheadid} {
8899 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8901 $canv itemconf $circleitem($row) -fill $ofill
8902 $canv delete tag.$id
8903 set xt [eval drawtags $id $idpos($id)]
8904 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8905 set text [$canv itemcget $linehtag($id) -text]
8906 set font [$canv itemcget $linehtag($id) -font]
8907 set xr [expr {$xt + [font measure $font $text]}]
8908 if {$xr > $canvxmax} {
8912 if {[info exists currentid] && $currentid == $id} {
8915 if {[info exists markedid] && $markedid eq $id} {
8923 catch {destroy $mktagtop}
8928 if {![domktag]} return
8932 proc writecommit {} {
8933 global rowmenuid wrcomtop commitinfo wrcomcmd NS
8935 set top .writecommit
8937 catch {destroy $top}
8939 make_transient $top .
8940 ${NS}::label $top.title -text [mc "Write commit to file"]
8941 grid $top.title - -pady 10
8942 ${NS}::label $top.id -text [mc "ID:"]
8943 ${NS}::entry $top.sha1 -width 40
8944 $top.sha1 insert 0 $rowmenuid
8945 $top.sha1 conf -state readonly
8946 grid $top.id $top.sha1 -sticky w
8947 ${NS}::entry $top.head -width 60
8948 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8949 $top.head conf -state readonly
8950 grid x $top.head -sticky w
8951 ${NS}::label $top.clab -text [mc "Command:"]
8952 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8953 grid $top.clab $top.cmd -sticky w -pady 10
8954 ${NS}::label $top.flab -text [mc "Output file:"]
8955 ${NS}::entry $top.fname -width 60
8956 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8957 grid $top.flab $top.fname -sticky w
8958 ${NS}::frame $top.buts
8959 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8960 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8961 bind $top <Key-Return> wrcomgo
8962 bind $top <Key-Escape> wrcomcan
8963 grid $top.buts.gen $top.buts.can
8964 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8965 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8966 grid $top.buts - -pady 10 -sticky ew
8973 set id [$wrcomtop.sha1 get]
8974 set cmd "echo $id | [$wrcomtop.cmd get]"
8975 set fname [$wrcomtop.fname get]
8976 if {[catch {exec sh -c $cmd >$fname &} err]} {
8977 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8979 catch {destroy $wrcomtop}
8986 catch {destroy $wrcomtop}
8991 global rowmenuid mkbrtop NS
8994 catch {destroy $top}
8996 make_transient $top .
8997 ${NS}::label $top.title -text [mc "Create new branch"]
8998 grid $top.title - -pady 10
8999 ${NS}::label $top.id -text [mc "ID:"]
9000 ${NS}::entry $top.sha1 -width 40
9001 $top.sha1 insert 0 $rowmenuid
9002 $top.sha1 conf -state readonly
9003 grid $top.id $top.sha1 -sticky w
9004 ${NS}::label $top.nlab -text [mc "Name:"]
9005 ${NS}::entry $top.name -width 40
9006 grid $top.nlab $top.name -sticky w
9007 ${NS}::frame $top.buts
9008 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9009 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9010 bind $top <Key-Return> [list mkbrgo $top]
9011 bind $top <Key-Escape> "catch {destroy $top}"
9012 grid $top.buts.go $top.buts.can
9013 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9014 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9015 grid $top.buts - -pady 10 -sticky ew
9020 global headids idheads
9022 set name [$top.name get]
9023 set id [$top.sha1 get]
9027 error_popup [mc "Please specify a name for the new branch"] $top
9030 if {[info exists headids($name)]} {
9031 if {![confirm_popup [mc \
9032 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9035 set old_id $headids($name)
9038 catch {destroy $top}
9039 lappend cmdargs $name $id
9043 eval exec git branch $cmdargs
9049 if {$old_id ne {}} {
9055 set headids($name) $id
9056 lappend idheads($id) $name
9065 proc exec_citool {tool_args {baseid {}}} {
9066 global commitinfo env
9068 set save_env [array get env GIT_AUTHOR_*]
9070 if {$baseid ne {}} {
9071 if {![info exists commitinfo($baseid)]} {
9074 set author [lindex $commitinfo($baseid) 1]
9075 set date [lindex $commitinfo($baseid) 2]
9076 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9077 $author author name email]
9079 set env(GIT_AUTHOR_NAME) $name
9080 set env(GIT_AUTHOR_EMAIL) $email
9081 set env(GIT_AUTHOR_DATE) $date
9085 eval exec git citool $tool_args &
9087 array unset env GIT_AUTHOR_*
9088 array set env $save_env
9091 proc cherrypick {} {
9092 global rowmenuid curview
9093 global mainhead mainheadid
9096 set oldhead [exec git rev-parse HEAD]
9097 set dheads [descheads $rowmenuid]
9098 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9099 set ok [confirm_popup [mc "Commit %s is already\
9100 included in branch %s -- really re-apply it?" \
9101 [string range $rowmenuid 0 7] $mainhead]]
9104 nowbusy cherrypick [mc "Cherry-picking"]
9106 # Unfortunately git-cherry-pick writes stuff to stderr even when
9107 # no error occurs, and exec takes that as an indication of error...
9108 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9111 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9113 error_popup [mc "Cherry-pick failed because of local changes\
9114 to file '%s'.\nPlease commit, reset or stash\
9115 your changes and try again." $fname]
9116 } elseif {[regexp -line \
9117 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9119 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9120 conflict.\nDo you wish to run git citool to\
9122 # Force citool to read MERGE_MSG
9123 file delete [file join $gitdir "GITGUI_MSG"]
9124 exec_citool {} $rowmenuid
9132 set newhead [exec git rev-parse HEAD]
9133 if {$newhead eq $oldhead} {
9135 error_popup [mc "No changes committed"]
9138 addnewchild $newhead $oldhead
9139 if {[commitinview $oldhead $curview]} {
9140 # XXX this isn't right if we have a path limit...
9141 insertrow $newhead $oldhead $curview
9142 if {$mainhead ne {}} {
9143 movehead $newhead $mainhead
9144 movedhead $newhead $mainhead
9146 set mainheadid $newhead
9155 global mainhead rowmenuid confirm_ok resettype NS
9158 set w ".confirmreset"
9161 wm title $w [mc "Confirm reset"]
9162 ${NS}::label $w.m -text \
9163 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9164 pack $w.m -side top -fill x -padx 20 -pady 20
9165 ${NS}::labelframe $w.f -text [mc "Reset type:"]
9167 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9168 -text [mc "Soft: Leave working tree and index untouched"]
9169 grid $w.f.soft -sticky w
9170 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9171 -text [mc "Mixed: Leave working tree untouched, reset index"]
9172 grid $w.f.mixed -sticky w
9173 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9174 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9175 grid $w.f.hard -sticky w
9176 pack $w.f -side top -fill x -padx 4
9177 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9178 pack $w.ok -side left -fill x -padx 20 -pady 20
9179 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9180 bind $w <Key-Escape> [list destroy $w]
9181 pack $w.cancel -side right -fill x -padx 20 -pady 20
9182 bind $w <Visibility> "grab $w; focus $w"
9184 if {!$confirm_ok} return
9185 if {[catch {set fd [open \
9186 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9190 filerun $fd [list readresetstat $fd]
9191 nowbusy reset [mc "Resetting"]
9196 proc readresetstat {fd} {
9197 global mainhead mainheadid showlocalchanges rprogcoord
9199 if {[gets $fd line] >= 0} {
9200 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9201 set rprogcoord [expr {1.0 * $m / $n}]
9209 if {[catch {close $fd} err]} {
9212 set oldhead $mainheadid
9213 set newhead [exec git rev-parse HEAD]
9214 if {$newhead ne $oldhead} {
9215 movehead $newhead $mainhead
9216 movedhead $newhead $mainhead
9217 set mainheadid $newhead
9221 if {$showlocalchanges} {
9227 # context menu for a head
9228 proc headmenu {x y id head} {
9229 global headmenuid headmenuhead headctxmenu mainhead
9233 set headmenuhead $head
9235 if {[string match "remotes/*" $head]} {
9238 if {$head eq $mainhead} {
9241 $headctxmenu entryconfigure 0 -state $state
9242 $headctxmenu entryconfigure 1 -state $state
9243 tk_popup $headctxmenu $x $y
9247 global headmenuid headmenuhead headids
9248 global showlocalchanges
9250 # check the tree is clean first??
9251 nowbusy checkout [mc "Checking out"]
9255 set fd [open [list | git checkout $headmenuhead 2>@1] r]
9259 if {$showlocalchanges} {
9263 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9267 proc readcheckoutstat {fd newhead newheadid} {
9268 global mainhead mainheadid headids showlocalchanges progresscoords
9269 global viewmainheadid curview
9271 if {[gets $fd line] >= 0} {
9272 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9273 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9278 set progresscoords {0 0}
9281 if {[catch {close $fd} err]} {
9284 set oldmainid $mainheadid
9285 set mainhead $newhead
9286 set mainheadid $newheadid
9287 set viewmainheadid($curview) $newheadid
9288 redrawtags $oldmainid
9289 redrawtags $newheadid
9291 if {$showlocalchanges} {
9297 global headmenuid headmenuhead mainhead
9300 set head $headmenuhead
9302 # this check shouldn't be needed any more...
9303 if {$head eq $mainhead} {
9304 error_popup [mc "Cannot delete the currently checked-out branch"]
9307 set dheads [descheads $id]
9308 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9309 # the stuff on this branch isn't on any other branch
9310 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9311 branch.\nReally delete branch %s?" $head $head]]} return
9315 if {[catch {exec git branch -D $head} err]} {
9320 removehead $id $head
9321 removedhead $id $head
9328 # Display a list of tags and heads
9330 global showrefstop bgcolor fgcolor selectbgcolor NS
9331 global bglist fglist reflistfilter reflist maincursor
9334 set showrefstop $top
9335 if {[winfo exists $top]} {
9341 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9342 make_transient $top .
9343 text $top.list -background $bgcolor -foreground $fgcolor \
9344 -selectbackground $selectbgcolor -font mainfont \
9345 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9346 -width 30 -height 20 -cursor $maincursor \
9347 -spacing1 1 -spacing3 1 -state disabled
9348 $top.list tag configure highlight -background $selectbgcolor
9349 lappend bglist $top.list
9350 lappend fglist $top.list
9351 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9352 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9353 grid $top.list $top.ysb -sticky nsew
9354 grid $top.xsb x -sticky ew
9356 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9357 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9358 set reflistfilter "*"
9359 trace add variable reflistfilter write reflistfilter_change
9360 pack $top.f.e -side right -fill x -expand 1
9361 pack $top.f.l -side left
9362 grid $top.f - -sticky ew -pady 2
9363 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9364 bind $top <Key-Escape> [list destroy $top]
9366 grid columnconfigure $top 0 -weight 1
9367 grid rowconfigure $top 0 -weight 1
9368 bind $top.list <1> {break}
9369 bind $top.list <B1-Motion> {break}
9370 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9375 proc sel_reflist {w x y} {
9376 global showrefstop reflist headids tagids otherrefids
9378 if {![winfo exists $showrefstop]} return
9379 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9380 set ref [lindex $reflist [expr {$l-1}]]
9381 set n [lindex $ref 0]
9382 switch -- [lindex $ref 1] {
9383 "H" {selbyid $headids($n)}
9384 "T" {selbyid $tagids($n)}
9385 "o" {selbyid $otherrefids($n)}
9387 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9390 proc unsel_reflist {} {
9393 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9394 $showrefstop.list tag remove highlight 0.0 end
9397 proc reflistfilter_change {n1 n2 op} {
9398 global reflistfilter
9400 after cancel refill_reflist
9401 after 200 refill_reflist
9404 proc refill_reflist {} {
9405 global reflist reflistfilter showrefstop headids tagids otherrefids
9408 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9410 foreach n [array names headids] {
9411 if {[string match $reflistfilter $n]} {
9412 if {[commitinview $headids($n) $curview]} {
9413 lappend refs [list $n H]
9415 interestedin $headids($n) {run refill_reflist}
9419 foreach n [array names tagids] {
9420 if {[string match $reflistfilter $n]} {
9421 if {[commitinview $tagids($n) $curview]} {
9422 lappend refs [list $n T]
9424 interestedin $tagids($n) {run refill_reflist}
9428 foreach n [array names otherrefids] {
9429 if {[string match $reflistfilter $n]} {
9430 if {[commitinview $otherrefids($n) $curview]} {
9431 lappend refs [list $n o]
9433 interestedin $otherrefids($n) {run refill_reflist}
9437 set refs [lsort -index 0 $refs]
9438 if {$refs eq $reflist} return
9440 # Update the contents of $showrefstop.list according to the
9441 # differences between $reflist (old) and $refs (new)
9442 $showrefstop.list conf -state normal
9443 $showrefstop.list insert end "\n"
9446 while {$i < [llength $reflist] || $j < [llength $refs]} {
9447 if {$i < [llength $reflist]} {
9448 if {$j < [llength $refs]} {
9449 set cmp [string compare [lindex $reflist $i 0] \
9450 [lindex $refs $j 0]]
9452 set cmp [string compare [lindex $reflist $i 1] \
9453 [lindex $refs $j 1]]
9463 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9471 set l [expr {$j + 1}]
9472 $showrefstop.list image create $l.0 -align baseline \
9473 -image reficon-[lindex $refs $j 1] -padx 2
9474 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9480 # delete last newline
9481 $showrefstop.list delete end-2c end-1c
9482 $showrefstop.list conf -state disabled
9485 # Stuff for finding nearby tags
9486 proc getallcommits {} {
9487 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9488 global idheads idtags idotherrefs allparents tagobjid
9491 if {![info exists allcommits]} {
9497 set allccache [file join $gitdir "gitk.cache"]
9499 set f [open $allccache r]
9508 set cmd [list | git rev-list --parents]
9509 set allcupdate [expr {$seeds ne {}}]
9513 set refs [concat [array names idheads] [array names idtags] \
9514 [array names idotherrefs]]
9517 foreach name [array names tagobjid] {
9518 lappend tagobjs $tagobjid($name)
9520 foreach id [lsort -unique $refs] {
9521 if {![info exists allparents($id)] &&
9522 [lsearch -exact $tagobjs $id] < 0} {
9533 set fd [open [concat $cmd $ids] r]
9534 fconfigure $fd -blocking 0
9537 filerun $fd [list getallclines $fd]
9543 # Since most commits have 1 parent and 1 child, we group strings of
9544 # such commits into "arcs" joining branch/merge points (BMPs), which
9545 # are commits that either don't have 1 parent or don't have 1 child.
9547 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9548 # arcout(id) - outgoing arcs for BMP
9549 # arcids(a) - list of IDs on arc including end but not start
9550 # arcstart(a) - BMP ID at start of arc
9551 # arcend(a) - BMP ID at end of arc
9552 # growing(a) - arc a is still growing
9553 # arctags(a) - IDs out of arcids (excluding end) that have tags
9554 # archeads(a) - IDs out of arcids (excluding end) that have heads
9555 # The start of an arc is at the descendent end, so "incoming" means
9556 # coming from descendents, and "outgoing" means going towards ancestors.
9558 proc getallclines {fd} {
9559 global allparents allchildren idtags idheads nextarc
9560 global arcnos arcids arctags arcout arcend arcstart archeads growing
9561 global seeds allcommits cachedarcs allcupdate
9564 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9565 set id [lindex $line 0]
9566 if {[info exists allparents($id)]} {
9571 set olds [lrange $line 1 end]
9572 set allparents($id) $olds
9573 if {![info exists allchildren($id)]} {
9574 set allchildren($id) {}
9579 if {[llength $olds] == 1 && [llength $a] == 1} {
9580 lappend arcids($a) $id
9581 if {[info exists idtags($id)]} {
9582 lappend arctags($a) $id
9584 if {[info exists idheads($id)]} {
9585 lappend archeads($a) $id
9587 if {[info exists allparents($olds)]} {
9588 # seen parent already
9589 if {![info exists arcout($olds)]} {
9592 lappend arcids($a) $olds
9593 set arcend($a) $olds
9596 lappend allchildren($olds) $id
9597 lappend arcnos($olds) $a
9601 foreach a $arcnos($id) {
9602 lappend arcids($a) $id
9609 lappend allchildren($p) $id
9610 set a [incr nextarc]
9611 set arcstart($a) $id
9618 if {[info exists allparents($p)]} {
9619 # seen it already, may need to make a new branch
9620 if {![info exists arcout($p)]} {
9623 lappend arcids($a) $p
9627 lappend arcnos($p) $a
9632 global cached_dheads cached_dtags cached_atags
9633 catch {unset cached_dheads}
9634 catch {unset cached_dtags}
9635 catch {unset cached_atags}
9638 return [expr {$nid >= 1000? 2: 1}]
9642 fconfigure $fd -blocking 1
9645 # got an error reading the list of commits
9646 # if we were updating, try rereading the whole thing again
9652 error_popup "[mc "Error reading commit topology information;\
9653 branch and preceding/following tag information\
9654 will be incomplete."]\n($err)"
9657 if {[incr allcommits -1] == 0} {
9667 proc recalcarc {a} {
9668 global arctags archeads arcids idtags idheads
9672 foreach id [lrange $arcids($a) 0 end-1] {
9673 if {[info exists idtags($id)]} {
9676 if {[info exists idheads($id)]} {
9681 set archeads($a) $ah
9685 global arcnos arcids nextarc arctags archeads idtags idheads
9686 global arcstart arcend arcout allparents growing
9689 if {[llength $a] != 1} {
9690 puts "oops splitarc called but [llength $a] arcs already"
9694 set i [lsearch -exact $arcids($a) $p]
9696 puts "oops splitarc $p not in arc $a"
9699 set na [incr nextarc]
9700 if {[info exists arcend($a)]} {
9701 set arcend($na) $arcend($a)
9703 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9704 set j [lsearch -exact $arcnos($l) $a]
9705 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9707 set tail [lrange $arcids($a) [expr {$i+1}] end]
9708 set arcids($a) [lrange $arcids($a) 0 $i]
9710 set arcstart($na) $p
9712 set arcids($na) $tail
9713 if {[info exists growing($a)]} {
9719 if {[llength $arcnos($id)] == 1} {
9722 set j [lsearch -exact $arcnos($id) $a]
9723 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9727 # reconstruct tags and heads lists
9728 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9733 set archeads($na) {}
9737 # Update things for a new commit added that is a child of one
9738 # existing commit. Used when cherry-picking.
9739 proc addnewchild {id p} {
9740 global allparents allchildren idtags nextarc
9741 global arcnos arcids arctags arcout arcend arcstart archeads growing
9742 global seeds allcommits
9744 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9745 set allparents($id) [list $p]
9746 set allchildren($id) {}
9749 lappend allchildren($p) $id
9750 set a [incr nextarc]
9751 set arcstart($a) $id
9754 set arcids($a) [list $p]
9756 if {![info exists arcout($p)]} {
9759 lappend arcnos($p) $a
9760 set arcout($id) [list $a]
9763 # This implements a cache for the topology information.
9764 # The cache saves, for each arc, the start and end of the arc,
9765 # the ids on the arc, and the outgoing arcs from the end.
9766 proc readcache {f} {
9767 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9768 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9773 if {$lim - $a > 500} {
9774 set lim [expr {$a + 500}]
9778 # finish reading the cache and setting up arctags, etc.
9780 if {$line ne "1"} {error "bad final version"}
9782 foreach id [array names idtags] {
9783 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9784 [llength $allparents($id)] == 1} {
9785 set a [lindex $arcnos($id) 0]
9786 if {$arctags($a) eq {}} {
9791 foreach id [array names idheads] {
9792 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9793 [llength $allparents($id)] == 1} {
9794 set a [lindex $arcnos($id) 0]
9795 if {$archeads($a) eq {}} {
9800 foreach id [lsort -unique $possible_seeds] {
9801 if {$arcnos($id) eq {}} {
9807 while {[incr a] <= $lim} {
9809 if {[llength $line] != 3} {error "bad line"}
9810 set s [lindex $line 0]
9812 lappend arcout($s) $a
9813 if {![info exists arcnos($s)]} {
9814 lappend possible_seeds $s
9817 set e [lindex $line 1]
9822 if {![info exists arcout($e)]} {
9826 set arcids($a) [lindex $line 2]
9827 foreach id $arcids($a) {
9828 lappend allparents($s) $id
9830 lappend arcnos($id) $a
9832 if {![info exists allparents($s)]} {
9833 set allparents($s) {}
9838 set nextarc [expr {$a - 1}]
9851 global nextarc cachedarcs possible_seeds
9855 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9856 # make sure it's an integer
9857 set cachedarcs [expr {int([lindex $line 1])}]
9858 if {$cachedarcs < 0} {error "bad number of arcs"}
9860 set possible_seeds {}
9868 proc dropcache {err} {
9869 global allcwait nextarc cachedarcs seeds
9871 #puts "dropping cache ($err)"
9872 foreach v {arcnos arcout arcids arcstart arcend growing \
9873 arctags archeads allparents allchildren} {
9884 proc writecache {f} {
9885 global cachearc cachedarcs allccache
9886 global arcstart arcend arcnos arcids arcout
9890 if {$lim - $a > 1000} {
9891 set lim [expr {$a + 1000}]
9894 while {[incr a] <= $lim} {
9895 if {[info exists arcend($a)]} {
9896 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9898 puts $f [list $arcstart($a) {} $arcids($a)]
9903 catch {file delete $allccache}
9904 #puts "writing cache failed ($err)"
9907 set cachearc [expr {$a - 1}]
9908 if {$a > $cachedarcs} {
9917 global nextarc cachedarcs cachearc allccache
9919 if {$nextarc == $cachedarcs} return
9921 set cachedarcs $nextarc
9923 set f [open $allccache w]
9924 puts $f [list 1 $cachedarcs]
9929 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9930 # or 0 if neither is true.
9931 proc anc_or_desc {a b} {
9932 global arcout arcstart arcend arcnos cached_isanc
9934 if {$arcnos($a) eq $arcnos($b)} {
9935 # Both are on the same arc(s); either both are the same BMP,
9936 # or if one is not a BMP, the other is also not a BMP or is
9937 # the BMP at end of the arc (and it only has 1 incoming arc).
9938 # Or both can be BMPs with no incoming arcs.
9939 if {$a eq $b || $arcnos($a) eq {}} {
9942 # assert {[llength $arcnos($a)] == 1}
9943 set arc [lindex $arcnos($a) 0]
9944 set i [lsearch -exact $arcids($arc) $a]
9945 set j [lsearch -exact $arcids($arc) $b]
9946 if {$i < 0 || $i > $j} {
9953 if {![info exists arcout($a)]} {
9954 set arc [lindex $arcnos($a) 0]
9955 if {[info exists arcend($arc)]} {
9956 set aend $arcend($arc)
9960 set a $arcstart($arc)
9964 if {![info exists arcout($b)]} {
9965 set arc [lindex $arcnos($b) 0]
9966 if {[info exists arcend($arc)]} {
9967 set bend $arcend($arc)
9971 set b $arcstart($arc)
9981 if {[info exists cached_isanc($a,$bend)]} {
9982 if {$cached_isanc($a,$bend)} {
9986 if {[info exists cached_isanc($b,$aend)]} {
9987 if {$cached_isanc($b,$aend)} {
9990 if {[info exists cached_isanc($a,$bend)]} {
9995 set todo [list $a $b]
9998 for {set i 0} {$i < [llength $todo]} {incr i} {
9999 set x [lindex $todo $i]
10000 if {$anc($x) eq {}} {
10003 foreach arc $arcnos($x) {
10004 set xd $arcstart($arc)
10005 if {$xd eq $bend} {
10006 set cached_isanc($a,$bend) 1
10007 set cached_isanc($b,$aend) 0
10009 } elseif {$xd eq $aend} {
10010 set cached_isanc($b,$aend) 1
10011 set cached_isanc($a,$bend) 0
10014 if {![info exists anc($xd)]} {
10015 set anc($xd) $anc($x)
10017 } elseif {$anc($xd) ne $anc($x)} {
10022 set cached_isanc($a,$bend) 0
10023 set cached_isanc($b,$aend) 0
10027 # This identifies whether $desc has an ancestor that is
10028 # a growing tip of the graph and which is not an ancestor of $anc
10029 # and returns 0 if so and 1 if not.
10030 # If we subsequently discover a tag on such a growing tip, and that
10031 # turns out to be a descendent of $anc (which it could, since we
10032 # don't necessarily see children before parents), then $desc
10033 # isn't a good choice to display as a descendent tag of
10034 # $anc (since it is the descendent of another tag which is
10035 # a descendent of $anc). Similarly, $anc isn't a good choice to
10036 # display as a ancestor tag of $desc.
10038 proc is_certain {desc anc} {
10039 global arcnos arcout arcstart arcend growing problems
10042 if {[llength $arcnos($anc)] == 1} {
10043 # tags on the same arc are certain
10044 if {$arcnos($desc) eq $arcnos($anc)} {
10047 if {![info exists arcout($anc)]} {
10048 # if $anc is partway along an arc, use the start of the arc instead
10049 set a [lindex $arcnos($anc) 0]
10050 set anc $arcstart($a)
10053 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10056 set a [lindex $arcnos($desc) 0]
10062 set anclist [list $x]
10066 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10067 set x [lindex $anclist $i]
10072 foreach a $arcout($x) {
10073 if {[info exists growing($a)]} {
10074 if {![info exists growanc($x)] && $dl($x)} {
10080 if {[info exists dl($y)]} {
10084 if {![info exists done($y)]} {
10087 if {[info exists growanc($x)]} {
10091 for {set k 0} {$k < [llength $xl]} {incr k} {
10092 set z [lindex $xl $k]
10093 foreach c $arcout($z) {
10094 if {[info exists arcend($c)]} {
10096 if {[info exists dl($v)] && $dl($v)} {
10098 if {![info exists done($v)]} {
10101 if {[info exists growanc($v)]} {
10111 } elseif {$y eq $anc || !$dl($x)} {
10122 foreach x [array names growanc] {
10131 proc validate_arctags {a} {
10132 global arctags idtags
10135 set na $arctags($a)
10136 foreach id $arctags($a) {
10138 if {![info exists idtags($id)]} {
10139 set na [lreplace $na $i $i]
10143 set arctags($a) $na
10146 proc validate_archeads {a} {
10147 global archeads idheads
10150 set na $archeads($a)
10151 foreach id $archeads($a) {
10153 if {![info exists idheads($id)]} {
10154 set na [lreplace $na $i $i]
10158 set archeads($a) $na
10161 # Return the list of IDs that have tags that are descendents of id,
10162 # ignoring IDs that are descendents of IDs already reported.
10163 proc desctags {id} {
10164 global arcnos arcstart arcids arctags idtags allparents
10165 global growing cached_dtags
10167 if {![info exists allparents($id)]} {
10170 set t1 [clock clicks -milliseconds]
10172 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10173 # part-way along an arc; check that arc first
10174 set a [lindex $arcnos($id) 0]
10175 if {$arctags($a) ne {}} {
10176 validate_arctags $a
10177 set i [lsearch -exact $arcids($a) $id]
10179 foreach t $arctags($a) {
10180 set j [lsearch -exact $arcids($a) $t]
10181 if {$j >= $i} break
10188 set id $arcstart($a)
10189 if {[info exists idtags($id)]} {
10193 if {[info exists cached_dtags($id)]} {
10194 return $cached_dtags($id)
10198 set todo [list $id]
10201 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10202 set id [lindex $todo $i]
10204 set ta [info exists hastaggedancestor($id)]
10208 # ignore tags on starting node
10209 if {!$ta && $i > 0} {
10210 if {[info exists idtags($id)]} {
10211 set tagloc($id) $id
10213 } elseif {[info exists cached_dtags($id)]} {
10214 set tagloc($id) $cached_dtags($id)
10218 foreach a $arcnos($id) {
10219 set d $arcstart($a)
10220 if {!$ta && $arctags($a) ne {}} {
10221 validate_arctags $a
10222 if {$arctags($a) ne {}} {
10223 lappend tagloc($id) [lindex $arctags($a) end]
10226 if {$ta || $arctags($a) ne {}} {
10227 set tomark [list $d]
10228 for {set j 0} {$j < [llength $tomark]} {incr j} {
10229 set dd [lindex $tomark $j]
10230 if {![info exists hastaggedancestor($dd)]} {
10231 if {[info exists done($dd)]} {
10232 foreach b $arcnos($dd) {
10233 lappend tomark $arcstart($b)
10235 if {[info exists tagloc($dd)]} {
10238 } elseif {[info exists queued($dd)]} {
10241 set hastaggedancestor($dd) 1
10245 if {![info exists queued($d)]} {
10248 if {![info exists hastaggedancestor($d)]} {
10255 foreach id [array names tagloc] {
10256 if {![info exists hastaggedancestor($id)]} {
10257 foreach t $tagloc($id) {
10258 if {[lsearch -exact $tags $t] < 0} {
10264 set t2 [clock clicks -milliseconds]
10267 # remove tags that are descendents of other tags
10268 for {set i 0} {$i < [llength $tags]} {incr i} {
10269 set a [lindex $tags $i]
10270 for {set j 0} {$j < $i} {incr j} {
10271 set b [lindex $tags $j]
10272 set r [anc_or_desc $a $b]
10274 set tags [lreplace $tags $j $j]
10277 } elseif {$r == -1} {
10278 set tags [lreplace $tags $i $i]
10285 if {[array names growing] ne {}} {
10286 # graph isn't finished, need to check if any tag could get
10287 # eclipsed by another tag coming later. Simply ignore any
10288 # tags that could later get eclipsed.
10291 if {[is_certain $t $origid]} {
10295 if {$tags eq $ctags} {
10296 set cached_dtags($origid) $tags
10301 set cached_dtags($origid) $tags
10303 set t3 [clock clicks -milliseconds]
10304 if {0 && $t3 - $t1 >= 100} {
10305 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10306 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10311 proc anctags {id} {
10312 global arcnos arcids arcout arcend arctags idtags allparents
10313 global growing cached_atags
10315 if {![info exists allparents($id)]} {
10318 set t1 [clock clicks -milliseconds]
10320 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10321 # part-way along an arc; check that arc first
10322 set a [lindex $arcnos($id) 0]
10323 if {$arctags($a) ne {}} {
10324 validate_arctags $a
10325 set i [lsearch -exact $arcids($a) $id]
10326 foreach t $arctags($a) {
10327 set j [lsearch -exact $arcids($a) $t]
10333 if {![info exists arcend($a)]} {
10337 if {[info exists idtags($id)]} {
10341 if {[info exists cached_atags($id)]} {
10342 return $cached_atags($id)
10346 set todo [list $id]
10350 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10351 set id [lindex $todo $i]
10353 set td [info exists hastaggeddescendent($id)]
10357 # ignore tags on starting node
10358 if {!$td && $i > 0} {
10359 if {[info exists idtags($id)]} {
10360 set tagloc($id) $id
10362 } elseif {[info exists cached_atags($id)]} {
10363 set tagloc($id) $cached_atags($id)
10367 foreach a $arcout($id) {
10368 if {!$td && $arctags($a) ne {}} {
10369 validate_arctags $a
10370 if {$arctags($a) ne {}} {
10371 lappend tagloc($id) [lindex $arctags($a) 0]
10374 if {![info exists arcend($a)]} continue
10376 if {$td || $arctags($a) ne {}} {
10377 set tomark [list $d]
10378 for {set j 0} {$j < [llength $tomark]} {incr j} {
10379 set dd [lindex $tomark $j]
10380 if {![info exists hastaggeddescendent($dd)]} {
10381 if {[info exists done($dd)]} {
10382 foreach b $arcout($dd) {
10383 if {[info exists arcend($b)]} {
10384 lappend tomark $arcend($b)
10387 if {[info exists tagloc($dd)]} {
10390 } elseif {[info exists queued($dd)]} {
10393 set hastaggeddescendent($dd) 1
10397 if {![info exists queued($d)]} {
10400 if {![info exists hastaggeddescendent($d)]} {
10406 set t2 [clock clicks -milliseconds]
10409 foreach id [array names tagloc] {
10410 if {![info exists hastaggeddescendent($id)]} {
10411 foreach t $tagloc($id) {
10412 if {[lsearch -exact $tags $t] < 0} {
10419 # remove tags that are ancestors of other tags
10420 for {set i 0} {$i < [llength $tags]} {incr i} {
10421 set a [lindex $tags $i]
10422 for {set j 0} {$j < $i} {incr j} {
10423 set b [lindex $tags $j]
10424 set r [anc_or_desc $a $b]
10426 set tags [lreplace $tags $j $j]
10429 } elseif {$r == 1} {
10430 set tags [lreplace $tags $i $i]
10437 if {[array names growing] ne {}} {
10438 # graph isn't finished, need to check if any tag could get
10439 # eclipsed by another tag coming later. Simply ignore any
10440 # tags that could later get eclipsed.
10443 if {[is_certain $origid $t]} {
10447 if {$tags eq $ctags} {
10448 set cached_atags($origid) $tags
10453 set cached_atags($origid) $tags
10455 set t3 [clock clicks -milliseconds]
10456 if {0 && $t3 - $t1 >= 100} {
10457 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10458 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10463 # Return the list of IDs that have heads that are descendents of id,
10464 # including id itself if it has a head.
10465 proc descheads {id} {
10466 global arcnos arcstart arcids archeads idheads cached_dheads
10469 if {![info exists allparents($id)]} {
10473 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10474 # part-way along an arc; check it first
10475 set a [lindex $arcnos($id) 0]
10476 if {$archeads($a) ne {}} {
10477 validate_archeads $a
10478 set i [lsearch -exact $arcids($a) $id]
10479 foreach t $archeads($a) {
10480 set j [lsearch -exact $arcids($a) $t]
10485 set id $arcstart($a)
10488 set todo [list $id]
10491 for {set i 0} {$i < [llength $todo]} {incr i} {
10492 set id [lindex $todo $i]
10493 if {[info exists cached_dheads($id)]} {
10494 set ret [concat $ret $cached_dheads($id)]
10496 if {[info exists idheads($id)]} {
10499 foreach a $arcnos($id) {
10500 if {$archeads($a) ne {}} {
10501 validate_archeads $a
10502 if {$archeads($a) ne {}} {
10503 set ret [concat $ret $archeads($a)]
10506 set d $arcstart($a)
10507 if {![info exists seen($d)]} {
10514 set ret [lsort -unique $ret]
10515 set cached_dheads($origid) $ret
10516 return [concat $ret $aret]
10519 proc addedtag {id} {
10520 global arcnos arcout cached_dtags cached_atags
10522 if {![info exists arcnos($id)]} return
10523 if {![info exists arcout($id)]} {
10524 recalcarc [lindex $arcnos($id) 0]
10526 catch {unset cached_dtags}
10527 catch {unset cached_atags}
10530 proc addedhead {hid head} {
10531 global arcnos arcout cached_dheads
10533 if {![info exists arcnos($hid)]} return
10534 if {![info exists arcout($hid)]} {
10535 recalcarc [lindex $arcnos($hid) 0]
10537 catch {unset cached_dheads}
10540 proc removedhead {hid head} {
10541 global cached_dheads
10543 catch {unset cached_dheads}
10546 proc movedhead {hid head} {
10547 global arcnos arcout cached_dheads
10549 if {![info exists arcnos($hid)]} return
10550 if {![info exists arcout($hid)]} {
10551 recalcarc [lindex $arcnos($hid) 0]
10553 catch {unset cached_dheads}
10556 proc changedrefs {} {
10557 global cached_dheads cached_dtags cached_atags
10558 global arctags archeads arcnos arcout idheads idtags
10560 foreach id [concat [array names idheads] [array names idtags]] {
10561 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10562 set a [lindex $arcnos($id) 0]
10563 if {![info exists donearc($a)]} {
10569 catch {unset cached_dtags}
10570 catch {unset cached_atags}
10571 catch {unset cached_dheads}
10574 proc rereadrefs {} {
10575 global idtags idheads idotherrefs mainheadid
10577 set refids [concat [array names idtags] \
10578 [array names idheads] [array names idotherrefs]]
10579 foreach id $refids {
10580 if {![info exists ref($id)]} {
10581 set ref($id) [listrefs $id]
10584 set oldmainhead $mainheadid
10587 set refids [lsort -unique [concat $refids [array names idtags] \
10588 [array names idheads] [array names idotherrefs]]]
10589 foreach id $refids {
10590 set v [listrefs $id]
10591 if {![info exists ref($id)] || $ref($id) != $v} {
10595 if {$oldmainhead ne $mainheadid} {
10596 redrawtags $oldmainhead
10597 redrawtags $mainheadid
10602 proc listrefs {id} {
10603 global idtags idheads idotherrefs
10606 if {[info exists idtags($id)]} {
10610 if {[info exists idheads($id)]} {
10611 set y $idheads($id)
10614 if {[info exists idotherrefs($id)]} {
10615 set z $idotherrefs($id)
10617 return [list $x $y $z]
10620 proc showtag {tag isnew} {
10621 global ctext tagcontents tagids linknum tagobjid
10624 addtohistory [list showtag $tag 0] savectextpos
10626 $ctext conf -state normal
10630 if {![info exists tagcontents($tag)]} {
10632 set tagcontents($tag) [exec git cat-file tag $tag]
10635 if {[info exists tagcontents($tag)]} {
10636 set text $tagcontents($tag)
10638 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10640 appendwithlinks $text {}
10641 maybe_scroll_ctext 1
10642 $ctext conf -state disabled
10654 if {[info exists gitktmpdir]} {
10655 catch {file delete -force $gitktmpdir}
10659 proc mkfontdisp {font top which} {
10660 global fontattr fontpref $font NS use_ttk
10662 set fontpref($font) [set $font]
10663 ${NS}::button $top.${font}but -text $which \
10664 -command [list choosefont $font $which]
10665 ${NS}::label $top.$font -relief flat -font $font \
10666 -text $fontattr($font,family) -justify left
10667 grid x $top.${font}but $top.$font -sticky w
10670 proc choosefont {font which} {
10671 global fontparam fontlist fonttop fontattr
10674 set fontparam(which) $which
10675 set fontparam(font) $font
10676 set fontparam(family) [font actual $font -family]
10677 set fontparam(size) $fontattr($font,size)
10678 set fontparam(weight) $fontattr($font,weight)
10679 set fontparam(slant) $fontattr($font,slant)
10682 if {![winfo exists $top]} {
10684 eval font config sample [font actual $font]
10686 make_transient $top $prefstop
10687 wm title $top [mc "Gitk font chooser"]
10688 ${NS}::label $top.l -textvariable fontparam(which)
10689 pack $top.l -side top
10690 set fontlist [lsort [font families]]
10691 ${NS}::frame $top.f
10692 listbox $top.f.fam -listvariable fontlist \
10693 -yscrollcommand [list $top.f.sb set]
10694 bind $top.f.fam <<ListboxSelect>> selfontfam
10695 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10696 pack $top.f.sb -side right -fill y
10697 pack $top.f.fam -side left -fill both -expand 1
10698 pack $top.f -side top -fill both -expand 1
10699 ${NS}::frame $top.g
10700 spinbox $top.g.size -from 4 -to 40 -width 4 \
10701 -textvariable fontparam(size) \
10702 -validatecommand {string is integer -strict %s}
10703 checkbutton $top.g.bold -padx 5 \
10704 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10705 -variable fontparam(weight) -onvalue bold -offvalue normal
10706 checkbutton $top.g.ital -padx 5 \
10707 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10708 -variable fontparam(slant) -onvalue italic -offvalue roman
10709 pack $top.g.size $top.g.bold $top.g.ital -side left
10710 pack $top.g -side top
10711 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10713 $top.c create text 100 25 -anchor center -text $which -font sample \
10714 -fill black -tags text
10715 bind $top.c <Configure> [list centertext $top.c]
10716 pack $top.c -side top -fill x
10717 ${NS}::frame $top.buts
10718 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10719 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10720 bind $top <Key-Return> fontok
10721 bind $top <Key-Escape> fontcan
10722 grid $top.buts.ok $top.buts.can
10723 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10724 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10725 pack $top.buts -side bottom -fill x
10726 trace add variable fontparam write chg_fontparam
10729 $top.c itemconf text -text $which
10731 set i [lsearch -exact $fontlist $fontparam(family)]
10733 $top.f.fam selection set $i
10738 proc centertext {w} {
10739 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10743 global fontparam fontpref prefstop
10745 set f $fontparam(font)
10746 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10747 if {$fontparam(weight) eq "bold"} {
10748 lappend fontpref($f) "bold"
10750 if {$fontparam(slant) eq "italic"} {
10751 lappend fontpref($f) "italic"
10754 $w conf -text $fontparam(family) -font $fontpref($f)
10760 global fonttop fontparam
10762 if {[info exists fonttop]} {
10763 catch {destroy $fonttop}
10764 catch {font delete sample}
10770 if {[package vsatisfies [package provide Tk] 8.6]} {
10771 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10772 # function to make use of it.
10773 proc choosefont {font which} {
10774 tk fontchooser configure -title $which -font $font \
10775 -command [list on_choosefont $font $which]
10776 tk fontchooser show
10778 proc on_choosefont {font which newfont} {
10780 puts stderr "$font $newfont"
10781 array set f [font actual $newfont]
10782 set fontparam(which) $which
10783 set fontparam(font) $font
10784 set fontparam(family) $f(-family)
10785 set fontparam(size) $f(-size)
10786 set fontparam(weight) $f(-weight)
10787 set fontparam(slant) $f(-slant)
10792 proc selfontfam {} {
10793 global fonttop fontparam
10795 set i [$fonttop.f.fam curselection]
10797 set fontparam(family) [$fonttop.f.fam get $i]
10801 proc chg_fontparam {v sub op} {
10804 font config sample -$sub $fontparam($sub)
10807 # Create a property sheet tab page
10808 proc create_prefs_page {w} {
10810 set parent [join [lrange [split $w .] 0 end-1] .]
10811 if {[winfo class $parent] eq "TNotebook"} {
10814 ${NS}::labelframe $w
10818 proc prefspage_general {notebook} {
10819 global NS maxwidth maxgraphpct showneartags showlocalchanges
10820 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10821 global hideremotes want_ttk have_ttk
10823 set page [create_prefs_page $notebook.general]
10825 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10826 grid $page.ldisp - -sticky w -pady 10
10827 ${NS}::label $page.spacer -text " "
10828 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10829 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10830 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10831 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10832 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10833 grid x $page.maxpctl $page.maxpct -sticky w
10834 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10835 -variable showlocalchanges
10836 grid x $page.showlocal -sticky w
10837 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10838 -variable autoselect
10839 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10840 grid x $page.autoselect $page.autosellen -sticky w
10841 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10842 -variable hideremotes
10843 grid x $page.hideremotes -sticky w
10845 ${NS}::label $page.ddisp -text [mc "Diff display options"]
10846 grid $page.ddisp - -sticky w -pady 10
10847 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10848 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10849 grid x $page.tabstopl $page.tabstop -sticky w
10850 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \
10851 -variable showneartags
10852 grid x $page.ntag -sticky w
10853 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10854 -variable limitdiffs
10855 grid x $page.ldiff -sticky w
10856 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10857 -variable perfile_attrs
10858 grid x $page.lattr -sticky w
10860 ${NS}::entry $page.extdifft -textvariable extdifftool
10861 ${NS}::frame $page.extdifff
10862 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10863 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10864 pack $page.extdifff.l $page.extdifff.b -side left
10865 pack configure $page.extdifff.l -padx 10
10866 grid x $page.extdifff $page.extdifft -sticky ew
10868 ${NS}::label $page.lgen -text [mc "General options"]
10869 grid $page.lgen - -sticky w -pady 10
10870 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10871 -text [mc "Use themed widgets"]
10873 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10875 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
10877 grid x $page.want_ttk $page.ttk_note -sticky w
10881 proc prefspage_colors {notebook} {
10882 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10884 set page [create_prefs_page $notebook.colors]
10886 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
10887 grid $page.cdisp - -sticky w -pady 10
10888 label $page.ui -padx 40 -relief sunk -background $uicolor
10889 ${NS}::button $page.uibut -text [mc "Interface"] \
10890 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
10891 grid x $page.uibut $page.ui -sticky w
10892 label $page.bg -padx 40 -relief sunk -background $bgcolor
10893 ${NS}::button $page.bgbut -text [mc "Background"] \
10894 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
10895 grid x $page.bgbut $page.bg -sticky w
10896 label $page.fg -padx 40 -relief sunk -background $fgcolor
10897 ${NS}::button $page.fgbut -text [mc "Foreground"] \
10898 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
10899 grid x $page.fgbut $page.fg -sticky w
10900 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10901 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
10902 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
10903 [list $ctext tag conf d0 -foreground]]
10904 grid x $page.diffoldbut $page.diffold -sticky w
10905 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10906 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
10907 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
10908 [list $ctext tag conf dresult -foreground]]
10909 grid x $page.diffnewbut $page.diffnew -sticky w
10910 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10911 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
10912 -command [list choosecolor diffcolors 2 $page.hunksep \
10913 [mc "diff hunk header"] \
10914 [list $ctext tag conf hunksep -foreground]]
10915 grid x $page.hunksepbut $page.hunksep -sticky w
10916 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
10917 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
10918 -command [list choosecolor markbgcolor {} $page.markbgsep \
10919 [mc "marked line background"] \
10920 [list $ctext tag conf omark -background]]
10921 grid x $page.markbgbut $page.markbgsep -sticky w
10922 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10923 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
10924 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
10925 grid x $page.selbgbut $page.selbgsep -sticky w
10929 proc prefspage_fonts {notebook} {
10931 set page [create_prefs_page $notebook.fonts]
10932 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
10933 grid $page.cfont - -sticky w -pady 10
10934 mkfontdisp mainfont $page [mc "Main font"]
10935 mkfontdisp textfont $page [mc "Diff display font"]
10936 mkfontdisp uifont $page [mc "User interface font"]
10941 global maxwidth maxgraphpct use_ttk NS
10942 global oldprefs prefstop showneartags showlocalchanges
10943 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10944 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10945 global hideremotes want_ttk have_ttk
10949 if {[winfo exists $top]} {
10953 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10954 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10955 set oldprefs($v) [set $v]
10958 wm title $top [mc "Gitk preferences"]
10959 make_transient $top .
10961 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
10962 set notebook [ttk::notebook $top.notebook]
10964 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
10967 lappend pages [prefspage_general $notebook] [mc "General"]
10968 lappend pages [prefspage_colors $notebook] [mc "Colors"]
10969 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
10970 foreach {page title} $pages {
10971 if {$use_notebook} {
10972 $notebook add $page -text $title
10974 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
10975 -text $title -command [list raise $page]]
10976 $page configure -text $title
10977 grid $btn -row 0 -column [incr col] -sticky w
10978 grid $page -row 1 -column 0 -sticky news -columnspan 100
10982 if {!$use_notebook} {
10983 grid columnconfigure $notebook 0 -weight 1
10984 grid rowconfigure $notebook 1 -weight 1
10985 raise [lindex $pages 0]
10988 grid $notebook -sticky news -padx 2 -pady 2
10989 grid rowconfigure $top 0 -weight 1
10990 grid columnconfigure $top 0 -weight 1
10992 ${NS}::frame $top.buts
10993 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10994 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10995 bind $top <Key-Return> prefsok
10996 bind $top <Key-Escape> prefscan
10997 grid $top.buts.ok $top.buts.can
10998 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10999 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11000 grid $top.buts - - -pady 10 -sticky ew
11001 grid columnconfigure $top 2 -weight 1
11002 bind $top <Visibility> [list focus $top.buts.ok]
11005 proc choose_extdiff {} {
11008 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11010 set extdifftool $prog
11014 proc choosecolor {v vi w x cmd} {
11017 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11018 -title [mc "Gitk: choose color for %s" $x]]
11019 if {$c eq {}} return
11020 $w conf -background $c
11025 proc setselbg {c} {
11026 global bglist cflist
11027 foreach w $bglist {
11028 $w configure -selectbackground $c
11030 $cflist tag configure highlight \
11031 -background [$cflist cget -selectbackground]
11032 allcanvs itemconf secsel -fill $c
11035 # This sets the background color and the color scheme for the whole UI.
11036 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11037 # if we don't specify one ourselves, which makes the checkbuttons and
11038 # radiobuttons look bad. This chooses white for selectColor if the
11039 # background color is light, or black if it is dark.
11041 if {[tk windowingsystem] eq "win32"} { return }
11042 set bg [winfo rgb . $c]
11044 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11047 tk_setPalette background $c selectColor $selc
11053 foreach w $bglist {
11054 $w conf -background $c
11061 foreach w $fglist {
11062 $w conf -foreground $c
11064 allcanvs itemconf text -fill $c
11065 $canv itemconf circle -outline $c
11066 $canv itemconf markid -outline $c
11070 global oldprefs prefstop
11072 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11073 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11075 set $v $oldprefs($v)
11077 catch {destroy $prefstop}
11083 global maxwidth maxgraphpct
11084 global oldprefs prefstop showneartags showlocalchanges
11085 global fontpref mainfont textfont uifont
11086 global limitdiffs treediffs perfile_attrs
11089 catch {destroy $prefstop}
11093 if {$mainfont ne $fontpref(mainfont)} {
11094 set mainfont $fontpref(mainfont)
11095 parsefont mainfont $mainfont
11096 eval font configure mainfont [fontflags mainfont]
11097 eval font configure mainfontbold [fontflags mainfont 1]
11101 if {$textfont ne $fontpref(textfont)} {
11102 set textfont $fontpref(textfont)
11103 parsefont textfont $textfont
11104 eval font configure textfont [fontflags textfont]
11105 eval font configure textfontbold [fontflags textfont 1]
11107 if {$uifont ne $fontpref(uifont)} {
11108 set uifont $fontpref(uifont)
11109 parsefont uifont $uifont
11110 eval font configure uifont [fontflags uifont]
11113 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11114 if {$showlocalchanges} {
11120 if {$limitdiffs != $oldprefs(limitdiffs) ||
11121 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11122 # treediffs elements are limited by path;
11123 # won't have encodings cached if perfile_attrs was just turned on
11124 catch {unset treediffs}
11126 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11127 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11129 } elseif {$showneartags != $oldprefs(showneartags) ||
11130 $limitdiffs != $oldprefs(limitdiffs)} {
11133 if {$hideremotes != $oldprefs(hideremotes)} {
11138 proc formatdate {d} {
11139 global datetimeformat
11141 set d [clock format [lindex $d 0] -format $datetimeformat]
11146 # This list of encoding names and aliases is distilled from
11147 # http://www.iana.org/assignments/character-sets.
11148 # Not all of them are supported by Tcl.
11149 set encoding_aliases {
11150 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11151 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11152 { ISO-10646-UTF-1 csISO10646UTF1 }
11153 { ISO_646.basic:1983 ref csISO646basic1983 }
11154 { INVARIANT csINVARIANT }
11155 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11156 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11157 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11158 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11159 { NATS-DANO iso-ir-9-1 csNATSDANO }
11160 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11161 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11162 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11163 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11164 { ISO-2022-KR csISO2022KR }
11166 { ISO-2022-JP csISO2022JP }
11167 { ISO-2022-JP-2 csISO2022JP2 }
11168 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11169 csISO13JISC6220jp }
11170 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11171 { IT iso-ir-15 ISO646-IT csISO15Italian }
11172 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11173 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11174 { greek7-old iso-ir-18 csISO18Greek7Old }
11175 { latin-greek iso-ir-19 csISO19LatinGreek }
11176 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11177 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11178 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11179 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11180 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11181 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11182 { INIS iso-ir-49 csISO49INIS }
11183 { INIS-8 iso-ir-50 csISO50INIS8 }
11184 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11185 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11186 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11187 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11188 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11189 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11190 csISO60Norwegian1 }
11191 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11192 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11193 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11194 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11195 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11196 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11197 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11198 { greek7 iso-ir-88 csISO88Greek7 }
11199 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11200 { iso-ir-90 csISO90 }
11201 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11202 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11203 csISO92JISC62991984b }
11204 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11205 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11206 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11207 csISO95JIS62291984handadd }
11208 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11209 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11210 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11211 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11212 CP819 csISOLatin1 }
11213 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11214 { T.61-7bit iso-ir-102 csISO102T617bit }
11215 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11216 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11217 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11218 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11219 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11220 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11221 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11222 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11223 arabic csISOLatinArabic }
11224 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11225 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11226 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11227 greek greek8 csISOLatinGreek }
11228 { T.101-G2 iso-ir-128 csISO128T101G2 }
11229 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11231 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11232 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11233 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11234 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11235 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11236 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11237 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11238 csISOLatinCyrillic }
11239 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11240 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11241 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11242 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11243 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11244 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11245 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11246 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11247 { ISO_10367-box iso-ir-155 csISO10367Box }
11248 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11249 { latin-lap lap iso-ir-158 csISO158Lap }
11250 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11251 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11254 { JIS_X0201 X0201 csHalfWidthKatakana }
11255 { KSC5636 ISO646-KR csKSC5636 }
11256 { ISO-10646-UCS-2 csUnicode }
11257 { ISO-10646-UCS-4 csUCS4 }
11258 { DEC-MCS dec csDECMCS }
11259 { hp-roman8 roman8 r8 csHPRoman8 }
11260 { macintosh mac csMacintosh }
11261 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11263 { IBM038 EBCDIC-INT cp038 csIBM038 }
11264 { IBM273 CP273 csIBM273 }
11265 { IBM274 EBCDIC-BE CP274 csIBM274 }
11266 { IBM275 EBCDIC-BR cp275 csIBM275 }
11267 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11268 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11269 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11270 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11271 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11272 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11273 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11274 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11275 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11276 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11277 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11278 { IBM437 cp437 437 csPC8CodePage437 }
11279 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11280 { IBM775 cp775 csPC775Baltic }
11281 { IBM850 cp850 850 csPC850Multilingual }
11282 { IBM851 cp851 851 csIBM851 }
11283 { IBM852 cp852 852 csPCp852 }
11284 { IBM855 cp855 855 csIBM855 }
11285 { IBM857 cp857 857 csIBM857 }
11286 { IBM860 cp860 860 csIBM860 }
11287 { IBM861 cp861 861 cp-is csIBM861 }
11288 { IBM862 cp862 862 csPC862LatinHebrew }
11289 { IBM863 cp863 863 csIBM863 }
11290 { IBM864 cp864 csIBM864 }
11291 { IBM865 cp865 865 csIBM865 }
11292 { IBM866 cp866 866 csIBM866 }
11293 { IBM868 CP868 cp-ar csIBM868 }
11294 { IBM869 cp869 869 cp-gr csIBM869 }
11295 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11296 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11297 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11298 { IBM891 cp891 csIBM891 }
11299 { IBM903 cp903 csIBM903 }
11300 { IBM904 cp904 904 csIBBM904 }
11301 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11302 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11303 { IBM1026 CP1026 csIBM1026 }
11304 { EBCDIC-AT-DE csIBMEBCDICATDE }
11305 { EBCDIC-AT-DE-A csEBCDICATDEA }
11306 { EBCDIC-CA-FR csEBCDICCAFR }
11307 { EBCDIC-DK-NO csEBCDICDKNO }
11308 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11309 { EBCDIC-FI-SE csEBCDICFISE }
11310 { EBCDIC-FI-SE-A csEBCDICFISEA }
11311 { EBCDIC-FR csEBCDICFR }
11312 { EBCDIC-IT csEBCDICIT }
11313 { EBCDIC-PT csEBCDICPT }
11314 { EBCDIC-ES csEBCDICES }
11315 { EBCDIC-ES-A csEBCDICESA }
11316 { EBCDIC-ES-S csEBCDICESS }
11317 { EBCDIC-UK csEBCDICUK }
11318 { EBCDIC-US csEBCDICUS }
11319 { UNKNOWN-8BIT csUnknown8BiT }
11320 { MNEMONIC csMnemonic }
11322 { VISCII csVISCII }
11325 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11326 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11327 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11328 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11329 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11330 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11331 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11332 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11333 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11334 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11335 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11336 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11337 { IBM1047 IBM-1047 }
11338 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11339 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11340 { UNICODE-1-1 csUnicode11 }
11341 { CESU-8 csCESU-8 }
11342 { BOCU-1 csBOCU-1 }
11343 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11344 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11346 { ISO-8859-15 ISO_8859-15 Latin-9 }
11347 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11348 { GBK CP936 MS936 windows-936 }
11349 { JIS_Encoding csJISEncoding }
11350 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11351 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11353 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11354 { ISO-10646-UCS-Basic csUnicodeASCII }
11355 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11356 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11357 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11358 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11359 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11360 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11361 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11362 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11363 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11364 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11365 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11366 { Ventura-US csVenturaUS }
11367 { Ventura-International csVenturaInternational }
11368 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11369 { PC8-Turkish csPC8Turkish }
11370 { IBM-Symbols csIBMSymbols }
11371 { IBM-Thai csIBMThai }
11372 { HP-Legal csHPLegal }
11373 { HP-Pi-font csHPPiFont }
11374 { HP-Math8 csHPMath8 }
11375 { Adobe-Symbol-Encoding csHPPSMath }
11376 { HP-DeskTop csHPDesktop }
11377 { Ventura-Math csVenturaMath }
11378 { Microsoft-Publishing csMicrosoftPublishing }
11379 { Windows-31J csWindows31J }
11380 { GB2312 csGB2312 }
11384 proc tcl_encoding {enc} {
11385 global encoding_aliases tcl_encoding_cache
11386 if {[info exists tcl_encoding_cache($enc)]} {
11387 return $tcl_encoding_cache($enc)
11389 set names [encoding names]
11390 set lcnames [string tolower $names]
11391 set enc [string tolower $enc]
11392 set i [lsearch -exact $lcnames $enc]
11394 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11395 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11396 set i [lsearch -exact $lcnames $encx]
11400 foreach l $encoding_aliases {
11401 set ll [string tolower $l]
11402 if {[lsearch -exact $ll $enc] < 0} continue
11403 # look through the aliases for one that tcl knows about
11405 set i [lsearch -exact $lcnames $e]
11407 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11408 set i [lsearch -exact $lcnames $ex]
11418 set tclenc [lindex $names $i]
11420 set tcl_encoding_cache($enc) $tclenc
11424 proc gitattr {path attr default} {
11425 global path_attr_cache
11426 if {[info exists path_attr_cache($attr,$path)]} {
11427 set r $path_attr_cache($attr,$path)
11429 set r "unspecified"
11430 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11431 regexp "(.*): $attr: (.*)" $line m f r
11433 set path_attr_cache($attr,$path) $r
11435 if {$r eq "unspecified"} {
11441 proc cache_gitattr {attr pathlist} {
11442 global path_attr_cache
11444 foreach path $pathlist {
11445 if {![info exists path_attr_cache($attr,$path)]} {
11446 lappend newlist $path
11450 if {[tk windowingsystem] == "win32"} {
11451 # windows has a 32k limit on the arguments to a command...
11454 while {$newlist ne {}} {
11455 set head [lrange $newlist 0 [expr {$lim - 1}]]
11456 set newlist [lrange $newlist $lim end]
11457 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11458 foreach row [split $rlist "\n"] {
11459 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11460 if {[string index $path 0] eq "\""} {
11461 set path [encoding convertfrom [lindex $path 0]]
11463 set path_attr_cache($attr,$path) $value
11470 proc get_path_encoding {path} {
11471 global gui_encoding perfile_attrs
11472 set tcl_enc $gui_encoding
11473 if {$path ne {} && $perfile_attrs} {
11474 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11482 # First check that Tcl/Tk is recent enough
11483 if {[catch {package require Tk 8.4} err]} {
11484 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11485 Gitk requires at least Tcl/Tk 8.4." list
11490 set wrcomcmd "git diff-tree --stdin -p --pretty"
11494 set gitencoding [exec git config --get i18n.commitencoding]
11497 set gitencoding [exec git config --get i18n.logoutputencoding]
11499 if {$gitencoding == ""} {
11500 set gitencoding "utf-8"
11502 set tclencoding [tcl_encoding $gitencoding]
11503 if {$tclencoding == {}} {
11504 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11507 set gui_encoding [encoding system]
11509 set enc [exec git config --get gui.encoding]
11511 set tclenc [tcl_encoding $enc]
11512 if {$tclenc ne {}} {
11513 set gui_encoding $tclenc
11515 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11520 if {[tk windowingsystem] eq "aqua"} {
11521 set mainfont {{Lucida Grande} 9}
11522 set textfont {Monaco 9}
11523 set uifont {{Lucida Grande} 9 bold}
11524 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11526 set mainfont {sans 9}
11527 set textfont {monospace 9}
11528 set uifont {sans 9 bold}
11530 set mainfont {Helvetica 9}
11531 set textfont {Courier 9}
11532 set uifont {Helvetica 9 bold}
11535 set findmergefiles 0
11543 set cmitmode "patch"
11544 set wrapcomment "none"
11549 set showlocalchanges 1
11551 set datetimeformat "%Y-%m-%d %H:%M:%S"
11554 set perfile_attrs 0
11557 if {[tk windowingsystem] eq "aqua"} {
11558 set extdifftool "opendiff"
11560 set extdifftool "meld"
11563 set colors {green red blue magenta darkgrey brown orange}
11564 if {[tk windowingsystem] eq "win32"} {
11565 set uicolor SystemButtonFace
11566 set bgcolor SystemWindow
11567 set fgcolor SystemButtonText
11568 set selectbgcolor SystemHighlight
11573 set selectbgcolor gray85
11575 set diffcolors {red "#00a000" blue}
11579 set markbgcolor "#e0e0ff"
11581 set circlecolors {white blue gray blue blue}
11583 # button for popping up context menus
11584 if {[tk windowingsystem] eq "aqua"} {
11585 set ctxbut <Button-2>
11587 set ctxbut <Button-3>
11590 ## For msgcat loading, first locate the installation location.
11591 if { [info exists ::env(GITK_MSGSDIR)] } {
11592 ## Msgsdir was manually set in the environment.
11593 set gitk_msgsdir $::env(GITK_MSGSDIR)
11595 ## Let's guess the prefix from argv0.
11596 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11597 set gitk_libdir [file join $gitk_prefix share gitk lib]
11598 set gitk_msgsdir [file join $gitk_libdir msgs]
11602 ## Internationalization (i18n) through msgcat and gettext. See
11603 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11604 package require msgcat
11605 namespace import ::msgcat::mc
11606 ## And eventually load the actual message catalog
11607 ::msgcat::mcload $gitk_msgsdir
11609 catch {source ~/.gitk}
11611 parsefont mainfont $mainfont
11612 eval font create mainfont [fontflags mainfont]
11613 eval font create mainfontbold [fontflags mainfont 1]
11615 parsefont textfont $textfont
11616 eval font create textfont [fontflags textfont]
11617 eval font create textfontbold [fontflags textfont 1]
11619 parsefont uifont $uifont
11620 eval font create uifont [fontflags uifont]
11626 # check that we can find a .git directory somewhere...
11627 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11628 show_error {} . [mc "Cannot find a git repository here."]
11633 set selectheadid {}
11636 set cmdline_files {}
11638 set revtreeargscmd {}
11639 foreach arg $argv {
11640 switch -glob -- $arg {
11643 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11646 "--select-commit=*" {
11647 set selecthead [string range $arg 16 end]
11650 set revtreeargscmd [string range $arg 10 end]
11653 lappend revtreeargs $arg
11659 if {$selecthead eq "HEAD"} {
11663 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11664 # no -- on command line, but some arguments (other than --argscmd)
11666 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11667 set cmdline_files [split $f "\n"]
11668 set n [llength $cmdline_files]
11669 set revtreeargs [lrange $revtreeargs 0 end-$n]
11670 # Unfortunately git rev-parse doesn't produce an error when
11671 # something is both a revision and a filename. To be consistent
11672 # with git log and git rev-list, check revtreeargs for filenames.
11673 foreach arg $revtreeargs {
11674 if {[file exists $arg]} {
11675 show_error {} . [mc "Ambiguous argument '%s': both revision\
11676 and filename" $arg]
11681 # unfortunately we get both stdout and stderr in $err,
11682 # so look for "fatal:".
11683 set i [string first "fatal:" $err]
11685 set err [string range $err [expr {$i + 6}] end]
11687 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11692 set nullid "0000000000000000000000000000000000000000"
11693 set nullid2 "0000000000000000000000000000000000000001"
11694 set nullfile "/dev/null"
11696 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11697 if {![info exists have_ttk]} {
11698 set have_ttk [llength [info commands ::ttk::style]]
11700 set use_ttk [expr {$have_ttk && $want_ttk}]
11701 set NS [expr {$use_ttk ? "ttk" : ""}]
11703 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11706 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11707 set show_notes "--show-notes"
11717 set highlight_paths {}
11719 set searchdirn -forwards
11722 set diffelide {0 0}
11723 set markingmatches 0
11724 set linkentercount 0
11725 set need_redisplay 0
11732 set selectedhlview [mc "None"]
11733 set highlight_related [mc "None"]
11734 set highlight_files {}
11735 set viewfiles(0) {}
11738 set viewargscmd(0) {}
11740 set selectedline {}
11748 set hasworktree [hasworktree]
11750 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11751 set cdup [exec git rev-parse --show-cdup]
11753 set worktree [exec git rev-parse --show-toplevel]
11757 image create photo gitlogo -width 16 -height 16
11759 image create photo gitlogominus -width 4 -height 2
11760 gitlogominus put #C00000 -to 0 0 4 2
11761 gitlogo copy gitlogominus -to 1 5
11762 gitlogo copy gitlogominus -to 6 5
11763 gitlogo copy gitlogominus -to 11 5
11764 image delete gitlogominus
11766 image create photo gitlogoplus -width 4 -height 4
11767 gitlogoplus put #008000 -to 1 0 3 4
11768 gitlogoplus put #008000 -to 0 1 4 3
11769 gitlogo copy gitlogoplus -to 1 9
11770 gitlogo copy gitlogoplus -to 6 9
11771 gitlogo copy gitlogoplus -to 11 9
11772 image delete gitlogoplus
11774 image create photo gitlogo32 -width 32 -height 32
11775 gitlogo32 copy gitlogo -zoom 2 2
11777 wm iconphoto . -default gitlogo gitlogo32
11779 # wait for the window to become visible
11780 tkwait visibility .
11781 wm title . "$appname: [reponame]"
11785 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11786 # create a view for the files/dirs specified on the command line
11790 set viewname(1) [mc "Command line"]
11791 set viewfiles(1) $cmdline_files
11792 set viewargs(1) $revtreeargs
11793 set viewargscmd(1) $revtreeargscmd
11797 .bar.view entryconf [mca "Edit view..."] -state normal
11798 .bar.view entryconf [mca "Delete view"] -state normal
11801 if {[info exists permviews]} {
11802 foreach v $permviews {
11805 set viewname($n) [lindex $v 0]
11806 set viewfiles($n) [lindex $v 1]
11807 set viewargs($n) [lindex $v 2]
11808 set viewargscmd($n) [lindex $v 3]
11814 if {[tk windowingsystem] eq "win32"} {
11822 # indent-tabs-mode: t