2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright © 2005-2011 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
13 return [expr {[exec git rev-parse
--is-bare-repository] == "false" &&
14 [exec git rev-parse
--is-inside-git-dir] == "false"}]
19 set n
[file normalize
$gitdir]
20 if {[string match
"*/.git" $n]} {
21 set n
[string range
$n 0 end-5
]
28 if {[info exists _gitworktree
]} {
31 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
32 if {[catch
{set _gitworktree
[exec git rev-parse
--show-toplevel]}]} {
33 # try to set work tree from environment, core.worktree or use
34 # cdup to obtain a relative path to the top of the worktree. If
35 # run from the top, the ./ prefix ensures normalize expands pwd.
36 if {[catch
{ set _gitworktree
$env(GIT_WORK_TREE
) }]} {
37 catch
{set _gitworktree
[exec git config
--get core.worktree
]}
38 if {$_gitworktree eq
""} {
39 set _gitworktree
[file normalize .
/[exec git rev-parse
--show-cdup]]
46 # A simple scheduler for compute-intensive stuff.
47 # The aim is to make sure that event handlers for GUI actions can
48 # run at least every 50-100 ms. Unfortunately fileevent handlers are
49 # run before X event handlers, so reading from a fast source can
50 # make the GUI completely unresponsive.
52 global isonrunq runq currunq
55 if {[info exists isonrunq
($script)]} return
56 if {$runq eq
{} && ![info exists currunq
]} {
59 lappend runq
[list
{} $script]
60 set isonrunq
($script) 1
63 proc filerun
{fd
script} {
64 fileevent
$fd readable
[list filereadable
$fd $script]
67 proc filereadable
{fd
script} {
70 fileevent
$fd readable
{}
71 if {$runq eq
{} && ![info exists currunq
]} {
74 lappend runq
[list
$fd $script]
80 for {set i
0} {$i < [llength
$runq]} {} {
81 if {[lindex
$runq $i 0] eq
$fd} {
82 set runq
[lreplace
$runq $i $i]
90 global isonrunq runq currunq
92 set tstart
[clock clicks
-milliseconds]
94 while {[llength
$runq] > 0} {
95 set fd
[lindex
$runq 0 0]
96 set script [lindex
$runq 0 1]
97 set currunq
[lindex
$runq 0]
98 set runq
[lrange
$runq 1 end
]
99 set repeat
[eval $script]
101 set t1
[clock clicks
-milliseconds]
102 set t
[expr {$t1 - $t0}]
103 if {$repeat ne
{} && $repeat} {
104 if {$fd eq
{} ||
$repeat == 2} {
105 # script returns 1 if it wants to be readded
106 # file readers return 2 if they could do more straight away
107 lappend runq
[list
$fd $script]
109 fileevent
$fd readable
[list filereadable
$fd $script]
111 } elseif
{$fd eq
{}} {
112 unset isonrunq
($script)
115 if {$t1 - $tstart >= 80} break
122 proc reg_instance
{fd
} {
123 global commfd leftover loginstance
125 set i
[incr loginstance
]
131 proc unmerged_files
{files
} {
134 # find the list of unmerged files
138 set fd
[open
"| git ls-files -u" r
]
140 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
143 while {[gets $fd line] >= 0} {
144 set i [string first "\t" $line]
146 set fname [string range $line [expr {$i+1}] end]
147 if {[lsearch -exact $mlist $fname] >= 0} continue
149 if {$files eq {} || [path_filter $files $fname]} {
157 proc parseviewargs {n arglist} {
158 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
159 global worddiff git_version
167 set origargs $arglist
171 foreach arg $arglist {
178 switch -glob -- $arg {
182 # remove from origargs in case we hit an unknown option
183 set origargs [lreplace $origargs $i $i]
187 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
188 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
189 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
190 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
191 "--ignore-space-change" - "-U*" - "--unified=*" {
192 # These request or affect diff output, which we don't want.
193 # Some could be used to set our defaults for diff display.
194 lappend diffargs
$arg
196 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
197 "--name-only" - "--name-status" - "--color" -
198 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
199 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
200 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
201 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
202 "--objects" - "--objects-edge" - "--reverse" {
203 # These cause our parsing of git log's output to fail, or else
204 # they're options we want to set ourselves, so ignore them.
206 "--color-words*" - "--word-diff=color" {
207 # These trigger a word diff in the console interface,
208 # so help the user by enabling our own support
209 if {[package vcompare
$git_version "1.7.2"] >= 0} {
210 set worddiff
[mc
"Color words"]
214 if {[package vcompare
$git_version "1.7.2"] >= 0} {
215 set worddiff
[mc
"Markup words"]
218 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
219 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
220 "--full-history" - "--dense" - "--sparse" -
221 "--follow" - "--left-right" - "--encoding=*" {
222 # These are harmless, and some are even useful
225 "--diff-filter=*" - "--no-merges" - "--unpacked" -
226 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
227 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
228 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
229 "--remove-empty" - "--first-parent" - "--cherry-pick" -
230 "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
231 "--simplify-by-decoration" {
232 # These mean that we get a subset of the commits
237 # This appears to be the only one that has a value as a
238 # separate word following it
248 # git rev-parse doesn't understand --merge
249 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
251 "--no-replace-objects" {
252 set env
(GIT_NO_REPLACE_OBJECTS
) "1"
255 # Other flag arguments including -<n>
256 if {[string is digit
-strict [string range
$arg 1 end
]]} {
259 # a flag argument that we don't recognize;
260 # that means we can't optimize
266 # Non-flag arguments specify commits or ranges of commits
267 if {[string match
"*...*" $arg]} {
268 lappend revargs
--gitk-symmetric-diff-marker
274 set vdflags
($n) $diffargs
275 set vflags
($n) $glflags
276 set vrevs
($n) $revargs
277 set vfiltered
($n) $filtered
278 set vorigargs
($n) $origargs
282 proc parseviewrevs
{view revs
} {
283 global vposids vnegids
288 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
289 # we get stdout followed by stderr in $err
290 # for an unknown rev, git rev-parse echoes it and then errors out
291 set errlines
[split $err "\n"]
293 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
294 set line
[lindex
$errlines $l]
295 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
296 if {[string match
"fatal:*" $line]} {
297 if {[string match
"fatal: ambiguous argument*" $line]
299 if {[llength
$badrev] == 1} {
300 set err
"unknown revision $badrev"
302 set err
"unknown revisions: [join $badrev ", "]"
305 set err
[join [lrange
$errlines $l end
] "\n"]
312 error_popup
"[mc "Error parsing revisions
:"] $err"
319 foreach id
[split $ids "\n"] {
320 if {$id eq
"--gitk-symmetric-diff-marker"} {
322 } elseif
{[string match
"^*" $id]} {
329 lappend neg
[string range
$id 1 end
]
334 lset ret end
$id...
[lindex
$ret end
]
340 set vposids
($view) $pos
341 set vnegids
($view) $neg
345 # Start off a git log process and arrange to read its output
346 proc start_rev_list
{view
} {
347 global startmsecs commitidx viewcomplete curview
349 global viewargs viewargscmd viewfiles vfilelimit
350 global showlocalchanges
351 global viewactive viewinstances vmergeonly
352 global mainheadid viewmainheadid viewmainheadid_orig
353 global vcanopt vflags vrevs vorigargs
356 set startmsecs
[clock clicks
-milliseconds]
357 set commitidx
($view) 0
358 # these are set this way for the error exits
359 set viewcomplete
($view) 1
360 set viewactive
($view) 0
363 set args
$viewargs($view)
364 if {$viewargscmd($view) ne
{}} {
366 set str
[exec sh
-c $viewargscmd($view)]
368 error_popup
"[mc "Error executing
--argscmd command:"] $err"
371 set args
[concat
$args [split $str "\n"]]
373 set vcanopt
($view) [parseviewargs
$view $args]
375 set files
$viewfiles($view)
376 if {$vmergeonly($view)} {
377 set files
[unmerged_files
$files]
380 if {$nr_unmerged == 0} {
381 error_popup
[mc
"No files selected: --merge specified but\
382 no files are unmerged."]
384 error_popup
[mc
"No files selected: --merge specified but\
385 no unmerged files are within file limit."]
390 set vfilelimit
($view) $files
392 if {$vcanopt($view)} {
393 set revs
[parseviewrevs
$view $vrevs($view)]
397 set args
[concat
$vflags($view) $revs]
399 set args
$vorigargs($view)
403 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
404 --parents --boundary $args "--" $files] r
]
406 error_popup
"[mc "Error executing git log
:"] $err"
409 set i
[reg_instance
$fd]
410 set viewinstances
($view) [list
$i]
411 set viewmainheadid
($view) $mainheadid
412 set viewmainheadid_orig
($view) $mainheadid
413 if {$files ne
{} && $mainheadid ne
{}} {
414 get_viewmainhead
$view
416 if {$showlocalchanges && $viewmainheadid($view) ne
{}} {
417 interestedin
$viewmainheadid($view) dodiffindex
419 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
420 if {$tclencoding != {}} {
421 fconfigure
$fd -encoding $tclencoding
423 filerun
$fd [list getcommitlines
$fd $i $view 0]
424 nowbusy
$view [mc
"Reading"]
425 set viewcomplete
($view) 0
426 set viewactive
($view) 1
430 proc stop_instance
{inst
} {
431 global commfd leftover
433 set fd
$commfd($inst)
437 if {$
::tcl_platform
(platform
) eq
{windows
}} {
446 unset leftover
($inst)
449 proc stop_backends
{} {
452 foreach inst
[array names commfd
] {
457 proc stop_rev_list
{view
} {
460 foreach inst
$viewinstances($view) {
463 set viewinstances
($view) {}
466 proc reset_pending_select
{selid
} {
467 global pending_select mainheadid selectheadid
470 set pending_select
$selid
471 } elseif
{$selectheadid ne
{}} {
472 set pending_select
$selectheadid
474 set pending_select
$mainheadid
478 proc getcommits
{selid
} {
479 global canv curview need_redisplay viewactive
482 if {[start_rev_list
$curview]} {
483 reset_pending_select
$selid
484 show_status
[mc
"Reading commits..."]
487 show_status
[mc
"No commits selected"]
491 proc updatecommits
{} {
492 global curview vcanopt vorigargs vfilelimit viewinstances
493 global viewactive viewcomplete tclencoding
494 global startmsecs showneartags showlocalchanges
495 global mainheadid viewmainheadid viewmainheadid_orig pending_select
497 global varcid vposids vnegids vflags vrevs
500 set hasworktree
[hasworktree
]
503 if {$mainheadid ne
$viewmainheadid_orig($view)} {
504 if {$showlocalchanges} {
507 set viewmainheadid
($view) $mainheadid
508 set viewmainheadid_orig
($view) $mainheadid
509 if {$vfilelimit($view) ne
{}} {
510 get_viewmainhead
$view
513 if {$showlocalchanges} {
516 if {$vcanopt($view)} {
517 set oldpos
$vposids($view)
518 set oldneg
$vnegids($view)
519 set revs
[parseviewrevs
$view $vrevs($view)]
523 # note: getting the delta when negative refs change is hard,
524 # and could require multiple git log invocations, so in that
525 # case we ask git log for all the commits (not just the delta)
526 if {$oldneg eq
$vnegids($view)} {
529 # take out positive refs that we asked for before or
530 # that we have already seen
532 if {[string length
$rev] == 40} {
533 if {[lsearch
-exact $oldpos $rev] < 0
534 && ![info exists varcid
($view,$rev)]} {
539 lappend
$newrevs $rev
542 if {$npos == 0} return
544 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
546 set args
[concat
$vflags($view) $revs --not $oldpos]
548 set args
$vorigargs($view)
551 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
552 --parents --boundary $args "--" $vfilelimit($view)] r
]
554 error_popup
"[mc "Error executing git log
:"] $err"
557 if {$viewactive($view) == 0} {
558 set startmsecs
[clock clicks
-milliseconds]
560 set i
[reg_instance
$fd]
561 lappend viewinstances
($view) $i
562 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
563 if {$tclencoding != {}} {
564 fconfigure
$fd -encoding $tclencoding
566 filerun
$fd [list getcommitlines
$fd $i $view 1]
567 incr viewactive
($view)
568 set viewcomplete
($view) 0
569 reset_pending_select
{}
570 nowbusy
$view [mc
"Reading"]
576 proc reloadcommits
{} {
577 global curview viewcomplete selectedline currentid thickerline
578 global showneartags treediffs commitinterest cached_commitrow
582 if {$selectedline ne
{}} {
586 if {!$viewcomplete($curview)} {
587 stop_rev_list
$curview
591 catch
{unset currentid
}
592 catch
{unset thickerline
}
593 catch
{unset treediffs
}
600 catch
{unset commitinterest
}
601 catch
{unset cached_commitrow
}
602 catch
{unset targetid
}
608 # This makes a string representation of a positive integer which
609 # sorts as a string in numerical order
612 return [format
"%x" $n]
613 } elseif
{$n < 256} {
614 return [format
"x%.2x" $n]
615 } elseif
{$n < 65536} {
616 return [format
"y%.4x" $n]
618 return [format
"z%.8x" $n]
621 # Procedures used in reordering commits from git log (without
622 # --topo-order) into the order for display.
624 proc varcinit
{view
} {
625 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
626 global vtokmod varcmod vrowmod varcix vlastins
628 set varcstart
($view) {{}}
629 set vupptr
($view) {0}
630 set vdownptr
($view) {0}
631 set vleftptr
($view) {0}
632 set vbackptr
($view) {0}
633 set varctok
($view) {{}}
634 set varcrow
($view) {{}}
635 set vtokmod
($view) {}
638 set varcix
($view) {{}}
639 set vlastins
($view) {0}
642 proc resetvarcs
{view
} {
643 global varcid varccommits parents children vseedcount ordertok
646 foreach vid
[array names varcid
$view,*] {
651 foreach vid
[array names vshortids
$view,*] {
652 unset vshortids
($vid)
654 # some commits might have children but haven't been seen yet
655 foreach vid
[array names children
$view,*] {
658 foreach va
[array names varccommits
$view,*] {
659 unset varccommits
($va)
661 foreach vd
[array names vseedcount
$view,*] {
662 unset vseedcount
($vd)
664 catch
{unset ordertok
}
667 # returns a list of the commits with no children
669 global vdownptr vleftptr varcstart
672 set a
[lindex
$vdownptr($v) 0]
674 lappend ret
[lindex
$varcstart($v) $a]
675 set a
[lindex
$vleftptr($v) $a]
680 proc newvarc
{view id
} {
681 global varcid varctok parents children vdatemode
682 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
683 global commitdata commitinfo vseedcount varccommits vlastins
685 set a
[llength
$varctok($view)]
687 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
688 if {![info exists commitinfo
($id)]} {
689 parsecommit
$id $commitdata($id) 1
691 set cdate
[lindex
[lindex
$commitinfo($id) 4] 0]
692 if {![string is integer
-strict $cdate]} {
695 if {![info exists vseedcount
($view,$cdate)]} {
696 set vseedcount
($view,$cdate) -1
698 set c
[incr vseedcount
($view,$cdate)]
699 set cdate
[expr {$cdate ^
0xffffffff}]
700 set tok
"s[strrep $cdate][strrep $c]"
705 if {[llength
$children($vid)] > 0} {
706 set kid
[lindex
$children($vid) end
]
707 set k
$varcid($view,$kid)
708 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
711 set tok
[lindex
$varctok($view) $k]
715 set i
[lsearch
-exact $parents($view,$ki) $id]
716 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
717 append tok
[strrep
$j]
719 set c
[lindex
$vlastins($view) $ka]
720 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
722 set b
[lindex
$vdownptr($view) $ka]
724 set b
[lindex
$vleftptr($view) $c]
726 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
728 set b
[lindex
$vleftptr($view) $c]
731 lset vdownptr
($view) $ka $a
732 lappend vbackptr
($view) 0
734 lset vleftptr
($view) $c $a
735 lappend vbackptr
($view) $c
737 lset vlastins
($view) $ka $a
738 lappend vupptr
($view) $ka
739 lappend vleftptr
($view) $b
741 lset vbackptr
($view) $b $a
743 lappend varctok
($view) $tok
744 lappend varcstart
($view) $id
745 lappend vdownptr
($view) 0
746 lappend varcrow
($view) {}
747 lappend varcix
($view) {}
748 set varccommits
($view,$a) {}
749 lappend vlastins
($view) 0
753 proc splitvarc
{p v
} {
754 global varcid varcstart varccommits varctok vtokmod
755 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
757 set oa
$varcid($v,$p)
758 set otok
[lindex
$varctok($v) $oa]
759 set ac
$varccommits($v,$oa)
760 set i
[lsearch
-exact $varccommits($v,$oa) $p]
762 set na
[llength
$varctok($v)]
763 # "%" sorts before "0"...
764 set tok
"$otok%[strrep $i]"
765 lappend varctok
($v) $tok
766 lappend varcrow
($v) {}
767 lappend varcix
($v) {}
768 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
769 set varccommits
($v,$na) [lrange
$ac $i end
]
770 lappend varcstart
($v) $p
771 foreach id
$varccommits($v,$na) {
772 set varcid
($v,$id) $na
774 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
775 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
776 lset vdownptr
($v) $oa $na
777 lset vlastins
($v) $oa 0
778 lappend vupptr
($v) $oa
779 lappend vleftptr
($v) 0
780 lappend vbackptr
($v) 0
781 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
782 lset vupptr
($v) $b $na
784 if {[string compare
$otok $vtokmod($v)] <= 0} {
789 proc renumbervarc
{a v
} {
790 global parents children varctok varcstart varccommits
791 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
793 set t1
[clock clicks
-milliseconds]
799 if {[info exists isrelated
($a)]} {
801 set id
[lindex
$varccommits($v,$a) end
]
802 foreach p
$parents($v,$id) {
803 if {[info exists varcid
($v,$p)]} {
804 set isrelated
($varcid($v,$p)) 1
809 set b
[lindex
$vdownptr($v) $a]
812 set b
[lindex
$vleftptr($v) $a]
814 set a
[lindex
$vupptr($v) $a]
820 if {![info exists kidchanged
($a)]} continue
821 set id
[lindex
$varcstart($v) $a]
822 if {[llength
$children($v,$id)] > 1} {
823 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
826 set oldtok
[lindex
$varctok($v) $a]
827 if {!$vdatemode($v)} {
833 set kid
[last_real_child
$v,$id]
835 set k
$varcid($v,$kid)
836 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
839 set tok
[lindex
$varctok($v) $k]
843 set i
[lsearch
-exact $parents($v,$ki) $id]
844 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
845 append tok
[strrep
$j]
847 if {$tok eq
$oldtok} {
850 set id
[lindex
$varccommits($v,$a) end
]
851 foreach p
$parents($v,$id) {
852 if {[info exists varcid
($v,$p)]} {
853 set kidchanged
($varcid($v,$p)) 1
858 lset varctok
($v) $a $tok
859 set b
[lindex
$vupptr($v) $a]
861 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
864 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
867 set c
[lindex
$vbackptr($v) $a]
868 set d
[lindex
$vleftptr($v) $a]
870 lset vdownptr
($v) $b $d
872 lset vleftptr
($v) $c $d
875 lset vbackptr
($v) $d $c
877 if {[lindex
$vlastins($v) $b] == $a} {
878 lset vlastins
($v) $b $c
880 lset vupptr
($v) $a $ka
881 set c
[lindex
$vlastins($v) $ka]
883 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
885 set b
[lindex
$vdownptr($v) $ka]
887 set b
[lindex
$vleftptr($v) $c]
890 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
892 set b
[lindex
$vleftptr($v) $c]
895 lset vdownptr
($v) $ka $a
896 lset vbackptr
($v) $a 0
898 lset vleftptr
($v) $c $a
899 lset vbackptr
($v) $a $c
901 lset vleftptr
($v) $a $b
903 lset vbackptr
($v) $b $a
905 lset vlastins
($v) $ka $a
908 foreach id
[array names sortkids
] {
909 if {[llength
$children($v,$id)] > 1} {
910 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
914 set t2
[clock clicks
-milliseconds]
915 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
918 # Fix up the graph after we have found out that in view $v,
919 # $p (a commit that we have already seen) is actually the parent
920 # of the last commit in arc $a.
921 proc fix_reversal
{p a v
} {
922 global varcid varcstart varctok vupptr
924 set pa
$varcid($v,$p)
925 if {$p ne
[lindex
$varcstart($v) $pa]} {
927 set pa
$varcid($v,$p)
929 # seeds always need to be renumbered
930 if {[lindex
$vupptr($v) $pa] == 0 ||
931 [string compare
[lindex
$varctok($v) $a] \
932 [lindex
$varctok($v) $pa]] > 0} {
937 proc insertrow
{id p v
} {
938 global cmitlisted children parents varcid varctok vtokmod
939 global varccommits ordertok commitidx numcommits curview
940 global targetid targetrow vshortids
944 set cmitlisted
($vid) 1
945 set children
($vid) {}
946 set parents
($vid) [list
$p]
947 set a
[newvarc
$v $id]
949 lappend vshortids
($v,[string range
$id 0 3]) $id
950 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
953 lappend varccommits
($v,$a) $id
955 if {[llength
[lappend children
($vp) $id]] > 1} {
956 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
957 catch
{unset ordertok
}
959 fix_reversal
$p $a $v
961 if {$v == $curview} {
962 set numcommits
$commitidx($v)
964 if {[info exists targetid
]} {
965 if {![comes_before
$targetid $p]} {
972 proc insertfakerow
{id p
} {
973 global varcid varccommits parents children cmitlisted
974 global commitidx varctok vtokmod targetid targetrow curview numcommits
978 set i
[lsearch
-exact $varccommits($v,$a) $p]
980 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
983 set children
($v,$id) {}
984 set parents
($v,$id) [list
$p]
985 set varcid
($v,$id) $a
986 lappend children
($v,$p) $id
987 set cmitlisted
($v,$id) 1
988 set numcommits
[incr commitidx
($v)]
989 # note we deliberately don't update varcstart($v) even if $i == 0
990 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
992 if {[info exists targetid
]} {
993 if {![comes_before
$targetid $p]} {
1001 proc removefakerow
{id
} {
1002 global varcid varccommits parents children commitidx
1003 global varctok vtokmod cmitlisted currentid selectedline
1004 global targetid curview numcommits
1007 if {[llength
$parents($v,$id)] != 1} {
1008 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1011 set p
[lindex
$parents($v,$id) 0]
1012 set a
$varcid($v,$id)
1013 set i
[lsearch
-exact $varccommits($v,$a) $id]
1015 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
1018 unset varcid
($v,$id)
1019 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
1020 unset parents
($v,$id)
1021 unset children
($v,$id)
1022 unset cmitlisted
($v,$id)
1023 set numcommits
[incr commitidx
($v) -1]
1024 set j
[lsearch
-exact $children($v,$p) $id]
1026 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
1029 if {[info exist currentid
] && $id eq
$currentid} {
1033 if {[info exists targetid
] && $targetid eq
$id} {
1040 proc real_children
{vp
} {
1041 global children nullid nullid2
1044 foreach id
$children($vp) {
1045 if {$id ne
$nullid && $id ne
$nullid2} {
1052 proc first_real_child
{vp
} {
1053 global children nullid nullid2
1055 foreach id
$children($vp) {
1056 if {$id ne
$nullid && $id ne
$nullid2} {
1063 proc last_real_child
{vp
} {
1064 global children nullid nullid2
1066 set kids
$children($vp)
1067 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
1068 set id
[lindex
$kids $i]
1069 if {$id ne
$nullid && $id ne
$nullid2} {
1076 proc vtokcmp
{v a b
} {
1077 global varctok varcid
1079 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1080 [lindex
$varctok($v) $varcid($v,$b)]]
1083 # This assumes that if lim is not given, the caller has checked that
1084 # arc a's token is less than $vtokmod($v)
1085 proc modify_arc
{v a
{lim
{}}} {
1086 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1089 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1092 set r
[lindex
$varcrow($v) $a]
1093 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1096 set vtokmod
($v) [lindex
$varctok($v) $a]
1098 if {$v == $curview} {
1099 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1100 set a
[lindex
$vupptr($v) $a]
1106 set lim
[llength
$varccommits($v,$a)]
1108 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1115 proc update_arcrows
{v
} {
1116 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1117 global varcid vrownum varcorder varcix varccommits
1118 global vupptr vdownptr vleftptr varctok
1119 global displayorder parentlist curview cached_commitrow
1121 if {$vrowmod($v) == $commitidx($v)} return
1122 if {$v == $curview} {
1123 if {[llength
$displayorder] > $vrowmod($v)} {
1124 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1125 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1127 catch
{unset cached_commitrow
}
1129 set narctot
[expr {[llength
$varctok($v)] - 1}]
1131 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1132 # go up the tree until we find something that has a row number,
1133 # or we get to a seed
1134 set a
[lindex
$vupptr($v) $a]
1137 set a
[lindex
$vdownptr($v) 0]
1140 set varcorder
($v) [list
$a]
1141 lset varcix
($v) $a 0
1142 lset varcrow
($v) $a 0
1146 set arcn
[lindex
$varcix($v) $a]
1147 if {[llength
$vrownum($v)] > $arcn + 1} {
1148 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1149 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1151 set row
[lindex
$varcrow($v) $a]
1155 incr row
[llength
$varccommits($v,$a)]
1156 # go down if possible
1157 set b
[lindex
$vdownptr($v) $a]
1159 # if not, go left, or go up until we can go left
1161 set b
[lindex
$vleftptr($v) $a]
1163 set a
[lindex
$vupptr($v) $a]
1169 lappend vrownum
($v) $row
1170 lappend varcorder
($v) $a
1171 lset varcix
($v) $a $arcn
1172 lset varcrow
($v) $a $row
1174 set vtokmod
($v) [lindex
$varctok($v) $p]
1176 set vrowmod
($v) $row
1177 if {[info exists currentid
]} {
1178 set selectedline
[rowofcommit
$currentid]
1182 # Test whether view $v contains commit $id
1183 proc commitinview
{id v
} {
1186 return [info exists varcid
($v,$id)]
1189 # Return the row number for commit $id in the current view
1190 proc rowofcommit
{id
} {
1191 global varcid varccommits varcrow curview cached_commitrow
1192 global varctok vtokmod
1195 if {![info exists varcid
($v,$id)]} {
1196 puts
"oops rowofcommit no arc for [shortids $id]"
1199 set a
$varcid($v,$id)
1200 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1203 if {[info exists cached_commitrow
($id)]} {
1204 return $cached_commitrow($id)
1206 set i
[lsearch
-exact $varccommits($v,$a) $id]
1208 puts
"oops didn't find commit [shortids $id] in arc $a"
1211 incr i
[lindex
$varcrow($v) $a]
1212 set cached_commitrow
($id) $i
1216 # Returns 1 if a is on an earlier row than b, otherwise 0
1217 proc comes_before
{a b
} {
1218 global varcid varctok curview
1221 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1222 ![info exists varcid
($v,$b)]} {
1225 if {$varcid($v,$a) != $varcid($v,$b)} {
1226 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1227 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1229 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1232 proc bsearch
{l elt
} {
1233 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1238 while {$hi - $lo > 1} {
1239 set mid
[expr {int
(($lo + $hi) / 2)}]
1240 set t
[lindex
$l $mid]
1243 } elseif
{$elt > $t} {
1252 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1253 proc make_disporder
{start end
} {
1254 global vrownum curview commitidx displayorder parentlist
1255 global varccommits varcorder parents vrowmod varcrow
1256 global d_valid_start d_valid_end
1258 if {$end > $vrowmod($curview)} {
1259 update_arcrows
$curview
1261 set ai
[bsearch
$vrownum($curview) $start]
1262 set start
[lindex
$vrownum($curview) $ai]
1263 set narc
[llength
$vrownum($curview)]
1264 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1265 set a
[lindex
$varcorder($curview) $ai]
1266 set l
[llength
$displayorder]
1267 set al
[llength
$varccommits($curview,$a)]
1268 if {$l < $r + $al} {
1270 set pad
[ntimes
[expr {$r - $l}] {}]
1271 set displayorder
[concat
$displayorder $pad]
1272 set parentlist
[concat
$parentlist $pad]
1273 } elseif
{$l > $r} {
1274 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1275 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1277 foreach id
$varccommits($curview,$a) {
1278 lappend displayorder
$id
1279 lappend parentlist
$parents($curview,$id)
1281 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1283 foreach id
$varccommits($curview,$a) {
1284 lset displayorder
$i $id
1285 lset parentlist
$i $parents($curview,$id)
1293 proc commitonrow
{row
} {
1296 set id
[lindex
$displayorder $row]
1298 make_disporder
$row [expr {$row + 1}]
1299 set id
[lindex
$displayorder $row]
1304 proc closevarcs
{v
} {
1305 global varctok varccommits varcid parents children
1306 global cmitlisted commitidx vtokmod
1308 set missing_parents
0
1310 set narcs
[llength
$varctok($v)]
1311 for {set a
1} {$a < $narcs} {incr a
} {
1312 set id
[lindex
$varccommits($v,$a) end
]
1313 foreach p
$parents($v,$id) {
1314 if {[info exists varcid
($v,$p)]} continue
1315 # add p as a new commit
1316 incr missing_parents
1317 set cmitlisted
($v,$p) 0
1318 set parents
($v,$p) {}
1319 if {[llength
$children($v,$p)] == 1 &&
1320 [llength
$parents($v,$id)] == 1} {
1323 set b
[newvarc
$v $p]
1325 set varcid
($v,$p) $b
1326 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1329 lappend varccommits
($v,$b) $p
1331 set scripts
[check_interest
$p $scripts]
1334 if {$missing_parents > 0} {
1335 foreach s
$scripts {
1341 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1342 # Assumes we already have an arc for $rwid.
1343 proc rewrite_commit
{v id rwid
} {
1344 global children parents varcid varctok vtokmod varccommits
1346 foreach ch
$children($v,$id) {
1347 # make $rwid be $ch's parent in place of $id
1348 set i
[lsearch
-exact $parents($v,$ch) $id]
1350 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1352 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1353 # add $ch to $rwid's children and sort the list if necessary
1354 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1355 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1356 $children($v,$rwid)]
1358 # fix the graph after joining $id to $rwid
1359 set a
$varcid($v,$ch)
1360 fix_reversal
$rwid $a $v
1361 # parentlist is wrong for the last element of arc $a
1362 # even if displayorder is right, hence the 3rd arg here
1363 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1367 # Mechanism for registering a command to be executed when we come
1368 # across a particular commit. To handle the case when only the
1369 # prefix of the commit is known, the commitinterest array is now
1370 # indexed by the first 4 characters of the ID. Each element is a
1371 # list of id, cmd pairs.
1372 proc interestedin
{id cmd
} {
1373 global commitinterest
1375 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1378 proc check_interest
{id scripts
} {
1379 global commitinterest
1381 set prefix
[string range
$id 0 3]
1382 if {[info exists commitinterest
($prefix)]} {
1384 foreach
{i
script} $commitinterest($prefix) {
1385 if {[string match
"$i*" $id]} {
1386 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1388 lappend newlist
$i $script
1391 if {$newlist ne
{}} {
1392 set commitinterest
($prefix) $newlist
1394 unset commitinterest
($prefix)
1400 proc getcommitlines
{fd inst view updating
} {
1401 global cmitlisted leftover
1402 global commitidx commitdata vdatemode
1403 global parents children curview hlview
1404 global idpending ordertok
1405 global varccommits varcid varctok vtokmod vfilelimit vshortids
1407 set stuff
[read $fd 500000]
1408 # git log doesn't terminate the last commit with a null...
1409 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1416 global commfd viewcomplete viewactive viewname
1417 global viewinstances
1419 set i
[lsearch
-exact $viewinstances($view) $inst]
1421 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1423 # set it blocking so we wait for the process to terminate
1424 fconfigure
$fd -blocking 1
1425 if {[catch
{close
$fd} err
]} {
1427 if {$view != $curview} {
1428 set fv
" for the \"$viewname($view)\" view"
1430 if {[string range
$err 0 4] == "usage"} {
1431 set err
"Gitk: error reading commits$fv:\
1432 bad arguments to git log."
1433 if {$viewname($view) eq
"Command line"} {
1435 " (Note: arguments to gitk are passed to git log\
1436 to allow selection of commits to be displayed.)"
1439 set err
"Error reading commits$fv: $err"
1443 if {[incr viewactive
($view) -1] <= 0} {
1444 set viewcomplete
($view) 1
1445 # Check if we have seen any ids listed as parents that haven't
1446 # appeared in the list
1450 if {$view == $curview} {
1459 set i
[string first
"\0" $stuff $start]
1461 append leftover
($inst) [string range
$stuff $start end
]
1465 set cmit
$leftover($inst)
1466 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1467 set leftover
($inst) {}
1469 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1471 set start
[expr {$i + 1}]
1472 set j
[string first
"\n" $cmit]
1475 if {$j >= 0 && [string match
"commit *" $cmit]} {
1476 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1477 if {[string match
{[-^
<>]*} $ids]} {
1478 switch
-- [string index
$ids 0] {
1484 set ids
[string range
$ids 1 end
]
1488 if {[string length
$id] != 40} {
1496 if {[string length
$shortcmit] > 80} {
1497 set shortcmit
"[string range $shortcmit 0 80]..."
1499 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1502 set id [lindex $ids 0]
1505 lappend vshortids($view,[string range $id 0 3]) $id
1507 if {!$listed && $updating && ![info exists varcid($vid)] &&
1508 $vfilelimit($view) ne {}} {
1509 # git log doesn't rewrite parents
for unlisted commits
1510 # when doing path limiting, so work around that here
1511 # by working out the rewritten parent with git rev-list
1512 # and if we already know about it, using the rewritten
1513 # parent as a substitute parent for $id's children.
1515 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1516 $id -- $vfilelimit($view)]
1518 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1519 # use $rwid in place of $id
1520 rewrite_commit
$view $id $rwid
1527 if {[info exists varcid
($vid)]} {
1528 if {$cmitlisted($vid) ||
!$listed} continue
1532 set olds
[lrange
$ids 1 end
]
1536 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1537 set cmitlisted
($vid) $listed
1538 set parents
($vid) $olds
1539 if {![info exists children
($vid)]} {
1540 set children
($vid) {}
1541 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1542 set k
[lindex
$children($vid) 0]
1543 if {[llength
$parents($view,$k)] == 1 &&
1544 (!$vdatemode($view) ||
1545 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1546 set a
$varcid($view,$k)
1551 set a
[newvarc
$view $id]
1553 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1556 if {![info exists varcid
($vid)]} {
1558 lappend varccommits
($view,$a) $id
1559 incr commitidx
($view)
1564 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1566 if {[llength
[lappend children
($vp) $id]] > 1 &&
1567 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1568 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1570 catch
{unset ordertok
}
1572 if {[info exists varcid
($view,$p)]} {
1573 fix_reversal
$p $a $view
1579 set scripts
[check_interest
$id $scripts]
1583 global numcommits hlview
1585 if {$view == $curview} {
1586 set numcommits
$commitidx($view)
1589 if {[info exists hlview
] && $view == $hlview} {
1590 # we never actually get here...
1593 foreach s
$scripts {
1600 proc chewcommits
{} {
1601 global curview hlview viewcomplete
1602 global pending_select
1605 if {$viewcomplete($curview)} {
1606 global commitidx varctok
1607 global numcommits startmsecs
1609 if {[info exists pending_select
]} {
1611 reset_pending_select
{}
1613 if {[commitinview
$pending_select $curview]} {
1614 selectline
[rowofcommit
$pending_select] 1
1616 set row
[first_real_row
]
1620 if {$commitidx($curview) > 0} {
1621 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1622 #puts "overall $ms ms for $numcommits commits"
1623 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1625 show_status
[mc
"No commits selected"]
1632 proc do_readcommit
{id
} {
1635 # Invoke git-log to handle automatic encoding conversion
1636 set fd
[open
[concat | git log
--no-color --pretty=raw
-1 $id] r
]
1637 # Read the results using i18n.logoutputencoding
1638 fconfigure
$fd -translation lf
-eofchar {}
1639 if {$tclencoding != {}} {
1640 fconfigure
$fd -encoding $tclencoding
1642 set contents
[read $fd]
1644 # Remove the heading line
1645 regsub
{^commit
[0-9a-f]+\n} $contents {} contents
1650 proc readcommit
{id
} {
1651 if {[catch
{set contents
[do_readcommit
$id]}]} return
1652 parsecommit
$id $contents 1
1655 proc parsecommit
{id contents listed
} {
1665 set hdrend
[string first
"\n\n" $contents]
1667 # should never happen...
1668 set hdrend
[string length
$contents]
1670 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1671 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1672 foreach line
[split $header "\n"] {
1673 set line
[split $line " "]
1674 set tag
[lindex
$line 0]
1675 if {$tag == "author"} {
1676 set audate
[lrange
$line end-1 end
]
1677 set auname
[join [lrange
$line 1 end-2
] " "]
1678 } elseif
{$tag == "committer"} {
1679 set comdate
[lrange
$line end-1 end
]
1680 set comname
[join [lrange
$line 1 end-2
] " "]
1684 # take the first non-blank line of the comment as the headline
1685 set headline
[string trimleft
$comment]
1686 set i
[string first
"\n" $headline]
1688 set headline
[string range
$headline 0 $i]
1690 set headline
[string trimright
$headline]
1691 set i
[string first
"\r" $headline]
1693 set headline
[string trimright
[string range
$headline 0 $i]]
1696 # git log indents the comment by 4 spaces;
1697 # if we got this via git cat-file, add the indentation
1699 foreach line
[split $comment "\n"] {
1700 append newcomment
" "
1701 append newcomment
$line
1702 append newcomment
"\n"
1704 set comment
$newcomment
1706 set hasnote
[string first
"\nNotes:\n" $contents]
1708 # If there is diff output shown in the git-log stream, split it
1709 # out. But get rid of the empty line that always precedes the
1711 set i
[string first
"\n\ndiff" $comment]
1713 set diff [string range
$comment $i+1 end
]
1714 set comment
[string range
$comment 0 $i-1]
1716 set commitinfo
($id) [list
$headline $auname $audate \
1717 $comname $comdate $comment $hasnote $diff]
1720 proc getcommit
{id
} {
1721 global commitdata commitinfo
1723 if {[info exists commitdata
($id)]} {
1724 parsecommit
$id $commitdata($id) 1
1727 if {![info exists commitinfo
($id)]} {
1728 set commitinfo
($id) [list
[mc
"No commit information available"]]
1734 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1735 # and are present in the current view.
1736 # This is fairly slow...
1737 proc longid
{prefix
} {
1738 global varcid curview vshortids
1741 if {[string length
$prefix] >= 4} {
1742 set vshortid
$curview,[string range
$prefix 0 3]
1743 if {[info exists vshortids
($vshortid)]} {
1744 foreach id
$vshortids($vshortid) {
1745 if {[string match
"$prefix*" $id]} {
1746 if {[lsearch
-exact $ids $id] < 0} {
1748 if {[llength
$ids] >= 2} break
1754 foreach match
[array names varcid
"$curview,$prefix*"] {
1755 lappend ids
[lindex
[split $match ","] 1]
1756 if {[llength
$ids] >= 2} break
1763 global tagids idtags headids idheads tagobjid
1764 global otherrefids idotherrefs mainhead mainheadid
1765 global selecthead selectheadid
1768 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1771 set refd
[open
[list | git show-ref
-d] r
]
1772 while {[gets
$refd line
] >= 0} {
1773 if {[string index
$line 40] ne
" "} continue
1774 set id
[string range
$line 0 39]
1775 set ref
[string range
$line 41 end
]
1776 if {![string match
"refs/*" $ref]} continue
1777 set name
[string range
$ref 5 end
]
1778 if {[string match
"remotes/*" $name]} {
1779 if {![string match
"*/HEAD" $name] && !$hideremotes} {
1780 set headids
($name) $id
1781 lappend idheads
($id) $name
1783 } elseif
{[string match
"heads/*" $name]} {
1784 set name
[string range
$name 6 end
]
1785 set headids
($name) $id
1786 lappend idheads
($id) $name
1787 } elseif
{[string match
"tags/*" $name]} {
1788 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1789 # which is what we want since the former is the commit ID
1790 set name
[string range
$name 5 end
]
1791 if {[string match
"*^{}" $name]} {
1792 set name
[string range
$name 0 end-3
]
1794 set tagobjid
($name) $id
1796 set tagids
($name) $id
1797 lappend idtags
($id) $name
1799 set otherrefids
($name) $id
1800 lappend idotherrefs
($id) $name
1807 set mainheadid
[exec git rev-parse HEAD
]
1808 set thehead
[exec git symbolic-ref HEAD
]
1809 if {[string match
"refs/heads/*" $thehead]} {
1810 set mainhead
[string range
$thehead 11 end
]
1814 if {$selecthead ne
{}} {
1816 set selectheadid
[exec git rev-parse
--verify $selecthead]
1821 # skip over fake commits
1822 proc first_real_row
{} {
1823 global nullid nullid2 numcommits
1825 for {set row
0} {$row < $numcommits} {incr row
} {
1826 set id
[commitonrow
$row]
1827 if {$id ne
$nullid && $id ne
$nullid2} {
1834 # update things for a head moved to a child of its previous location
1835 proc movehead
{id name
} {
1836 global headids idheads
1838 removehead
$headids($name) $name
1839 set headids
($name) $id
1840 lappend idheads
($id) $name
1843 # update things when a head has been removed
1844 proc removehead
{id name
} {
1845 global headids idheads
1847 if {$idheads($id) eq
$name} {
1850 set i
[lsearch
-exact $idheads($id) $name]
1852 set idheads
($id) [lreplace
$idheads($id) $i $i]
1855 unset headids
($name)
1858 proc ttk_toplevel
{w args
} {
1860 eval [linsert
$args 0 ::toplevel
$w]
1862 place
[ttk
::frame
$w._toplevel_background
] -x 0 -y 0 -relwidth 1 -relheight 1
1867 proc make_transient
{window origin
} {
1870 # In MacOS Tk 8.4 transient appears to work by setting
1871 # overrideredirect, which is utterly useless, since the
1872 # windows get no border, and are not even kept above
1874 if {!$have_tk85 && [tk windowingsystem
] eq
{aqua
}} return
1876 wm transient
$window $origin
1878 # Windows fails to place transient windows normally, so
1879 # schedule a callback to center them on the parent.
1880 if {[tk windowingsystem
] eq
{win32
}} {
1881 after idle
[list tk
::PlaceWindow
$window widget
$origin]
1885 proc show_error
{w top msg
{mc mc
}} {
1887 if {![info exists NS
]} {set NS
""}
1888 if {[wm state
$top] eq
"withdrawn"} { wm deiconify
$top }
1889 message
$w.m
-text $msg -justify center
-aspect 400
1890 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1891 ${NS}::button
$w.ok
-default active
-text [$mc OK
] -command "destroy $top"
1892 pack
$w.ok
-side bottom
-fill x
1893 bind $top <Visibility
> "grab $top; focus $top"
1894 bind $top <Key-Return
> "destroy $top"
1895 bind $top <Key-space
> "destroy $top"
1896 bind $top <Key-Escape
> "destroy $top"
1900 proc error_popup
{msg
{owner .
}} {
1901 if {[tk windowingsystem
] eq
"win32"} {
1902 tk_messageBox
-icon error
-type ok
-title [wm title .
] \
1903 -parent $owner -message $msg
1907 make_transient
$w $owner
1908 show_error
$w $w $msg
1912 proc confirm_popup
{msg
{owner .
}} {
1913 global confirm_ok NS
1917 make_transient
$w $owner
1918 message
$w.m
-text $msg -justify center
-aspect 400
1919 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1920 ${NS}::button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1921 pack
$w.ok
-side left
-fill x
1922 ${NS}::button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1923 pack
$w.cancel
-side right
-fill x
1924 bind $w <Visibility
> "grab $w; focus $w"
1925 bind $w <Key-Return
> "set confirm_ok 1; destroy $w"
1926 bind $w <Key-space
> "set confirm_ok 1; destroy $w"
1927 bind $w <Key-Escape
> "destroy $w"
1928 tk
::PlaceWindow
$w widget
$owner
1933 proc setoptions
{} {
1934 if {[tk windowingsystem
] ne
"win32"} {
1935 option add
*Panedwindow.showHandle
1 startupFile
1936 option add
*Panedwindow.sashRelief raised startupFile
1937 if {[tk windowingsystem
] ne
"aqua"} {
1938 option add
*Menu.font uifont startupFile
1941 option add
*Menu.TearOff
0 startupFile
1943 option add
*Button.font uifont startupFile
1944 option add
*Checkbutton.font uifont startupFile
1945 option add
*Radiobutton.font uifont startupFile
1946 option add
*Menubutton.font uifont startupFile
1947 option add
*Label.font uifont startupFile
1948 option add
*Message.font uifont startupFile
1949 option add
*Entry.font textfont startupFile
1950 option add
*Text.font textfont startupFile
1951 option add
*Labelframe.font uifont startupFile
1952 option add
*Spinbox.font textfont startupFile
1953 option add
*Listbox.font mainfont startupFile
1956 # Make a menu and submenus.
1957 # m is the window name for the menu, items is the list of menu items to add.
1958 # Each item is a list {mc label type description options...}
1959 # mc is ignored; it's so we can put mc there to alert xgettext
1960 # label is the string that appears in the menu
1961 # type is cascade, command or radiobutton (should add checkbutton)
1962 # description depends on type; it's the sublist for cascade, the
1963 # command to invoke for command, or {variable value} for radiobutton
1964 proc makemenu
{m items
} {
1966 if {[tk windowingsystem
] eq
{aqua
}} {
1972 set name
[mc
[lindex
$i 1]]
1973 set type [lindex
$i 2]
1974 set thing
[lindex
$i 3]
1975 set params
[list
$type]
1977 set u
[string first
"&" [string map
{&& x
} $name]]
1978 lappend params
-label [string map
{&& & & {}} $name]
1980 lappend params
-underline $u
1985 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1986 lappend params
-menu $m.
$submenu
1989 lappend params
-command $thing
1992 lappend params
-variable [lindex
$thing 0] \
1993 -value [lindex
$thing 1]
1996 set tail [lrange
$i 4 end
]
1997 regsub
-all {\yMeta1\y
} $tail $Meta1 tail
1998 eval $m add
$params $tail
1999 if {$type eq
"cascade"} {
2000 makemenu
$m.
$submenu $thing
2005 # translate string and remove ampersands
2007 return [string map
{&& & & {}} [mc
$str]]
2010 proc cleardropsel
{w
} {
2013 proc makedroplist
{w varname args
} {
2017 foreach label
$args {
2018 set cx
[string length
$label]
2019 if {$cx > $width} {set width
$cx}
2021 set gm
[ttk
::combobox
$w -width $width -state readonly\
2022 -textvariable $varname -values $args \
2023 -exportselection false
]
2024 bind $gm <<ComboboxSelected>> [list $gm selection clear]
2026 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2031 proc makewindow {} {
2032 global canv canv2 canv3 linespc charspc ctext cflist cscroll
2034 global findtype findtypemenu findloc findstring fstring geometry
2035 global entries sha1entry sha1string sha1but
2036 global diffcontextstring diffcontext
2038 global maincursor textcursor curtextcursor
2039 global rowctxmenu fakerowmenu mergemax wrapcomment
2040 global highlight_files gdttype
2041 global searchstring sstring
2042 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2043 global uifgcolor uifgdisabledcolor
2044 global filesepbgcolor filesepfgcolor
2045 global mergecolors foundbgcolor currentsearchhitbgcolor
2046 global headctxmenu progresscanv progressitem progresscoords statusw
2047 global fprogitem fprogcoord lastprogupdate progupdatepending
2048 global rprogitem rprogcoord rownumsel numcommits
2049 global have_tk85 use_ttk NS
2053 # The "mc" arguments here are purely so that xgettext
2054 # sees the following string as needing to be translated
2057 {mc "Update" command updatecommits -accelerator F5}
2058 {mc "Reload" command reloadcommits -accelerator Shift-F5}
2059 {mc "Reread references" command rereadrefs}
2060 {mc "List references" command showrefs -accelerator F2}
2062 {mc "Start git gui" command {exec git gui &}}
2064 {mc "Quit" command doquit -accelerator Meta1-Q}
2068 {mc "Preferences" command doprefs}
2072 {mc "New view..." command {newview 0} -accelerator Shift-F4}
2073 {mc "Edit view..." command editview -state disabled -accelerator F4}
2074 {mc "Delete view" command delview -state disabled}
2076 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2078 if {[tk windowingsystem] ne "aqua"} {
2081 {mc "About gitk" command about}
2082 {mc "Key bindings" command keys}
2084 set bar [list $file $edit $view $help]
2086 proc ::tk::mac::ShowPreferences {} {doprefs}
2087 proc ::tk::mac::Quit {} {doquit}
2088 lset file end [lreplace [lindex $file end] end-1 end]
2090 xx "Apple" cascade {
2091 {mc "About gitk" command about}
2096 {mc "Key bindings" command keys}
2098 set bar [list $apple $file $view $help]
2101 . configure -menu .bar
2104 # cover the non-themed toplevel with a themed frame.
2105 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2108 # the gui has upper and lower half, parts of a paned window.
2109 ${NS}::panedwindow .ctop -orient vertical
2111 # possibly use assumed geometry
2112 if {![info exists geometry(pwsash0)]} {
2113 set geometry(topheight) [expr {15 * $linespc}]
2114 set geometry(topwidth) [expr {80 * $charspc}]
2115 set geometry(botheight) [expr {15 * $linespc}]
2116 set geometry(botwidth) [expr {50 * $charspc}]
2117 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2118 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2121 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2122 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2123 ${NS}::frame .tf.histframe
2124 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2126 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2129 # create three canvases
2130 set cscroll .tf.histframe.csb
2131 set canv .tf.histframe.pwclist.canv
2133 -selectbackground $selectbgcolor \
2134 -background $bgcolor -bd 0 \
2135 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2136 .tf.histframe.pwclist add $canv
2137 set canv2 .tf.histframe.pwclist.canv2
2139 -selectbackground $selectbgcolor \
2140 -background $bgcolor -bd 0 -yscrollincr $linespc
2141 .tf.histframe.pwclist add $canv2
2142 set canv3 .tf.histframe.pwclist.canv3
2144 -selectbackground $selectbgcolor \
2145 -background $bgcolor -bd 0 -yscrollincr $linespc
2146 .tf.histframe.pwclist add $canv3
2148 bind .tf.histframe.pwclist <Map> {
2150 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2151 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2154 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2155 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2158 # a scroll bar to rule them
2159 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2160 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2161 pack $cscroll -side right -fill y
2162 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2163 lappend bglist $canv $canv2 $canv3
2164 pack .tf.histframe.pwclist -fill both -expand 1 -side left
2166 # we have two button bars at bottom of top frame. Bar 1
2167 ${NS}::frame .tf.bar
2168 ${NS}::frame .tf.lbar -height 15
2170 set sha1entry .tf.bar.sha1
2171 set entries $sha1entry
2172 set sha1but .tf.bar.sha1label
2173 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2174 -command gotocommit -width 8
2175 $sha1but conf -disabledforeground [$sha1but cget -foreground]
2176 pack .tf.bar.sha1label -side left
2177 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2178 trace add variable sha1string write sha1change
2179 pack $sha1entry -side left -pady 2
2182 #define left_width 16
2183 #define left_height 16
2184 static unsigned char left_bits[] = {
2185 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2186 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2187 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2190 #define right_width 16
2191 #define right_height 16
2192 static unsigned char right_bits[] = {
2193 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2194 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2195 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2197 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2198 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2199 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2200 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2202 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2204 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2206 .tf.bar.leftbut configure -image bm-left
2208 pack .tf.bar.leftbut -side left -fill y
2209 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2211 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2213 .tf.bar.rightbut configure -image bm-right
2215 pack .tf.bar.rightbut -side left -fill y
2217 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2219 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2220 -relief sunken -anchor e
2221 ${NS}::label .tf.bar.rowlabel2 -text "/"
2222 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2223 -relief sunken -anchor e
2224 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2227 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2230 trace add variable selectedline write selectedline_change
2232 # Status label and progress bar
2233 set statusw .tf.bar.status
2234 ${NS}::label $statusw -width 15 -relief sunken
2235 pack $statusw -side left -padx 5
2237 set progresscanv [ttk::progressbar .tf.bar.progress]
2239 set h [expr {[font metrics uifont -linespace] + 2}]
2240 set progresscanv .tf.bar.progress
2241 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2242 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2243 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2244 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2246 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2247 set progresscoords {0 0}
2250 bind $progresscanv <Configure> adjustprogress
2251 set lastprogupdate [clock clicks -milliseconds]
2252 set progupdatepending 0
2254 # build up the bottom bar of upper window
2255 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2256 ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2257 ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2258 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2259 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2261 set gdttype [mc "containing:"]
2262 set gm [makedroplist .tf.lbar.gdttype gdttype \
2263 [mc "containing:"] \
2264 [mc "touching paths:"] \
2265 [mc "adding/removing string:"] \
2266 [mc "changing lines matching:"]]
2267 trace add variable gdttype write gdttype_change
2268 pack .tf.lbar.gdttype -side left -fill y
2271 set fstring .tf.lbar.findstring
2272 lappend entries $fstring
2273 ${NS}::entry $fstring -width 30 -textvariable findstring
2274 trace add variable findstring write find_change
2275 set findtype [mc "Exact"]
2276 set findtypemenu [makedroplist .tf.lbar.findtype \
2277 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2278 trace add variable findtype write findcom_change
2279 set findloc [mc "All fields"]
2280 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2281 [mc "Comments"] [mc "Author"] [mc "Committer"]
2282 trace add variable findloc write find_change
2283 pack .tf.lbar.findloc -side right
2284 pack .tf.lbar.findtype -side right
2285 pack $fstring -side left -expand 1 -fill x
2287 # Finish putting the upper half of the viewer together
2288 pack .tf.lbar -in .tf -side bottom -fill x
2289 pack .tf.bar -in .tf -side bottom -fill x
2290 pack .tf.histframe -fill both -side top -expand 1
2293 .ctop paneconfigure .tf -height $geometry(topheight)
2294 .ctop paneconfigure .tf -width $geometry(topwidth)
2297 # now build up the bottom
2298 ${NS}::panedwindow .pwbottom -orient horizontal
2300 # lower left, a text box over search bar, scroll bar to the right
2301 # if we know window height, then that will set the lower text height, otherwise
2302 # we set lower text height which will drive window height
2303 if {[info exists geometry(main)]} {
2304 ${NS}::frame .bleft -width $geometry(botwidth)
2306 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2308 ${NS}::frame .bleft.top
2309 ${NS}::frame .bleft.mid
2310 ${NS}::frame .bleft.bottom
2312 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2313 pack .bleft.top.search -side left -padx 5
2314 set sstring .bleft.top.sstring
2316 ${NS}::entry $sstring -width 20 -textvariable searchstring
2317 lappend entries $sstring
2318 trace add variable searchstring write incrsearch
2319 pack $sstring -side left -expand 1 -fill x
2320 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2321 -command changediffdisp -variable diffelide -value {0 0}
2322 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2323 -command changediffdisp -variable diffelide -value {0 1}
2324 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2325 -command changediffdisp -variable diffelide -value {1 0}
2326 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
2327 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2328 spinbox .bleft.mid.diffcontext -width 5 \
2329 -from 0 -increment 1 -to 10000000 \
2330 -validate all -validatecommand "diffcontextvalidate %P" \
2331 -textvariable diffcontextstring
2332 .bleft.mid.diffcontext set $diffcontext
2333 trace add variable diffcontextstring write diffcontextchange
2334 lappend entries .bleft.mid.diffcontext
2335 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2336 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2337 -command changeignorespace -variable ignorespace
2338 pack .bleft.mid.ignspace -side left -padx 5
2340 set worddiff [mc "Line diff"]
2341 if {[package vcompare $git_version "1.7.2"] >= 0} {
2342 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2343 [mc "Markup words"] [mc "Color words"]
2344 trace add variable worddiff write changeworddiff
2345 pack .bleft.mid.worddiff -side left -padx 5
2348 set ctext .bleft.bottom.ctext
2349 text $ctext -background $bgcolor -foreground $fgcolor \
2350 -state disabled -font textfont \
2351 -yscrollcommand scrolltext -wrap none \
2352 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2354 $ctext conf -tabstyle wordprocessor
2356 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2357 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2358 pack .bleft.top -side top -fill x
2359 pack .bleft.mid -side top -fill x
2360 grid $ctext .bleft.bottom.sb -sticky nsew
2361 grid .bleft.bottom.sbhorizontal -sticky ew
2362 grid columnconfigure .bleft.bottom 0 -weight 1
2363 grid rowconfigure .bleft.bottom 0 -weight 1
2364 grid rowconfigure .bleft.bottom 1 -weight 0
2365 pack .bleft.bottom -side top -fill both -expand 1
2366 lappend bglist $ctext
2367 lappend fglist $ctext
2369 $ctext tag conf comment -wrap $wrapcomment
2370 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2371 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2372 $ctext tag conf d0 -fore [lindex $diffcolors 0]
2373 $ctext tag conf dresult -fore [lindex $diffcolors 1]
2374 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2375 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2376 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2377 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2378 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2379 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2380 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2381 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2382 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2383 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2384 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2385 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2386 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2387 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2388 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2389 $ctext tag conf m15 -fore [lindex $mergecolors 15]
2390 $ctext tag conf mmax -fore darkgrey
2392 $ctext tag conf mresult -font textfontbold
2393 $ctext tag conf msep -font textfontbold
2394 $ctext tag conf found -back $foundbgcolor
2395 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2396 $ctext tag conf wwrap -wrap word
2397 $ctext tag conf bold -font textfontbold
2399 .pwbottom add .bleft
2401 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2405 ${NS}::frame .bright
2406 ${NS}::frame .bright.mode
2407 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2408 -command reselectline -variable cmitmode -value "patch"
2409 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2410 -command reselectline -variable cmitmode -value "tree"
2411 grid .bright.mode.patch .bright.mode.tree -sticky ew
2412 pack .bright.mode -side top -fill x
2413 set cflist .bright.cfiles
2414 set indent [font measure mainfont "nn"]
2416 -selectbackground $selectbgcolor \
2417 -background $bgcolor -foreground $fgcolor \
2419 -tabs [list $indent [expr {2 * $indent}]] \
2420 -yscrollcommand ".bright.sb set" \
2421 -cursor [. cget -cursor] \
2422 -spacing1 1 -spacing3 1
2423 lappend bglist $cflist
2424 lappend fglist $cflist
2425 ${NS}::scrollbar .bright.sb -command "$cflist yview"
2426 pack .bright.sb -side right -fill y
2427 pack $cflist -side left -fill both -expand 1
2428 $cflist tag configure highlight \
2429 -background [$cflist cget -selectbackground]
2430 $cflist tag configure bold -font mainfontbold
2432 .pwbottom add .bright
2435 # restore window width & height if known
2436 if {[info exists geometry(main)]} {
2437 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2438 if {$w > [winfo screenwidth .]} {
2439 set w [winfo screenwidth .]
2441 if {$h > [winfo screenheight .]} {
2442 set h [winfo screenheight .]
2444 wm geometry . "${w}x$h"
2448 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2449 wm state . $geometry(state)
2452 if {[tk windowingsystem] eq {aqua}} {
2463 %W sashpos 0 $::geometry(topheight)
2465 bind .pwbottom <Map> {
2467 %W sashpos 0 $::geometry(botwidth)
2471 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2472 pack .ctop -fill both -expand 1
2473 bindall <1> {selcanvline %W %x %y}
2474 #bindall <B1-Motion> {selcanvline %W %x %y}
2475 if {[tk windowingsystem] == "win32"} {
2476 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2477 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2479 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2480 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2481 if {[tk windowingsystem] eq "aqua"} {
2482 bindall <MouseWheel> {
2483 set delta [expr {- (%D)}]
2484 allcanvs yview scroll $delta units
2486 bindall <Shift-MouseWheel> {
2487 set delta [expr {- (%D)}]
2488 $canv xview scroll $delta units
2492 bindall <$::BM> "canvscan mark %W %x %y"
2493 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2494 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2495 bind . <$M1B-Key-w> doquit
2496 bindkey <Home> selfirstline
2497 bindkey <End> sellastline
2498 bind . <Key-Up> "selnextline -1"
2499 bind . <Key-Down> "selnextline 1"
2500 bind . <Shift-Key-Up> "dofind -1 0"
2501 bind . <Shift-Key-Down> "dofind 1 0"
2502 bindkey <Key-Right> "goforw"
2503 bindkey <Key-Left> "goback"
2504 bind . <Key-Prior> "selnextpage -1"
2505 bind . <Key-Next> "selnextpage 1"
2506 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2507 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2508 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2509 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2510 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2511 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2512 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2513 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2514 bindkey <Key-space> "$ctext yview scroll 1 pages"
2515 bindkey p "selnextline -1"
2516 bindkey n "selnextline 1"
2519 bindkey k "selnextline -1"
2520 bindkey j "selnextline 1"
2524 bindkey d "$ctext yview scroll 18 units"
2525 bindkey u "$ctext yview scroll -18 units"
2526 bindkey / {focus $fstring}
2527 bindkey <Key-KP_Divide> {focus $fstring}
2528 bindkey <Key-Return> {dofind 1 1}
2529 bindkey ? {dofind -1 1}
2531 bind . <F5> updatecommits
2532 bindmodfunctionkey Shift 5 reloadcommits
2533 bind . <F2> showrefs
2534 bindmodfunctionkey Shift 4 {newview 0}
2535 bind . <F4> edit_or_newview
2536 bind . <$M1B-q> doquit
2537 bind . <$M1B-f> {dofind 1 1}
2538 bind . <$M1B-g> {dofind 1 0}
2539 bind . <$M1B-r> dosearchback
2540 bind . <$M1B-s> dosearch
2541 bind . <$M1B-equal> {incrfont 1}
2542 bind . <$M1B-plus> {incrfont 1}
2543 bind . <$M1B-KP_Add> {incrfont 1}
2544 bind . <$M1B-minus> {incrfont -1}
2545 bind . <$M1B-KP_Subtract> {incrfont -1}
2546 wm protocol . WM_DELETE_WINDOW doquit
2547 bind . <Destroy> {stop_backends}
2548 bind . <Button-1> "click %W"
2549 bind $fstring <Key-Return> {dofind 1 1}
2550 bind $sha1entry <Key-Return> {gotocommit; break}
2551 bind $sha1entry <<PasteSelection>> clearsha1
2552 bind $cflist <1> {sel_flist %W %x %y; break}
2553 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2554 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2556 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2557 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2558 bind $ctext <Button-1> {focus %W}
2559 bind $ctext <<Selection>> rehighlight_search_results
2561 set maincursor [. cget -cursor]
2562 set textcursor [$ctext cget -cursor]
2563 set curtextcursor $textcursor
2565 set rowctxmenu .rowctxmenu
2566 makemenu $rowctxmenu {
2567 {mc "Diff this -> selected" command {diffvssel 0}}
2568 {mc "Diff selected -> this" command {diffvssel 1}}
2569 {mc "Make patch" command mkpatch}
2570 {mc "Create tag" command mktag}
2571 {mc "Write commit to file" command writecommit}
2572 {mc "Create new branch" command mkbranch}
2573 {mc "Cherry-pick this commit" command cherrypick}
2574 {mc "Reset HEAD branch to here" command resethead}
2575 {mc "Mark this commit" command markhere}
2576 {mc "Return to mark" command gotomark}
2577 {mc "Find descendant of this and mark" command find_common_desc}
2578 {mc "Compare with marked commit" command compare_commits}
2579 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2580 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2581 {mc "Revert this commit" command revert}
2583 $rowctxmenu configure -tearoff 0
2585 set fakerowmenu .fakerowmenu
2586 makemenu $fakerowmenu {
2587 {mc "Diff this -> selected" command {diffvssel 0}}
2588 {mc "Diff selected -> this" command {diffvssel 1}}
2589 {mc "Make patch" command mkpatch}
2590 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2591 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2593 $fakerowmenu configure -tearoff 0
2595 set headctxmenu .headctxmenu
2596 makemenu $headctxmenu {
2597 {mc "Check out this branch" command cobranch}
2598 {mc "Remove this branch" command rmbranch}
2600 $headctxmenu configure -tearoff 0
2603 set flist_menu .flistctxmenu
2604 makemenu $flist_menu {
2605 {mc "Highlight this too" command {flist_hl 0}}
2606 {mc "Highlight this only" command {flist_hl 1}}
2607 {mc "External diff" command {external_diff}}
2608 {mc "Blame parent commit" command {external_blame 1}}
2610 $flist_menu configure -tearoff 0
2613 set diff_menu .diffctxmenu
2614 makemenu $diff_menu {
2615 {mc "Show origin of this line" command show_line_source}
2616 {mc "Run git gui blame on this line" command {external_blame_diff}}
2618 $diff_menu configure -tearoff 0
2621 # Windows sends all mouse wheel events to the current focused window, not
2622 # the one where the mouse hovers, so bind those events here and redirect
2623 # to the correct window
2624 proc windows_mousewheel_redirector {W X Y D} {
2625 global canv canv2 canv3
2626 set w [winfo containing -displayof $W $X $Y]
2628 set u [expr {$D < 0 ? 5 : -5}]
2629 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2630 allcanvs yview scroll $u units
2633 $w yview scroll $u units
2639 # Update row number label when selectedline changes
2640 proc selectedline_change {n1 n2 op} {
2641 global selectedline rownumsel
2643 if {$selectedline eq {}} {
2646 set rownumsel [expr {$selectedline + 1}]
2650 # mouse-2 makes all windows scan vertically, but only the one
2651 # the cursor is in scans horizontally
2652 proc canvscan {op w x y} {
2653 global canv canv2 canv3
2654 foreach c [list $canv $canv2 $canv3] {
2663 proc scrollcanv {cscroll f0 f1} {
2664 $cscroll set $f0 $f1
2669 # when we make a key binding for the toplevel, make sure
2670 # it doesn't get triggered when that key is pressed in the
2671 # find string entry widget.
2672 proc bindkey {ev script} {
2675 set escript [bind Entry $ev]
2676 if {$escript == {}} {
2677 set escript [bind Entry <Key>]
2679 foreach e $entries {
2680 bind $e $ev "$escript; break"
2684 proc bindmodfunctionkey {mod n script} {
2685 bind . <$mod-F$n> $script
2686 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2689 # set the focus back to the toplevel for any click outside
2692 global ctext entries
2693 foreach e [concat $entries $ctext] {
2694 if {$w == $e} return
2699 # Adjust the progress bar for a change in requested extent or canvas size
2700 proc adjustprogress {} {
2701 global progresscanv progressitem progresscoords
2702 global fprogitem fprogcoord lastprogupdate progupdatepending
2703 global rprogitem rprogcoord use_ttk
2706 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2710 set w [expr {[winfo width $progresscanv] - 4}]
2711 set x0 [expr {$w * [lindex $progresscoords 0]}]
2712 set x1 [expr {$w * [lindex $progresscoords 1]}]
2713 set h [winfo height $progresscanv]
2714 $progresscanv coords $progressitem $x0 0 $x1 $h
2715 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2716 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2717 set now [clock clicks -milliseconds]
2718 if {$now >= $lastprogupdate + 100} {
2719 set progupdatepending 0
2721 } elseif {!$progupdatepending} {
2722 set progupdatepending 1
2723 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2727 proc doprogupdate {} {
2728 global lastprogupdate progupdatepending
2730 if {$progupdatepending} {
2731 set progupdatepending 0
2732 set lastprogupdate [clock clicks -milliseconds]
2737 proc savestuff {w} {
2738 global canv canv2 canv3 mainfont textfont uifont tabstop
2739 global stuffsaved findmergefiles maxgraphpct
2740 global maxwidth showneartags showlocalchanges
2741 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2742 global cmitmode wrapcomment datetimeformat limitdiffs
2743 global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2744 global uifgcolor uifgdisabledcolor
2745 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
2746 global tagbgcolor tagfgcolor tagoutlinecolor
2747 global reflinecolor filesepbgcolor filesepfgcolor
2748 global mergecolors foundbgcolor currentsearchhitbgcolor
2749 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
2750 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
2751 global linkfgcolor circleoutlinecolor
2752 global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2753 global hideremotes want_ttk maxrefs
2755 if {$stuffsaved} return
2756 if {![winfo viewable .]} return
2758 if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2759 set f [open "~/.gitk-new" w]
2760 if {$::tcl_platform(platform) eq {windows}} {
2761 file attributes "~/.gitk-new" -hidden true
2763 puts $f [list set mainfont $mainfont]
2764 puts $f [list set textfont $textfont]
2765 puts $f [list set uifont $uifont]
2766 puts $f [list set tabstop $tabstop]
2767 puts $f [list set findmergefiles $findmergefiles]
2768 puts $f [list set maxgraphpct $maxgraphpct]
2769 puts $f [list set maxwidth $maxwidth]
2770 puts $f [list set cmitmode $cmitmode]
2771 puts $f [list set wrapcomment $wrapcomment]
2772 puts $f [list set autoselect $autoselect]
2773 puts $f [list set autosellen $autosellen]
2774 puts $f [list set showneartags $showneartags]
2775 puts $f [list set maxrefs $maxrefs]
2776 puts $f [list set hideremotes $hideremotes]
2777 puts $f [list set showlocalchanges $showlocalchanges]
2778 puts $f [list set datetimeformat $datetimeformat]
2779 puts $f [list set limitdiffs $limitdiffs]
2780 puts $f [list set uicolor $uicolor]
2781 puts $f [list set want_ttk $want_ttk]
2782 puts $f [list set bgcolor $bgcolor]
2783 puts $f [list set fgcolor $fgcolor]
2784 puts $f [list set uifgcolor $uifgcolor]
2785 puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
2786 puts $f [list set colors $colors]
2787 puts $f [list set diffcolors $diffcolors]
2788 puts $f [list set mergecolors $mergecolors]
2789 puts $f [list set markbgcolor $markbgcolor]
2790 puts $f [list set diffcontext $diffcontext]
2791 puts $f [list set selectbgcolor $selectbgcolor]
2792 puts $f [list set foundbgcolor $foundbgcolor]
2793 puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
2794 puts $f [list set extdifftool $extdifftool]
2795 puts $f [list set perfile_attrs $perfile_attrs]
2796 puts $f [list set headbgcolor $headbgcolor]
2797 puts $f [list set headfgcolor $headfgcolor]
2798 puts $f [list set headoutlinecolor $headoutlinecolor]
2799 puts $f [list set remotebgcolor $remotebgcolor]
2800 puts $f [list set tagbgcolor $tagbgcolor]
2801 puts $f [list set tagfgcolor $tagfgcolor]
2802 puts $f [list set tagoutlinecolor $tagoutlinecolor]
2803 puts $f [list set reflinecolor $reflinecolor]
2804 puts $f [list set filesepbgcolor $filesepbgcolor]
2805 puts $f [list set filesepfgcolor $filesepfgcolor]
2806 puts $f [list set linehoverbgcolor $linehoverbgcolor]
2807 puts $f [list set linehoverfgcolor $linehoverfgcolor]
2808 puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
2809 puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
2810 puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
2811 puts $f [list set indexcirclecolor $indexcirclecolor]
2812 puts $f [list set circlecolors $circlecolors]
2813 puts $f [list set linkfgcolor $linkfgcolor]
2814 puts $f [list set circleoutlinecolor $circleoutlinecolor]
2816 puts $f "set geometry(main) [wm geometry .]"
2817 puts $f "set geometry(state) [wm state .]"
2818 puts $f "set geometry(topwidth) [winfo width .tf]"
2819 puts $f "set geometry(topheight) [winfo height .tf]"
2821 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2822 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2824 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2825 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2827 puts $f "set geometry(botwidth) [winfo width .bleft]"
2828 puts $f "set geometry(botheight) [winfo height .bleft]"
2830 puts -nonewline $f "set permviews {"
2831 for {set v 0} {$v < $nextviewnum} {incr v} {
2832 if {$viewperm($v)} {
2833 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2838 file rename -force "~/.gitk-new" "~/.gitk"
2843 proc resizeclistpanes {win w} {
2844 global oldwidth use_ttk
2845 if {[info exists oldwidth($win)]} {
2847 set s0 [$win sashpos 0]
2848 set s1 [$win sashpos 1]
2850 set s0 [$win sash coord 0]
2851 set s1 [$win sash coord 1]
2854 set sash0 [expr {int($w/2 - 2)}]
2855 set sash1 [expr {int($w*5/6 - 2)}]
2857 set factor [expr {1.0 * $w / $oldwidth($win)}]
2858 set sash0 [expr {int($factor * [lindex $s0 0])}]
2859 set sash1 [expr {int($factor * [lindex $s1 0])}]
2863 if {$sash1 < $sash0 + 20} {
2864 set sash1 [expr {$sash0 + 20}]
2866 if {$sash1 > $w - 10} {
2867 set sash1 [expr {$w - 10}]
2868 if {$sash0 > $sash1 - 20} {
2869 set sash0 [expr {$sash1 - 20}]
2874 $win sashpos 0 $sash0
2875 $win sashpos 1 $sash1
2877 $win sash place 0 $sash0 [lindex $s0 1]
2878 $win sash place 1 $sash1 [lindex $s1 1]
2881 set oldwidth($win) $w
2884 proc resizecdetpanes {win w} {
2885 global oldwidth use_ttk
2886 if {[info exists oldwidth($win)]} {
2888 set s0 [$win sashpos 0]
2890 set s0 [$win sash coord 0]
2893 set sash0 [expr {int($w*3/4 - 2)}]
2895 set factor [expr {1.0 * $w / $oldwidth($win)}]
2896 set sash0 [expr {int($factor * [lindex $s0 0])}]
2900 if {$sash0 > $w - 15} {
2901 set sash0 [expr {$w - 15}]
2905 $win sashpos 0 $sash0
2907 $win sash place 0 $sash0 [lindex $s0 1]
2910 set oldwidth($win) $w
2913 proc allcanvs args {
2914 global canv canv2 canv3
2920 proc bindall {event action} {
2921 global canv canv2 canv3
2922 bind $canv $event $action
2923 bind $canv2 $event $action
2924 bind $canv3 $event $action
2930 if {[winfo exists $w]} {
2935 wm title $w [mc "About gitk"]
2937 message $w.m -text [mc "
2938 Gitk - a commit viewer for git
2940 Copyright \u00a9 2005-2011 Paul Mackerras
2942 Use and redistribute under the terms of the GNU General Public License"] \
2943 -justify center -aspect 400 -border 2 -bg white -relief groove
2944 pack $w.m -side top -fill x -padx 2 -pady 2
2945 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2946 pack $w.ok -side bottom
2947 bind $w <Visibility> "focus $w.ok"
2948 bind $w <Key-Escape> "destroy $w"
2949 bind $w <Key-Return> "destroy $w"
2950 tk::PlaceWindow $w widget .
2956 if {[winfo exists $w]} {
2960 if {[tk windowingsystem] eq {aqua}} {
2966 wm title $w [mc "Gitk key bindings"]
2968 message $w.m -text "
2969 [mc "Gitk key bindings:"]
2971 [mc "<%s-Q> Quit" $M1T]
2972 [mc "<%s-W> Close window" $M1T]
2973 [mc "<Home> Move to first commit"]
2974 [mc "<End> Move to last commit"]
2975 [mc "<Up>, p, k Move up one commit"]
2976 [mc "<Down>, n, j Move down one commit"]
2977 [mc "<Left>, z, h Go back in history list"]
2978 [mc "<Right>, x, l Go forward in history list"]
2979 [mc "<PageUp> Move up one page in commit list"]
2980 [mc "<PageDown> Move down one page in commit list"]
2981 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2982 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2983 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2984 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2985 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2986 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2987 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2988 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2989 [mc "<Delete>, b Scroll diff view up one page"]
2990 [mc "<Backspace> Scroll diff view up one page"]
2991 [mc "<Space> Scroll diff view down one page"]
2992 [mc "u Scroll diff view up 18 lines"]
2993 [mc "d Scroll diff view down 18 lines"]
2994 [mc "<%s-F> Find" $M1T]
2995 [mc "<%s-G> Move to next find hit" $M1T]
2996 [mc "<Return> Move to next find hit"]
2997 [mc "/ Focus the search box"]
2998 [mc "? Move to previous find hit"]
2999 [mc "f Scroll diff view to next file"]
3000 [mc "<%s-S> Search for next hit in diff view" $M1T]
3001 [mc "<%s-R> Search for previous hit in diff view" $M1T]
3002 [mc "<%s-KP+> Increase font size" $M1T]
3003 [mc "<%s-plus> Increase font size" $M1T]
3004 [mc "<%s-KP-> Decrease font size" $M1T]
3005 [mc "<%s-minus> Decrease font size" $M1T]
3008 -justify left -bg white -border 2 -relief groove
3009 pack $w.m -side top -fill both -padx 2 -pady 2
3010 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3011 bind $w <Key-Escape> [list destroy $w]
3012 pack $w.ok -side bottom
3013 bind $w <Visibility> "focus $w.ok"
3014 bind $w <Key-Escape> "destroy $w"
3015 bind $w <Key-Return> "destroy $w"
3018 # Procedures for manipulating the file list window at the
3019 # bottom right of the overall window.
3021 proc treeview {w l openlevs} {
3022 global treecontents treediropen treeheight treeparent treeindex
3032 set treecontents() {}
3033 $w conf -state normal
3035 while {[string range $f 0 $prefixend] ne $prefix} {
3036 if {$lev <= $openlevs} {
3037 $w mark set e:$treeindex($prefix) "end -1c"
3038 $w mark gravity e:$treeindex($prefix) left
3040 set treeheight($prefix) $ht
3041 incr ht [lindex $htstack end]
3042 set htstack [lreplace $htstack end end]
3043 set prefixend [lindex $prefendstack end]
3044 set prefendstack [lreplace $prefendstack end end]
3045 set prefix [string range $prefix 0 $prefixend]
3048 set tail [string range $f [expr {$prefixend+1}] end]
3049 while {[set slash [string first "/" $tail]] >= 0} {
3052 lappend prefendstack $prefixend
3053 incr prefixend [expr {$slash + 1}]
3054 set d [string range $tail 0 $slash]
3055 lappend treecontents($prefix) $d
3056 set oldprefix $prefix
3058 set treecontents($prefix) {}
3059 set treeindex($prefix) [incr ix]
3060 set treeparent($prefix) $oldprefix
3061 set tail [string range $tail [expr {$slash+1}] end]
3062 if {$lev <= $openlevs} {
3064 set treediropen($prefix) [expr {$lev < $openlevs}]
3065 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3066 $w mark set d:$ix "end -1c"
3067 $w mark gravity d:$ix left
3069 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3071 $w image create end -align center -image $bm -padx 1 \
3073 $w insert end $d [highlight_tag $prefix]
3074 $w mark set s:$ix "end -1c"
3075 $w mark gravity s:$ix left
3080 if {$lev <= $openlevs} {
3083 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3085 $w insert end $tail [highlight_tag $f]
3087 lappend treecontents($prefix) $tail
3090 while {$htstack ne {}} {
3091 set treeheight($prefix) $ht
3092 incr ht [lindex $htstack end]
3093 set htstack [lreplace $htstack end end]
3094 set prefixend [lindex $prefendstack end]
3095 set prefendstack [lreplace $prefendstack end end]
3096 set prefix [string range $prefix 0 $prefixend]
3098 $w conf -state disabled
3101 proc linetoelt {l} {
3102 global treeheight treecontents
3107 foreach e $treecontents($prefix) {
3112 if {[string index $e end] eq "/"} {
3113 set n $treeheight($prefix$e)
3125 proc highlight_tree {y prefix} {
3126 global treeheight treecontents cflist
3128 foreach e $treecontents($prefix) {
3130 if {[highlight_tag $path] ne {}} {
3131 $cflist tag add bold $y.0 "$y.0 lineend"
3134 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3135 set y [highlight_tree $y $path]
3141 proc treeclosedir {w dir} {
3142 global treediropen treeheight treeparent treeindex
3144 set ix $treeindex($dir)
3145 $w conf -state normal
3146 $w delete s:$ix e:$ix
3147 set treediropen($dir) 0
3148 $w image configure a:$ix -image tri-rt
3149 $w conf -state disabled
3150 set n [expr {1 - $treeheight($dir)}]
3151 while {$dir ne {}} {
3152 incr treeheight($dir) $n
3153 set dir $treeparent($dir)
3157 proc treeopendir {w dir} {
3158 global treediropen treeheight treeparent treecontents treeindex
3160 set ix $treeindex($dir)
3161 $w conf -state normal
3162 $w image configure a:$ix -image tri-dn
3163 $w mark set e:$ix s:$ix
3164 $w mark gravity e:$ix right
3167 set n [llength $treecontents($dir)]
3168 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3171 incr treeheight($x) $n
3173 foreach e $treecontents($dir) {
3175 if {[string index $e end] eq "/"} {
3176 set iy $treeindex($de)
3177 $w mark set d:$iy e:$ix
3178 $w mark gravity d:$iy left
3179 $w insert e:$ix $str
3180 set treediropen($de) 0
3181 $w image create e:$ix -align center -image tri-rt -padx 1 \
3183 $w insert e:$ix $e [highlight_tag $de]
3184 $w mark set s:$iy e:$ix
3185 $w mark gravity s:$iy left
3186 set treeheight($de) 1
3188 $w insert e:$ix $str
3189 $w insert e:$ix $e [highlight_tag $de]
3192 $w mark gravity e:$ix right
3193 $w conf -state disabled
3194 set treediropen($dir) 1
3195 set top [lindex [split [$w index @0,0] .] 0]
3196 set ht [$w cget -height]
3197 set l [lindex [split [$w index s:$ix] .] 0]
3200 } elseif {$l + $n + 1 > $top + $ht} {
3201 set top [expr {$l + $n + 2 - $ht}]
3209 proc treeclick {w x y} {
3210 global treediropen cmitmode ctext cflist cflist_top
3212 if {$cmitmode ne "tree"} return
3213 if {![info exists cflist_top]} return
3214 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3215 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3216 $cflist tag add highlight $l.0 "$l.0 lineend"
3222 set e [linetoelt $l]
3223 if {[string index $e end] ne "/"} {
3225 } elseif {$treediropen($e)} {
3232 proc setfilelist {id} {
3233 global treefilelist cflist jump_to_here
3235 treeview $cflist $treefilelist($id) 0
3236 if {$jump_to_here ne {}} {
3237 set f [lindex $jump_to_here 0]
3238 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3244 image create bitmap tri-rt -background black -foreground blue -data {
3245 #define tri-rt_width 13
3246 #define tri-rt_height 13
3247 static unsigned char tri-rt_bits[] = {
3248 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3249 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3252 #define tri-rt-mask_width 13
3253 #define tri-rt-mask_height 13
3254 static unsigned char tri-rt-mask_bits[] = {
3255 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3256 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3259 image create bitmap tri-dn -background black -foreground blue -data {
3260 #define tri-dn_width 13
3261 #define tri-dn_height 13
3262 static unsigned char tri-dn_bits[] = {
3263 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3264 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3267 #define tri-dn-mask_width 13
3268 #define tri-dn-mask_height 13
3269 static unsigned char tri-dn-mask_bits[] = {
3270 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3271 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3275 image create bitmap reficon-T -background black -foreground yellow -data {
3276 #define tagicon_width 13
3277 #define tagicon_height 9
3278 static unsigned char tagicon_bits[] = {
3279 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3280 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3282 #define tagicon-mask_width 13
3283 #define tagicon-mask_height 9
3284 static unsigned char tagicon-mask_bits[] = {
3285 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3286 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3289 #define headicon_width 13
3290 #define headicon_height 9
3291 static unsigned char headicon_bits[] = {
3292 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3293 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3296 #define headicon-mask_width 13
3297 #define headicon-mask_height 9
3298 static unsigned char headicon-mask_bits[] = {
3299 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3300 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3302 image create bitmap reficon-H -background black -foreground green \
3303 -data $rectdata -maskdata $rectmask
3304 image create bitmap reficon-o -background black -foreground "#ddddff" \
3305 -data $rectdata -maskdata $rectmask
3307 proc init_flist {first} {
3308 global cflist cflist_top difffilestart
3310 $cflist conf -state normal
3311 $cflist delete 0.0 end
3313 $cflist insert end $first
3315 $cflist tag add highlight 1.0 "1.0 lineend"
3317 catch {unset cflist_top}
3319 $cflist conf -state disabled
3320 set difffilestart {}
3323 proc highlight_tag {f} {
3324 global highlight_paths
3326 foreach p $highlight_paths {
3327 if {[string match $p $f]} {
3334 proc highlight_filelist {} {
3335 global cmitmode cflist
3337 $cflist conf -state normal
3338 if {$cmitmode ne "tree"} {
3339 set end [lindex [split [$cflist index end] .] 0]
3340 for {set l 2} {$l < $end} {incr l} {
3341 set line [$cflist get $l.0 "$l.0 lineend"]
3342 if {[highlight_tag $line] ne {}} {
3343 $cflist tag add bold $l.0 "$l.0 lineend"
3349 $cflist conf -state disabled
3352 proc unhighlight_filelist {} {
3355 $cflist conf -state normal
3356 $cflist tag remove bold 1.0 end
3357 $cflist conf -state disabled
3360 proc add_flist {fl} {
3363 $cflist conf -state normal
3365 $cflist insert end "\n"
3366 $cflist insert end $f [highlight_tag $f]
3368 $cflist conf -state disabled
3371 proc sel_flist {w x y} {
3372 global ctext difffilestart cflist cflist_top cmitmode
3374 if {$cmitmode eq "tree"} return
3375 if {![info exists cflist_top]} return
3376 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3377 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3378 $cflist tag add highlight $l.0 "$l.0 lineend"
3383 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3385 suppress_highlighting_file_for_current_scrollpos
3388 proc pop_flist_menu {w X Y x y} {
3389 global ctext cflist cmitmode flist_menu flist_menu_file
3390 global treediffs diffids
3393 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3395 if {$cmitmode eq "tree"} {
3396 set e [linetoelt $l]
3397 if {[string index $e end] eq "/"} return
3399 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3401 set flist_menu_file $e
3402 set xdiffstate "normal"
3403 if {$cmitmode eq "tree"} {
3404 set xdiffstate "disabled"
3406 # Disable "External diff" item in tree mode
3407 $flist_menu entryconf 2 -state $xdiffstate
3408 tk_popup $flist_menu $X $Y
3411 proc find_ctext_fileinfo {line} {
3412 global ctext_file_names ctext_file_lines
3414 set ok [bsearch $ctext_file_lines $line]
3415 set tline [lindex $ctext_file_lines $ok]
3417 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3420 return [list [lindex $ctext_file_names $ok] $tline]
3424 proc pop_diff_menu {w X Y x y} {
3425 global ctext diff_menu flist_menu_file
3426 global diff_menu_txtpos diff_menu_line
3427 global diff_menu_filebase
3429 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3430 set diff_menu_line [lindex $diff_menu_txtpos 0]
3431 # don't pop up the menu on hunk-separator or file-separator lines
3432 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3436 set f [find_ctext_fileinfo $diff_menu_line]
3437 if {$f eq {}} return
3438 set flist_menu_file [lindex $f 0]
3439 set diff_menu_filebase [lindex $f 1]
3440 tk_popup $diff_menu $X $Y
3443 proc flist_hl {only} {
3444 global flist_menu_file findstring gdttype
3446 set x [shellquote $flist_menu_file]
3447 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3450 append findstring " " $x
3452 set gdttype [mc "touching paths:"]
3455 proc gitknewtmpdir {} {
3456 global diffnum gitktmpdir gitdir
3458 if {![info exists gitktmpdir]} {
3459 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3460 if {[catch {file mkdir $gitktmpdir} err]} {
3461 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3468 set diffdir [file join $gitktmpdir $diffnum]
3469 if {[catch {file mkdir $diffdir} err]} {
3470 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3476 proc save_file_from_commit {filename output what} {
3479 if {[catch {exec git show $filename -- > $output} err]} {
3480 if {[string match "fatal: bad revision *" $err]} {
3483 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3489 proc external_diff_get_one_file {diffid filename diffdir} {
3490 global nullid nullid2 nullfile
3493 if {$diffid == $nullid} {
3494 set difffile [file join $worktree $filename]
3495 if {[file exists $difffile]} {
3500 if {$diffid == $nullid2} {
3501 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3502 return [save_file_from_commit :$filename $difffile index]
3504 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3505 return [save_file_from_commit $diffid:$filename $difffile \
3509 proc external_diff {} {
3510 global nullid nullid2
3511 global flist_menu_file
3515 if {[llength $diffids] == 1} {
3516 # no reference commit given
3517 set diffidto [lindex $diffids 0]
3518 if {$diffidto eq $nullid} {
3519 # diffing working copy with index
3520 set diffidfrom $nullid2
3521 } elseif {$diffidto eq $nullid2} {
3522 # diffing index with HEAD
3523 set diffidfrom "HEAD"
3525 # use first parent commit
3526 global parentlist selectedline
3527 set diffidfrom [lindex $parentlist $selectedline 0]
3530 set diffidfrom [lindex $diffids 0]
3531 set diffidto [lindex $diffids 1]
3534 # make sure that several diffs wont collide
3535 set diffdir [gitknewtmpdir]
3536 if {$diffdir eq {}} return
3538 # gather files to diff
3539 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3540 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3542 if {$difffromfile ne {} && $difftofile ne {}} {
3543 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3544 if {[catch {set fl [open |$cmd r]} err]} {
3545 file delete -force $diffdir
3546 error_popup "$extdifftool: [mc "command failed:"] $err"
3548 fconfigure $fl -blocking 0
3549 filerun $fl [list delete_at_eof $fl $diffdir]
3554 proc find_hunk_blamespec {base line} {
3557 # Find and parse the hunk header
3558 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3559 if {$s_lix eq {}} return
3561 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3562 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3563 s_line old_specs osz osz1 new_line nsz]} {
3567 # base lines for the parents
3568 set base_lines [list $new_line]
3569 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3570 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3571 old_spec old_line osz]} {
3574 lappend base_lines $old_line
3577 # Now scan the lines to determine offset within the hunk
3578 set max_parent [expr {[llength $base_lines]-2}]
3580 set s_lno [lindex [split $s_lix "."] 0]
3582 # Determine if the line is removed
3583 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3584 if {[string match {[-+ ]*} $chunk]} {
3585 set removed_idx [string first "-" $chunk]
3586 # Choose a parent index
3587 if {$removed_idx >= 0} {
3588 set parent $removed_idx
3590 set unchanged_idx [string first " " $chunk]
3591 if {$unchanged_idx >= 0} {
3592 set parent $unchanged_idx
3594 # blame the current commit
3598 # then count other lines that belong to it
3599 for {set i $line} {[incr i -1] > $s_lno} {} {
3600 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3601 # Determine if the line is removed
3602 set removed_idx [string first "-" $chunk]
3604 set code [string index $chunk $parent]
3605 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3609 if {$removed_idx < 0} {
3619 incr dline [lindex $base_lines $parent]
3620 return [list $parent $dline]
3623 proc external_blame_diff {} {
3624 global currentid cmitmode
3625 global diff_menu_txtpos diff_menu_line
3626 global diff_menu_filebase flist_menu_file
3628 if {$cmitmode eq "tree"} {
3630 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3632 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3634 set parent_idx [lindex $hinfo 0]
3635 set line [lindex $hinfo 1]
3642 external_blame $parent_idx $line
3645 # Find the SHA1 ID of the blob for file $fname in the index
3647 proc index_sha1 {fname} {
3648 set f [open [list | git ls-files -s $fname] r]
3649 while {[gets $f line] >= 0} {
3650 set info [lindex [split $line "\t"] 0]
3651 set stage [lindex $info 2]
3652 if {$stage eq "0" || $stage eq "2"} {
3654 return [lindex $info 1]
3661 # Turn an absolute path into one relative to the current directory
3662 proc make_relative {f} {
3663 if {[file pathtype $f] eq "relative"} {
3666 set elts [file split $f]
3667 set here [file split [pwd]]
3672 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3679 set elts [concat $res [lrange $elts $ei end]]
3680 return [eval file join $elts]
3683 proc external_blame {parent_idx {line {}}} {
3684 global flist_menu_file cdup
3685 global nullid nullid2
3686 global parentlist selectedline currentid
3688 if {$parent_idx > 0} {
3689 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3691 set base_commit $currentid
3694 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3695 error_popup [mc "No such commit"]
3699 set cmdline [list git gui blame]
3700 if {$line ne {} && $line > 1} {
3701 lappend cmdline "--line=$line"
3703 set f [file join $cdup $flist_menu_file]
3704 # Unfortunately it seems git gui blame doesn't like
3705 # being given an absolute path...
3706 set f [make_relative $f]
3707 lappend cmdline $base_commit $f
3708 if {[catch {eval exec $cmdline &} err]} {
3709 error_popup "[mc "git gui blame: command failed:"] $err"
3713 proc show_line_source {} {
3714 global cmitmode currentid parents curview blamestuff blameinst
3715 global diff_menu_line diff_menu_filebase flist_menu_file
3716 global nullid nullid2 gitdir cdup
3719 if {$cmitmode eq "tree"} {
3721 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3723 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3724 if {$h eq {}} return
3725 set pi [lindex $h 0]
3727 mark_ctext_line $diff_menu_line
3731 if {$currentid eq $nullid} {
3733 # must be a merge in progress...
3735 # get the last line from .git/MERGE_HEAD
3736 set f [open [file join $gitdir MERGE_HEAD] r]
3737 set id [lindex [split [read $f] "\n"] end-1]
3740 error_popup [mc "Couldn't read merge head: %s" $err]
3743 } elseif {$parents($curview,$currentid) eq $nullid2} {
3744 # need to do the blame from the index
3746 set from_index [index_sha1 $flist_menu_file]
3748 error_popup [mc "Error reading index: %s" $err]
3752 set id $parents($curview,$currentid)
3755 set id [lindex $parents($curview,$currentid) $pi]
3757 set line [lindex $h 1]
3760 if {$from_index ne {}} {
3761 lappend blameargs | git cat-file blob $from_index
3763 lappend blameargs | git blame -p -L$line,+1
3764 if {$from_index ne {}} {
3765 lappend blameargs --contents -
3767 lappend blameargs $id
3769 lappend blameargs -- [file join $cdup $flist_menu_file]
3771 set f [open $blameargs r]
3773 error_popup [mc "Couldn't start git blame: %s" $err]
3776 nowbusy blaming [mc "Searching"]
3777 fconfigure $f -blocking 0
3778 set i [reg_instance $f]
3779 set blamestuff($i) {}
3781 filerun $f [list read_line_source $f $i]
3784 proc stopblaming {} {
3787 if {[info exists blameinst]} {
3788 stop_instance $blameinst
3794 proc read_line_source {fd inst} {
3795 global blamestuff curview commfd blameinst nullid nullid2
3797 while {[gets $fd line] >= 0} {
3798 lappend blamestuff($inst) $line
3806 fconfigure $fd -blocking 1
3807 if {[catch {close $fd} err]} {
3808 error_popup [mc "Error running git blame: %s" $err]
3813 set line [split [lindex $blamestuff($inst) 0] " "]
3814 set id [lindex $line 0]
3815 set lnum [lindex $line 1]
3816 if {[string length $id] == 40 && [string is xdigit $id] &&
3817 [string is digit -strict $lnum]} {
3818 # look for "filename" line
3819 foreach l $blamestuff($inst) {
3820 if {[string match "filename *" $l]} {
3821 set fname [string range $l 9 end]
3827 # all looks good, select it
3828 if {$id eq $nullid} {
3829 # blame uses all-zeroes to mean not committed,
3830 # which would mean a change in the index
3833 if {[commitinview $id $curview]} {
3834 selectline [rowofcommit $id] 1 [list $fname $lnum]
3836 error_popup [mc "That line comes from commit %s, \
3837 which is not in this view" [shortids $id]]
3840 puts "oops couldn't parse git blame output"
3845 # delete $dir when we see eof on $f (presumably because the child has exited)
3846 proc delete_at_eof {f dir} {
3847 while {[gets $f line] >= 0} {}
3849 if {[catch {close $f} err]} {
3850 error_popup "[mc "External diff viewer failed:"] $err"
3852 file delete -force $dir
3858 # Functions for adding and removing shell-type quoting
3860 proc shellquote {str} {
3861 if {![string match "*\['\"\\ \t]*" $str]} {
3864 if {![string match "*\['\"\\]*" $str]} {
3867 if {![string match "*'*" $str]} {
3870 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3873 proc shellarglist {l} {
3879 append str [shellquote $a]
3884 proc shelldequote {str} {
3889 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3890 append ret [string range $str $used end]
3891 set used [string length $str]
3894 set first [lindex $first 0]
3895 set ch [string index $str $first]
3896 if {$first > $used} {
3897 append ret [string range $str $used [expr {$first - 1}]]
3900 if {$ch eq " " || $ch eq "\t"} break
3903 set first [string first "'" $str $used]
3905 error "unmatched single-quote"
3907 append ret [string range $str $used [expr {$first - 1}]]
3912 if {$used >= [string length $str]} {
3913 error "trailing backslash"
3915 append ret [string index $str $used]
3920 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3921 error "unmatched double-quote"
3923 set first [lindex $first 0]
3924 set ch [string index $str $first]
3925 if {$first > $used} {
3926 append ret [string range $str $used [expr {$first - 1}]]
3929 if {$ch eq "\""} break
3931 append ret [string index $str $used]
3935 return [list $used $ret]
3938 proc shellsplit {str} {
3941 set str [string trimleft $str]
3942 if {$str eq {}} break
3943 set dq [shelldequote $str]
3944 set n [lindex $dq 0]
3945 set word [lindex $dq 1]
3946 set str [string range $str $n end]
3952 # Code to implement multiple views
3954 proc newview {ishighlight} {
3955 global nextviewnum newviewname newishighlight
3956 global revtreeargs viewargscmd newviewopts curview
3958 set newishighlight $ishighlight
3960 if {[winfo exists $top]} {
3964 decode_view_opts $nextviewnum $revtreeargs
3965 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3966 set newviewopts($nextviewnum,perm) 0
3967 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3968 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3971 set known_view_options {
3972 {perm b . {} {mc "Remember this view"}}
3973 {reflabel l + {} {mc "References (space separated list):"}}
3974 {refs t15 .. {} {mc "Branches & tags:"}}
3975 {allrefs b *. "--all" {mc "All refs"}}
3976 {branches b . "--branches" {mc "All (local) branches"}}
3977 {tags b . "--tags" {mc "All tags"}}
3978 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3979 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3980 {author t15 .. "--author=*" {mc "Author:"}}
3981 {committer t15 . "--committer=*" {mc "Committer:"}}
3982 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3983 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3984 {changes_l l + {} {mc "Changes to Files:"}}
3985 {pickaxe_s r0 . {} {mc "Fixed String"}}
3986 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3987 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3988 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3989 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3990 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3991 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3992 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3993 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3994 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3995 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3996 {lright b . "--left-right" {mc "Mark branch sides"}}
3997 {first b . "--first-parent" {mc "Limit to first parent"}}
3998 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
3999 {args t50 *. {} {mc "Additional arguments to git log:"}}
4000 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4001 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
4004 # Convert $newviewopts($n, ...) into args for git log.
4005 proc encode_view_opts {n} {
4006 global known_view_options newviewopts
4009 foreach opt $known_view_options {
4010 set patterns [lindex $opt 3]
4011 if {$patterns eq {}} continue
4012 set pattern [lindex $patterns 0]
4014 if {[lindex $opt 1] eq "b"} {
4015 set val $newviewopts($n,[lindex $opt 0])
4017 lappend rargs $pattern
4019 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4020 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4021 set val $newviewopts($n,$button_id)
4022 if {$val eq $value} {
4023 lappend rargs $pattern
4026 set val $newviewopts($n,[lindex $opt 0])
4027 set val [string trim $val]
4029 set pfix [string range $pattern 0 end-1]
4030 lappend rargs $pfix$val
4034 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4035 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4038 # Fill $newviewopts($n, ...) based on args for git log.
4039 proc decode_view_opts {n view_args} {
4040 global known_view_options newviewopts
4042 foreach opt $known_view_options {
4043 set id [lindex $opt 0]
4044 if {[lindex $opt 1] eq "b"} {
4047 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4049 regexp {^(.*_)} $id uselessvar id
4055 set newviewopts($n,$id) $val
4059 foreach arg $view_args {
4060 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4061 && ![info exists found(limit)]} {
4062 set newviewopts($n,limit) $cnt
4067 foreach opt $known_view_options {
4068 set id [lindex $opt 0]
4069 if {[info exists found($id)]} continue
4070 foreach pattern [lindex $opt 3] {
4071 if {![string match $pattern $arg]} continue
4072 if {[lindex $opt 1] eq "b"} {
4075 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4077 regexp {^(.*_)} $id uselessvar id
4081 set size [string length $pattern]
4082 set val [string range $arg [expr {$size-1}] end]
4084 set newviewopts($n,$id) $val
4088 if {[info exists val]} break
4090 if {[info exists val]} continue
4091 if {[regexp {^-} $arg]} {
4094 lappend refargs $arg
4097 set newviewopts($n,refs) [shellarglist $refargs]
4098 set newviewopts($n,args) [shellarglist $oargs]
4101 proc edit_or_newview {} {
4113 global viewname viewperm newviewname newviewopts
4114 global viewargs viewargscmd
4116 set top .gitkvedit-$curview
4117 if {[winfo exists $top]} {
4121 decode_view_opts $curview $viewargs($curview)
4122 set newviewname($curview) $viewname($curview)
4123 set newviewopts($curview,perm) $viewperm($curview)
4124 set newviewopts($curview,cmd) $viewargscmd($curview)
4125 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4128 proc vieweditor {top n title} {
4129 global newviewname newviewopts viewfiles bgcolor
4130 global known_view_options NS
4133 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4134 make_transient $top .
4137 ${NS}::frame $top.nfr
4138 ${NS}::label $top.nl -text [mc "View Name"]
4139 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4140 pack $top.nfr -in $top -fill x -pady 5 -padx 3
4141 pack $top.nl -in $top.nfr -side left -padx {0 5}
4142 pack $top.name -in $top.nfr -side left -padx {0 25}
4148 foreach opt $known_view_options {
4149 set id [lindex $opt 0]
4150 set type [lindex $opt 1]
4151 set flags [lindex $opt 2]
4152 set title [eval [lindex $opt 4]]
4155 if {$flags eq "+" || $flags eq "*"} {
4156 set cframe $top.fr$cnt
4158 ${NS}::frame $cframe
4159 pack $cframe -in $top -fill x -pady 3 -padx 3
4160 set cexpand [expr {$flags eq "*"}]
4161 } elseif {$flags eq ".." || $flags eq "*."} {
4162 set cframe $top.fr$cnt
4164 ${NS}::frame $cframe
4165 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4166 set cexpand [expr {$flags eq "*."}]
4172 ${NS}::label $cframe.l_$id -text $title
4173 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4174 } elseif {$type eq "b"} {
4175 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4176 pack $cframe.c_$id -in $cframe -side left \
4177 -padx [list $lxpad 0] -expand $cexpand -anchor w
4178 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4179 regexp {^(.*_)} $id uselessvar button_id
4180 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4181 pack $cframe.c_$id -in $cframe -side left \
4182 -padx [list $lxpad 0] -expand $cexpand -anchor w
4183 } elseif {[regexp {^t(\d+)$} $type type sz]} {
4184 ${NS}::label $cframe.l_$id -text $title
4185 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4186 -textvariable newviewopts($n,$id)
4187 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4188 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4189 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4190 ${NS}::label $cframe.l_$id -text $title
4191 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4192 -textvariable newviewopts($n,$id)
4193 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4194 pack $cframe.e_$id -in $cframe -side top -fill x
4195 } elseif {$type eq "path"} {
4196 ${NS}::label $top.l -text $title
4197 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4198 text $top.t -width 40 -height 5 -background $bgcolor
4199 if {[info exists viewfiles($n)]} {
4200 foreach f $viewfiles($n) {
4201 $top.t insert end $f
4202 $top.t insert end "\n"
4204 $top.t delete {end - 1c} end
4205 $top.t mark set insert 0.0
4207 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4211 ${NS}::frame $top.buts
4212 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4213 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4214 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4215 bind $top <Control-Return> [list newviewok $top $n]
4216 bind $top <F5> [list newviewok $top $n 1]
4217 bind $top <Escape> [list destroy $top]
4218 grid $top.buts.ok $top.buts.apply $top.buts.can
4219 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4220 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4221 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4222 pack $top.buts -in $top -side top -fill x
4226 proc doviewmenu {m first cmd op argv} {
4227 set nmenu [$m index end]
4228 for {set i $first} {$i <= $nmenu} {incr i} {
4229 if {[$m entrycget $i -command] eq $cmd} {
4230 eval $m $op $i $argv
4236 proc allviewmenus {n op args} {
4239 doviewmenu .bar.view 5 [list showview $n] $op $args
4240 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4243 proc newviewok {top n {apply 0}} {
4244 global nextviewnum newviewperm newviewname newishighlight
4245 global viewname viewfiles viewperm selectedview curview
4246 global viewargs viewargscmd newviewopts viewhlmenu
4249 set newargs [encode_view_opts $n]
4251 error_popup "[mc "Error in commit selection arguments:"] $err" $top
4255 foreach f [split [$top.t get 0.0 end] "\n"] {
4256 set ft [string trim $f]
4261 if {![info exists viewfiles($n)]} {
4262 # creating a new view
4264 set viewname($n) $newviewname($n)
4265 set viewperm($n) $newviewopts($n,perm)
4266 set viewfiles($n) $files
4267 set viewargs($n) $newargs
4268 set viewargscmd($n) $newviewopts($n,cmd)
4270 if {!$newishighlight} {
4273 run addvhighlight $n
4276 # editing an existing view
4277 set viewperm($n) $newviewopts($n,perm)
4278 if {$newviewname($n) ne $viewname($n)} {
4279 set viewname($n) $newviewname($n)
4280 doviewmenu .bar.view 5 [list showview $n] \
4281 entryconf [list -label $viewname($n)]
4282 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4283 # entryconf [list -label $viewname($n) -value $viewname($n)]
4285 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4286 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4287 set viewfiles($n) $files
4288 set viewargs($n) $newargs
4289 set viewargscmd($n) $newviewopts($n,cmd)
4290 if {$curview == $n} {
4296 catch {destroy $top}
4300 global curview viewperm hlview selectedhlview
4302 if {$curview == 0} return
4303 if {[info exists hlview] && $hlview == $curview} {
4304 set selectedhlview [mc "None"]
4307 allviewmenus $curview delete
4308 set viewperm($curview) 0
4312 proc addviewmenu {n} {
4313 global viewname viewhlmenu
4315 .bar.view add radiobutton -label $viewname($n) \
4316 -command [list showview $n] -variable selectedview -value $n
4317 #$viewhlmenu add radiobutton -label $viewname($n) \
4318 # -command [list addvhighlight $n] -variable selectedhlview
4322 global curview cached_commitrow ordertok
4323 global displayorder parentlist rowidlist rowisopt rowfinal
4324 global colormap rowtextx nextcolor canvxmax
4325 global numcommits viewcomplete
4326 global selectedline currentid canv canvy0
4328 global pending_select mainheadid
4331 global hlview selectedhlview commitinterest
4333 if {$n == $curview} return
4335 set ymax [lindex [$canv cget -scrollregion] 3]
4336 set span [$canv yview]
4337 set ytop [expr {[lindex $span 0] * $ymax}]
4338 set ybot [expr {[lindex $span 1] * $ymax}]
4339 set yscreen [expr {($ybot - $ytop) / 2}]
4340 if {$selectedline ne {}} {
4341 set selid $currentid
4342 set y [yc $selectedline]
4343 if {$ytop < $y && $y < $ybot} {
4344 set yscreen [expr {$y - $ytop}]
4346 } elseif {[info exists pending_select]} {
4347 set selid $pending_select
4348 unset pending_select
4352 catch {unset treediffs}
4354 if {[info exists hlview] && $hlview == $n} {
4356 set selectedhlview [mc "None"]
4358 catch {unset commitinterest}
4359 catch {unset cached_commitrow}
4360 catch {unset ordertok}
4364 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4365 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4368 if {![info exists viewcomplete($n)]} {
4378 set numcommits $commitidx($n)
4380 catch {unset colormap}
4381 catch {unset rowtextx}
4383 set canvxmax [$canv cget -width]
4389 if {$selid ne {} && [commitinview $selid $n]} {
4390 set row [rowofcommit $selid]
4391 # try to get the selected row in the same position on the screen
4392 set ymax [lindex [$canv cget -scrollregion] 3]
4393 set ytop [expr {[yc $row] - $yscreen}]
4397 set yf [expr {$ytop * 1.0 / $ymax}]
4399 allcanvs yview moveto $yf
4403 } elseif {!$viewcomplete($n)} {
4404 reset_pending_select $selid
4406 reset_pending_select {}
4408 if {[commitinview $pending_select $curview]} {
4409 selectline [rowofcommit $pending_select] 1
4411 set row [first_real_row]
4412 if {$row < $numcommits} {
4417 if {!$viewcomplete($n)} {
4418 if {$numcommits == 0} {
4419 show_status [mc "Reading commits..."]
4421 } elseif {$numcommits == 0} {
4422 show_status [mc "No commits selected"]
4426 # Stuff relating to the highlighting facility
4428 proc ishighlighted {id} {
4429 global vhighlights fhighlights nhighlights rhighlights
4431 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4432 return $nhighlights($id)
4434 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4435 return $vhighlights($id)
4437 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4438 return $fhighlights($id)
4440 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4441 return $rhighlights($id)
4446 proc bolden {id font} {
4447 global canv linehtag currentid boldids need_redisplay markedid
4449 # need_redisplay = 1 means the display is stale and about to be redrawn
4450 if {$need_redisplay} return
4452 $canv itemconf $linehtag($id) -font $font
4453 if {[info exists currentid] && $id eq $currentid} {
4455 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4456 -outline {{}} -tags secsel \
4457 -fill [$canv cget -selectbackground]]
4460 if {[info exists markedid] && $id eq $markedid} {
4465 proc bolden_name {id font} {
4466 global canv2 linentag currentid boldnameids need_redisplay
4468 if {$need_redisplay} return
4469 lappend boldnameids $id
4470 $canv2 itemconf $linentag($id) -font $font
4471 if {[info exists currentid] && $id eq $currentid} {
4472 $canv2 delete secsel
4473 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4474 -outline {{}} -tags secsel \
4475 -fill [$canv2 cget -selectbackground]]
4484 foreach id $boldids {
4485 if {![ishighlighted $id]} {
4488 lappend stillbold $id
4491 set boldids $stillbold
4494 proc addvhighlight {n} {
4495 global hlview viewcomplete curview vhl_done commitidx
4497 if {[info exists hlview]} {
4501 if {$n != $curview && ![info exists viewcomplete($n)]} {
4504 set vhl_done $commitidx($hlview)
4505 if {$vhl_done > 0} {
4510 proc delvhighlight {} {
4511 global hlview vhighlights
4513 if {![info exists hlview]} return
4515 catch {unset vhighlights}
4519 proc vhighlightmore {} {
4520 global hlview vhl_done commitidx vhighlights curview
4522 set max $commitidx($hlview)
4523 set vr [visiblerows]
4524 set r0 [lindex $vr 0]
4525 set r1 [lindex $vr 1]
4526 for {set i $vhl_done} {$i < $max} {incr i} {
4527 set id [commitonrow $i $hlview]
4528 if {[commitinview $id $curview]} {
4529 set row [rowofcommit $id]
4530 if {$r0 <= $row && $row <= $r1} {
4531 if {![highlighted $row]} {
4532 bolden $id mainfontbold
4534 set vhighlights($id) 1
4542 proc askvhighlight {row id} {
4543 global hlview vhighlights iddrawn
4545 if {[commitinview $id $hlview]} {
4546 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4547 bolden $id mainfontbold
4549 set vhighlights($id) 1
4551 set vhighlights($id) 0
4555 proc hfiles_change {} {
4556 global highlight_files filehighlight fhighlights fh_serial
4557 global highlight_paths
4559 if {[info exists filehighlight]} {
4560 # delete previous highlights
4561 catch {close $filehighlight}
4563 catch {unset fhighlights}
4565 unhighlight_filelist
4567 set highlight_paths {}
4568 after cancel do_file_hl $fh_serial
4570 if {$highlight_files ne {}} {
4571 after 300 do_file_hl $fh_serial
4575 proc gdttype_change {name ix op} {
4576 global gdttype highlight_files findstring findpattern
4579 if {$findstring ne {}} {
4580 if {$gdttype eq [mc "containing:"]} {
4581 if {$highlight_files ne {}} {
4582 set highlight_files {}
4587 if {$findpattern ne {}} {
4591 set highlight_files $findstring
4596 # enable/disable findtype/findloc menus too
4599 proc find_change {name ix op} {
4600 global gdttype findstring highlight_files
4603 if {$gdttype eq [mc "containing:"]} {
4606 if {$highlight_files ne $findstring} {
4607 set highlight_files $findstring
4614 proc findcom_change args {
4615 global nhighlights boldnameids
4616 global findpattern findtype findstring gdttype
4619 # delete previous highlights, if any
4620 foreach id $boldnameids {
4621 bolden_name $id mainfont
4624 catch {unset nhighlights}
4627 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4629 } elseif {$findtype eq [mc "Regexp"]} {
4630 set findpattern $findstring
4632 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4634 set findpattern "*$e*"
4638 proc makepatterns {l} {
4641 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4642 if {[string index $ee end] eq "/"} {
4652 proc do_file_hl {serial} {
4653 global highlight_files filehighlight highlight_paths gdttype fhl_list
4654 global cdup findtype
4656 if {$gdttype eq [mc "touching paths:"]} {
4657 # If "exact" match then convert backslashes to forward slashes.
4658 # Most useful to support Windows-flavoured file paths.
4659 if {$findtype eq [mc "Exact"]} {
4660 set highlight_files [string map {"\\" "/"} $highlight_files]
4662 if {[catch {set paths [shellsplit $highlight_files]}]} return
4663 set highlight_paths [makepatterns $paths]
4665 set relative_paths {}
4666 foreach path $paths {
4667 lappend relative_paths [file join $cdup $path]
4669 set gdtargs [concat -- $relative_paths]
4670 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4671 set gdtargs [list "-S$highlight_files"]
4672 } elseif {$gdttype eq [mc "changing lines matching:"]} {
4673 set gdtargs [list "-G$highlight_files"]
4675 # must be "containing:", i.e. we're searching commit info
4678 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4679 set filehighlight [open $cmd r+]
4680 fconfigure $filehighlight -blocking 0
4681 filerun $filehighlight readfhighlight
4687 proc flushhighlights {} {
4688 global filehighlight fhl_list
4690 if {[info exists filehighlight]} {
4692 puts $filehighlight ""
4693 flush $filehighlight
4697 proc askfilehighlight {row id} {
4698 global filehighlight fhighlights fhl_list
4700 lappend fhl_list $id
4701 set fhighlights($id) -1
4702 puts $filehighlight $id
4705 proc readfhighlight {} {
4706 global filehighlight fhighlights curview iddrawn
4707 global fhl_list find_dirn
4709 if {![info exists filehighlight]} {
4713 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4714 set line [string trim $line]
4715 set i [lsearch -exact $fhl_list $line]
4716 if {$i < 0} continue
4717 for {set j 0} {$j < $i} {incr j} {
4718 set id [lindex $fhl_list $j]
4719 set fhighlights($id) 0
4721 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4722 if {$line eq {}} continue
4723 if {![commitinview $line $curview]} continue
4724 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4725 bolden $line mainfontbold
4727 set fhighlights($line) 1
4729 if {[eof $filehighlight]} {
4731 puts "oops, git diff-tree died"
4732 catch {close $filehighlight}
4736 if {[info exists find_dirn]} {
4742 proc doesmatch {f} {
4743 global findtype findpattern
4745 if {$findtype eq [mc "Regexp"]} {
4746 return [regexp $findpattern $f]
4747 } elseif {$findtype eq [mc "IgnCase"]} {
4748 return [string match -nocase $findpattern $f]
4750 return [string match $findpattern $f]
4754 proc askfindhighlight {row id} {
4755 global nhighlights commitinfo iddrawn
4757 global markingmatches
4759 if {![info exists commitinfo($id)]} {
4762 set info $commitinfo($id)
4764 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4765 foreach f $info ty $fldtypes {
4766 if {$ty eq ""} continue
4767 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4769 if {$ty eq [mc "Author"]} {
4776 if {$isbold && [info exists iddrawn($id)]} {
4777 if {![ishighlighted $id]} {
4778 bolden $id mainfontbold
4780 bolden_name $id mainfontbold
4783 if {$markingmatches} {
4784 markrowmatches $row $id
4787 set nhighlights($id) $isbold
4790 proc markrowmatches {row id} {
4791 global canv canv2 linehtag linentag commitinfo findloc
4793 set headline [lindex $commitinfo($id) 0]
4794 set author [lindex $commitinfo($id) 1]
4795 $canv delete match$row
4796 $canv2 delete match$row
4797 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4798 set m [findmatches $headline]
4800 markmatches $canv $row $headline $linehtag($id) $m \
4801 [$canv itemcget $linehtag($id) -font] $row
4804 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4805 set m [findmatches $author]
4807 markmatches $canv2 $row $author $linentag($id) $m \
4808 [$canv2 itemcget $linentag($id) -font] $row
4813 proc vrel_change {name ix op} {
4814 global highlight_related
4817 if {$highlight_related ne [mc "None"]} {
4822 # prepare for testing whether commits are descendents or ancestors of a
4823 proc rhighlight_sel {a} {
4824 global descendent desc_todo ancestor anc_todo
4825 global highlight_related
4827 catch {unset descendent}
4828 set desc_todo [list $a]
4829 catch {unset ancestor}
4830 set anc_todo [list $a]
4831 if {$highlight_related ne [mc "None"]} {
4837 proc rhighlight_none {} {
4840 catch {unset rhighlights}
4844 proc is_descendent {a} {
4845 global curview children descendent desc_todo
4848 set la [rowofcommit $a]
4852 for {set i 0} {$i < [llength $todo]} {incr i} {
4853 set do [lindex $todo $i]
4854 if {[rowofcommit $do] < $la} {
4855 lappend leftover $do
4858 foreach nk $children($v,$do) {
4859 if {![info exists descendent($nk)]} {
4860 set descendent($nk) 1
4868 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4872 set descendent($a) 0
4873 set desc_todo $leftover
4876 proc is_ancestor {a} {
4877 global curview parents ancestor anc_todo
4880 set la [rowofcommit $a]
4884 for {set i 0} {$i < [llength $todo]} {incr i} {
4885 set do [lindex $todo $i]
4886 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4887 lappend leftover $do
4890 foreach np $parents($v,$do) {
4891 if {![info exists ancestor($np)]} {
4900 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4905 set anc_todo $leftover
4908 proc askrelhighlight {row id} {
4909 global descendent highlight_related iddrawn rhighlights
4910 global selectedline ancestor
4912 if {$selectedline eq {}} return
4914 if {$highlight_related eq [mc "Descendant"] ||
4915 $highlight_related eq [mc "Not descendant"]} {
4916 if {![info exists descendent($id)]} {
4919 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4922 } elseif {$highlight_related eq [mc "Ancestor"] ||
4923 $highlight_related eq [mc "Not ancestor"]} {
4924 if {![info exists ancestor($id)]} {
4927 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4931 if {[info exists iddrawn($id)]} {
4932 if {$isbold && ![ishighlighted $id]} {
4933 bolden $id mainfontbold
4936 set rhighlights($id) $isbold
4939 # Graph layout functions
4941 proc shortids {ids} {
4944 if {[llength $id] > 1} {
4945 lappend res [shortids $id]
4946 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4947 lappend res [string range $id 0 7]
4958 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4959 if {($n & $mask) != 0} {
4960 set ret [concat $ret $o]
4962 set o [concat $o $o]
4967 proc ordertoken {id} {
4968 global ordertok curview varcid varcstart varctok curview parents children
4969 global nullid nullid2
4971 if {[info exists ordertok($id)]} {
4972 return $ordertok($id)
4977 if {[info exists varcid($curview,$id)]} {
4978 set a $varcid($curview,$id)
4979 set p [lindex $varcstart($curview) $a]
4981 set p [lindex $children($curview,$id) 0]
4983 if {[info exists ordertok($p)]} {
4984 set tok $ordertok($p)
4987 set id [first_real_child $curview,$p]
4990 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4993 if {[llength $parents($curview,$id)] == 1} {
4994 lappend todo [list $p {}]
4996 set j [lsearch -exact $parents($curview,$id) $p]
4998 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5000 lappend todo [list $p [strrep $j]]
5003 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5004 set p [lindex $todo $i 0]
5005 append tok [lindex $todo $i 1]
5006 set ordertok($p) $tok
5008 set ordertok($origid) $tok
5012 # Work out where id should go in idlist so that order-token
5013 # values increase from left to right
5014 proc idcol {idlist id {i 0}} {
5015 set t [ordertoken $id]
5019 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5020 if {$i > [llength $idlist]} {
5021 set i [llength $idlist]
5023 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5026 if {$t > [ordertoken [lindex $idlist $i]]} {
5027 while {[incr i] < [llength $idlist] &&
5028 $t >= [ordertoken [lindex $idlist $i]]} {}
5034 proc initlayout {} {
5035 global rowidlist rowisopt rowfinal displayorder parentlist
5036 global numcommits canvxmax canv
5038 global colormap rowtextx
5047 set canvxmax [$canv cget -width]
5048 catch {unset colormap}
5049 catch {unset rowtextx}
5053 proc setcanvscroll {} {
5054 global canv canv2 canv3 numcommits linespc canvxmax canvy0
5055 global lastscrollset lastscrollrows
5057 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5058 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5059 $canv2 conf -scrollregion [list 0 0 0 $ymax]
5060 $canv3 conf -scrollregion [list 0 0 0 $ymax]
5061 set lastscrollset [clock clicks -milliseconds]
5062 set lastscrollrows $numcommits
5065 proc visiblerows {} {
5066 global canv numcommits linespc
5068 set ymax [lindex [$canv cget -scrollregion] 3]
5069 if {$ymax eq {} || $ymax == 0} return
5071 set y0 [expr {int([lindex $f 0] * $ymax)}]
5072 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5076 set y1 [expr {int([lindex $f 1] * $ymax)}]
5077 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5078 if {$r1 >= $numcommits} {
5079 set r1 [expr {$numcommits - 1}]
5081 return [list $r0 $r1]
5084 proc layoutmore {} {
5085 global commitidx viewcomplete curview
5086 global numcommits pending_select curview
5087 global lastscrollset lastscrollrows
5089 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5090 [clock clicks -milliseconds] - $lastscrollset > 500} {
5093 if {[info exists pending_select] &&
5094 [commitinview $pending_select $curview]} {
5096 selectline [rowofcommit $pending_select] 1
5101 # With path limiting, we mightn't get the actual HEAD commit,
5102 # so ask git rev-list what is the first ancestor of HEAD that
5103 # touches a file in the path limit.
5104 proc get_viewmainhead {view} {
5105 global viewmainheadid vfilelimit viewinstances mainheadid
5108 set rfd [open [concat | git rev-list -1 $mainheadid \
5109 -- $vfilelimit($view)] r]
5110 set j [reg_instance $rfd]
5111 lappend viewinstances($view) $j
5112 fconfigure $rfd -blocking 0
5113 filerun $rfd [list getviewhead $rfd $j $view]
5114 set viewmainheadid($curview) {}
5118 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5119 proc getviewhead {fd inst view} {
5120 global viewmainheadid commfd curview viewinstances showlocalchanges
5123 if {[gets $fd line] < 0} {
5127 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5130 set viewmainheadid($view) $id
5133 set i [lsearch -exact $viewinstances($view) $inst]
5135 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5137 if {$showlocalchanges && $id ne {} && $view == $curview} {
5143 proc doshowlocalchanges {} {
5144 global curview viewmainheadid
5146 if {$viewmainheadid($curview) eq {}} return
5147 if {[commitinview $viewmainheadid($curview) $curview]} {
5150 interestedin $viewmainheadid($curview) dodiffindex
5154 proc dohidelocalchanges {} {
5155 global nullid nullid2 lserial curview
5157 if {[commitinview $nullid $curview]} {
5158 removefakerow $nullid
5160 if {[commitinview $nullid2 $curview]} {
5161 removefakerow $nullid2
5166 # spawn off a process to do git diff-index --cached HEAD
5167 proc dodiffindex {} {
5168 global lserial showlocalchanges vfilelimit curview
5171 if {!$showlocalchanges || !$hasworktree} return
5173 set cmd "|git diff-index --cached HEAD"
5174 if {$vfilelimit($curview) ne {}} {
5175 set cmd [concat $cmd -- $vfilelimit($curview)]
5177 set fd [open $cmd r]
5178 fconfigure $fd -blocking 0
5179 set i [reg_instance $fd]
5180 filerun $fd [list readdiffindex $fd $lserial $i]
5183 proc readdiffindex {fd serial inst} {
5184 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5188 if {[gets $fd line] < 0} {
5194 # we only need to see one line and we don't really care what it says...
5197 if {$serial != $lserial} {
5201 # now see if there are any local changes not checked in to the index
5202 set cmd "|git diff-files"
5203 if {$vfilelimit($curview) ne {}} {
5204 set cmd [concat $cmd -- $vfilelimit($curview)]
5206 set fd [open $cmd r]
5207 fconfigure $fd -blocking 0
5208 set i [reg_instance $fd]
5209 filerun $fd [list readdifffiles $fd $serial $i]
5211 if {$isdiff && ![commitinview $nullid2 $curview]} {
5212 # add the line for the changes in the index to the graph
5213 set hl [mc "Local changes checked in to index but not committed"]
5214 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5215 set commitdata($nullid2) "\n $hl\n"
5216 if {[commitinview $nullid $curview]} {
5217 removefakerow $nullid
5219 insertfakerow $nullid2 $viewmainheadid($curview)
5220 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5221 if {[commitinview $nullid $curview]} {
5222 removefakerow $nullid
5224 removefakerow $nullid2
5229 proc readdifffiles {fd serial inst} {
5230 global viewmainheadid nullid nullid2 curview
5231 global commitinfo commitdata lserial
5234 if {[gets $fd line] < 0} {
5240 # we only need to see one line and we don't really care what it says...
5243 if {$serial != $lserial} {
5247 if {$isdiff && ![commitinview $nullid $curview]} {
5248 # add the line for the local diff to the graph
5249 set hl [mc "Local uncommitted changes, not checked in to index"]
5250 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5251 set commitdata($nullid) "\n $hl\n"
5252 if {[commitinview $nullid2 $curview]} {
5255 set p $viewmainheadid($curview)
5257 insertfakerow $nullid $p
5258 } elseif {!$isdiff && [commitinview $nullid $curview]} {
5259 removefakerow $nullid
5264 proc nextuse {id row} {
5265 global curview children
5267 if {[info exists children($curview,$id)]} {
5268 foreach kid $children($curview,$id) {
5269 if {![commitinview $kid $curview]} {
5272 if {[rowofcommit $kid] > $row} {
5273 return [rowofcommit $kid]
5277 if {[commitinview $id $curview]} {
5278 return [rowofcommit $id]
5283 proc prevuse {id row} {
5284 global curview children
5287 if {[info exists children($curview,$id)]} {
5288 foreach kid $children($curview,$id) {
5289 if {![commitinview $kid $curview]} break
5290 if {[rowofcommit $kid] < $row} {
5291 set ret [rowofcommit $kid]
5298 proc make_idlist {row} {
5299 global displayorder parentlist uparrowlen downarrowlen mingaplen
5300 global commitidx curview children
5302 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5306 set ra [expr {$row - $downarrowlen}]
5310 set rb [expr {$row + $uparrowlen}]
5311 if {$rb > $commitidx($curview)} {
5312 set rb $commitidx($curview)
5314 make_disporder $r [expr {$rb + 1}]
5316 for {} {$r < $ra} {incr r} {
5317 set nextid [lindex $displayorder [expr {$r + 1}]]
5318 foreach p [lindex $parentlist $r] {
5319 if {$p eq $nextid} continue
5320 set rn [nextuse $p $r]
5322 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5323 lappend ids [list [ordertoken $p] $p]
5327 for {} {$r < $row} {incr r} {
5328 set nextid [lindex $displayorder [expr {$r + 1}]]
5329 foreach p [lindex $parentlist $r] {
5330 if {$p eq $nextid} continue
5331 set rn [nextuse $p $r]
5332 if {$rn < 0 || $rn >= $row} {
5333 lappend ids [list [ordertoken $p] $p]
5337 set id [lindex $displayorder $row]
5338 lappend ids [list [ordertoken $id] $id]
5340 foreach p [lindex $parentlist $r] {
5341 set firstkid [lindex $children($curview,$p) 0]
5342 if {[rowofcommit $firstkid] < $row} {
5343 lappend ids [list [ordertoken $p] $p]
5347 set id [lindex $displayorder $r]
5349 set firstkid [lindex $children($curview,$id) 0]
5350 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5351 lappend ids [list [ordertoken $id] $id]
5356 foreach idx [lsort -unique $ids] {
5357 lappend idlist [lindex $idx 1]
5362 proc rowsequal {a b} {
5363 while {[set i [lsearch -exact $a {}]] >= 0} {
5364 set a [lreplace $a $i $i]
5366 while {[set i [lsearch -exact $b {}]] >= 0} {
5367 set b [lreplace $b $i $i]
5369 return [expr {$a eq $b}]
5372 proc makeupline {id row rend col} {
5373 global rowidlist uparrowlen downarrowlen mingaplen
5375 for {set r $rend} {1} {set r $rstart} {
5376 set rstart [prevuse $id $r]
5377 if {$rstart < 0} return
5378 if {$rstart < $row} break
5380 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5381 set rstart [expr {$rend - $uparrowlen - 1}]
5383 for {set r $rstart} {[incr r] <= $row} {} {
5384 set idlist [lindex $rowidlist $r]
5385 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5386 set col [idcol $idlist $id $col]
5387 lset rowidlist $r [linsert $idlist $col $id]
5393 proc layoutrows {row endrow} {
5394 global rowidlist rowisopt rowfinal displayorder
5395 global uparrowlen downarrowlen maxwidth mingaplen
5396 global children parentlist
5397 global commitidx viewcomplete curview
5399 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5402 set rm1 [expr {$row - 1}]
5403 foreach id [lindex $rowidlist $rm1] {
5408 set final [lindex $rowfinal $rm1]
5410 for {} {$row < $endrow} {incr row} {
5411 set rm1 [expr {$row - 1}]
5412 if {$rm1 < 0 || $idlist eq {}} {
5413 set idlist [make_idlist $row]
5416 set id [lindex $displayorder $rm1]
5417 set col [lsearch -exact $idlist $id]
5418 set idlist [lreplace $idlist $col $col]
5419 foreach p [lindex $parentlist $rm1] {
5420 if {[lsearch -exact $idlist $p] < 0} {
5421 set col [idcol $idlist $p $col]
5422 set idlist [linsert $idlist $col $p]
5423 # if not the first child, we have to insert a line going up
5424 if {$id ne [lindex $children($curview,$p) 0]} {
5425 makeupline $p $rm1 $row $col
5429 set id [lindex $displayorder $row]
5430 if {$row > $downarrowlen} {
5431 set termrow [expr {$row - $downarrowlen - 1}]
5432 foreach p [lindex $parentlist $termrow] {
5433 set i [lsearch -exact $idlist $p]
5434 if {$i < 0} continue
5435 set nr [nextuse $p $termrow]
5436 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5437 set idlist [lreplace $idlist $i $i]
5441 set col [lsearch -exact $idlist $id]
5443 set col [idcol $idlist $id]
5444 set idlist [linsert $idlist $col $id]
5445 if {$children($curview,$id) ne {}} {
5446 makeupline $id $rm1 $row $col
5449 set r [expr {$row + $uparrowlen - 1}]
5450 if {$r < $commitidx($curview)} {
5452 foreach p [lindex $parentlist $r] {
5453 if {[lsearch -exact $idlist $p] >= 0} continue
5454 set fk [lindex $children($curview,$p) 0]
5455 if {[rowofcommit $fk] < $row} {
5456 set x [idcol $idlist $p $x]
5457 set idlist [linsert $idlist $x $p]
5460 if {[incr r] < $commitidx($curview)} {
5461 set p [lindex $displayorder $r]
5462 if {[lsearch -exact $idlist $p] < 0} {
5463 set fk [lindex $children($curview,$p) 0]
5464 if {$fk ne {} && [rowofcommit $fk] < $row} {
5465 set x [idcol $idlist $p $x]
5466 set idlist [linsert $idlist $x $p]
5472 if {$final && !$viewcomplete($curview) &&
5473 $row + $uparrowlen + $mingaplen + $downarrowlen
5474 >= $commitidx($curview)} {
5477 set l [llength $rowidlist]
5479 lappend rowidlist $idlist
5481 lappend rowfinal $final
5482 } elseif {$row < $l} {
5483 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5484 lset rowidlist $row $idlist
5487 lset rowfinal $row $final
5489 set pad [ntimes [expr {$row - $l}] {}]
5490 set rowidlist [concat $rowidlist $pad]
5491 lappend rowidlist $idlist
5492 set rowfinal [concat $rowfinal $pad]
5493 lappend rowfinal $final
5494 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5500 proc changedrow {row} {
5501 global displayorder iddrawn rowisopt need_redisplay
5503 set l [llength $rowisopt]
5505 lset rowisopt $row 0
5506 if {$row + 1 < $l} {
5507 lset rowisopt [expr {$row + 1}] 0
5508 if {$row + 2 < $l} {
5509 lset rowisopt [expr {$row + 2}] 0
5513 set id [lindex $displayorder $row]
5514 if {[info exists iddrawn($id)]} {
5515 set need_redisplay 1
5519 proc insert_pad {row col npad} {
5522 set pad [ntimes $npad {}]
5523 set idlist [lindex $rowidlist $row]
5524 set bef [lrange $idlist 0 [expr {$col - 1}]]
5525 set aft [lrange $idlist $col end]
5526 set i [lsearch -exact $aft {}]
5528 set aft [lreplace $aft $i $i]
5530 lset rowidlist $row [concat $bef $pad $aft]
5534 proc optimize_rows {row col endrow} {
5535 global rowidlist rowisopt displayorder curview children
5540 for {} {$row < $endrow} {incr row; set col 0} {
5541 if {[lindex $rowisopt $row]} continue
5543 set y0 [expr {$row - 1}]
5544 set ym [expr {$row - 2}]
5545 set idlist [lindex $rowidlist $row]
5546 set previdlist [lindex $rowidlist $y0]
5547 if {$idlist eq {} || $previdlist eq {}} continue
5549 set pprevidlist [lindex $rowidlist $ym]
5550 if {$pprevidlist eq {}} continue
5556 for {} {$col < [llength $idlist]} {incr col} {
5557 set id [lindex $idlist $col]
5558 if {[lindex $previdlist $col] eq $id} continue
5563 set x0 [lsearch -exact $previdlist $id]
5564 if {$x0 < 0} continue
5565 set z [expr {$x0 - $col}]
5569 set xm [lsearch -exact $pprevidlist $id]
5571 set z0 [expr {$xm - $x0}]
5575 # if row y0 is the first child of $id then it's not an arrow
5576 if {[lindex $children($curview,$id) 0] ne
5577 [lindex $displayorder $y0]} {
5581 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5582 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5585 # Looking at lines from this row to the previous row,
5586 # make them go straight up if they end in an arrow on
5587 # the previous row; otherwise make them go straight up
5589 if {$z < -1 || ($z < 0 && $isarrow)} {
5590 # Line currently goes left too much;
5591 # insert pads in the previous row, then optimize it
5592 set npad [expr {-1 - $z + $isarrow}]
5593 insert_pad $y0 $x0 $npad
5595 optimize_rows $y0 $x0 $row
5597 set previdlist [lindex $rowidlist $y0]
5598 set x0 [lsearch -exact $previdlist $id]
5599 set z [expr {$x0 - $col}]
5601 set pprevidlist [lindex $rowidlist $ym]
5602 set xm [lsearch -exact $pprevidlist $id]
5603 set z0 [expr {$xm - $x0}]
5605 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5606 # Line currently goes right too much;
5607 # insert pads in this line
5608 set npad [expr {$z - 1 + $isarrow}]
5609 insert_pad $row $col $npad
5610 set idlist [lindex $rowidlist $row]
5612 set z [expr {$x0 - $col}]
5615 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5616 # this line links to its first child on row $row-2
5617 set id [lindex $displayorder $ym]
5618 set xc [lsearch -exact $pprevidlist $id]
5620 set z0 [expr {$xc - $x0}]
5623 # avoid lines jigging left then immediately right
5624 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5625 insert_pad $y0 $x0 1
5627 optimize_rows $y0 $x0 $row
5628 set previdlist [lindex $rowidlist $y0]
5632 # Find the first column that doesn't have a line going right
5633 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5634 set id [lindex $idlist $col]
5635 if {$id eq {}} break
5636 set x0 [lsearch -exact $previdlist $id]
5638 # check if this is the link to the first child
5639 set kid [lindex $displayorder $y0]
5640 if {[lindex $children($curview,$id) 0] eq $kid} {
5641 # it is, work out offset to child
5642 set x0 [lsearch -exact $previdlist $kid]
5645 if {$x0 <= $col} break
5647 # Insert a pad at that column as long as it has a line and
5648 # isn't the last column
5649 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5650 set idlist [linsert $idlist $col {}]
5651 lset rowidlist $row $idlist
5659 global canvx0 linespc
5660 return [expr {$canvx0 + $col * $linespc}]
5664 global canvy0 linespc
5665 return [expr {$canvy0 + $row * $linespc}]
5668 proc linewidth {id} {
5669 global thickerline lthickness
5672 if {[info exists thickerline] && $id eq $thickerline} {
5673 set wid [expr {2 * $lthickness}]
5678 proc rowranges {id} {
5679 global curview children uparrowlen downarrowlen
5682 set kids $children($curview,$id)
5688 foreach child $kids {
5689 if {![commitinview $child $curview]} break
5690 set row [rowofcommit $child]
5691 if {![info exists prev]} {
5692 lappend ret [expr {$row + 1}]
5694 if {$row <= $prevrow} {
5695 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5697 # see if the line extends the whole way from prevrow to row
5698 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5699 [lsearch -exact [lindex $rowidlist \
5700 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5701 # it doesn't, see where it ends
5702 set r [expr {$prevrow + $downarrowlen}]
5703 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5704 while {[incr r -1] > $prevrow &&
5705 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5707 while {[incr r] <= $row &&
5708 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5712 # see where it starts up again
5713 set r [expr {$row - $uparrowlen}]
5714 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5715 while {[incr r] < $row &&
5716 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5718 while {[incr r -1] >= $prevrow &&
5719 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5725 if {$child eq $id} {
5734 proc drawlineseg {id row endrow arrowlow} {
5735 global rowidlist displayorder iddrawn linesegs
5736 global canv colormap linespc curview maxlinelen parentlist
5738 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5739 set le [expr {$row + 1}]
5742 set c [lsearch -exact [lindex $rowidlist $le] $id]
5748 set x [lindex $displayorder $le]
5753 if {[info exists iddrawn($x)] || $le == $endrow} {
5754 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5770 if {[info exists linesegs($id)]} {
5771 set lines $linesegs($id)
5773 set r0 [lindex $li 0]
5775 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5785 set li [lindex $lines [expr {$i-1}]]
5786 set r1 [lindex $li 1]
5787 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5792 set x [lindex $cols [expr {$le - $row}]]
5793 set xp [lindex $cols [expr {$le - 1 - $row}]]
5794 set dir [expr {$xp - $x}]
5796 set ith [lindex $lines $i 2]
5797 set coords [$canv coords $ith]
5798 set ah [$canv itemcget $ith -arrow]
5799 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5800 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5801 if {$x2 ne {} && $x - $x2 == $dir} {
5802 set coords [lrange $coords 0 end-2]
5805 set coords [list [xc $le $x] [yc $le]]
5808 set itl [lindex $lines [expr {$i-1}] 2]
5809 set al [$canv itemcget $itl -arrow]
5810 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5811 } elseif {$arrowlow} {
5812 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5813 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5817 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5818 for {set y $le} {[incr y -1] > $row} {} {
5820 set xp [lindex $cols [expr {$y - 1 - $row}]]
5821 set ndir [expr {$xp - $x}]
5822 if {$dir != $ndir || $xp < 0} {
5823 lappend coords [xc $y $x] [yc $y]
5829 # join parent line to first child
5830 set ch [lindex $displayorder $row]
5831 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5833 puts "oops: drawlineseg: child $ch not on row $row"
5834 } elseif {$xc != $x} {
5835 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5836 set d [expr {int(0.5 * $linespc)}]
5839 set x2 [expr {$x1 - $d}]
5841 set x2 [expr {$x1 + $d}]
5844 set y1 [expr {$y2 + $d}]
5845 lappend coords $x1 $y1 $x2 $y2
5846 } elseif {$xc < $x - 1} {
5847 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5848 } elseif {$xc > $x + 1} {
5849 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5853 lappend coords [xc $row $x] [yc $row]
5855 set xn [xc $row $xp]
5857 lappend coords $xn $yn
5861 set t [$canv create line $coords -width [linewidth $id] \
5862 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5865 set lines [linsert $lines $i [list $row $le $t]]
5867 $canv coords $ith $coords
5868 if {$arrow ne $ah} {
5869 $canv itemconf $ith -arrow $arrow
5871 lset lines $i 0 $row
5874 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5875 set ndir [expr {$xo - $xp}]
5876 set clow [$canv coords $itl]
5877 if {$dir == $ndir} {
5878 set clow [lrange $clow 2 end]
5880 set coords [concat $coords $clow]
5882 lset lines [expr {$i-1}] 1 $le
5884 # coalesce two pieces
5886 set b [lindex $lines [expr {$i-1}] 0]
5887 set e [lindex $lines $i 1]
5888 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5890 $canv coords $itl $coords
5891 if {$arrow ne $al} {
5892 $canv itemconf $itl -arrow $arrow
5896 set linesegs($id) $lines
5900 proc drawparentlinks {id row} {
5901 global rowidlist canv colormap curview parentlist
5902 global idpos linespc
5904 set rowids [lindex $rowidlist $row]
5905 set col [lsearch -exact $rowids $id]
5906 if {$col < 0} return
5907 set olds [lindex $parentlist $row]
5908 set row2 [expr {$row + 1}]
5909 set x [xc $row $col]
5912 set d [expr {int(0.5 * $linespc)}]
5913 set ymid [expr {$y + $d}]
5914 set ids [lindex $rowidlist $row2]
5915 # rmx = right-most X coord used
5918 set i [lsearch -exact $ids $p]
5920 puts "oops, parent $p of $id not in list"
5923 set x2 [xc $row2 $i]
5927 set j [lsearch -exact $rowids $p]
5929 # drawlineseg will do this one for us
5933 # should handle duplicated parents here...
5934 set coords [list $x $y]
5936 # if attaching to a vertical segment, draw a smaller
5937 # slant for visual distinctness
5940 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5942 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5944 } elseif {$i < $col && $i < $j} {
5945 # segment slants towards us already
5946 lappend coords [xc $row $j] $y
5948 if {$i < $col - 1} {
5949 lappend coords [expr {$x2 + $linespc}] $y
5950 } elseif {$i > $col + 1} {
5951 lappend coords [expr {$x2 - $linespc}] $y
5953 lappend coords $x2 $y2
5956 lappend coords $x2 $y2
5958 set t [$canv create line $coords -width [linewidth $p] \
5959 -fill $colormap($p) -tags lines.$p]
5963 if {$rmx > [lindex $idpos($id) 1]} {
5964 lset idpos($id) 1 $rmx
5969 proc drawlines {id} {
5972 $canv itemconf lines.$id -width [linewidth $id]
5975 proc drawcmittext {id row col} {
5976 global linespc canv canv2 canv3 fgcolor curview
5977 global cmitlisted commitinfo rowidlist parentlist
5978 global rowtextx idpos idtags idheads idotherrefs
5979 global linehtag linentag linedtag selectedline
5980 global canvxmax boldids boldnameids fgcolor markedid
5981 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5982 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5983 global circleoutlinecolor
5985 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5986 set listed $cmitlisted($curview,$id)
5987 if {$id eq $nullid} {
5988 set ofill $workingfilescirclecolor
5989 } elseif {$id eq $nullid2} {
5990 set ofill $indexcirclecolor
5991 } elseif {$id eq $mainheadid} {
5992 set ofill $mainheadcirclecolor
5994 set ofill [lindex $circlecolors $listed]
5996 set x [xc $row $col]
5998 set orad [expr {$linespc / 3}]
6000 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6001 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6002 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6003 } elseif {$listed == 3} {
6004 # triangle pointing left for left-side commits
6005 set t [$canv create polygon \
6006 [expr {$x - $orad}] $y \
6007 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6008 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6009 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6011 # triangle pointing right for right-side commits
6012 set t [$canv create polygon \
6013 [expr {$x + $orad - 1}] $y \
6014 [expr {$x - $orad}] [expr {$y - $orad}] \
6015 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6016 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6018 set circleitem($row) $t
6020 $canv bind $t <1> {selcanvline {} %x %y}
6021 set rmx [llength [lindex $rowidlist $row]]
6022 set olds [lindex $parentlist $row]
6024 set nextids [lindex $rowidlist [expr {$row + 1}]]
6026 set i [lsearch -exact $nextids $p]
6032 set xt [xc $row $rmx]
6033 set rowtextx($row) $xt
6034 set idpos($id) [list $x $xt $y]
6035 if {[info exists idtags($id)] || [info exists idheads($id)]
6036 || [info exists idotherrefs($id)]} {
6037 set xt [drawtags $id $x $xt $y]
6039 if {[lindex $commitinfo($id) 6] > 0} {
6040 set xt [drawnotesign $xt $y]
6042 set headline [lindex $commitinfo($id) 0]
6043 set name [lindex $commitinfo($id) 1]
6044 set date [lindex $commitinfo($id) 2]
6045 set date [formatdate $date]
6048 set isbold [ishighlighted $id]
6051 set font mainfontbold
6053 lappend boldnameids $id
6054 set nfont mainfontbold
6057 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6058 -text $headline -font $font -tags text]
6059 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6060 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6061 -text $name -font $nfont -tags text]
6062 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6063 -text $date -font mainfont -tags text]
6064 if {$selectedline == $row} {
6067 if {[info exists markedid] && $markedid eq $id} {
6070 set xr [expr {$xt + [font measure $font $headline]}]
6071 if {$xr > $canvxmax} {
6077 proc drawcmitrow {row} {
6078 global displayorder rowidlist nrows_drawn
6079 global iddrawn markingmatches
6080 global commitinfo numcommits
6081 global filehighlight fhighlights findpattern nhighlights
6082 global hlview vhighlights
6083 global highlight_related rhighlights
6085 if {$row >= $numcommits} return
6087 set id [lindex $displayorder $row]
6088 if {[info exists hlview] && ![info exists vhighlights($id)]} {
6089 askvhighlight $row $id
6091 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6092 askfilehighlight $row $id
6094 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6095 askfindhighlight $row $id
6097 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6098 askrelhighlight $row $id
6100 if {![info exists iddrawn($id)]} {
6101 set col [lsearch -exact [lindex $rowidlist $row] $id]
6103 puts "oops, row $row id $id not in list"
6106 if {![info exists commitinfo($id)]} {
6110 drawcmittext $id $row $col
6114 if {$markingmatches} {
6115 markrowmatches $row $id
6119 proc drawcommits {row {endrow {}}} {
6120 global numcommits iddrawn displayorder curview need_redisplay
6121 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6126 if {$endrow eq {}} {
6129 if {$endrow >= $numcommits} {
6130 set endrow [expr {$numcommits - 1}]
6133 set rl1 [expr {$row - $downarrowlen - 3}]
6137 set ro1 [expr {$row - 3}]
6141 set r2 [expr {$endrow + $uparrowlen + 3}]
6142 if {$r2 > $numcommits} {
6145 for {set r $rl1} {$r < $r2} {incr r} {
6146 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6150 set rl1 [expr {$r + 1}]
6156 optimize_rows $ro1 0 $r2
6157 if {$need_redisplay || $nrows_drawn > 2000} {
6161 # make the lines join to already-drawn rows either side
6162 set r [expr {$row - 1}]
6163 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6166 set er [expr {$endrow + 1}]
6167 if {$er >= $numcommits ||
6168 ![info exists iddrawn([lindex $displayorder $er])]} {
6171 for {} {$r <= $er} {incr r} {
6172 set id [lindex $displayorder $r]
6173 set wasdrawn [info exists iddrawn($id)]
6175 if {$r == $er} break
6176 set nextid [lindex $displayorder [expr {$r + 1}]]
6177 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6178 drawparentlinks $id $r
6180 set rowids [lindex $rowidlist $r]
6181 foreach lid $rowids {
6182 if {$lid eq {}} continue
6183 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6185 # see if this is the first child of any of its parents
6186 foreach p [lindex $parentlist $r] {
6187 if {[lsearch -exact $rowids $p] < 0} {
6188 # make this line extend up to the child
6189 set lineend($p) [drawlineseg $p $r $er 0]
6193 set lineend($lid) [drawlineseg $lid $r $er 1]
6199 proc undolayout {row} {
6200 global uparrowlen mingaplen downarrowlen
6201 global rowidlist rowisopt rowfinal need_redisplay
6203 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6207 if {[llength $rowidlist] > $r} {
6209 set rowidlist [lrange $rowidlist 0 $r]
6210 set rowfinal [lrange $rowfinal 0 $r]
6211 set rowisopt [lrange $rowisopt 0 $r]
6212 set need_redisplay 1
6217 proc drawvisible {} {
6218 global canv linespc curview vrowmod selectedline targetrow targetid
6219 global need_redisplay cscroll numcommits
6221 set fs [$canv yview]
6222 set ymax [lindex [$canv cget -scrollregion] 3]
6223 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6224 set f0 [lindex $fs 0]
6225 set f1 [lindex $fs 1]
6226 set y0 [expr {int($f0 * $ymax)}]
6227 set y1 [expr {int($f1 * $ymax)}]
6229 if {[info exists targetid]} {
6230 if {[commitinview $targetid $curview]} {
6231 set r [rowofcommit $targetid]
6232 if {$r != $targetrow} {
6233 # Fix up the scrollregion and change the scrolling position
6234 # now that our target row has moved.
6235 set diff [expr {($r - $targetrow) * $linespc}]
6238 set ymax [lindex [$canv cget -scrollregion] 3]
6241 set f0 [expr {$y0 / $ymax}]
6242 set f1 [expr {$y1 / $ymax}]
6243 allcanvs yview moveto $f0
6244 $cscroll set $f0 $f1
6245 set need_redisplay 1
6252 set row [expr {int(($y0 - 3) / $linespc) - 1}]
6253 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6254 if {$endrow >= $vrowmod($curview)} {
6255 update_arcrows $curview
6257 if {$selectedline ne {} &&
6258 $row <= $selectedline && $selectedline <= $endrow} {
6259 set targetrow $selectedline
6260 } elseif {[info exists targetid]} {
6261 set targetrow [expr {int(($row + $endrow) / 2)}]
6263 if {[info exists targetrow]} {
6264 if {$targetrow >= $numcommits} {
6265 set targetrow [expr {$numcommits - 1}]
6267 set targetid [commitonrow $targetrow]
6269 drawcommits $row $endrow
6272 proc clear_display {} {
6273 global iddrawn linesegs need_redisplay nrows_drawn
6274 global vhighlights fhighlights nhighlights rhighlights
6275 global linehtag linentag linedtag boldids boldnameids
6278 catch {unset iddrawn}
6279 catch {unset linesegs}
6280 catch {unset linehtag}
6281 catch {unset linentag}
6282 catch {unset linedtag}
6285 catch {unset vhighlights}
6286 catch {unset fhighlights}
6287 catch {unset nhighlights}
6288 catch {unset rhighlights}
6289 set need_redisplay 0
6293 proc findcrossings {id} {
6294 global rowidlist parentlist numcommits displayorder
6298 foreach {s e} [rowranges $id] {
6299 if {$e >= $numcommits} {
6300 set e [expr {$numcommits - 1}]
6302 if {$e <= $s} continue
6303 for {set row $e} {[incr row -1] >= $s} {} {
6304 set x [lsearch -exact [lindex $rowidlist $row] $id]
6306 set olds [lindex $parentlist $row]
6307 set kid [lindex $displayorder $row]
6308 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6309 if {$kidx < 0} continue
6310 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6312 set px [lsearch -exact $nextrow $p]
6313 if {$px < 0} continue
6314 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6315 if {[lsearch -exact $ccross $p] >= 0} continue
6316 if {$x == $px + ($kidx < $px? -1: 1)} {
6318 } elseif {[lsearch -exact $cross $p] < 0} {
6325 return [concat $ccross {{}} $cross]
6328 proc assigncolor {id} {
6329 global colormap colors nextcolor
6330 global parents children children curview
6332 if {[info exists colormap($id)]} return
6333 set ncolors [llength $colors]
6334 if {[info exists children($curview,$id)]} {
6335 set kids $children($curview,$id)
6339 if {[llength $kids] == 1} {
6340 set child [lindex $kids 0]
6341 if {[info exists colormap($child)]
6342 && [llength $parents($curview,$child)] == 1} {
6343 set colormap($id) $colormap($child)
6349 foreach x [findcrossings $id] {
6351 # delimiter between corner crossings and other crossings
6352 if {[llength $badcolors] >= $ncolors - 1} break
6353 set origbad $badcolors
6355 if {[info exists colormap($x)]
6356 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6357 lappend badcolors $colormap($x)
6360 if {[llength $badcolors] >= $ncolors} {
6361 set badcolors $origbad
6363 set origbad $badcolors
6364 if {[llength $badcolors] < $ncolors - 1} {
6365 foreach child $kids {
6366 if {[info exists colormap($child)]
6367 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6368 lappend badcolors $colormap($child)
6370 foreach p $parents($curview,$child) {
6371 if {[info exists colormap($p)]
6372 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6373 lappend badcolors $colormap($p)
6377 if {[llength $badcolors] >= $ncolors} {
6378 set badcolors $origbad
6381 for {set i 0} {$i <= $ncolors} {incr i} {
6382 set c [lindex $colors $nextcolor]
6383 if {[incr nextcolor] >= $ncolors} {
6386 if {[lsearch -exact $badcolors $c]} break
6388 set colormap($id) $c
6391 proc bindline {t id} {
6394 $canv bind $t <Enter> "lineenter %x %y $id"
6395 $canv bind $t <Motion> "linemotion %x %y $id"
6396 $canv bind $t <Leave> "lineleave $id"
6397 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6400 proc graph_pane_width {} {
6404 set g [.tf.histframe.pwclist sashpos 0]
6406 set g [.tf.histframe.pwclist sash coord 0]
6408 return [lindex $g 0]
6411 proc totalwidth {l font extra} {
6414 set tot [expr {$tot + [font measure $font $str] + $extra}]
6419 proc drawtags {id x xt y1} {
6420 global idtags idheads idotherrefs mainhead
6421 global linespc lthickness
6422 global canv rowtextx curview fgcolor bgcolor ctxbut
6423 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6424 global tagbgcolor tagfgcolor tagoutlinecolor
6433 set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6434 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6435 set extra [expr {$delta + $lthickness + $linespc}]
6437 if {[info exists idtags($id)]} {
6438 set marks $idtags($id)
6439 set ntags [llength $marks]
6440 if {$ntags > $maxtags ||
6441 [totalwidth $marks mainfont $extra] > $maxwidth} {
6442 # show just a single "n tags..." tag
6445 set marks [list "tag..."]
6447 set marks [list [format "%d tags..." $ntags]]
6452 if {[info exists idheads($id)]} {
6453 set marks [concat $marks $idheads($id)]
6454 set nheads [llength $idheads($id)]
6456 if {[info exists idotherrefs($id)]} {
6457 set marks [concat $marks $idotherrefs($id)]
6463 set yt [expr {$y1 - 0.5 * $linespc}]
6464 set yb [expr {$yt + $linespc - 1}]
6468 foreach tag $marks {
6470 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6471 set wid [font measure mainfontbold $tag]
6473 set wid [font measure mainfont $tag]
6477 set xt [expr {$xt + $wid + $extra}]
6479 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6480 -width $lthickness -fill $reflinecolor -tags tag.$id]
6482 foreach tag $marks x $xvals wid $wvals {
6483 set tag_quoted [string map {% %%} $tag]
6484 set xl [expr {$x + $delta}]
6485 set xr [expr {$x + $delta + $wid + $lthickness}]
6487 if {[incr ntags -1] >= 0} {
6489 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6490 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6491 -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6494 set tagclick [list showtags $id 1]
6496 set tagclick [list showtag $tag_quoted 1]
6498 $canv bind $t <1> $tagclick
6499 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6501 # draw a head or other ref
6502 if {[incr nheads -1] >= 0} {
6503 set col $headbgcolor
6504 if {$tag eq $mainhead} {
6505 set font mainfontbold
6510 set xl [expr {$xl - $delta/2}]
6511 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6512 -width 1 -outline black -fill $col -tags tag.$id
6513 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6514 set rwid [font measure mainfont $remoteprefix]
6515 set xi [expr {$x + 1}]
6516 set yti [expr {$yt + 1}]
6517 set xri [expr {$x + $rwid}]
6518 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6519 -width 0 -fill $remotebgcolor -tags tag.$id
6522 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6523 -font $font -tags [list tag.$id text]]
6525 $canv bind $t <1> $tagclick
6526 } elseif {$nheads >= 0} {
6527 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6533 proc drawnotesign {xt y} {
6534 global linespc canv fgcolor
6536 set orad [expr {$linespc / 3}]
6537 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6538 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6539 -fill yellow -outline $fgcolor -width 1 -tags circle]
6540 set xt [expr {$xt + $orad * 3}]
6544 proc xcoord {i level ln} {
6545 global canvx0 xspc1 xspc2
6547 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6548 if {$i > 0 && $i == $level} {
6549 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6550 } elseif {$i > $level} {
6551 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6556 proc show_status {msg} {
6560 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6561 -tags text -fill $fgcolor
6564 # Don't change the text pane cursor if it is currently the hand cursor,
6565 # showing that we are over a sha1 ID link.
6566 proc settextcursor {c} {
6567 global ctext curtextcursor
6569 if {[$ctext cget -cursor] == $curtextcursor} {
6570 $ctext config -cursor $c
6572 set curtextcursor $c
6575 proc nowbusy {what {name {}}} {
6576 global isbusy busyname statusw
6578 if {[array names isbusy] eq {}} {
6579 . config -cursor watch
6583 set busyname($what) $name
6585 $statusw conf -text $name
6589 proc notbusy {what} {
6590 global isbusy maincursor textcursor busyname statusw
6594 if {$busyname($what) ne {} &&
6595 [$statusw cget -text] eq $busyname($what)} {
6596 $statusw conf -text {}
6599 if {[array names isbusy] eq {}} {
6600 . config -cursor $maincursor
6601 settextcursor $textcursor
6605 proc findmatches {f} {
6606 global findtype findstring
6607 if {$findtype == [mc "Regexp"]} {
6608 set matches [regexp -indices -all -inline $findstring $f]
6611 if {$findtype == [mc "IgnCase"]} {
6612 set f [string tolower $f]
6613 set fs [string tolower $fs]
6617 set l [string length $fs]
6618 while {[set j [string first $fs $f $i]] >= 0} {
6619 lappend matches [list $j [expr {$j+$l-1}]]
6620 set i [expr {$j + $l}]
6626 proc dofind {{dirn 1} {wrap 1}} {
6627 global findstring findstartline findcurline selectedline numcommits
6628 global gdttype filehighlight fh_serial find_dirn findallowwrap
6630 if {[info exists find_dirn]} {
6631 if {$find_dirn == $dirn} return
6635 if {$findstring eq {} || $numcommits == 0} return
6636 if {$selectedline eq {}} {
6637 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6639 set findstartline $selectedline
6641 set findcurline $findstartline
6642 nowbusy finding [mc "Searching"]
6643 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6644 after cancel do_file_hl $fh_serial
6645 do_file_hl $fh_serial
6648 set findallowwrap $wrap
6652 proc stopfinding {} {
6653 global find_dirn findcurline fprogcoord
6655 if {[info exists find_dirn]} {
6666 global commitdata commitinfo numcommits findpattern findloc
6667 global findstartline findcurline findallowwrap
6668 global find_dirn gdttype fhighlights fprogcoord
6669 global curview varcorder vrownum varccommits vrowmod
6671 if {![info exists find_dirn]} {
6674 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6677 if {$find_dirn > 0} {
6679 if {$l >= $numcommits} {
6682 if {$l <= $findstartline} {
6683 set lim [expr {$findstartline + 1}]
6686 set moretodo $findallowwrap
6693 if {$l >= $findstartline} {
6694 set lim [expr {$findstartline - 1}]
6697 set moretodo $findallowwrap
6700 set n [expr {($lim - $l) * $find_dirn}]
6705 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6706 update_arcrows $curview
6710 set ai [bsearch $vrownum($curview) $l]
6711 set a [lindex $varcorder($curview) $ai]
6712 set arow [lindex $vrownum($curview) $ai]
6713 set ids [lindex $varccommits($curview,$a)]
6714 set arowend [expr {$arow + [llength $ids]}]
6715 if {$gdttype eq [mc "containing:"]} {
6716 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6717 if {$l < $arow || $l >= $arowend} {
6719 set a [lindex $varcorder($curview) $ai]
6720 set arow [lindex $vrownum($curview) $ai]
6721 set ids [lindex $varccommits($curview,$a)]
6722 set arowend [expr {$arow + [llength $ids]}]
6724 set id [lindex $ids [expr {$l - $arow}]]
6725 # shouldn't happen unless git log doesn't give all the commits...
6726 if {![info exists commitdata($id)] ||
6727 ![doesmatch $commitdata($id)]} {
6730 if {![info exists commitinfo($id)]} {
6733 set info $commitinfo($id)
6734 foreach f $info ty $fldtypes {
6735 if {$ty eq ""} continue
6736 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6745 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6746 if {$l < $arow || $l >= $arowend} {
6748 set a [lindex $varcorder($curview) $ai]
6749 set arow [lindex $vrownum($curview) $ai]
6750 set ids [lindex $varccommits($curview,$a)]
6751 set arowend [expr {$arow + [llength $ids]}]
6753 set id [lindex $ids [expr {$l - $arow}]]
6754 if {![info exists fhighlights($id)]} {
6755 # this sets fhighlights($id) to -1
6756 askfilehighlight $l $id
6758 if {$fhighlights($id) > 0} {
6762 if {$fhighlights($id) < 0} {
6765 set findcurline [expr {$l - $find_dirn}]
6770 if {$found || ($domore && !$moretodo)} {
6786 set findcurline [expr {$l - $find_dirn}]
6788 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6792 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6797 proc findselectline {l} {
6798 global findloc commentend ctext findcurline markingmatches gdttype
6800 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6803 if {$markingmatches &&
6804 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6805 # highlight the matches in the comments
6806 set f [$ctext get 1.0 $commentend]
6807 set matches [findmatches $f]
6808 foreach match $matches {
6809 set start [lindex $match 0]
6810 set end [expr {[lindex $match 1] + 1}]
6811 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6817 # mark the bits of a headline or author that match a find string
6818 proc markmatches {canv l str tag matches font row} {
6821 set bbox [$canv bbox $tag]
6822 set x0 [lindex $bbox 0]
6823 set y0 [lindex $bbox 1]
6824 set y1 [lindex $bbox 3]
6825 foreach match $matches {
6826 set start [lindex $match 0]
6827 set end [lindex $match 1]
6828 if {$start > $end} continue
6829 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6830 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6831 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6832 [expr {$x0+$xlen+2}] $y1 \
6833 -outline {} -tags [list match$l matches] -fill yellow]
6835 if {$row == $selectedline} {
6836 $canv raise $t secsel
6841 proc unmarkmatches {} {
6842 global markingmatches
6844 allcanvs delete matches
6845 set markingmatches 0
6849 proc selcanvline {w x y} {
6850 global canv canvy0 ctext linespc
6852 set ymax [lindex [$canv cget -scrollregion] 3]
6853 if {$ymax == {}} return
6854 set yfrac [lindex [$canv yview] 0]
6855 set y [expr {$y + $yfrac * $ymax}]
6856 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6861 set xmax [lindex [$canv cget -scrollregion] 2]
6862 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6863 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6869 proc commit_descriptor {p} {
6871 if {![info exists commitinfo($p)]} {
6875 if {[llength $commitinfo($p)] > 1} {
6876 set l [lindex $commitinfo($p) 0]
6881 # append some text to the ctext widget, and make any SHA1 ID
6882 # that we know about be a clickable link.
6883 proc appendwithlinks {text tags} {
6884 global ctext linknum curview
6886 set start [$ctext index "end - 1c"]
6887 $ctext insert end $text $tags
6888 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6892 set linkid [string range $text $s $e]
6894 $ctext tag delete link$linknum
6895 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6896 setlink $linkid link$linknum
6901 proc setlink {id lk} {
6902 global curview ctext pendinglinks
6905 if {[string range $id 0 1] eq "-g"} {
6906 set id [string range $id 2 end]
6910 if {[string length $id] < 40} {
6911 set matches [longid $id]
6912 if {[llength $matches] > 0} {
6913 if {[llength $matches] > 1} return
6915 set id [lindex $matches 0]
6918 set known [commitinview $id $curview]
6921 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6922 $ctext tag bind $lk <1> [list selbyid $id]
6923 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6924 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6926 lappend pendinglinks($id) $lk
6927 interestedin $id {makelink %P}
6931 proc appendshortlink {id {pre {}} {post {}}} {
6932 global ctext linknum
6934 $ctext insert end $pre
6935 $ctext tag delete link$linknum
6936 $ctext insert end [string range $id 0 7] link$linknum
6937 $ctext insert end $post
6938 setlink $id link$linknum
6942 proc makelink {id} {
6945 if {![info exists pendinglinks($id)]} return
6946 foreach lk $pendinglinks($id) {
6949 unset pendinglinks($id)
6952 proc linkcursor {w inc} {
6953 global linkentercount curtextcursor
6955 if {[incr linkentercount $inc] > 0} {
6956 $w configure -cursor hand2
6958 $w configure -cursor $curtextcursor
6959 if {$linkentercount < 0} {
6960 set linkentercount 0
6965 proc viewnextline {dir} {
6969 set ymax [lindex [$canv cget -scrollregion] 3]
6970 set wnow [$canv yview]
6971 set wtop [expr {[lindex $wnow 0] * $ymax}]
6972 set newtop [expr {$wtop + $dir * $linespc}]
6975 } elseif {$newtop > $ymax} {
6978 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6981 # add a list of tag or branch names at position pos
6982 # returns the number of names inserted
6983 proc appendrefs {pos ids var} {
6984 global ctext linknum curview $var maxrefs mainheadid
6986 if {[catch {$ctext index $pos}]} {
6989 $ctext conf -state normal
6990 $ctext delete $pos "$pos lineend"
6993 foreach tag [set $var\($id\)] {
6994 lappend tags [list $tag $id]
6999 set tags [lsort -index 0 -decreasing $tags]
7002 if {[llength $tags] > $maxrefs} {
7003 # If we are displaying heads, and there are too many,
7004 # see if there are some important heads to display.
7005 # Currently this means "master" and the current head.
7007 if {$var eq "idheads"} {
7010 set hname [lindex $ti 0]
7011 set id [lindex $ti 1]
7012 if {($hname eq "master" || $id eq $mainheadid) &&
7013 [llength $itags] < $maxrefs} {
7022 set str [mc "and many more"]
7027 $ctext insert $pos "$str ([llength $tags])"
7028 set nutags [llength $tags]
7033 set id [lindex $ti 1]
7036 $ctext tag delete $lk
7037 $ctext insert $pos $sep
7038 $ctext insert $pos [lindex $ti 0] $lk
7042 $ctext tag add wwrap "$pos linestart" "$pos lineend"
7043 $ctext conf -state disabled
7044 return [expr {[llength $tags] + $nutags}]
7047 # called when we have finished computing the nearby tags
7048 proc dispneartags {delay} {
7049 global selectedline currentid showneartags tagphase
7051 if {$selectedline eq {} || !$showneartags} return
7052 after cancel dispnexttag
7054 after 200 dispnexttag
7057 after idle dispnexttag
7062 proc dispnexttag {} {
7063 global selectedline currentid showneartags tagphase ctext
7065 if {$selectedline eq {} || !$showneartags} return
7066 switch -- $tagphase {
7068 set dtags [desctags $currentid]
7070 appendrefs precedes $dtags idtags
7074 set atags [anctags $currentid]
7076 appendrefs follows $atags idtags
7080 set dheads [descheads $currentid]
7081 if {$dheads ne {}} {
7082 if {[appendrefs branch $dheads idheads] > 1
7083 && [$ctext get "branch -3c"] eq "h"} {
7084 # turn "Branch" into "Branches"
7085 $ctext conf -state normal
7086 $ctext insert "branch -2c" "es"
7087 $ctext conf -state disabled
7092 if {[incr tagphase] <= 2} {
7093 after idle dispnexttag
7097 proc make_secsel {id} {
7098 global linehtag linentag linedtag canv canv2 canv3
7100 if {![info exists linehtag($id)]} return
7102 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7103 -tags secsel -fill [$canv cget -selectbackground]]
7105 $canv2 delete secsel
7106 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7107 -tags secsel -fill [$canv2 cget -selectbackground]]
7109 $canv3 delete secsel
7110 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7111 -tags secsel -fill [$canv3 cget -selectbackground]]
7115 proc make_idmark {id} {
7116 global linehtag canv fgcolor
7118 if {![info exists linehtag($id)]} return
7120 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7121 -tags markid -outline $fgcolor]
7125 proc selectline {l isnew {desired_loc {}}} {
7126 global canv ctext commitinfo selectedline
7127 global canvy0 linespc parents children curview
7128 global currentid sha1entry
7129 global commentend idtags linknum
7130 global mergemax numcommits pending_select
7131 global cmitmode showneartags allcommits
7132 global targetrow targetid lastscrollrows
7133 global autoselect autosellen jump_to_here
7135 catch {unset pending_select}
7140 if {$l < 0 || $l >= $numcommits} return
7141 set id [commitonrow $l]
7146 if {$lastscrollrows < $numcommits} {
7150 set y [expr {$canvy0 + $l * $linespc}]
7151 set ymax [lindex [$canv cget -scrollregion] 3]
7152 set ytop [expr {$y - $linespc - 1}]
7153 set ybot [expr {$y + $linespc + 1}]
7154 set wnow [$canv yview]
7155 set wtop [expr {[lindex $wnow 0] * $ymax}]
7156 set wbot [expr {[lindex $wnow 1] * $ymax}]
7157 set wh [expr {$wbot - $wtop}]
7159 if {$ytop < $wtop} {
7160 if {$ybot < $wtop} {
7161 set newtop [expr {$y - $wh / 2.0}]
7164 if {$newtop > $wtop - $linespc} {
7165 set newtop [expr {$wtop - $linespc}]
7168 } elseif {$ybot > $wbot} {
7169 if {$ytop > $wbot} {
7170 set newtop [expr {$y - $wh / 2.0}]
7172 set newtop [expr {$ybot - $wh}]
7173 if {$newtop < $wtop + $linespc} {
7174 set newtop [expr {$wtop + $linespc}]
7178 if {$newtop != $wtop} {
7182 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7189 addtohistory [list selbyid $id 0] savecmitpos
7192 $sha1entry delete 0 end
7193 $sha1entry insert 0 $id
7195 $sha1entry selection range 0 $autosellen
7199 $ctext conf -state normal
7202 if {![info exists commitinfo($id)]} {
7205 set info $commitinfo($id)
7206 set date [formatdate [lindex $info 2]]
7207 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
7208 set date [formatdate [lindex $info 4]]
7209 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
7210 if {[info exists idtags($id)]} {
7211 $ctext insert end [mc "Tags:"]
7212 foreach tag $idtags($id) {
7213 $ctext insert end " $tag"
7215 $ctext insert end "\n"
7219 set olds $parents($curview,$id)
7220 if {[llength $olds] > 1} {
7223 if {$np >= $mergemax} {
7228 $ctext insert end "[mc "Parent"]: " $tag
7229 appendwithlinks [commit_descriptor $p] {}
7234 append headers "[mc "Parent"]: [commit_descriptor $p]"
7238 foreach c $children($curview,$id) {
7239 append headers "[mc "Child"]: [commit_descriptor $c]"
7242 # make anything that looks like a SHA1 ID be a clickable link
7243 appendwithlinks $headers {}
7244 if {$showneartags} {
7245 if {![info exists allcommits]} {
7248 $ctext insert end "[mc "Branch"]: "
7249 $ctext mark set branch "end -1c"
7250 $ctext mark gravity branch left
7251 $ctext insert end "\n[mc "Follows"]: "
7252 $ctext mark set follows "end -1c"
7253 $ctext mark gravity follows left
7254 $ctext insert end "\n[mc "Precedes"]: "
7255 $ctext mark set precedes "end -1c"
7256 $ctext mark gravity precedes left
7257 $ctext insert end "\n"
7260 $ctext insert end "\n"
7261 set comment [lindex $info 5]
7262 if {[string first "\r" $comment] >= 0} {
7263 set comment [string map {"\r" "\n "} $comment]
7265 appendwithlinks $comment {comment}
7267 $ctext tag remove found 1.0 end
7268 $ctext conf -state disabled
7269 set commentend [$ctext index "end - 1c"]
7271 set jump_to_here $desired_loc
7272 init_flist [mc "Comments"]
7273 if {$cmitmode eq "tree"} {
7275 } elseif {[llength $olds] <= 1} {
7282 proc selfirstline {} {
7287 proc sellastline {} {
7290 set l [expr {$numcommits - 1}]
7294 proc selnextline {dir} {
7297 if {$selectedline eq {}} return
7298 set l [expr {$selectedline + $dir}]
7303 proc selnextpage {dir} {
7304 global canv linespc selectedline numcommits
7306 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7310 allcanvs yview scroll [expr {$dir * $lpp}] units
7312 if {$selectedline eq {}} return
7313 set l [expr {$selectedline + $dir * $lpp}]
7316 } elseif {$l >= $numcommits} {
7317 set l [expr $numcommits - 1]
7323 proc unselectline {} {
7324 global selectedline currentid
7327 catch {unset currentid}
7328 allcanvs delete secsel
7332 proc reselectline {} {
7335 if {$selectedline ne {}} {
7336 selectline $selectedline 0
7340 proc addtohistory {cmd {saveproc {}}} {
7341 global history historyindex curview
7345 set elt [list $curview $cmd $saveproc {}]
7346 if {$historyindex > 0
7347 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7351 if {$historyindex < [llength $history]} {
7352 set history [lreplace $history $historyindex end $elt]
7354 lappend history $elt
7357 if {$historyindex > 1} {
7358 .tf.bar.leftbut conf -state normal
7360 .tf.bar.leftbut conf -state disabled
7362 .tf.bar.rightbut conf -state disabled
7365 # save the scrolling position of the diff display pane
7366 proc save_position {} {
7367 global historyindex history
7369 if {$historyindex < 1} return
7370 set hi [expr {$historyindex - 1}]
7371 set fn [lindex $history $hi 2]
7373 lset history $hi 3 [eval $fn]
7377 proc unset_posvars {} {
7380 if {[info exists last_posvars]} {
7381 foreach {var val} $last_posvars {
7390 global curview last_posvars
7392 set view [lindex $elt 0]
7393 set cmd [lindex $elt 1]
7394 set pv [lindex $elt 3]
7395 if {$curview != $view} {
7399 foreach {var val} $pv {
7403 set last_posvars $pv
7408 global history historyindex
7411 if {$historyindex > 1} {
7413 incr historyindex -1
7414 godo [lindex $history [expr {$historyindex - 1}]]
7415 .tf.bar.rightbut conf -state normal
7417 if {$historyindex <= 1} {
7418 .tf.bar.leftbut conf -state disabled
7423 global history historyindex
7426 if {$historyindex < [llength $history]} {
7428 set cmd [lindex $history $historyindex]
7431 .tf.bar.leftbut conf -state normal
7433 if {$historyindex >= [llength $history]} {
7434 .tf.bar.rightbut conf -state disabled
7439 global treefilelist treeidlist diffids diffmergeid treepending
7440 global nullid nullid2
7443 catch {unset diffmergeid}
7444 if {![info exists treefilelist($id)]} {
7445 if {![info exists treepending]} {
7446 if {$id eq $nullid} {
7447 set cmd [list | git ls-files]
7448 } elseif {$id eq $nullid2} {
7449 set cmd [list | git ls-files --stage -t]
7451 set cmd [list | git ls-tree -r $id]
7453 if {[catch {set gtf [open $cmd r]}]} {
7457 set treefilelist($id) {}
7458 set treeidlist($id) {}
7459 fconfigure $gtf -blocking 0 -encoding binary
7460 filerun $gtf [list gettreeline $gtf $id]
7467 proc gettreeline {gtf id} {
7468 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7471 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7472 if {$diffids eq $nullid} {
7475 set i [string first "\t" $line]
7476 if {$i < 0} continue
7477 set fname [string range $line [expr {$i+1}] end]
7478 set line [string range $line 0 [expr {$i-1}]]
7479 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7480 set sha1 [lindex $line 2]
7481 lappend treeidlist($id) $sha1
7483 if {[string index $fname 0] eq "\""} {
7484 set fname [lindex $fname 0]
7486 set fname [encoding convertfrom $fname]
7487 lappend treefilelist($id) $fname
7490 return [expr {$nl >= 1000? 2: 1}]
7494 if {$cmitmode ne "tree"} {
7495 if {![info exists diffmergeid]} {
7496 gettreediffs $diffids
7498 } elseif {$id ne $diffids} {
7507 global treefilelist treeidlist diffids nullid nullid2
7508 global ctext_file_names ctext_file_lines
7509 global ctext commentend
7511 set i [lsearch -exact $treefilelist($diffids) $f]
7513 puts "oops, $f not in list for id $diffids"
7516 if {$diffids eq $nullid} {
7517 if {[catch {set bf [open $f r]} err]} {
7518 puts "oops, can't read $f: $err"
7522 set blob [lindex $treeidlist($diffids) $i]
7523 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7524 puts "oops, error reading blob $blob: $err"
7528 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7529 filerun $bf [list getblobline $bf $diffids]
7530 $ctext config -state normal
7531 clear_ctext $commentend
7532 lappend ctext_file_names $f
7533 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7534 $ctext insert end "\n"
7535 $ctext insert end "$f\n" filesep
7536 $ctext config -state disabled
7537 $ctext yview $commentend
7541 proc getblobline {bf id} {
7542 global diffids cmitmode ctext
7544 if {$id ne $diffids || $cmitmode ne "tree"} {
7548 $ctext config -state normal
7550 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7551 $ctext insert end "$line\n"
7554 global jump_to_here ctext_file_names commentend
7556 # delete last newline
7557 $ctext delete "end - 2c" "end - 1c"
7559 if {$jump_to_here ne {} &&
7560 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7561 set lnum [expr {[lindex $jump_to_here 1] +
7562 [lindex [split $commentend .] 0]}]
7563 mark_ctext_line $lnum
7565 $ctext config -state disabled
7568 $ctext config -state disabled
7569 return [expr {$nl >= 1000? 2: 1}]
7572 proc mark_ctext_line {lnum} {
7573 global ctext markbgcolor
7575 $ctext tag delete omark
7576 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7577 $ctext tag conf omark -background $markbgcolor
7581 proc mergediff {id} {
7583 global diffids treediffs
7584 global parents curview
7588 set treediffs($id) {}
7589 set np [llength $parents($curview,$id)]
7594 proc startdiff {ids} {
7595 global treediffs diffids treepending diffmergeid nullid nullid2
7599 catch {unset diffmergeid}
7600 if {![info exists treediffs($ids)] ||
7601 [lsearch -exact $ids $nullid] >= 0 ||
7602 [lsearch -exact $ids $nullid2] >= 0} {
7603 if {![info exists treepending]} {
7611 # If the filename (name) is under any of the passed filter paths
7612 # then return true to include the file in the listing.
7613 proc path_filter {filter name} {
7614 set worktree [gitworktree]
7616 set fq_p [file normalize $p]
7617 set fq_n [file normalize [file join $worktree $name]]
7618 if {[string match [file normalize $fq_p]* $fq_n]} {
7625 proc addtocflist {ids} {
7628 add_flist $treediffs($ids)
7632 proc diffcmd {ids flags} {
7633 global log_showroot nullid nullid2
7635 set i [lsearch -exact $ids $nullid]
7636 set j [lsearch -exact $ids $nullid2]
7638 if {[llength $ids] > 1 && $j < 0} {
7639 # comparing working directory with some specific revision
7640 set cmd [concat | git diff-index $flags]
7642 lappend cmd -R [lindex $ids 1]
7644 lappend cmd [lindex $ids 0]
7647 # comparing working directory with index
7648 set cmd [concat | git diff-files $flags]
7653 } elseif {$j >= 0} {
7654 set cmd [concat | git diff-index --cached $flags]
7655 if {[llength $ids] > 1} {
7656 # comparing index with specific revision
7658 lappend cmd -R [lindex $ids 1]
7660 lappend cmd [lindex $ids 0]
7663 # comparing index with HEAD
7667 if {$log_showroot} {
7668 lappend flags --root
7670 set cmd [concat | git diff-tree -r $flags $ids]
7675 proc gettreediffs {ids} {
7676 global treediff treepending limitdiffs vfilelimit curview
7678 set cmd [diffcmd $ids {--no-commit-id}]
7679 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7680 set cmd [concat $cmd -- $vfilelimit($curview)]
7682 if {[catch {set gdtf [open $cmd r]}]} return
7684 set treepending $ids
7686 fconfigure $gdtf -blocking 0 -encoding binary
7687 filerun $gdtf [list gettreediffline $gdtf $ids]
7690 proc gettreediffline {gdtf ids} {
7691 global treediff treediffs treepending diffids diffmergeid
7692 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7697 if {$perfile_attrs} {
7698 # cache_gitattr is slow, and even slower on win32 where we
7699 # have to invoke it for only about 30 paths at a time
7701 if {[tk windowingsystem] == "win32"} {
7705 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7706 set i [string first "\t" $line]
7708 set file [string range $line [expr {$i+1}] end]
7709 if {[string index $file 0] eq "\""} {
7710 set file [lindex $file 0]
7712 set file [encoding convertfrom $file]
7713 if {$file ne [lindex $treediff end]} {
7714 lappend treediff $file
7715 lappend sublist $file
7719 if {$perfile_attrs} {
7720 cache_gitattr encoding $sublist
7723 return [expr {$nr >= $max? 2: 1}]
7726 set treediffs($ids) $treediff
7728 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7730 } elseif {$ids != $diffids} {
7731 if {![info exists diffmergeid]} {
7732 gettreediffs $diffids
7740 # empty string or positive integer
7741 proc diffcontextvalidate {v} {
7742 return [regexp {^(|[1-9][0-9]*)$} $v]
7745 proc diffcontextchange {n1 n2 op} {
7746 global diffcontextstring diffcontext
7748 if {[string is integer -strict $diffcontextstring]} {
7749 if {$diffcontextstring >= 0} {
7750 set diffcontext $diffcontextstring
7756 proc changeignorespace {} {
7760 proc changeworddiff {name ix op} {
7764 proc initblobdiffvars {} {
7765 global diffencoding targetline diffnparents
7766 global diffinhdr currdiffsubmod diffseehere
7770 set diffencoding [get_path_encoding {}]
7771 set currdiffsubmod ""
7775 proc getblobdiffs {ids} {
7776 global blobdifffd diffids env
7781 global limitdiffs vfilelimit curview
7785 if {[package vcompare $git_version "1.6.1"] >= 0} {
7786 set textconv "--textconv"
7789 if {[package vcompare $git_version "1.6.6"] >= 0} {
7790 set submodule "--submodule"
7792 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
7796 if {$worddiff ne [mc "Line diff"]} {
7797 append cmd " --word-diff=porcelain"
7799 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7800 set cmd [concat $cmd -- $vfilelimit($curview)]
7802 if {[catch {set bdf [open $cmd r]} err]} {
7803 error_popup [mc "Error getting diffs: %s" $err]
7806 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7807 set blobdifffd($ids) $bdf
7809 filerun $bdf [list getblobdiffline $bdf $diffids]
7812 proc savecmitpos {} {
7813 global ctext cmitmode
7815 if {$cmitmode eq "tree"} {
7818 return [list target_scrollpos [$ctext index @0,0]]
7821 proc savectextpos {} {
7824 return [list target_scrollpos [$ctext index @0,0]]
7827 proc maybe_scroll_ctext {ateof} {
7828 global ctext target_scrollpos
7830 if {![info exists target_scrollpos]} return
7832 set nlines [expr {[winfo height $ctext]
7833 / [font metrics textfont -linespace]}]
7834 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7836 $ctext yview $target_scrollpos
7837 unset target_scrollpos
7840 proc setinlist {var i val} {
7843 while {[llength [set $var]] < $i} {
7846 if {[llength [set $var]] == $i} {
7853 proc makediffhdr {fname ids} {
7854 global ctext curdiffstart treediffs diffencoding
7855 global ctext_file_names jump_to_here targetline diffline
7857 set fname [encoding convertfrom $fname]
7858 set diffencoding [get_path_encoding $fname]
7859 set i [lsearch -exact $treediffs($ids) $fname]
7861 setinlist difffilestart $i $curdiffstart
7863 lset ctext_file_names end $fname
7864 set l [expr {(78 - [string length $fname]) / 2}]
7865 set pad [string range "----------------------------------------" 1 $l]
7866 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7868 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7869 set targetline [lindex $jump_to_here 1]
7874 proc blobdiffmaybeseehere {ateof} {
7876 if {$diffseehere >= 0} {
7877 mark_ctext_line [lindex [split $diffseehere .] 0]
7879 maybe_scroll_ctext ateof
7882 proc getblobdiffline {bdf ids} {
7883 global diffids blobdifffd
7887 $ctext conf -state normal
7888 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7889 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7893 parseblobdiffline $ids $line
7895 $ctext conf -state disabled
7896 blobdiffmaybeseehere [eof $bdf]
7901 return [expr {$nr >= 1000? 2: 1}]
7904 proc parseblobdiffline {ids line} {
7905 global ctext curdiffstart
7906 global diffnexthead diffnextnote difffilestart
7907 global ctext_file_names ctext_file_lines
7908 global diffinhdr treediffs mergemax diffnparents
7909 global diffencoding jump_to_here targetline diffline currdiffsubmod
7910 global worddiff diffseehere
7912 if {![string compare -length 5 "diff " $line]} {
7913 if {![regexp {^diff (--cc|--git) } $line m type]} {
7914 set line [encoding convertfrom $line]
7915 $ctext insert end "$line\n" hunksep
7918 # start of a new file
7920 $ctext insert end "\n"
7921 set curdiffstart [$ctext index "end - 1c"]
7922 lappend ctext_file_names ""
7923 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7924 $ctext insert end "\n" filesep
7926 if {$type eq "--cc"} {
7927 # start of a new file in a merge diff
7928 set fname [string range $line 10 end]
7929 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7930 lappend treediffs($ids) $fname
7931 add_flist [list $fname]
7935 set line [string range $line 11 end]
7936 # If the name hasn't changed the length will be odd,
7937 # the middle char will be a space, and the two bits either
7938 # side will be a/name and b/name, or "a/name" and "b/name".
7939 # If the name has changed we'll get "rename from" and
7940 # "rename to" or "copy from" and "copy to" lines following
7941 # this, and we'll use them to get the filenames.
7942 # This complexity is necessary because spaces in the
7943 # filename(s) don't get escaped.
7944 set l [string length $line]
7945 set i [expr {$l / 2}]
7946 if {!(($l & 1) && [string index $line $i] eq " " &&
7947 [string range $line 2 [expr {$i - 1}]] eq \
7948 [string range $line [expr {$i + 3}] end])} {
7951 # unescape if quoted and chop off the a/ from the front
7952 if {[string index $line 0] eq "\""} {
7953 set fname [string range [lindex $line 0] 2 end]
7955 set fname [string range $line 2 [expr {$i - 1}]]
7958 makediffhdr $fname $ids
7960 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7961 set fname [encoding convertfrom [string range $line 16 end]]
7962 $ctext insert end "\n"
7963 set curdiffstart [$ctext index "end - 1c"]
7964 lappend ctext_file_names $fname
7965 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7966 $ctext insert end "$line\n" filesep
7967 set i [lsearch -exact $treediffs($ids) $fname]
7969 setinlist difffilestart $i $curdiffstart
7972 } elseif {![string compare -length 2 "@@" $line]} {
7973 regexp {^@@+} $line ats
7974 set line [encoding convertfrom $diffencoding $line]
7975 $ctext insert end "$line\n" hunksep
7976 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7979 set diffnparents [expr {[string length $ats] - 1}]
7982 } elseif {![string compare -length 10 "Submodule " $line]} {
7983 # start of a new submodule
7984 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7985 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7987 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7989 if {$currdiffsubmod != $fname} {
7990 $ctext insert end "\n"; # Add newline after commit message
7992 set curdiffstart [$ctext index "end - 1c"]
7993 lappend ctext_file_names ""
7994 if {$currdiffsubmod != $fname} {
7995 lappend ctext_file_lines $fname
7996 makediffhdr $fname $ids
7997 set currdiffsubmod $fname
7998 $ctext insert end "\n$line\n" filesep
8000 $ctext insert end "$line\n" filesep
8002 } elseif {![string compare -length 3 " >" $line]} {
8003 set $currdiffsubmod ""
8004 set line [encoding convertfrom $diffencoding $line]
8005 $ctext insert end "$line\n" dresult
8006 } elseif {![string compare -length 3 " <" $line]} {
8007 set $currdiffsubmod ""
8008 set line [encoding convertfrom $diffencoding $line]
8009 $ctext insert end "$line\n" d0
8010 } elseif {$diffinhdr} {
8011 if {![string compare -length 12 "rename from " $line]} {
8012 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8013 if {[string index $fname 0] eq "\""} {
8014 set fname [lindex $fname 0]
8016 set fname [encoding convertfrom $fname]
8017 set i [lsearch -exact $treediffs($ids) $fname]
8019 setinlist difffilestart $i $curdiffstart
8021 } elseif {![string compare -length 10 $line "rename to "] ||
8022 ![string compare -length 8 $line "copy to "]} {
8023 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8024 if {[string index $fname 0] eq "\""} {
8025 set fname [lindex $fname 0]
8027 makediffhdr $fname $ids
8028 } elseif {[string compare -length 3 $line "---"] == 0} {
8031 } elseif {[string compare -length 3 $line "+++"] == 0} {
8035 $ctext insert end "$line\n" filesep
8038 set line [string map {\x1A ^Z} \
8039 [encoding convertfrom $diffencoding $line]]
8040 # parse the prefix - one ' ', '-' or '+' for each parent
8041 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8042 set tag [expr {$diffnparents > 1? "m": "d"}]
8043 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8044 set words_pre_markup ""
8045 set words_post_markup ""
8046 if {[string trim $prefix " -+"] eq {}} {
8047 # prefix only has " ", "-" and "+" in it: normal diff line
8048 set num [string first "-" $prefix]
8050 set line [string range $line 1 end]
8053 # removed line, first parent with line is $num
8054 if {$num >= $mergemax} {
8057 if {$dowords && $worddiff eq [mc "Markup words"]} {
8058 $ctext insert end "\[-$line-\]" $tag$num
8060 $ctext insert end "$line" $tag$num
8063 $ctext insert end "\n" $tag$num
8067 if {[string first "+" $prefix] >= 0} {
8069 lappend tags ${tag}result
8070 if {$diffnparents > 1} {
8071 set num [string first " " $prefix]
8073 if {$num >= $mergemax} {
8079 set words_pre_markup "{+"
8080 set words_post_markup "+}"
8082 if {$targetline ne {}} {
8083 if {$diffline == $targetline} {
8084 set diffseehere [$ctext index "end - 1 chars"]
8090 if {$dowords && $worddiff eq [mc "Markup words"]} {
8091 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8093 $ctext insert end "$line" $tags
8096 $ctext insert end "\n" $tags
8099 } elseif {$dowords && $prefix eq "~"} {
8100 $ctext insert end "\n" {}
8102 # "\ No newline at end of file",
8103 # or something else we don't recognize
8104 $ctext insert end "$line\n" hunksep
8109 proc changediffdisp {} {
8110 global ctext diffelide
8112 $ctext tag conf d0 -elide [lindex $diffelide 0]
8113 $ctext tag conf dresult -elide [lindex $diffelide 1]
8116 proc highlightfile {cline} {
8117 global cflist cflist_top
8119 if {![info exists cflist_top]} return
8121 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8122 $cflist tag add highlight $cline.0 "$cline.0 lineend"
8123 $cflist see $cline.0
8124 set cflist_top $cline
8127 proc highlightfile_for_scrollpos {topidx} {
8128 global cmitmode difffilestart
8130 if {$cmitmode eq "tree"} return
8131 if {![info exists difffilestart]} return
8133 set top [lindex [split $topidx .] 0]
8134 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8137 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8142 global difffilestart ctext cmitmode
8144 if {$cmitmode eq "tree"} return
8146 set here [$ctext index @0,0]
8147 foreach loc $difffilestart {
8148 if {[$ctext compare $loc >= $here]} {
8158 global difffilestart ctext cmitmode
8160 if {$cmitmode eq "tree"} return
8161 set here [$ctext index @0,0]
8162 foreach loc $difffilestart {
8163 if {[$ctext compare $loc > $here]} {
8170 proc clear_ctext {{first 1.0}} {
8171 global ctext smarktop smarkbot
8172 global ctext_file_names ctext_file_lines
8175 set l [lindex [split $first .] 0]
8176 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8179 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8182 $ctext delete $first end
8183 if {$first eq "1.0"} {
8184 catch {unset pendinglinks}
8186 set ctext_file_names {}
8187 set ctext_file_lines {}
8190 proc settabs {{firstab {}}} {
8191 global firsttabstop tabstop ctext have_tk85
8193 if {$firstab ne {} && $have_tk85} {
8194 set firsttabstop $firstab
8196 set w [font measure textfont "0"]
8197 if {$firsttabstop != 0} {
8198 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8199 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8200 } elseif {$have_tk85 || $tabstop != 8} {
8201 $ctext conf -tabs [expr {$tabstop * $w}]
8203 $ctext conf -tabs {}
8207 proc incrsearch {name ix op} {
8208 global ctext searchstring searchdirn
8210 if {[catch {$ctext index anchor}]} {
8211 # no anchor set, use start of selection, or of visible area
8212 set sel [$ctext tag ranges sel]
8214 $ctext mark set anchor [lindex $sel 0]
8215 } elseif {$searchdirn eq "-forwards"} {
8216 $ctext mark set anchor @0,0
8218 $ctext mark set anchor @0,[winfo height $ctext]
8221 if {$searchstring ne {}} {
8222 set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8225 set mend "$here + $mlen c"
8226 $ctext tag remove sel 1.0 end
8227 $ctext tag add sel $here $mend
8228 suppress_highlighting_file_for_current_scrollpos
8229 highlightfile_for_scrollpos $here
8232 rehighlight_search_results
8236 global sstring ctext searchstring searchdirn
8239 $sstring icursor end
8240 set searchdirn -forwards
8241 if {$searchstring ne {}} {
8242 set sel [$ctext tag ranges sel]
8244 set start "[lindex $sel 0] + 1c"
8245 } elseif {[catch {set start [$ctext index anchor]}]} {
8248 set match [$ctext search -count mlen -- $searchstring $start]
8249 $ctext tag remove sel 1.0 end
8255 suppress_highlighting_file_for_current_scrollpos
8256 highlightfile_for_scrollpos $match
8257 set mend "$match + $mlen c"
8258 $ctext tag add sel $match $mend
8259 $ctext mark unset anchor
8260 rehighlight_search_results
8264 proc dosearchback {} {
8265 global sstring ctext searchstring searchdirn
8268 $sstring icursor end
8269 set searchdirn -backwards
8270 if {$searchstring ne {}} {
8271 set sel [$ctext tag ranges sel]
8273 set start [lindex $sel 0]
8274 } elseif {[catch {set start [$ctext index anchor]}]} {
8275 set start @0,[winfo height $ctext]
8277 set match [$ctext search -backwards -count ml -- $searchstring $start]
8278 $ctext tag remove sel 1.0 end
8284 suppress_highlighting_file_for_current_scrollpos
8285 highlightfile_for_scrollpos $match
8286 set mend "$match + $ml c"
8287 $ctext tag add sel $match $mend
8288 $ctext mark unset anchor
8289 rehighlight_search_results
8293 proc rehighlight_search_results {} {
8294 global ctext searchstring
8296 $ctext tag remove found 1.0 end
8297 $ctext tag remove currentsearchhit 1.0 end
8299 if {$searchstring ne {}} {
8304 proc searchmark {first last} {
8305 global ctext searchstring
8307 set sel [$ctext tag ranges sel]
8311 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8312 if {$match eq {}} break
8313 set mend "$match + $mlen c"
8314 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8315 $ctext tag add currentsearchhit $match $mend
8317 $ctext tag add found $match $mend
8322 proc searchmarkvisible {doall} {
8323 global ctext smarktop smarkbot
8325 set topline [lindex [split [$ctext index @0,0] .] 0]
8326 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8327 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8328 # no overlap with previous
8329 searchmark $topline $botline
8330 set smarktop $topline
8331 set smarkbot $botline
8333 if {$topline < $smarktop} {
8334 searchmark $topline [expr {$smarktop-1}]
8335 set smarktop $topline
8337 if {$botline > $smarkbot} {
8338 searchmark [expr {$smarkbot+1}] $botline
8339 set smarkbot $botline
8344 proc suppress_highlighting_file_for_current_scrollpos {} {
8345 global ctext suppress_highlighting_file_for_this_scrollpos
8347 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8350 proc scrolltext {f0 f1} {
8351 global searchstring cmitmode ctext
8352 global suppress_highlighting_file_for_this_scrollpos
8354 set topidx [$ctext index @0,0]
8355 if {![info exists suppress_highlighting_file_for_this_scrollpos]
8356 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8357 highlightfile_for_scrollpos $topidx
8360 catch {unset suppress_highlighting_file_for_this_scrollpos}
8362 .bleft.bottom.sb set $f0 $f1
8363 if {$searchstring ne {}} {
8369 global linespc charspc canvx0 canvy0
8370 global xspc1 xspc2 lthickness
8372 set linespc [font metrics mainfont -linespace]
8373 set charspc [font measure mainfont "m"]
8374 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8375 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8376 set lthickness [expr {int($linespc / 9) + 1}]
8377 set xspc1(0) $linespc
8385 set ymax [lindex [$canv cget -scrollregion] 3]
8386 if {$ymax eq {} || $ymax == 0} return
8387 set span [$canv yview]
8390 allcanvs yview moveto [lindex $span 0]
8392 if {$selectedline ne {}} {
8393 selectline $selectedline 0
8394 allcanvs yview moveto [lindex $span 0]
8398 proc parsefont {f n} {
8401 set fontattr($f,family) [lindex $n 0]
8403 if {$s eq {} || $s == 0} {
8406 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8408 set fontattr($f,size) $s
8409 set fontattr($f,weight) normal
8410 set fontattr($f,slant) roman
8411 foreach style [lrange $n 2 end] {
8414 "bold" {set fontattr($f,weight) $style}
8416 "italic" {set fontattr($f,slant) $style}
8421 proc fontflags {f {isbold 0}} {
8424 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8425 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8426 -slant $fontattr($f,slant)]
8432 set n [list $fontattr($f,family) $fontattr($f,size)]
8433 if {$fontattr($f,weight) eq "bold"} {
8436 if {$fontattr($f,slant) eq "italic"} {
8442 proc incrfont {inc} {
8443 global mainfont textfont ctext canv cflist showrefstop
8444 global stopped entries fontattr
8447 set s $fontattr(mainfont,size)
8452 set fontattr(mainfont,size) $s
8453 font config mainfont -size $s
8454 font config mainfontbold -size $s
8455 set mainfont [fontname mainfont]
8456 set s $fontattr(textfont,size)
8461 set fontattr(textfont,size) $s
8462 font config textfont -size $s
8463 font config textfontbold -size $s
8464 set textfont [fontname textfont]
8471 global sha1entry sha1string
8472 if {[string length $sha1string] == 40} {
8473 $sha1entry delete 0 end
8477 proc sha1change {n1 n2 op} {
8478 global sha1string currentid sha1but
8479 if {$sha1string == {}
8480 || ([info exists currentid] && $sha1string == $currentid)} {
8485 if {[$sha1but cget -state] == $state} return
8486 if {$state == "normal"} {
8487 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8489 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8493 proc gotocommit {} {
8494 global sha1string tagids headids curview varcid
8496 if {$sha1string == {}
8497 || ([info exists currentid] && $sha1string == $currentid)} return
8498 if {[info exists tagids($sha1string)]} {
8499 set id $tagids($sha1string)
8500 } elseif {[info exists headids($sha1string)]} {
8501 set id $headids($sha1string)
8503 set id [string tolower $sha1string]
8504 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8505 set matches [longid $id]
8506 if {$matches ne {}} {
8507 if {[llength $matches] > 1} {
8508 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8511 set id [lindex $matches 0]
8514 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8515 error_popup [mc "Revision %s is not known" $sha1string]
8520 if {[commitinview $id $curview]} {
8521 selectline [rowofcommit $id] 1
8524 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8525 set msg [mc "SHA1 id %s is not known" $sha1string]
8527 set msg [mc "Revision %s is not in the current view" $sha1string]
8532 proc lineenter {x y id} {
8533 global hoverx hovery hoverid hovertimer
8534 global commitinfo canv
8536 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8540 if {[info exists hovertimer]} {
8541 after cancel $hovertimer
8543 set hovertimer [after 500 linehover]
8547 proc linemotion {x y id} {
8548 global hoverx hovery hoverid hovertimer
8550 if {[info exists hoverid] && $id == $hoverid} {
8553 if {[info exists hovertimer]} {
8554 after cancel $hovertimer
8556 set hovertimer [after 500 linehover]
8560 proc lineleave {id} {
8561 global hoverid hovertimer canv
8563 if {[info exists hoverid] && $id == $hoverid} {
8565 if {[info exists hovertimer]} {
8566 after cancel $hovertimer
8574 global hoverx hovery hoverid hovertimer
8575 global canv linespc lthickness
8576 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8580 set text [lindex $commitinfo($hoverid) 0]
8581 set ymax [lindex [$canv cget -scrollregion] 3]
8582 if {$ymax == {}} return
8583 set yfrac [lindex [$canv yview] 0]
8584 set x [expr {$hoverx + 2 * $linespc}]
8585 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8586 set x0 [expr {$x - 2 * $lthickness}]
8587 set y0 [expr {$y - 2 * $lthickness}]
8588 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8589 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8590 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8591 -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8592 -width 1 -tags hover]
8594 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8595 -font mainfont -fill $linehoverfgcolor]
8599 proc clickisonarrow {id y} {
8602 set ranges [rowranges $id]
8603 set thresh [expr {2 * $lthickness + 6}]
8604 set n [expr {[llength $ranges] - 1}]
8605 for {set i 1} {$i < $n} {incr i} {
8606 set row [lindex $ranges $i]
8607 if {abs([yc $row] - $y) < $thresh} {
8614 proc arrowjump {id n y} {
8617 # 1 <-> 2, 3 <-> 4, etc...
8618 set n [expr {(($n - 1) ^ 1) + 1}]
8619 set row [lindex [rowranges $id] $n]
8621 set ymax [lindex [$canv cget -scrollregion] 3]
8622 if {$ymax eq {} || $ymax <= 0} return
8623 set view [$canv yview]
8624 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8625 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8629 allcanvs yview moveto $yfrac
8632 proc lineclick {x y id isnew} {
8633 global ctext commitinfo children canv thickerline curview
8635 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8640 # draw this line thicker than normal
8644 set ymax [lindex [$canv cget -scrollregion] 3]
8645 if {$ymax eq {}} return
8646 set yfrac [lindex [$canv yview] 0]
8647 set y [expr {$y + $yfrac * $ymax}]
8649 set dirn [clickisonarrow $id $y]
8651 arrowjump $id $dirn $y
8656 addtohistory [list lineclick $x $y $id 0] savectextpos
8658 # fill the details pane with info about this line
8659 $ctext conf -state normal
8662 $ctext insert end "[mc "Parent"]:\t"
8663 $ctext insert end $id link0
8665 set info $commitinfo($id)
8666 $ctext insert end "\n\t[lindex $info 0]\n"
8667 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8668 set date [formatdate [lindex $info 2]]
8669 $ctext insert end "\t[mc "Date"]:\t$date\n"
8670 set kids $children($curview,$id)
8672 $ctext insert end "\n[mc "Children"]:"
8674 foreach child $kids {
8676 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8677 set info $commitinfo($child)
8678 $ctext insert end "\n\t"
8679 $ctext insert end $child link$i
8680 setlink $child link$i
8681 $ctext insert end "\n\t[lindex $info 0]"
8682 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8683 set date [formatdate [lindex $info 2]]
8684 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8687 maybe_scroll_ctext 1
8688 $ctext conf -state disabled
8692 proc normalline {} {
8694 if {[info exists thickerline]} {
8701 proc selbyid {id {isnew 1}} {
8703 if {[commitinview $id $curview]} {
8704 selectline [rowofcommit $id] $isnew
8710 if {![info exists startmstime]} {
8711 set startmstime [clock clicks -milliseconds]
8713 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8716 proc rowmenu {x y id} {
8717 global rowctxmenu selectedline rowmenuid curview
8718 global nullid nullid2 fakerowmenu mainhead markedid
8722 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8727 if {[info exists markedid] && $markedid ne $id} {
8732 if {$id ne $nullid && $id ne $nullid2} {
8733 set menu $rowctxmenu
8734 if {$mainhead ne {}} {
8735 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8737 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8739 $menu entryconfigure 9 -state $mstate
8740 $menu entryconfigure 10 -state $mstate
8741 $menu entryconfigure 11 -state $mstate
8743 set menu $fakerowmenu
8745 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8746 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8747 $menu entryconfigure [mca "Make patch"] -state $state
8748 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8749 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8750 tk_popup $menu $x $y
8754 global rowmenuid markedid canv
8756 set markedid $rowmenuid
8757 make_idmark $markedid
8763 if {[info exists markedid]} {
8768 proc replace_by_kids {l r} {
8769 global curview children
8771 set id [commitonrow $r]
8772 set l [lreplace $l 0 0]
8773 foreach kid $children($curview,$id) {
8774 lappend l [rowofcommit $kid]
8776 return [lsort -integer -decreasing -unique $l]
8779 proc find_common_desc {} {
8780 global markedid rowmenuid curview children
8782 if {![info exists markedid]} return
8783 if {![commitinview $markedid $curview] ||
8784 ![commitinview $rowmenuid $curview]} return
8785 #set t1 [clock clicks -milliseconds]
8786 set l1 [list [rowofcommit $markedid]]
8787 set l2 [list [rowofcommit $rowmenuid]]
8789 set r1 [lindex $l1 0]
8790 set r2 [lindex $l2 0]
8791 if {$r1 eq {} || $r2 eq {}} break
8797 set l1 [replace_by_kids $l1 $r1]
8799 set l2 [replace_by_kids $l2 $r2]
8802 #set t2 [clock clicks -milliseconds]
8803 #puts "took [expr {$t2-$t1}]ms"
8806 proc compare_commits {} {
8807 global markedid rowmenuid curview children
8809 if {![info exists markedid]} return
8810 if {![commitinview $markedid $curview]} return
8811 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8812 do_cmp_commits $markedid $rowmenuid
8815 proc getpatchid {id} {
8818 if {![info exists patchids($id)]} {
8819 set cmd [diffcmd [list $id] {-p --root}]
8820 # trim off the initial "|"
8821 set cmd [lrange $cmd 1 end]
8823 set x [eval exec $cmd | git patch-id]
8824 set patchids($id) [lindex $x 0]
8826 set patchids($id) "error"
8829 return $patchids($id)
8832 proc do_cmp_commits {a b} {
8833 global ctext curview parents children patchids commitinfo
8835 $ctext conf -state normal
8838 for {set i 0} {$i < 100} {incr i} {
8841 if {[llength $parents($curview,$a)] > 1} {
8842 appendshortlink $a [mc "Skipping merge commit "] "\n"
8845 set patcha [getpatchid $a]
8847 if {[llength $parents($curview,$b)] > 1} {
8848 appendshortlink $b [mc "Skipping merge commit "] "\n"
8851 set patchb [getpatchid $b]
8853 if {!$skipa && !$skipb} {
8854 set heada [lindex $commitinfo($a) 0]
8855 set headb [lindex $commitinfo($b) 0]
8856 if {$patcha eq "error"} {
8857 appendshortlink $a [mc "Error getting patch ID for "] \
8858 [mc " - stopping\n"]
8861 if {$patchb eq "error"} {
8862 appendshortlink $b [mc "Error getting patch ID for "] \
8863 [mc " - stopping\n"]
8866 if {$patcha eq $patchb} {
8867 if {$heada eq $headb} {
8868 appendshortlink $a [mc "Commit "]
8869 appendshortlink $b " == " " $heada\n"
8871 appendshortlink $a [mc "Commit "] " $heada\n"
8872 appendshortlink $b [mc " is the same patch as\n "] \
8878 $ctext insert end "\n"
8879 appendshortlink $a [mc "Commit "] " $heada\n"
8880 appendshortlink $b [mc " differs from\n "] \
8882 $ctext insert end [mc "Diff of commits:\n\n"]
8883 $ctext conf -state disabled
8890 set kids [real_children $curview,$a]
8891 if {[llength $kids] != 1} {
8892 $ctext insert end "\n"
8893 appendshortlink $a [mc "Commit "] \
8894 [mc " has %s children - stopping\n" [llength $kids]]
8897 set a [lindex $kids 0]
8900 set kids [real_children $curview,$b]
8901 if {[llength $kids] != 1} {
8902 appendshortlink $b [mc "Commit "] \
8903 [mc " has %s children - stopping\n" [llength $kids]]
8906 set b [lindex $kids 0]
8909 $ctext conf -state disabled
8912 proc diffcommits {a b} {
8913 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8915 set tmpdir [gitknewtmpdir]
8916 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8917 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8919 exec git diff-tree -p --pretty $a >$fna
8920 exec git diff-tree -p --pretty $b >$fnb
8922 error_popup [mc "Error writing commit to file: %s" $err]
8926 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8928 error_popup [mc "Error diffing commits: %s" $err]
8931 set diffids [list commits $a $b]
8932 set blobdifffd($diffids) $fd
8934 set currdiffsubmod ""
8935 filerun $fd [list getblobdiffline $fd $diffids]
8938 proc diffvssel {dirn} {
8939 global rowmenuid selectedline
8941 if {$selectedline eq {}} return
8943 set oldid [commitonrow $selectedline]
8944 set newid $rowmenuid
8946 set oldid $rowmenuid
8947 set newid [commitonrow $selectedline]
8949 addtohistory [list doseldiff $oldid $newid] savectextpos
8950 doseldiff $oldid $newid
8953 proc diffvsmark {dirn} {
8954 global rowmenuid markedid
8956 if {![info exists markedid]} return
8959 set newid $rowmenuid
8961 set oldid $rowmenuid
8964 addtohistory [list doseldiff $oldid $newid] savectextpos
8965 doseldiff $oldid $newid
8968 proc doseldiff {oldid newid} {
8972 $ctext conf -state normal
8974 init_flist [mc "Top"]
8975 $ctext insert end "[mc "From"] "
8976 $ctext insert end $oldid link0
8977 setlink $oldid link0
8978 $ctext insert end "\n "
8979 $ctext insert end [lindex $commitinfo($oldid) 0]
8980 $ctext insert end "\n\n[mc "To"] "
8981 $ctext insert end $newid link1
8982 setlink $newid link1
8983 $ctext insert end "\n "
8984 $ctext insert end [lindex $commitinfo($newid) 0]
8985 $ctext insert end "\n"
8986 $ctext conf -state disabled
8987 $ctext tag remove found 1.0 end
8988 startdiff [list $oldid $newid]
8992 global rowmenuid currentid commitinfo patchtop patchnum NS
8994 if {![info exists currentid]} return
8995 set oldid $currentid
8996 set oldhead [lindex $commitinfo($oldid) 0]
8997 set newid $rowmenuid
8998 set newhead [lindex $commitinfo($newid) 0]
9001 catch {destroy $top}
9003 make_transient $top .
9004 ${NS}::label $top.title -text [mc "Generate patch"]
9005 grid $top.title - -pady 10
9006 ${NS}::label $top.from -text [mc "From:"]
9007 ${NS}::entry $top.fromsha1 -width 40
9008 $top.fromsha1 insert 0 $oldid
9009 $top.fromsha1 conf -state readonly
9010 grid $top.from $top.fromsha1 -sticky w
9011 ${NS}::entry $top.fromhead -width 60
9012 $top.fromhead insert 0 $oldhead
9013 $top.fromhead conf -state readonly
9014 grid x $top.fromhead -sticky w
9015 ${NS}::label $top.to -text [mc "To:"]
9016 ${NS}::entry $top.tosha1 -width 40
9017 $top.tosha1 insert 0 $newid
9018 $top.tosha1 conf -state readonly
9019 grid $top.to $top.tosha1 -sticky w
9020 ${NS}::entry $top.tohead -width 60
9021 $top.tohead insert 0 $newhead
9022 $top.tohead conf -state readonly
9023 grid x $top.tohead -sticky w
9024 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9025 grid $top.rev x -pady 10 -padx 5
9026 ${NS}::label $top.flab -text [mc "Output file:"]
9027 ${NS}::entry $top.fname -width 60
9028 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9030 grid $top.flab $top.fname -sticky w
9031 ${NS}::frame $top.buts
9032 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9033 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9034 bind $top <Key-Return> mkpatchgo
9035 bind $top <Key-Escape> mkpatchcan
9036 grid $top.buts.gen $top.buts.can
9037 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9038 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9039 grid $top.buts - -pady 10 -sticky ew
9043 proc mkpatchrev {} {
9046 set oldid [$patchtop.fromsha1 get]
9047 set oldhead [$patchtop.fromhead get]
9048 set newid [$patchtop.tosha1 get]
9049 set newhead [$patchtop.tohead get]
9050 foreach e [list fromsha1 fromhead tosha1 tohead] \
9051 v [list $newid $newhead $oldid $oldhead] {
9052 $patchtop.$e conf -state normal
9053 $patchtop.$e delete 0 end
9054 $patchtop.$e insert 0 $v
9055 $patchtop.$e conf -state readonly
9060 global patchtop nullid nullid2
9062 set oldid [$patchtop.fromsha1 get]
9063 set newid [$patchtop.tosha1 get]
9064 set fname [$patchtop.fname get]
9065 set cmd [diffcmd [list $oldid $newid] -p]
9066 # trim off the initial "|"
9067 set cmd [lrange $cmd 1 end]
9068 lappend cmd >$fname &
9069 if {[catch {eval exec $cmd} err]} {
9070 error_popup "[mc "Error creating patch:"] $err" $patchtop
9072 catch {destroy $patchtop}
9076 proc mkpatchcan {} {
9079 catch {destroy $patchtop}
9084 global rowmenuid mktagtop commitinfo NS
9088 catch {destroy $top}
9090 make_transient $top .
9091 ${NS}::label $top.title -text [mc "Create tag"]
9092 grid $top.title - -pady 10
9093 ${NS}::label $top.id -text [mc "ID:"]
9094 ${NS}::entry $top.sha1 -width 40
9095 $top.sha1 insert 0 $rowmenuid
9096 $top.sha1 conf -state readonly
9097 grid $top.id $top.sha1 -sticky w
9098 ${NS}::entry $top.head -width 60
9099 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9100 $top.head conf -state readonly
9101 grid x $top.head -sticky w
9102 ${NS}::label $top.tlab -text [mc "Tag name:"]
9103 ${NS}::entry $top.tag -width 60
9104 grid $top.tlab $top.tag -sticky w
9105 ${NS}::label $top.op -text [mc "Tag message is optional"]
9106 grid $top.op -columnspan 2 -sticky we
9107 ${NS}::label $top.mlab -text [mc "Tag message:"]
9108 ${NS}::entry $top.msg -width 60
9109 grid $top.mlab $top.msg -sticky w
9110 ${NS}::frame $top.buts
9111 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9112 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9113 bind $top <Key-Return> mktaggo
9114 bind $top <Key-Escape> mktagcan
9115 grid $top.buts.gen $top.buts.can
9116 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9117 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9118 grid $top.buts - -pady 10 -sticky ew
9123 global mktagtop env tagids idtags
9125 set id [$mktagtop.sha1 get]
9126 set tag [$mktagtop.tag get]
9127 set msg [$mktagtop.msg get]
9129 error_popup [mc "No tag name specified"] $mktagtop
9132 if {[info exists tagids($tag)]} {
9133 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9138 exec git tag -a -m $msg $tag $id
9140 exec git tag $tag $id
9143 error_popup "[mc "Error creating tag:"] $err" $mktagtop
9147 set tagids($tag) $id
9148 lappend idtags($id) $tag
9156 proc redrawtags {id} {
9157 global canv linehtag idpos currentid curview cmitlisted markedid
9158 global canvxmax iddrawn circleitem mainheadid circlecolors
9159 global mainheadcirclecolor
9161 if {![commitinview $id $curview]} return
9162 if {![info exists iddrawn($id)]} return
9163 set row [rowofcommit $id]
9164 if {$id eq $mainheadid} {
9165 set ofill $mainheadcirclecolor
9167 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9169 $canv itemconf $circleitem($row) -fill $ofill
9170 $canv delete tag.$id
9171 set xt [eval drawtags $id $idpos($id)]
9172 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9173 set text [$canv itemcget $linehtag($id) -text]
9174 set font [$canv itemcget $linehtag($id) -font]
9175 set xr [expr {$xt + [font measure $font $text]}]
9176 if {$xr > $canvxmax} {
9180 if {[info exists currentid] && $currentid == $id} {
9183 if {[info exists markedid] && $markedid eq $id} {
9191 catch {destroy $mktagtop}
9196 if {![domktag]} return
9200 proc writecommit {} {
9201 global rowmenuid wrcomtop commitinfo wrcomcmd NS
9203 set top .writecommit
9205 catch {destroy $top}
9207 make_transient $top .
9208 ${NS}::label $top.title -text [mc "Write commit to file"]
9209 grid $top.title - -pady 10
9210 ${NS}::label $top.id -text [mc "ID:"]
9211 ${NS}::entry $top.sha1 -width 40
9212 $top.sha1 insert 0 $rowmenuid
9213 $top.sha1 conf -state readonly
9214 grid $top.id $top.sha1 -sticky w
9215 ${NS}::entry $top.head -width 60
9216 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9217 $top.head conf -state readonly
9218 grid x $top.head -sticky w
9219 ${NS}::label $top.clab -text [mc "Command:"]
9220 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9221 grid $top.clab $top.cmd -sticky w -pady 10
9222 ${NS}::label $top.flab -text [mc "Output file:"]
9223 ${NS}::entry $top.fname -width 60
9224 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9225 grid $top.flab $top.fname -sticky w
9226 ${NS}::frame $top.buts
9227 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9228 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9229 bind $top <Key-Return> wrcomgo
9230 bind $top <Key-Escape> wrcomcan
9231 grid $top.buts.gen $top.buts.can
9232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9234 grid $top.buts - -pady 10 -sticky ew
9241 set id [$wrcomtop.sha1 get]
9242 set cmd "echo $id | [$wrcomtop.cmd get]"
9243 set fname [$wrcomtop.fname get]
9244 if {[catch {exec sh -c $cmd >$fname &} err]} {
9245 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9247 catch {destroy $wrcomtop}
9254 catch {destroy $wrcomtop}
9259 global rowmenuid mkbrtop NS
9262 catch {destroy $top}
9264 make_transient $top .
9265 ${NS}::label $top.title -text [mc "Create new branch"]
9266 grid $top.title - -pady 10
9267 ${NS}::label $top.id -text [mc "ID:"]
9268 ${NS}::entry $top.sha1 -width 40
9269 $top.sha1 insert 0 $rowmenuid
9270 $top.sha1 conf -state readonly
9271 grid $top.id $top.sha1 -sticky w
9272 ${NS}::label $top.nlab -text [mc "Name:"]
9273 ${NS}::entry $top.name -width 40
9274 grid $top.nlab $top.name -sticky w
9275 ${NS}::frame $top.buts
9276 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9277 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9278 bind $top <Key-Return> [list mkbrgo $top]
9279 bind $top <Key-Escape> "catch {destroy $top}"
9280 grid $top.buts.go $top.buts.can
9281 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9282 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9283 grid $top.buts - -pady 10 -sticky ew
9288 global headids idheads
9290 set name [$top.name get]
9291 set id [$top.sha1 get]
9295 error_popup [mc "Please specify a name for the new branch"] $top
9298 if {[info exists headids($name)]} {
9299 if {![confirm_popup [mc \
9300 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9303 set old_id $headids($name)
9306 catch {destroy $top}
9307 lappend cmdargs $name $id
9311 eval exec git branch $cmdargs
9317 if {$old_id ne {}} {
9323 set headids($name) $id
9324 lappend idheads($id) $name
9333 proc exec_citool {tool_args {baseid {}}} {
9334 global commitinfo env
9336 set save_env [array get env GIT_AUTHOR_*]
9338 if {$baseid ne {}} {
9339 if {![info exists commitinfo($baseid)]} {
9342 set author [lindex $commitinfo($baseid) 1]
9343 set date [lindex $commitinfo($baseid) 2]
9344 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9345 $author author name email]
9347 set env(GIT_AUTHOR_NAME) $name
9348 set env(GIT_AUTHOR_EMAIL) $email
9349 set env(GIT_AUTHOR_DATE) $date
9353 eval exec git citool $tool_args &
9355 array unset env GIT_AUTHOR_*
9356 array set env $save_env
9359 proc cherrypick {} {
9360 global rowmenuid curview
9361 global mainhead mainheadid
9364 set oldhead [exec git rev-parse HEAD]
9365 set dheads [descheads $rowmenuid]
9366 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9367 set ok [confirm_popup [mc "Commit %s is already\
9368 included in branch %s -- really re-apply it?" \
9369 [string range $rowmenuid 0 7] $mainhead]]
9372 nowbusy cherrypick [mc "Cherry-picking"]
9374 # Unfortunately git-cherry-pick writes stuff to stderr even when
9375 # no error occurs, and exec takes that as an indication of error...
9376 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9379 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9381 error_popup [mc "Cherry-pick failed because of local changes\
9382 to file '%s'.\nPlease commit, reset or stash\
9383 your changes and try again." $fname]
9384 } elseif {[regexp -line \
9385 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9387 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9388 conflict.\nDo you wish to run git citool to\
9390 # Force citool to read MERGE_MSG
9391 file delete [file join $gitdir "GITGUI_MSG"]
9392 exec_citool {} $rowmenuid
9400 set newhead [exec git rev-parse HEAD]
9401 if {$newhead eq $oldhead} {
9403 error_popup [mc "No changes committed"]
9406 addnewchild $newhead $oldhead
9407 if {[commitinview $oldhead $curview]} {
9408 # XXX this isn't right if we have a path limit...
9409 insertrow $newhead $oldhead $curview
9410 if {$mainhead ne {}} {
9411 movehead $newhead $mainhead
9412 movedhead $newhead $mainhead
9414 set mainheadid $newhead
9423 global rowmenuid curview
9424 global mainhead mainheadid
9427 set oldhead [exec git rev-parse HEAD]
9428 set dheads [descheads $rowmenuid]
9429 if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9430 set ok [confirm_popup [mc "Commit %s is not\
9431 included in branch %s -- really revert it?" \
9432 [string range $rowmenuid 0 7] $mainhead]]
9435 nowbusy revert [mc "Reverting"]
9438 if [catch {exec git revert --no-edit $rowmenuid} err] {
9440 if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9442 regsub {\n( |\t)+} $files "\n" files
9443 error_popup [mc "Revert failed because of local changes to\
9444 the following files:%s Please commit, reset or stash \
9445 your changes and try again." $files]
9446 } elseif [regexp {error: could not revert} $err] {
9447 if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9448 Do you wish to run git citool to resolve it?"]] {
9449 # Force citool to read MERGE_MSG
9450 file delete [file join $gitdir "GITGUI_MSG"]
9451 exec_citool {} $rowmenuid
9453 } else { error_popup $err }
9458 set newhead [exec git rev-parse HEAD]
9459 if { $newhead eq $oldhead } {
9461 error_popup [mc "No changes committed"]
9465 addnewchild $newhead $oldhead
9467 if [commitinview $oldhead $curview] {
9468 # XXX this isn't right if we have a path limit...
9469 insertrow $newhead $oldhead $curview
9470 if {$mainhead ne {}} {
9471 movehead $newhead $mainhead
9472 movedhead $newhead $mainhead
9474 set mainheadid $newhead
9484 global mainhead rowmenuid confirm_ok resettype NS
9487 set w ".confirmreset"
9490 wm title $w [mc "Confirm reset"]
9491 ${NS}::label $w.m -text \
9492 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9493 pack $w.m -side top -fill x -padx 20 -pady 20
9494 ${NS}::labelframe $w.f -text [mc "Reset type:"]
9496 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9497 -text [mc "Soft: Leave working tree and index untouched"]
9498 grid $w.f.soft -sticky w
9499 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9500 -text [mc "Mixed: Leave working tree untouched, reset index"]
9501 grid $w.f.mixed -sticky w
9502 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9503 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9504 grid $w.f.hard -sticky w
9505 pack $w.f -side top -fill x -padx 4
9506 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9507 pack $w.ok -side left -fill x -padx 20 -pady 20
9508 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9509 bind $w <Key-Escape> [list destroy $w]
9510 pack $w.cancel -side right -fill x -padx 20 -pady 20
9511 bind $w <Visibility> "grab $w; focus $w"
9513 if {!$confirm_ok} return
9514 if {[catch {set fd [open \
9515 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9519 filerun $fd [list readresetstat $fd]
9520 nowbusy reset [mc "Resetting"]
9525 proc readresetstat {fd} {
9526 global mainhead mainheadid showlocalchanges rprogcoord
9528 if {[gets $fd line] >= 0} {
9529 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9530 set rprogcoord [expr {1.0 * $m / $n}]
9538 if {[catch {close $fd} err]} {
9541 set oldhead $mainheadid
9542 set newhead [exec git rev-parse HEAD]
9543 if {$newhead ne $oldhead} {
9544 movehead $newhead $mainhead
9545 movedhead $newhead $mainhead
9546 set mainheadid $newhead
9550 if {$showlocalchanges} {
9556 # context menu for a head
9557 proc headmenu {x y id head} {
9558 global headmenuid headmenuhead headctxmenu mainhead
9562 set headmenuhead $head
9564 if {[string match "remotes/*" $head]} {
9567 if {$head eq $mainhead} {
9570 $headctxmenu entryconfigure 0 -state $state
9571 $headctxmenu entryconfigure 1 -state $state
9572 tk_popup $headctxmenu $x $y
9576 global headmenuid headmenuhead headids
9577 global showlocalchanges
9579 # check the tree is clean first??
9580 nowbusy checkout [mc "Checking out"]
9584 set fd [open [list | git checkout $headmenuhead 2>@1] r]
9588 if {$showlocalchanges} {
9592 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9596 proc readcheckoutstat {fd newhead newheadid} {
9597 global mainhead mainheadid headids showlocalchanges progresscoords
9598 global viewmainheadid curview
9600 if {[gets $fd line] >= 0} {
9601 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9602 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9607 set progresscoords {0 0}
9610 if {[catch {close $fd} err]} {
9613 set oldmainid $mainheadid
9614 set mainhead $newhead
9615 set mainheadid $newheadid
9616 set viewmainheadid($curview) $newheadid
9617 redrawtags $oldmainid
9618 redrawtags $newheadid
9620 if {$showlocalchanges} {
9626 global headmenuid headmenuhead mainhead
9629 set head $headmenuhead
9631 # this check shouldn't be needed any more...
9632 if {$head eq $mainhead} {
9633 error_popup [mc "Cannot delete the currently checked-out branch"]
9636 set dheads [descheads $id]
9637 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9638 # the stuff on this branch isn't on any other branch
9639 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9640 branch.\nReally delete branch %s?" $head $head]]} return
9644 if {[catch {exec git branch -D $head} err]} {
9649 removehead $id $head
9650 removedhead $id $head
9657 # Display a list of tags and heads
9659 global showrefstop bgcolor fgcolor selectbgcolor NS
9660 global bglist fglist reflistfilter reflist maincursor
9663 set showrefstop $top
9664 if {[winfo exists $top]} {
9670 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9671 make_transient $top .
9672 text $top.list -background $bgcolor -foreground $fgcolor \
9673 -selectbackground $selectbgcolor -font mainfont \
9674 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9675 -width 30 -height 20 -cursor $maincursor \
9676 -spacing1 1 -spacing3 1 -state disabled
9677 $top.list tag configure highlight -background $selectbgcolor
9678 lappend bglist $top.list
9679 lappend fglist $top.list
9680 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9681 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9682 grid $top.list $top.ysb -sticky nsew
9683 grid $top.xsb x -sticky ew
9685 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9686 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9687 set reflistfilter "*"
9688 trace add variable reflistfilter write reflistfilter_change
9689 pack $top.f.e -side right -fill x -expand 1
9690 pack $top.f.l -side left
9691 grid $top.f - -sticky ew -pady 2
9692 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9693 bind $top <Key-Escape> [list destroy $top]
9695 grid columnconfigure $top 0 -weight 1
9696 grid rowconfigure $top 0 -weight 1
9697 bind $top.list <1> {break}
9698 bind $top.list <B1-Motion> {break}
9699 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9704 proc sel_reflist {w x y} {
9705 global showrefstop reflist headids tagids otherrefids
9707 if {![winfo exists $showrefstop]} return
9708 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9709 set ref [lindex $reflist [expr {$l-1}]]
9710 set n [lindex $ref 0]
9711 switch -- [lindex $ref 1] {
9712 "H" {selbyid $headids($n)}
9713 "T" {selbyid $tagids($n)}
9714 "o" {selbyid $otherrefids($n)}
9716 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9719 proc unsel_reflist {} {
9722 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9723 $showrefstop.list tag remove highlight 0.0 end
9726 proc reflistfilter_change {n1 n2 op} {
9727 global reflistfilter
9729 after cancel refill_reflist
9730 after 200 refill_reflist
9733 proc refill_reflist {} {
9734 global reflist reflistfilter showrefstop headids tagids otherrefids
9737 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9739 foreach n [array names headids] {
9740 if {[string match $reflistfilter $n]} {
9741 if {[commitinview $headids($n) $curview]} {
9742 lappend refs [list $n H]
9744 interestedin $headids($n) {run refill_reflist}
9748 foreach n [array names tagids] {
9749 if {[string match $reflistfilter $n]} {
9750 if {[commitinview $tagids($n) $curview]} {
9751 lappend refs [list $n T]
9753 interestedin $tagids($n) {run refill_reflist}
9757 foreach n [array names otherrefids] {
9758 if {[string match $reflistfilter $n]} {
9759 if {[commitinview $otherrefids($n) $curview]} {
9760 lappend refs [list $n o]
9762 interestedin $otherrefids($n) {run refill_reflist}
9766 set refs [lsort -index 0 $refs]
9767 if {$refs eq $reflist} return
9769 # Update the contents of $showrefstop.list according to the
9770 # differences between $reflist (old) and $refs (new)
9771 $showrefstop.list conf -state normal
9772 $showrefstop.list insert end "\n"
9775 while {$i < [llength $reflist] || $j < [llength $refs]} {
9776 if {$i < [llength $reflist]} {
9777 if {$j < [llength $refs]} {
9778 set cmp [string compare [lindex $reflist $i 0] \
9779 [lindex $refs $j 0]]
9781 set cmp [string compare [lindex $reflist $i 1] \
9782 [lindex $refs $j 1]]
9792 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9800 set l [expr {$j + 1}]
9801 $showrefstop.list image create $l.0 -align baseline \
9802 -image reficon-[lindex $refs $j 1] -padx 2
9803 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9809 # delete last newline
9810 $showrefstop.list delete end-2c end-1c
9811 $showrefstop.list conf -state disabled
9814 # Stuff for finding nearby tags
9815 proc getallcommits {} {
9816 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9817 global idheads idtags idotherrefs allparents tagobjid
9820 if {![info exists allcommits]} {
9826 set allccache [file join $gitdir "gitk.cache"]
9828 set f [open $allccache r]
9837 set cmd [list | git rev-list --parents]
9838 set allcupdate [expr {$seeds ne {}}]
9842 set refs [concat [array names idheads] [array names idtags] \
9843 [array names idotherrefs]]
9846 foreach name [array names tagobjid] {
9847 lappend tagobjs $tagobjid($name)
9849 foreach id [lsort -unique $refs] {
9850 if {![info exists allparents($id)] &&
9851 [lsearch -exact $tagobjs $id] < 0} {
9862 set fd [open [concat $cmd $ids] r]
9863 fconfigure $fd -blocking 0
9866 filerun $fd [list getallclines $fd]
9872 # Since most commits have 1 parent and 1 child, we group strings of
9873 # such commits into "arcs" joining branch/merge points (BMPs), which
9874 # are commits that either don't have 1 parent or don't have 1 child.
9876 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9877 # arcout(id) - outgoing arcs for BMP
9878 # arcids(a) - list of IDs on arc including end but not start
9879 # arcstart(a) - BMP ID at start of arc
9880 # arcend(a) - BMP ID at end of arc
9881 # growing(a) - arc a is still growing
9882 # arctags(a) - IDs out of arcids (excluding end) that have tags
9883 # archeads(a) - IDs out of arcids (excluding end) that have heads
9884 # The start of an arc is at the descendent end, so "incoming" means
9885 # coming from descendents, and "outgoing" means going towards ancestors.
9887 proc getallclines {fd} {
9888 global allparents allchildren idtags idheads nextarc
9889 global arcnos arcids arctags arcout arcend arcstart archeads growing
9890 global seeds allcommits cachedarcs allcupdate
9893 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9894 set id [lindex $line 0]
9895 if {[info exists allparents($id)]} {
9900 set olds [lrange $line 1 end]
9901 set allparents($id) $olds
9902 if {![info exists allchildren($id)]} {
9903 set allchildren($id) {}
9908 if {[llength $olds] == 1 && [llength $a] == 1} {
9909 lappend arcids($a) $id
9910 if {[info exists idtags($id)]} {
9911 lappend arctags($a) $id
9913 if {[info exists idheads($id)]} {
9914 lappend archeads($a) $id
9916 if {[info exists allparents($olds)]} {
9917 # seen parent already
9918 if {![info exists arcout($olds)]} {
9921 lappend arcids($a) $olds
9922 set arcend($a) $olds
9925 lappend allchildren($olds) $id
9926 lappend arcnos($olds) $a
9930 foreach a $arcnos($id) {
9931 lappend arcids($a) $id
9938 lappend allchildren($p) $id
9939 set a [incr nextarc]
9940 set arcstart($a) $id
9947 if {[info exists allparents($p)]} {
9948 # seen it already, may need to make a new branch
9949 if {![info exists arcout($p)]} {
9952 lappend arcids($a) $p
9956 lappend arcnos($p) $a
9961 global cached_dheads cached_dtags cached_atags
9962 catch {unset cached_dheads}
9963 catch {unset cached_dtags}
9964 catch {unset cached_atags}
9967 return [expr {$nid >= 1000? 2: 1}]
9971 fconfigure $fd -blocking 1
9974 # got an error reading the list of commits
9975 # if we were updating, try rereading the whole thing again
9981 error_popup "[mc "Error reading commit topology information;\
9982 branch and preceding/following tag information\
9983 will be incomplete."]\n($err)"
9986 if {[incr allcommits -1] == 0} {
9996 proc recalcarc {a} {
9997 global arctags archeads arcids idtags idheads
10001 foreach id [lrange $arcids($a) 0 end-1] {
10002 if {[info exists idtags($id)]} {
10005 if {[info exists idheads($id)]} {
10009 set arctags($a) $at
10010 set archeads($a) $ah
10013 proc splitarc {p} {
10014 global arcnos arcids nextarc arctags archeads idtags idheads
10015 global arcstart arcend arcout allparents growing
10018 if {[llength $a] != 1} {
10019 puts "oops splitarc called but [llength $a] arcs already"
10022 set a [lindex $a 0]
10023 set i [lsearch -exact $arcids($a) $p]
10025 puts "oops splitarc $p not in arc $a"
10028 set na [incr nextarc]
10029 if {[info exists arcend($a)]} {
10030 set arcend($na) $arcend($a)
10032 set l [lindex $allparents([lindex $arcids($a) end]) 0]
10033 set j [lsearch -exact $arcnos($l) $a]
10034 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10036 set tail [lrange $arcids($a) [expr {$i+1}] end]
10037 set arcids($a) [lrange $arcids($a) 0 $i]
10039 set arcstart($na) $p
10041 set arcids($na) $tail
10042 if {[info exists growing($a)]} {
10048 if {[llength $arcnos($id)] == 1} {
10049 set arcnos($id) $na
10051 set j [lsearch -exact $arcnos($id) $a]
10052 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10056 # reconstruct tags and heads lists
10057 if {$arctags($a) ne {} || $archeads($a) ne {}} {
10061 set arctags($na) {}
10062 set archeads($na) {}
10066 # Update things for a new commit added that is a child of one
10067 # existing commit. Used when cherry-picking.
10068 proc addnewchild {id p} {
10069 global allparents allchildren idtags nextarc
10070 global arcnos arcids arctags arcout arcend arcstart archeads growing
10071 global seeds allcommits
10073 if {![info exists allcommits] || ![info exists arcnos($p)]} return
10074 set allparents($id) [list $p]
10075 set allchildren($id) {}
10078 lappend allchildren($p) $id
10079 set a [incr nextarc]
10080 set arcstart($a) $id
10081 set archeads($a) {}
10083 set arcids($a) [list $p]
10085 if {![info exists arcout($p)]} {
10088 lappend arcnos($p) $a
10089 set arcout($id) [list $a]
10092 # This implements a cache for the topology information.
10093 # The cache saves, for each arc, the start and end of the arc,
10094 # the ids on the arc, and the outgoing arcs from the end.
10095 proc readcache {f} {
10096 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10097 global idtags idheads allparents cachedarcs possible_seeds seeds growing
10101 set lim $cachedarcs
10102 if {$lim - $a > 500} {
10103 set lim [expr {$a + 500}]
10107 # finish reading the cache and setting up arctags, etc.
10109 if {$line ne "1"} {error "bad final version"}
10111 foreach id [array names idtags] {
10112 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10113 [llength $allparents($id)] == 1} {
10114 set a [lindex $arcnos($id) 0]
10115 if {$arctags($a) eq {}} {
10120 foreach id [array names idheads] {
10121 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10122 [llength $allparents($id)] == 1} {
10123 set a [lindex $arcnos($id) 0]
10124 if {$archeads($a) eq {}} {
10129 foreach id [lsort -unique $possible_seeds] {
10130 if {$arcnos($id) eq {}} {
10136 while {[incr a] <= $lim} {
10138 if {[llength $line] != 3} {error "bad line"}
10139 set s [lindex $line 0]
10140 set arcstart($a) $s
10141 lappend arcout($s) $a
10142 if {![info exists arcnos($s)]} {
10143 lappend possible_seeds $s
10146 set e [lindex $line 1]
10151 if {![info exists arcout($e)]} {
10155 set arcids($a) [lindex $line 2]
10156 foreach id $arcids($a) {
10157 lappend allparents($s) $id
10159 lappend arcnos($id) $a
10161 if {![info exists allparents($s)]} {
10162 set allparents($s) {}
10165 set archeads($a) {}
10167 set nextarc [expr {$a - 1}]
10179 proc getcache {f} {
10180 global nextarc cachedarcs possible_seeds
10184 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10185 # make sure it's an integer
10186 set cachedarcs [expr {int([lindex $line 1])}]
10187 if {$cachedarcs < 0} {error "bad number of arcs"}
10189 set possible_seeds {}
10197 proc dropcache {err} {
10198 global allcwait nextarc cachedarcs seeds
10200 #puts "dropping cache ($err)"
10201 foreach v {arcnos arcout arcids arcstart arcend growing \
10202 arctags archeads allparents allchildren} {
10213 proc writecache {f} {
10214 global cachearc cachedarcs allccache
10215 global arcstart arcend arcnos arcids arcout
10218 set lim $cachedarcs
10219 if {$lim - $a > 1000} {
10220 set lim [expr {$a + 1000}]
10223 while {[incr a] <= $lim} {
10224 if {[info exists arcend($a)]} {
10225 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10227 puts $f [list $arcstart($a) {} $arcids($a)]
10232 catch {file delete $allccache}
10233 #puts "writing cache failed ($err)"
10236 set cachearc [expr {$a - 1}]
10237 if {$a > $cachedarcs} {
10245 proc savecache {} {
10246 global nextarc cachedarcs cachearc allccache
10248 if {$nextarc == $cachedarcs} return
10250 set cachedarcs $nextarc
10252 set f [open $allccache w]
10253 puts $f [list 1 $cachedarcs]
10258 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10259 # or 0 if neither is true.
10260 proc anc_or_desc {a b} {
10261 global arcout arcstart arcend arcnos cached_isanc
10263 if {$arcnos($a) eq $arcnos($b)} {
10264 # Both are on the same arc(s); either both are the same BMP,
10265 # or if one is not a BMP, the other is also not a BMP or is
10266 # the BMP at end of the arc (and it only has 1 incoming arc).
10267 # Or both can be BMPs with no incoming arcs.
10268 if {$a eq $b || $arcnos($a) eq {}} {
10271 # assert {[llength $arcnos($a)] == 1}
10272 set arc [lindex $arcnos($a) 0]
10273 set i [lsearch -exact $arcids($arc) $a]
10274 set j [lsearch -exact $arcids($arc) $b]
10275 if {$i < 0 || $i > $j} {
10282 if {![info exists arcout($a)]} {
10283 set arc [lindex $arcnos($a) 0]
10284 if {[info exists arcend($arc)]} {
10285 set aend $arcend($arc)
10289 set a $arcstart($arc)
10293 if {![info exists arcout($b)]} {
10294 set arc [lindex $arcnos($b) 0]
10295 if {[info exists arcend($arc)]} {
10296 set bend $arcend($arc)
10300 set b $arcstart($arc)
10310 if {[info exists cached_isanc($a,$bend)]} {
10311 if {$cached_isanc($a,$bend)} {
10315 if {[info exists cached_isanc($b,$aend)]} {
10316 if {$cached_isanc($b,$aend)} {
10319 if {[info exists cached_isanc($a,$bend)]} {
10324 set todo [list $a $b]
10327 for {set i 0} {$i < [llength $todo]} {incr i} {
10328 set x [lindex $todo $i]
10329 if {$anc($x) eq {}} {
10332 foreach arc $arcnos($x) {
10333 set xd $arcstart($arc)
10334 if {$xd eq $bend} {
10335 set cached_isanc($a,$bend) 1
10336 set cached_isanc($b,$aend) 0
10338 } elseif {$xd eq $aend} {
10339 set cached_isanc($b,$aend) 1
10340 set cached_isanc($a,$bend) 0
10343 if {![info exists anc($xd)]} {
10344 set anc($xd) $anc($x)
10346 } elseif {$anc($xd) ne $anc($x)} {
10351 set cached_isanc($a,$bend) 0
10352 set cached_isanc($b,$aend) 0
10356 # This identifies whether $desc has an ancestor that is
10357 # a growing tip of the graph and which is not an ancestor of $anc
10358 # and returns 0 if so and 1 if not.
10359 # If we subsequently discover a tag on such a growing tip, and that
10360 # turns out to be a descendent of $anc (which it could, since we
10361 # don't necessarily see children before parents), then $desc
10362 # isn't a good choice to display as a descendent tag of
10363 # $anc (since it is the descendent of another tag which is
10364 # a descendent of $anc). Similarly, $anc isn't a good choice to
10365 # display as a ancestor tag of $desc.
10367 proc is_certain {desc anc} {
10368 global arcnos arcout arcstart arcend growing problems
10371 if {[llength $arcnos($anc)] == 1} {
10372 # tags on the same arc are certain
10373 if {$arcnos($desc) eq $arcnos($anc)} {
10376 if {![info exists arcout($anc)]} {
10377 # if $anc is partway along an arc, use the start of the arc instead
10378 set a [lindex $arcnos($anc) 0]
10379 set anc $arcstart($a)
10382 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10385 set a [lindex $arcnos($desc) 0]
10391 set anclist [list $x]
10395 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10396 set x [lindex $anclist $i]
10401 foreach a $arcout($x) {
10402 if {[info exists growing($a)]} {
10403 if {![info exists growanc($x)] && $dl($x)} {
10409 if {[info exists dl($y)]} {
10413 if {![info exists done($y)]} {
10416 if {[info exists growanc($x)]} {
10420 for {set k 0} {$k < [llength $xl]} {incr k} {
10421 set z [lindex $xl $k]
10422 foreach c $arcout($z) {
10423 if {[info exists arcend($c)]} {
10425 if {[info exists dl($v)] && $dl($v)} {
10427 if {![info exists done($v)]} {
10430 if {[info exists growanc($v)]} {
10440 } elseif {$y eq $anc || !$dl($x)} {
10451 foreach x [array names growanc] {
10460 proc validate_arctags {a} {
10461 global arctags idtags
10464 set na $arctags($a)
10465 foreach id $arctags($a) {
10467 if {![info exists idtags($id)]} {
10468 set na [lreplace $na $i $i]
10472 set arctags($a) $na
10475 proc validate_archeads {a} {
10476 global archeads idheads
10479 set na $archeads($a)
10480 foreach id $archeads($a) {
10482 if {![info exists idheads($id)]} {
10483 set na [lreplace $na $i $i]
10487 set archeads($a) $na
10490 # Return the list of IDs that have tags that are descendents of id,
10491 # ignoring IDs that are descendents of IDs already reported.
10492 proc desctags {id} {
10493 global arcnos arcstart arcids arctags idtags allparents
10494 global growing cached_dtags
10496 if {![info exists allparents($id)]} {
10499 set t1 [clock clicks -milliseconds]
10501 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10502 # part-way along an arc; check that arc first
10503 set a [lindex $arcnos($id) 0]
10504 if {$arctags($a) ne {}} {
10505 validate_arctags $a
10506 set i [lsearch -exact $arcids($a) $id]
10508 foreach t $arctags($a) {
10509 set j [lsearch -exact $arcids($a) $t]
10510 if {$j >= $i} break
10517 set id $arcstart($a)
10518 if {[info exists idtags($id)]} {
10522 if {[info exists cached_dtags($id)]} {
10523 return $cached_dtags($id)
10527 set todo [list $id]
10530 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10531 set id [lindex $todo $i]
10533 set ta [info exists hastaggedancestor($id)]
10537 # ignore tags on starting node
10538 if {!$ta && $i > 0} {
10539 if {[info exists idtags($id)]} {
10540 set tagloc($id) $id
10542 } elseif {[info exists cached_dtags($id)]} {
10543 set tagloc($id) $cached_dtags($id)
10547 foreach a $arcnos($id) {
10548 set d $arcstart($a)
10549 if {!$ta && $arctags($a) ne {}} {
10550 validate_arctags $a
10551 if {$arctags($a) ne {}} {
10552 lappend tagloc($id) [lindex $arctags($a) end]
10555 if {$ta || $arctags($a) ne {}} {
10556 set tomark [list $d]
10557 for {set j 0} {$j < [llength $tomark]} {incr j} {
10558 set dd [lindex $tomark $j]
10559 if {![info exists hastaggedancestor($dd)]} {
10560 if {[info exists done($dd)]} {
10561 foreach b $arcnos($dd) {
10562 lappend tomark $arcstart($b)
10564 if {[info exists tagloc($dd)]} {
10567 } elseif {[info exists queued($dd)]} {
10570 set hastaggedancestor($dd) 1
10574 if {![info exists queued($d)]} {
10577 if {![info exists hastaggedancestor($d)]} {
10584 foreach id [array names tagloc] {
10585 if {![info exists hastaggedancestor($id)]} {
10586 foreach t $tagloc($id) {
10587 if {[lsearch -exact $tags $t] < 0} {
10593 set t2 [clock clicks -milliseconds]
10596 # remove tags that are descendents of other tags
10597 for {set i 0} {$i < [llength $tags]} {incr i} {
10598 set a [lindex $tags $i]
10599 for {set j 0} {$j < $i} {incr j} {
10600 set b [lindex $tags $j]
10601 set r [anc_or_desc $a $b]
10603 set tags [lreplace $tags $j $j]
10606 } elseif {$r == -1} {
10607 set tags [lreplace $tags $i $i]
10614 if {[array names growing] ne {}} {
10615 # graph isn't finished, need to check if any tag could get
10616 # eclipsed by another tag coming later. Simply ignore any
10617 # tags that could later get eclipsed.
10620 if {[is_certain $t $origid]} {
10624 if {$tags eq $ctags} {
10625 set cached_dtags($origid) $tags
10630 set cached_dtags($origid) $tags
10632 set t3 [clock clicks -milliseconds]
10633 if {0 && $t3 - $t1 >= 100} {
10634 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10635 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10640 proc anctags {id} {
10641 global arcnos arcids arcout arcend arctags idtags allparents
10642 global growing cached_atags
10644 if {![info exists allparents($id)]} {
10647 set t1 [clock clicks -milliseconds]
10649 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10650 # part-way along an arc; check that arc first
10651 set a [lindex $arcnos($id) 0]
10652 if {$arctags($a) ne {}} {
10653 validate_arctags $a
10654 set i [lsearch -exact $arcids($a) $id]
10655 foreach t $arctags($a) {
10656 set j [lsearch -exact $arcids($a) $t]
10662 if {![info exists arcend($a)]} {
10666 if {[info exists idtags($id)]} {
10670 if {[info exists cached_atags($id)]} {
10671 return $cached_atags($id)
10675 set todo [list $id]
10679 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10680 set id [lindex $todo $i]
10682 set td [info exists hastaggeddescendent($id)]
10686 # ignore tags on starting node
10687 if {!$td && $i > 0} {
10688 if {[info exists idtags($id)]} {
10689 set tagloc($id) $id
10691 } elseif {[info exists cached_atags($id)]} {
10692 set tagloc($id) $cached_atags($id)
10696 foreach a $arcout($id) {
10697 if {!$td && $arctags($a) ne {}} {
10698 validate_arctags $a
10699 if {$arctags($a) ne {}} {
10700 lappend tagloc($id) [lindex $arctags($a) 0]
10703 if {![info exists arcend($a)]} continue
10705 if {$td || $arctags($a) ne {}} {
10706 set tomark [list $d]
10707 for {set j 0} {$j < [llength $tomark]} {incr j} {
10708 set dd [lindex $tomark $j]
10709 if {![info exists hastaggeddescendent($dd)]} {
10710 if {[info exists done($dd)]} {
10711 foreach b $arcout($dd) {
10712 if {[info exists arcend($b)]} {
10713 lappend tomark $arcend($b)
10716 if {[info exists tagloc($dd)]} {
10719 } elseif {[info exists queued($dd)]} {
10722 set hastaggeddescendent($dd) 1
10726 if {![info exists queued($d)]} {
10729 if {![info exists hastaggeddescendent($d)]} {
10735 set t2 [clock clicks -milliseconds]
10738 foreach id [array names tagloc] {
10739 if {![info exists hastaggeddescendent($id)]} {
10740 foreach t $tagloc($id) {
10741 if {[lsearch -exact $tags $t] < 0} {
10748 # remove tags that are ancestors of other tags
10749 for {set i 0} {$i < [llength $tags]} {incr i} {
10750 set a [lindex $tags $i]
10751 for {set j 0} {$j < $i} {incr j} {
10752 set b [lindex $tags $j]
10753 set r [anc_or_desc $a $b]
10755 set tags [lreplace $tags $j $j]
10758 } elseif {$r == 1} {
10759 set tags [lreplace $tags $i $i]
10766 if {[array names growing] ne {}} {
10767 # graph isn't finished, need to check if any tag could get
10768 # eclipsed by another tag coming later. Simply ignore any
10769 # tags that could later get eclipsed.
10772 if {[is_certain $origid $t]} {
10776 if {$tags eq $ctags} {
10777 set cached_atags($origid) $tags
10782 set cached_atags($origid) $tags
10784 set t3 [clock clicks -milliseconds]
10785 if {0 && $t3 - $t1 >= 100} {
10786 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10787 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10792 # Return the list of IDs that have heads that are descendents of id,
10793 # including id itself if it has a head.
10794 proc descheads {id} {
10795 global arcnos arcstart arcids archeads idheads cached_dheads
10796 global allparents arcout
10798 if {![info exists allparents($id)]} {
10802 if {![info exists arcout($id)]} {
10803 # part-way along an arc; check it first
10804 set a [lindex $arcnos($id) 0]
10805 if {$archeads($a) ne {}} {
10806 validate_archeads $a
10807 set i [lsearch -exact $arcids($a) $id]
10808 foreach t $archeads($a) {
10809 set j [lsearch -exact $arcids($a) $t]
10814 set id $arcstart($a)
10817 set todo [list $id]
10820 for {set i 0} {$i < [llength $todo]} {incr i} {
10821 set id [lindex $todo $i]
10822 if {[info exists cached_dheads($id)]} {
10823 set ret [concat $ret $cached_dheads($id)]
10825 if {[info exists idheads($id)]} {
10828 foreach a $arcnos($id) {
10829 if {$archeads($a) ne {}} {
10830 validate_archeads $a
10831 if {$archeads($a) ne {}} {
10832 set ret [concat $ret $archeads($a)]
10835 set d $arcstart($a)
10836 if {![info exists seen($d)]} {
10843 set ret [lsort -unique $ret]
10844 set cached_dheads($origid) $ret
10845 return [concat $ret $aret]
10848 proc addedtag {id} {
10849 global arcnos arcout cached_dtags cached_atags
10851 if {![info exists arcnos($id)]} return
10852 if {![info exists arcout($id)]} {
10853 recalcarc [lindex $arcnos($id) 0]
10855 catch {unset cached_dtags}
10856 catch {unset cached_atags}
10859 proc addedhead {hid head} {
10860 global arcnos arcout cached_dheads
10862 if {![info exists arcnos($hid)]} return
10863 if {![info exists arcout($hid)]} {
10864 recalcarc [lindex $arcnos($hid) 0]
10866 catch {unset cached_dheads}
10869 proc removedhead {hid head} {
10870 global cached_dheads
10872 catch {unset cached_dheads}
10875 proc movedhead {hid head} {
10876 global arcnos arcout cached_dheads
10878 if {![info exists arcnos($hid)]} return
10879 if {![info exists arcout($hid)]} {
10880 recalcarc [lindex $arcnos($hid) 0]
10882 catch {unset cached_dheads}
10885 proc changedrefs {} {
10886 global cached_dheads cached_dtags cached_atags cached_tagcontent
10887 global arctags archeads arcnos arcout idheads idtags
10889 foreach id [concat [array names idheads] [array names idtags]] {
10890 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10891 set a [lindex $arcnos($id) 0]
10892 if {![info exists donearc($a)]} {
10898 catch {unset cached_tagcontent}
10899 catch {unset cached_dtags}
10900 catch {unset cached_atags}
10901 catch {unset cached_dheads}
10904 proc rereadrefs {} {
10905 global idtags idheads idotherrefs mainheadid
10907 set refids [concat [array names idtags] \
10908 [array names idheads] [array names idotherrefs]]
10909 foreach id $refids {
10910 if {![info exists ref($id)]} {
10911 set ref($id) [listrefs $id]
10914 set oldmainhead $mainheadid
10917 set refids [lsort -unique [concat $refids [array names idtags] \
10918 [array names idheads] [array names idotherrefs]]]
10919 foreach id $refids {
10920 set v [listrefs $id]
10921 if {![info exists ref($id)] || $ref($id) != $v} {
10925 if {$oldmainhead ne $mainheadid} {
10926 redrawtags $oldmainhead
10927 redrawtags $mainheadid
10932 proc listrefs {id} {
10933 global idtags idheads idotherrefs
10936 if {[info exists idtags($id)]} {
10940 if {[info exists idheads($id)]} {
10941 set y $idheads($id)
10944 if {[info exists idotherrefs($id)]} {
10945 set z $idotherrefs($id)
10947 return [list $x $y $z]
10950 proc add_tag_ctext {tag} {
10951 global ctext cached_tagcontent tagids
10953 if {![info exists cached_tagcontent($tag)]} {
10955 set cached_tagcontent($tag) [exec git cat-file -p $tag]
10958 $ctext insert end "[mc "Tag"]: $tag\n" bold
10959 if {[info exists cached_tagcontent($tag)]} {
10960 set text $cached_tagcontent($tag)
10962 set text "[mc "Id"]: $tagids($tag)"
10964 appendwithlinks $text {}
10967 proc showtag {tag isnew} {
10968 global ctext cached_tagcontent tagids linknum tagobjid
10971 addtohistory [list showtag $tag 0] savectextpos
10973 $ctext conf -state normal
10978 maybe_scroll_ctext 1
10979 $ctext conf -state disabled
10983 proc showtags {id isnew} {
10984 global idtags ctext linknum
10987 addtohistory [list showtags $id 0] savectextpos
10989 $ctext conf -state normal
10994 foreach tag $idtags($id) {
10995 $ctext insert end $sep
10999 maybe_scroll_ctext 1
11000 $ctext conf -state disabled
11012 if {[info exists gitktmpdir]} {
11013 catch {file delete -force $gitktmpdir}
11017 proc mkfontdisp {font top which} {
11018 global fontattr fontpref $font NS use_ttk
11020 set fontpref($font) [set $font]
11021 ${NS}::button $top.${font}but -text $which \
11022 -command [list choosefont $font $which]
11023 ${NS}::label $top.$font -relief flat -font $font \
11024 -text $fontattr($font,family) -justify left
11025 grid x $top.${font}but $top.$font -sticky w
11028 proc choosefont {font which} {
11029 global fontparam fontlist fonttop fontattr
11032 set fontparam(which) $which
11033 set fontparam(font) $font
11034 set fontparam(family) [font actual $font -family]
11035 set fontparam(size) $fontattr($font,size)
11036 set fontparam(weight) $fontattr($font,weight)
11037 set fontparam(slant) $fontattr($font,slant)
11040 if {![winfo exists $top]} {
11042 eval font config sample [font actual $font]
11044 make_transient $top $prefstop
11045 wm title $top [mc "Gitk font chooser"]
11046 ${NS}::label $top.l -textvariable fontparam(which)
11047 pack $top.l -side top
11048 set fontlist [lsort [font families]]
11049 ${NS}::frame $top.f
11050 listbox $top.f.fam -listvariable fontlist \
11051 -yscrollcommand [list $top.f.sb set]
11052 bind $top.f.fam <<ListboxSelect>> selfontfam
11053 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11054 pack $top.f.sb -side right -fill y
11055 pack $top.f.fam -side left -fill both -expand 1
11056 pack $top.f -side top -fill both -expand 1
11057 ${NS}::frame $top.g
11058 spinbox $top.g.size -from 4 -to 40 -width 4 \
11059 -textvariable fontparam(size) \
11060 -validatecommand {string is integer -strict %s}
11061 checkbutton $top.g.bold -padx 5 \
11062 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11063 -variable fontparam(weight) -onvalue bold -offvalue normal
11064 checkbutton $top.g.ital -padx 5 \
11065 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
11066 -variable fontparam(slant) -onvalue italic -offvalue roman
11067 pack $top.g.size $top.g.bold $top.g.ital -side left
11068 pack $top.g -side top
11069 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11071 $top.c create text 100 25 -anchor center -text $which -font sample \
11072 -fill black -tags text
11073 bind $top.c <Configure> [list centertext $top.c]
11074 pack $top.c -side top -fill x
11075 ${NS}::frame $top.buts
11076 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11077 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11078 bind $top <Key-Return> fontok
11079 bind $top <Key-Escape> fontcan
11080 grid $top.buts.ok $top.buts.can
11081 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11082 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11083 pack $top.buts -side bottom -fill x
11084 trace add variable fontparam write chg_fontparam
11087 $top.c itemconf text -text $which
11089 set i [lsearch -exact $fontlist $fontparam(family)]
11091 $top.f.fam selection set $i
11096 proc centertext {w} {
11097 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11101 global fontparam fontpref prefstop
11103 set f $fontparam(font)
11104 set fontpref($f) [list $fontparam(family) $fontparam(size)]
11105 if {$fontparam(weight) eq "bold"} {
11106 lappend fontpref($f) "bold"
11108 if {$fontparam(slant) eq "italic"} {
11109 lappend fontpref($f) "italic"
11111 set w $prefstop.notebook.fonts.$f
11112 $w conf -text $fontparam(family) -font $fontpref($f)
11118 global fonttop fontparam
11120 if {[info exists fonttop]} {
11121 catch {destroy $fonttop}
11122 catch {font delete sample}
11128 if {[package vsatisfies [package provide Tk] 8.6]} {
11129 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11130 # function to make use of it.
11131 proc choosefont {font which} {
11132 tk fontchooser configure -title $which -font $font \
11133 -command [list on_choosefont $font $which]
11134 tk fontchooser show
11136 proc on_choosefont {font which newfont} {
11138 puts stderr "$font $newfont"
11139 array set f [font actual $newfont]
11140 set fontparam(which) $which
11141 set fontparam(font) $font
11142 set fontparam(family) $f(-family)
11143 set fontparam(size) $f(-size)
11144 set fontparam(weight) $f(-weight)
11145 set fontparam(slant) $f(-slant)
11150 proc selfontfam {} {
11151 global fonttop fontparam
11153 set i [$fonttop.f.fam curselection]
11155 set fontparam(family) [$fonttop.f.fam get $i]
11159 proc chg_fontparam {v sub op} {
11162 font config sample -$sub $fontparam($sub)
11165 # Create a property sheet tab page
11166 proc create_prefs_page {w} {
11168 set parent [join [lrange [split $w .] 0 end-1] .]
11169 if {[winfo class $parent] eq "TNotebook"} {
11172 ${NS}::labelframe $w
11176 proc prefspage_general {notebook} {
11177 global NS maxwidth maxgraphpct showneartags showlocalchanges
11178 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11179 global hideremotes want_ttk have_ttk maxrefs
11181 set page [create_prefs_page $notebook.general]
11183 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11184 grid $page.ldisp - -sticky w -pady 10
11185 ${NS}::label $page.spacer -text " "
11186 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11187 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11188 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11189 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11190 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11191 grid x $page.maxpctl $page.maxpct -sticky w
11192 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11193 -variable showlocalchanges
11194 grid x $page.showlocal -sticky w
11195 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11196 -variable autoselect
11197 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11198 grid x $page.autoselect $page.autosellen -sticky w
11199 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11200 -variable hideremotes
11201 grid x $page.hideremotes -sticky w
11203 ${NS}::label $page.ddisp -text [mc "Diff display options"]
11204 grid $page.ddisp - -sticky w -pady 10
11205 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11206 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11207 grid x $page.tabstopl $page.tabstop -sticky w
11208 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11209 -variable showneartags
11210 grid x $page.ntag -sticky w
11211 ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11212 spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11213 grid x $page.maxrefsl $page.maxrefs -sticky w
11214 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11215 -variable limitdiffs
11216 grid x $page.ldiff -sticky w
11217 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11218 -variable perfile_attrs
11219 grid x $page.lattr -sticky w
11221 ${NS}::entry $page.extdifft -textvariable extdifftool
11222 ${NS}::frame $page.extdifff
11223 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11224 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11225 pack $page.extdifff.l $page.extdifff.b -side left
11226 pack configure $page.extdifff.l -padx 10
11227 grid x $page.extdifff $page.extdifft -sticky ew
11229 ${NS}::label $page.lgen -text [mc "General options"]
11230 grid $page.lgen - -sticky w -pady 10
11231 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11232 -text [mc "Use themed widgets"]
11234 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11236 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11238 grid x $page.want_ttk $page.ttk_note -sticky w
11242 proc prefspage_colors {notebook} {
11243 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11245 set page [create_prefs_page $notebook.colors]
11247 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11248 grid $page.cdisp - -sticky w -pady 10
11249 label $page.ui -padx 40 -relief sunk -background $uicolor
11250 ${NS}::button $page.uibut -text [mc "Interface"] \
11251 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11252 grid x $page.uibut $page.ui -sticky w
11253 label $page.bg -padx 40 -relief sunk -background $bgcolor
11254 ${NS}::button $page.bgbut -text [mc "Background"] \
11255 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11256 grid x $page.bgbut $page.bg -sticky w
11257 label $page.fg -padx 40 -relief sunk -background $fgcolor
11258 ${NS}::button $page.fgbut -text [mc "Foreground"] \
11259 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11260 grid x $page.fgbut $page.fg -sticky w
11261 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11262 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11263 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11264 [list $ctext tag conf d0 -foreground]]
11265 grid x $page.diffoldbut $page.diffold -sticky w
11266 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11267 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11268 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11269 [list $ctext tag conf dresult -foreground]]
11270 grid x $page.diffnewbut $page.diffnew -sticky w
11271 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11272 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11273 -command [list choosecolor diffcolors 2 $page.hunksep \
11274 [mc "diff hunk header"] \
11275 [list $ctext tag conf hunksep -foreground]]
11276 grid x $page.hunksepbut $page.hunksep -sticky w
11277 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11278 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11279 -command [list choosecolor markbgcolor {} $page.markbgsep \
11280 [mc "marked line background"] \
11281 [list $ctext tag conf omark -background]]
11282 grid x $page.markbgbut $page.markbgsep -sticky w
11283 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11284 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11285 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11286 grid x $page.selbgbut $page.selbgsep -sticky w
11290 proc prefspage_fonts {notebook} {
11292 set page [create_prefs_page $notebook.fonts]
11293 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11294 grid $page.cfont - -sticky w -pady 10
11295 mkfontdisp mainfont $page [mc "Main font"]
11296 mkfontdisp textfont $page [mc "Diff display font"]
11297 mkfontdisp uifont $page [mc "User interface font"]
11302 global maxwidth maxgraphpct use_ttk NS
11303 global oldprefs prefstop showneartags showlocalchanges
11304 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11305 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11306 global hideremotes want_ttk have_ttk
11310 if {[winfo exists $top]} {
11314 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11315 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11316 set oldprefs($v) [set $v]
11319 wm title $top [mc "Gitk preferences"]
11320 make_transient $top .
11322 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11323 set notebook [ttk::notebook $top.notebook]
11325 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11328 lappend pages [prefspage_general $notebook] [mc "General"]
11329 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11330 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11332 foreach {page title} $pages {
11333 if {$use_notebook} {
11334 $notebook add $page -text $title
11336 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11337 -text $title -command [list raise $page]]
11338 $page configure -text $title
11339 grid $btn -row 0 -column [incr col] -sticky w
11340 grid $page -row 1 -column 0 -sticky news -columnspan 100
11344 if {!$use_notebook} {
11345 grid columnconfigure $notebook 0 -weight 1
11346 grid rowconfigure $notebook 1 -weight 1
11347 raise [lindex $pages 0]
11350 grid $notebook -sticky news -padx 2 -pady 2
11351 grid rowconfigure $top 0 -weight 1
11352 grid columnconfigure $top 0 -weight 1
11354 ${NS}::frame $top.buts
11355 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11356 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11357 bind $top <Key-Return> prefsok
11358 bind $top <Key-Escape> prefscan
11359 grid $top.buts.ok $top.buts.can
11360 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11361 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11362 grid $top.buts - - -pady 10 -sticky ew
11363 grid columnconfigure $top 2 -weight 1
11364 bind $top <Visibility> [list focus $top.buts.ok]
11367 proc choose_extdiff {} {
11370 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11372 set extdifftool $prog
11376 proc choosecolor {v vi w x cmd} {
11379 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11380 -title [mc "Gitk: choose color for %s" $x]]
11381 if {$c eq {}} return
11382 $w conf -background $c
11387 proc setselbg {c} {
11388 global bglist cflist
11389 foreach w $bglist {
11390 $w configure -selectbackground $c
11392 $cflist tag configure highlight \
11393 -background [$cflist cget -selectbackground]
11394 allcanvs itemconf secsel -fill $c
11397 # This sets the background color and the color scheme for the whole UI.
11398 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11399 # if we don't specify one ourselves, which makes the checkbuttons and
11400 # radiobuttons look bad. This chooses white for selectColor if the
11401 # background color is light, or black if it is dark.
11403 if {[tk windowingsystem] eq "win32"} { return }
11404 set bg [winfo rgb . $c]
11406 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11409 tk_setPalette background $c selectColor $selc
11415 foreach w $bglist {
11416 $w conf -background $c
11423 foreach w $fglist {
11424 $w conf -foreground $c
11426 allcanvs itemconf text -fill $c
11427 $canv itemconf circle -outline $c
11428 $canv itemconf markid -outline $c
11432 global oldprefs prefstop
11434 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11435 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11437 set $v $oldprefs($v)
11439 catch {destroy $prefstop}
11445 global maxwidth maxgraphpct
11446 global oldprefs prefstop showneartags showlocalchanges
11447 global fontpref mainfont textfont uifont
11448 global limitdiffs treediffs perfile_attrs
11451 catch {destroy $prefstop}
11455 if {$mainfont ne $fontpref(mainfont)} {
11456 set mainfont $fontpref(mainfont)
11457 parsefont mainfont $mainfont
11458 eval font configure mainfont [fontflags mainfont]
11459 eval font configure mainfontbold [fontflags mainfont 1]
11463 if {$textfont ne $fontpref(textfont)} {
11464 set textfont $fontpref(textfont)
11465 parsefont textfont $textfont
11466 eval font configure textfont [fontflags textfont]
11467 eval font configure textfontbold [fontflags textfont 1]
11469 if {$uifont ne $fontpref(uifont)} {
11470 set uifont $fontpref(uifont)
11471 parsefont uifont $uifont
11472 eval font configure uifont [fontflags uifont]
11475 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11476 if {$showlocalchanges} {
11482 if {$limitdiffs != $oldprefs(limitdiffs) ||
11483 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11484 # treediffs elements are limited by path;
11485 # won't have encodings cached if perfile_attrs was just turned on
11486 catch {unset treediffs}
11488 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11489 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11491 } elseif {$showneartags != $oldprefs(showneartags) ||
11492 $limitdiffs != $oldprefs(limitdiffs)} {
11495 if {$hideremotes != $oldprefs(hideremotes)} {
11500 proc formatdate {d} {
11501 global datetimeformat
11503 set d [clock format [lindex $d 0] -format $datetimeformat]
11508 # This list of encoding names and aliases is distilled from
11509 # http://www.iana.org/assignments/character-sets.
11510 # Not all of them are supported by Tcl.
11511 set encoding_aliases {
11512 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11513 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11514 { ISO-10646-UTF-1 csISO10646UTF1 }
11515 { ISO_646.basic:1983 ref csISO646basic1983 }
11516 { INVARIANT csINVARIANT }
11517 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11518 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11519 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11520 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11521 { NATS-DANO iso-ir-9-1 csNATSDANO }
11522 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11523 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11524 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11525 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11526 { ISO-2022-KR csISO2022KR }
11528 { ISO-2022-JP csISO2022JP }
11529 { ISO-2022-JP-2 csISO2022JP2 }
11530 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11531 csISO13JISC6220jp }
11532 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11533 { IT iso-ir-15 ISO646-IT csISO15Italian }
11534 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11535 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11536 { greek7-old iso-ir-18 csISO18Greek7Old }
11537 { latin-greek iso-ir-19 csISO19LatinGreek }
11538 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11539 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11540 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11541 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11542 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11543 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11544 { INIS iso-ir-49 csISO49INIS }
11545 { INIS-8 iso-ir-50 csISO50INIS8 }
11546 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11547 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11548 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11549 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11550 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11551 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11552 csISO60Norwegian1 }
11553 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11554 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11555 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11556 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11557 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11558 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11559 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11560 { greek7 iso-ir-88 csISO88Greek7 }
11561 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11562 { iso-ir-90 csISO90 }
11563 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11564 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11565 csISO92JISC62991984b }
11566 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11567 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11568 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11569 csISO95JIS62291984handadd }
11570 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11571 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11572 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11573 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11574 CP819 csISOLatin1 }
11575 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11576 { T.61-7bit iso-ir-102 csISO102T617bit }
11577 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11578 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11579 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11580 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11581 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11582 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11583 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11584 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11585 arabic csISOLatinArabic }
11586 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11587 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11588 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11589 greek greek8 csISOLatinGreek }
11590 { T.101-G2 iso-ir-128 csISO128T101G2 }
11591 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11593 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11594 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11595 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11596 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11597 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11598 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11599 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11600 csISOLatinCyrillic }
11601 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11602 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11603 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11604 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11605 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11606 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11607 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11608 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11609 { ISO_10367-box iso-ir-155 csISO10367Box }
11610 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11611 { latin-lap lap iso-ir-158 csISO158Lap }
11612 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11613 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11616 { JIS_X0201 X0201 csHalfWidthKatakana }
11617 { KSC5636 ISO646-KR csKSC5636 }
11618 { ISO-10646-UCS-2 csUnicode }
11619 { ISO-10646-UCS-4 csUCS4 }
11620 { DEC-MCS dec csDECMCS }
11621 { hp-roman8 roman8 r8 csHPRoman8 }
11622 { macintosh mac csMacintosh }
11623 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11625 { IBM038 EBCDIC-INT cp038 csIBM038 }
11626 { IBM273 CP273 csIBM273 }
11627 { IBM274 EBCDIC-BE CP274 csIBM274 }
11628 { IBM275 EBCDIC-BR cp275 csIBM275 }
11629 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11630 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11631 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11632 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11633 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11634 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11635 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11636 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11637 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11638 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11639 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11640 { IBM437 cp437 437 csPC8CodePage437 }
11641 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11642 { IBM775 cp775 csPC775Baltic }
11643 { IBM850 cp850 850 csPC850Multilingual }
11644 { IBM851 cp851 851 csIBM851 }
11645 { IBM852 cp852 852 csPCp852 }
11646 { IBM855 cp855 855 csIBM855 }
11647 { IBM857 cp857 857 csIBM857 }
11648 { IBM860 cp860 860 csIBM860 }
11649 { IBM861 cp861 861 cp-is csIBM861 }
11650 { IBM862 cp862 862 csPC862LatinHebrew }
11651 { IBM863 cp863 863 csIBM863 }
11652 { IBM864 cp864 csIBM864 }
11653 { IBM865 cp865 865 csIBM865 }
11654 { IBM866 cp866 866 csIBM866 }
11655 { IBM868 CP868 cp-ar csIBM868 }
11656 { IBM869 cp869 869 cp-gr csIBM869 }
11657 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11658 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11659 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11660 { IBM891 cp891 csIBM891 }
11661 { IBM903 cp903 csIBM903 }
11662 { IBM904 cp904 904 csIBBM904 }
11663 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11664 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11665 { IBM1026 CP1026 csIBM1026 }
11666 { EBCDIC-AT-DE csIBMEBCDICATDE }
11667 { EBCDIC-AT-DE-A csEBCDICATDEA }
11668 { EBCDIC-CA-FR csEBCDICCAFR }
11669 { EBCDIC-DK-NO csEBCDICDKNO }
11670 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11671 { EBCDIC-FI-SE csEBCDICFISE }
11672 { EBCDIC-FI-SE-A csEBCDICFISEA }
11673 { EBCDIC-FR csEBCDICFR }
11674 { EBCDIC-IT csEBCDICIT }
11675 { EBCDIC-PT csEBCDICPT }
11676 { EBCDIC-ES csEBCDICES }
11677 { EBCDIC-ES-A csEBCDICESA }
11678 { EBCDIC-ES-S csEBCDICESS }
11679 { EBCDIC-UK csEBCDICUK }
11680 { EBCDIC-US csEBCDICUS }
11681 { UNKNOWN-8BIT csUnknown8BiT }
11682 { MNEMONIC csMnemonic }
11684 { VISCII csVISCII }
11687 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11688 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11689 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11690 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11691 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11692 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11693 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11694 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11695 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11696 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11697 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11698 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11699 { IBM1047 IBM-1047 }
11700 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11701 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11702 { UNICODE-1-1 csUnicode11 }
11703 { CESU-8 csCESU-8 }
11704 { BOCU-1 csBOCU-1 }
11705 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11706 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11708 { ISO-8859-15 ISO_8859-15 Latin-9 }
11709 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11710 { GBK CP936 MS936 windows-936 }
11711 { JIS_Encoding csJISEncoding }
11712 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11713 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11715 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11716 { ISO-10646-UCS-Basic csUnicodeASCII }
11717 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11718 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11719 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11720 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11721 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11722 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11723 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11724 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11725 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11726 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11727 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11728 { Ventura-US csVenturaUS }
11729 { Ventura-International csVenturaInternational }
11730 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11731 { PC8-Turkish csPC8Turkish }
11732 { IBM-Symbols csIBMSymbols }
11733 { IBM-Thai csIBMThai }
11734 { HP-Legal csHPLegal }
11735 { HP-Pi-font csHPPiFont }
11736 { HP-Math8 csHPMath8 }
11737 { Adobe-Symbol-Encoding csHPPSMath }
11738 { HP-DeskTop csHPDesktop }
11739 { Ventura-Math csVenturaMath }
11740 { Microsoft-Publishing csMicrosoftPublishing }
11741 { Windows-31J csWindows31J }
11742 { GB2312 csGB2312 }
11746 proc tcl_encoding {enc} {
11747 global encoding_aliases tcl_encoding_cache
11748 if {[info exists tcl_encoding_cache($enc)]} {
11749 return $tcl_encoding_cache($enc)
11751 set names [encoding names]
11752 set lcnames [string tolower $names]
11753 set enc [string tolower $enc]
11754 set i [lsearch -exact $lcnames $enc]
11756 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11757 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11758 set i [lsearch -exact $lcnames $encx]
11762 foreach l $encoding_aliases {
11763 set ll [string tolower $l]
11764 if {[lsearch -exact $ll $enc] < 0} continue
11765 # look through the aliases for one that tcl knows about
11767 set i [lsearch -exact $lcnames $e]
11769 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11770 set i [lsearch -exact $lcnames $ex]
11780 set tclenc [lindex $names $i]
11782 set tcl_encoding_cache($enc) $tclenc
11786 proc gitattr {path attr default} {
11787 global path_attr_cache
11788 if {[info exists path_attr_cache($attr,$path)]} {
11789 set r $path_attr_cache($attr,$path)
11791 set r "unspecified"
11792 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11793 regexp "(.*): $attr: (.*)" $line m f r
11795 set path_attr_cache($attr,$path) $r
11797 if {$r eq "unspecified"} {
11803 proc cache_gitattr {attr pathlist} {
11804 global path_attr_cache
11806 foreach path $pathlist {
11807 if {![info exists path_attr_cache($attr,$path)]} {
11808 lappend newlist $path
11812 if {[tk windowingsystem] == "win32"} {
11813 # windows has a 32k limit on the arguments to a command...
11816 while {$newlist ne {}} {
11817 set head [lrange $newlist 0 [expr {$lim - 1}]]
11818 set newlist [lrange $newlist $lim end]
11819 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11820 foreach row [split $rlist "\n"] {
11821 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11822 if {[string index $path 0] eq "\""} {
11823 set path [encoding convertfrom [lindex $path 0]]
11825 set path_attr_cache($attr,$path) $value
11832 proc get_path_encoding {path} {
11833 global gui_encoding perfile_attrs
11834 set tcl_enc $gui_encoding
11835 if {$path ne {} && $perfile_attrs} {
11836 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11844 # First check that Tcl/Tk is recent enough
11845 if {[catch {package require Tk 8.4} err]} {
11846 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11847 Gitk requires at least Tcl/Tk 8.4." list
11851 # on OSX bring the current Wish process window to front
11852 if {[tk windowingsystem] eq "aqua"} {
11853 exec osascript -e [format {
11854 tell application "System Events"
11855 set frontmost of processes whose unix id is %d to true
11860 # Unset GIT_TRACE var if set
11861 if { [info exists ::env(GIT_TRACE)] } {
11862 unset ::env(GIT_TRACE)
11866 set wrcomcmd "git diff-tree --stdin -p --pretty"
11870 set gitencoding [exec git config --get i18n.commitencoding]
11873 set gitencoding [exec git config --get i18n.logoutputencoding]
11875 if {$gitencoding == ""} {
11876 set gitencoding "utf-8"
11878 set tclencoding [tcl_encoding $gitencoding]
11879 if {$tclencoding == {}} {
11880 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11883 set gui_encoding [encoding system]
11885 set enc [exec git config --get gui.encoding]
11887 set tclenc [tcl_encoding $enc]
11888 if {$tclenc ne {}} {
11889 set gui_encoding $tclenc
11891 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11896 set log_showroot true
11898 set log_showroot [exec git config --bool --get log.showroot]
11901 if {[tk windowingsystem] eq "aqua"} {
11902 set mainfont {{Lucida Grande} 9}
11903 set textfont {Monaco 9}
11904 set uifont {{Lucida Grande} 9 bold}
11905 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11907 set mainfont {sans 9}
11908 set textfont {monospace 9}
11909 set uifont {sans 9 bold}
11911 set mainfont {Helvetica 9}
11912 set textfont {Courier 9}
11913 set uifont {Helvetica 9 bold}
11916 set findmergefiles 0
11924 set cmitmode "patch"
11925 set wrapcomment "none"
11930 set showlocalchanges 1
11932 set datetimeformat "%Y-%m-%d %H:%M:%S"
11935 set perfile_attrs 0
11938 if {[tk windowingsystem] eq "aqua"} {
11939 set extdifftool "opendiff"
11941 set extdifftool "meld"
11944 set colors {green red blue magenta darkgrey brown orange}
11945 if {[tk windowingsystem] eq "win32"} {
11946 set uicolor SystemButtonFace
11947 set uifgcolor SystemButtonText
11948 set uifgdisabledcolor SystemDisabledText
11949 set bgcolor SystemWindow
11950 set fgcolor SystemWindowText
11951 set selectbgcolor SystemHighlight
11954 set uifgcolor black
11955 set uifgdisabledcolor "#999"
11958 set selectbgcolor gray85
11960 set diffcolors {red "#00a000" blue}
11962 set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
11965 set markbgcolor "#e0e0ff"
11967 set headbgcolor green
11968 set headfgcolor black
11969 set headoutlinecolor black
11970 set remotebgcolor #ffddaa
11971 set tagbgcolor yellow
11972 set tagfgcolor black
11973 set tagoutlinecolor black
11974 set reflinecolor black
11975 set filesepbgcolor #aaaaaa
11976 set filesepfgcolor black
11977 set linehoverbgcolor #ffff80
11978 set linehoverfgcolor black
11979 set linehoveroutlinecolor black
11980 set mainheadcirclecolor yellow
11981 set workingfilescirclecolor red
11982 set indexcirclecolor green
11983 set circlecolors {white blue gray blue blue}
11984 set linkfgcolor blue
11985 set circleoutlinecolor $fgcolor
11986 set foundbgcolor yellow
11987 set currentsearchhitbgcolor orange
11989 # button for popping up context menus
11990 if {[tk windowingsystem] eq "aqua"} {
11991 set ctxbut <Button-2>
11993 set ctxbut <Button-3>
11996 ## For msgcat loading, first locate the installation location.
11997 if { [info exists ::env(GITK_MSGSDIR)] } {
11998 ## Msgsdir was manually set in the environment.
11999 set gitk_msgsdir $::env(GITK_MSGSDIR)
12001 ## Let's guess the prefix from argv0.
12002 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12003 set gitk_libdir [file join $gitk_prefix share gitk lib]
12004 set gitk_msgsdir [file join $gitk_libdir msgs]
12008 ## Internationalization (i18n) through msgcat and gettext. See
12009 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12010 package require msgcat
12011 namespace import ::msgcat::mc
12012 ## And eventually load the actual message catalog
12013 ::msgcat::mcload $gitk_msgsdir
12015 catch {source ~/.gitk}
12017 parsefont mainfont $mainfont
12018 eval font create mainfont [fontflags mainfont]
12019 eval font create mainfontbold [fontflags mainfont 1]
12021 parsefont textfont $textfont
12022 eval font create textfont [fontflags textfont]
12023 eval font create textfontbold [fontflags textfont 1]
12025 parsefont uifont $uifont
12026 eval font create uifont [fontflags uifont]
12032 # check that we can find a .git directory somewhere...
12033 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12034 show_error {} . [mc "Cannot find a git repository here."]
12039 set selectheadid {}
12042 set cmdline_files {}
12044 set revtreeargscmd {}
12045 foreach arg $argv {
12046 switch -glob -- $arg {
12049 set cmdline_files [lrange $argv [expr {$i + 1}] end]
12052 "--select-commit=*" {
12053 set selecthead [string range $arg 16 end]
12056 set revtreeargscmd [string range $arg 10 end]
12059 lappend revtreeargs $arg
12065 if {$selecthead eq "HEAD"} {
12069 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12070 # no -- on command line, but some arguments (other than --argscmd)
12072 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12073 set cmdline_files [split $f "\n"]
12074 set n [llength $cmdline_files]
12075 set revtreeargs [lrange $revtreeargs 0 end-$n]
12076 # Unfortunately git rev-parse doesn't produce an error when
12077 # something is both a revision and a filename. To be consistent
12078 # with git log and git rev-list, check revtreeargs for filenames.
12079 foreach arg $revtreeargs {
12080 if {[file exists $arg]} {
12081 show_error {} . [mc "Ambiguous argument '%s': both revision\
12082 and filename" $arg]
12087 # unfortunately we get both stdout and stderr in $err,
12088 # so look for "fatal:".
12089 set i [string first "fatal:" $err]
12091 set err [string range $err [expr {$i + 6}] end]
12093 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12098 set nullid "0000000000000000000000000000000000000000"
12099 set nullid2 "0000000000000000000000000000000000000001"
12100 set nullfile "/dev/null"
12102 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12103 if {![info exists have_ttk]} {
12104 set have_ttk [llength [info commands ::ttk::style]]
12106 set use_ttk [expr {$have_ttk && $want_ttk}]
12107 set NS [expr {$use_ttk ? "ttk" : ""}]
12109 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12112 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12113 set show_notes "--show-notes"
12123 set highlight_paths {}
12125 set searchdirn -forwards
12128 set diffelide {0 0}
12129 set markingmatches 0
12130 set linkentercount 0
12131 set need_redisplay 0
12138 set selectedhlview [mc "None"]
12139 set highlight_related [mc "None"]
12140 set highlight_files {}
12141 set viewfiles(0) {}
12144 set viewargscmd(0) {}
12146 set selectedline {}
12154 set hasworktree [hasworktree]
12156 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12157 set cdup [exec git rev-parse --show-cdup]
12159 set worktree [exec git rev-parse --show-toplevel]
12163 image create photo gitlogo -width 16 -height 16
12165 image create photo gitlogominus -width 4 -height 2
12166 gitlogominus put #C00000 -to 0 0 4 2
12167 gitlogo copy gitlogominus -to 1 5
12168 gitlogo copy gitlogominus -to 6 5
12169 gitlogo copy gitlogominus -to 11 5
12170 image delete gitlogominus
12172 image create photo gitlogoplus -width 4 -height 4
12173 gitlogoplus put #008000 -to 1 0 3 4
12174 gitlogoplus put #008000 -to 0 1 4 3
12175 gitlogo copy gitlogoplus -to 1 9
12176 gitlogo copy gitlogoplus -to 6 9
12177 gitlogo copy gitlogoplus -to 11 9
12178 image delete gitlogoplus
12180 image create photo gitlogo32 -width 32 -height 32
12181 gitlogo32 copy gitlogo -zoom 2 2
12183 wm iconphoto . -default gitlogo gitlogo32
12185 # wait for the window to become visible
12186 tkwait visibility .
12187 wm title . "$appname: [reponame]"
12191 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12192 # create a view for the files/dirs specified on the command line
12196 set viewname(1) [mc "Command line"]
12197 set viewfiles(1) $cmdline_files
12198 set viewargs(1) $revtreeargs
12199 set viewargscmd(1) $revtreeargscmd
12203 .bar.view entryconf [mca "Edit view..."] -state normal
12204 .bar.view entryconf [mca "Delete view"] -state normal
12207 if {[info exists permviews]} {
12208 foreach v $permviews {
12211 set viewname($n) [lindex $v 0]
12212 set viewfiles($n) [lindex $v 1]
12213 set viewargs($n) [lindex $v 2]
12214 set viewargscmd($n) [lindex $v 3]
12220 if {[tk windowingsystem] eq "win32"} {
12228 # indent-tabs-mode: t