2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright © 2005-2016 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
160 global worddiff git_version
164 set vinlinediff($n) 0
169 set origargs $arglist
173 foreach arg $arglist {
180 switch -glob -- $arg {
184 # remove from origargs in case we hit an unknown option
185 set origargs [lreplace $origargs $i $i]
189 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
190 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
191 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
192 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
193 "--ignore-space-change" - "-U*" - "--unified=*" {
194 # These request or affect diff output, which we don't want.
195 # Some could be used to set our defaults for diff display.
196 lappend diffargs
$arg
198 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
199 "--name-only" - "--name-status" - "--color" -
200 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
201 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
202 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
203 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
204 "--objects" - "--objects-edge" - "--reverse" {
205 # These cause our parsing of git log's output to fail, or else
206 # they're options we want to set ourselves, so ignore them.
208 "--color-words*" - "--word-diff=color" {
209 # These trigger a word diff in the console interface,
210 # so help the user by enabling our own support
211 if {[package vcompare
$git_version "1.7.2"] >= 0} {
212 set worddiff
[mc
"Color words"]
216 if {[package vcompare
$git_version "1.7.2"] >= 0} {
217 set worddiff
[mc
"Markup words"]
220 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
221 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
222 "--full-history" - "--dense" - "--sparse" -
223 "--follow" - "--left-right" - "--encoding=*" {
224 # These are harmless, and some are even useful
227 "--diff-filter=*" - "--no-merges" - "--unpacked" -
228 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
229 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
230 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
231 "--remove-empty" - "--first-parent" - "--cherry-pick" -
232 "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
233 "--simplify-by-decoration" {
234 # These mean that we get a subset of the commits
239 # Line-log with 'stuck' argument (unstuck form is
242 set vinlinediff
($n) 1
247 # This appears to be the only one that has a value as a
248 # separate word following it
258 # git rev-parse doesn't understand --merge
259 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
261 "--no-replace-objects" {
262 set env
(GIT_NO_REPLACE_OBJECTS
) "1"
265 # Other flag arguments including -<n>
266 if {[string is digit
-strict [string range
$arg 1 end
]]} {
269 # a flag argument that we don't recognize;
270 # that means we can't optimize
276 # Non-flag arguments specify commits or ranges of commits
277 if {[string match
"*...*" $arg]} {
278 lappend revargs
--gitk-symmetric-diff-marker
284 set vdflags
($n) $diffargs
285 set vflags
($n) $glflags
286 set vrevs
($n) $revargs
287 set vfiltered
($n) $filtered
288 set vorigargs
($n) $origargs
292 proc parseviewrevs
{view revs
} {
293 global vposids vnegids
297 } elseif
{[lsearch
-exact $revs --all] >= 0} {
300 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
301 # we get stdout followed by stderr in $err
302 # for an unknown rev, git rev-parse echoes it and then errors out
303 set errlines
[split $err "\n"]
305 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
306 set line
[lindex
$errlines $l]
307 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
308 if {[string match
"fatal:*" $line]} {
309 if {[string match
"fatal: ambiguous argument*" $line]
311 if {[llength
$badrev] == 1} {
312 set err
"unknown revision $badrev"
314 set err
"unknown revisions: [join $badrev ", "]"
317 set err
[join [lrange
$errlines $l end
] "\n"]
324 error_popup
"[mc "Error parsing revisions
:"] $err"
331 foreach id
[split $ids "\n"] {
332 if {$id eq
"--gitk-symmetric-diff-marker"} {
334 } elseif
{[string match
"^*" $id]} {
341 lappend neg
[string range
$id 1 end
]
346 lset ret end
$id...
[lindex
$ret end
]
352 set vposids
($view) $pos
353 set vnegids
($view) $neg
357 # Start off a git log process and arrange to read its output
358 proc start_rev_list
{view
} {
359 global startmsecs commitidx viewcomplete curview
361 global viewargs viewargscmd viewfiles vfilelimit
362 global showlocalchanges
363 global viewactive viewinstances vmergeonly
364 global mainheadid viewmainheadid viewmainheadid_orig
365 global vcanopt vflags vrevs vorigargs
368 set startmsecs
[clock clicks
-milliseconds]
369 set commitidx
($view) 0
370 # these are set this way for the error exits
371 set viewcomplete
($view) 1
372 set viewactive
($view) 0
375 set args
$viewargs($view)
376 if {$viewargscmd($view) ne
{}} {
378 set str
[exec sh
-c $viewargscmd($view)]
380 error_popup
"[mc "Error executing
--argscmd command:"] $err"
383 set args
[concat
$args [split $str "\n"]]
385 set vcanopt
($view) [parseviewargs
$view $args]
387 set files
$viewfiles($view)
388 if {$vmergeonly($view)} {
389 set files
[unmerged_files
$files]
392 if {$nr_unmerged == 0} {
393 error_popup
[mc
"No files selected: --merge specified but\
394 no files are unmerged."]
396 error_popup
[mc
"No files selected: --merge specified but\
397 no unmerged files are within file limit."]
402 set vfilelimit
($view) $files
404 if {$vcanopt($view)} {
405 set revs
[parseviewrevs
$view $vrevs($view)]
409 set args
[concat
$vflags($view) $revs]
411 set args
$vorigargs($view)
415 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
416 --parents --boundary $args "--" $files] r
]
418 error_popup
"[mc "Error executing git log
:"] $err"
421 set i
[reg_instance
$fd]
422 set viewinstances
($view) [list
$i]
423 set viewmainheadid
($view) $mainheadid
424 set viewmainheadid_orig
($view) $mainheadid
425 if {$files ne
{} && $mainheadid ne
{}} {
426 get_viewmainhead
$view
428 if {$showlocalchanges && $viewmainheadid($view) ne
{}} {
429 interestedin
$viewmainheadid($view) dodiffindex
431 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
432 if {$tclencoding != {}} {
433 fconfigure
$fd -encoding $tclencoding
435 filerun
$fd [list getcommitlines
$fd $i $view 0]
436 nowbusy
$view [mc
"Reading"]
437 set viewcomplete
($view) 0
438 set viewactive
($view) 1
442 proc stop_instance
{inst
} {
443 global commfd leftover
445 set fd
$commfd($inst)
449 if {$
::tcl_platform
(platform
) eq
{windows
}} {
450 exec taskkill
/pid
$pid
458 unset leftover
($inst)
461 proc stop_backends
{} {
464 foreach inst
[array names commfd
] {
469 proc stop_rev_list
{view
} {
472 foreach inst
$viewinstances($view) {
475 set viewinstances
($view) {}
478 proc reset_pending_select
{selid
} {
479 global pending_select mainheadid selectheadid
482 set pending_select
$selid
483 } elseif
{$selectheadid ne
{}} {
484 set pending_select
$selectheadid
486 set pending_select
$mainheadid
490 proc getcommits
{selid
} {
491 global canv curview need_redisplay viewactive
494 if {[start_rev_list
$curview]} {
495 reset_pending_select
$selid
496 show_status
[mc
"Reading commits..."]
499 show_status
[mc
"No commits selected"]
503 proc updatecommits
{} {
504 global curview vcanopt vorigargs vfilelimit viewinstances
505 global viewactive viewcomplete tclencoding
506 global startmsecs showneartags showlocalchanges
507 global mainheadid viewmainheadid viewmainheadid_orig pending_select
509 global varcid vposids vnegids vflags vrevs
512 set hasworktree
[hasworktree
]
515 if {$mainheadid ne
$viewmainheadid_orig($view)} {
516 if {$showlocalchanges} {
519 set viewmainheadid
($view) $mainheadid
520 set viewmainheadid_orig
($view) $mainheadid
521 if {$vfilelimit($view) ne
{}} {
522 get_viewmainhead
$view
525 if {$showlocalchanges} {
528 if {$vcanopt($view)} {
529 set oldpos
$vposids($view)
530 set oldneg
$vnegids($view)
531 set revs
[parseviewrevs
$view $vrevs($view)]
535 # note: getting the delta when negative refs change is hard,
536 # and could require multiple git log invocations, so in that
537 # case we ask git log for all the commits (not just the delta)
538 if {$oldneg eq
$vnegids($view)} {
541 # take out positive refs that we asked for before or
542 # that we have already seen
544 if {[string length
$rev] == 40} {
545 if {[lsearch
-exact $oldpos $rev] < 0
546 && ![info exists varcid
($view,$rev)]} {
551 lappend
$newrevs $rev
554 if {$npos == 0} return
556 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
558 set args
[concat
$vflags($view) $revs --not $oldpos]
560 set args
$vorigargs($view)
563 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
564 --parents --boundary $args "--" $vfilelimit($view)] r
]
566 error_popup
"[mc "Error executing git log
:"] $err"
569 if {$viewactive($view) == 0} {
570 set startmsecs
[clock clicks
-milliseconds]
572 set i
[reg_instance
$fd]
573 lappend viewinstances
($view) $i
574 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
575 if {$tclencoding != {}} {
576 fconfigure
$fd -encoding $tclencoding
578 filerun
$fd [list getcommitlines
$fd $i $view 1]
579 incr viewactive
($view)
580 set viewcomplete
($view) 0
581 reset_pending_select
{}
582 nowbusy
$view [mc
"Reading"]
588 proc reloadcommits
{} {
589 global curview viewcomplete selectedline currentid thickerline
590 global showneartags treediffs commitinterest cached_commitrow
591 global targetid commitinfo
594 if {$selectedline ne
{}} {
598 if {!$viewcomplete($curview)} {
599 stop_rev_list
$curview
603 unset -nocomplain currentid
604 unset -nocomplain thickerline
605 unset -nocomplain treediffs
612 unset -nocomplain commitinfo
613 unset -nocomplain commitinterest
614 unset -nocomplain cached_commitrow
615 unset -nocomplain targetid
621 # This makes a string representation of a positive integer which
622 # sorts as a string in numerical order
625 return [format
"%x" $n]
626 } elseif
{$n < 256} {
627 return [format
"x%.2x" $n]
628 } elseif
{$n < 65536} {
629 return [format
"y%.4x" $n]
631 return [format
"z%.8x" $n]
634 # Procedures used in reordering commits from git log (without
635 # --topo-order) into the order for display.
637 proc varcinit
{view
} {
638 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
639 global vtokmod varcmod vrowmod varcix vlastins
641 set varcstart
($view) {{}}
642 set vupptr
($view) {0}
643 set vdownptr
($view) {0}
644 set vleftptr
($view) {0}
645 set vbackptr
($view) {0}
646 set varctok
($view) {{}}
647 set varcrow
($view) {{}}
648 set vtokmod
($view) {}
651 set varcix
($view) {{}}
652 set vlastins
($view) {0}
655 proc resetvarcs
{view
} {
656 global varcid varccommits parents children vseedcount ordertok
659 foreach vid
[array names varcid
$view,*] {
664 foreach vid
[array names vshortids
$view,*] {
665 unset vshortids
($vid)
667 # some commits might have children but haven't been seen yet
668 foreach vid
[array names children
$view,*] {
671 foreach va
[array names varccommits
$view,*] {
672 unset varccommits
($va)
674 foreach vd
[array names vseedcount
$view,*] {
675 unset vseedcount
($vd)
677 unset -nocomplain ordertok
680 # returns a list of the commits with no children
682 global vdownptr vleftptr varcstart
685 set a
[lindex
$vdownptr($v) 0]
687 lappend ret
[lindex
$varcstart($v) $a]
688 set a
[lindex
$vleftptr($v) $a]
693 proc newvarc
{view id
} {
694 global varcid varctok parents children vdatemode
695 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
696 global commitdata commitinfo vseedcount varccommits vlastins
698 set a
[llength
$varctok($view)]
700 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
701 if {![info exists commitinfo
($id)]} {
702 parsecommit
$id $commitdata($id) 1
704 set cdate
[lindex
[lindex
$commitinfo($id) 4] 0]
705 if {![string is integer
-strict $cdate]} {
708 if {![info exists vseedcount
($view,$cdate)]} {
709 set vseedcount
($view,$cdate) -1
711 set c
[incr vseedcount
($view,$cdate)]
712 set cdate
[expr {$cdate ^
0xffffffff}]
713 set tok
"s[strrep $cdate][strrep $c]"
718 if {[llength
$children($vid)] > 0} {
719 set kid
[lindex
$children($vid) end
]
720 set k
$varcid($view,$kid)
721 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
724 set tok
[lindex
$varctok($view) $k]
728 set i
[lsearch
-exact $parents($view,$ki) $id]
729 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
730 append tok
[strrep
$j]
732 set c
[lindex
$vlastins($view) $ka]
733 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
735 set b
[lindex
$vdownptr($view) $ka]
737 set b
[lindex
$vleftptr($view) $c]
739 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
741 set b
[lindex
$vleftptr($view) $c]
744 lset vdownptr
($view) $ka $a
745 lappend vbackptr
($view) 0
747 lset vleftptr
($view) $c $a
748 lappend vbackptr
($view) $c
750 lset vlastins
($view) $ka $a
751 lappend vupptr
($view) $ka
752 lappend vleftptr
($view) $b
754 lset vbackptr
($view) $b $a
756 lappend varctok
($view) $tok
757 lappend varcstart
($view) $id
758 lappend vdownptr
($view) 0
759 lappend varcrow
($view) {}
760 lappend varcix
($view) {}
761 set varccommits
($view,$a) {}
762 lappend vlastins
($view) 0
766 proc splitvarc
{p v
} {
767 global varcid varcstart varccommits varctok vtokmod
768 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
770 set oa
$varcid($v,$p)
771 set otok
[lindex
$varctok($v) $oa]
772 set ac
$varccommits($v,$oa)
773 set i
[lsearch
-exact $varccommits($v,$oa) $p]
775 set na
[llength
$varctok($v)]
776 # "%" sorts before "0"...
777 set tok
"$otok%[strrep $i]"
778 lappend varctok
($v) $tok
779 lappend varcrow
($v) {}
780 lappend varcix
($v) {}
781 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
782 set varccommits
($v,$na) [lrange
$ac $i end
]
783 lappend varcstart
($v) $p
784 foreach id
$varccommits($v,$na) {
785 set varcid
($v,$id) $na
787 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
788 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
789 lset vdownptr
($v) $oa $na
790 lset vlastins
($v) $oa 0
791 lappend vupptr
($v) $oa
792 lappend vleftptr
($v) 0
793 lappend vbackptr
($v) 0
794 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
795 lset vupptr
($v) $b $na
797 if {[string compare
$otok $vtokmod($v)] <= 0} {
802 proc renumbervarc
{a v
} {
803 global parents children varctok varcstart varccommits
804 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
806 set t1
[clock clicks
-milliseconds]
812 if {[info exists isrelated
($a)]} {
814 set id
[lindex
$varccommits($v,$a) end
]
815 foreach p
$parents($v,$id) {
816 if {[info exists varcid
($v,$p)]} {
817 set isrelated
($varcid($v,$p)) 1
822 set b
[lindex
$vdownptr($v) $a]
825 set b
[lindex
$vleftptr($v) $a]
827 set a
[lindex
$vupptr($v) $a]
833 if {![info exists kidchanged
($a)]} continue
834 set id
[lindex
$varcstart($v) $a]
835 if {[llength
$children($v,$id)] > 1} {
836 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
839 set oldtok
[lindex
$varctok($v) $a]
840 if {!$vdatemode($v)} {
846 set kid
[last_real_child
$v,$id]
848 set k
$varcid($v,$kid)
849 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
852 set tok
[lindex
$varctok($v) $k]
856 set i
[lsearch
-exact $parents($v,$ki) $id]
857 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
858 append tok
[strrep
$j]
860 if {$tok eq
$oldtok} {
863 set id
[lindex
$varccommits($v,$a) end
]
864 foreach p
$parents($v,$id) {
865 if {[info exists varcid
($v,$p)]} {
866 set kidchanged
($varcid($v,$p)) 1
871 lset varctok
($v) $a $tok
872 set b
[lindex
$vupptr($v) $a]
874 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
877 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
880 set c
[lindex
$vbackptr($v) $a]
881 set d
[lindex
$vleftptr($v) $a]
883 lset vdownptr
($v) $b $d
885 lset vleftptr
($v) $c $d
888 lset vbackptr
($v) $d $c
890 if {[lindex
$vlastins($v) $b] == $a} {
891 lset vlastins
($v) $b $c
893 lset vupptr
($v) $a $ka
894 set c
[lindex
$vlastins($v) $ka]
896 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
898 set b
[lindex
$vdownptr($v) $ka]
900 set b
[lindex
$vleftptr($v) $c]
903 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
905 set b
[lindex
$vleftptr($v) $c]
908 lset vdownptr
($v) $ka $a
909 lset vbackptr
($v) $a 0
911 lset vleftptr
($v) $c $a
912 lset vbackptr
($v) $a $c
914 lset vleftptr
($v) $a $b
916 lset vbackptr
($v) $b $a
918 lset vlastins
($v) $ka $a
921 foreach id
[array names sortkids
] {
922 if {[llength
$children($v,$id)] > 1} {
923 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
927 set t2
[clock clicks
-milliseconds]
928 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
931 # Fix up the graph after we have found out that in view $v,
932 # $p (a commit that we have already seen) is actually the parent
933 # of the last commit in arc $a.
934 proc fix_reversal
{p a v
} {
935 global varcid varcstart varctok vupptr
937 set pa
$varcid($v,$p)
938 if {$p ne
[lindex
$varcstart($v) $pa]} {
940 set pa
$varcid($v,$p)
942 # seeds always need to be renumbered
943 if {[lindex
$vupptr($v) $pa] == 0 ||
944 [string compare
[lindex
$varctok($v) $a] \
945 [lindex
$varctok($v) $pa]] > 0} {
950 proc insertrow
{id p v
} {
951 global cmitlisted children parents varcid varctok vtokmod
952 global varccommits ordertok commitidx numcommits curview
953 global targetid targetrow vshortids
957 set cmitlisted
($vid) 1
958 set children
($vid) {}
959 set parents
($vid) [list
$p]
960 set a
[newvarc
$v $id]
962 lappend vshortids
($v,[string range
$id 0 3]) $id
963 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
966 lappend varccommits
($v,$a) $id
968 if {[llength
[lappend children
($vp) $id]] > 1} {
969 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
970 unset -nocomplain ordertok
972 fix_reversal
$p $a $v
974 if {$v == $curview} {
975 set numcommits
$commitidx($v)
977 if {[info exists targetid
]} {
978 if {![comes_before
$targetid $p]} {
985 proc insertfakerow
{id p
} {
986 global varcid varccommits parents children cmitlisted
987 global commitidx varctok vtokmod targetid targetrow curview numcommits
991 set i
[lsearch
-exact $varccommits($v,$a) $p]
993 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
996 set children
($v,$id) {}
997 set parents
($v,$id) [list
$p]
998 set varcid
($v,$id) $a
999 lappend children
($v,$p) $id
1000 set cmitlisted
($v,$id) 1
1001 set numcommits
[incr commitidx
($v)]
1002 # note we deliberately don't update varcstart($v) even if $i == 0
1003 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
1005 if {[info exists targetid
]} {
1006 if {![comes_before
$targetid $p]} {
1014 proc removefakerow
{id
} {
1015 global varcid varccommits parents children commitidx
1016 global varctok vtokmod cmitlisted currentid selectedline
1017 global targetid curview numcommits
1020 if {[llength
$parents($v,$id)] != 1} {
1021 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1024 set p
[lindex
$parents($v,$id) 0]
1025 set a
$varcid($v,$id)
1026 set i
[lsearch
-exact $varccommits($v,$a) $id]
1028 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
1031 unset varcid
($v,$id)
1032 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
1033 unset parents
($v,$id)
1034 unset children
($v,$id)
1035 unset cmitlisted
($v,$id)
1036 set numcommits
[incr commitidx
($v) -1]
1037 set j
[lsearch
-exact $children($v,$p) $id]
1039 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
1042 if {[info exist currentid
] && $id eq
$currentid} {
1046 if {[info exists targetid
] && $targetid eq
$id} {
1053 proc real_children
{vp
} {
1054 global children nullid nullid2
1057 foreach id
$children($vp) {
1058 if {$id ne
$nullid && $id ne
$nullid2} {
1065 proc first_real_child
{vp
} {
1066 global children nullid nullid2
1068 foreach id
$children($vp) {
1069 if {$id ne
$nullid && $id ne
$nullid2} {
1076 proc last_real_child
{vp
} {
1077 global children nullid nullid2
1079 set kids
$children($vp)
1080 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
1081 set id
[lindex
$kids $i]
1082 if {$id ne
$nullid && $id ne
$nullid2} {
1089 proc vtokcmp
{v a b
} {
1090 global varctok varcid
1092 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1093 [lindex
$varctok($v) $varcid($v,$b)]]
1096 # This assumes that if lim is not given, the caller has checked that
1097 # arc a's token is less than $vtokmod($v)
1098 proc modify_arc
{v a
{lim
{}}} {
1099 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1102 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1105 set r
[lindex
$varcrow($v) $a]
1106 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1109 set vtokmod
($v) [lindex
$varctok($v) $a]
1111 if {$v == $curview} {
1112 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1113 set a
[lindex
$vupptr($v) $a]
1119 set lim
[llength
$varccommits($v,$a)]
1121 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1128 proc update_arcrows
{v
} {
1129 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1130 global varcid vrownum varcorder varcix varccommits
1131 global vupptr vdownptr vleftptr varctok
1132 global displayorder parentlist curview cached_commitrow
1134 if {$vrowmod($v) == $commitidx($v)} return
1135 if {$v == $curview} {
1136 if {[llength
$displayorder] > $vrowmod($v)} {
1137 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1138 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1140 unset -nocomplain cached_commitrow
1142 set narctot
[expr {[llength
$varctok($v)] - 1}]
1144 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1145 # go up the tree until we find something that has a row number,
1146 # or we get to a seed
1147 set a
[lindex
$vupptr($v) $a]
1150 set a
[lindex
$vdownptr($v) 0]
1153 set varcorder
($v) [list
$a]
1154 lset varcix
($v) $a 0
1155 lset varcrow
($v) $a 0
1159 set arcn
[lindex
$varcix($v) $a]
1160 if {[llength
$vrownum($v)] > $arcn + 1} {
1161 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1162 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1164 set row
[lindex
$varcrow($v) $a]
1168 incr row
[llength
$varccommits($v,$a)]
1169 # go down if possible
1170 set b
[lindex
$vdownptr($v) $a]
1172 # if not, go left, or go up until we can go left
1174 set b
[lindex
$vleftptr($v) $a]
1176 set a
[lindex
$vupptr($v) $a]
1182 lappend vrownum
($v) $row
1183 lappend varcorder
($v) $a
1184 lset varcix
($v) $a $arcn
1185 lset varcrow
($v) $a $row
1187 set vtokmod
($v) [lindex
$varctok($v) $p]
1189 set vrowmod
($v) $row
1190 if {[info exists currentid
]} {
1191 set selectedline
[rowofcommit
$currentid]
1195 # Test whether view $v contains commit $id
1196 proc commitinview
{id v
} {
1199 return [info exists varcid
($v,$id)]
1202 # Return the row number for commit $id in the current view
1203 proc rowofcommit
{id
} {
1204 global varcid varccommits varcrow curview cached_commitrow
1205 global varctok vtokmod
1208 if {![info exists varcid
($v,$id)]} {
1209 puts
"oops rowofcommit no arc for [shortids $id]"
1212 set a
$varcid($v,$id)
1213 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1216 if {[info exists cached_commitrow
($id)]} {
1217 return $cached_commitrow($id)
1219 set i
[lsearch
-exact $varccommits($v,$a) $id]
1221 puts
"oops didn't find commit [shortids $id] in arc $a"
1224 incr i
[lindex
$varcrow($v) $a]
1225 set cached_commitrow
($id) $i
1229 # Returns 1 if a is on an earlier row than b, otherwise 0
1230 proc comes_before
{a b
} {
1231 global varcid varctok curview
1234 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1235 ![info exists varcid
($v,$b)]} {
1238 if {$varcid($v,$a) != $varcid($v,$b)} {
1239 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1240 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1242 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1245 proc bsearch
{l elt
} {
1246 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1251 while {$hi - $lo > 1} {
1252 set mid
[expr {int
(($lo + $hi) / 2)}]
1253 set t
[lindex
$l $mid]
1256 } elseif
{$elt > $t} {
1265 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1266 proc make_disporder
{start end
} {
1267 global vrownum curview commitidx displayorder parentlist
1268 global varccommits varcorder parents vrowmod varcrow
1269 global d_valid_start d_valid_end
1271 if {$end > $vrowmod($curview)} {
1272 update_arcrows
$curview
1274 set ai
[bsearch
$vrownum($curview) $start]
1275 set start
[lindex
$vrownum($curview) $ai]
1276 set narc
[llength
$vrownum($curview)]
1277 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1278 set a
[lindex
$varcorder($curview) $ai]
1279 set l
[llength
$displayorder]
1280 set al
[llength
$varccommits($curview,$a)]
1281 if {$l < $r + $al} {
1283 set pad
[ntimes
[expr {$r - $l}] {}]
1284 set displayorder
[concat
$displayorder $pad]
1285 set parentlist
[concat
$parentlist $pad]
1286 } elseif
{$l > $r} {
1287 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1288 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1290 foreach id
$varccommits($curview,$a) {
1291 lappend displayorder
$id
1292 lappend parentlist
$parents($curview,$id)
1294 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1296 foreach id
$varccommits($curview,$a) {
1297 lset displayorder
$i $id
1298 lset parentlist
$i $parents($curview,$id)
1306 proc commitonrow
{row
} {
1309 set id
[lindex
$displayorder $row]
1311 make_disporder
$row [expr {$row + 1}]
1312 set id
[lindex
$displayorder $row]
1317 proc closevarcs
{v
} {
1318 global varctok varccommits varcid parents children
1319 global cmitlisted commitidx vtokmod curview numcommits
1321 set missing_parents
0
1323 set narcs
[llength
$varctok($v)]
1324 for {set a
1} {$a < $narcs} {incr a
} {
1325 set id
[lindex
$varccommits($v,$a) end
]
1326 foreach p
$parents($v,$id) {
1327 if {[info exists varcid
($v,$p)]} continue
1328 # add p as a new commit
1329 incr missing_parents
1330 set cmitlisted
($v,$p) 0
1331 set parents
($v,$p) {}
1332 if {[llength
$children($v,$p)] == 1 &&
1333 [llength
$parents($v,$id)] == 1} {
1336 set b
[newvarc
$v $p]
1338 set varcid
($v,$p) $b
1339 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1342 lappend varccommits
($v,$b) $p
1344 if {$v == $curview} {
1345 set numcommits
$commitidx($v)
1347 set scripts
[check_interest
$p $scripts]
1350 if {$missing_parents > 0} {
1351 foreach s
$scripts {
1357 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1358 # Assumes we already have an arc for $rwid.
1359 proc rewrite_commit
{v id rwid
} {
1360 global children parents varcid varctok vtokmod varccommits
1362 foreach ch
$children($v,$id) {
1363 # make $rwid be $ch's parent in place of $id
1364 set i
[lsearch
-exact $parents($v,$ch) $id]
1366 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1368 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1369 # add $ch to $rwid's children and sort the list if necessary
1370 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1371 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1372 $children($v,$rwid)]
1374 # fix the graph after joining $id to $rwid
1375 set a
$varcid($v,$ch)
1376 fix_reversal
$rwid $a $v
1377 # parentlist is wrong for the last element of arc $a
1378 # even if displayorder is right, hence the 3rd arg here
1379 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1383 # Mechanism for registering a command to be executed when we come
1384 # across a particular commit. To handle the case when only the
1385 # prefix of the commit is known, the commitinterest array is now
1386 # indexed by the first 4 characters of the ID. Each element is a
1387 # list of id, cmd pairs.
1388 proc interestedin
{id cmd
} {
1389 global commitinterest
1391 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1394 proc check_interest
{id scripts
} {
1395 global commitinterest
1397 set prefix
[string range
$id 0 3]
1398 if {[info exists commitinterest
($prefix)]} {
1400 foreach
{i
script} $commitinterest($prefix) {
1401 if {[string match
"$i*" $id]} {
1402 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1404 lappend newlist
$i $script
1407 if {$newlist ne
{}} {
1408 set commitinterest
($prefix) $newlist
1410 unset commitinterest
($prefix)
1416 proc getcommitlines
{fd inst view updating
} {
1417 global cmitlisted leftover
1418 global commitidx commitdata vdatemode
1419 global parents children curview hlview
1420 global idpending ordertok
1421 global varccommits varcid varctok vtokmod vfilelimit vshortids
1423 set stuff
[read $fd 500000]
1424 # git log doesn't terminate the last commit with a null...
1425 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1432 global commfd viewcomplete viewactive viewname
1433 global viewinstances
1435 set i
[lsearch
-exact $viewinstances($view) $inst]
1437 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1439 # set it blocking so we wait for the process to terminate
1440 fconfigure
$fd -blocking 1
1441 if {[catch
{close
$fd} err
]} {
1443 if {$view != $curview} {
1444 set fv
" for the \"$viewname($view)\" view"
1446 if {[string range
$err 0 4] == "usage"} {
1447 set err
"Gitk: error reading commits$fv:\
1448 bad arguments to git log."
1449 if {$viewname($view) eq
[mc
"Command line"]} {
1451 " (Note: arguments to gitk are passed to git log\
1452 to allow selection of commits to be displayed.)"
1455 set err
"Error reading commits$fv: $err"
1459 if {[incr viewactive
($view) -1] <= 0} {
1460 set viewcomplete
($view) 1
1461 # Check if we have seen any ids listed as parents that haven't
1462 # appeared in the list
1466 if {$view == $curview} {
1475 set i
[string first
"\0" $stuff $start]
1477 append leftover
($inst) [string range
$stuff $start end
]
1481 set cmit
$leftover($inst)
1482 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1483 set leftover
($inst) {}
1485 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1487 set start
[expr {$i + 1}]
1488 set j
[string first
"\n" $cmit]
1491 if {$j >= 0 && [string match
"commit *" $cmit]} {
1492 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1493 if {[string match
{[-^
<>]*} $ids]} {
1494 switch
-- [string index
$ids 0] {
1500 set ids
[string range
$ids 1 end
]
1504 if {[string length
$id] != 40} {
1512 if {[string length
$shortcmit] > 80} {
1513 set shortcmit
"[string range $shortcmit 0 80]..."
1515 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1518 set id [lindex $ids 0]
1521 lappend vshortids($view,[string range $id 0 3]) $id
1523 if {!$listed && $updating && ![info exists varcid($vid)] &&
1524 $vfilelimit($view) ne {}} {
1525 # git log doesn't rewrite parents
for unlisted commits
1526 # when doing path limiting, so work around that here
1527 # by working out the rewritten parent with git rev-list
1528 # and if we already know about it, using the rewritten
1529 # parent as a substitute parent for $id's children.
1531 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1532 $id -- $vfilelimit($view)]
1534 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1535 # use $rwid in place of $id
1536 rewrite_commit
$view $id $rwid
1543 if {[info exists varcid
($vid)]} {
1544 if {$cmitlisted($vid) ||
!$listed} continue
1548 set olds
[lrange
$ids 1 end
]
1552 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1553 set cmitlisted
($vid) $listed
1554 set parents
($vid) $olds
1555 if {![info exists children
($vid)]} {
1556 set children
($vid) {}
1557 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1558 set k
[lindex
$children($vid) 0]
1559 if {[llength
$parents($view,$k)] == 1 &&
1560 (!$vdatemode($view) ||
1561 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1562 set a
$varcid($view,$k)
1567 set a
[newvarc
$view $id]
1569 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1572 if {![info exists varcid
($vid)]} {
1574 lappend varccommits
($view,$a) $id
1575 incr commitidx
($view)
1580 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1582 if {[llength
[lappend children
($vp) $id]] > 1 &&
1583 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1584 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1586 unset -nocomplain ordertok
1588 if {[info exists varcid
($view,$p)]} {
1589 fix_reversal
$p $a $view
1595 set scripts
[check_interest
$id $scripts]
1599 global numcommits hlview
1601 if {$view == $curview} {
1602 set numcommits
$commitidx($view)
1605 if {[info exists hlview
] && $view == $hlview} {
1606 # we never actually get here...
1609 foreach s
$scripts {
1616 proc chewcommits
{} {
1617 global curview hlview viewcomplete
1618 global pending_select
1621 if {$viewcomplete($curview)} {
1622 global commitidx varctok
1623 global numcommits startmsecs
1625 if {[info exists pending_select
]} {
1627 reset_pending_select
{}
1629 if {[commitinview
$pending_select $curview]} {
1630 selectline
[rowofcommit
$pending_select] 1
1632 set row
[first_real_row
]
1636 if {$commitidx($curview) > 0} {
1637 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1638 #puts "overall $ms ms for $numcommits commits"
1639 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1641 show_status
[mc
"No commits selected"]
1648 proc do_readcommit
{id
} {
1651 # Invoke git-log to handle automatic encoding conversion
1652 set fd
[open
[concat | git log
--no-color --pretty=raw
-1 $id] r
]
1653 # Read the results using i18n.logoutputencoding
1654 fconfigure
$fd -translation lf
-eofchar {}
1655 if {$tclencoding != {}} {
1656 fconfigure
$fd -encoding $tclencoding
1658 set contents
[read $fd]
1660 # Remove the heading line
1661 regsub
{^commit
[0-9a-f]+\n} $contents {} contents
1666 proc readcommit
{id
} {
1667 if {[catch
{set contents
[do_readcommit
$id]}]} return
1668 parsecommit
$id $contents 1
1671 proc parsecommit
{id contents listed
} {
1681 set hdrend
[string first
"\n\n" $contents]
1683 # should never happen...
1684 set hdrend
[string length
$contents]
1686 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1687 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1688 foreach line
[split $header "\n"] {
1689 set line
[split $line " "]
1690 set tag
[lindex
$line 0]
1691 if {$tag == "author"} {
1692 set audate
[lrange
$line end-1 end
]
1693 set auname
[join [lrange
$line 1 end-2
] " "]
1694 } elseif
{$tag == "committer"} {
1695 set comdate
[lrange
$line end-1 end
]
1696 set comname
[join [lrange
$line 1 end-2
] " "]
1700 # take the first non-blank line of the comment as the headline
1701 set headline
[string trimleft
$comment]
1702 set i
[string first
"\n" $headline]
1704 set headline
[string range
$headline 0 $i]
1706 set headline
[string trimright
$headline]
1707 set i
[string first
"\r" $headline]
1709 set headline
[string trimright
[string range
$headline 0 $i]]
1712 # git log indents the comment by 4 spaces;
1713 # if we got this via git cat-file, add the indentation
1715 foreach line
[split $comment "\n"] {
1716 append newcomment
" "
1717 append newcomment
$line
1718 append newcomment
"\n"
1720 set comment
$newcomment
1722 set hasnote
[string first
"\nNotes:\n" $contents]
1724 # If there is diff output shown in the git-log stream, split it
1725 # out. But get rid of the empty line that always precedes the
1727 set i
[string first
"\n\ndiff" $comment]
1729 set diff [string range
$comment $i+1 end
]
1730 set comment
[string range
$comment 0 $i-1]
1732 set commitinfo
($id) [list
$headline $auname $audate \
1733 $comname $comdate $comment $hasnote $diff]
1736 proc getcommit
{id
} {
1737 global commitdata commitinfo
1739 if {[info exists commitdata
($id)]} {
1740 parsecommit
$id $commitdata($id) 1
1743 if {![info exists commitinfo
($id)]} {
1744 set commitinfo
($id) [list
[mc
"No commit information available"]]
1750 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1751 # and are present in the current view.
1752 # This is fairly slow...
1753 proc longid
{prefix
} {
1754 global varcid curview vshortids
1757 if {[string length
$prefix] >= 4} {
1758 set vshortid
$curview,[string range
$prefix 0 3]
1759 if {[info exists vshortids
($vshortid)]} {
1760 foreach id
$vshortids($vshortid) {
1761 if {[string match
"$prefix*" $id]} {
1762 if {[lsearch
-exact $ids $id] < 0} {
1764 if {[llength
$ids] >= 2} break
1770 foreach match
[array names varcid
"$curview,$prefix*"] {
1771 lappend ids
[lindex
[split $match ","] 1]
1772 if {[llength
$ids] >= 2} break
1779 global tagids idtags headids idheads tagobjid
1780 global otherrefids idotherrefs mainhead mainheadid
1781 global selecthead selectheadid
1784 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1785 unset -nocomplain $v
1787 set refd
[open
[list | git show-ref
-d] r
]
1788 while {[gets
$refd line
] >= 0} {
1789 if {[string index
$line 40] ne
" "} continue
1790 set id
[string range
$line 0 39]
1791 set ref
[string range
$line 41 end
]
1792 if {![string match
"refs/*" $ref]} continue
1793 set name
[string range
$ref 5 end
]
1794 if {[string match
"remotes/*" $name]} {
1795 if {![string match
"*/HEAD" $name] && !$hideremotes} {
1796 set headids
($name) $id
1797 lappend idheads
($id) $name
1799 } elseif
{[string match
"heads/*" $name]} {
1800 set name
[string range
$name 6 end
]
1801 set headids
($name) $id
1802 lappend idheads
($id) $name
1803 } elseif
{[string match
"tags/*" $name]} {
1804 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1805 # which is what we want since the former is the commit ID
1806 set name
[string range
$name 5 end
]
1807 if {[string match
"*^{}" $name]} {
1808 set name
[string range
$name 0 end-3
]
1810 set tagobjid
($name) $id
1812 set tagids
($name) $id
1813 lappend idtags
($id) $name
1815 set otherrefids
($name) $id
1816 lappend idotherrefs
($id) $name
1823 set mainheadid
[exec git rev-parse HEAD
]
1824 set thehead
[exec git symbolic-ref HEAD
]
1825 if {[string match
"refs/heads/*" $thehead]} {
1826 set mainhead
[string range
$thehead 11 end
]
1830 if {$selecthead ne
{}} {
1832 set selectheadid
[exec git rev-parse
--verify $selecthead]
1837 # skip over fake commits
1838 proc first_real_row
{} {
1839 global nullid nullid2 numcommits
1841 for {set row
0} {$row < $numcommits} {incr row
} {
1842 set id
[commitonrow
$row]
1843 if {$id ne
$nullid && $id ne
$nullid2} {
1850 # update things for a head moved to a child of its previous location
1851 proc movehead
{id name
} {
1852 global headids idheads
1854 removehead
$headids($name) $name
1855 set headids
($name) $id
1856 lappend idheads
($id) $name
1859 # update things when a head has been removed
1860 proc removehead
{id name
} {
1861 global headids idheads
1863 if {$idheads($id) eq
$name} {
1866 set i
[lsearch
-exact $idheads($id) $name]
1868 set idheads
($id) [lreplace
$idheads($id) $i $i]
1871 unset headids
($name)
1874 proc ttk_toplevel
{w args
} {
1876 eval [linsert
$args 0 ::toplevel
$w]
1878 place
[ttk
::frame
$w._toplevel_background
] -x 0 -y 0 -relwidth 1 -relheight 1
1883 proc make_transient
{window origin
} {
1886 # In MacOS Tk 8.4 transient appears to work by setting
1887 # overrideredirect, which is utterly useless, since the
1888 # windows get no border, and are not even kept above
1890 if {!$have_tk85 && [tk windowingsystem
] eq
{aqua
}} return
1892 wm transient
$window $origin
1894 # Windows fails to place transient windows normally, so
1895 # schedule a callback to center them on the parent.
1896 if {[tk windowingsystem
] eq
{win32
}} {
1897 after idle
[list tk
::PlaceWindow
$window widget
$origin]
1901 proc show_error
{w top msg
} {
1903 if {![info exists NS
]} {set NS
""}
1904 if {[wm state
$top] eq
"withdrawn"} { wm deiconify
$top }
1905 message
$w.m
-text $msg -justify center
-aspect 400
1906 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1907 ${NS}::button
$w.ok
-default active
-text [mc OK
] -command "destroy $top"
1908 pack
$w.ok
-side bottom
-fill x
1909 bind $top <Visibility
> "grab $top; focus $top"
1910 bind $top <Key-Return
> "destroy $top"
1911 bind $top <Key-space
> "destroy $top"
1912 bind $top <Key-Escape
> "destroy $top"
1916 proc error_popup
{msg
{owner .
}} {
1917 if {[tk windowingsystem
] eq
"win32"} {
1918 tk_messageBox
-icon error
-type ok
-title [wm title .
] \
1919 -parent $owner -message $msg
1923 make_transient
$w $owner
1924 show_error
$w $w $msg
1928 proc confirm_popup
{msg
{owner .
}} {
1929 global confirm_ok NS
1933 make_transient
$w $owner
1934 message
$w.m
-text $msg -justify center
-aspect 400
1935 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1936 ${NS}::button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1937 pack
$w.ok
-side left
-fill x
1938 ${NS}::button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1939 pack
$w.cancel
-side right
-fill x
1940 bind $w <Visibility
> "grab $w; focus $w"
1941 bind $w <Key-Return
> "set confirm_ok 1; destroy $w"
1942 bind $w <Key-space
> "set confirm_ok 1; destroy $w"
1943 bind $w <Key-Escape
> "destroy $w"
1944 tk
::PlaceWindow
$w widget
$owner
1949 proc setoptions
{} {
1952 if {[tk windowingsystem
] ne
"win32"} {
1953 option add
*Panedwindow.showHandle
1 startupFile
1954 option add
*Panedwindow.sashRelief raised startupFile
1955 if {[tk windowingsystem
] ne
"aqua"} {
1956 option add
*Menu.font uifont startupFile
1959 option add
*Menu.TearOff
0 startupFile
1961 option add
*Button.font uifont startupFile
1962 option add
*Checkbutton.font uifont startupFile
1963 option add
*Radiobutton.font uifont startupFile
1964 option add
*Menubutton.font uifont startupFile
1965 option add
*Label.font uifont startupFile
1966 option add
*Message.font uifont startupFile
1967 option add
*Entry.font textfont startupFile
1968 option add
*Text.font textfont startupFile
1969 option add
*Labelframe.font uifont startupFile
1970 option add
*Spinbox.font textfont startupFile
1971 option add
*Listbox.font mainfont startupFile
1974 proc setttkstyle
{} {
1975 eval font configure TkDefaultFont
[fontflags mainfont
]
1976 eval font configure TkTextFont
[fontflags textfont
]
1977 eval font configure TkHeadingFont
[fontflags mainfont
]
1978 eval font configure TkCaptionFont
[fontflags mainfont
] -weight bold
1979 eval font configure TkTooltipFont
[fontflags uifont
]
1980 eval font configure TkFixedFont
[fontflags textfont
]
1981 eval font configure TkIconFont
[fontflags uifont
]
1982 eval font configure TkMenuFont
[fontflags uifont
]
1983 eval font configure TkSmallCaptionFont
[fontflags uifont
]
1986 # Make a menu and submenus.
1987 # m is the window name for the menu, items is the list of menu items to add.
1988 # Each item is a list {mc label type description options...}
1989 # mc is ignored; it's so we can put mc there to alert xgettext
1990 # label is the string that appears in the menu
1991 # type is cascade, command or radiobutton (should add checkbutton)
1992 # description depends on type; it's the sublist for cascade, the
1993 # command to invoke for command, or {variable value} for radiobutton
1994 proc makemenu
{m items
} {
1996 if {[tk windowingsystem
] eq
{aqua
}} {
2002 set name
[mc
[lindex
$i 1]]
2003 set type [lindex
$i 2]
2004 set thing
[lindex
$i 3]
2005 set params
[list
$type]
2007 set u
[string first
"&" [string map
{&& x
} $name]]
2008 lappend params
-label [string map
{&& & & {}} $name]
2010 lappend params
-underline $u
2015 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
2016 lappend params
-menu $m.
$submenu
2019 lappend params
-command $thing
2022 lappend params
-variable [lindex
$thing 0] \
2023 -value [lindex
$thing 1]
2026 set tail [lrange
$i 4 end
]
2027 regsub
-all {\yMeta1\y
} $tail $Meta1 tail
2028 eval $m add
$params $tail
2029 if {$type eq
"cascade"} {
2030 makemenu
$m.
$submenu $thing
2035 # translate string and remove ampersands
2037 return [string map
{&& & & {}} [mc
$str]]
2040 proc cleardropsel
{w
} {
2043 proc makedroplist
{w varname args
} {
2047 foreach label
$args {
2048 set cx
[string length
$label]
2049 if {$cx > $width} {set width
$cx}
2051 set gm
[ttk
::combobox
$w -width $width -state readonly\
2052 -textvariable $varname -values $args \
2053 -exportselection false
]
2054 bind $gm <<ComboboxSelected>> [list $gm selection clear]
2056 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2061 proc makewindow {} {
2062 global canv canv2 canv3 linespc charspc ctext cflist cscroll
2064 global findtype findtypemenu findloc findstring fstring geometry
2065 global entries sha1entry sha1string sha1but
2066 global diffcontextstring diffcontext
2068 global maincursor textcursor curtextcursor
2069 global rowctxmenu fakerowmenu mergemax wrapcomment
2070 global highlight_files gdttype
2071 global searchstring sstring
2072 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2073 global uifgcolor uifgdisabledcolor
2074 global filesepbgcolor filesepfgcolor
2075 global mergecolors foundbgcolor currentsearchhitbgcolor
2076 global headctxmenu progresscanv progressitem progresscoords statusw
2077 global fprogitem fprogcoord lastprogupdate progupdatepending
2078 global rprogitem rprogcoord rownumsel numcommits
2079 global have_tk85 use_ttk NS
2083 # The "mc" arguments here are purely so that xgettext
2084 # sees the following string as needing to be translated
2086 mc "&File" cascade {
2087 {mc "&Update" command updatecommits -accelerator F5}
2088 {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2089 {mc "Reread re&ferences" command rereadrefs}
2090 {mc "&List references" command showrefs -accelerator F2}
2092 {mc "Start git &gui" command {exec git gui &}}
2094 {mc "&Quit" command doquit -accelerator Meta1-Q}
2097 mc "&Edit" cascade {
2098 {mc "&Preferences" command doprefs}
2101 mc "&View" cascade {
2102 {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2103 {mc "&Edit view..." command editview -state disabled -accelerator F4}
2104 {mc "&Delete view" command delview -state disabled}
2106 {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2108 if {[tk windowingsystem] ne "aqua"} {
2110 mc "&Help" cascade {
2111 {mc "&About gitk" command about}
2112 {mc "&Key bindings" command keys}
2114 set bar [list $file $edit $view $help]
2116 proc ::tk::mac::ShowPreferences {} {doprefs}
2117 proc ::tk::mac::Quit {} {doquit}
2118 lset file end [lreplace [lindex $file end] end-1 end]
2120 xx "&Apple" cascade {
2121 {mc "&About gitk" command about}
2125 mc "&Help" cascade {
2126 {mc "&Key bindings" command keys}
2128 set bar [list $apple $file $view $help]
2131 . configure -menu .bar
2134 # cover the non-themed toplevel with a themed frame.
2135 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2138 # the gui has upper and lower half, parts of a paned window.
2139 ${NS}::panedwindow .ctop -orient vertical
2141 # possibly use assumed geometry
2142 if {![info exists geometry(pwsash0)]} {
2143 set geometry(topheight) [expr {15 * $linespc}]
2144 set geometry(topwidth) [expr {80 * $charspc}]
2145 set geometry(botheight) [expr {15 * $linespc}]
2146 set geometry(botwidth) [expr {50 * $charspc}]
2147 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2148 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2151 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2152 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2153 ${NS}::frame .tf.histframe
2154 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2156 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2159 # create three canvases
2160 set cscroll .tf.histframe.csb
2161 set canv .tf.histframe.pwclist.canv
2163 -selectbackground $selectbgcolor \
2164 -background $bgcolor -bd 0 \
2165 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2166 .tf.histframe.pwclist add $canv
2167 set canv2 .tf.histframe.pwclist.canv2
2169 -selectbackground $selectbgcolor \
2170 -background $bgcolor -bd 0 -yscrollincr $linespc
2171 .tf.histframe.pwclist add $canv2
2172 set canv3 .tf.histframe.pwclist.canv3
2174 -selectbackground $selectbgcolor \
2175 -background $bgcolor -bd 0 -yscrollincr $linespc
2176 .tf.histframe.pwclist add $canv3
2178 bind .tf.histframe.pwclist <Map> {
2180 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2181 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2184 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2185 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2188 # a scroll bar to rule them
2189 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2190 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2191 pack $cscroll -side right -fill y
2192 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2193 lappend bglist $canv $canv2 $canv3
2194 pack .tf.histframe.pwclist -fill both -expand 1 -side left
2196 # we have two button bars at bottom of top frame. Bar 1
2197 ${NS}::frame .tf.bar
2198 ${NS}::frame .tf.lbar -height 15
2200 set sha1entry .tf.bar.sha1
2201 set entries $sha1entry
2202 set sha1but .tf.bar.sha1label
2203 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2204 -command gotocommit -width 8
2205 $sha1but conf -disabledforeground [$sha1but cget -foreground]
2206 pack .tf.bar.sha1label -side left
2207 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2208 trace add variable sha1string write sha1change
2209 pack $sha1entry -side left -pady 2
2212 #define left_width 16
2213 #define left_height 16
2214 static unsigned char left_bits[] = {
2215 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2216 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2217 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2220 #define right_width 16
2221 #define right_height 16
2222 static unsigned char right_bits[] = {
2223 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2224 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2225 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2227 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2228 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2229 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2230 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2232 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2234 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2236 .tf.bar.leftbut configure -image bm-left
2238 pack .tf.bar.leftbut -side left -fill y
2239 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2241 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2243 .tf.bar.rightbut configure -image bm-right
2245 pack .tf.bar.rightbut -side left -fill y
2247 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2249 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2250 -relief sunken -anchor e
2251 ${NS}::label .tf.bar.rowlabel2 -text "/"
2252 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2253 -relief sunken -anchor e
2254 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2257 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2260 trace add variable selectedline write selectedline_change
2262 # Status label and progress bar
2263 set statusw .tf.bar.status
2264 ${NS}::label $statusw -width 15 -relief sunken
2265 pack $statusw -side left -padx 5
2267 set progresscanv [ttk::progressbar .tf.bar.progress]
2269 set h [expr {[font metrics uifont -linespace] + 2}]
2270 set progresscanv .tf.bar.progress
2271 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2272 set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2273 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2274 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2276 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2277 set progresscoords {0 0}
2280 bind $progresscanv <Configure> adjustprogress
2281 set lastprogupdate [clock clicks -milliseconds]
2282 set progupdatepending 0
2284 # build up the bottom bar of upper window
2285 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2288 #define down_width 16
2289 #define down_height 16
2290 static unsigned char down_bits[] = {
2291 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2292 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2293 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2294 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2296 image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2297 ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2298 .tf.lbar.fnext configure -image bm-down
2302 #define up_height 16
2303 static unsigned char up_bits[] = {
2304 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2305 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2306 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2307 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2309 image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2310 ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2311 .tf.lbar.fprev configure -image bm-up
2313 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2315 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2317 set gdttype [mc "containing:"]
2318 set gm [makedroplist .tf.lbar.gdttype gdttype \
2319 [mc "containing:"] \
2320 [mc "touching paths:"] \
2321 [mc "adding/removing string:"] \
2322 [mc "changing lines matching:"]]
2323 trace add variable gdttype write gdttype_change
2324 pack .tf.lbar.gdttype -side left -fill y
2327 set fstring .tf.lbar.findstring
2328 lappend entries $fstring
2329 ${NS}::entry $fstring -width 30 -textvariable findstring
2330 trace add variable findstring write find_change
2331 set findtype [mc "Exact"]
2332 set findtypemenu [makedroplist .tf.lbar.findtype \
2333 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2334 trace add variable findtype write findcom_change
2335 set findloc [mc "All fields"]
2336 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2337 [mc "Comments"] [mc "Author"] [mc "Committer"]
2338 trace add variable findloc write find_change
2339 pack .tf.lbar.findloc -side right
2340 pack .tf.lbar.findtype -side right
2341 pack $fstring -side left -expand 1 -fill x
2343 # Finish putting the upper half of the viewer together
2344 pack .tf.lbar -in .tf -side bottom -fill x
2345 pack .tf.bar -in .tf -side bottom -fill x
2346 pack .tf.histframe -fill both -side top -expand 1
2349 .ctop paneconfigure .tf -height $geometry(topheight)
2350 .ctop paneconfigure .tf -width $geometry(topwidth)
2353 # now build up the bottom
2354 ${NS}::panedwindow .pwbottom -orient horizontal
2356 # lower left, a text box over search bar, scroll bar to the right
2357 # if we know window height, then that will set the lower text height, otherwise
2358 # we set lower text height which will drive window height
2359 if {[info exists geometry(main)]} {
2360 ${NS}::frame .bleft -width $geometry(botwidth)
2362 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2364 ${NS}::frame .bleft.top
2365 ${NS}::frame .bleft.mid
2366 ${NS}::frame .bleft.bottom
2368 # gap between sub-widgets
2369 set wgap [font measure uifont "i"]
2371 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2372 pack .bleft.top.search -side left -padx 5
2373 set sstring .bleft.top.sstring
2375 ${NS}::entry $sstring -width 20 -textvariable searchstring
2376 lappend entries $sstring
2377 trace add variable searchstring write incrsearch
2378 pack $sstring -side left -expand 1 -fill x
2379 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2380 -command changediffdisp -variable diffelide -value {0 0}
2381 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2382 -command changediffdisp -variable diffelide -value {0 1}
2383 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2384 -command changediffdisp -variable diffelide -value {1 0}
2386 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
2387 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2388 spinbox .bleft.mid.diffcontext -width 5 \
2389 -from 0 -increment 1 -to 10000000 \
2390 -validate all -validatecommand "diffcontextvalidate %P" \
2391 -textvariable diffcontextstring
2392 .bleft.mid.diffcontext set $diffcontext
2393 trace add variable diffcontextstring write diffcontextchange
2394 lappend entries .bleft.mid.diffcontext
2395 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2396 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2397 -command changeignorespace -variable ignorespace
2398 pack .bleft.mid.ignspace -side left -padx 5
2400 set worddiff [mc "Line diff"]
2401 if {[package vcompare $git_version "1.7.2"] >= 0} {
2402 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2403 [mc "Markup words"] [mc "Color words"]
2404 trace add variable worddiff write changeworddiff
2405 pack .bleft.mid.worddiff -side left -padx 5
2408 set ctext .bleft.bottom.ctext
2409 text $ctext -background $bgcolor -foreground $fgcolor \
2410 -state disabled -undo 0 -font textfont \
2411 -yscrollcommand scrolltext -wrap none \
2412 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2414 $ctext conf -tabstyle wordprocessor
2416 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2417 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2418 pack .bleft.top -side top -fill x
2419 pack .bleft.mid -side top -fill x
2420 grid $ctext .bleft.bottom.sb -sticky nsew
2421 grid .bleft.bottom.sbhorizontal -sticky ew
2422 grid columnconfigure .bleft.bottom 0 -weight 1
2423 grid rowconfigure .bleft.bottom 0 -weight 1
2424 grid rowconfigure .bleft.bottom 1 -weight 0
2425 pack .bleft.bottom -side top -fill both -expand 1
2426 lappend bglist $ctext
2427 lappend fglist $ctext
2429 $ctext tag conf comment -wrap $wrapcomment
2430 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2431 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2432 $ctext tag conf d0 -fore [lindex $diffcolors 0]
2433 $ctext tag conf dresult -fore [lindex $diffcolors 1]
2434 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2435 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2436 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2437 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2438 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2439 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2440 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2441 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2442 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2443 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2444 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2445 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2446 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2447 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2448 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2449 $ctext tag conf m15 -fore [lindex $mergecolors 15]
2450 $ctext tag conf mmax -fore darkgrey
2452 $ctext tag conf mresult -font textfontbold
2453 $ctext tag conf msep -font textfontbold
2454 $ctext tag conf found -back $foundbgcolor
2455 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2456 $ctext tag conf wwrap -wrap word -lmargin2 1c
2457 $ctext tag conf bold -font textfontbold
2459 .pwbottom add .bleft
2461 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2465 ${NS}::frame .bright
2466 ${NS}::frame .bright.mode
2467 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2468 -command reselectline -variable cmitmode -value "patch"
2469 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2470 -command reselectline -variable cmitmode -value "tree"
2471 grid .bright.mode.patch .bright.mode.tree -sticky ew
2472 pack .bright.mode -side top -fill x
2473 set cflist .bright.cfiles
2474 set indent [font measure mainfont "nn"]
2476 -selectbackground $selectbgcolor \
2477 -background $bgcolor -foreground $fgcolor \
2479 -tabs [list $indent [expr {2 * $indent}]] \
2480 -yscrollcommand ".bright.sb set" \
2481 -cursor [. cget -cursor] \
2482 -spacing1 1 -spacing3 1
2483 lappend bglist $cflist
2484 lappend fglist $cflist
2485 ${NS}::scrollbar .bright.sb -command "$cflist yview"
2486 pack .bright.sb -side right -fill y
2487 pack $cflist -side left -fill both -expand 1
2488 $cflist tag configure highlight \
2489 -background [$cflist cget -selectbackground]
2490 $cflist tag configure bold -font mainfontbold
2492 .pwbottom add .bright
2495 # restore window width & height if known
2496 if {[info exists geometry(main)]} {
2497 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2498 if {$w > [winfo screenwidth .]} {
2499 set w [winfo screenwidth .]
2501 if {$h > [winfo screenheight .]} {
2502 set h [winfo screenheight .]
2504 wm geometry . "${w}x$h"
2508 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2509 wm state . $geometry(state)
2512 if {[tk windowingsystem] eq {aqua}} {
2523 %W sashpos 0 $::geometry(topheight)
2525 bind .pwbottom <Map> {
2527 %W sashpos 0 $::geometry(botwidth)
2531 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2532 pack .ctop -fill both -expand 1
2533 bindall <1> {selcanvline %W %x %y}
2534 #bindall <B1-Motion> {selcanvline %W %x %y}
2535 if {[tk windowingsystem] == "win32"} {
2536 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2537 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2539 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2540 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2541 bind $ctext <Button> {
2543 $ctext xview scroll -5 units
2544 } elseif {"%b" eq 7} {
2545 $ctext xview scroll 5 units
2548 if {[tk windowingsystem] eq "aqua"} {
2549 bindall <MouseWheel> {
2550 set delta [expr {- (%D)}]
2551 allcanvs yview scroll $delta units
2553 bindall <Shift-MouseWheel> {
2554 set delta [expr {- (%D)}]
2555 $canv xview scroll $delta units
2559 bindall <$::BM> "canvscan mark %W %x %y"
2560 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2561 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2562 bind . <$M1B-Key-w> doquit
2563 bindkey <Home> selfirstline
2564 bindkey <End> sellastline
2565 bind . <Key-Up> "selnextline -1"
2566 bind . <Key-Down> "selnextline 1"
2567 bind . <Shift-Key-Up> "dofind -1 0"
2568 bind . <Shift-Key-Down> "dofind 1 0"
2569 bindkey <Key-Right> "goforw"
2570 bindkey <Key-Left> "goback"
2571 bind . <Key-Prior> "selnextpage -1"
2572 bind . <Key-Next> "selnextpage 1"
2573 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2574 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2575 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2576 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2577 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2578 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2579 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2580 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2581 bindkey <Key-space> "$ctext yview scroll 1 pages"
2582 bindkey p "selnextline -1"
2583 bindkey n "selnextline 1"
2586 bindkey k "selnextline -1"
2587 bindkey j "selnextline 1"
2591 bindkey d "$ctext yview scroll 18 units"
2592 bindkey u "$ctext yview scroll -18 units"
2593 bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2594 bindkey / {focus $fstring}
2595 bindkey <Key-KP_Divide> {focus $fstring}
2596 bindkey <Key-Return> {dofind 1 1}
2597 bindkey ? {dofind -1 1}
2599 bind . <F5> updatecommits
2600 bindmodfunctionkey Shift 5 reloadcommits
2601 bind . <F2> showrefs
2602 bindmodfunctionkey Shift 4 {newview 0}
2603 bind . <F4> edit_or_newview
2604 bind . <$M1B-q> doquit
2605 bind . <$M1B-f> {dofind 1 1}
2606 bind . <$M1B-g> {dofind 1 0}
2607 bind . <$M1B-r> dosearchback
2608 bind . <$M1B-s> dosearch
2609 bind . <$M1B-equal> {incrfont 1}
2610 bind . <$M1B-plus> {incrfont 1}
2611 bind . <$M1B-KP_Add> {incrfont 1}
2612 bind . <$M1B-minus> {incrfont -1}
2613 bind . <$M1B-KP_Subtract> {incrfont -1}
2614 wm protocol . WM_DELETE_WINDOW doquit
2615 bind . <Destroy> {stop_backends}
2616 bind . <Button-1> "click %W"
2617 bind $fstring <Key-Return> {dofind 1 1}
2618 bind $sha1entry <Key-Return> {gotocommit; break}
2619 bind $sha1entry <<PasteSelection>> clearsha1
2620 bind $sha1entry <<Paste>> clearsha1
2621 bind $cflist <1> {sel_flist %W %x %y; break}
2622 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2623 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2625 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2626 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2627 bind $ctext <Button-1> {focus %W}
2628 bind $ctext <<Selection>> rehighlight_search_results
2629 for {set i 1} {$i < 10} {incr i} {
2630 bind . <$M1B-Key-$i> [list go_to_parent $i]
2633 set maincursor [. cget -cursor]
2634 set textcursor [$ctext cget -cursor]
2635 set curtextcursor $textcursor
2637 set rowctxmenu .rowctxmenu
2638 makemenu $rowctxmenu {
2639 {mc "Diff this -> selected" command {diffvssel 0}}
2640 {mc "Diff selected -> this" command {diffvssel 1}}
2641 {mc "Make patch" command mkpatch}
2642 {mc "Create tag" command mktag}
2643 {mc "Copy commit summary" command copysummary}
2644 {mc "Write commit to file" command writecommit}
2645 {mc "Create new branch" command mkbranch}
2646 {mc "Cherry-pick this commit" command cherrypick}
2647 {mc "Reset HEAD branch to here" command resethead}
2648 {mc "Mark this commit" command markhere}
2649 {mc "Return to mark" command gotomark}
2650 {mc "Find descendant of this and mark" command find_common_desc}
2651 {mc "Compare with marked commit" command compare_commits}
2652 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2653 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2654 {mc "Revert this commit" command revert}
2656 $rowctxmenu configure -tearoff 0
2658 set fakerowmenu .fakerowmenu
2659 makemenu $fakerowmenu {
2660 {mc "Diff this -> selected" command {diffvssel 0}}
2661 {mc "Diff selected -> this" command {diffvssel 1}}
2662 {mc "Make patch" command mkpatch}
2663 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2664 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2666 $fakerowmenu configure -tearoff 0
2668 set headctxmenu .headctxmenu
2669 makemenu $headctxmenu {
2670 {mc "Check out this branch" command cobranch}
2671 {mc "Rename this branch" command mvbranch}
2672 {mc "Remove this branch" command rmbranch}
2673 {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2675 $headctxmenu configure -tearoff 0
2678 set flist_menu .flistctxmenu
2679 makemenu $flist_menu {
2680 {mc "Highlight this too" command {flist_hl 0}}
2681 {mc "Highlight this only" command {flist_hl 1}}
2682 {mc "External diff" command {external_diff}}
2683 {mc "Blame parent commit" command {external_blame 1}}
2684 {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2686 $flist_menu configure -tearoff 0
2689 set diff_menu .diffctxmenu
2690 makemenu $diff_menu {
2691 {mc "Show origin of this line" command show_line_source}
2692 {mc "Run git gui blame on this line" command {external_blame_diff}}
2694 $diff_menu configure -tearoff 0
2697 # Windows sends all mouse wheel events to the current focused window, not
2698 # the one where the mouse hovers, so bind those events here and redirect
2699 # to the correct window
2700 proc windows_mousewheel_redirector {W X Y D} {
2701 global canv canv2 canv3
2702 set w [winfo containing -displayof $W $X $Y]
2704 set u [expr {$D < 0 ? 5 : -5}]
2705 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2706 allcanvs yview scroll $u units
2709 $w yview scroll $u units
2715 # Update row number label when selectedline changes
2716 proc selectedline_change {n1 n2 op} {
2717 global selectedline rownumsel
2719 if {$selectedline eq {}} {
2722 set rownumsel [expr {$selectedline + 1}]
2726 # mouse-2 makes all windows scan vertically, but only the one
2727 # the cursor is in scans horizontally
2728 proc canvscan {op w x y} {
2729 global canv canv2 canv3
2730 foreach c [list $canv $canv2 $canv3] {
2739 proc scrollcanv {cscroll f0 f1} {
2740 $cscroll set $f0 $f1
2745 # when we make a key binding for the toplevel, make sure
2746 # it doesn't get triggered when that key is pressed in the
2747 # find string entry widget.
2748 proc bindkey {ev script} {
2751 set escript [bind Entry $ev]
2752 if {$escript == {}} {
2753 set escript [bind Entry <Key>]
2755 foreach e $entries {
2756 bind $e $ev "$escript; break"
2760 proc bindmodfunctionkey {mod n script} {
2761 bind . <$mod-F$n> $script
2762 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2765 # set the focus back to the toplevel for any click outside
2768 global ctext entries
2769 foreach e [concat $entries $ctext] {
2770 if {$w == $e} return
2775 # Adjust the progress bar for a change in requested extent or canvas size
2776 proc adjustprogress {} {
2777 global progresscanv progressitem progresscoords
2778 global fprogitem fprogcoord lastprogupdate progupdatepending
2779 global rprogitem rprogcoord use_ttk
2782 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2786 set w [expr {[winfo width $progresscanv] - 4}]
2787 set x0 [expr {$w * [lindex $progresscoords 0]}]
2788 set x1 [expr {$w * [lindex $progresscoords 1]}]
2789 set h [winfo height $progresscanv]
2790 $progresscanv coords $progressitem $x0 0 $x1 $h
2791 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2792 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2793 set now [clock clicks -milliseconds]
2794 if {$now >= $lastprogupdate + 100} {
2795 set progupdatepending 0
2797 } elseif {!$progupdatepending} {
2798 set progupdatepending 1
2799 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2803 proc doprogupdate {} {
2804 global lastprogupdate progupdatepending
2806 if {$progupdatepending} {
2807 set progupdatepending 0
2808 set lastprogupdate [clock clicks -milliseconds]
2813 proc config_check_tmp_exists {tries_left} {
2814 global config_file_tmp
2816 if {[file exists $config_file_tmp]} {
2818 if {$tries_left > 0} {
2819 after 100 [list config_check_tmp_exists $tries_left]
2821 error_popup "There appears to be a stale $config_file_tmp\
2822 file, which will prevent gitk from saving its configuration on exit.\
2823 Please remove it if it is not being used by any existing gitk process."
2828 proc config_init_trace {name} {
2829 global config_variable_changed config_variable_original
2832 set config_variable_changed($name) 0
2833 set config_variable_original($name) $var
2836 proc config_variable_change_cb {name name2 op} {
2837 global config_variable_changed config_variable_original
2840 if {$op eq "write" &&
2841 (![info exists config_variable_original($name)] ||
2842 $config_variable_original($name) ne $var)} {
2843 set config_variable_changed($name) 1
2847 proc savestuff {w} {
2849 global config_file config_file_tmp
2850 global config_variables config_variable_changed
2853 upvar #0 viewname current_viewname
2854 upvar #0 viewfiles current_viewfiles
2855 upvar #0 viewargs current_viewargs
2856 upvar #0 viewargscmd current_viewargscmd
2857 upvar #0 viewperm current_viewperm
2858 upvar #0 nextviewnum current_nextviewnum
2859 upvar #0 use_ttk current_use_ttk
2861 if {$stuffsaved} return
2862 if {![winfo viewable .]} return
2866 while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2867 if {[incr try_count] > 50} {
2868 error "Unable to write config file: $config_file_tmp exists"
2873 if {$::tcl_platform(platform) eq {windows}} {
2874 file attributes $config_file_tmp -hidden true
2876 if {[file exists $config_file]} {
2879 foreach var_name $config_variables {
2880 upvar #0 $var_name var
2881 upvar 0 $var_name old_var
2882 if {!$config_variable_changed($var_name) && [info exists old_var]} {
2883 puts $f [list set $var_name $old_var]
2885 puts $f [list set $var_name $var]
2889 puts $f "set geometry(main) [wm geometry .]"
2890 puts $f "set geometry(state) [wm state .]"
2891 puts $f "set geometry(topwidth) [winfo width .tf]"
2892 puts $f "set geometry(topheight) [winfo height .tf]"
2893 if {$current_use_ttk} {
2894 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2895 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2897 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2898 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2900 puts $f "set geometry(botwidth) [winfo width .bleft]"
2901 puts $f "set geometry(botheight) [winfo height .bleft]"
2903 array set view_save {}
2905 if {![info exists permviews]} { set permviews {} }
2906 foreach view $permviews {
2907 set view_save([lindex $view 0]) 1
2908 set views([lindex $view 0]) $view
2910 puts -nonewline $f "set permviews {"
2911 for {set v 1} {$v < $current_nextviewnum} {incr v} {
2912 if {$viewchanged($v)} {
2913 if {$current_viewperm($v)} {
2914 set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2916 set view_save($current_viewname($v)) 0
2920 # write old and updated view to their places and append remaining to the end
2921 foreach view $permviews {
2922 set view_name [lindex $view 0]
2923 if {$view_save($view_name)} {
2924 puts $f "{$views($view_name)}"
2926 unset views($view_name)
2928 foreach view_name [array names views] {
2929 puts $f "{$views($view_name)}"
2933 file rename -force $config_file_tmp $config_file
2936 puts "Error saving config: $err"
2939 file delete -force $config_file_tmp
2944 proc resizeclistpanes {win w} {
2945 global oldwidth use_ttk
2946 if {[info exists oldwidth($win)]} {
2948 set s0 [$win sashpos 0]
2949 set s1 [$win sashpos 1]
2951 set s0 [$win sash coord 0]
2952 set s1 [$win sash coord 1]
2955 set sash0 [expr {int($w/2 - 2)}]
2956 set sash1 [expr {int($w*5/6 - 2)}]
2958 set factor [expr {1.0 * $w / $oldwidth($win)}]
2959 set sash0 [expr {int($factor * [lindex $s0 0])}]
2960 set sash1 [expr {int($factor * [lindex $s1 0])}]
2964 if {$sash1 < $sash0 + 20} {
2965 set sash1 [expr {$sash0 + 20}]
2967 if {$sash1 > $w - 10} {
2968 set sash1 [expr {$w - 10}]
2969 if {$sash0 > $sash1 - 20} {
2970 set sash0 [expr {$sash1 - 20}]
2975 $win sashpos 0 $sash0
2976 $win sashpos 1 $sash1
2978 $win sash place 0 $sash0 [lindex $s0 1]
2979 $win sash place 1 $sash1 [lindex $s1 1]
2982 set oldwidth($win) $w
2985 proc resizecdetpanes {win w} {
2986 global oldwidth use_ttk
2987 if {[info exists oldwidth($win)]} {
2989 set s0 [$win sashpos 0]
2991 set s0 [$win sash coord 0]
2994 set sash0 [expr {int($w*3/4 - 2)}]
2996 set factor [expr {1.0 * $w / $oldwidth($win)}]
2997 set sash0 [expr {int($factor * [lindex $s0 0])}]
3001 if {$sash0 > $w - 15} {
3002 set sash0 [expr {$w - 15}]
3006 $win sashpos 0 $sash0
3008 $win sash place 0 $sash0 [lindex $s0 1]
3011 set oldwidth($win) $w
3014 proc allcanvs args {
3015 global canv canv2 canv3
3021 proc bindall {event action} {
3022 global canv canv2 canv3
3023 bind $canv $event $action
3024 bind $canv2 $event $action
3025 bind $canv3 $event $action
3031 if {[winfo exists $w]} {
3036 wm title $w [mc "About gitk"]
3038 message $w.m -text [mc "
3039 Gitk - a commit viewer for git
3041 Copyright \u00a9 2005-2016 Paul Mackerras
3043 Use and redistribute under the terms of the GNU General Public License"] \
3044 -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3045 pack $w.m -side top -fill x -padx 2 -pady 2
3046 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3047 pack $w.ok -side bottom
3048 bind $w <Visibility> "focus $w.ok"
3049 bind $w <Key-Escape> "destroy $w"
3050 bind $w <Key-Return> "destroy $w"
3051 tk::PlaceWindow $w widget .
3057 if {[winfo exists $w]} {
3061 if {[tk windowingsystem] eq {aqua}} {
3067 wm title $w [mc "Gitk key bindings"]
3069 message $w.m -text "
3070 [mc "Gitk key bindings:"]
3072 [mc "<%s-Q> Quit" $M1T]
3073 [mc "<%s-W> Close window" $M1T]
3074 [mc "<Home> Move to first commit"]
3075 [mc "<End> Move to last commit"]
3076 [mc "<Up>, p, k Move up one commit"]
3077 [mc "<Down>, n, j Move down one commit"]
3078 [mc "<Left>, z, h Go back in history list"]
3079 [mc "<Right>, x, l Go forward in history list"]
3080 [mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
3081 [mc "<PageUp> Move up one page in commit list"]
3082 [mc "<PageDown> Move down one page in commit list"]
3083 [mc "<%s-Home> Scroll to top of commit list" $M1T]
3084 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
3085 [mc "<%s-Up> Scroll commit list up one line" $M1T]
3086 [mc "<%s-Down> Scroll commit list down one line" $M1T]
3087 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
3088 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
3089 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
3090 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
3091 [mc "<Delete>, b Scroll diff view up one page"]
3092 [mc "<Backspace> Scroll diff view up one page"]
3093 [mc "<Space> Scroll diff view down one page"]
3094 [mc "u Scroll diff view up 18 lines"]
3095 [mc "d Scroll diff view down 18 lines"]
3096 [mc "<%s-F> Find" $M1T]
3097 [mc "<%s-G> Move to next find hit" $M1T]
3098 [mc "<Return> Move to next find hit"]
3099 [mc "g Go to commit"]
3100 [mc "/ Focus the search box"]
3101 [mc "? Move to previous find hit"]
3102 [mc "f Scroll diff view to next file"]
3103 [mc "<%s-S> Search for next hit in diff view" $M1T]
3104 [mc "<%s-R> Search for previous hit in diff view" $M1T]
3105 [mc "<%s-KP+> Increase font size" $M1T]
3106 [mc "<%s-plus> Increase font size" $M1T]
3107 [mc "<%s-KP-> Decrease font size" $M1T]
3108 [mc "<%s-minus> Decrease font size" $M1T]
3111 -justify left -bg $bgcolor -border 2 -relief groove
3112 pack $w.m -side top -fill both -padx 2 -pady 2
3113 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3114 bind $w <Key-Escape> [list destroy $w]
3115 pack $w.ok -side bottom
3116 bind $w <Visibility> "focus $w.ok"
3117 bind $w <Key-Escape> "destroy $w"
3118 bind $w <Key-Return> "destroy $w"
3121 # Procedures for manipulating the file list window at the
3122 # bottom right of the overall window.
3124 proc treeview {w l openlevs} {
3125 global treecontents treediropen treeheight treeparent treeindex
3135 set treecontents() {}
3136 $w conf -state normal
3138 while {[string range $f 0 $prefixend] ne $prefix} {
3139 if {$lev <= $openlevs} {
3140 $w mark set e:$treeindex($prefix) "end -1c"
3141 $w mark gravity e:$treeindex($prefix) left
3143 set treeheight($prefix) $ht
3144 incr ht [lindex $htstack end]
3145 set htstack [lreplace $htstack end end]
3146 set prefixend [lindex $prefendstack end]
3147 set prefendstack [lreplace $prefendstack end end]
3148 set prefix [string range $prefix 0 $prefixend]
3151 set tail [string range $f [expr {$prefixend+1}] end]
3152 while {[set slash [string first "/" $tail]] >= 0} {
3155 lappend prefendstack $prefixend
3156 incr prefixend [expr {$slash + 1}]
3157 set d [string range $tail 0 $slash]
3158 lappend treecontents($prefix) $d
3159 set oldprefix $prefix
3161 set treecontents($prefix) {}
3162 set treeindex($prefix) [incr ix]
3163 set treeparent($prefix) $oldprefix
3164 set tail [string range $tail [expr {$slash+1}] end]
3165 if {$lev <= $openlevs} {
3167 set treediropen($prefix) [expr {$lev < $openlevs}]
3168 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3169 $w mark set d:$ix "end -1c"
3170 $w mark gravity d:$ix left
3172 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3174 $w image create end -align center -image $bm -padx 1 \
3176 $w insert end $d [highlight_tag $prefix]
3177 $w mark set s:$ix "end -1c"
3178 $w mark gravity s:$ix left
3183 if {$lev <= $openlevs} {
3186 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3188 $w insert end $tail [highlight_tag $f]
3190 lappend treecontents($prefix) $tail
3193 while {$htstack ne {}} {
3194 set treeheight($prefix) $ht
3195 incr ht [lindex $htstack end]
3196 set htstack [lreplace $htstack end end]
3197 set prefixend [lindex $prefendstack end]
3198 set prefendstack [lreplace $prefendstack end end]
3199 set prefix [string range $prefix 0 $prefixend]
3201 $w conf -state disabled
3204 proc linetoelt {l} {
3205 global treeheight treecontents
3210 foreach e $treecontents($prefix) {
3215 if {[string index $e end] eq "/"} {
3216 set n $treeheight($prefix$e)
3228 proc highlight_tree {y prefix} {
3229 global treeheight treecontents cflist
3231 foreach e $treecontents($prefix) {
3233 if {[highlight_tag $path] ne {}} {
3234 $cflist tag add bold $y.0 "$y.0 lineend"
3237 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3238 set y [highlight_tree $y $path]
3244 proc treeclosedir {w dir} {
3245 global treediropen treeheight treeparent treeindex
3247 set ix $treeindex($dir)
3248 $w conf -state normal
3249 $w delete s:$ix e:$ix
3250 set treediropen($dir) 0
3251 $w image configure a:$ix -image tri-rt
3252 $w conf -state disabled
3253 set n [expr {1 - $treeheight($dir)}]
3254 while {$dir ne {}} {
3255 incr treeheight($dir) $n
3256 set dir $treeparent($dir)
3260 proc treeopendir {w dir} {
3261 global treediropen treeheight treeparent treecontents treeindex
3263 set ix $treeindex($dir)
3264 $w conf -state normal
3265 $w image configure a:$ix -image tri-dn
3266 $w mark set e:$ix s:$ix
3267 $w mark gravity e:$ix right
3270 set n [llength $treecontents($dir)]
3271 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3274 incr treeheight($x) $n
3276 foreach e $treecontents($dir) {
3278 if {[string index $e end] eq "/"} {
3279 set iy $treeindex($de)
3280 $w mark set d:$iy e:$ix
3281 $w mark gravity d:$iy left
3282 $w insert e:$ix $str
3283 set treediropen($de) 0
3284 $w image create e:$ix -align center -image tri-rt -padx 1 \
3286 $w insert e:$ix $e [highlight_tag $de]
3287 $w mark set s:$iy e:$ix
3288 $w mark gravity s:$iy left
3289 set treeheight($de) 1
3291 $w insert e:$ix $str
3292 $w insert e:$ix $e [highlight_tag $de]
3295 $w mark gravity e:$ix right
3296 $w conf -state disabled
3297 set treediropen($dir) 1
3298 set top [lindex [split [$w index @0,0] .] 0]
3299 set ht [$w cget -height]
3300 set l [lindex [split [$w index s:$ix] .] 0]
3303 } elseif {$l + $n + 1 > $top + $ht} {
3304 set top [expr {$l + $n + 2 - $ht}]
3312 proc treeclick {w x y} {
3313 global treediropen cmitmode ctext cflist cflist_top
3315 if {$cmitmode ne "tree"} return
3316 if {![info exists cflist_top]} return
3317 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3318 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3319 $cflist tag add highlight $l.0 "$l.0 lineend"
3325 set e [linetoelt $l]
3326 if {[string index $e end] ne "/"} {
3328 } elseif {$treediropen($e)} {
3335 proc setfilelist {id} {
3336 global treefilelist cflist jump_to_here
3338 treeview $cflist $treefilelist($id) 0
3339 if {$jump_to_here ne {}} {
3340 set f [lindex $jump_to_here 0]
3341 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3347 image create bitmap tri-rt -background black -foreground blue -data {
3348 #define tri-rt_width 13
3349 #define tri-rt_height 13
3350 static unsigned char tri-rt_bits[] = {
3351 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3352 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3355 #define tri-rt-mask_width 13
3356 #define tri-rt-mask_height 13
3357 static unsigned char tri-rt-mask_bits[] = {
3358 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3359 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3362 image create bitmap tri-dn -background black -foreground blue -data {
3363 #define tri-dn_width 13
3364 #define tri-dn_height 13
3365 static unsigned char tri-dn_bits[] = {
3366 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3367 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3370 #define tri-dn-mask_width 13
3371 #define tri-dn-mask_height 13
3372 static unsigned char tri-dn-mask_bits[] = {
3373 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3374 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3378 image create bitmap reficon-T -background black -foreground yellow -data {
3379 #define tagicon_width 13
3380 #define tagicon_height 9
3381 static unsigned char tagicon_bits[] = {
3382 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3383 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3385 #define tagicon-mask_width 13
3386 #define tagicon-mask_height 9
3387 static unsigned char tagicon-mask_bits[] = {
3388 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3389 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3392 #define headicon_width 13
3393 #define headicon_height 9
3394 static unsigned char headicon_bits[] = {
3395 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3396 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3399 #define headicon-mask_width 13
3400 #define headicon-mask_height 9
3401 static unsigned char headicon-mask_bits[] = {
3402 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3403 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3405 image create bitmap reficon-H -background black -foreground "#00ff00" \
3406 -data $rectdata -maskdata $rectmask
3407 image create bitmap reficon-R -background black -foreground "#ffddaa" \
3408 -data $rectdata -maskdata $rectmask
3409 image create bitmap reficon-o -background black -foreground "#ddddff" \
3410 -data $rectdata -maskdata $rectmask
3412 proc init_flist {first} {
3413 global cflist cflist_top difffilestart
3415 $cflist conf -state normal
3416 $cflist delete 0.0 end
3418 $cflist insert end $first
3420 $cflist tag add highlight 1.0 "1.0 lineend"
3422 unset -nocomplain cflist_top
3424 $cflist conf -state disabled
3425 set difffilestart {}
3428 proc highlight_tag {f} {
3429 global highlight_paths
3431 foreach p $highlight_paths {
3432 if {[string match $p $f]} {
3439 proc highlight_filelist {} {
3440 global cmitmode cflist
3442 $cflist conf -state normal
3443 if {$cmitmode ne "tree"} {
3444 set end [lindex [split [$cflist index end] .] 0]
3445 for {set l 2} {$l < $end} {incr l} {
3446 set line [$cflist get $l.0 "$l.0 lineend"]
3447 if {[highlight_tag $line] ne {}} {
3448 $cflist tag add bold $l.0 "$l.0 lineend"
3454 $cflist conf -state disabled
3457 proc unhighlight_filelist {} {
3460 $cflist conf -state normal
3461 $cflist tag remove bold 1.0 end
3462 $cflist conf -state disabled
3465 proc add_flist {fl} {
3468 $cflist conf -state normal
3470 $cflist insert end "\n"
3471 $cflist insert end $f [highlight_tag $f]
3473 $cflist conf -state disabled
3476 proc sel_flist {w x y} {
3477 global ctext difffilestart cflist cflist_top cmitmode
3479 if {$cmitmode eq "tree"} return
3480 if {![info exists cflist_top]} return
3481 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3482 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3483 $cflist tag add highlight $l.0 "$l.0 lineend"
3488 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3490 suppress_highlighting_file_for_current_scrollpos
3493 proc pop_flist_menu {w X Y x y} {
3494 global ctext cflist cmitmode flist_menu flist_menu_file
3495 global treediffs diffids
3498 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3500 if {$cmitmode eq "tree"} {
3501 set e [linetoelt $l]
3502 if {[string index $e end] eq "/"} return
3504 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3506 set flist_menu_file $e
3507 set xdiffstate "normal"
3508 if {$cmitmode eq "tree"} {
3509 set xdiffstate "disabled"
3511 # Disable "External diff" item in tree mode
3512 $flist_menu entryconf 2 -state $xdiffstate
3513 tk_popup $flist_menu $X $Y
3516 proc find_ctext_fileinfo {line} {
3517 global ctext_file_names ctext_file_lines
3519 set ok [bsearch $ctext_file_lines $line]
3520 set tline [lindex $ctext_file_lines $ok]
3522 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3525 return [list [lindex $ctext_file_names $ok] $tline]
3529 proc pop_diff_menu {w X Y x y} {
3530 global ctext diff_menu flist_menu_file
3531 global diff_menu_txtpos diff_menu_line
3532 global diff_menu_filebase
3534 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3535 set diff_menu_line [lindex $diff_menu_txtpos 0]
3536 # don't pop up the menu on hunk-separator or file-separator lines
3537 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3541 set f [find_ctext_fileinfo $diff_menu_line]
3542 if {$f eq {}} return
3543 set flist_menu_file [lindex $f 0]
3544 set diff_menu_filebase [lindex $f 1]
3545 tk_popup $diff_menu $X $Y
3548 proc flist_hl {only} {
3549 global flist_menu_file findstring gdttype
3551 set x [shellquote $flist_menu_file]
3552 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3555 append findstring " " $x
3557 set gdttype [mc "touching paths:"]
3560 proc gitknewtmpdir {} {
3561 global diffnum gitktmpdir gitdir env
3563 if {![info exists gitktmpdir]} {
3564 if {[info exists env(GITK_TMPDIR)]} {
3565 set tmpdir $env(GITK_TMPDIR)
3566 } elseif {[info exists env(TMPDIR)]} {
3567 set tmpdir $env(TMPDIR)
3571 set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3572 if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3573 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3575 if {[catch {file mkdir $gitktmpdir} err]} {
3576 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3583 set diffdir [file join $gitktmpdir $diffnum]
3584 if {[catch {file mkdir $diffdir} err]} {
3585 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3591 proc save_file_from_commit {filename output what} {
3594 if {[catch {exec git show $filename -- > $output} err]} {
3595 if {[string match "fatal: bad revision *" $err]} {
3598 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3604 proc external_diff_get_one_file {diffid filename diffdir} {
3605 global nullid nullid2 nullfile
3608 if {$diffid == $nullid} {
3609 set difffile [file join $worktree $filename]
3610 if {[file exists $difffile]} {
3615 if {$diffid == $nullid2} {
3616 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3617 return [save_file_from_commit :$filename $difffile index]
3619 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3620 return [save_file_from_commit $diffid:$filename $difffile \
3624 proc external_diff {} {
3625 global nullid nullid2
3626 global flist_menu_file
3630 if {[llength $diffids] == 1} {
3631 # no reference commit given
3632 set diffidto [lindex $diffids 0]
3633 if {$diffidto eq $nullid} {
3634 # diffing working copy with index
3635 set diffidfrom $nullid2
3636 } elseif {$diffidto eq $nullid2} {
3637 # diffing index with HEAD
3638 set diffidfrom "HEAD"
3640 # use first parent commit
3641 global parentlist selectedline
3642 set diffidfrom [lindex $parentlist $selectedline 0]
3645 set diffidfrom [lindex $diffids 0]
3646 set diffidto [lindex $diffids 1]
3649 # make sure that several diffs wont collide
3650 set diffdir [gitknewtmpdir]
3651 if {$diffdir eq {}} return
3653 # gather files to diff
3654 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3655 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3657 if {$difffromfile ne {} && $difftofile ne {}} {
3658 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3659 if {[catch {set fl [open |$cmd r]} err]} {
3660 file delete -force $diffdir
3661 error_popup "$extdifftool: [mc "command failed:"] $err"
3663 fconfigure $fl -blocking 0
3664 filerun $fl [list delete_at_eof $fl $diffdir]
3669 proc find_hunk_blamespec {base line} {
3672 # Find and parse the hunk header
3673 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3674 if {$s_lix eq {}} return
3676 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3677 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3678 s_line old_specs osz osz1 new_line nsz]} {
3682 # base lines for the parents
3683 set base_lines [list $new_line]
3684 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3685 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3686 old_spec old_line osz]} {
3689 lappend base_lines $old_line
3692 # Now scan the lines to determine offset within the hunk
3693 set max_parent [expr {[llength $base_lines]-2}]
3695 set s_lno [lindex [split $s_lix "."] 0]
3697 # Determine if the line is removed
3698 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3699 if {[string match {[-+ ]*} $chunk]} {
3700 set removed_idx [string first "-" $chunk]
3701 # Choose a parent index
3702 if {$removed_idx >= 0} {
3703 set parent $removed_idx
3705 set unchanged_idx [string first " " $chunk]
3706 if {$unchanged_idx >= 0} {
3707 set parent $unchanged_idx
3709 # blame the current commit
3713 # then count other lines that belong to it
3714 for {set i $line} {[incr i -1] > $s_lno} {} {
3715 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3716 # Determine if the line is removed
3717 set removed_idx [string first "-" $chunk]
3719 set code [string index $chunk $parent]
3720 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3724 if {$removed_idx < 0} {
3734 incr dline [lindex $base_lines $parent]
3735 return [list $parent $dline]
3738 proc external_blame_diff {} {
3739 global currentid cmitmode
3740 global diff_menu_txtpos diff_menu_line
3741 global diff_menu_filebase flist_menu_file
3743 if {$cmitmode eq "tree"} {
3745 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3747 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3749 set parent_idx [lindex $hinfo 0]
3750 set line [lindex $hinfo 1]
3757 external_blame $parent_idx $line
3760 # Find the SHA1 ID of the blob for file $fname in the index
3762 proc index_sha1 {fname} {
3763 set f [open [list | git ls-files -s $fname] r]
3764 while {[gets $f line] >= 0} {
3765 set info [lindex [split $line "\t"] 0]
3766 set stage [lindex $info 2]
3767 if {$stage eq "0" || $stage eq "2"} {
3769 return [lindex $info 1]
3776 # Turn an absolute path into one relative to the current directory
3777 proc make_relative {f} {
3778 if {[file pathtype $f] eq "relative"} {
3781 set elts [file split $f]
3782 set here [file split [pwd]]
3787 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3794 set elts [concat $res [lrange $elts $ei end]]
3795 return [eval file join $elts]
3798 proc external_blame {parent_idx {line {}}} {
3799 global flist_menu_file cdup
3800 global nullid nullid2
3801 global parentlist selectedline currentid
3803 if {$parent_idx > 0} {
3804 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3806 set base_commit $currentid
3809 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3810 error_popup [mc "No such commit"]
3814 set cmdline [list git gui blame]
3815 if {$line ne {} && $line > 1} {
3816 lappend cmdline "--line=$line"
3818 set f [file join $cdup $flist_menu_file]
3819 # Unfortunately it seems git gui blame doesn't like
3820 # being given an absolute path...
3821 set f [make_relative $f]
3822 lappend cmdline $base_commit $f
3823 if {[catch {eval exec $cmdline &} err]} {
3824 error_popup "[mc "git gui blame: command failed:"] $err"
3828 proc show_line_source {} {
3829 global cmitmode currentid parents curview blamestuff blameinst
3830 global diff_menu_line diff_menu_filebase flist_menu_file
3831 global nullid nullid2 gitdir cdup
3834 if {$cmitmode eq "tree"} {
3836 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3838 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3839 if {$h eq {}} return
3840 set pi [lindex $h 0]
3842 mark_ctext_line $diff_menu_line
3846 if {$currentid eq $nullid} {
3848 # must be a merge in progress...
3850 # get the last line from .git/MERGE_HEAD
3851 set f [open [file join $gitdir MERGE_HEAD] r]
3852 set id [lindex [split [read $f] "\n"] end-1]
3855 error_popup [mc "Couldn't read merge head: %s" $err]
3858 } elseif {$parents($curview,$currentid) eq $nullid2} {
3859 # need to do the blame from the index
3861 set from_index [index_sha1 $flist_menu_file]
3863 error_popup [mc "Error reading index: %s" $err]
3867 set id $parents($curview,$currentid)
3870 set id [lindex $parents($curview,$currentid) $pi]
3872 set line [lindex $h 1]
3875 if {$from_index ne {}} {
3876 lappend blameargs | git cat-file blob $from_index
3878 lappend blameargs | git blame -p -L$line,+1
3879 if {$from_index ne {}} {
3880 lappend blameargs --contents -
3882 lappend blameargs $id
3884 lappend blameargs -- [file join $cdup $flist_menu_file]
3886 set f [open $blameargs r]
3888 error_popup [mc "Couldn't start git blame: %s" $err]
3891 nowbusy blaming [mc "Searching"]
3892 fconfigure $f -blocking 0
3893 set i [reg_instance $f]
3894 set blamestuff($i) {}
3896 filerun $f [list read_line_source $f $i]
3899 proc stopblaming {} {
3902 if {[info exists blameinst]} {
3903 stop_instance $blameinst
3909 proc read_line_source {fd inst} {
3910 global blamestuff curview commfd blameinst nullid nullid2
3912 while {[gets $fd line] >= 0} {
3913 lappend blamestuff($inst) $line
3921 fconfigure $fd -blocking 1
3922 if {[catch {close $fd} err]} {
3923 error_popup [mc "Error running git blame: %s" $err]
3928 set line [split [lindex $blamestuff($inst) 0] " "]
3929 set id [lindex $line 0]
3930 set lnum [lindex $line 1]
3931 if {[string length $id] == 40 && [string is xdigit $id] &&
3932 [string is digit -strict $lnum]} {
3933 # look for "filename" line
3934 foreach l $blamestuff($inst) {
3935 if {[string match "filename *" $l]} {
3936 set fname [string range $l 9 end]
3942 # all looks good, select it
3943 if {$id eq $nullid} {
3944 # blame uses all-zeroes to mean not committed,
3945 # which would mean a change in the index
3948 if {[commitinview $id $curview]} {
3949 selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3951 error_popup [mc "That line comes from commit %s, \
3952 which is not in this view" [shortids $id]]
3955 puts "oops couldn't parse git blame output"
3960 # delete $dir when we see eof on $f (presumably because the child has exited)
3961 proc delete_at_eof {f dir} {
3962 while {[gets $f line] >= 0} {}
3964 if {[catch {close $f} err]} {
3965 error_popup "[mc "External diff viewer failed:"] $err"
3967 file delete -force $dir
3973 # Functions for adding and removing shell-type quoting
3975 proc shellquote {str} {
3976 if {![string match "*\['\"\\ \t]*" $str]} {
3979 if {![string match "*\['\"\\]*" $str]} {
3982 if {![string match "*'*" $str]} {
3985 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3988 proc shellarglist {l} {
3994 append str [shellquote $a]
3999 proc shelldequote {str} {
4004 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4005 append ret [string range $str $used end]
4006 set used [string length $str]
4009 set first [lindex $first 0]
4010 set ch [string index $str $first]
4011 if {$first > $used} {
4012 append ret [string range $str $used [expr {$first - 1}]]
4015 if {$ch eq " " || $ch eq "\t"} break
4018 set first [string first "'" $str $used]
4020 error "unmatched single-quote"
4022 append ret [string range $str $used [expr {$first - 1}]]
4027 if {$used >= [string length $str]} {
4028 error "trailing backslash"
4030 append ret [string index $str $used]
4035 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4036 error "unmatched double-quote"
4038 set first [lindex $first 0]
4039 set ch [string index $str $first]
4040 if {$first > $used} {
4041 append ret [string range $str $used [expr {$first - 1}]]
4044 if {$ch eq "\""} break
4046 append ret [string index $str $used]
4050 return [list $used $ret]
4053 proc shellsplit {str} {
4056 set str [string trimleft $str]
4057 if {$str eq {}} break
4058 set dq [shelldequote $str]
4059 set n [lindex $dq 0]
4060 set word [lindex $dq 1]
4061 set str [string range $str $n end]
4067 proc set_window_title {} {
4068 global appname curview viewname vrevs
4069 set rev [mc "All files"]
4070 if {$curview ne 0} {
4071 if {$viewname($curview) eq [mc "Command line"]} {
4072 set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4074 set rev $viewname($curview)
4077 wm title . "[reponame]: $rev - $appname"
4080 # Code to implement multiple views
4082 proc newview {ishighlight} {
4083 global nextviewnum newviewname newishighlight
4084 global revtreeargs viewargscmd newviewopts curview
4086 set newishighlight $ishighlight
4088 if {[winfo exists $top]} {
4092 decode_view_opts $nextviewnum $revtreeargs
4093 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4094 set newviewopts($nextviewnum,perm) 0
4095 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
4096 vieweditor $top $nextviewnum [mc "Gitk view definition"]
4099 set known_view_options {
4100 {perm b . {} {mc "Remember this view"}}
4101 {reflabel l + {} {mc "References (space separated list):"}}
4102 {refs t15 .. {} {mc "Branches & tags:"}}
4103 {allrefs b *. "--all" {mc "All refs"}}
4104 {branches b . "--branches" {mc "All (local) branches"}}
4105 {tags b . "--tags" {mc "All tags"}}
4106 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
4107 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
4108 {author t15 .. "--author=*" {mc "Author:"}}
4109 {committer t15 . "--committer=*" {mc "Committer:"}}
4110 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
4111 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
4112 {igrep b .. "--invert-grep" {mc "Matches no Commit Info criteria"}}
4113 {changes_l l + {} {mc "Changes to Files:"}}
4114 {pickaxe_s r0 . {} {mc "Fixed String"}}
4115 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
4116 {pickaxe t15 .. "-S*" {mc "Search string:"}}
4117 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4118 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
4119 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
4120 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
4121 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
4122 {skip t10 . "--skip=*" {mc "Number to skip:"}}
4123 {misc_lbl l + {} {mc "Miscellaneous options:"}}
4124 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
4125 {lright b . "--left-right" {mc "Mark branch sides"}}
4126 {first b . "--first-parent" {mc "Limit to first parent"}}
4127 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
4128 {args t50 *. {} {mc "Additional arguments to git log:"}}
4129 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4130 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
4133 # Convert $newviewopts($n, ...) into args for git log.
4134 proc encode_view_opts {n} {
4135 global known_view_options newviewopts
4138 foreach opt $known_view_options {
4139 set patterns [lindex $opt 3]
4140 if {$patterns eq {}} continue
4141 set pattern [lindex $patterns 0]
4143 if {[lindex $opt 1] eq "b"} {
4144 set val $newviewopts($n,[lindex $opt 0])
4146 lappend rargs $pattern
4148 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4149 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4150 set val $newviewopts($n,$button_id)
4151 if {$val eq $value} {
4152 lappend rargs $pattern
4155 set val $newviewopts($n,[lindex $opt 0])
4156 set val [string trim $val]
4158 set pfix [string range $pattern 0 end-1]
4159 lappend rargs $pfix$val
4163 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4164 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4167 # Fill $newviewopts($n, ...) based on args for git log.
4168 proc decode_view_opts {n view_args} {
4169 global known_view_options newviewopts
4171 foreach opt $known_view_options {
4172 set id [lindex $opt 0]
4173 if {[lindex $opt 1] eq "b"} {
4176 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4178 regexp {^(.*_)} $id uselessvar id
4184 set newviewopts($n,$id) $val
4188 foreach arg $view_args {
4189 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4190 && ![info exists found(limit)]} {
4191 set newviewopts($n,limit) $cnt
4196 foreach opt $known_view_options {
4197 set id [lindex $opt 0]
4198 if {[info exists found($id)]} continue
4199 foreach pattern [lindex $opt 3] {
4200 if {![string match $pattern $arg]} continue
4201 if {[lindex $opt 1] eq "b"} {
4204 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4206 regexp {^(.*_)} $id uselessvar id
4210 set size [string length $pattern]
4211 set val [string range $arg [expr {$size-1}] end]
4213 set newviewopts($n,$id) $val
4217 if {[info exists val]} break
4219 if {[info exists val]} continue
4220 if {[regexp {^-} $arg]} {
4223 lappend refargs $arg
4226 set newviewopts($n,refs) [shellarglist $refargs]
4227 set newviewopts($n,args) [shellarglist $oargs]
4230 proc edit_or_newview {} {
4242 global viewname viewperm newviewname newviewopts
4243 global viewargs viewargscmd
4245 set top .gitkvedit-$curview
4246 if {[winfo exists $top]} {
4250 decode_view_opts $curview $viewargs($curview)
4251 set newviewname($curview) $viewname($curview)
4252 set newviewopts($curview,perm) $viewperm($curview)
4253 set newviewopts($curview,cmd) $viewargscmd($curview)
4254 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4257 proc vieweditor {top n title} {
4258 global newviewname newviewopts viewfiles bgcolor
4259 global known_view_options NS
4262 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4263 make_transient $top .
4266 ${NS}::frame $top.nfr
4267 ${NS}::label $top.nl -text [mc "View Name"]
4268 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4269 pack $top.nfr -in $top -fill x -pady 5 -padx 3
4270 pack $top.nl -in $top.nfr -side left -padx {0 5}
4271 pack $top.name -in $top.nfr -side left -padx {0 25}
4277 foreach opt $known_view_options {
4278 set id [lindex $opt 0]
4279 set type [lindex $opt 1]
4280 set flags [lindex $opt 2]
4281 set title [eval [lindex $opt 4]]
4284 if {$flags eq "+" || $flags eq "*"} {
4285 set cframe $top.fr$cnt
4287 ${NS}::frame $cframe
4288 pack $cframe -in $top -fill x -pady 3 -padx 3
4289 set cexpand [expr {$flags eq "*"}]
4290 } elseif {$flags eq ".." || $flags eq "*."} {
4291 set cframe $top.fr$cnt
4293 ${NS}::frame $cframe
4294 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4295 set cexpand [expr {$flags eq "*."}]
4301 ${NS}::label $cframe.l_$id -text $title
4302 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4303 } elseif {$type eq "b"} {
4304 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4305 pack $cframe.c_$id -in $cframe -side left \
4306 -padx [list $lxpad 0] -expand $cexpand -anchor w
4307 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4308 regexp {^(.*_)} $id uselessvar button_id
4309 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4310 pack $cframe.c_$id -in $cframe -side left \
4311 -padx [list $lxpad 0] -expand $cexpand -anchor w
4312 } elseif {[regexp {^t(\d+)$} $type type sz]} {
4313 ${NS}::label $cframe.l_$id -text $title
4314 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4315 -textvariable newviewopts($n,$id)
4316 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4317 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4318 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4319 ${NS}::label $cframe.l_$id -text $title
4320 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4321 -textvariable newviewopts($n,$id)
4322 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4323 pack $cframe.e_$id -in $cframe -side top -fill x
4324 } elseif {$type eq "path"} {
4325 ${NS}::label $top.l -text $title
4326 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4327 text $top.t -width 40 -height 5 -background $bgcolor
4328 if {[info exists viewfiles($n)]} {
4329 foreach f $viewfiles($n) {
4330 $top.t insert end $f
4331 $top.t insert end "\n"
4333 $top.t delete {end - 1c} end
4334 $top.t mark set insert 0.0
4336 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4340 ${NS}::frame $top.buts
4341 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4342 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4343 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4344 bind $top <Control-Return> [list newviewok $top $n]
4345 bind $top <F5> [list newviewok $top $n 1]
4346 bind $top <Escape> [list destroy $top]
4347 grid $top.buts.ok $top.buts.apply $top.buts.can
4348 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4349 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4350 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4351 pack $top.buts -in $top -side top -fill x
4355 proc doviewmenu {m first cmd op argv} {
4356 set nmenu [$m index end]
4357 for {set i $first} {$i <= $nmenu} {incr i} {
4358 if {[$m entrycget $i -command] eq $cmd} {
4359 eval $m $op $i $argv
4365 proc allviewmenus {n op args} {
4368 doviewmenu .bar.view 5 [list showview $n] $op $args
4369 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4372 proc newviewok {top n {apply 0}} {
4373 global nextviewnum newviewperm newviewname newishighlight
4374 global viewname viewfiles viewperm viewchanged selectedview curview
4375 global viewargs viewargscmd newviewopts viewhlmenu
4378 set newargs [encode_view_opts $n]
4380 error_popup "[mc "Error in commit selection arguments:"] $err" $top
4384 foreach f [split [$top.t get 0.0 end] "\n"] {
4385 set ft [string trim $f]
4390 if {![info exists viewfiles($n)]} {
4391 # creating a new view
4393 set viewname($n) $newviewname($n)
4394 set viewperm($n) $newviewopts($n,perm)
4395 set viewchanged($n) 1
4396 set viewfiles($n) $files
4397 set viewargs($n) $newargs
4398 set viewargscmd($n) $newviewopts($n,cmd)
4400 if {!$newishighlight} {
4403 run addvhighlight $n
4406 # editing an existing view
4407 set viewperm($n) $newviewopts($n,perm)
4408 set viewchanged($n) 1
4409 if {$newviewname($n) ne $viewname($n)} {
4410 set viewname($n) $newviewname($n)
4411 doviewmenu .bar.view 5 [list showview $n] \
4412 entryconf [list -label $viewname($n)]
4413 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4414 # entryconf [list -label $viewname($n) -value $viewname($n)]
4416 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4417 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4418 set viewfiles($n) $files
4419 set viewargs($n) $newargs
4420 set viewargscmd($n) $newviewopts($n,cmd)
4421 if {$curview == $n} {
4427 catch {destroy $top}
4431 global curview viewperm hlview selectedhlview viewchanged
4433 if {$curview == 0} return
4434 if {[info exists hlview] && $hlview == $curview} {
4435 set selectedhlview [mc "None"]
4438 allviewmenus $curview delete
4439 set viewperm($curview) 0
4440 set viewchanged($curview) 1
4444 proc addviewmenu {n} {
4445 global viewname viewhlmenu
4447 .bar.view add radiobutton -label $viewname($n) \
4448 -command [list showview $n] -variable selectedview -value $n
4449 #$viewhlmenu add radiobutton -label $viewname($n) \
4450 # -command [list addvhighlight $n] -variable selectedhlview
4454 global curview cached_commitrow ordertok
4455 global displayorder parentlist rowidlist rowisopt rowfinal
4456 global colormap rowtextx nextcolor canvxmax
4457 global numcommits viewcomplete
4458 global selectedline currentid canv canvy0
4460 global pending_select mainheadid
4463 global hlview selectedhlview commitinterest
4465 if {$n == $curview} return
4467 set ymax [lindex [$canv cget -scrollregion] 3]
4468 set span [$canv yview]
4469 set ytop [expr {[lindex $span 0] * $ymax}]
4470 set ybot [expr {[lindex $span 1] * $ymax}]
4471 set yscreen [expr {($ybot - $ytop) / 2}]
4472 if {$selectedline ne {}} {
4473 set selid $currentid
4474 set y [yc $selectedline]
4475 if {$ytop < $y && $y < $ybot} {
4476 set yscreen [expr {$y - $ytop}]
4478 } elseif {[info exists pending_select]} {
4479 set selid $pending_select
4480 unset pending_select
4484 unset -nocomplain treediffs
4486 if {[info exists hlview] && $hlview == $n} {
4488 set selectedhlview [mc "None"]
4490 unset -nocomplain commitinterest
4491 unset -nocomplain cached_commitrow
4492 unset -nocomplain ordertok
4496 .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4497 .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4500 if {![info exists viewcomplete($n)]} {
4510 set numcommits $commitidx($n)
4512 unset -nocomplain colormap
4513 unset -nocomplain rowtextx
4515 set canvxmax [$canv cget -width]
4521 if {$selid ne {} && [commitinview $selid $n]} {
4522 set row [rowofcommit $selid]
4523 # try to get the selected row in the same position on the screen
4524 set ymax [lindex [$canv cget -scrollregion] 3]
4525 set ytop [expr {[yc $row] - $yscreen}]
4529 set yf [expr {$ytop * 1.0 / $ymax}]
4531 allcanvs yview moveto $yf
4535 } elseif {!$viewcomplete($n)} {
4536 reset_pending_select $selid
4538 reset_pending_select {}
4540 if {[commitinview $pending_select $curview]} {
4541 selectline [rowofcommit $pending_select] 1
4543 set row [first_real_row]
4544 if {$row < $numcommits} {
4549 if {!$viewcomplete($n)} {
4550 if {$numcommits == 0} {
4551 show_status [mc "Reading commits..."]
4553 } elseif {$numcommits == 0} {
4554 show_status [mc "No commits selected"]
4559 # Stuff relating to the highlighting facility
4561 proc ishighlighted {id} {
4562 global vhighlights fhighlights nhighlights rhighlights
4564 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4565 return $nhighlights($id)
4567 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4568 return $vhighlights($id)
4570 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4571 return $fhighlights($id)
4573 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4574 return $rhighlights($id)
4579 proc bolden {id font} {
4580 global canv linehtag currentid boldids need_redisplay markedid
4582 # need_redisplay = 1 means the display is stale and about to be redrawn
4583 if {$need_redisplay} return
4585 $canv itemconf $linehtag($id) -font $font
4586 if {[info exists currentid] && $id eq $currentid} {
4588 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4589 -outline {{}} -tags secsel \
4590 -fill [$canv cget -selectbackground]]
4593 if {[info exists markedid] && $id eq $markedid} {
4598 proc bolden_name {id font} {
4599 global canv2 linentag currentid boldnameids need_redisplay
4601 if {$need_redisplay} return
4602 lappend boldnameids $id
4603 $canv2 itemconf $linentag($id) -font $font
4604 if {[info exists currentid] && $id eq $currentid} {
4605 $canv2 delete secsel
4606 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4607 -outline {{}} -tags secsel \
4608 -fill [$canv2 cget -selectbackground]]
4617 foreach id $boldids {
4618 if {![ishighlighted $id]} {
4621 lappend stillbold $id
4624 set boldids $stillbold
4627 proc addvhighlight {n} {
4628 global hlview viewcomplete curview vhl_done commitidx
4630 if {[info exists hlview]} {
4634 if {$n != $curview && ![info exists viewcomplete($n)]} {
4637 set vhl_done $commitidx($hlview)
4638 if {$vhl_done > 0} {
4643 proc delvhighlight {} {
4644 global hlview vhighlights
4646 if {![info exists hlview]} return
4648 unset -nocomplain vhighlights
4652 proc vhighlightmore {} {
4653 global hlview vhl_done commitidx vhighlights curview
4655 set max $commitidx($hlview)
4656 set vr [visiblerows]
4657 set r0 [lindex $vr 0]
4658 set r1 [lindex $vr 1]
4659 for {set i $vhl_done} {$i < $max} {incr i} {
4660 set id [commitonrow $i $hlview]
4661 if {[commitinview $id $curview]} {
4662 set row [rowofcommit $id]
4663 if {$r0 <= $row && $row <= $r1} {
4664 if {![highlighted $row]} {
4665 bolden $id mainfontbold
4667 set vhighlights($id) 1
4675 proc askvhighlight {row id} {
4676 global hlview vhighlights iddrawn
4678 if {[commitinview $id $hlview]} {
4679 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4680 bolden $id mainfontbold
4682 set vhighlights($id) 1
4684 set vhighlights($id) 0
4688 proc hfiles_change {} {
4689 global highlight_files filehighlight fhighlights fh_serial
4690 global highlight_paths
4692 if {[info exists filehighlight]} {
4693 # delete previous highlights
4694 catch {close $filehighlight}
4696 unset -nocomplain fhighlights
4698 unhighlight_filelist
4700 set highlight_paths {}
4701 after cancel do_file_hl $fh_serial
4703 if {$highlight_files ne {}} {
4704 after 300 do_file_hl $fh_serial
4708 proc gdttype_change {name ix op} {
4709 global gdttype highlight_files findstring findpattern
4712 if {$findstring ne {}} {
4713 if {$gdttype eq [mc "containing:"]} {
4714 if {$highlight_files ne {}} {
4715 set highlight_files {}
4720 if {$findpattern ne {}} {
4724 set highlight_files $findstring
4729 # enable/disable findtype/findloc menus too
4732 proc find_change {name ix op} {
4733 global gdttype findstring highlight_files
4736 if {$gdttype eq [mc "containing:"]} {
4739 if {$highlight_files ne $findstring} {
4740 set highlight_files $findstring
4747 proc findcom_change args {
4748 global nhighlights boldnameids
4749 global findpattern findtype findstring gdttype
4752 # delete previous highlights, if any
4753 foreach id $boldnameids {
4754 bolden_name $id mainfont
4757 unset -nocomplain nhighlights
4760 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4762 } elseif {$findtype eq [mc "Regexp"]} {
4763 set findpattern $findstring
4765 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4767 set findpattern "*$e*"
4771 proc makepatterns {l} {
4774 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4775 if {[string index $ee end] eq "/"} {
4785 proc do_file_hl {serial} {
4786 global highlight_files filehighlight highlight_paths gdttype fhl_list
4787 global cdup findtype
4789 if {$gdttype eq [mc "touching paths:"]} {
4790 # If "exact" match then convert backslashes to forward slashes.
4791 # Most useful to support Windows-flavoured file paths.
4792 if {$findtype eq [mc "Exact"]} {
4793 set highlight_files [string map {"\\" "/"} $highlight_files]
4795 if {[catch {set paths [shellsplit $highlight_files]}]} return
4796 set highlight_paths [makepatterns $paths]
4798 set relative_paths {}
4799 foreach path $paths {
4800 lappend relative_paths [file join $cdup $path]
4802 set gdtargs [concat -- $relative_paths]
4803 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4804 set gdtargs [list "-S$highlight_files"]
4805 } elseif {$gdttype eq [mc "changing lines matching:"]} {
4806 set gdtargs [list "-G$highlight_files"]
4808 # must be "containing:", i.e. we're searching commit info
4811 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4812 set filehighlight [open $cmd r+]
4813 fconfigure $filehighlight -blocking 0
4814 filerun $filehighlight readfhighlight
4820 proc flushhighlights {} {
4821 global filehighlight fhl_list
4823 if {[info exists filehighlight]} {
4825 puts $filehighlight ""
4826 flush $filehighlight
4830 proc askfilehighlight {row id} {
4831 global filehighlight fhighlights fhl_list
4833 lappend fhl_list $id
4834 set fhighlights($id) -1
4835 puts $filehighlight $id
4838 proc readfhighlight {} {
4839 global filehighlight fhighlights curview iddrawn
4840 global fhl_list find_dirn
4842 if {![info exists filehighlight]} {
4846 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4847 set line [string trim $line]
4848 set i [lsearch -exact $fhl_list $line]
4849 if {$i < 0} continue
4850 for {set j 0} {$j < $i} {incr j} {
4851 set id [lindex $fhl_list $j]
4852 set fhighlights($id) 0
4854 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4855 if {$line eq {}} continue
4856 if {![commitinview $line $curview]} continue
4857 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4858 bolden $line mainfontbold
4860 set fhighlights($line) 1
4862 if {[eof $filehighlight]} {
4864 puts "oops, git diff-tree died"
4865 catch {close $filehighlight}
4869 if {[info exists find_dirn]} {
4875 proc doesmatch {f} {
4876 global findtype findpattern
4878 if {$findtype eq [mc "Regexp"]} {
4879 return [regexp $findpattern $f]
4880 } elseif {$findtype eq [mc "IgnCase"]} {
4881 return [string match -nocase $findpattern $f]
4883 return [string match $findpattern $f]
4887 proc askfindhighlight {row id} {
4888 global nhighlights commitinfo iddrawn
4890 global markingmatches
4892 if {![info exists commitinfo($id)]} {
4895 set info $commitinfo($id)
4897 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4898 foreach f $info ty $fldtypes {
4899 if {$ty eq ""} continue
4900 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4902 if {$ty eq [mc "Author"]} {
4909 if {$isbold && [info exists iddrawn($id)]} {
4910 if {![ishighlighted $id]} {
4911 bolden $id mainfontbold
4913 bolden_name $id mainfontbold
4916 if {$markingmatches} {
4917 markrowmatches $row $id
4920 set nhighlights($id) $isbold
4923 proc markrowmatches {row id} {
4924 global canv canv2 linehtag linentag commitinfo findloc
4926 set headline [lindex $commitinfo($id) 0]
4927 set author [lindex $commitinfo($id) 1]
4928 $canv delete match$row
4929 $canv2 delete match$row
4930 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4931 set m [findmatches $headline]
4933 markmatches $canv $row $headline $linehtag($id) $m \
4934 [$canv itemcget $linehtag($id) -font] $row
4937 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4938 set m [findmatches $author]
4940 markmatches $canv2 $row $author $linentag($id) $m \
4941 [$canv2 itemcget $linentag($id) -font] $row
4946 proc vrel_change {name ix op} {
4947 global highlight_related
4950 if {$highlight_related ne [mc "None"]} {
4955 # prepare for testing whether commits are descendents or ancestors of a
4956 proc rhighlight_sel {a} {
4957 global descendent desc_todo ancestor anc_todo
4958 global highlight_related
4960 unset -nocomplain descendent
4961 set desc_todo [list $a]
4962 unset -nocomplain ancestor
4963 set anc_todo [list $a]
4964 if {$highlight_related ne [mc "None"]} {
4970 proc rhighlight_none {} {
4973 unset -nocomplain rhighlights
4977 proc is_descendent {a} {
4978 global curview children descendent desc_todo
4981 set la [rowofcommit $a]
4985 for {set i 0} {$i < [llength $todo]} {incr i} {
4986 set do [lindex $todo $i]
4987 if {[rowofcommit $do] < $la} {
4988 lappend leftover $do
4991 foreach nk $children($v,$do) {
4992 if {![info exists descendent($nk)]} {
4993 set descendent($nk) 1
5001 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5005 set descendent($a) 0
5006 set desc_todo $leftover
5009 proc is_ancestor {a} {
5010 global curview parents ancestor anc_todo
5013 set la [rowofcommit $a]
5017 for {set i 0} {$i < [llength $todo]} {incr i} {
5018 set do [lindex $todo $i]
5019 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5020 lappend leftover $do
5023 foreach np $parents($v,$do) {
5024 if {![info exists ancestor($np)]} {
5033 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5038 set anc_todo $leftover
5041 proc askrelhighlight {row id} {
5042 global descendent highlight_related iddrawn rhighlights
5043 global selectedline ancestor
5045 if {$selectedline eq {}} return
5047 if {$highlight_related eq [mc "Descendant"] ||
5048 $highlight_related eq [mc "Not descendant"]} {
5049 if {![info exists descendent($id)]} {
5052 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5055 } elseif {$highlight_related eq [mc "Ancestor"] ||
5056 $highlight_related eq [mc "Not ancestor"]} {
5057 if {![info exists ancestor($id)]} {
5060 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5064 if {[info exists iddrawn($id)]} {
5065 if {$isbold && ![ishighlighted $id]} {
5066 bolden $id mainfontbold
5069 set rhighlights($id) $isbold
5072 # Graph layout functions
5074 proc shortids {ids} {
5077 if {[llength $id] > 1} {
5078 lappend res [shortids $id]
5079 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5080 lappend res [string range $id 0 7]
5091 for {set mask 1} {$mask <= $n} {incr mask $mask} {
5092 if {($n & $mask) != 0} {
5093 set ret [concat $ret $o]
5095 set o [concat $o $o]
5100 proc ordertoken {id} {
5101 global ordertok curview varcid varcstart varctok curview parents children
5102 global nullid nullid2
5104 if {[info exists ordertok($id)]} {
5105 return $ordertok($id)
5110 if {[info exists varcid($curview,$id)]} {
5111 set a $varcid($curview,$id)
5112 set p [lindex $varcstart($curview) $a]
5114 set p [lindex $children($curview,$id) 0]
5116 if {[info exists ordertok($p)]} {
5117 set tok $ordertok($p)
5120 set id [first_real_child $curview,$p]
5123 set tok [lindex $varctok($curview) $varcid($curview,$p)]
5126 if {[llength $parents($curview,$id)] == 1} {
5127 lappend todo [list $p {}]
5129 set j [lsearch -exact $parents($curview,$id) $p]
5131 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5133 lappend todo [list $p [strrep $j]]
5136 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5137 set p [lindex $todo $i 0]
5138 append tok [lindex $todo $i 1]
5139 set ordertok($p) $tok
5141 set ordertok($origid) $tok
5145 # Work out where id should go in idlist so that order-token
5146 # values increase from left to right
5147 proc idcol {idlist id {i 0}} {
5148 set t [ordertoken $id]
5152 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5153 if {$i > [llength $idlist]} {
5154 set i [llength $idlist]
5156 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5159 if {$t > [ordertoken [lindex $idlist $i]]} {
5160 while {[incr i] < [llength $idlist] &&
5161 $t >= [ordertoken [lindex $idlist $i]]} {}
5167 proc initlayout {} {
5168 global rowidlist rowisopt rowfinal displayorder parentlist
5169 global numcommits canvxmax canv
5171 global colormap rowtextx
5180 set canvxmax [$canv cget -width]
5181 unset -nocomplain colormap
5182 unset -nocomplain rowtextx
5186 proc setcanvscroll {} {
5187 global canv canv2 canv3 numcommits linespc canvxmax canvy0
5188 global lastscrollset lastscrollrows
5190 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5191 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5192 $canv2 conf -scrollregion [list 0 0 0 $ymax]
5193 $canv3 conf -scrollregion [list 0 0 0 $ymax]
5194 set lastscrollset [clock clicks -milliseconds]
5195 set lastscrollrows $numcommits
5198 proc visiblerows {} {
5199 global canv numcommits linespc
5201 set ymax [lindex [$canv cget -scrollregion] 3]
5202 if {$ymax eq {} || $ymax == 0} return
5204 set y0 [expr {int([lindex $f 0] * $ymax)}]
5205 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5209 set y1 [expr {int([lindex $f 1] * $ymax)}]
5210 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5211 if {$r1 >= $numcommits} {
5212 set r1 [expr {$numcommits - 1}]
5214 return [list $r0 $r1]
5217 proc layoutmore {} {
5218 global commitidx viewcomplete curview
5219 global numcommits pending_select curview
5220 global lastscrollset lastscrollrows
5222 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5223 [clock clicks -milliseconds] - $lastscrollset > 500} {
5226 if {[info exists pending_select] &&
5227 [commitinview $pending_select $curview]} {
5229 selectline [rowofcommit $pending_select] 1
5234 # With path limiting, we mightn't get the actual HEAD commit,
5235 # so ask git rev-list what is the first ancestor of HEAD that
5236 # touches a file in the path limit.
5237 proc get_viewmainhead {view} {
5238 global viewmainheadid vfilelimit viewinstances mainheadid
5241 set rfd [open [concat | git rev-list -1 $mainheadid \
5242 -- $vfilelimit($view)] r]
5243 set j [reg_instance $rfd]
5244 lappend viewinstances($view) $j
5245 fconfigure $rfd -blocking 0
5246 filerun $rfd [list getviewhead $rfd $j $view]
5247 set viewmainheadid($curview) {}
5251 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5252 proc getviewhead {fd inst view} {
5253 global viewmainheadid commfd curview viewinstances showlocalchanges
5256 if {[gets $fd line] < 0} {
5260 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5263 set viewmainheadid($view) $id
5266 set i [lsearch -exact $viewinstances($view) $inst]
5268 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5270 if {$showlocalchanges && $id ne {} && $view == $curview} {
5276 proc doshowlocalchanges {} {
5277 global curview viewmainheadid
5279 if {$viewmainheadid($curview) eq {}} return
5280 if {[commitinview $viewmainheadid($curview) $curview]} {
5283 interestedin $viewmainheadid($curview) dodiffindex
5287 proc dohidelocalchanges {} {
5288 global nullid nullid2 lserial curview
5290 if {[commitinview $nullid $curview]} {
5291 removefakerow $nullid
5293 if {[commitinview $nullid2 $curview]} {
5294 removefakerow $nullid2
5299 # spawn off a process to do git diff-index --cached HEAD
5300 proc dodiffindex {} {
5301 global lserial showlocalchanges vfilelimit curview
5302 global hasworktree git_version
5304 if {!$showlocalchanges || !$hasworktree} return
5306 if {[package vcompare $git_version "1.7.2"] >= 0} {
5307 set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5309 set cmd "|git diff-index --cached HEAD"
5311 if {$vfilelimit($curview) ne {}} {
5312 set cmd [concat $cmd -- $vfilelimit($curview)]
5314 set fd [open $cmd r]
5315 fconfigure $fd -blocking 0
5316 set i [reg_instance $fd]
5317 filerun $fd [list readdiffindex $fd $lserial $i]
5320 proc readdiffindex {fd serial inst} {
5321 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5325 if {[gets $fd line] < 0} {
5331 # we only need to see one line and we don't really care what it says...
5334 if {$serial != $lserial} {
5338 # now see if there are any local changes not checked in to the index
5339 set cmd "|git diff-files"
5340 if {$vfilelimit($curview) ne {}} {
5341 set cmd [concat $cmd -- $vfilelimit($curview)]
5343 set fd [open $cmd r]
5344 fconfigure $fd -blocking 0
5345 set i [reg_instance $fd]
5346 filerun $fd [list readdifffiles $fd $serial $i]
5348 if {$isdiff && ![commitinview $nullid2 $curview]} {
5349 # add the line for the changes in the index to the graph
5350 set hl [mc "Local changes checked in to index but not committed"]
5351 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5352 set commitdata($nullid2) "\n $hl\n"
5353 if {[commitinview $nullid $curview]} {
5354 removefakerow $nullid
5356 insertfakerow $nullid2 $viewmainheadid($curview)
5357 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5358 if {[commitinview $nullid $curview]} {
5359 removefakerow $nullid
5361 removefakerow $nullid2
5366 proc readdifffiles {fd serial inst} {
5367 global viewmainheadid nullid nullid2 curview
5368 global commitinfo commitdata lserial
5371 if {[gets $fd line] < 0} {
5377 # we only need to see one line and we don't really care what it says...
5380 if {$serial != $lserial} {
5384 if {$isdiff && ![commitinview $nullid $curview]} {
5385 # add the line for the local diff to the graph
5386 set hl [mc "Local uncommitted changes, not checked in to index"]
5387 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5388 set commitdata($nullid) "\n $hl\n"
5389 if {[commitinview $nullid2 $curview]} {
5392 set p $viewmainheadid($curview)
5394 insertfakerow $nullid $p
5395 } elseif {!$isdiff && [commitinview $nullid $curview]} {
5396 removefakerow $nullid
5401 proc nextuse {id row} {
5402 global curview children
5404 if {[info exists children($curview,$id)]} {
5405 foreach kid $children($curview,$id) {
5406 if {![commitinview $kid $curview]} {
5409 if {[rowofcommit $kid] > $row} {
5410 return [rowofcommit $kid]
5414 if {[commitinview $id $curview]} {
5415 return [rowofcommit $id]
5420 proc prevuse {id row} {
5421 global curview children
5424 if {[info exists children($curview,$id)]} {
5425 foreach kid $children($curview,$id) {
5426 if {![commitinview $kid $curview]} break
5427 if {[rowofcommit $kid] < $row} {
5428 set ret [rowofcommit $kid]
5435 proc make_idlist {row} {
5436 global displayorder parentlist uparrowlen downarrowlen mingaplen
5437 global commitidx curview children
5439 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5443 set ra [expr {$row - $downarrowlen}]
5447 set rb [expr {$row + $uparrowlen}]
5448 if {$rb > $commitidx($curview)} {
5449 set rb $commitidx($curview)
5451 make_disporder $r [expr {$rb + 1}]
5453 for {} {$r < $ra} {incr r} {
5454 set nextid [lindex $displayorder [expr {$r + 1}]]
5455 foreach p [lindex $parentlist $r] {
5456 if {$p eq $nextid} continue
5457 set rn [nextuse $p $r]
5459 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5460 lappend ids [list [ordertoken $p] $p]
5464 for {} {$r < $row} {incr r} {
5465 set nextid [lindex $displayorder [expr {$r + 1}]]
5466 foreach p [lindex $parentlist $r] {
5467 if {$p eq $nextid} continue
5468 set rn [nextuse $p $r]
5469 if {$rn < 0 || $rn >= $row} {
5470 lappend ids [list [ordertoken $p] $p]
5474 set id [lindex $displayorder $row]
5475 lappend ids [list [ordertoken $id] $id]
5477 foreach p [lindex $parentlist $r] {
5478 set firstkid [lindex $children($curview,$p) 0]
5479 if {[rowofcommit $firstkid] < $row} {
5480 lappend ids [list [ordertoken $p] $p]
5484 set id [lindex $displayorder $r]
5486 set firstkid [lindex $children($curview,$id) 0]
5487 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5488 lappend ids [list [ordertoken $id] $id]
5493 foreach idx [lsort -unique $ids] {
5494 lappend idlist [lindex $idx 1]
5499 proc rowsequal {a b} {
5500 while {[set i [lsearch -exact $a {}]] >= 0} {
5501 set a [lreplace $a $i $i]
5503 while {[set i [lsearch -exact $b {}]] >= 0} {
5504 set b [lreplace $b $i $i]
5506 return [expr {$a eq $b}]
5509 proc makeupline {id row rend col} {
5510 global rowidlist uparrowlen downarrowlen mingaplen
5512 for {set r $rend} {1} {set r $rstart} {
5513 set rstart [prevuse $id $r]
5514 if {$rstart < 0} return
5515 if {$rstart < $row} break
5517 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5518 set rstart [expr {$rend - $uparrowlen - 1}]
5520 for {set r $rstart} {[incr r] <= $row} {} {
5521 set idlist [lindex $rowidlist $r]
5522 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5523 set col [idcol $idlist $id $col]
5524 lset rowidlist $r [linsert $idlist $col $id]
5530 proc layoutrows {row endrow} {
5531 global rowidlist rowisopt rowfinal displayorder
5532 global uparrowlen downarrowlen maxwidth mingaplen
5533 global children parentlist
5534 global commitidx viewcomplete curview
5536 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5539 set rm1 [expr {$row - 1}]
5540 foreach id [lindex $rowidlist $rm1] {
5545 set final [lindex $rowfinal $rm1]
5547 for {} {$row < $endrow} {incr row} {
5548 set rm1 [expr {$row - 1}]
5549 if {$rm1 < 0 || $idlist eq {}} {
5550 set idlist [make_idlist $row]
5553 set id [lindex $displayorder $rm1]
5554 set col [lsearch -exact $idlist $id]
5555 set idlist [lreplace $idlist $col $col]
5556 foreach p [lindex $parentlist $rm1] {
5557 if {[lsearch -exact $idlist $p] < 0} {
5558 set col [idcol $idlist $p $col]
5559 set idlist [linsert $idlist $col $p]
5560 # if not the first child, we have to insert a line going up
5561 if {$id ne [lindex $children($curview,$p) 0]} {
5562 makeupline $p $rm1 $row $col
5566 set id [lindex $displayorder $row]
5567 if {$row > $downarrowlen} {
5568 set termrow [expr {$row - $downarrowlen - 1}]
5569 foreach p [lindex $parentlist $termrow] {
5570 set i [lsearch -exact $idlist $p]
5571 if {$i < 0} continue
5572 set nr [nextuse $p $termrow]
5573 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5574 set idlist [lreplace $idlist $i $i]
5578 set col [lsearch -exact $idlist $id]
5580 set col [idcol $idlist $id]
5581 set idlist [linsert $idlist $col $id]
5582 if {$children($curview,$id) ne {}} {
5583 makeupline $id $rm1 $row $col
5586 set r [expr {$row + $uparrowlen - 1}]
5587 if {$r < $commitidx($curview)} {
5589 foreach p [lindex $parentlist $r] {
5590 if {[lsearch -exact $idlist $p] >= 0} continue
5591 set fk [lindex $children($curview,$p) 0]
5592 if {[rowofcommit $fk] < $row} {
5593 set x [idcol $idlist $p $x]
5594 set idlist [linsert $idlist $x $p]
5597 if {[incr r] < $commitidx($curview)} {
5598 set p [lindex $displayorder $r]
5599 if {[lsearch -exact $idlist $p] < 0} {
5600 set fk [lindex $children($curview,$p) 0]
5601 if {$fk ne {} && [rowofcommit $fk] < $row} {
5602 set x [idcol $idlist $p $x]
5603 set idlist [linsert $idlist $x $p]
5609 if {$final && !$viewcomplete($curview) &&
5610 $row + $uparrowlen + $mingaplen + $downarrowlen
5611 >= $commitidx($curview)} {
5614 set l [llength $rowidlist]
5616 lappend rowidlist $idlist
5618 lappend rowfinal $final
5619 } elseif {$row < $l} {
5620 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5621 lset rowidlist $row $idlist
5624 lset rowfinal $row $final
5626 set pad [ntimes [expr {$row - $l}] {}]
5627 set rowidlist [concat $rowidlist $pad]
5628 lappend rowidlist $idlist
5629 set rowfinal [concat $rowfinal $pad]
5630 lappend rowfinal $final
5631 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5637 proc changedrow {row} {
5638 global displayorder iddrawn rowisopt need_redisplay
5640 set l [llength $rowisopt]
5642 lset rowisopt $row 0
5643 if {$row + 1 < $l} {
5644 lset rowisopt [expr {$row + 1}] 0
5645 if {$row + 2 < $l} {
5646 lset rowisopt [expr {$row + 2}] 0
5650 set id [lindex $displayorder $row]
5651 if {[info exists iddrawn($id)]} {
5652 set need_redisplay 1
5656 proc insert_pad {row col npad} {
5659 set pad [ntimes $npad {}]
5660 set idlist [lindex $rowidlist $row]
5661 set bef [lrange $idlist 0 [expr {$col - 1}]]
5662 set aft [lrange $idlist $col end]
5663 set i [lsearch -exact $aft {}]
5665 set aft [lreplace $aft $i $i]
5667 lset rowidlist $row [concat $bef $pad $aft]
5671 proc optimize_rows {row col endrow} {
5672 global rowidlist rowisopt displayorder curview children
5677 for {} {$row < $endrow} {incr row; set col 0} {
5678 if {[lindex $rowisopt $row]} continue
5680 set y0 [expr {$row - 1}]
5681 set ym [expr {$row - 2}]
5682 set idlist [lindex $rowidlist $row]
5683 set previdlist [lindex $rowidlist $y0]
5684 if {$idlist eq {} || $previdlist eq {}} continue
5686 set pprevidlist [lindex $rowidlist $ym]
5687 if {$pprevidlist eq {}} continue
5693 for {} {$col < [llength $idlist]} {incr col} {
5694 set id [lindex $idlist $col]
5695 if {[lindex $previdlist $col] eq $id} continue
5700 set x0 [lsearch -exact $previdlist $id]
5701 if {$x0 < 0} continue
5702 set z [expr {$x0 - $col}]
5706 set xm [lsearch -exact $pprevidlist $id]
5708 set z0 [expr {$xm - $x0}]
5712 # if row y0 is the first child of $id then it's not an arrow
5713 if {[lindex $children($curview,$id) 0] ne
5714 [lindex $displayorder $y0]} {
5718 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5719 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5722 # Looking at lines from this row to the previous row,
5723 # make them go straight up if they end in an arrow on
5724 # the previous row; otherwise make them go straight up
5726 if {$z < -1 || ($z < 0 && $isarrow)} {
5727 # Line currently goes left too much;
5728 # insert pads in the previous row, then optimize it
5729 set npad [expr {-1 - $z + $isarrow}]
5730 insert_pad $y0 $x0 $npad
5732 optimize_rows $y0 $x0 $row
5734 set previdlist [lindex $rowidlist $y0]
5735 set x0 [lsearch -exact $previdlist $id]
5736 set z [expr {$x0 - $col}]
5738 set pprevidlist [lindex $rowidlist $ym]
5739 set xm [lsearch -exact $pprevidlist $id]
5740 set z0 [expr {$xm - $x0}]
5742 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5743 # Line currently goes right too much;
5744 # insert pads in this line
5745 set npad [expr {$z - 1 + $isarrow}]
5746 insert_pad $row $col $npad
5747 set idlist [lindex $rowidlist $row]
5749 set z [expr {$x0 - $col}]
5752 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5753 # this line links to its first child on row $row-2
5754 set id [lindex $displayorder $ym]
5755 set xc [lsearch -exact $pprevidlist $id]
5757 set z0 [expr {$xc - $x0}]
5760 # avoid lines jigging left then immediately right
5761 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5762 insert_pad $y0 $x0 1
5764 optimize_rows $y0 $x0 $row
5765 set previdlist [lindex $rowidlist $y0]
5769 # Find the first column that doesn't have a line going right
5770 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5771 set id [lindex $idlist $col]
5772 if {$id eq {}} break
5773 set x0 [lsearch -exact $previdlist $id]
5775 # check if this is the link to the first child
5776 set kid [lindex $displayorder $y0]
5777 if {[lindex $children($curview,$id) 0] eq $kid} {
5778 # it is, work out offset to child
5779 set x0 [lsearch -exact $previdlist $kid]
5782 if {$x0 <= $col} break
5784 # Insert a pad at that column as long as it has a line and
5785 # isn't the last column
5786 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5787 set idlist [linsert $idlist $col {}]
5788 lset rowidlist $row $idlist
5796 global canvx0 linespc
5797 return [expr {$canvx0 + $col * $linespc}]
5801 global canvy0 linespc
5802 return [expr {$canvy0 + $row * $linespc}]
5805 proc linewidth {id} {
5806 global thickerline lthickness
5809 if {[info exists thickerline] && $id eq $thickerline} {
5810 set wid [expr {2 * $lthickness}]
5815 proc rowranges {id} {
5816 global curview children uparrowlen downarrowlen
5819 set kids $children($curview,$id)
5825 foreach child $kids {
5826 if {![commitinview $child $curview]} break
5827 set row [rowofcommit $child]
5828 if {![info exists prev]} {
5829 lappend ret [expr {$row + 1}]
5831 if {$row <= $prevrow} {
5832 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5834 # see if the line extends the whole way from prevrow to row
5835 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5836 [lsearch -exact [lindex $rowidlist \
5837 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5838 # it doesn't, see where it ends
5839 set r [expr {$prevrow + $downarrowlen}]
5840 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5841 while {[incr r -1] > $prevrow &&
5842 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5844 while {[incr r] <= $row &&
5845 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5849 # see where it starts up again
5850 set r [expr {$row - $uparrowlen}]
5851 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5852 while {[incr r] < $row &&
5853 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5855 while {[incr r -1] >= $prevrow &&
5856 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5862 if {$child eq $id} {
5871 proc drawlineseg {id row endrow arrowlow} {
5872 global rowidlist displayorder iddrawn linesegs
5873 global canv colormap linespc curview maxlinelen parentlist
5875 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5876 set le [expr {$row + 1}]
5879 set c [lsearch -exact [lindex $rowidlist $le] $id]
5885 set x [lindex $displayorder $le]
5890 if {[info exists iddrawn($x)] || $le == $endrow} {
5891 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5907 if {[info exists linesegs($id)]} {
5908 set lines $linesegs($id)
5910 set r0 [lindex $li 0]
5912 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5922 set li [lindex $lines [expr {$i-1}]]
5923 set r1 [lindex $li 1]
5924 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5929 set x [lindex $cols [expr {$le - $row}]]
5930 set xp [lindex $cols [expr {$le - 1 - $row}]]
5931 set dir [expr {$xp - $x}]
5933 set ith [lindex $lines $i 2]
5934 set coords [$canv coords $ith]
5935 set ah [$canv itemcget $ith -arrow]
5936 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5937 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5938 if {$x2 ne {} && $x - $x2 == $dir} {
5939 set coords [lrange $coords 0 end-2]
5942 set coords [list [xc $le $x] [yc $le]]
5945 set itl [lindex $lines [expr {$i-1}] 2]
5946 set al [$canv itemcget $itl -arrow]
5947 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5948 } elseif {$arrowlow} {
5949 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5950 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5954 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5955 for {set y $le} {[incr y -1] > $row} {} {
5957 set xp [lindex $cols [expr {$y - 1 - $row}]]
5958 set ndir [expr {$xp - $x}]
5959 if {$dir != $ndir || $xp < 0} {
5960 lappend coords [xc $y $x] [yc $y]
5966 # join parent line to first child
5967 set ch [lindex $displayorder $row]
5968 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5970 puts "oops: drawlineseg: child $ch not on row $row"
5971 } elseif {$xc != $x} {
5972 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5973 set d [expr {int(0.5 * $linespc)}]
5976 set x2 [expr {$x1 - $d}]
5978 set x2 [expr {$x1 + $d}]
5981 set y1 [expr {$y2 + $d}]
5982 lappend coords $x1 $y1 $x2 $y2
5983 } elseif {$xc < $x - 1} {
5984 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5985 } elseif {$xc > $x + 1} {
5986 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5990 lappend coords [xc $row $x] [yc $row]
5992 set xn [xc $row $xp]
5994 lappend coords $xn $yn
5998 set t [$canv create line $coords -width [linewidth $id] \
5999 -fill $colormap($id) -tags lines.$id -arrow $arrow]
6002 set lines [linsert $lines $i [list $row $le $t]]
6004 $canv coords $ith $coords
6005 if {$arrow ne $ah} {
6006 $canv itemconf $ith -arrow $arrow
6008 lset lines $i 0 $row
6011 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6012 set ndir [expr {$xo - $xp}]
6013 set clow [$canv coords $itl]
6014 if {$dir == $ndir} {
6015 set clow [lrange $clow 2 end]
6017 set coords [concat $coords $clow]
6019 lset lines [expr {$i-1}] 1 $le
6021 # coalesce two pieces
6023 set b [lindex $lines [expr {$i-1}] 0]
6024 set e [lindex $lines $i 1]
6025 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6027 $canv coords $itl $coords
6028 if {$arrow ne $al} {
6029 $canv itemconf $itl -arrow $arrow
6033 set linesegs($id) $lines
6037 proc drawparentlinks {id row} {
6038 global rowidlist canv colormap curview parentlist
6039 global idpos linespc
6041 set rowids [lindex $rowidlist $row]
6042 set col [lsearch -exact $rowids $id]
6043 if {$col < 0} return
6044 set olds [lindex $parentlist $row]
6045 set row2 [expr {$row + 1}]
6046 set x [xc $row $col]
6049 set d [expr {int(0.5 * $linespc)}]
6050 set ymid [expr {$y + $d}]
6051 set ids [lindex $rowidlist $row2]
6052 # rmx = right-most X coord used
6055 set i [lsearch -exact $ids $p]
6057 puts "oops, parent $p of $id not in list"
6060 set x2 [xc $row2 $i]
6064 set j [lsearch -exact $rowids $p]
6066 # drawlineseg will do this one for us
6070 # should handle duplicated parents here...
6071 set coords [list $x $y]
6073 # if attaching to a vertical segment, draw a smaller
6074 # slant for visual distinctness
6077 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6079 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6081 } elseif {$i < $col && $i < $j} {
6082 # segment slants towards us already
6083 lappend coords [xc $row $j] $y
6085 if {$i < $col - 1} {
6086 lappend coords [expr {$x2 + $linespc}] $y
6087 } elseif {$i > $col + 1} {
6088 lappend coords [expr {$x2 - $linespc}] $y
6090 lappend coords $x2 $y2
6093 lappend coords $x2 $y2
6095 set t [$canv create line $coords -width [linewidth $p] \
6096 -fill $colormap($p) -tags lines.$p]
6100 if {$rmx > [lindex $idpos($id) 1]} {
6101 lset idpos($id) 1 $rmx
6106 proc drawlines {id} {
6109 $canv itemconf lines.$id -width [linewidth $id]
6112 proc drawcmittext {id row col} {
6113 global linespc canv canv2 canv3 fgcolor curview
6114 global cmitlisted commitinfo rowidlist parentlist
6115 global rowtextx idpos idtags idheads idotherrefs
6116 global linehtag linentag linedtag selectedline
6117 global canvxmax boldids boldnameids fgcolor markedid
6118 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6119 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6120 global circleoutlinecolor
6122 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6123 set listed $cmitlisted($curview,$id)
6124 if {$id eq $nullid} {
6125 set ofill $workingfilescirclecolor
6126 } elseif {$id eq $nullid2} {
6127 set ofill $indexcirclecolor
6128 } elseif {$id eq $mainheadid} {
6129 set ofill $mainheadcirclecolor
6131 set ofill [lindex $circlecolors $listed]
6133 set x [xc $row $col]
6135 set orad [expr {$linespc / 3}]
6137 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6138 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6139 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6140 } elseif {$listed == 3} {
6141 # triangle pointing left for left-side commits
6142 set t [$canv create polygon \
6143 [expr {$x - $orad}] $y \
6144 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6145 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6146 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6148 # triangle pointing right for right-side commits
6149 set t [$canv create polygon \
6150 [expr {$x + $orad - 1}] $y \
6151 [expr {$x - $orad}] [expr {$y - $orad}] \
6152 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6153 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6155 set circleitem($row) $t
6157 $canv bind $t <1> {selcanvline {} %x %y}
6158 set rmx [llength [lindex $rowidlist $row]]
6159 set olds [lindex $parentlist $row]
6161 set nextids [lindex $rowidlist [expr {$row + 1}]]
6163 set i [lsearch -exact $nextids $p]
6169 set xt [xc $row $rmx]
6170 set rowtextx($row) $xt
6171 set idpos($id) [list $x $xt $y]
6172 if {[info exists idtags($id)] || [info exists idheads($id)]
6173 || [info exists idotherrefs($id)]} {
6174 set xt [drawtags $id $x $xt $y]
6176 if {[lindex $commitinfo($id) 6] > 0} {
6177 set xt [drawnotesign $xt $y]
6179 set headline [lindex $commitinfo($id) 0]
6180 set name [lindex $commitinfo($id) 1]
6181 set date [lindex $commitinfo($id) 2]
6182 set date [formatdate $date]
6185 set isbold [ishighlighted $id]
6188 set font mainfontbold
6190 lappend boldnameids $id
6191 set nfont mainfontbold
6194 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6195 -text $headline -font $font -tags text]
6196 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6197 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6198 -text $name -font $nfont -tags text]
6199 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6200 -text $date -font mainfont -tags text]
6201 if {$selectedline == $row} {
6204 if {[info exists markedid] && $markedid eq $id} {
6207 set xr [expr {$xt + [font measure $font $headline]}]
6208 if {$xr > $canvxmax} {
6214 proc drawcmitrow {row} {
6215 global displayorder rowidlist nrows_drawn
6216 global iddrawn markingmatches
6217 global commitinfo numcommits
6218 global filehighlight fhighlights findpattern nhighlights
6219 global hlview vhighlights
6220 global highlight_related rhighlights
6222 if {$row >= $numcommits} return
6224 set id [lindex $displayorder $row]
6225 if {[info exists hlview] && ![info exists vhighlights($id)]} {
6226 askvhighlight $row $id
6228 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6229 askfilehighlight $row $id
6231 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6232 askfindhighlight $row $id
6234 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6235 askrelhighlight $row $id
6237 if {![info exists iddrawn($id)]} {
6238 set col [lsearch -exact [lindex $rowidlist $row] $id]
6240 puts "oops, row $row id $id not in list"
6243 if {![info exists commitinfo($id)]} {
6247 drawcmittext $id $row $col
6251 if {$markingmatches} {
6252 markrowmatches $row $id
6256 proc drawcommits {row {endrow {}}} {
6257 global numcommits iddrawn displayorder curview need_redisplay
6258 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6263 if {$endrow eq {}} {
6266 if {$endrow >= $numcommits} {
6267 set endrow [expr {$numcommits - 1}]
6270 set rl1 [expr {$row - $downarrowlen - 3}]
6274 set ro1 [expr {$row - 3}]
6278 set r2 [expr {$endrow + $uparrowlen + 3}]
6279 if {$r2 > $numcommits} {
6282 for {set r $rl1} {$r < $r2} {incr r} {
6283 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6287 set rl1 [expr {$r + 1}]
6293 optimize_rows $ro1 0 $r2
6294 if {$need_redisplay || $nrows_drawn > 2000} {
6298 # make the lines join to already-drawn rows either side
6299 set r [expr {$row - 1}]
6300 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6303 set er [expr {$endrow + 1}]
6304 if {$er >= $numcommits ||
6305 ![info exists iddrawn([lindex $displayorder $er])]} {
6308 for {} {$r <= $er} {incr r} {
6309 set id [lindex $displayorder $r]
6310 set wasdrawn [info exists iddrawn($id)]
6312 if {$r == $er} break
6313 set nextid [lindex $displayorder [expr {$r + 1}]]
6314 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6315 drawparentlinks $id $r
6317 set rowids [lindex $rowidlist $r]
6318 foreach lid $rowids {
6319 if {$lid eq {}} continue
6320 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6322 # see if this is the first child of any of its parents
6323 foreach p [lindex $parentlist $r] {
6324 if {[lsearch -exact $rowids $p] < 0} {
6325 # make this line extend up to the child
6326 set lineend($p) [drawlineseg $p $r $er 0]
6330 set lineend($lid) [drawlineseg $lid $r $er 1]
6336 proc undolayout {row} {
6337 global uparrowlen mingaplen downarrowlen
6338 global rowidlist rowisopt rowfinal need_redisplay
6340 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6344 if {[llength $rowidlist] > $r} {
6346 set rowidlist [lrange $rowidlist 0 $r]
6347 set rowfinal [lrange $rowfinal 0 $r]
6348 set rowisopt [lrange $rowisopt 0 $r]
6349 set need_redisplay 1
6354 proc drawvisible {} {
6355 global canv linespc curview vrowmod selectedline targetrow targetid
6356 global need_redisplay cscroll numcommits
6358 set fs [$canv yview]
6359 set ymax [lindex [$canv cget -scrollregion] 3]
6360 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6361 set f0 [lindex $fs 0]
6362 set f1 [lindex $fs 1]
6363 set y0 [expr {int($f0 * $ymax)}]
6364 set y1 [expr {int($f1 * $ymax)}]
6366 if {[info exists targetid]} {
6367 if {[commitinview $targetid $curview]} {
6368 set r [rowofcommit $targetid]
6369 if {$r != $targetrow} {
6370 # Fix up the scrollregion and change the scrolling position
6371 # now that our target row has moved.
6372 set diff [expr {($r - $targetrow) * $linespc}]
6375 set ymax [lindex [$canv cget -scrollregion] 3]
6378 set f0 [expr {$y0 / $ymax}]
6379 set f1 [expr {$y1 / $ymax}]
6380 allcanvs yview moveto $f0
6381 $cscroll set $f0 $f1
6382 set need_redisplay 1
6389 set row [expr {int(($y0 - 3) / $linespc) - 1}]
6390 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6391 if {$endrow >= $vrowmod($curview)} {
6392 update_arcrows $curview
6394 if {$selectedline ne {} &&
6395 $row <= $selectedline && $selectedline <= $endrow} {
6396 set targetrow $selectedline
6397 } elseif {[info exists targetid]} {
6398 set targetrow [expr {int(($row + $endrow) / 2)}]
6400 if {[info exists targetrow]} {
6401 if {$targetrow >= $numcommits} {
6402 set targetrow [expr {$numcommits - 1}]
6404 set targetid [commitonrow $targetrow]
6406 drawcommits $row $endrow
6409 proc clear_display {} {
6410 global iddrawn linesegs need_redisplay nrows_drawn
6411 global vhighlights fhighlights nhighlights rhighlights
6412 global linehtag linentag linedtag boldids boldnameids
6415 unset -nocomplain iddrawn
6416 unset -nocomplain linesegs
6417 unset -nocomplain linehtag
6418 unset -nocomplain linentag
6419 unset -nocomplain linedtag
6422 unset -nocomplain vhighlights
6423 unset -nocomplain fhighlights
6424 unset -nocomplain nhighlights
6425 unset -nocomplain rhighlights
6426 set need_redisplay 0
6430 proc findcrossings {id} {
6431 global rowidlist parentlist numcommits displayorder
6435 foreach {s e} [rowranges $id] {
6436 if {$e >= $numcommits} {
6437 set e [expr {$numcommits - 1}]
6439 if {$e <= $s} continue
6440 for {set row $e} {[incr row -1] >= $s} {} {
6441 set x [lsearch -exact [lindex $rowidlist $row] $id]
6443 set olds [lindex $parentlist $row]
6444 set kid [lindex $displayorder $row]
6445 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6446 if {$kidx < 0} continue
6447 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6449 set px [lsearch -exact $nextrow $p]
6450 if {$px < 0} continue
6451 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6452 if {[lsearch -exact $ccross $p] >= 0} continue
6453 if {$x == $px + ($kidx < $px? -1: 1)} {
6455 } elseif {[lsearch -exact $cross $p] < 0} {
6462 return [concat $ccross {{}} $cross]
6465 proc assigncolor {id} {
6466 global colormap colors nextcolor
6467 global parents children children curview
6469 if {[info exists colormap($id)]} return
6470 set ncolors [llength $colors]
6471 if {[info exists children($curview,$id)]} {
6472 set kids $children($curview,$id)
6476 if {[llength $kids] == 1} {
6477 set child [lindex $kids 0]
6478 if {[info exists colormap($child)]
6479 && [llength $parents($curview,$child)] == 1} {
6480 set colormap($id) $colormap($child)
6486 foreach x [findcrossings $id] {
6488 # delimiter between corner crossings and other crossings
6489 if {[llength $badcolors] >= $ncolors - 1} break
6490 set origbad $badcolors
6492 if {[info exists colormap($x)]
6493 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6494 lappend badcolors $colormap($x)
6497 if {[llength $badcolors] >= $ncolors} {
6498 set badcolors $origbad
6500 set origbad $badcolors
6501 if {[llength $badcolors] < $ncolors - 1} {
6502 foreach child $kids {
6503 if {[info exists colormap($child)]
6504 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6505 lappend badcolors $colormap($child)
6507 foreach p $parents($curview,$child) {
6508 if {[info exists colormap($p)]
6509 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6510 lappend badcolors $colormap($p)
6514 if {[llength $badcolors] >= $ncolors} {
6515 set badcolors $origbad
6518 for {set i 0} {$i <= $ncolors} {incr i} {
6519 set c [lindex $colors $nextcolor]
6520 if {[incr nextcolor] >= $ncolors} {
6523 if {[lsearch -exact $badcolors $c]} break
6525 set colormap($id) $c
6528 proc bindline {t id} {
6531 $canv bind $t <Enter> "lineenter %x %y $id"
6532 $canv bind $t <Motion> "linemotion %x %y $id"
6533 $canv bind $t <Leave> "lineleave $id"
6534 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6537 proc graph_pane_width {} {
6541 set g [.tf.histframe.pwclist sashpos 0]
6543 set g [.tf.histframe.pwclist sash coord 0]
6545 return [lindex $g 0]
6548 proc totalwidth {l font extra} {
6551 set tot [expr {$tot + [font measure $font $str] + $extra}]
6556 proc drawtags {id x xt y1} {
6557 global idtags idheads idotherrefs mainhead
6558 global linespc lthickness
6559 global canv rowtextx curview fgcolor bgcolor ctxbut
6560 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6561 global tagbgcolor tagfgcolor tagoutlinecolor
6570 set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6571 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6572 set extra [expr {$delta + $lthickness + $linespc}]
6574 if {[info exists idtags($id)]} {
6575 set marks $idtags($id)
6576 set ntags [llength $marks]
6577 if {$ntags > $maxtags ||
6578 [totalwidth $marks mainfont $extra] > $maxwidth} {
6579 # show just a single "n tags..." tag
6582 set marks [list "tag..."]
6584 set marks [list [format "%d tags..." $ntags]]
6589 if {[info exists idheads($id)]} {
6590 set marks [concat $marks $idheads($id)]
6591 set nheads [llength $idheads($id)]
6593 if {[info exists idotherrefs($id)]} {
6594 set marks [concat $marks $idotherrefs($id)]
6600 set yt [expr {$y1 - 0.5 * $linespc}]
6601 set yb [expr {$yt + $linespc - 1}]
6605 foreach tag $marks {
6607 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6608 set wid [font measure mainfontbold $tag]
6610 set wid [font measure mainfont $tag]
6614 set xt [expr {$xt + $wid + $extra}]
6616 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6617 -width $lthickness -fill $reflinecolor -tags tag.$id]
6619 foreach tag $marks x $xvals wid $wvals {
6620 set tag_quoted [string map {% %%} $tag]
6621 set xl [expr {$x + $delta}]
6622 set xr [expr {$x + $delta + $wid + $lthickness}]
6624 if {[incr ntags -1] >= 0} {
6626 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6627 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6628 -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6631 set tagclick [list showtags $id 1]
6633 set tagclick [list showtag $tag_quoted 1]
6635 $canv bind $t <1> $tagclick
6636 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6638 # draw a head or other ref
6639 if {[incr nheads -1] >= 0} {
6640 set col $headbgcolor
6641 if {$tag eq $mainhead} {
6642 set font mainfontbold
6647 set xl [expr {$xl - $delta/2}]
6648 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6649 -width 1 -outline black -fill $col -tags tag.$id
6650 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6651 set rwid [font measure mainfont $remoteprefix]
6652 set xi [expr {$x + 1}]
6653 set yti [expr {$yt + 1}]
6654 set xri [expr {$x + $rwid}]
6655 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6656 -width 0 -fill $remotebgcolor -tags tag.$id
6659 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6660 -font $font -tags [list tag.$id text]]
6662 $canv bind $t <1> $tagclick
6663 } elseif {$nheads >= 0} {
6664 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6670 proc drawnotesign {xt y} {
6671 global linespc canv fgcolor
6673 set orad [expr {$linespc / 3}]
6674 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6675 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6676 -fill yellow -outline $fgcolor -width 1 -tags circle]
6677 set xt [expr {$xt + $orad * 3}]
6681 proc xcoord {i level ln} {
6682 global canvx0 xspc1 xspc2
6684 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6685 if {$i > 0 && $i == $level} {
6686 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6687 } elseif {$i > $level} {
6688 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6693 proc show_status {msg} {
6698 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6699 -tags text -fill $fgcolor
6702 # Don't change the text pane cursor if it is currently the hand cursor,
6703 # showing that we are over a sha1 ID link.
6704 proc settextcursor {c} {
6705 global ctext curtextcursor
6707 if {[$ctext cget -cursor] == $curtextcursor} {
6708 $ctext config -cursor $c
6710 set curtextcursor $c
6713 proc nowbusy {what {name {}}} {
6714 global isbusy busyname statusw
6716 if {[array names isbusy] eq {}} {
6717 . config -cursor watch
6721 set busyname($what) $name
6723 $statusw conf -text $name
6727 proc notbusy {what} {
6728 global isbusy maincursor textcursor busyname statusw
6732 if {$busyname($what) ne {} &&
6733 [$statusw cget -text] eq $busyname($what)} {
6734 $statusw conf -text {}
6737 if {[array names isbusy] eq {}} {
6738 . config -cursor $maincursor
6739 settextcursor $textcursor
6743 proc findmatches {f} {
6744 global findtype findstring
6745 if {$findtype == [mc "Regexp"]} {
6746 set matches [regexp -indices -all -inline $findstring $f]
6749 if {$findtype == [mc "IgnCase"]} {
6750 set f [string tolower $f]
6751 set fs [string tolower $fs]
6755 set l [string length $fs]
6756 while {[set j [string first $fs $f $i]] >= 0} {
6757 lappend matches [list $j [expr {$j+$l-1}]]
6758 set i [expr {$j + $l}]
6764 proc dofind {{dirn 1} {wrap 1}} {
6765 global findstring findstartline findcurline selectedline numcommits
6766 global gdttype filehighlight fh_serial find_dirn findallowwrap
6768 if {[info exists find_dirn]} {
6769 if {$find_dirn == $dirn} return
6773 if {$findstring eq {} || $numcommits == 0} return
6774 if {$selectedline eq {}} {
6775 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6777 set findstartline $selectedline
6779 set findcurline $findstartline
6780 nowbusy finding [mc "Searching"]
6781 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6782 after cancel do_file_hl $fh_serial
6783 do_file_hl $fh_serial
6786 set findallowwrap $wrap
6790 proc stopfinding {} {
6791 global find_dirn findcurline fprogcoord
6793 if {[info exists find_dirn]} {
6804 global commitdata commitinfo numcommits findpattern findloc
6805 global findstartline findcurline findallowwrap
6806 global find_dirn gdttype fhighlights fprogcoord
6807 global curview varcorder vrownum varccommits vrowmod
6809 if {![info exists find_dirn]} {
6812 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6815 if {$find_dirn > 0} {
6817 if {$l >= $numcommits} {
6820 if {$l <= $findstartline} {
6821 set lim [expr {$findstartline + 1}]
6824 set moretodo $findallowwrap
6831 if {$l >= $findstartline} {
6832 set lim [expr {$findstartline - 1}]
6835 set moretodo $findallowwrap
6838 set n [expr {($lim - $l) * $find_dirn}]
6843 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6844 update_arcrows $curview
6848 set ai [bsearch $vrownum($curview) $l]
6849 set a [lindex $varcorder($curview) $ai]
6850 set arow [lindex $vrownum($curview) $ai]
6851 set ids [lindex $varccommits($curview,$a)]
6852 set arowend [expr {$arow + [llength $ids]}]
6853 if {$gdttype eq [mc "containing:"]} {
6854 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6855 if {$l < $arow || $l >= $arowend} {
6857 set a [lindex $varcorder($curview) $ai]
6858 set arow [lindex $vrownum($curview) $ai]
6859 set ids [lindex $varccommits($curview,$a)]
6860 set arowend [expr {$arow + [llength $ids]}]
6862 set id [lindex $ids [expr {$l - $arow}]]
6863 # shouldn't happen unless git log doesn't give all the commits...
6864 if {![info exists commitdata($id)] ||
6865 ![doesmatch $commitdata($id)]} {
6868 if {![info exists commitinfo($id)]} {
6871 set info $commitinfo($id)
6872 foreach f $info ty $fldtypes {
6873 if {$ty eq ""} continue
6874 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6883 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6884 if {$l < $arow || $l >= $arowend} {
6886 set a [lindex $varcorder($curview) $ai]
6887 set arow [lindex $vrownum($curview) $ai]
6888 set ids [lindex $varccommits($curview,$a)]
6889 set arowend [expr {$arow + [llength $ids]}]
6891 set id [lindex $ids [expr {$l - $arow}]]
6892 if {![info exists fhighlights($id)]} {
6893 # this sets fhighlights($id) to -1
6894 askfilehighlight $l $id
6896 if {$fhighlights($id) > 0} {
6900 if {$fhighlights($id) < 0} {
6903 set findcurline [expr {$l - $find_dirn}]
6908 if {$found || ($domore && !$moretodo)} {
6924 set findcurline [expr {$l - $find_dirn}]
6926 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6930 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6935 proc findselectline {l} {
6936 global findloc commentend ctext findcurline markingmatches gdttype
6938 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6941 if {$markingmatches &&
6942 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6943 # highlight the matches in the comments
6944 set f [$ctext get 1.0 $commentend]
6945 set matches [findmatches $f]
6946 foreach match $matches {
6947 set start [lindex $match 0]
6948 set end [expr {[lindex $match 1] + 1}]
6949 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6955 # mark the bits of a headline or author that match a find string
6956 proc markmatches {canv l str tag matches font row} {
6959 set bbox [$canv bbox $tag]
6960 set x0 [lindex $bbox 0]
6961 set y0 [lindex $bbox 1]
6962 set y1 [lindex $bbox 3]
6963 foreach match $matches {
6964 set start [lindex $match 0]
6965 set end [lindex $match 1]
6966 if {$start > $end} continue
6967 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6968 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6969 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6970 [expr {$x0+$xlen+2}] $y1 \
6971 -outline {} -tags [list match$l matches] -fill yellow]
6973 if {$row == $selectedline} {
6974 $canv raise $t secsel
6979 proc unmarkmatches {} {
6980 global markingmatches
6982 allcanvs delete matches
6983 set markingmatches 0
6987 proc selcanvline {w x y} {
6988 global canv canvy0 ctext linespc
6990 set ymax [lindex [$canv cget -scrollregion] 3]
6991 if {$ymax == {}} return
6992 set yfrac [lindex [$canv yview] 0]
6993 set y [expr {$y + $yfrac * $ymax}]
6994 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6999 set xmax [lindex [$canv cget -scrollregion] 2]
7000 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
7001 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
7007 proc commit_descriptor {p} {
7009 if {![info exists commitinfo($p)]} {
7013 if {[llength $commitinfo($p)] > 1} {
7014 set l [lindex $commitinfo($p) 0]
7019 # append some text to the ctext widget, and make any SHA1 ID
7020 # that we know about be a clickable link.
7021 # Also look for URLs of the form "http[s]://..." and make them web links.
7022 proc appendwithlinks {text tags} {
7023 global ctext linknum curview
7025 set start [$ctext index "end - 1c"]
7026 $ctext insert end $text $tags
7027 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7031 set linkid [string range $text $s $e]
7033 $ctext tag delete link$linknum
7034 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7035 setlink $linkid link$linknum
7038 set wlinks [regexp -indices -all -inline -line \
7039 {https?://[^[:space:]]+} $text]
7041 set s2 [lindex $l 0]
7042 set e2 [lindex $l 1]
7043 set url [string range $text $s2 $e2]
7045 $ctext tag delete link$linknum
7046 $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7047 setwlink $url link$linknum
7052 proc setlink {id lk} {
7053 global curview ctext pendinglinks
7056 if {[string range $id 0 1] eq "-g"} {
7057 set id [string range $id 2 end]
7061 if {[string length $id] < 40} {
7062 set matches [longid $id]
7063 if {[llength $matches] > 0} {
7064 if {[llength $matches] > 1} return
7066 set id [lindex $matches 0]
7069 set known [commitinview $id $curview]
7072 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7073 $ctext tag bind $lk <1> [list selbyid $id]
7074 $ctext tag bind $lk <Enter> {linkcursor %W 1}
7075 $ctext tag bind $lk <Leave> {linkcursor %W -1}
7077 lappend pendinglinks($id) $lk
7078 interestedin $id {makelink %P}
7082 proc setwlink {url lk} {
7087 if {$web_browser eq {}} return
7088 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7089 $ctext tag bind $lk <1> [list browseweb $url]
7090 $ctext tag bind $lk <Enter> {linkcursor %W 1}
7091 $ctext tag bind $lk <Leave> {linkcursor %W -1}
7094 proc appendshortlink {id {pre {}} {post {}}} {
7095 global ctext linknum
7097 $ctext insert end $pre
7098 $ctext tag delete link$linknum
7099 $ctext insert end [string range $id 0 7] link$linknum
7100 $ctext insert end $post
7101 setlink $id link$linknum
7105 proc makelink {id} {
7108 if {![info exists pendinglinks($id)]} return
7109 foreach lk $pendinglinks($id) {
7112 unset pendinglinks($id)
7115 proc linkcursor {w inc} {
7116 global linkentercount curtextcursor
7118 if {[incr linkentercount $inc] > 0} {
7119 $w configure -cursor hand2
7121 $w configure -cursor $curtextcursor
7122 if {$linkentercount < 0} {
7123 set linkentercount 0
7128 proc browseweb {url} {
7131 if {$web_browser eq {}} return
7132 # Use eval here in case $web_browser is a command plus some arguments
7133 if {[catch {eval exec $web_browser [list $url] &} err]} {
7134 error_popup "[mc "Error starting web browser:"] $err"
7138 proc viewnextline {dir} {
7142 set ymax [lindex [$canv cget -scrollregion] 3]
7143 set wnow [$canv yview]
7144 set wtop [expr {[lindex $wnow 0] * $ymax}]
7145 set newtop [expr {$wtop + $dir * $linespc}]
7148 } elseif {$newtop > $ymax} {
7151 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7154 # add a list of tag or branch names at position pos
7155 # returns the number of names inserted
7156 proc appendrefs {pos ids var} {
7157 global ctext linknum curview $var maxrefs visiblerefs mainheadid
7159 if {[catch {$ctext index $pos}]} {
7162 $ctext conf -state normal
7163 $ctext delete $pos "$pos lineend"
7166 foreach tag [set $var\($id\)] {
7167 lappend tags [list $tag $id]
7172 set tags [lsort -index 0 -decreasing $tags]
7175 if {[llength $tags] > $maxrefs} {
7176 # If we are displaying heads, and there are too many,
7177 # see if there are some important heads to display.
7178 # Currently that are the current head and heads listed in $visiblerefs option
7180 if {$var eq "idheads"} {
7183 set hname [lindex $ti 0]
7184 set id [lindex $ti 1]
7185 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7186 [llength $itags] < $maxrefs} {
7195 set str [mc "and many more"]
7200 $ctext insert $pos "$str ([llength $tags])"
7201 set nutags [llength $tags]
7206 set id [lindex $ti 1]
7209 $ctext tag delete $lk
7210 $ctext insert $pos $sep
7211 $ctext insert $pos [lindex $ti 0] $lk
7215 $ctext tag add wwrap "$pos linestart" "$pos lineend"
7216 $ctext conf -state disabled
7217 return [expr {[llength $tags] + $nutags}]
7220 # called when we have finished computing the nearby tags
7221 proc dispneartags {delay} {
7222 global selectedline currentid showneartags tagphase
7224 if {$selectedline eq {} || !$showneartags} return
7225 after cancel dispnexttag
7227 after 200 dispnexttag
7230 after idle dispnexttag
7235 proc dispnexttag {} {
7236 global selectedline currentid showneartags tagphase ctext
7238 if {$selectedline eq {} || !$showneartags} return
7239 switch -- $tagphase {
7241 set dtags [desctags $currentid]
7243 appendrefs precedes $dtags idtags
7247 set atags [anctags $currentid]
7249 appendrefs follows $atags idtags
7253 set dheads [descheads $currentid]
7254 if {$dheads ne {}} {
7255 if {[appendrefs branch $dheads idheads] > 1
7256 && [$ctext get "branch -3c"] eq "h"} {
7257 # turn "Branch" into "Branches"
7258 $ctext conf -state normal
7259 $ctext insert "branch -2c" "es"
7260 $ctext conf -state disabled
7265 if {[incr tagphase] <= 2} {
7266 after idle dispnexttag
7270 proc make_secsel {id} {
7271 global linehtag linentag linedtag canv canv2 canv3
7273 if {![info exists linehtag($id)]} return
7275 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7276 -tags secsel -fill [$canv cget -selectbackground]]
7278 $canv2 delete secsel
7279 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7280 -tags secsel -fill [$canv2 cget -selectbackground]]
7282 $canv3 delete secsel
7283 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7284 -tags secsel -fill [$canv3 cget -selectbackground]]
7288 proc make_idmark {id} {
7289 global linehtag canv fgcolor
7291 if {![info exists linehtag($id)]} return
7293 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7294 -tags markid -outline $fgcolor]
7298 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7299 global canv ctext commitinfo selectedline
7300 global canvy0 linespc parents children curview
7301 global currentid sha1entry
7302 global commentend idtags linknum
7303 global mergemax numcommits pending_select
7304 global cmitmode showneartags allcommits
7305 global targetrow targetid lastscrollrows
7306 global autoselect autosellen jump_to_here
7309 unset -nocomplain pending_select
7314 if {$l < 0 || $l >= $numcommits} return
7315 set id [commitonrow $l]
7320 if {$lastscrollrows < $numcommits} {
7324 if {$cmitmode ne "patch" && $switch_to_patch} {
7325 set cmitmode "patch"
7328 set y [expr {$canvy0 + $l * $linespc}]
7329 set ymax [lindex [$canv cget -scrollregion] 3]
7330 set ytop [expr {$y - $linespc - 1}]
7331 set ybot [expr {$y + $linespc + 1}]
7332 set wnow [$canv yview]
7333 set wtop [expr {[lindex $wnow 0] * $ymax}]
7334 set wbot [expr {[lindex $wnow 1] * $ymax}]
7335 set wh [expr {$wbot - $wtop}]
7337 if {$ytop < $wtop} {
7338 if {$ybot < $wtop} {
7339 set newtop [expr {$y - $wh / 2.0}]
7342 if {$newtop > $wtop - $linespc} {
7343 set newtop [expr {$wtop - $linespc}]
7346 } elseif {$ybot > $wbot} {
7347 if {$ytop > $wbot} {
7348 set newtop [expr {$y - $wh / 2.0}]
7350 set newtop [expr {$ybot - $wh}]
7351 if {$newtop < $wtop + $linespc} {
7352 set newtop [expr {$wtop + $linespc}]
7356 if {$newtop != $wtop} {
7360 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7367 addtohistory [list selbyid $id 0] savecmitpos
7370 $sha1entry delete 0 end
7371 $sha1entry insert 0 $id
7373 $sha1entry selection range 0 $autosellen
7377 $ctext conf -state normal
7380 if {![info exists commitinfo($id)]} {
7383 set info $commitinfo($id)
7384 set date [formatdate [lindex $info 2]]
7385 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
7386 set date [formatdate [lindex $info 4]]
7387 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
7388 if {[info exists idtags($id)]} {
7389 $ctext insert end [mc "Tags:"]
7390 foreach tag $idtags($id) {
7391 $ctext insert end " $tag"
7393 $ctext insert end "\n"
7397 set olds $parents($curview,$id)
7398 if {[llength $olds] > 1} {
7401 if {$np >= $mergemax} {
7406 $ctext insert end "[mc "Parent"]: " $tag
7407 appendwithlinks [commit_descriptor $p] {}
7412 append headers "[mc "Parent"]: [commit_descriptor $p]"
7416 foreach c $children($curview,$id) {
7417 append headers "[mc "Child"]: [commit_descriptor $c]"
7420 # make anything that looks like a SHA1 ID be a clickable link
7421 appendwithlinks $headers {}
7422 if {$showneartags} {
7423 if {![info exists allcommits]} {
7426 $ctext insert end "[mc "Branch"]: "
7427 $ctext mark set branch "end -1c"
7428 $ctext mark gravity branch left
7429 $ctext insert end "\n[mc "Follows"]: "
7430 $ctext mark set follows "end -1c"
7431 $ctext mark gravity follows left
7432 $ctext insert end "\n[mc "Precedes"]: "
7433 $ctext mark set precedes "end -1c"
7434 $ctext mark gravity precedes left
7435 $ctext insert end "\n"
7438 $ctext insert end "\n"
7439 set comment [lindex $info 5]
7440 if {[string first "\r" $comment] >= 0} {
7441 set comment [string map {"\r" "\n "} $comment]
7443 appendwithlinks $comment {comment}
7445 $ctext tag remove found 1.0 end
7446 $ctext conf -state disabled
7447 set commentend [$ctext index "end - 1c"]
7449 set jump_to_here $desired_loc
7450 init_flist [mc "Comments"]
7451 if {$cmitmode eq "tree"} {
7453 } elseif {$vinlinediff($curview) == 1} {
7455 } elseif {[llength $olds] <= 1} {
7462 proc selfirstline {} {
7467 proc sellastline {} {
7470 set l [expr {$numcommits - 1}]
7474 proc selnextline {dir} {
7477 if {$selectedline eq {}} return
7478 set l [expr {$selectedline + $dir}]
7483 proc selnextpage {dir} {
7484 global canv linespc selectedline numcommits
7486 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7490 allcanvs yview scroll [expr {$dir * $lpp}] units
7492 if {$selectedline eq {}} return
7493 set l [expr {$selectedline + $dir * $lpp}]
7496 } elseif {$l >= $numcommits} {
7497 set l [expr $numcommits - 1]
7503 proc unselectline {} {
7504 global selectedline currentid
7507 unset -nocomplain currentid
7508 allcanvs delete secsel
7512 proc reselectline {} {
7515 if {$selectedline ne {}} {
7516 selectline $selectedline 0
7520 proc addtohistory {cmd {saveproc {}}} {
7521 global history historyindex curview
7525 set elt [list $curview $cmd $saveproc {}]
7526 if {$historyindex > 0
7527 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7531 if {$historyindex < [llength $history]} {
7532 set history [lreplace $history $historyindex end $elt]
7534 lappend history $elt
7537 if {$historyindex > 1} {
7538 .tf.bar.leftbut conf -state normal
7540 .tf.bar.leftbut conf -state disabled
7542 .tf.bar.rightbut conf -state disabled
7545 # save the scrolling position of the diff display pane
7546 proc save_position {} {
7547 global historyindex history
7549 if {$historyindex < 1} return
7550 set hi [expr {$historyindex - 1}]
7551 set fn [lindex $history $hi 2]
7553 lset history $hi 3 [eval $fn]
7557 proc unset_posvars {} {
7560 if {[info exists last_posvars]} {
7561 foreach {var val} $last_posvars {
7563 unset -nocomplain $var
7570 global curview last_posvars
7572 set view [lindex $elt 0]
7573 set cmd [lindex $elt 1]
7574 set pv [lindex $elt 3]
7575 if {$curview != $view} {
7579 foreach {var val} $pv {
7583 set last_posvars $pv
7588 global history historyindex
7591 if {$historyindex > 1} {
7593 incr historyindex -1
7594 godo [lindex $history [expr {$historyindex - 1}]]
7595 .tf.bar.rightbut conf -state normal
7597 if {$historyindex <= 1} {
7598 .tf.bar.leftbut conf -state disabled
7603 global history historyindex
7606 if {$historyindex < [llength $history]} {
7608 set cmd [lindex $history $historyindex]
7611 .tf.bar.leftbut conf -state normal
7613 if {$historyindex >= [llength $history]} {
7614 .tf.bar.rightbut conf -state disabled
7618 proc go_to_parent {i} {
7619 global parents curview targetid
7620 set ps $parents($curview,$targetid)
7621 if {[llength $ps] >= $i} {
7622 selbyid [lindex $ps [expr $i - 1]]
7627 global treefilelist treeidlist diffids diffmergeid treepending
7628 global nullid nullid2
7631 unset -nocomplain diffmergeid
7632 if {![info exists treefilelist($id)]} {
7633 if {![info exists treepending]} {
7634 if {$id eq $nullid} {
7635 set cmd [list | git ls-files]
7636 } elseif {$id eq $nullid2} {
7637 set cmd [list | git ls-files --stage -t]
7639 set cmd [list | git ls-tree -r $id]
7641 if {[catch {set gtf [open $cmd r]}]} {
7645 set treefilelist($id) {}
7646 set treeidlist($id) {}
7647 fconfigure $gtf -blocking 0 -encoding binary
7648 filerun $gtf [list gettreeline $gtf $id]
7655 proc gettreeline {gtf id} {
7656 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7659 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7660 if {$diffids eq $nullid} {
7663 set i [string first "\t" $line]
7664 if {$i < 0} continue
7665 set fname [string range $line [expr {$i+1}] end]
7666 set line [string range $line 0 [expr {$i-1}]]
7667 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7668 set sha1 [lindex $line 2]
7669 lappend treeidlist($id) $sha1
7671 if {[string index $fname 0] eq "\""} {
7672 set fname [lindex $fname 0]
7674 set fname [encoding convertfrom $fname]
7675 lappend treefilelist($id) $fname
7678 return [expr {$nl >= 1000? 2: 1}]
7682 if {$cmitmode ne "tree"} {
7683 if {![info exists diffmergeid]} {
7684 gettreediffs $diffids
7686 } elseif {$id ne $diffids} {
7695 global treefilelist treeidlist diffids nullid nullid2
7696 global ctext_file_names ctext_file_lines
7697 global ctext commentend
7699 set i [lsearch -exact $treefilelist($diffids) $f]
7701 puts "oops, $f not in list for id $diffids"
7704 if {$diffids eq $nullid} {
7705 if {[catch {set bf [open $f r]} err]} {
7706 puts "oops, can't read $f: $err"
7710 set blob [lindex $treeidlist($diffids) $i]
7711 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7712 puts "oops, error reading blob $blob: $err"
7716 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7717 filerun $bf [list getblobline $bf $diffids]
7718 $ctext config -state normal
7719 clear_ctext $commentend
7720 lappend ctext_file_names $f
7721 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7722 $ctext insert end "\n"
7723 $ctext insert end "$f\n" filesep
7724 $ctext config -state disabled
7725 $ctext yview $commentend
7729 proc getblobline {bf id} {
7730 global diffids cmitmode ctext
7732 if {$id ne $diffids || $cmitmode ne "tree"} {
7736 $ctext config -state normal
7738 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7739 $ctext insert end "$line\n"
7742 global jump_to_here ctext_file_names commentend
7744 # delete last newline
7745 $ctext delete "end - 2c" "end - 1c"
7747 if {$jump_to_here ne {} &&
7748 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7749 set lnum [expr {[lindex $jump_to_here 1] +
7750 [lindex [split $commentend .] 0]}]
7751 mark_ctext_line $lnum
7753 $ctext config -state disabled
7756 $ctext config -state disabled
7757 return [expr {$nl >= 1000? 2: 1}]
7760 proc mark_ctext_line {lnum} {
7761 global ctext markbgcolor
7763 $ctext tag delete omark
7764 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7765 $ctext tag conf omark -background $markbgcolor
7769 proc mergediff {id} {
7771 global diffids treediffs
7772 global parents curview
7776 set treediffs($id) {}
7777 set np [llength $parents($curview,$id)]
7782 proc startdiff {ids} {
7783 global treediffs diffids treepending diffmergeid nullid nullid2
7787 unset -nocomplain diffmergeid
7788 if {![info exists treediffs($ids)] ||
7789 [lsearch -exact $ids $nullid] >= 0 ||
7790 [lsearch -exact $ids $nullid2] >= 0} {
7791 if {![info exists treepending]} {
7799 proc showinlinediff {ids} {
7800 global commitinfo commitdata ctext
7803 set info $commitinfo($ids)
7804 set diff [lindex $info 7]
7805 set difflines [split $diff "\n"]
7811 foreach line $difflines {
7812 if {![string compare -length 5 "diff " $line]} {
7814 } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7815 # offset also accounts for the b/ prefix
7816 lappend treediff [string range $line 6 end]
7821 set treediffs($ids) $treediff
7824 $ctext conf -state normal
7825 foreach line $difflines {
7826 parseblobdiffline $ids $line
7828 maybe_scroll_ctext 1
7829 $ctext conf -state disabled
7832 # If the filename (name) is under any of the passed filter paths
7833 # then return true to include the file in the listing.
7834 proc path_filter {filter name} {
7835 set worktree [gitworktree]
7837 set fq_p [file normalize $p]
7838 set fq_n [file normalize [file join $worktree $name]]
7839 if {[string match [file normalize $fq_p]* $fq_n]} {
7846 proc addtocflist {ids} {
7849 add_flist $treediffs($ids)
7853 proc diffcmd {ids flags} {
7854 global log_showroot nullid nullid2 git_version
7856 set i [lsearch -exact $ids $nullid]
7857 set j [lsearch -exact $ids $nullid2]
7859 if {[llength $ids] > 1 && $j < 0} {
7860 # comparing working directory with some specific revision
7861 set cmd [concat | git diff-index $flags]
7863 lappend cmd -R [lindex $ids 1]
7865 lappend cmd [lindex $ids 0]
7868 # comparing working directory with index
7869 set cmd [concat | git diff-files $flags]
7874 } elseif {$j >= 0} {
7875 if {[package vcompare $git_version "1.7.2"] >= 0} {
7876 set flags "$flags --ignore-submodules=dirty"
7878 set cmd [concat | git diff-index --cached $flags]
7879 if {[llength $ids] > 1} {
7880 # comparing index with specific revision
7882 lappend cmd -R [lindex $ids 1]
7884 lappend cmd [lindex $ids 0]
7887 # comparing index with HEAD
7891 if {$log_showroot} {
7892 lappend flags --root
7894 set cmd [concat | git diff-tree -r $flags $ids]
7899 proc gettreediffs {ids} {
7900 global treediff treepending limitdiffs vfilelimit curview
7902 set cmd [diffcmd $ids {--no-commit-id}]
7903 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7904 set cmd [concat $cmd -- $vfilelimit($curview)]
7906 if {[catch {set gdtf [open $cmd r]}]} return
7908 set treepending $ids
7910 fconfigure $gdtf -blocking 0 -encoding binary
7911 filerun $gdtf [list gettreediffline $gdtf $ids]
7914 proc gettreediffline {gdtf ids} {
7915 global treediff treediffs treepending diffids diffmergeid
7916 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7921 if {$perfile_attrs} {
7922 # cache_gitattr is slow, and even slower on win32 where we
7923 # have to invoke it for only about 30 paths at a time
7925 if {[tk windowingsystem] == "win32"} {
7929 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7930 set i [string first "\t" $line]
7932 set file [string range $line [expr {$i+1}] end]
7933 if {[string index $file 0] eq "\""} {
7934 set file [lindex $file 0]
7936 set file [encoding convertfrom $file]
7937 if {$file ne [lindex $treediff end]} {
7938 lappend treediff $file
7939 lappend sublist $file
7943 if {$perfile_attrs} {
7944 cache_gitattr encoding $sublist
7947 return [expr {$nr >= $max? 2: 1}]
7950 set treediffs($ids) $treediff
7952 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7954 } elseif {$ids != $diffids} {
7955 if {![info exists diffmergeid]} {
7956 gettreediffs $diffids
7964 # empty string or positive integer
7965 proc diffcontextvalidate {v} {
7966 return [regexp {^(|[1-9][0-9]*)$} $v]
7969 proc diffcontextchange {n1 n2 op} {
7970 global diffcontextstring diffcontext
7972 if {[string is integer -strict $diffcontextstring]} {
7973 if {$diffcontextstring >= 0} {
7974 set diffcontext $diffcontextstring
7980 proc changeignorespace {} {
7984 proc changeworddiff {name ix op} {
7988 proc initblobdiffvars {} {
7989 global diffencoding targetline diffnparents
7990 global diffinhdr currdiffsubmod diffseehere
7994 set diffencoding [get_path_encoding {}]
7995 set currdiffsubmod ""
7999 proc getblobdiffs {ids} {
8000 global blobdifffd diffids env
8005 global limitdiffs vfilelimit curview
8009 if {[package vcompare $git_version "1.6.1"] >= 0} {
8010 set textconv "--textconv"
8013 if {[package vcompare $git_version "1.6.6"] >= 0} {
8014 set submodule "--submodule"
8016 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
8020 if {$worddiff ne [mc "Line diff"]} {
8021 append cmd " --word-diff=porcelain"
8023 if {$limitdiffs && $vfilelimit($curview) ne {}} {
8024 set cmd [concat $cmd -- $vfilelimit($curview)]
8026 if {[catch {set bdf [open $cmd r]} err]} {
8027 error_popup [mc "Error getting diffs: %s" $err]
8030 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
8031 set blobdifffd($ids) $bdf
8033 filerun $bdf [list getblobdiffline $bdf $diffids]
8036 proc savecmitpos {} {
8037 global ctext cmitmode
8039 if {$cmitmode eq "tree"} {
8042 return [list target_scrollpos [$ctext index @0,0]]
8045 proc savectextpos {} {
8048 return [list target_scrollpos [$ctext index @0,0]]
8051 proc maybe_scroll_ctext {ateof} {
8052 global ctext target_scrollpos
8054 if {![info exists target_scrollpos]} return
8056 set nlines [expr {[winfo height $ctext]
8057 / [font metrics textfont -linespace]}]
8058 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8060 $ctext yview $target_scrollpos
8061 unset target_scrollpos
8064 proc setinlist {var i val} {
8067 while {[llength [set $var]] < $i} {
8070 if {[llength [set $var]] == $i} {
8077 proc makediffhdr {fname ids} {
8078 global ctext curdiffstart treediffs diffencoding
8079 global ctext_file_names jump_to_here targetline diffline
8081 set fname [encoding convertfrom $fname]
8082 set diffencoding [get_path_encoding $fname]
8083 set i [lsearch -exact $treediffs($ids) $fname]
8085 setinlist difffilestart $i $curdiffstart
8087 lset ctext_file_names end $fname
8088 set l [expr {(78 - [string length $fname]) / 2}]
8089 set pad [string range "----------------------------------------" 1 $l]
8090 $ctext insert $curdiffstart "$pad $fname $pad" filesep
8092 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8093 set targetline [lindex $jump_to_here 1]
8098 proc blobdiffmaybeseehere {ateof} {
8100 if {$diffseehere >= 0} {
8101 mark_ctext_line [lindex [split $diffseehere .] 0]
8103 maybe_scroll_ctext $ateof
8106 proc getblobdiffline {bdf ids} {
8107 global diffids blobdifffd
8111 $ctext conf -state normal
8112 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8113 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8114 # Older diff read. Abort it.
8116 if {$ids != $diffids} {
8117 array unset blobdifffd $ids
8121 parseblobdiffline $ids $line
8123 $ctext conf -state disabled
8124 blobdiffmaybeseehere [eof $bdf]
8127 array unset blobdifffd $ids
8130 return [expr {$nr >= 1000? 2: 1}]
8133 proc parseblobdiffline {ids line} {
8134 global ctext curdiffstart
8135 global diffnexthead diffnextnote difffilestart
8136 global ctext_file_names ctext_file_lines
8137 global diffinhdr treediffs mergemax diffnparents
8138 global diffencoding jump_to_here targetline diffline currdiffsubmod
8139 global worddiff diffseehere
8141 if {![string compare -length 5 "diff " $line]} {
8142 if {![regexp {^diff (--cc|--git) } $line m type]} {
8143 set line [encoding convertfrom $line]
8144 $ctext insert end "$line\n" hunksep
8147 # start of a new file
8149 $ctext insert end "\n"
8150 set curdiffstart [$ctext index "end - 1c"]
8151 lappend ctext_file_names ""
8152 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8153 $ctext insert end "\n" filesep
8155 if {$type eq "--cc"} {
8156 # start of a new file in a merge diff
8157 set fname [string range $line 10 end]
8158 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8159 lappend treediffs($ids) $fname
8160 add_flist [list $fname]
8164 set line [string range $line 11 end]
8165 # If the name hasn't changed the length will be odd,
8166 # the middle char will be a space, and the two bits either
8167 # side will be a/name and b/name, or "a/name" and "b/name".
8168 # If the name has changed we'll get "rename from" and
8169 # "rename to" or "copy from" and "copy to" lines following
8170 # this, and we'll use them to get the filenames.
8171 # This complexity is necessary because spaces in the
8172 # filename(s) don't get escaped.
8173 set l [string length $line]
8174 set i [expr {$l / 2}]
8175 if {!(($l & 1) && [string index $line $i] eq " " &&
8176 [string range $line 2 [expr {$i - 1}]] eq \
8177 [string range $line [expr {$i + 3}] end])} {
8180 # unescape if quoted and chop off the a/ from the front
8181 if {[string index $line 0] eq "\""} {
8182 set fname [string range [lindex $line 0] 2 end]
8184 set fname [string range $line 2 [expr {$i - 1}]]
8187 makediffhdr $fname $ids
8189 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8190 set fname [encoding convertfrom [string range $line 16 end]]
8191 $ctext insert end "\n"
8192 set curdiffstart [$ctext index "end - 1c"]
8193 lappend ctext_file_names $fname
8194 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8195 $ctext insert end "$line\n" filesep
8196 set i [lsearch -exact $treediffs($ids) $fname]
8198 setinlist difffilestart $i $curdiffstart
8201 } elseif {![string compare -length 2 "@@" $line]} {
8202 regexp {^@@+} $line ats
8203 set line [encoding convertfrom $diffencoding $line]
8204 $ctext insert end "$line\n" hunksep
8205 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8208 set diffnparents [expr {[string length $ats] - 1}]
8211 } elseif {![string compare -length 10 "Submodule " $line]} {
8212 # start of a new submodule
8213 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8214 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8216 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8218 if {$currdiffsubmod != $fname} {
8219 $ctext insert end "\n"; # Add newline after commit message
8221 set curdiffstart [$ctext index "end - 1c"]
8222 lappend ctext_file_names ""
8223 if {$currdiffsubmod != $fname} {
8224 lappend ctext_file_lines $fname
8225 makediffhdr $fname $ids
8226 set currdiffsubmod $fname
8227 $ctext insert end "\n$line\n" filesep
8229 $ctext insert end "$line\n" filesep
8231 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} {
8232 set $currdiffsubmod ""
8233 set line [encoding convertfrom $diffencoding $line]
8234 $ctext insert end "$line\n" dresult
8235 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} {
8236 set $currdiffsubmod ""
8237 set line [encoding convertfrom $diffencoding $line]
8238 $ctext insert end "$line\n" d0
8239 } elseif {$diffinhdr} {
8240 if {![string compare -length 12 "rename from " $line]} {
8241 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8242 if {[string index $fname 0] eq "\""} {
8243 set fname [lindex $fname 0]
8245 set fname [encoding convertfrom $fname]
8246 set i [lsearch -exact $treediffs($ids) $fname]
8248 setinlist difffilestart $i $curdiffstart
8250 } elseif {![string compare -length 10 $line "rename to "] ||
8251 ![string compare -length 8 $line "copy to "]} {
8252 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8253 if {[string index $fname 0] eq "\""} {
8254 set fname [lindex $fname 0]
8256 makediffhdr $fname $ids
8257 } elseif {[string compare -length 3 $line "---"] == 0} {
8260 } elseif {[string compare -length 3 $line "+++"] == 0} {
8264 $ctext insert end "$line\n" filesep
8267 set line [string map {\x1A ^Z} \
8268 [encoding convertfrom $diffencoding $line]]
8269 # parse the prefix - one ' ', '-' or '+' for each parent
8270 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8271 set tag [expr {$diffnparents > 1? "m": "d"}]
8272 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8273 set words_pre_markup ""
8274 set words_post_markup ""
8275 if {[string trim $prefix " -+"] eq {}} {
8276 # prefix only has " ", "-" and "+" in it: normal diff line
8277 set num [string first "-" $prefix]
8279 set line [string range $line 1 end]
8282 # removed line, first parent with line is $num
8283 if {$num >= $mergemax} {
8286 if {$dowords && $worddiff eq [mc "Markup words"]} {
8287 $ctext insert end "\[-$line-\]" $tag$num
8289 $ctext insert end "$line" $tag$num
8292 $ctext insert end "\n" $tag$num
8296 if {[string first "+" $prefix] >= 0} {
8298 lappend tags ${tag}result
8299 if {$diffnparents > 1} {
8300 set num [string first " " $prefix]
8302 if {$num >= $mergemax} {
8308 set words_pre_markup "{+"
8309 set words_post_markup "+}"
8311 if {$targetline ne {}} {
8312 if {$diffline == $targetline} {
8313 set diffseehere [$ctext index "end - 1 chars"]
8319 if {$dowords && $worddiff eq [mc "Markup words"]} {
8320 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8322 $ctext insert end "$line" $tags
8325 $ctext insert end "\n" $tags
8328 } elseif {$dowords && $prefix eq "~"} {
8329 $ctext insert end "\n" {}
8331 # "\ No newline at end of file",
8332 # or something else we don't recognize
8333 $ctext insert end "$line\n" hunksep
8338 proc changediffdisp {} {
8339 global ctext diffelide
8341 $ctext tag conf d0 -elide [lindex $diffelide 0]
8342 $ctext tag conf dresult -elide [lindex $diffelide 1]
8345 proc highlightfile {cline} {
8346 global cflist cflist_top
8348 if {![info exists cflist_top]} return
8350 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8351 $cflist tag add highlight $cline.0 "$cline.0 lineend"
8352 $cflist see $cline.0
8353 set cflist_top $cline
8356 proc highlightfile_for_scrollpos {topidx} {
8357 global cmitmode difffilestart
8359 if {$cmitmode eq "tree"} return
8360 if {![info exists difffilestart]} return
8362 set top [lindex [split $topidx .] 0]
8363 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8366 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8371 global difffilestart ctext cmitmode
8373 if {$cmitmode eq "tree"} return
8375 set here [$ctext index @0,0]
8376 foreach loc $difffilestart {
8377 if {[$ctext compare $loc >= $here]} {
8387 global difffilestart ctext cmitmode
8389 if {$cmitmode eq "tree"} return
8390 set here [$ctext index @0,0]
8391 foreach loc $difffilestart {
8392 if {[$ctext compare $loc > $here]} {
8399 proc clear_ctext {{first 1.0}} {
8400 global ctext smarktop smarkbot
8401 global ctext_file_names ctext_file_lines
8404 set l [lindex [split $first .] 0]
8405 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8408 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8411 $ctext delete $first end
8412 if {$first eq "1.0"} {
8413 unset -nocomplain pendinglinks
8415 set ctext_file_names {}
8416 set ctext_file_lines {}
8419 proc settabs {{firstab {}}} {
8420 global firsttabstop tabstop ctext have_tk85
8422 if {$firstab ne {} && $have_tk85} {
8423 set firsttabstop $firstab
8425 set w [font measure textfont "0"]
8426 if {$firsttabstop != 0} {
8427 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8428 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8429 } elseif {$have_tk85 || $tabstop != 8} {
8430 $ctext conf -tabs [expr {$tabstop * $w}]
8432 $ctext conf -tabs {}
8436 proc incrsearch {name ix op} {
8437 global ctext searchstring searchdirn
8439 if {[catch {$ctext index anchor}]} {
8440 # no anchor set, use start of selection, or of visible area
8441 set sel [$ctext tag ranges sel]
8443 $ctext mark set anchor [lindex $sel 0]
8444 } elseif {$searchdirn eq "-forwards"} {
8445 $ctext mark set anchor @0,0
8447 $ctext mark set anchor @0,[winfo height $ctext]
8450 if {$searchstring ne {}} {
8451 set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8454 set mend "$here + $mlen c"
8455 $ctext tag remove sel 1.0 end
8456 $ctext tag add sel $here $mend
8457 suppress_highlighting_file_for_current_scrollpos
8458 highlightfile_for_scrollpos $here
8461 rehighlight_search_results
8465 global sstring ctext searchstring searchdirn
8468 $sstring icursor end
8469 set searchdirn -forwards
8470 if {$searchstring ne {}} {
8471 set sel [$ctext tag ranges sel]
8473 set start "[lindex $sel 0] + 1c"
8474 } elseif {[catch {set start [$ctext index anchor]}]} {
8477 set match [$ctext search -count mlen -- $searchstring $start]
8478 $ctext tag remove sel 1.0 end
8484 suppress_highlighting_file_for_current_scrollpos
8485 highlightfile_for_scrollpos $match
8486 set mend "$match + $mlen c"
8487 $ctext tag add sel $match $mend
8488 $ctext mark unset anchor
8489 rehighlight_search_results
8493 proc dosearchback {} {
8494 global sstring ctext searchstring searchdirn
8497 $sstring icursor end
8498 set searchdirn -backwards
8499 if {$searchstring ne {}} {
8500 set sel [$ctext tag ranges sel]
8502 set start [lindex $sel 0]
8503 } elseif {[catch {set start [$ctext index anchor]}]} {
8504 set start @0,[winfo height $ctext]
8506 set match [$ctext search -backwards -count ml -- $searchstring $start]
8507 $ctext tag remove sel 1.0 end
8513 suppress_highlighting_file_for_current_scrollpos
8514 highlightfile_for_scrollpos $match
8515 set mend "$match + $ml c"
8516 $ctext tag add sel $match $mend
8517 $ctext mark unset anchor
8518 rehighlight_search_results
8522 proc rehighlight_search_results {} {
8523 global ctext searchstring
8525 $ctext tag remove found 1.0 end
8526 $ctext tag remove currentsearchhit 1.0 end
8528 if {$searchstring ne {}} {
8533 proc searchmark {first last} {
8534 global ctext searchstring
8536 set sel [$ctext tag ranges sel]
8540 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8541 if {$match eq {}} break
8542 set mend "$match + $mlen c"
8543 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8544 $ctext tag add currentsearchhit $match $mend
8546 $ctext tag add found $match $mend
8551 proc searchmarkvisible {doall} {
8552 global ctext smarktop smarkbot
8554 set topline [lindex [split [$ctext index @0,0] .] 0]
8555 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8556 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8557 # no overlap with previous
8558 searchmark $topline $botline
8559 set smarktop $topline
8560 set smarkbot $botline
8562 if {$topline < $smarktop} {
8563 searchmark $topline [expr {$smarktop-1}]
8564 set smarktop $topline
8566 if {$botline > $smarkbot} {
8567 searchmark [expr {$smarkbot+1}] $botline
8568 set smarkbot $botline
8573 proc suppress_highlighting_file_for_current_scrollpos {} {
8574 global ctext suppress_highlighting_file_for_this_scrollpos
8576 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8579 proc scrolltext {f0 f1} {
8580 global searchstring cmitmode ctext
8581 global suppress_highlighting_file_for_this_scrollpos
8583 set topidx [$ctext index @0,0]
8584 if {![info exists suppress_highlighting_file_for_this_scrollpos]
8585 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8586 highlightfile_for_scrollpos $topidx
8589 unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8591 .bleft.bottom.sb set $f0 $f1
8592 if {$searchstring ne {}} {
8598 global linespc charspc canvx0 canvy0
8599 global xspc1 xspc2 lthickness
8601 set linespc [font metrics mainfont -linespace]
8602 set charspc [font measure mainfont "m"]
8603 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8604 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8605 set lthickness [expr {int($linespc / 9) + 1}]
8606 set xspc1(0) $linespc
8614 set ymax [lindex [$canv cget -scrollregion] 3]
8615 if {$ymax eq {} || $ymax == 0} return
8616 set span [$canv yview]
8619 allcanvs yview moveto [lindex $span 0]
8621 if {$selectedline ne {}} {
8622 selectline $selectedline 0
8623 allcanvs yview moveto [lindex $span 0]
8627 proc parsefont {f n} {
8630 set fontattr($f,family) [lindex $n 0]
8632 if {$s eq {} || $s == 0} {
8635 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8637 set fontattr($f,size) $s
8638 set fontattr($f,weight) normal
8639 set fontattr($f,slant) roman
8640 foreach style [lrange $n 2 end] {
8643 "bold" {set fontattr($f,weight) $style}
8645 "italic" {set fontattr($f,slant) $style}
8650 proc fontflags {f {isbold 0}} {
8653 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8654 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8655 -slant $fontattr($f,slant)]
8661 set n [list $fontattr($f,family) $fontattr($f,size)]
8662 if {$fontattr($f,weight) eq "bold"} {
8665 if {$fontattr($f,slant) eq "italic"} {
8671 proc incrfont {inc} {
8672 global mainfont textfont ctext canv cflist showrefstop
8673 global stopped entries fontattr
8676 set s $fontattr(mainfont,size)
8681 set fontattr(mainfont,size) $s
8682 font config mainfont -size $s
8683 font config mainfontbold -size $s
8684 set mainfont [fontname mainfont]
8685 set s $fontattr(textfont,size)
8690 set fontattr(textfont,size) $s
8691 font config textfont -size $s
8692 font config textfontbold -size $s
8693 set textfont [fontname textfont]
8700 global sha1entry sha1string
8701 if {[string length $sha1string] == 40} {
8702 $sha1entry delete 0 end
8706 proc sha1change {n1 n2 op} {
8707 global sha1string currentid sha1but
8708 if {$sha1string == {}
8709 || ([info exists currentid] && $sha1string == $currentid)} {
8714 if {[$sha1but cget -state] == $state} return
8715 if {$state == "normal"} {
8716 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8718 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8722 proc gotocommit {} {
8723 global sha1string tagids headids curview varcid
8725 if {$sha1string == {}
8726 || ([info exists currentid] && $sha1string == $currentid)} return
8727 if {[info exists tagids($sha1string)]} {
8728 set id $tagids($sha1string)
8729 } elseif {[info exists headids($sha1string)]} {
8730 set id $headids($sha1string)
8732 set id [string tolower $sha1string]
8733 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8734 set matches [longid $id]
8735 if {$matches ne {}} {
8736 if {[llength $matches] > 1} {
8737 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8740 set id [lindex $matches 0]
8743 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8744 error_popup [mc "Revision %s is not known" $sha1string]
8749 if {[commitinview $id $curview]} {
8750 selectline [rowofcommit $id] 1
8753 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8754 set msg [mc "SHA1 id %s is not known" $sha1string]
8756 set msg [mc "Revision %s is not in the current view" $sha1string]
8761 proc lineenter {x y id} {
8762 global hoverx hovery hoverid hovertimer
8763 global commitinfo canv
8765 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8769 if {[info exists hovertimer]} {
8770 after cancel $hovertimer
8772 set hovertimer [after 500 linehover]
8776 proc linemotion {x y id} {
8777 global hoverx hovery hoverid hovertimer
8779 if {[info exists hoverid] && $id == $hoverid} {
8782 if {[info exists hovertimer]} {
8783 after cancel $hovertimer
8785 set hovertimer [after 500 linehover]
8789 proc lineleave {id} {
8790 global hoverid hovertimer canv
8792 if {[info exists hoverid] && $id == $hoverid} {
8794 if {[info exists hovertimer]} {
8795 after cancel $hovertimer
8803 global hoverx hovery hoverid hovertimer
8804 global canv linespc lthickness
8805 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8809 set text [lindex $commitinfo($hoverid) 0]
8810 set ymax [lindex [$canv cget -scrollregion] 3]
8811 if {$ymax == {}} return
8812 set yfrac [lindex [$canv yview] 0]
8813 set x [expr {$hoverx + 2 * $linespc}]
8814 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8815 set x0 [expr {$x - 2 * $lthickness}]
8816 set y0 [expr {$y - 2 * $lthickness}]
8817 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8818 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8819 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8820 -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8821 -width 1 -tags hover]
8823 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8824 -font mainfont -fill $linehoverfgcolor]
8828 proc clickisonarrow {id y} {
8831 set ranges [rowranges $id]
8832 set thresh [expr {2 * $lthickness + 6}]
8833 set n [expr {[llength $ranges] - 1}]
8834 for {set i 1} {$i < $n} {incr i} {
8835 set row [lindex $ranges $i]
8836 if {abs([yc $row] - $y) < $thresh} {
8843 proc arrowjump {id n y} {
8846 # 1 <-> 2, 3 <-> 4, etc...
8847 set n [expr {(($n - 1) ^ 1) + 1}]
8848 set row [lindex [rowranges $id] $n]
8850 set ymax [lindex [$canv cget -scrollregion] 3]
8851 if {$ymax eq {} || $ymax <= 0} return
8852 set view [$canv yview]
8853 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8854 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8858 allcanvs yview moveto $yfrac
8861 proc lineclick {x y id isnew} {
8862 global ctext commitinfo children canv thickerline curview
8864 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8869 # draw this line thicker than normal
8873 set ymax [lindex [$canv cget -scrollregion] 3]
8874 if {$ymax eq {}} return
8875 set yfrac [lindex [$canv yview] 0]
8876 set y [expr {$y + $yfrac * $ymax}]
8878 set dirn [clickisonarrow $id $y]
8880 arrowjump $id $dirn $y
8885 addtohistory [list lineclick $x $y $id 0] savectextpos
8887 # fill the details pane with info about this line
8888 $ctext conf -state normal
8891 $ctext insert end "[mc "Parent"]:\t"
8892 $ctext insert end $id link0
8894 set info $commitinfo($id)
8895 $ctext insert end "\n\t[lindex $info 0]\n"
8896 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8897 set date [formatdate [lindex $info 2]]
8898 $ctext insert end "\t[mc "Date"]:\t$date\n"
8899 set kids $children($curview,$id)
8901 $ctext insert end "\n[mc "Children"]:"
8903 foreach child $kids {
8905 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8906 set info $commitinfo($child)
8907 $ctext insert end "\n\t"
8908 $ctext insert end $child link$i
8909 setlink $child link$i
8910 $ctext insert end "\n\t[lindex $info 0]"
8911 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8912 set date [formatdate [lindex $info 2]]
8913 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8916 maybe_scroll_ctext 1
8917 $ctext conf -state disabled
8921 proc normalline {} {
8923 if {[info exists thickerline]} {
8930 proc selbyid {id {isnew 1}} {
8932 if {[commitinview $id $curview]} {
8933 selectline [rowofcommit $id] $isnew
8939 if {![info exists startmstime]} {
8940 set startmstime [clock clicks -milliseconds]
8942 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8945 proc rowmenu {x y id} {
8946 global rowctxmenu selectedline rowmenuid curview
8947 global nullid nullid2 fakerowmenu mainhead markedid
8951 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8956 if {[info exists markedid] && $markedid ne $id} {
8961 if {$id ne $nullid && $id ne $nullid2} {
8962 set menu $rowctxmenu
8963 if {$mainhead ne {}} {
8964 $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8966 $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8968 $menu entryconfigure 10 -state $mstate
8969 $menu entryconfigure 11 -state $mstate
8970 $menu entryconfigure 12 -state $mstate
8972 set menu $fakerowmenu
8974 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8975 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8976 $menu entryconfigure [mca "Make patch"] -state $state
8977 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8978 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8979 tk_popup $menu $x $y
8983 global rowmenuid markedid canv
8985 set markedid $rowmenuid
8986 make_idmark $markedid
8992 if {[info exists markedid]} {
8997 proc replace_by_kids {l r} {
8998 global curview children
9000 set id [commitonrow $r]
9001 set l [lreplace $l 0 0]
9002 foreach kid $children($curview,$id) {
9003 lappend l [rowofcommit $kid]
9005 return [lsort -integer -decreasing -unique $l]
9008 proc find_common_desc {} {
9009 global markedid rowmenuid curview children
9011 if {![info exists markedid]} return
9012 if {![commitinview $markedid $curview] ||
9013 ![commitinview $rowmenuid $curview]} return
9014 #set t1 [clock clicks -milliseconds]
9015 set l1 [list [rowofcommit $markedid]]
9016 set l2 [list [rowofcommit $rowmenuid]]
9018 set r1 [lindex $l1 0]
9019 set r2 [lindex $l2 0]
9020 if {$r1 eq {} || $r2 eq {}} break
9026 set l1 [replace_by_kids $l1 $r1]
9028 set l2 [replace_by_kids $l2 $r2]
9031 #set t2 [clock clicks -milliseconds]
9032 #puts "took [expr {$t2-$t1}]ms"
9035 proc compare_commits {} {
9036 global markedid rowmenuid curview children
9038 if {![info exists markedid]} return
9039 if {![commitinview $markedid $curview]} return
9040 addtohistory [list do_cmp_commits $markedid $rowmenuid]
9041 do_cmp_commits $markedid $rowmenuid
9044 proc getpatchid {id} {
9047 if {![info exists patchids($id)]} {
9048 set cmd [diffcmd [list $id] {-p --root}]
9049 # trim off the initial "|"
9050 set cmd [lrange $cmd 1 end]
9052 set x [eval exec $cmd | git patch-id]
9053 set patchids($id) [lindex $x 0]
9055 set patchids($id) "error"
9058 return $patchids($id)
9061 proc do_cmp_commits {a b} {
9062 global ctext curview parents children patchids commitinfo
9064 $ctext conf -state normal
9067 for {set i 0} {$i < 100} {incr i} {
9070 if {[llength $parents($curview,$a)] > 1} {
9071 appendshortlink $a [mc "Skipping merge commit "] "\n"
9074 set patcha [getpatchid $a]
9076 if {[llength $parents($curview,$b)] > 1} {
9077 appendshortlink $b [mc "Skipping merge commit "] "\n"
9080 set patchb [getpatchid $b]
9082 if {!$skipa && !$skipb} {
9083 set heada [lindex $commitinfo($a) 0]
9084 set headb [lindex $commitinfo($b) 0]
9085 if {$patcha eq "error"} {
9086 appendshortlink $a [mc "Error getting patch ID for "] \
9087 [mc " - stopping\n"]
9090 if {$patchb eq "error"} {
9091 appendshortlink $b [mc "Error getting patch ID for "] \
9092 [mc " - stopping\n"]
9095 if {$patcha eq $patchb} {
9096 if {$heada eq $headb} {
9097 appendshortlink $a [mc "Commit "]
9098 appendshortlink $b " == " " $heada\n"
9100 appendshortlink $a [mc "Commit "] " $heada\n"
9101 appendshortlink $b [mc " is the same patch as\n "] \
9107 $ctext insert end "\n"
9108 appendshortlink $a [mc "Commit "] " $heada\n"
9109 appendshortlink $b [mc " differs from\n "] \
9111 $ctext insert end [mc "Diff of commits:\n\n"]
9112 $ctext conf -state disabled
9119 set kids [real_children $curview,$a]
9120 if {[llength $kids] != 1} {
9121 $ctext insert end "\n"
9122 appendshortlink $a [mc "Commit "] \
9123 [mc " has %s children - stopping\n" [llength $kids]]
9126 set a [lindex $kids 0]
9129 set kids [real_children $curview,$b]
9130 if {[llength $kids] != 1} {
9131 appendshortlink $b [mc "Commit "] \
9132 [mc " has %s children - stopping\n" [llength $kids]]
9135 set b [lindex $kids 0]
9138 $ctext conf -state disabled
9141 proc diffcommits {a b} {
9142 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9144 set tmpdir [gitknewtmpdir]
9145 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9146 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9148 exec git diff-tree -p --pretty $a >$fna
9149 exec git diff-tree -p --pretty $b >$fnb
9151 error_popup [mc "Error writing commit to file: %s" $err]
9155 set fd [open "| diff -U$diffcontext $fna $fnb" r]
9157 error_popup [mc "Error diffing commits: %s" $err]
9160 set diffids [list commits $a $b]
9161 set blobdifffd($diffids) $fd
9163 set currdiffsubmod ""
9164 filerun $fd [list getblobdiffline $fd $diffids]
9167 proc diffvssel {dirn} {
9168 global rowmenuid selectedline
9170 if {$selectedline eq {}} return
9172 set oldid [commitonrow $selectedline]
9173 set newid $rowmenuid
9175 set oldid $rowmenuid
9176 set newid [commitonrow $selectedline]
9178 addtohistory [list doseldiff $oldid $newid] savectextpos
9179 doseldiff $oldid $newid
9182 proc diffvsmark {dirn} {
9183 global rowmenuid markedid
9185 if {![info exists markedid]} return
9188 set newid $rowmenuid
9190 set oldid $rowmenuid
9193 addtohistory [list doseldiff $oldid $newid] savectextpos
9194 doseldiff $oldid $newid
9197 proc doseldiff {oldid newid} {
9201 $ctext conf -state normal
9203 init_flist [mc "Top"]
9204 $ctext insert end "[mc "From"] "
9205 $ctext insert end $oldid link0
9206 setlink $oldid link0
9207 $ctext insert end "\n "
9208 $ctext insert end [lindex $commitinfo($oldid) 0]
9209 $ctext insert end "\n\n[mc "To"] "
9210 $ctext insert end $newid link1
9211 setlink $newid link1
9212 $ctext insert end "\n "
9213 $ctext insert end [lindex $commitinfo($newid) 0]
9214 $ctext insert end "\n"
9215 $ctext conf -state disabled
9216 $ctext tag remove found 1.0 end
9217 startdiff [list $oldid $newid]
9221 global rowmenuid currentid commitinfo patchtop patchnum NS
9223 if {![info exists currentid]} return
9224 set oldid $currentid
9225 set oldhead [lindex $commitinfo($oldid) 0]
9226 set newid $rowmenuid
9227 set newhead [lindex $commitinfo($newid) 0]
9230 catch {destroy $top}
9232 make_transient $top .
9233 ${NS}::label $top.title -text [mc "Generate patch"]
9234 grid $top.title - -pady 10
9235 ${NS}::label $top.from -text [mc "From:"]
9236 ${NS}::entry $top.fromsha1 -width 40
9237 $top.fromsha1 insert 0 $oldid
9238 $top.fromsha1 conf -state readonly
9239 grid $top.from $top.fromsha1 -sticky w
9240 ${NS}::entry $top.fromhead -width 60
9241 $top.fromhead insert 0 $oldhead
9242 $top.fromhead conf -state readonly
9243 grid x $top.fromhead -sticky w
9244 ${NS}::label $top.to -text [mc "To:"]
9245 ${NS}::entry $top.tosha1 -width 40
9246 $top.tosha1 insert 0 $newid
9247 $top.tosha1 conf -state readonly
9248 grid $top.to $top.tosha1 -sticky w
9249 ${NS}::entry $top.tohead -width 60
9250 $top.tohead insert 0 $newhead
9251 $top.tohead conf -state readonly
9252 grid x $top.tohead -sticky w
9253 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9254 grid $top.rev x -pady 10 -padx 5
9255 ${NS}::label $top.flab -text [mc "Output file:"]
9256 ${NS}::entry $top.fname -width 60
9257 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9259 grid $top.flab $top.fname -sticky w
9260 ${NS}::frame $top.buts
9261 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9262 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9263 bind $top <Key-Return> mkpatchgo
9264 bind $top <Key-Escape> mkpatchcan
9265 grid $top.buts.gen $top.buts.can
9266 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9267 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9268 grid $top.buts - -pady 10 -sticky ew
9272 proc mkpatchrev {} {
9275 set oldid [$patchtop.fromsha1 get]
9276 set oldhead [$patchtop.fromhead get]
9277 set newid [$patchtop.tosha1 get]
9278 set newhead [$patchtop.tohead get]
9279 foreach e [list fromsha1 fromhead tosha1 tohead] \
9280 v [list $newid $newhead $oldid $oldhead] {
9281 $patchtop.$e conf -state normal
9282 $patchtop.$e delete 0 end
9283 $patchtop.$e insert 0 $v
9284 $patchtop.$e conf -state readonly
9289 global patchtop nullid nullid2
9291 set oldid [$patchtop.fromsha1 get]
9292 set newid [$patchtop.tosha1 get]
9293 set fname [$patchtop.fname get]
9294 set cmd [diffcmd [list $oldid $newid] -p]
9295 # trim off the initial "|"
9296 set cmd [lrange $cmd 1 end]
9297 lappend cmd >$fname &
9298 if {[catch {eval exec $cmd} err]} {
9299 error_popup "[mc "Error creating patch:"] $err" $patchtop
9301 catch {destroy $patchtop}
9305 proc mkpatchcan {} {
9308 catch {destroy $patchtop}
9313 global rowmenuid mktagtop commitinfo NS
9317 catch {destroy $top}
9319 make_transient $top .
9320 ${NS}::label $top.title -text [mc "Create tag"]
9321 grid $top.title - -pady 10
9322 ${NS}::label $top.id -text [mc "ID:"]
9323 ${NS}::entry $top.sha1 -width 40
9324 $top.sha1 insert 0 $rowmenuid
9325 $top.sha1 conf -state readonly
9326 grid $top.id $top.sha1 -sticky w
9327 ${NS}::entry $top.head -width 60
9328 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9329 $top.head conf -state readonly
9330 grid x $top.head -sticky w
9331 ${NS}::label $top.tlab -text [mc "Tag name:"]
9332 ${NS}::entry $top.tag -width 60
9333 grid $top.tlab $top.tag -sticky w
9334 ${NS}::label $top.op -text [mc "Tag message is optional"]
9335 grid $top.op -columnspan 2 -sticky we
9336 ${NS}::label $top.mlab -text [mc "Tag message:"]
9337 ${NS}::entry $top.msg -width 60
9338 grid $top.mlab $top.msg -sticky w
9339 ${NS}::frame $top.buts
9340 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9341 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9342 bind $top <Key-Return> mktaggo
9343 bind $top <Key-Escape> mktagcan
9344 grid $top.buts.gen $top.buts.can
9345 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9346 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9347 grid $top.buts - -pady 10 -sticky ew
9352 global mktagtop env tagids idtags
9354 set id [$mktagtop.sha1 get]
9355 set tag [$mktagtop.tag get]
9356 set msg [$mktagtop.msg get]
9358 error_popup [mc "No tag name specified"] $mktagtop
9361 if {[info exists tagids($tag)]} {
9362 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9367 exec git tag -a -m $msg $tag $id
9369 exec git tag $tag $id
9372 error_popup "[mc "Error creating tag:"] $err" $mktagtop
9376 set tagids($tag) $id
9377 lappend idtags($id) $tag
9385 proc redrawtags {id} {
9386 global canv linehtag idpos currentid curview cmitlisted markedid
9387 global canvxmax iddrawn circleitem mainheadid circlecolors
9388 global mainheadcirclecolor
9390 if {![commitinview $id $curview]} return
9391 if {![info exists iddrawn($id)]} return
9392 set row [rowofcommit $id]
9393 if {$id eq $mainheadid} {
9394 set ofill $mainheadcirclecolor
9396 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9398 $canv itemconf $circleitem($row) -fill $ofill
9399 $canv delete tag.$id
9400 set xt [eval drawtags $id $idpos($id)]
9401 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9402 set text [$canv itemcget $linehtag($id) -text]
9403 set font [$canv itemcget $linehtag($id) -font]
9404 set xr [expr {$xt + [font measure $font $text]}]
9405 if {$xr > $canvxmax} {
9409 if {[info exists currentid] && $currentid == $id} {
9412 if {[info exists markedid] && $markedid eq $id} {
9420 catch {destroy $mktagtop}
9425 if {![domktag]} return
9429 proc copysummary {} {
9430 global rowmenuid autosellen
9432 set format "%h (\"%s\", %ad)"
9433 set cmd [list git show -s --pretty=format:$format --date=short]
9434 if {$autosellen < 40} {
9435 lappend cmd --abbrev=$autosellen
9437 set summary [eval exec $cmd $rowmenuid]
9440 clipboard append $summary
9443 proc writecommit {} {
9444 global rowmenuid wrcomtop commitinfo wrcomcmd NS
9446 set top .writecommit
9448 catch {destroy $top}
9450 make_transient $top .
9451 ${NS}::label $top.title -text [mc "Write commit to file"]
9452 grid $top.title - -pady 10
9453 ${NS}::label $top.id -text [mc "ID:"]
9454 ${NS}::entry $top.sha1 -width 40
9455 $top.sha1 insert 0 $rowmenuid
9456 $top.sha1 conf -state readonly
9457 grid $top.id $top.sha1 -sticky w
9458 ${NS}::entry $top.head -width 60
9459 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9460 $top.head conf -state readonly
9461 grid x $top.head -sticky w
9462 ${NS}::label $top.clab -text [mc "Command:"]
9463 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9464 grid $top.clab $top.cmd -sticky w -pady 10
9465 ${NS}::label $top.flab -text [mc "Output file:"]
9466 ${NS}::entry $top.fname -width 60
9467 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9468 grid $top.flab $top.fname -sticky w
9469 ${NS}::frame $top.buts
9470 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9471 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9472 bind $top <Key-Return> wrcomgo
9473 bind $top <Key-Escape> wrcomcan
9474 grid $top.buts.gen $top.buts.can
9475 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9476 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9477 grid $top.buts - -pady 10 -sticky ew
9484 set id [$wrcomtop.sha1 get]
9485 set cmd "echo $id | [$wrcomtop.cmd get]"
9486 set fname [$wrcomtop.fname get]
9487 if {[catch {exec sh -c $cmd >$fname &} err]} {
9488 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9490 catch {destroy $wrcomtop}
9497 catch {destroy $wrcomtop}
9504 set top .branchdialog
9507 set val(id) $rowmenuid
9508 set val(command) [list mkbrgo $top]
9510 set ui(title) [mc "Create branch"]
9511 set ui(accept) [mc "Create"]
9513 branchdia $top val ui
9518 global headmenuid headmenuhead
9520 set top .branchdialog
9522 set val(name) $headmenuhead
9523 set val(id) $headmenuid
9524 set val(command) [list mvbrgo $top $headmenuhead]
9526 set ui(title) [mc "Rename branch %s" $headmenuhead]
9527 set ui(accept) [mc "Rename"]
9529 branchdia $top val ui
9532 proc branchdia {top valvar uivar} {
9533 global NS commitinfo
9534 upvar $valvar val $uivar ui
9536 catch {destroy $top}
9538 make_transient $top .
9539 ${NS}::label $top.title -text $ui(title)
9540 grid $top.title - -pady 10
9541 ${NS}::label $top.id -text [mc "ID:"]
9542 ${NS}::entry $top.sha1 -width 40
9543 $top.sha1 insert 0 $val(id)
9544 $top.sha1 conf -state readonly
9545 grid $top.id $top.sha1 -sticky w
9546 ${NS}::entry $top.head -width 60
9547 $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9548 $top.head conf -state readonly
9549 grid x $top.head -sticky ew
9550 grid columnconfigure $top 1 -weight 1
9551 ${NS}::label $top.nlab -text [mc "Name:"]
9552 ${NS}::entry $top.name -width 40
9553 $top.name insert 0 $val(name)
9554 grid $top.nlab $top.name -sticky w
9555 ${NS}::frame $top.buts
9556 ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9557 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9558 bind $top <Key-Return> $val(command)
9559 bind $top <Key-Escape> "catch {destroy $top}"
9560 grid $top.buts.go $top.buts.can
9561 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9562 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9563 grid $top.buts - -pady 10 -sticky ew
9568 global headids idheads
9570 set name [$top.name get]
9571 set id [$top.sha1 get]
9575 error_popup [mc "Please specify a name for the new branch"] $top
9578 if {[info exists headids($name)]} {
9579 if {![confirm_popup [mc \
9580 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9583 set old_id $headids($name)
9586 catch {destroy $top}
9587 lappend cmdargs $name $id
9591 eval exec git branch $cmdargs
9597 if {$old_id ne {}} {
9603 set headids($name) $id
9604 lappend idheads($id) $name
9613 proc mvbrgo {top prevname} {
9614 global headids idheads mainhead mainheadid
9616 set name [$top.name get]
9617 set id [$top.sha1 get]
9619 if {$name eq $prevname} {
9620 catch {destroy $top}
9624 error_popup [mc "Please specify a new name for the branch"] $top
9627 catch {destroy $top}
9628 lappend cmdargs -m $prevname $name
9629 nowbusy renamebranch
9632 eval exec git branch $cmdargs
9634 notbusy renamebranch
9637 notbusy renamebranch
9638 removehead $id $prevname
9639 removedhead $id $prevname
9640 set headids($name) $id
9641 lappend idheads($id) $name
9643 if {$prevname eq $mainhead} {
9653 proc exec_citool {tool_args {baseid {}}} {
9654 global commitinfo env
9656 set save_env [array get env GIT_AUTHOR_*]
9658 if {$baseid ne {}} {
9659 if {![info exists commitinfo($baseid)]} {
9662 set author [lindex $commitinfo($baseid) 1]
9663 set date [lindex $commitinfo($baseid) 2]
9664 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9665 $author author name email]
9667 set env(GIT_AUTHOR_NAME) $name
9668 set env(GIT_AUTHOR_EMAIL) $email
9669 set env(GIT_AUTHOR_DATE) $date
9673 eval exec git citool $tool_args &
9675 array unset env GIT_AUTHOR_*
9676 array set env $save_env
9679 proc cherrypick {} {
9680 global rowmenuid curview
9681 global mainhead mainheadid
9684 set oldhead [exec git rev-parse HEAD]
9685 set dheads [descheads $rowmenuid]
9686 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9687 set ok [confirm_popup [mc "Commit %s is already\
9688 included in branch %s -- really re-apply it?" \
9689 [string range $rowmenuid 0 7] $mainhead]]
9692 nowbusy cherrypick [mc "Cherry-picking"]
9694 # Unfortunately git-cherry-pick writes stuff to stderr even when
9695 # no error occurs, and exec takes that as an indication of error...
9696 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9699 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9701 error_popup [mc "Cherry-pick failed because of local changes\
9702 to file '%s'.\nPlease commit, reset or stash\
9703 your changes and try again." $fname]
9704 } elseif {[regexp -line \
9705 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9707 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9708 conflict.\nDo you wish to run git citool to\
9710 # Force citool to read MERGE_MSG
9711 file delete [file join $gitdir "GITGUI_MSG"]
9712 exec_citool {} $rowmenuid
9720 set newhead [exec git rev-parse HEAD]
9721 if {$newhead eq $oldhead} {
9723 error_popup [mc "No changes committed"]
9726 addnewchild $newhead $oldhead
9727 if {[commitinview $oldhead $curview]} {
9728 # XXX this isn't right if we have a path limit...
9729 insertrow $newhead $oldhead $curview
9730 if {$mainhead ne {}} {
9731 movehead $newhead $mainhead
9732 movedhead $newhead $mainhead
9734 set mainheadid $newhead
9743 global rowmenuid curview
9744 global mainhead mainheadid
9747 set oldhead [exec git rev-parse HEAD]
9748 set dheads [descheads $rowmenuid]
9749 if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9750 set ok [confirm_popup [mc "Commit %s is not\
9751 included in branch %s -- really revert it?" \
9752 [string range $rowmenuid 0 7] $mainhead]]
9755 nowbusy revert [mc "Reverting"]
9758 if [catch {exec git revert --no-edit $rowmenuid} err] {
9760 if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9762 regsub {\n( |\t)+} $files "\n" files
9763 error_popup [mc "Revert failed because of local changes to\
9764 the following files:%s Please commit, reset or stash \
9765 your changes and try again." $files]
9766 } elseif [regexp {error: could not revert} $err] {
9767 if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9768 Do you wish to run git citool to resolve it?"]] {
9769 # Force citool to read MERGE_MSG
9770 file delete [file join $gitdir "GITGUI_MSG"]
9771 exec_citool {} $rowmenuid
9773 } else { error_popup $err }
9778 set newhead [exec git rev-parse HEAD]
9779 if { $newhead eq $oldhead } {
9781 error_popup [mc "No changes committed"]
9785 addnewchild $newhead $oldhead
9787 if [commitinview $oldhead $curview] {
9788 # XXX this isn't right if we have a path limit...
9789 insertrow $newhead $oldhead $curview
9790 if {$mainhead ne {}} {
9791 movehead $newhead $mainhead
9792 movedhead $newhead $mainhead
9794 set mainheadid $newhead
9804 global mainhead rowmenuid confirm_ok resettype NS
9807 set w ".confirmreset"
9810 wm title $w [mc "Confirm reset"]
9811 ${NS}::label $w.m -text \
9812 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9813 pack $w.m -side top -fill x -padx 20 -pady 20
9814 ${NS}::labelframe $w.f -text [mc "Reset type:"]
9816 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9817 -text [mc "Soft: Leave working tree and index untouched"]
9818 grid $w.f.soft -sticky w
9819 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9820 -text [mc "Mixed: Leave working tree untouched, reset index"]
9821 grid $w.f.mixed -sticky w
9822 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9823 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9824 grid $w.f.hard -sticky w
9825 pack $w.f -side top -fill x -padx 4
9826 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9827 pack $w.ok -side left -fill x -padx 20 -pady 20
9828 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9829 bind $w <Key-Escape> [list destroy $w]
9830 pack $w.cancel -side right -fill x -padx 20 -pady 20
9831 bind $w <Visibility> "grab $w; focus $w"
9833 if {!$confirm_ok} return
9834 if {[catch {set fd [open \
9835 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9839 filerun $fd [list readresetstat $fd]
9840 nowbusy reset [mc "Resetting"]
9845 proc readresetstat {fd} {
9846 global mainhead mainheadid showlocalchanges rprogcoord
9848 if {[gets $fd line] >= 0} {
9849 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9850 set rprogcoord [expr {1.0 * $m / $n}]
9858 if {[catch {close $fd} err]} {
9861 set oldhead $mainheadid
9862 set newhead [exec git rev-parse HEAD]
9863 if {$newhead ne $oldhead} {
9864 movehead $newhead $mainhead
9865 movedhead $newhead $mainhead
9866 set mainheadid $newhead
9870 if {$showlocalchanges} {
9876 # context menu for a head
9877 proc headmenu {x y id head} {
9878 global headmenuid headmenuhead headctxmenu mainhead headids
9882 set headmenuhead $head
9883 array set state {0 normal 1 normal 2 normal}
9884 if {[string match "remotes/*" $head]} {
9885 set localhead [string range $head [expr [string last / $head] + 1] end]
9886 if {[info exists headids($localhead)]} {
9887 set state(0) disabled
9889 array set state {1 disabled 2 disabled}
9891 if {$head eq $mainhead} {
9892 array set state {0 disabled 2 disabled}
9895 $headctxmenu entryconfigure $i -state $state($i)
9897 tk_popup $headctxmenu $x $y
9901 global headmenuid headmenuhead headids
9902 global showlocalchanges
9904 # check the tree is clean first??
9905 set newhead $headmenuhead
9906 set command [list | git checkout]
9907 if {[string match "remotes/*" $newhead]} {
9909 set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9910 # The following check is redundant - the menu option should
9911 # be disabled to begin with...
9912 if {[info exists headids($newhead)]} {
9913 error_popup [mc "A local branch named %s exists already" $newhead]
9916 lappend command -b $newhead --track $remote
9918 lappend command $newhead
9920 lappend command 2>@1
9921 nowbusy checkout [mc "Checking out"]
9925 set fd [open $command r]
9929 if {$showlocalchanges} {
9933 filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9937 proc readcheckoutstat {fd newhead newheadid} {
9938 global mainhead mainheadid headids idheads showlocalchanges progresscoords
9939 global viewmainheadid curview
9941 if {[gets $fd line] >= 0} {
9942 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9943 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9948 set progresscoords {0 0}
9951 if {[catch {close $fd} err]} {
9955 set oldmainid $mainheadid
9956 if {! [info exists headids($newhead)]} {
9957 set headids($newhead) $newheadid
9958 lappend idheads($newheadid) $newhead
9959 addedhead $newheadid $newhead
9961 set mainhead $newhead
9962 set mainheadid $newheadid
9963 set viewmainheadid($curview) $newheadid
9964 redrawtags $oldmainid
9965 redrawtags $newheadid
9967 if {$showlocalchanges} {
9973 global headmenuid headmenuhead mainhead
9976 set head $headmenuhead
9978 # this check shouldn't be needed any more...
9979 if {$head eq $mainhead} {
9980 error_popup [mc "Cannot delete the currently checked-out branch"]
9983 set dheads [descheads $id]
9984 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9985 # the stuff on this branch isn't on any other branch
9986 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9987 branch.\nReally delete branch %s?" $head $head]]} return
9991 if {[catch {exec git branch -D $head} err]} {
9996 removehead $id $head
9997 removedhead $id $head
10004 # Display a list of tags and heads
10006 global showrefstop bgcolor fgcolor selectbgcolor NS
10007 global bglist fglist reflistfilter reflist maincursor
10010 set showrefstop $top
10011 if {[winfo exists $top]} {
10017 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
10018 make_transient $top .
10019 text $top.list -background $bgcolor -foreground $fgcolor \
10020 -selectbackground $selectbgcolor -font mainfont \
10021 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10022 -width 30 -height 20 -cursor $maincursor \
10023 -spacing1 1 -spacing3 1 -state disabled
10024 $top.list tag configure highlight -background $selectbgcolor
10025 if {![lsearch -exact $bglist $top.list]} {
10026 lappend bglist $top.list
10027 lappend fglist $top.list
10029 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10030 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
10031 grid $top.list $top.ysb -sticky nsew
10032 grid $top.xsb x -sticky ew
10033 ${NS}::frame $top.f
10034 ${NS}::label $top.f.l -text "[mc "Filter"]: "
10035 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
10036 set reflistfilter "*"
10037 trace add variable reflistfilter write reflistfilter_change
10038 pack $top.f.e -side right -fill x -expand 1
10039 pack $top.f.l -side left
10040 grid $top.f - -sticky ew -pady 2
10041 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10042 bind $top <Key-Escape> [list destroy $top]
10044 grid columnconfigure $top 0 -weight 1
10045 grid rowconfigure $top 0 -weight 1
10046 bind $top.list <1> {break}
10047 bind $top.list <B1-Motion> {break}
10048 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10053 proc sel_reflist {w x y} {
10054 global showrefstop reflist headids tagids otherrefids
10056 if {![winfo exists $showrefstop]} return
10057 set l [lindex [split [$w index "@$x,$y"] "."] 0]
10058 set ref [lindex $reflist [expr {$l-1}]]
10059 set n [lindex $ref 0]
10060 switch -- [lindex $ref 1] {
10061 "H" {selbyid $headids($n)}
10062 "R" {selbyid $headids($n)}
10063 "T" {selbyid $tagids($n)}
10064 "o" {selbyid $otherrefids($n)}
10066 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10069 proc unsel_reflist {} {
10072 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10073 $showrefstop.list tag remove highlight 0.0 end
10076 proc reflistfilter_change {n1 n2 op} {
10077 global reflistfilter
10079 after cancel refill_reflist
10080 after 200 refill_reflist
10083 proc refill_reflist {} {
10084 global reflist reflistfilter showrefstop headids tagids otherrefids
10087 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10089 foreach n [array names headids] {
10090 if {[string match $reflistfilter $n]} {
10091 if {[commitinview $headids($n) $curview]} {
10092 if {[string match "remotes/*" $n]} {
10093 lappend refs [list $n R]
10095 lappend refs [list $n H]
10098 interestedin $headids($n) {run refill_reflist}
10102 foreach n [array names tagids] {
10103 if {[string match $reflistfilter $n]} {
10104 if {[commitinview $tagids($n) $curview]} {
10105 lappend refs [list $n T]
10107 interestedin $tagids($n) {run refill_reflist}
10111 foreach n [array names otherrefids] {
10112 if {[string match $reflistfilter $n]} {
10113 if {[commitinview $otherrefids($n) $curview]} {
10114 lappend refs [list $n o]
10116 interestedin $otherrefids($n) {run refill_reflist}
10120 set refs [lsort -index 0 $refs]
10121 if {$refs eq $reflist} return
10123 # Update the contents of $showrefstop.list according to the
10124 # differences between $reflist (old) and $refs (new)
10125 $showrefstop.list conf -state normal
10126 $showrefstop.list insert end "\n"
10129 while {$i < [llength $reflist] || $j < [llength $refs]} {
10130 if {$i < [llength $reflist]} {
10131 if {$j < [llength $refs]} {
10132 set cmp [string compare [lindex $reflist $i 0] \
10133 [lindex $refs $j 0]]
10135 set cmp [string compare [lindex $reflist $i 1] \
10136 [lindex $refs $j 1]]
10146 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10154 set l [expr {$j + 1}]
10155 $showrefstop.list image create $l.0 -align baseline \
10156 -image reficon-[lindex $refs $j 1] -padx 2
10157 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10163 # delete last newline
10164 $showrefstop.list delete end-2c end-1c
10165 $showrefstop.list conf -state disabled
10168 # Stuff for finding nearby tags
10169 proc getallcommits {} {
10170 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10171 global idheads idtags idotherrefs allparents tagobjid
10174 if {![info exists allcommits]} {
10180 set allccache [file join $gitdir "gitk.cache"]
10182 set f [open $allccache r]
10191 set cmd [list | git rev-list --parents]
10192 set allcupdate [expr {$seeds ne {}}]
10193 if {!$allcupdate} {
10196 set refs [concat [array names idheads] [array names idtags] \
10197 [array names idotherrefs]]
10200 foreach name [array names tagobjid] {
10201 lappend tagobjs $tagobjid($name)
10203 foreach id [lsort -unique $refs] {
10204 if {![info exists allparents($id)] &&
10205 [lsearch -exact $tagobjs $id] < 0} {
10210 foreach id $seeds {
10216 set fd [open [concat $cmd $ids] r]
10217 fconfigure $fd -blocking 0
10220 filerun $fd [list getallclines $fd]
10226 # Since most commits have 1 parent and 1 child, we group strings of
10227 # such commits into "arcs" joining branch/merge points (BMPs), which
10228 # are commits that either don't have 1 parent or don't have 1 child.
10230 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10231 # arcout(id) - outgoing arcs for BMP
10232 # arcids(a) - list of IDs on arc including end but not start
10233 # arcstart(a) - BMP ID at start of arc
10234 # arcend(a) - BMP ID at end of arc
10235 # growing(a) - arc a is still growing
10236 # arctags(a) - IDs out of arcids (excluding end) that have tags
10237 # archeads(a) - IDs out of arcids (excluding end) that have heads
10238 # The start of an arc is at the descendent end, so "incoming" means
10239 # coming from descendents, and "outgoing" means going towards ancestors.
10241 proc getallclines {fd} {
10242 global allparents allchildren idtags idheads nextarc
10243 global arcnos arcids arctags arcout arcend arcstart archeads growing
10244 global seeds allcommits cachedarcs allcupdate
10247 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10248 set id [lindex $line 0]
10249 if {[info exists allparents($id)]} {
10254 set olds [lrange $line 1 end]
10255 set allparents($id) $olds
10256 if {![info exists allchildren($id)]} {
10257 set allchildren($id) {}
10262 if {[llength $olds] == 1 && [llength $a] == 1} {
10263 lappend arcids($a) $id
10264 if {[info exists idtags($id)]} {
10265 lappend arctags($a) $id
10267 if {[info exists idheads($id)]} {
10268 lappend archeads($a) $id
10270 if {[info exists allparents($olds)]} {
10271 # seen parent already
10272 if {![info exists arcout($olds)]} {
10275 lappend arcids($a) $olds
10276 set arcend($a) $olds
10279 lappend allchildren($olds) $id
10280 lappend arcnos($olds) $a
10284 foreach a $arcnos($id) {
10285 lappend arcids($a) $id
10292 lappend allchildren($p) $id
10293 set a [incr nextarc]
10294 set arcstart($a) $id
10295 set archeads($a) {}
10297 set archeads($a) {}
10301 if {[info exists allparents($p)]} {
10302 # seen it already, may need to make a new branch
10303 if {![info exists arcout($p)]} {
10306 lappend arcids($a) $p
10310 lappend arcnos($p) $a
10312 set arcout($id) $ao
10315 global cached_dheads cached_dtags cached_atags
10316 unset -nocomplain cached_dheads
10317 unset -nocomplain cached_dtags
10318 unset -nocomplain cached_atags
10321 return [expr {$nid >= 1000? 2: 1}]
10325 fconfigure $fd -blocking 1
10328 # got an error reading the list of commits
10329 # if we were updating, try rereading the whole thing again
10335 error_popup "[mc "Error reading commit topology information;\
10336 branch and preceding/following tag information\
10337 will be incomplete."]\n($err)"
10340 if {[incr allcommits -1] == 0} {
10350 proc recalcarc {a} {
10351 global arctags archeads arcids idtags idheads
10355 foreach id [lrange $arcids($a) 0 end-1] {
10356 if {[info exists idtags($id)]} {
10359 if {[info exists idheads($id)]} {
10363 set arctags($a) $at
10364 set archeads($a) $ah
10367 proc splitarc {p} {
10368 global arcnos arcids nextarc arctags archeads idtags idheads
10369 global arcstart arcend arcout allparents growing
10372 if {[llength $a] != 1} {
10373 puts "oops splitarc called but [llength $a] arcs already"
10376 set a [lindex $a 0]
10377 set i [lsearch -exact $arcids($a) $p]
10379 puts "oops splitarc $p not in arc $a"
10382 set na [incr nextarc]
10383 if {[info exists arcend($a)]} {
10384 set arcend($na) $arcend($a)
10386 set l [lindex $allparents([lindex $arcids($a) end]) 0]
10387 set j [lsearch -exact $arcnos($l) $a]
10388 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10390 set tail [lrange $arcids($a) [expr {$i+1}] end]
10391 set arcids($a) [lrange $arcids($a) 0 $i]
10393 set arcstart($na) $p
10395 set arcids($na) $tail
10396 if {[info exists growing($a)]} {
10402 if {[llength $arcnos($id)] == 1} {
10403 set arcnos($id) $na
10405 set j [lsearch -exact $arcnos($id) $a]
10406 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10410 # reconstruct tags and heads lists
10411 if {$arctags($a) ne {} || $archeads($a) ne {}} {
10415 set arctags($na) {}
10416 set archeads($na) {}
10420 # Update things for a new commit added that is a child of one
10421 # existing commit. Used when cherry-picking.
10422 proc addnewchild {id p} {
10423 global allparents allchildren idtags nextarc
10424 global arcnos arcids arctags arcout arcend arcstart archeads growing
10425 global seeds allcommits
10427 if {![info exists allcommits] || ![info exists arcnos($p)]} return
10428 set allparents($id) [list $p]
10429 set allchildren($id) {}
10432 lappend allchildren($p) $id
10433 set a [incr nextarc]
10434 set arcstart($a) $id
10435 set archeads($a) {}
10437 set arcids($a) [list $p]
10439 if {![info exists arcout($p)]} {
10442 lappend arcnos($p) $a
10443 set arcout($id) [list $a]
10446 # This implements a cache for the topology information.
10447 # The cache saves, for each arc, the start and end of the arc,
10448 # the ids on the arc, and the outgoing arcs from the end.
10449 proc readcache {f} {
10450 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10451 global idtags idheads allparents cachedarcs possible_seeds seeds growing
10455 set lim $cachedarcs
10456 if {$lim - $a > 500} {
10457 set lim [expr {$a + 500}]
10461 # finish reading the cache and setting up arctags, etc.
10463 if {$line ne "1"} {error "bad final version"}
10465 foreach id [array names idtags] {
10466 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10467 [llength $allparents($id)] == 1} {
10468 set a [lindex $arcnos($id) 0]
10469 if {$arctags($a) eq {}} {
10474 foreach id [array names idheads] {
10475 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10476 [llength $allparents($id)] == 1} {
10477 set a [lindex $arcnos($id) 0]
10478 if {$archeads($a) eq {}} {
10483 foreach id [lsort -unique $possible_seeds] {
10484 if {$arcnos($id) eq {}} {
10490 while {[incr a] <= $lim} {
10492 if {[llength $line] != 3} {error "bad line"}
10493 set s [lindex $line 0]
10494 set arcstart($a) $s
10495 lappend arcout($s) $a
10496 if {![info exists arcnos($s)]} {
10497 lappend possible_seeds $s
10500 set e [lindex $line 1]
10505 if {![info exists arcout($e)]} {
10509 set arcids($a) [lindex $line 2]
10510 foreach id $arcids($a) {
10511 lappend allparents($s) $id
10513 lappend arcnos($id) $a
10515 if {![info exists allparents($s)]} {
10516 set allparents($s) {}
10519 set archeads($a) {}
10521 set nextarc [expr {$a - 1}]
10533 proc getcache {f} {
10534 global nextarc cachedarcs possible_seeds
10538 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10539 # make sure it's an integer
10540 set cachedarcs [expr {int([lindex $line 1])}]
10541 if {$cachedarcs < 0} {error "bad number of arcs"}
10543 set possible_seeds {}
10551 proc dropcache {err} {
10552 global allcwait nextarc cachedarcs seeds
10554 #puts "dropping cache ($err)"
10555 foreach v {arcnos arcout arcids arcstart arcend growing \
10556 arctags archeads allparents allchildren} {
10558 unset -nocomplain $v
10567 proc writecache {f} {
10568 global cachearc cachedarcs allccache
10569 global arcstart arcend arcnos arcids arcout
10572 set lim $cachedarcs
10573 if {$lim - $a > 1000} {
10574 set lim [expr {$a + 1000}]
10577 while {[incr a] <= $lim} {
10578 if {[info exists arcend($a)]} {
10579 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10581 puts $f [list $arcstart($a) {} $arcids($a)]
10586 catch {file delete $allccache}
10587 #puts "writing cache failed ($err)"
10590 set cachearc [expr {$a - 1}]
10591 if {$a > $cachedarcs} {
10599 proc savecache {} {
10600 global nextarc cachedarcs cachearc allccache
10602 if {$nextarc == $cachedarcs} return
10604 set cachedarcs $nextarc
10606 set f [open $allccache w]
10607 puts $f [list 1 $cachedarcs]
10612 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10613 # or 0 if neither is true.
10614 proc anc_or_desc {a b} {
10615 global arcout arcstart arcend arcnos cached_isanc
10617 if {$arcnos($a) eq $arcnos($b)} {
10618 # Both are on the same arc(s); either both are the same BMP,
10619 # or if one is not a BMP, the other is also not a BMP or is
10620 # the BMP at end of the arc (and it only has 1 incoming arc).
10621 # Or both can be BMPs with no incoming arcs.
10622 if {$a eq $b || $arcnos($a) eq {}} {
10625 # assert {[llength $arcnos($a)] == 1}
10626 set arc [lindex $arcnos($a) 0]
10627 set i [lsearch -exact $arcids($arc) $a]
10628 set j [lsearch -exact $arcids($arc) $b]
10629 if {$i < 0 || $i > $j} {
10636 if {![info exists arcout($a)]} {
10637 set arc [lindex $arcnos($a) 0]
10638 if {[info exists arcend($arc)]} {
10639 set aend $arcend($arc)
10643 set a $arcstart($arc)
10647 if {![info exists arcout($b)]} {
10648 set arc [lindex $arcnos($b) 0]
10649 if {[info exists arcend($arc)]} {
10650 set bend $arcend($arc)
10654 set b $arcstart($arc)
10664 if {[info exists cached_isanc($a,$bend)]} {
10665 if {$cached_isanc($a,$bend)} {
10669 if {[info exists cached_isanc($b,$aend)]} {
10670 if {$cached_isanc($b,$aend)} {
10673 if {[info exists cached_isanc($a,$bend)]} {
10678 set todo [list $a $b]
10681 for {set i 0} {$i < [llength $todo]} {incr i} {
10682 set x [lindex $todo $i]
10683 if {$anc($x) eq {}} {
10686 foreach arc $arcnos($x) {
10687 set xd $arcstart($arc)
10688 if {$xd eq $bend} {
10689 set cached_isanc($a,$bend) 1
10690 set cached_isanc($b,$aend) 0
10692 } elseif {$xd eq $aend} {
10693 set cached_isanc($b,$aend) 1
10694 set cached_isanc($a,$bend) 0
10697 if {![info exists anc($xd)]} {
10698 set anc($xd) $anc($x)
10700 } elseif {$anc($xd) ne $anc($x)} {
10705 set cached_isanc($a,$bend) 0
10706 set cached_isanc($b,$aend) 0
10710 # This identifies whether $desc has an ancestor that is
10711 # a growing tip of the graph and which is not an ancestor of $anc
10712 # and returns 0 if so and 1 if not.
10713 # If we subsequently discover a tag on such a growing tip, and that
10714 # turns out to be a descendent of $anc (which it could, since we
10715 # don't necessarily see children before parents), then $desc
10716 # isn't a good choice to display as a descendent tag of
10717 # $anc (since it is the descendent of another tag which is
10718 # a descendent of $anc). Similarly, $anc isn't a good choice to
10719 # display as a ancestor tag of $desc.
10721 proc is_certain {desc anc} {
10722 global arcnos arcout arcstart arcend growing problems
10725 if {[llength $arcnos($anc)] == 1} {
10726 # tags on the same arc are certain
10727 if {$arcnos($desc) eq $arcnos($anc)} {
10730 if {![info exists arcout($anc)]} {
10731 # if $anc is partway along an arc, use the start of the arc instead
10732 set a [lindex $arcnos($anc) 0]
10733 set anc $arcstart($a)
10736 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10739 set a [lindex $arcnos($desc) 0]
10745 set anclist [list $x]
10749 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10750 set x [lindex $anclist $i]
10755 foreach a $arcout($x) {
10756 if {[info exists growing($a)]} {
10757 if {![info exists growanc($x)] && $dl($x)} {
10763 if {[info exists dl($y)]} {
10767 if {![info exists done($y)]} {
10770 if {[info exists growanc($x)]} {
10774 for {set k 0} {$k < [llength $xl]} {incr k} {
10775 set z [lindex $xl $k]
10776 foreach c $arcout($z) {
10777 if {[info exists arcend($c)]} {
10779 if {[info exists dl($v)] && $dl($v)} {
10781 if {![info exists done($v)]} {
10784 if {[info exists growanc($v)]} {
10794 } elseif {$y eq $anc || !$dl($x)} {
10805 foreach x [array names growanc] {
10814 proc validate_arctags {a} {
10815 global arctags idtags
10818 set na $arctags($a)
10819 foreach id $arctags($a) {
10821 if {![info exists idtags($id)]} {
10822 set na [lreplace $na $i $i]
10826 set arctags($a) $na
10829 proc validate_archeads {a} {
10830 global archeads idheads
10833 set na $archeads($a)
10834 foreach id $archeads($a) {
10836 if {![info exists idheads($id)]} {
10837 set na [lreplace $na $i $i]
10841 set archeads($a) $na
10844 # Return the list of IDs that have tags that are descendents of id,
10845 # ignoring IDs that are descendents of IDs already reported.
10846 proc desctags {id} {
10847 global arcnos arcstart arcids arctags idtags allparents
10848 global growing cached_dtags
10850 if {![info exists allparents($id)]} {
10853 set t1 [clock clicks -milliseconds]
10855 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10856 # part-way along an arc; check that arc first
10857 set a [lindex $arcnos($id) 0]
10858 if {$arctags($a) ne {}} {
10859 validate_arctags $a
10860 set i [lsearch -exact $arcids($a) $id]
10862 foreach t $arctags($a) {
10863 set j [lsearch -exact $arcids($a) $t]
10864 if {$j >= $i} break
10871 set id $arcstart($a)
10872 if {[info exists idtags($id)]} {
10876 if {[info exists cached_dtags($id)]} {
10877 return $cached_dtags($id)
10881 set todo [list $id]
10884 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10885 set id [lindex $todo $i]
10887 set ta [info exists hastaggedancestor($id)]
10891 # ignore tags on starting node
10892 if {!$ta && $i > 0} {
10893 if {[info exists idtags($id)]} {
10894 set tagloc($id) $id
10896 } elseif {[info exists cached_dtags($id)]} {
10897 set tagloc($id) $cached_dtags($id)
10901 foreach a $arcnos($id) {
10902 set d $arcstart($a)
10903 if {!$ta && $arctags($a) ne {}} {
10904 validate_arctags $a
10905 if {$arctags($a) ne {}} {
10906 lappend tagloc($id) [lindex $arctags($a) end]
10909 if {$ta || $arctags($a) ne {}} {
10910 set tomark [list $d]
10911 for {set j 0} {$j < [llength $tomark]} {incr j} {
10912 set dd [lindex $tomark $j]
10913 if {![info exists hastaggedancestor($dd)]} {
10914 if {[info exists done($dd)]} {
10915 foreach b $arcnos($dd) {
10916 lappend tomark $arcstart($b)
10918 if {[info exists tagloc($dd)]} {
10921 } elseif {[info exists queued($dd)]} {
10924 set hastaggedancestor($dd) 1
10928 if {![info exists queued($d)]} {
10931 if {![info exists hastaggedancestor($d)]} {
10938 foreach id [array names tagloc] {
10939 if {![info exists hastaggedancestor($id)]} {
10940 foreach t $tagloc($id) {
10941 if {[lsearch -exact $tags $t] < 0} {
10947 set t2 [clock clicks -milliseconds]
10950 # remove tags that are descendents of other tags
10951 for {set i 0} {$i < [llength $tags]} {incr i} {
10952 set a [lindex $tags $i]
10953 for {set j 0} {$j < $i} {incr j} {
10954 set b [lindex $tags $j]
10955 set r [anc_or_desc $a $b]
10957 set tags [lreplace $tags $j $j]
10960 } elseif {$r == -1} {
10961 set tags [lreplace $tags $i $i]
10968 if {[array names growing] ne {}} {
10969 # graph isn't finished, need to check if any tag could get
10970 # eclipsed by another tag coming later. Simply ignore any
10971 # tags that could later get eclipsed.
10974 if {[is_certain $t $origid]} {
10978 if {$tags eq $ctags} {
10979 set cached_dtags($origid) $tags
10984 set cached_dtags($origid) $tags
10986 set t3 [clock clicks -milliseconds]
10987 if {0 && $t3 - $t1 >= 100} {
10988 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10989 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10994 proc anctags {id} {
10995 global arcnos arcids arcout arcend arctags idtags allparents
10996 global growing cached_atags
10998 if {![info exists allparents($id)]} {
11001 set t1 [clock clicks -milliseconds]
11003 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
11004 # part-way along an arc; check that arc first
11005 set a [lindex $arcnos($id) 0]
11006 if {$arctags($a) ne {}} {
11007 validate_arctags $a
11008 set i [lsearch -exact $arcids($a) $id]
11009 foreach t $arctags($a) {
11010 set j [lsearch -exact $arcids($a) $t]
11016 if {![info exists arcend($a)]} {
11020 if {[info exists idtags($id)]} {
11024 if {[info exists cached_atags($id)]} {
11025 return $cached_atags($id)
11029 set todo [list $id]
11033 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
11034 set id [lindex $todo $i]
11036 set td [info exists hastaggeddescendent($id)]
11040 # ignore tags on starting node
11041 if {!$td && $i > 0} {
11042 if {[info exists idtags($id)]} {
11043 set tagloc($id) $id
11045 } elseif {[info exists cached_atags($id)]} {
11046 set tagloc($id) $cached_atags($id)
11050 foreach a $arcout($id) {
11051 if {!$td && $arctags($a) ne {}} {
11052 validate_arctags $a
11053 if {$arctags($a) ne {}} {
11054 lappend tagloc($id) [lindex $arctags($a) 0]
11057 if {![info exists arcend($a)]} continue
11059 if {$td || $arctags($a) ne {}} {
11060 set tomark [list $d]
11061 for {set j 0} {$j < [llength $tomark]} {incr j} {
11062 set dd [lindex $tomark $j]
11063 if {![info exists hastaggeddescendent($dd)]} {
11064 if {[info exists done($dd)]} {
11065 foreach b $arcout($dd) {
11066 if {[info exists arcend($b)]} {
11067 lappend tomark $arcend($b)
11070 if {[info exists tagloc($dd)]} {
11073 } elseif {[info exists queued($dd)]} {
11076 set hastaggeddescendent($dd) 1
11080 if {![info exists queued($d)]} {
11083 if {![info exists hastaggeddescendent($d)]} {
11089 set t2 [clock clicks -milliseconds]
11092 foreach id [array names tagloc] {
11093 if {![info exists hastaggeddescendent($id)]} {
11094 foreach t $tagloc($id) {
11095 if {[lsearch -exact $tags $t] < 0} {
11102 # remove tags that are ancestors of other tags
11103 for {set i 0} {$i < [llength $tags]} {incr i} {
11104 set a [lindex $tags $i]
11105 for {set j 0} {$j < $i} {incr j} {
11106 set b [lindex $tags $j]
11107 set r [anc_or_desc $a $b]
11109 set tags [lreplace $tags $j $j]
11112 } elseif {$r == 1} {
11113 set tags [lreplace $tags $i $i]
11120 if {[array names growing] ne {}} {
11121 # graph isn't finished, need to check if any tag could get
11122 # eclipsed by another tag coming later. Simply ignore any
11123 # tags that could later get eclipsed.
11126 if {[is_certain $origid $t]} {
11130 if {$tags eq $ctags} {
11131 set cached_atags($origid) $tags
11136 set cached_atags($origid) $tags
11138 set t3 [clock clicks -milliseconds]
11139 if {0 && $t3 - $t1 >= 100} {
11140 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11141 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11146 # Return the list of IDs that have heads that are descendents of id,
11147 # including id itself if it has a head.
11148 proc descheads {id} {
11149 global arcnos arcstart arcids archeads idheads cached_dheads
11150 global allparents arcout
11152 if {![info exists allparents($id)]} {
11156 if {![info exists arcout($id)]} {
11157 # part-way along an arc; check it first
11158 set a [lindex $arcnos($id) 0]
11159 if {$archeads($a) ne {}} {
11160 validate_archeads $a
11161 set i [lsearch -exact $arcids($a) $id]
11162 foreach t $archeads($a) {
11163 set j [lsearch -exact $arcids($a) $t]
11168 set id $arcstart($a)
11171 set todo [list $id]
11174 for {set i 0} {$i < [llength $todo]} {incr i} {
11175 set id [lindex $todo $i]
11176 if {[info exists cached_dheads($id)]} {
11177 set ret [concat $ret $cached_dheads($id)]
11179 if {[info exists idheads($id)]} {
11182 foreach a $arcnos($id) {
11183 if {$archeads($a) ne {}} {
11184 validate_archeads $a
11185 if {$archeads($a) ne {}} {
11186 set ret [concat $ret $archeads($a)]
11189 set d $arcstart($a)
11190 if {![info exists seen($d)]} {
11197 set ret [lsort -unique $ret]
11198 set cached_dheads($origid) $ret
11199 return [concat $ret $aret]
11202 proc addedtag {id} {
11203 global arcnos arcout cached_dtags cached_atags
11205 if {![info exists arcnos($id)]} return
11206 if {![info exists arcout($id)]} {
11207 recalcarc [lindex $arcnos($id) 0]
11209 unset -nocomplain cached_dtags
11210 unset -nocomplain cached_atags
11213 proc addedhead {hid head} {
11214 global arcnos arcout cached_dheads
11216 if {![info exists arcnos($hid)]} return
11217 if {![info exists arcout($hid)]} {
11218 recalcarc [lindex $arcnos($hid) 0]
11220 unset -nocomplain cached_dheads
11223 proc removedhead {hid head} {
11224 global cached_dheads
11226 unset -nocomplain cached_dheads
11229 proc movedhead {hid head} {
11230 global arcnos arcout cached_dheads
11232 if {![info exists arcnos($hid)]} return
11233 if {![info exists arcout($hid)]} {
11234 recalcarc [lindex $arcnos($hid) 0]
11236 unset -nocomplain cached_dheads
11239 proc changedrefs {} {
11240 global cached_dheads cached_dtags cached_atags cached_tagcontent
11241 global arctags archeads arcnos arcout idheads idtags
11243 foreach id [concat [array names idheads] [array names idtags]] {
11244 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11245 set a [lindex $arcnos($id) 0]
11246 if {![info exists donearc($a)]} {
11252 unset -nocomplain cached_tagcontent
11253 unset -nocomplain cached_dtags
11254 unset -nocomplain cached_atags
11255 unset -nocomplain cached_dheads
11258 proc rereadrefs {} {
11259 global idtags idheads idotherrefs mainheadid
11261 set refids [concat [array names idtags] \
11262 [array names idheads] [array names idotherrefs]]
11263 foreach id $refids {
11264 if {![info exists ref($id)]} {
11265 set ref($id) [listrefs $id]
11268 set oldmainhead $mainheadid
11271 set refids [lsort -unique [concat $refids [array names idtags] \
11272 [array names idheads] [array names idotherrefs]]]
11273 foreach id $refids {
11274 set v [listrefs $id]
11275 if {![info exists ref($id)] || $ref($id) != $v} {
11279 if {$oldmainhead ne $mainheadid} {
11280 redrawtags $oldmainhead
11281 redrawtags $mainheadid
11286 proc listrefs {id} {
11287 global idtags idheads idotherrefs
11290 if {[info exists idtags($id)]} {
11294 if {[info exists idheads($id)]} {
11295 set y $idheads($id)
11298 if {[info exists idotherrefs($id)]} {
11299 set z $idotherrefs($id)
11301 return [list $x $y $z]
11304 proc add_tag_ctext {tag} {
11305 global ctext cached_tagcontent tagids
11307 if {![info exists cached_tagcontent($tag)]} {
11309 set cached_tagcontent($tag) [exec git cat-file -p $tag]
11312 $ctext insert end "[mc "Tag"]: $tag\n" bold
11313 if {[info exists cached_tagcontent($tag)]} {
11314 set text $cached_tagcontent($tag)
11316 set text "[mc "Id"]: $tagids($tag)"
11318 appendwithlinks $text {}
11321 proc showtag {tag isnew} {
11322 global ctext cached_tagcontent tagids linknum tagobjid
11325 addtohistory [list showtag $tag 0] savectextpos
11327 $ctext conf -state normal
11332 maybe_scroll_ctext 1
11333 $ctext conf -state disabled
11337 proc showtags {id isnew} {
11338 global idtags ctext linknum
11341 addtohistory [list showtags $id 0] savectextpos
11343 $ctext conf -state normal
11348 foreach tag $idtags($id) {
11349 $ctext insert end $sep
11353 maybe_scroll_ctext 1
11354 $ctext conf -state disabled
11366 if {[info exists gitktmpdir]} {
11367 catch {file delete -force $gitktmpdir}
11371 proc mkfontdisp {font top which} {
11372 global fontattr fontpref $font NS use_ttk
11374 set fontpref($font) [set $font]
11375 ${NS}::button $top.${font}but -text $which \
11376 -command [list choosefont $font $which]
11377 ${NS}::label $top.$font -relief flat -font $font \
11378 -text $fontattr($font,family) -justify left
11379 grid x $top.${font}but $top.$font -sticky w
11382 proc choosefont {font which} {
11383 global fontparam fontlist fonttop fontattr
11386 set fontparam(which) $which
11387 set fontparam(font) $font
11388 set fontparam(family) [font actual $font -family]
11389 set fontparam(size) $fontattr($font,size)
11390 set fontparam(weight) $fontattr($font,weight)
11391 set fontparam(slant) $fontattr($font,slant)
11394 if {![winfo exists $top]} {
11396 eval font config sample [font actual $font]
11398 make_transient $top $prefstop
11399 wm title $top [mc "Gitk font chooser"]
11400 ${NS}::label $top.l -textvariable fontparam(which)
11401 pack $top.l -side top
11402 set fontlist [lsort [font families]]
11403 ${NS}::frame $top.f
11404 listbox $top.f.fam -listvariable fontlist \
11405 -yscrollcommand [list $top.f.sb set]
11406 bind $top.f.fam <<ListboxSelect>> selfontfam
11407 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11408 pack $top.f.sb -side right -fill y
11409 pack $top.f.fam -side left -fill both -expand 1
11410 pack $top.f -side top -fill both -expand 1
11411 ${NS}::frame $top.g
11412 spinbox $top.g.size -from 4 -to 40 -width 4 \
11413 -textvariable fontparam(size) \
11414 -validatecommand {string is integer -strict %s}
11415 checkbutton $top.g.bold -padx 5 \
11416 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11417 -variable fontparam(weight) -onvalue bold -offvalue normal
11418 checkbutton $top.g.ital -padx 5 \
11419 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
11420 -variable fontparam(slant) -onvalue italic -offvalue roman
11421 pack $top.g.size $top.g.bold $top.g.ital -side left
11422 pack $top.g -side top
11423 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11425 $top.c create text 100 25 -anchor center -text $which -font sample \
11426 -fill black -tags text
11427 bind $top.c <Configure> [list centertext $top.c]
11428 pack $top.c -side top -fill x
11429 ${NS}::frame $top.buts
11430 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11431 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11432 bind $top <Key-Return> fontok
11433 bind $top <Key-Escape> fontcan
11434 grid $top.buts.ok $top.buts.can
11435 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11436 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11437 pack $top.buts -side bottom -fill x
11438 trace add variable fontparam write chg_fontparam
11441 $top.c itemconf text -text $which
11443 set i [lsearch -exact $fontlist $fontparam(family)]
11445 $top.f.fam selection set $i
11450 proc centertext {w} {
11451 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11455 global fontparam fontpref prefstop
11457 set f $fontparam(font)
11458 set fontpref($f) [list $fontparam(family) $fontparam(size)]
11459 if {$fontparam(weight) eq "bold"} {
11460 lappend fontpref($f) "bold"
11462 if {$fontparam(slant) eq "italic"} {
11463 lappend fontpref($f) "italic"
11465 set w $prefstop.notebook.fonts.$f
11466 $w conf -text $fontparam(family) -font $fontpref($f)
11472 global fonttop fontparam
11474 if {[info exists fonttop]} {
11475 catch {destroy $fonttop}
11476 catch {font delete sample}
11482 if {[package vsatisfies [package provide Tk] 8.6]} {
11483 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11484 # function to make use of it.
11485 proc choosefont {font which} {
11486 tk fontchooser configure -title $which -font $font \
11487 -command [list on_choosefont $font $which]
11488 tk fontchooser show
11490 proc on_choosefont {font which newfont} {
11492 puts stderr "$font $newfont"
11493 array set f [font actual $newfont]
11494 set fontparam(which) $which
11495 set fontparam(font) $font
11496 set fontparam(family) $f(-family)
11497 set fontparam(size) $f(-size)
11498 set fontparam(weight) $f(-weight)
11499 set fontparam(slant) $f(-slant)
11504 proc selfontfam {} {
11505 global fonttop fontparam
11507 set i [$fonttop.f.fam curselection]
11509 set fontparam(family) [$fonttop.f.fam get $i]
11513 proc chg_fontparam {v sub op} {
11516 font config sample -$sub $fontparam($sub)
11519 # Create a property sheet tab page
11520 proc create_prefs_page {w} {
11522 set parent [join [lrange [split $w .] 0 end-1] .]
11523 if {[winfo class $parent] eq "TNotebook"} {
11526 ${NS}::labelframe $w
11530 proc prefspage_general {notebook} {
11531 global NS maxwidth maxgraphpct showneartags showlocalchanges
11532 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11533 global hideremotes want_ttk have_ttk maxrefs web_browser
11535 set page [create_prefs_page $notebook.general]
11537 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11538 grid $page.ldisp - -sticky w -pady 10
11539 ${NS}::label $page.spacer -text " "
11540 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11541 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11542 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11543 #xgettext:no-tcl-format
11544 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11545 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11546 grid x $page.maxpctl $page.maxpct -sticky w
11547 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11548 -variable showlocalchanges
11549 grid x $page.showlocal -sticky w
11550 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11551 -variable autoselect
11552 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11553 grid x $page.autoselect $page.autosellen -sticky w
11554 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11555 -variable hideremotes
11556 grid x $page.hideremotes -sticky w
11558 ${NS}::label $page.ddisp -text [mc "Diff display options"]
11559 grid $page.ddisp - -sticky w -pady 10
11560 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11561 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11562 grid x $page.tabstopl $page.tabstop -sticky w
11563 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11564 -variable showneartags
11565 grid x $page.ntag -sticky w
11566 ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11567 spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11568 grid x $page.maxrefsl $page.maxrefs -sticky w
11569 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11570 -variable limitdiffs
11571 grid x $page.ldiff -sticky w
11572 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11573 -variable perfile_attrs
11574 grid x $page.lattr -sticky w
11576 ${NS}::entry $page.extdifft -textvariable extdifftool
11577 ${NS}::frame $page.extdifff
11578 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11579 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11580 pack $page.extdifff.l $page.extdifff.b -side left
11581 pack configure $page.extdifff.l -padx 10
11582 grid x $page.extdifff $page.extdifft -sticky ew
11584 ${NS}::entry $page.webbrowser -textvariable web_browser
11585 ${NS}::frame $page.webbrowserf
11586 ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11587 pack $page.webbrowserf.l -side left
11588 pack configure $page.webbrowserf.l -padx 10
11589 grid x $page.webbrowserf $page.webbrowser -sticky ew
11591 ${NS}::label $page.lgen -text [mc "General options"]
11592 grid $page.lgen - -sticky w -pady 10
11593 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11594 -text [mc "Use themed widgets"]
11596 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11598 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11600 grid x $page.want_ttk $page.ttk_note -sticky w
11604 proc prefspage_colors {notebook} {
11605 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11607 set page [create_prefs_page $notebook.colors]
11609 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11610 grid $page.cdisp - -sticky w -pady 10
11611 label $page.ui -padx 40 -relief sunk -background $uicolor
11612 ${NS}::button $page.uibut -text [mc "Interface"] \
11613 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11614 grid x $page.uibut $page.ui -sticky w
11615 label $page.bg -padx 40 -relief sunk -background $bgcolor
11616 ${NS}::button $page.bgbut -text [mc "Background"] \
11617 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11618 grid x $page.bgbut $page.bg -sticky w
11619 label $page.fg -padx 40 -relief sunk -background $fgcolor
11620 ${NS}::button $page.fgbut -text [mc "Foreground"] \
11621 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11622 grid x $page.fgbut $page.fg -sticky w
11623 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11624 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11625 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11626 [list $ctext tag conf d0 -foreground]]
11627 grid x $page.diffoldbut $page.diffold -sticky w
11628 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11629 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11630 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11631 [list $ctext tag conf dresult -foreground]]
11632 grid x $page.diffnewbut $page.diffnew -sticky w
11633 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11634 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11635 -command [list choosecolor diffcolors 2 $page.hunksep \
11636 [mc "diff hunk header"] \
11637 [list $ctext tag conf hunksep -foreground]]
11638 grid x $page.hunksepbut $page.hunksep -sticky w
11639 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11640 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11641 -command [list choosecolor markbgcolor {} $page.markbgsep \
11642 [mc "marked line background"] \
11643 [list $ctext tag conf omark -background]]
11644 grid x $page.markbgbut $page.markbgsep -sticky w
11645 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11646 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11647 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11648 grid x $page.selbgbut $page.selbgsep -sticky w
11652 proc prefspage_fonts {notebook} {
11654 set page [create_prefs_page $notebook.fonts]
11655 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11656 grid $page.cfont - -sticky w -pady 10
11657 mkfontdisp mainfont $page [mc "Main font"]
11658 mkfontdisp textfont $page [mc "Diff display font"]
11659 mkfontdisp uifont $page [mc "User interface font"]
11664 global maxwidth maxgraphpct use_ttk NS
11665 global oldprefs prefstop showneartags showlocalchanges
11666 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11667 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11668 global hideremotes want_ttk have_ttk
11672 if {[winfo exists $top]} {
11676 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11677 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11678 set oldprefs($v) [set $v]
11681 wm title $top [mc "Gitk preferences"]
11682 make_transient $top .
11684 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11685 set notebook [ttk::notebook $top.notebook]
11687 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11690 lappend pages [prefspage_general $notebook] [mc "General"]
11691 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11692 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11694 foreach {page title} $pages {
11695 if {$use_notebook} {
11696 $notebook add $page -text $title
11698 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11699 -text $title -command [list raise $page]]
11700 $page configure -text $title
11701 grid $btn -row 0 -column [incr col] -sticky w
11702 grid $page -row 1 -column 0 -sticky news -columnspan 100
11706 if {!$use_notebook} {
11707 grid columnconfigure $notebook 0 -weight 1
11708 grid rowconfigure $notebook 1 -weight 1
11709 raise [lindex $pages 0]
11712 grid $notebook -sticky news -padx 2 -pady 2
11713 grid rowconfigure $top 0 -weight 1
11714 grid columnconfigure $top 0 -weight 1
11716 ${NS}::frame $top.buts
11717 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11718 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11719 bind $top <Key-Return> prefsok
11720 bind $top <Key-Escape> prefscan
11721 grid $top.buts.ok $top.buts.can
11722 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11723 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11724 grid $top.buts - - -pady 10 -sticky ew
11725 grid columnconfigure $top 2 -weight 1
11726 bind $top <Visibility> [list focus $top.buts.ok]
11729 proc choose_extdiff {} {
11732 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11734 set extdifftool $prog
11738 proc choosecolor {v vi w x cmd} {
11741 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11742 -title [mc "Gitk: choose color for %s" $x]]
11743 if {$c eq {}} return
11744 $w conf -background $c
11749 proc setselbg {c} {
11750 global bglist cflist
11751 foreach w $bglist {
11752 if {[winfo exists $w]} {
11753 $w configure -selectbackground $c
11756 $cflist tag configure highlight \
11757 -background [$cflist cget -selectbackground]
11758 allcanvs itemconf secsel -fill $c
11761 # This sets the background color and the color scheme for the whole UI.
11762 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11763 # if we don't specify one ourselves, which makes the checkbuttons and
11764 # radiobuttons look bad. This chooses white for selectColor if the
11765 # background color is light, or black if it is dark.
11767 if {[tk windowingsystem] eq "win32"} { return }
11768 set bg [winfo rgb . $c]
11770 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11773 tk_setPalette background $c selectColor $selc
11779 foreach w $bglist {
11780 if {[winfo exists $w]} {
11781 $w conf -background $c
11789 foreach w $fglist {
11790 if {[winfo exists $w]} {
11791 $w conf -foreground $c
11794 allcanvs itemconf text -fill $c
11795 $canv itemconf circle -outline $c
11796 $canv itemconf markid -outline $c
11800 global oldprefs prefstop
11802 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11803 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11805 set $v $oldprefs($v)
11807 catch {destroy $prefstop}
11813 global maxwidth maxgraphpct
11814 global oldprefs prefstop showneartags showlocalchanges
11815 global fontpref mainfont textfont uifont
11816 global limitdiffs treediffs perfile_attrs
11819 catch {destroy $prefstop}
11823 if {$mainfont ne $fontpref(mainfont)} {
11824 set mainfont $fontpref(mainfont)
11825 parsefont mainfont $mainfont
11826 eval font configure mainfont [fontflags mainfont]
11827 eval font configure mainfontbold [fontflags mainfont 1]
11831 if {$textfont ne $fontpref(textfont)} {
11832 set textfont $fontpref(textfont)
11833 parsefont textfont $textfont
11834 eval font configure textfont [fontflags textfont]
11835 eval font configure textfontbold [fontflags textfont 1]
11837 if {$uifont ne $fontpref(uifont)} {
11838 set uifont $fontpref(uifont)
11839 parsefont uifont $uifont
11840 eval font configure uifont [fontflags uifont]
11843 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11844 if {$showlocalchanges} {
11850 if {$limitdiffs != $oldprefs(limitdiffs) ||
11851 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11852 # treediffs elements are limited by path;
11853 # won't have encodings cached if perfile_attrs was just turned on
11854 unset -nocomplain treediffs
11856 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11857 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11859 } elseif {$showneartags != $oldprefs(showneartags) ||
11860 $limitdiffs != $oldprefs(limitdiffs)} {
11863 if {$hideremotes != $oldprefs(hideremotes)} {
11868 proc formatdate {d} {
11869 global datetimeformat
11871 # If $datetimeformat includes a timezone, display in the
11872 # timezone of the argument. Otherwise, display in local time.
11873 if {[string match {*%[zZ]*} $datetimeformat]} {
11874 if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11875 # Tcl < 8.5 does not support -timezone. Emulate it by
11876 # setting TZ (e.g. TZ=<-0430>+04:30).
11878 if {[info exists env(TZ)]} {
11879 set savedTZ $env(TZ)
11881 set zone [lindex $d 1]
11882 set sign [string map {+ - - +} [string index $zone 0]]
11883 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11884 set d [clock format [lindex $d 0] -format $datetimeformat]
11885 if {[info exists savedTZ]} {
11886 set env(TZ) $savedTZ
11892 set d [clock format [lindex $d 0] -format $datetimeformat]
11898 # This list of encoding names and aliases is distilled from
11899 # http://www.iana.org/assignments/character-sets.
11900 # Not all of them are supported by Tcl.
11901 set encoding_aliases {
11902 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11903 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11904 { ISO-10646-UTF-1 csISO10646UTF1 }
11905 { ISO_646.basic:1983 ref csISO646basic1983 }
11906 { INVARIANT csINVARIANT }
11907 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11908 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11909 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11910 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11911 { NATS-DANO iso-ir-9-1 csNATSDANO }
11912 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11913 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11914 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11915 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11916 { ISO-2022-KR csISO2022KR }
11918 { ISO-2022-JP csISO2022JP }
11919 { ISO-2022-JP-2 csISO2022JP2 }
11920 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11921 csISO13JISC6220jp }
11922 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11923 { IT iso-ir-15 ISO646-IT csISO15Italian }
11924 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11925 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11926 { greek7-old iso-ir-18 csISO18Greek7Old }
11927 { latin-greek iso-ir-19 csISO19LatinGreek }
11928 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11929 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11930 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11931 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11932 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11933 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11934 { INIS iso-ir-49 csISO49INIS }
11935 { INIS-8 iso-ir-50 csISO50INIS8 }
11936 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11937 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11938 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11939 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11940 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11941 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11942 csISO60Norwegian1 }
11943 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11944 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11945 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11946 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11947 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11948 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11949 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11950 { greek7 iso-ir-88 csISO88Greek7 }
11951 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11952 { iso-ir-90 csISO90 }
11953 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11954 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11955 csISO92JISC62991984b }
11956 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11957 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11958 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11959 csISO95JIS62291984handadd }
11960 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11961 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11962 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11963 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11964 CP819 csISOLatin1 }
11965 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11966 { T.61-7bit iso-ir-102 csISO102T617bit }
11967 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11968 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11969 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11970 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11971 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11972 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11973 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11974 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11975 arabic csISOLatinArabic }
11976 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11977 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11978 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11979 greek greek8 csISOLatinGreek }
11980 { T.101-G2 iso-ir-128 csISO128T101G2 }
11981 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11983 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11984 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11985 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11986 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11987 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11988 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11989 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11990 csISOLatinCyrillic }
11991 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11992 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11993 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11994 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11995 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11996 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11997 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11998 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11999 { ISO_10367-box iso-ir-155 csISO10367Box }
12000 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
12001 { latin-lap lap iso-ir-158 csISO158Lap }
12002 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
12003 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
12006 { JIS_X0201 X0201 csHalfWidthKatakana }
12007 { KSC5636 ISO646-KR csKSC5636 }
12008 { ISO-10646-UCS-2 csUnicode }
12009 { ISO-10646-UCS-4 csUCS4 }
12010 { DEC-MCS dec csDECMCS }
12011 { hp-roman8 roman8 r8 csHPRoman8 }
12012 { macintosh mac csMacintosh }
12013 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12015 { IBM038 EBCDIC-INT cp038 csIBM038 }
12016 { IBM273 CP273 csIBM273 }
12017 { IBM274 EBCDIC-BE CP274 csIBM274 }
12018 { IBM275 EBCDIC-BR cp275 csIBM275 }
12019 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12020 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12021 { IBM280 CP280 ebcdic-cp-it csIBM280 }
12022 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12023 { IBM284 CP284 ebcdic-cp-es csIBM284 }
12024 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12025 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12026 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12027 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12028 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12029 { IBM424 cp424 ebcdic-cp-he csIBM424 }
12030 { IBM437 cp437 437 csPC8CodePage437 }
12031 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12032 { IBM775 cp775 csPC775Baltic }
12033 { IBM850 cp850 850 csPC850Multilingual }
12034 { IBM851 cp851 851 csIBM851 }
12035 { IBM852 cp852 852 csPCp852 }
12036 { IBM855 cp855 855 csIBM855 }
12037 { IBM857 cp857 857 csIBM857 }
12038 { IBM860 cp860 860 csIBM860 }
12039 { IBM861 cp861 861 cp-is csIBM861 }
12040 { IBM862 cp862 862 csPC862LatinHebrew }
12041 { IBM863 cp863 863 csIBM863 }
12042 { IBM864 cp864 csIBM864 }
12043 { IBM865 cp865 865 csIBM865 }
12044 { IBM866 cp866 866 csIBM866 }
12045 { IBM868 CP868 cp-ar csIBM868 }
12046 { IBM869 cp869 869 cp-gr csIBM869 }
12047 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12048 { IBM871 CP871 ebcdic-cp-is csIBM871 }
12049 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12050 { IBM891 cp891 csIBM891 }
12051 { IBM903 cp903 csIBM903 }
12052 { IBM904 cp904 904 csIBBM904 }
12053 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12054 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12055 { IBM1026 CP1026 csIBM1026 }
12056 { EBCDIC-AT-DE csIBMEBCDICATDE }
12057 { EBCDIC-AT-DE-A csEBCDICATDEA }
12058 { EBCDIC-CA-FR csEBCDICCAFR }
12059 { EBCDIC-DK-NO csEBCDICDKNO }
12060 { EBCDIC-DK-NO-A csEBCDICDKNOA }
12061 { EBCDIC-FI-SE csEBCDICFISE }
12062 { EBCDIC-FI-SE-A csEBCDICFISEA }
12063 { EBCDIC-FR csEBCDICFR }
12064 { EBCDIC-IT csEBCDICIT }
12065 { EBCDIC-PT csEBCDICPT }
12066 { EBCDIC-ES csEBCDICES }
12067 { EBCDIC-ES-A csEBCDICESA }
12068 { EBCDIC-ES-S csEBCDICESS }
12069 { EBCDIC-UK csEBCDICUK }
12070 { EBCDIC-US csEBCDICUS }
12071 { UNKNOWN-8BIT csUnknown8BiT }
12072 { MNEMONIC csMnemonic }
12074 { VISCII csVISCII }
12077 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12078 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12079 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12080 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12081 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12082 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12083 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12084 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12085 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12086 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12087 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12088 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12089 { IBM1047 IBM-1047 }
12090 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12091 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12092 { UNICODE-1-1 csUnicode11 }
12093 { CESU-8 csCESU-8 }
12094 { BOCU-1 csBOCU-1 }
12095 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12096 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12098 { ISO-8859-15 ISO_8859-15 Latin-9 }
12099 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12100 { GBK CP936 MS936 windows-936 }
12101 { JIS_Encoding csJISEncoding }
12102 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12103 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12105 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12106 { ISO-10646-UCS-Basic csUnicodeASCII }
12107 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12108 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12109 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12110 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12111 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12112 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12113 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12114 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12115 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12116 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12117 { Adobe-Standard-Encoding csAdobeStandardEncoding }
12118 { Ventura-US csVenturaUS }
12119 { Ventura-International csVenturaInternational }
12120 { PC8-Danish-Norwegian csPC8DanishNorwegian }
12121 { PC8-Turkish csPC8Turkish }
12122 { IBM-Symbols csIBMSymbols }
12123 { IBM-Thai csIBMThai }
12124 { HP-Legal csHPLegal }
12125 { HP-Pi-font csHPPiFont }
12126 { HP-Math8 csHPMath8 }
12127 { Adobe-Symbol-Encoding csHPPSMath }
12128 { HP-DeskTop csHPDesktop }
12129 { Ventura-Math csVenturaMath }
12130 { Microsoft-Publishing csMicrosoftPublishing }
12131 { Windows-31J csWindows31J }
12132 { GB2312 csGB2312 }
12136 proc tcl_encoding {enc} {
12137 global encoding_aliases tcl_encoding_cache
12138 if {[info exists tcl_encoding_cache($enc)]} {
12139 return $tcl_encoding_cache($enc)
12141 set names [encoding names]
12142 set lcnames [string tolower $names]
12143 set enc [string tolower $enc]
12144 set i [lsearch -exact $lcnames $enc]
12146 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12147 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12148 set i [lsearch -exact $lcnames $encx]
12152 foreach l $encoding_aliases {
12153 set ll [string tolower $l]
12154 if {[lsearch -exact $ll $enc] < 0} continue
12155 # look through the aliases for one that tcl knows about
12157 set i [lsearch -exact $lcnames $e]
12159 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12160 set i [lsearch -exact $lcnames $ex]
12170 set tclenc [lindex $names $i]
12172 set tcl_encoding_cache($enc) $tclenc
12176 proc gitattr {path attr default} {
12177 global path_attr_cache
12178 if {[info exists path_attr_cache($attr,$path)]} {
12179 set r $path_attr_cache($attr,$path)
12181 set r "unspecified"
12182 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12183 regexp "(.*): $attr: (.*)" $line m f r
12185 set path_attr_cache($attr,$path) $r
12187 if {$r eq "unspecified"} {
12193 proc cache_gitattr {attr pathlist} {
12194 global path_attr_cache
12196 foreach path $pathlist {
12197 if {![info exists path_attr_cache($attr,$path)]} {
12198 lappend newlist $path
12202 if {[tk windowingsystem] == "win32"} {
12203 # windows has a 32k limit on the arguments to a command...
12206 while {$newlist ne {}} {
12207 set head [lrange $newlist 0 [expr {$lim - 1}]]
12208 set newlist [lrange $newlist $lim end]
12209 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12210 foreach row [split $rlist "\n"] {
12211 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12212 if {[string index $path 0] eq "\""} {
12213 set path [encoding convertfrom [lindex $path 0]]
12215 set path_attr_cache($attr,$path) $value
12222 proc get_path_encoding {path} {
12223 global gui_encoding perfile_attrs
12224 set tcl_enc $gui_encoding
12225 if {$path ne {} && $perfile_attrs} {
12226 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12234 ## For msgcat loading, first locate the installation location.
12235 if { [info exists ::env(GITK_MSGSDIR)] } {
12236 ## Msgsdir was manually set in the environment.
12237 set gitk_msgsdir $::env(GITK_MSGSDIR)
12239 ## Let's guess the prefix from argv0.
12240 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12241 set gitk_libdir [file join $gitk_prefix share gitk lib]
12242 set gitk_msgsdir [file join $gitk_libdir msgs]
12246 ## Internationalization (i18n) through msgcat and gettext. See
12247 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12248 package require msgcat
12249 namespace import ::msgcat::mc
12250 ## And eventually load the actual message catalog
12251 ::msgcat::mcload $gitk_msgsdir
12253 # First check that Tcl/Tk is recent enough
12254 if {[catch {package require Tk 8.4} err]} {
12255 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12256 Gitk requires at least Tcl/Tk 8.4."]
12260 # on OSX bring the current Wish process window to front
12261 if {[tk windowingsystem] eq "aqua"} {
12262 exec osascript -e [format {
12263 tell application "System Events"
12264 set frontmost of processes whose unix id is %d to true
12269 # Unset GIT_TRACE var if set
12270 if { [info exists ::env(GIT_TRACE)] } {
12271 unset ::env(GIT_TRACE)
12275 set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12279 set gitencoding [exec git config --get i18n.commitencoding]
12282 set gitencoding [exec git config --get i18n.logoutputencoding]
12284 if {$gitencoding == ""} {
12285 set gitencoding "utf-8"
12287 set tclencoding [tcl_encoding $gitencoding]
12288 if {$tclencoding == {}} {
12289 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12292 set gui_encoding [encoding system]
12294 set enc [exec git config --get gui.encoding]
12296 set tclenc [tcl_encoding $enc]
12297 if {$tclenc ne {}} {
12298 set gui_encoding $tclenc
12300 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12305 set log_showroot true
12307 set log_showroot [exec git config --bool --get log.showroot]
12310 if {[tk windowingsystem] eq "aqua"} {
12311 set mainfont {{Lucida Grande} 9}
12312 set textfont {Monaco 9}
12313 set uifont {{Lucida Grande} 9 bold}
12314 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12316 set mainfont {sans 9}
12317 set textfont {monospace 9}
12318 set uifont {sans 9 bold}
12320 set mainfont {Helvetica 9}
12321 set textfont {Courier 9}
12322 set uifont {Helvetica 9 bold}
12325 set findmergefiles 0
12333 set cmitmode "patch"
12334 set wrapcomment "none"
12338 set visiblerefs {"master"}
12340 set showlocalchanges 1
12342 set datetimeformat "%Y-%m-%d %H:%M:%S"
12345 set perfile_attrs 0
12348 if {[tk windowingsystem] eq "aqua"} {
12349 set extdifftool "opendiff"
12351 set extdifftool "meld"
12354 set colors {"#00ff00" red blue magenta darkgrey brown orange}
12355 if {[tk windowingsystem] eq "win32"} {
12356 set uicolor SystemButtonFace
12357 set uifgcolor SystemButtonText
12358 set uifgdisabledcolor SystemDisabledText
12359 set bgcolor SystemWindow
12360 set fgcolor SystemWindowText
12361 set selectbgcolor SystemHighlight
12362 set web_browser "cmd /c start"
12365 set uifgcolor black
12366 set uifgdisabledcolor "#999"
12369 set selectbgcolor gray85
12370 if {[tk windowingsystem] eq "aqua"} {
12371 set web_browser "open"
12373 set web_browser "xdg-open"
12376 set diffcolors {red "#00a000" blue}
12378 set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12381 set markbgcolor "#e0e0ff"
12383 set headbgcolor "#00ff00"
12384 set headfgcolor black
12385 set headoutlinecolor black
12386 set remotebgcolor #ffddaa
12387 set tagbgcolor yellow
12388 set tagfgcolor black
12389 set tagoutlinecolor black
12390 set reflinecolor black
12391 set filesepbgcolor #aaaaaa
12392 set filesepfgcolor black
12393 set linehoverbgcolor #ffff80
12394 set linehoverfgcolor black
12395 set linehoveroutlinecolor black
12396 set mainheadcirclecolor yellow
12397 set workingfilescirclecolor red
12398 set indexcirclecolor "#00ff00"
12399 set circlecolors {white blue gray blue blue}
12400 set linkfgcolor blue
12401 set circleoutlinecolor $fgcolor
12402 set foundbgcolor yellow
12403 set currentsearchhitbgcolor orange
12405 # button for popping up context menus
12406 if {[tk windowingsystem] eq "aqua"} {
12407 set ctxbut <Button-2>
12409 set ctxbut <Button-3>
12413 # follow the XDG base directory specification by default. See
12414 # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12415 if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12416 # XDG_CONFIG_HOME environment variable is set
12417 set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12418 set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12420 # default XDG_CONFIG_HOME
12421 set config_file "~/.config/git/gitk"
12422 set config_file_tmp "~/.config/git/gitk-tmp"
12424 if {![file exists $config_file]} {
12425 # for backward compatibility use the old config file if it exists
12426 if {[file exists "~/.gitk"]} {
12427 set config_file "~/.gitk"
12428 set config_file_tmp "~/.gitk-tmp"
12429 } elseif {![file exists [file dirname $config_file]]} {
12430 file mkdir [file dirname $config_file]
12433 source $config_file
12435 config_check_tmp_exists 50
12437 set config_variables {
12438 mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12439 cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12440 hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12441 bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12442 markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12443 extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12444 remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12445 filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12446 linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12447 indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12450 foreach var $config_variables {
12451 config_init_trace $var
12452 trace add variable $var write config_variable_change_cb
12455 parsefont mainfont $mainfont
12456 eval font create mainfont [fontflags mainfont]
12457 eval font create mainfontbold [fontflags mainfont 1]
12459 parsefont textfont $textfont
12460 eval font create textfont [fontflags textfont]
12461 eval font create textfontbold [fontflags textfont 1]
12463 parsefont uifont $uifont
12464 eval font create uifont [fontflags uifont]
12470 # check that we can find a .git directory somewhere...
12471 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12472 show_error {} . [mc "Cannot find a git repository here."]
12477 set selectheadid {}
12480 set cmdline_files {}
12482 set revtreeargscmd {}
12483 foreach arg $argv {
12484 switch -glob -- $arg {
12487 set cmdline_files [lrange $argv [expr {$i + 1}] end]
12490 "--select-commit=*" {
12491 set selecthead [string range $arg 16 end]
12494 set revtreeargscmd [string range $arg 10 end]
12497 lappend revtreeargs $arg
12503 if {$selecthead eq "HEAD"} {
12507 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12508 # no -- on command line, but some arguments (other than --argscmd)
12510 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12511 set cmdline_files [split $f "\n"]
12512 set n [llength $cmdline_files]
12513 set revtreeargs [lrange $revtreeargs 0 end-$n]
12514 # Unfortunately git rev-parse doesn't produce an error when
12515 # something is both a revision and a filename. To be consistent
12516 # with git log and git rev-list, check revtreeargs for filenames.
12517 foreach arg $revtreeargs {
12518 if {[file exists $arg]} {
12519 show_error {} . [mc "Ambiguous argument '%s': both revision\
12520 and filename" $arg]
12525 # unfortunately we get both stdout and stderr in $err,
12526 # so look for "fatal:".
12527 set i [string first "fatal:" $err]
12529 set err [string range $err [expr {$i + 6}] end]
12531 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12536 set nullid "0000000000000000000000000000000000000000"
12537 set nullid2 "0000000000000000000000000000000000000001"
12538 set nullfile "/dev/null"
12540 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12541 if {![info exists have_ttk]} {
12542 set have_ttk [llength [info commands ::ttk::style]]
12544 set use_ttk [expr {$have_ttk && $want_ttk}]
12545 set NS [expr {$use_ttk ? "ttk" : ""}]
12551 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12554 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12555 set show_notes "--show-notes"
12565 set highlight_paths {}
12567 set searchdirn -forwards
12570 set diffelide {0 0}
12571 set markingmatches 0
12572 set linkentercount 0
12573 set need_redisplay 0
12580 set selectedhlview [mc "None"]
12581 set highlight_related [mc "None"]
12582 set highlight_files {}
12583 set viewfiles(0) {}
12585 set viewchanged(0) 0
12587 set viewargscmd(0) {}
12589 set selectedline {}
12597 set hasworktree [hasworktree]
12599 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12600 set cdup [exec git rev-parse --show-cdup]
12602 set worktree [exec git rev-parse --show-toplevel]
12606 image create photo gitlogo -width 16 -height 16
12608 image create photo gitlogominus -width 4 -height 2
12609 gitlogominus put #C00000 -to 0 0 4 2
12610 gitlogo copy gitlogominus -to 1 5
12611 gitlogo copy gitlogominus -to 6 5
12612 gitlogo copy gitlogominus -to 11 5
12613 image delete gitlogominus
12615 image create photo gitlogoplus -width 4 -height 4
12616 gitlogoplus put #008000 -to 1 0 3 4
12617 gitlogoplus put #008000 -to 0 1 4 3
12618 gitlogo copy gitlogoplus -to 1 9
12619 gitlogo copy gitlogoplus -to 6 9
12620 gitlogo copy gitlogoplus -to 11 9
12621 image delete gitlogoplus
12623 image create photo gitlogo32 -width 32 -height 32
12624 gitlogo32 copy gitlogo -zoom 2 2
12626 wm iconphoto . -default gitlogo gitlogo32
12628 # wait for the window to become visible
12629 tkwait visibility .
12634 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12635 # create a view for the files/dirs specified on the command line
12639 set viewname(1) [mc "Command line"]
12640 set viewfiles(1) $cmdline_files
12641 set viewargs(1) $revtreeargs
12642 set viewargscmd(1) $revtreeargscmd
12644 set viewchanged(1) 0
12647 .bar.view entryconf [mca "&Edit view..."] -state normal
12648 .bar.view entryconf [mca "&Delete view"] -state normal
12651 if {[info exists permviews]} {
12652 foreach v $permviews {
12655 set viewname($n) [lindex $v 0]
12656 set viewfiles($n) [lindex $v 1]
12657 set viewargs($n) [lindex $v 2]
12658 set viewargscmd($n) [lindex $v 3]
12660 set viewchanged($n) 0
12665 if {[tk windowingsystem] eq "win32"} {
12673 # indent-tabs-mode: t