2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright © 2005-2008 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
25 global isonrunq runq currunq
28 if {[info exists isonrunq
($script)]} return
29 if {$runq eq
{} && ![info exists currunq
]} {
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
44 if {$runq eq
{} && ![info exists currunq
]} {
47 lappend runq
[list
$fd $script]
53 for {set i
0} {$i < [llength
$runq]} {} {
54 if {[lindex
$runq $i 0] eq
$fd} {
55 set runq
[lreplace
$runq $i $i]
63 global isonrunq runq currunq
65 set tstart
[clock clicks
-milliseconds]
67 while {[llength
$runq] > 0} {
68 set fd
[lindex
$runq 0 0]
69 set script [lindex
$runq 0 1]
70 set currunq
[lindex
$runq 0]
71 set runq
[lrange
$runq 1 end
]
72 set repeat
[eval $script]
74 set t1
[clock clicks
-milliseconds]
75 set t
[expr {$t1 - $t0}]
76 if {$repeat ne
{} && $repeat} {
77 if {$fd eq
{} ||
$repeat == 2} {
78 # script returns 1 if it wants to be readded
79 # file readers return 2 if they could do more straight away
80 lappend runq
[list
$fd $script]
82 fileevent
$fd readable
[list filereadable
$fd $script]
84 } elseif
{$fd eq
{}} {
85 unset isonrunq
($script)
88 if {$t1 - $tstart >= 80} break
95 proc reg_instance
{fd
} {
96 global commfd leftover loginstance
98 set i
[incr loginstance
]
104 proc unmerged_files
{files
} {
107 # find the list of unmerged files
111 set fd
[open
"| git ls-files -u" r
]
113 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
116 while {[gets $fd line] >= 0} {
117 set i [string first "\t" $line]
119 set fname [string range $line [expr {$i+1}] end]
120 if {[lsearch -exact $mlist $fname] >= 0} continue
122 if {$files eq {} || [path_filter $files $fname]} {
130 proc parseviewargs {n arglist} {
131 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
139 set origargs $arglist
143 foreach arg $arglist {
150 switch -glob -- $arg {
154 # remove from origargs in case we hit an unknown option
155 set origargs [lreplace $origargs $i $i]
159 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
160 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
161 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
162 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
163 "--ignore-space-change" - "-U*" - "--unified=*" {
164 # These request or affect diff output, which we don't want.
165 # Some could be used to set our defaults for diff display.
166 lappend diffargs
$arg
168 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
169 "--name-only" - "--name-status" - "--color" - "--color-words" -
170 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
171 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
172 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
173 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
174 "--objects" - "--objects-edge" - "--reverse" {
175 # These cause our parsing of git log's output to fail, or else
176 # they're options we want to set ourselves, so ignore them.
178 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
179 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
180 "--full-history" - "--dense" - "--sparse" -
181 "--follow" - "--left-right" - "--encoding=*" {
182 # These are harmless, and some are even useful
185 "--diff-filter=*" - "--no-merges" - "--unpacked" -
186 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
187 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
188 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
189 "--remove-empty" - "--first-parent" - "--cherry-pick" -
190 "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
191 "--simplify-by-decoration" {
192 # These mean that we get a subset of the commits
197 # This appears to be the only one that has a value as a
198 # separate word following it
208 # git rev-parse doesn't understand --merge
209 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
212 # Other flag arguments including -<n>
213 if {[string is digit
-strict [string range
$arg 1 end
]]} {
216 # a flag argument that we don't recognize;
217 # that means we can't optimize
223 # Non-flag arguments specify commits or ranges of commits
224 if {[string match
"*...*" $arg]} {
225 lappend revargs
--gitk-symmetric-diff-marker
231 set vdflags
($n) $diffargs
232 set vflags
($n) $glflags
233 set vrevs
($n) $revargs
234 set vfiltered
($n) $filtered
235 set vorigargs
($n) $origargs
239 proc parseviewrevs
{view revs
} {
240 global vposids vnegids
245 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
246 # we get stdout followed by stderr in $err
247 # for an unknown rev, git rev-parse echoes it and then errors out
248 set errlines
[split $err "\n"]
250 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
251 set line
[lindex
$errlines $l]
252 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
253 if {[string match
"fatal:*" $line]} {
254 if {[string match
"fatal: ambiguous argument*" $line]
256 if {[llength
$badrev] == 1} {
257 set err
"unknown revision $badrev"
259 set err
"unknown revisions: [join $badrev ", "]"
262 set err
[join [lrange
$errlines $l end
] "\n"]
269 error_popup
"[mc "Error parsing revisions
:"] $err"
276 foreach id
[split $ids "\n"] {
277 if {$id eq
"--gitk-symmetric-diff-marker"} {
279 } elseif
{[string match
"^*" $id]} {
286 lappend neg
[string range
$id 1 end
]
291 lset ret end
$id...
[lindex
$ret end
]
297 set vposids
($view) $pos
298 set vnegids
($view) $neg
302 # Start off a git log process and arrange to read its output
303 proc start_rev_list
{view
} {
304 global startmsecs commitidx viewcomplete curview
306 global viewargs viewargscmd viewfiles vfilelimit
307 global showlocalchanges
308 global viewactive viewinstances vmergeonly
309 global mainheadid viewmainheadid viewmainheadid_orig
310 global vcanopt vflags vrevs vorigargs
312 set startmsecs
[clock clicks
-milliseconds]
313 set commitidx
($view) 0
314 # these are set this way for the error exits
315 set viewcomplete
($view) 1
316 set viewactive
($view) 0
319 set args
$viewargs($view)
320 if {$viewargscmd($view) ne
{}} {
322 set str
[exec sh
-c $viewargscmd($view)]
324 error_popup
"[mc "Error executing
--argscmd command:"] $err"
327 set args
[concat
$args [split $str "\n"]]
329 set vcanopt
($view) [parseviewargs
$view $args]
331 set files
$viewfiles($view)
332 if {$vmergeonly($view)} {
333 set files
[unmerged_files
$files]
336 if {$nr_unmerged == 0} {
337 error_popup
[mc
"No files selected: --merge specified but\
338 no files are unmerged."]
340 error_popup
[mc
"No files selected: --merge specified but\
341 no unmerged files are within file limit."]
346 set vfilelimit
($view) $files
348 if {$vcanopt($view)} {
349 set revs
[parseviewrevs
$view $vrevs($view)]
353 set args
[concat
$vflags($view) $revs]
355 set args
$vorigargs($view)
359 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
360 --boundary $args "--" $files] r
]
362 error_popup
"[mc "Error executing git log
:"] $err"
365 set i
[reg_instance
$fd]
366 set viewinstances
($view) [list
$i]
367 set viewmainheadid
($view) $mainheadid
368 set viewmainheadid_orig
($view) $mainheadid
369 if {$files ne
{} && $mainheadid ne
{}} {
370 get_viewmainhead
$view
372 if {$showlocalchanges && $viewmainheadid($view) ne
{}} {
373 interestedin
$viewmainheadid($view) dodiffindex
375 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
376 if {$tclencoding != {}} {
377 fconfigure
$fd -encoding $tclencoding
379 filerun
$fd [list getcommitlines
$fd $i $view 0]
380 nowbusy
$view [mc
"Reading"]
381 set viewcomplete
($view) 0
382 set viewactive
($view) 1
386 proc stop_instance
{inst
} {
387 global commfd leftover
389 set fd
$commfd($inst)
393 if {$
::tcl_platform
(platform
) eq
{windows
}} {
402 unset leftover
($inst)
405 proc stop_backends
{} {
408 foreach inst
[array names commfd
] {
413 proc stop_rev_list
{view
} {
416 foreach inst
$viewinstances($view) {
419 set viewinstances
($view) {}
422 proc reset_pending_select
{selid
} {
423 global pending_select mainheadid selectheadid
426 set pending_select
$selid
427 } elseif
{$selectheadid ne
{}} {
428 set pending_select
$selectheadid
430 set pending_select
$mainheadid
434 proc getcommits
{selid
} {
435 global canv curview need_redisplay viewactive
438 if {[start_rev_list
$curview]} {
439 reset_pending_select
$selid
440 show_status
[mc
"Reading commits..."]
443 show_status
[mc
"No commits selected"]
447 proc updatecommits
{} {
448 global curview vcanopt vorigargs vfilelimit viewinstances
449 global viewactive viewcomplete tclencoding
450 global startmsecs showneartags showlocalchanges
451 global mainheadid viewmainheadid viewmainheadid_orig pending_select
453 global varcid vposids vnegids vflags vrevs
455 set isworktree
[expr {[exec git rev-parse
--is-inside-work-tree] == "true"}]
458 if {$mainheadid ne
$viewmainheadid_orig($view)} {
459 if {$showlocalchanges} {
462 set viewmainheadid
($view) $mainheadid
463 set viewmainheadid_orig
($view) $mainheadid
464 if {$vfilelimit($view) ne
{}} {
465 get_viewmainhead
$view
468 if {$showlocalchanges} {
471 if {$vcanopt($view)} {
472 set oldpos
$vposids($view)
473 set oldneg
$vnegids($view)
474 set revs
[parseviewrevs
$view $vrevs($view)]
478 # note: getting the delta when negative refs change is hard,
479 # and could require multiple git log invocations, so in that
480 # case we ask git log for all the commits (not just the delta)
481 if {$oldneg eq
$vnegids($view)} {
484 # take out positive refs that we asked for before or
485 # that we have already seen
487 if {[string length
$rev] == 40} {
488 if {[lsearch
-exact $oldpos $rev] < 0
489 && ![info exists varcid
($view,$rev)]} {
494 lappend
$newrevs $rev
497 if {$npos == 0} return
499 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
501 set args
[concat
$vflags($view) $revs --not $oldpos]
503 set args
$vorigargs($view)
506 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
507 --boundary $args "--" $vfilelimit($view)] r
]
509 error_popup
"[mc "Error executing git log
:"] $err"
512 if {$viewactive($view) == 0} {
513 set startmsecs
[clock clicks
-milliseconds]
515 set i
[reg_instance
$fd]
516 lappend viewinstances
($view) $i
517 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
518 if {$tclencoding != {}} {
519 fconfigure
$fd -encoding $tclencoding
521 filerun
$fd [list getcommitlines
$fd $i $view 1]
522 incr viewactive
($view)
523 set viewcomplete
($view) 0
524 reset_pending_select
{}
525 nowbusy
$view [mc
"Reading"]
531 proc reloadcommits
{} {
532 global curview viewcomplete selectedline currentid thickerline
533 global showneartags treediffs commitinterest cached_commitrow
537 if {$selectedline ne
{}} {
541 if {!$viewcomplete($curview)} {
542 stop_rev_list
$curview
546 catch
{unset currentid
}
547 catch
{unset thickerline
}
548 catch
{unset treediffs
}
555 catch
{unset commitinterest
}
556 catch
{unset cached_commitrow
}
557 catch
{unset targetid
}
563 # This makes a string representation of a positive integer which
564 # sorts as a string in numerical order
567 return [format
"%x" $n]
568 } elseif
{$n < 256} {
569 return [format
"x%.2x" $n]
570 } elseif
{$n < 65536} {
571 return [format
"y%.4x" $n]
573 return [format
"z%.8x" $n]
576 # Procedures used in reordering commits from git log (without
577 # --topo-order) into the order for display.
579 proc varcinit
{view
} {
580 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
581 global vtokmod varcmod vrowmod varcix vlastins
583 set varcstart
($view) {{}}
584 set vupptr
($view) {0}
585 set vdownptr
($view) {0}
586 set vleftptr
($view) {0}
587 set vbackptr
($view) {0}
588 set varctok
($view) {{}}
589 set varcrow
($view) {{}}
590 set vtokmod
($view) {}
593 set varcix
($view) {{}}
594 set vlastins
($view) {0}
597 proc resetvarcs
{view
} {
598 global varcid varccommits parents children vseedcount ordertok
600 foreach vid
[array names varcid
$view,*] {
605 # some commits might have children but haven't been seen yet
606 foreach vid
[array names children
$view,*] {
609 foreach va
[array names varccommits
$view,*] {
610 unset varccommits
($va)
612 foreach vd
[array names vseedcount
$view,*] {
613 unset vseedcount
($vd)
615 catch
{unset ordertok
}
618 # returns a list of the commits with no children
620 global vdownptr vleftptr varcstart
623 set a
[lindex
$vdownptr($v) 0]
625 lappend ret
[lindex
$varcstart($v) $a]
626 set a
[lindex
$vleftptr($v) $a]
631 proc newvarc
{view id
} {
632 global varcid varctok parents children vdatemode
633 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
634 global commitdata commitinfo vseedcount varccommits vlastins
636 set a
[llength
$varctok($view)]
638 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
639 if {![info exists commitinfo
($id)]} {
640 parsecommit
$id $commitdata($id) 1
642 set cdate
[lindex
$commitinfo($id) 4]
643 if {![string is integer
-strict $cdate]} {
646 if {![info exists vseedcount
($view,$cdate)]} {
647 set vseedcount
($view,$cdate) -1
649 set c
[incr vseedcount
($view,$cdate)]
650 set cdate
[expr {$cdate ^
0xffffffff}]
651 set tok
"s[strrep $cdate][strrep $c]"
656 if {[llength
$children($vid)] > 0} {
657 set kid
[lindex
$children($vid) end
]
658 set k
$varcid($view,$kid)
659 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
662 set tok
[lindex
$varctok($view) $k]
666 set i
[lsearch
-exact $parents($view,$ki) $id]
667 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
668 append tok
[strrep
$j]
670 set c
[lindex
$vlastins($view) $ka]
671 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
673 set b
[lindex
$vdownptr($view) $ka]
675 set b
[lindex
$vleftptr($view) $c]
677 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
679 set b
[lindex
$vleftptr($view) $c]
682 lset vdownptr
($view) $ka $a
683 lappend vbackptr
($view) 0
685 lset vleftptr
($view) $c $a
686 lappend vbackptr
($view) $c
688 lset vlastins
($view) $ka $a
689 lappend vupptr
($view) $ka
690 lappend vleftptr
($view) $b
692 lset vbackptr
($view) $b $a
694 lappend varctok
($view) $tok
695 lappend varcstart
($view) $id
696 lappend vdownptr
($view) 0
697 lappend varcrow
($view) {}
698 lappend varcix
($view) {}
699 set varccommits
($view,$a) {}
700 lappend vlastins
($view) 0
704 proc splitvarc
{p v
} {
705 global varcid varcstart varccommits varctok vtokmod
706 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
708 set oa
$varcid($v,$p)
709 set otok
[lindex
$varctok($v) $oa]
710 set ac
$varccommits($v,$oa)
711 set i
[lsearch
-exact $varccommits($v,$oa) $p]
713 set na
[llength
$varctok($v)]
714 # "%" sorts before "0"...
715 set tok
"$otok%[strrep $i]"
716 lappend varctok
($v) $tok
717 lappend varcrow
($v) {}
718 lappend varcix
($v) {}
719 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
720 set varccommits
($v,$na) [lrange
$ac $i end
]
721 lappend varcstart
($v) $p
722 foreach id
$varccommits($v,$na) {
723 set varcid
($v,$id) $na
725 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
726 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
727 lset vdownptr
($v) $oa $na
728 lset vlastins
($v) $oa 0
729 lappend vupptr
($v) $oa
730 lappend vleftptr
($v) 0
731 lappend vbackptr
($v) 0
732 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
733 lset vupptr
($v) $b $na
735 if {[string compare
$otok $vtokmod($v)] <= 0} {
740 proc renumbervarc
{a v
} {
741 global parents children varctok varcstart varccommits
742 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
744 set t1
[clock clicks
-milliseconds]
750 if {[info exists isrelated
($a)]} {
752 set id
[lindex
$varccommits($v,$a) end
]
753 foreach p
$parents($v,$id) {
754 if {[info exists varcid
($v,$p)]} {
755 set isrelated
($varcid($v,$p)) 1
760 set b
[lindex
$vdownptr($v) $a]
763 set b
[lindex
$vleftptr($v) $a]
765 set a
[lindex
$vupptr($v) $a]
771 if {![info exists kidchanged
($a)]} continue
772 set id
[lindex
$varcstart($v) $a]
773 if {[llength
$children($v,$id)] > 1} {
774 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
777 set oldtok
[lindex
$varctok($v) $a]
778 if {!$vdatemode($v)} {
784 set kid
[last_real_child
$v,$id]
786 set k
$varcid($v,$kid)
787 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
790 set tok
[lindex
$varctok($v) $k]
794 set i
[lsearch
-exact $parents($v,$ki) $id]
795 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
796 append tok
[strrep
$j]
798 if {$tok eq
$oldtok} {
801 set id
[lindex
$varccommits($v,$a) end
]
802 foreach p
$parents($v,$id) {
803 if {[info exists varcid
($v,$p)]} {
804 set kidchanged
($varcid($v,$p)) 1
809 lset varctok
($v) $a $tok
810 set b
[lindex
$vupptr($v) $a]
812 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
815 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
818 set c
[lindex
$vbackptr($v) $a]
819 set d
[lindex
$vleftptr($v) $a]
821 lset vdownptr
($v) $b $d
823 lset vleftptr
($v) $c $d
826 lset vbackptr
($v) $d $c
828 if {[lindex
$vlastins($v) $b] == $a} {
829 lset vlastins
($v) $b $c
831 lset vupptr
($v) $a $ka
832 set c
[lindex
$vlastins($v) $ka]
834 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
836 set b
[lindex
$vdownptr($v) $ka]
838 set b
[lindex
$vleftptr($v) $c]
841 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
843 set b
[lindex
$vleftptr($v) $c]
846 lset vdownptr
($v) $ka $a
847 lset vbackptr
($v) $a 0
849 lset vleftptr
($v) $c $a
850 lset vbackptr
($v) $a $c
852 lset vleftptr
($v) $a $b
854 lset vbackptr
($v) $b $a
856 lset vlastins
($v) $ka $a
859 foreach id
[array names sortkids
] {
860 if {[llength
$children($v,$id)] > 1} {
861 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
865 set t2
[clock clicks
-milliseconds]
866 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
869 # Fix up the graph after we have found out that in view $v,
870 # $p (a commit that we have already seen) is actually the parent
871 # of the last commit in arc $a.
872 proc fix_reversal
{p a v
} {
873 global varcid varcstart varctok vupptr
875 set pa
$varcid($v,$p)
876 if {$p ne
[lindex
$varcstart($v) $pa]} {
878 set pa
$varcid($v,$p)
880 # seeds always need to be renumbered
881 if {[lindex
$vupptr($v) $pa] == 0 ||
882 [string compare
[lindex
$varctok($v) $a] \
883 [lindex
$varctok($v) $pa]] > 0} {
888 proc insertrow
{id p v
} {
889 global cmitlisted children parents varcid varctok vtokmod
890 global varccommits ordertok commitidx numcommits curview
891 global targetid targetrow
895 set cmitlisted
($vid) 1
896 set children
($vid) {}
897 set parents
($vid) [list
$p]
898 set a
[newvarc
$v $id]
900 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
903 lappend varccommits
($v,$a) $id
905 if {[llength
[lappend children
($vp) $id]] > 1} {
906 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
907 catch
{unset ordertok
}
909 fix_reversal
$p $a $v
911 if {$v == $curview} {
912 set numcommits
$commitidx($v)
914 if {[info exists targetid
]} {
915 if {![comes_before
$targetid $p]} {
922 proc insertfakerow
{id p
} {
923 global varcid varccommits parents children cmitlisted
924 global commitidx varctok vtokmod targetid targetrow curview numcommits
928 set i
[lsearch
-exact $varccommits($v,$a) $p]
930 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
933 set children
($v,$id) {}
934 set parents
($v,$id) [list
$p]
935 set varcid
($v,$id) $a
936 lappend children
($v,$p) $id
937 set cmitlisted
($v,$id) 1
938 set numcommits
[incr commitidx
($v)]
939 # note we deliberately don't update varcstart($v) even if $i == 0
940 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
942 if {[info exists targetid
]} {
943 if {![comes_before
$targetid $p]} {
951 proc removefakerow
{id
} {
952 global varcid varccommits parents children commitidx
953 global varctok vtokmod cmitlisted currentid selectedline
954 global targetid curview numcommits
957 if {[llength
$parents($v,$id)] != 1} {
958 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
961 set p
[lindex
$parents($v,$id) 0]
962 set a
$varcid($v,$id)
963 set i
[lsearch
-exact $varccommits($v,$a) $id]
965 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
969 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
970 unset parents
($v,$id)
971 unset children
($v,$id)
972 unset cmitlisted
($v,$id)
973 set numcommits
[incr commitidx
($v) -1]
974 set j
[lsearch
-exact $children($v,$p) $id]
976 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
979 if {[info exist currentid
] && $id eq
$currentid} {
983 if {[info exists targetid
] && $targetid eq
$id} {
990 proc first_real_child
{vp
} {
991 global children nullid nullid2
993 foreach id
$children($vp) {
994 if {$id ne
$nullid && $id ne
$nullid2} {
1001 proc last_real_child
{vp
} {
1002 global children nullid nullid2
1004 set kids
$children($vp)
1005 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
1006 set id
[lindex
$kids $i]
1007 if {$id ne
$nullid && $id ne
$nullid2} {
1014 proc vtokcmp
{v a b
} {
1015 global varctok varcid
1017 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1018 [lindex
$varctok($v) $varcid($v,$b)]]
1021 # This assumes that if lim is not given, the caller has checked that
1022 # arc a's token is less than $vtokmod($v)
1023 proc modify_arc
{v a
{lim
{}}} {
1024 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1027 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1030 set r
[lindex
$varcrow($v) $a]
1031 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1034 set vtokmod
($v) [lindex
$varctok($v) $a]
1036 if {$v == $curview} {
1037 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1038 set a
[lindex
$vupptr($v) $a]
1044 set lim
[llength
$varccommits($v,$a)]
1046 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1053 proc update_arcrows
{v
} {
1054 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1055 global varcid vrownum varcorder varcix varccommits
1056 global vupptr vdownptr vleftptr varctok
1057 global displayorder parentlist curview cached_commitrow
1059 if {$vrowmod($v) == $commitidx($v)} return
1060 if {$v == $curview} {
1061 if {[llength
$displayorder] > $vrowmod($v)} {
1062 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1063 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1065 catch
{unset cached_commitrow
}
1067 set narctot
[expr {[llength
$varctok($v)] - 1}]
1069 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1070 # go up the tree until we find something that has a row number,
1071 # or we get to a seed
1072 set a
[lindex
$vupptr($v) $a]
1075 set a
[lindex
$vdownptr($v) 0]
1078 set varcorder
($v) [list
$a]
1079 lset varcix
($v) $a 0
1080 lset varcrow
($v) $a 0
1084 set arcn
[lindex
$varcix($v) $a]
1085 if {[llength
$vrownum($v)] > $arcn + 1} {
1086 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1087 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1089 set row
[lindex
$varcrow($v) $a]
1093 incr row
[llength
$varccommits($v,$a)]
1094 # go down if possible
1095 set b
[lindex
$vdownptr($v) $a]
1097 # if not, go left, or go up until we can go left
1099 set b
[lindex
$vleftptr($v) $a]
1101 set a
[lindex
$vupptr($v) $a]
1107 lappend vrownum
($v) $row
1108 lappend varcorder
($v) $a
1109 lset varcix
($v) $a $arcn
1110 lset varcrow
($v) $a $row
1112 set vtokmod
($v) [lindex
$varctok($v) $p]
1114 set vrowmod
($v) $row
1115 if {[info exists currentid
]} {
1116 set selectedline
[rowofcommit
$currentid]
1120 # Test whether view $v contains commit $id
1121 proc commitinview
{id v
} {
1124 return [info exists varcid
($v,$id)]
1127 # Return the row number for commit $id in the current view
1128 proc rowofcommit
{id
} {
1129 global varcid varccommits varcrow curview cached_commitrow
1130 global varctok vtokmod
1133 if {![info exists varcid
($v,$id)]} {
1134 puts
"oops rowofcommit no arc for [shortids $id]"
1137 set a
$varcid($v,$id)
1138 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1141 if {[info exists cached_commitrow
($id)]} {
1142 return $cached_commitrow($id)
1144 set i
[lsearch
-exact $varccommits($v,$a) $id]
1146 puts
"oops didn't find commit [shortids $id] in arc $a"
1149 incr i
[lindex
$varcrow($v) $a]
1150 set cached_commitrow
($id) $i
1154 # Returns 1 if a is on an earlier row than b, otherwise 0
1155 proc comes_before
{a b
} {
1156 global varcid varctok curview
1159 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1160 ![info exists varcid
($v,$b)]} {
1163 if {$varcid($v,$a) != $varcid($v,$b)} {
1164 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1165 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1167 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1170 proc bsearch
{l elt
} {
1171 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1176 while {$hi - $lo > 1} {
1177 set mid
[expr {int
(($lo + $hi) / 2)}]
1178 set t
[lindex
$l $mid]
1181 } elseif
{$elt > $t} {
1190 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1191 proc make_disporder
{start end
} {
1192 global vrownum curview commitidx displayorder parentlist
1193 global varccommits varcorder parents vrowmod varcrow
1194 global d_valid_start d_valid_end
1196 if {$end > $vrowmod($curview)} {
1197 update_arcrows
$curview
1199 set ai
[bsearch
$vrownum($curview) $start]
1200 set start
[lindex
$vrownum($curview) $ai]
1201 set narc
[llength
$vrownum($curview)]
1202 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1203 set a
[lindex
$varcorder($curview) $ai]
1204 set l
[llength
$displayorder]
1205 set al
[llength
$varccommits($curview,$a)]
1206 if {$l < $r + $al} {
1208 set pad
[ntimes
[expr {$r - $l}] {}]
1209 set displayorder
[concat
$displayorder $pad]
1210 set parentlist
[concat
$parentlist $pad]
1211 } elseif
{$l > $r} {
1212 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1213 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1215 foreach id
$varccommits($curview,$a) {
1216 lappend displayorder
$id
1217 lappend parentlist
$parents($curview,$id)
1219 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1221 foreach id
$varccommits($curview,$a) {
1222 lset displayorder
$i $id
1223 lset parentlist
$i $parents($curview,$id)
1231 proc commitonrow
{row
} {
1234 set id
[lindex
$displayorder $row]
1236 make_disporder
$row [expr {$row + 1}]
1237 set id
[lindex
$displayorder $row]
1242 proc closevarcs
{v
} {
1243 global varctok varccommits varcid parents children
1244 global cmitlisted commitidx vtokmod
1246 set missing_parents
0
1248 set narcs
[llength
$varctok($v)]
1249 for {set a
1} {$a < $narcs} {incr a
} {
1250 set id
[lindex
$varccommits($v,$a) end
]
1251 foreach p
$parents($v,$id) {
1252 if {[info exists varcid
($v,$p)]} continue
1253 # add p as a new commit
1254 incr missing_parents
1255 set cmitlisted
($v,$p) 0
1256 set parents
($v,$p) {}
1257 if {[llength
$children($v,$p)] == 1 &&
1258 [llength
$parents($v,$id)] == 1} {
1261 set b
[newvarc
$v $p]
1263 set varcid
($v,$p) $b
1264 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1267 lappend varccommits
($v,$b) $p
1269 set scripts
[check_interest
$p $scripts]
1272 if {$missing_parents > 0} {
1273 foreach s
$scripts {
1279 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1280 # Assumes we already have an arc for $rwid.
1281 proc rewrite_commit
{v id rwid
} {
1282 global children parents varcid varctok vtokmod varccommits
1284 foreach ch
$children($v,$id) {
1285 # make $rwid be $ch's parent in place of $id
1286 set i
[lsearch
-exact $parents($v,$ch) $id]
1288 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1290 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1291 # add $ch to $rwid's children and sort the list if necessary
1292 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1293 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1294 $children($v,$rwid)]
1296 # fix the graph after joining $id to $rwid
1297 set a
$varcid($v,$ch)
1298 fix_reversal
$rwid $a $v
1299 # parentlist is wrong for the last element of arc $a
1300 # even if displayorder is right, hence the 3rd arg here
1301 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1305 # Mechanism for registering a command to be executed when we come
1306 # across a particular commit. To handle the case when only the
1307 # prefix of the commit is known, the commitinterest array is now
1308 # indexed by the first 4 characters of the ID. Each element is a
1309 # list of id, cmd pairs.
1310 proc interestedin
{id cmd
} {
1311 global commitinterest
1313 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1316 proc check_interest
{id scripts
} {
1317 global commitinterest
1319 set prefix
[string range
$id 0 3]
1320 if {[info exists commitinterest
($prefix)]} {
1322 foreach
{i
script} $commitinterest($prefix) {
1323 if {[string match
"$i*" $id]} {
1324 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1326 lappend newlist
$i $script
1329 if {$newlist ne
{}} {
1330 set commitinterest
($prefix) $newlist
1332 unset commitinterest
($prefix)
1338 proc getcommitlines
{fd inst view updating
} {
1339 global cmitlisted leftover
1340 global commitidx commitdata vdatemode
1341 global parents children curview hlview
1342 global idpending ordertok
1343 global varccommits varcid varctok vtokmod vfilelimit
1345 set stuff
[read $fd 500000]
1346 # git log doesn't terminate the last commit with a null...
1347 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1354 global commfd viewcomplete viewactive viewname
1355 global viewinstances
1357 set i
[lsearch
-exact $viewinstances($view) $inst]
1359 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1361 # set it blocking so we wait for the process to terminate
1362 fconfigure
$fd -blocking 1
1363 if {[catch
{close
$fd} err
]} {
1365 if {$view != $curview} {
1366 set fv
" for the \"$viewname($view)\" view"
1368 if {[string range
$err 0 4] == "usage"} {
1369 set err
"Gitk: error reading commits$fv:\
1370 bad arguments to git log."
1371 if {$viewname($view) eq
"Command line"} {
1373 " (Note: arguments to gitk are passed to git log\
1374 to allow selection of commits to be displayed.)"
1377 set err
"Error reading commits$fv: $err"
1381 if {[incr viewactive
($view) -1] <= 0} {
1382 set viewcomplete
($view) 1
1383 # Check if we have seen any ids listed as parents that haven't
1384 # appeared in the list
1388 if {$view == $curview} {
1397 set i
[string first
"\0" $stuff $start]
1399 append leftover
($inst) [string range
$stuff $start end
]
1403 set cmit
$leftover($inst)
1404 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1405 set leftover
($inst) {}
1407 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1409 set start
[expr {$i + 1}]
1410 set j
[string first
"\n" $cmit]
1413 if {$j >= 0 && [string match
"commit *" $cmit]} {
1414 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1415 if {[string match
{[-^
<>]*} $ids]} {
1416 switch
-- [string index
$ids 0] {
1422 set ids
[string range
$ids 1 end
]
1426 if {[string length
$id] != 40} {
1434 if {[string length
$shortcmit] > 80} {
1435 set shortcmit
"[string range $shortcmit 0 80]..."
1437 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1440 set id [lindex $ids 0]
1443 if {!$listed && $updating && ![info exists varcid($vid)] &&
1444 $vfilelimit($view) ne {}} {
1445 # git log doesn't rewrite parents
for unlisted commits
1446 # when doing path limiting, so work around that here
1447 # by working out the rewritten parent with git rev-list
1448 # and if we already know about it, using the rewritten
1449 # parent as a substitute parent for $id's children.
1451 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1452 $id -- $vfilelimit($view)]
1454 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1455 # use $rwid in place of $id
1456 rewrite_commit
$view $id $rwid
1463 if {[info exists varcid
($vid)]} {
1464 if {$cmitlisted($vid) ||
!$listed} continue
1468 set olds
[lrange
$ids 1 end
]
1472 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1473 set cmitlisted
($vid) $listed
1474 set parents
($vid) $olds
1475 if {![info exists children
($vid)]} {
1476 set children
($vid) {}
1477 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1478 set k
[lindex
$children($vid) 0]
1479 if {[llength
$parents($view,$k)] == 1 &&
1480 (!$vdatemode($view) ||
1481 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1482 set a
$varcid($view,$k)
1487 set a
[newvarc
$view $id]
1489 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1492 if {![info exists varcid
($vid)]} {
1494 lappend varccommits
($view,$a) $id
1495 incr commitidx
($view)
1500 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1502 if {[llength
[lappend children
($vp) $id]] > 1 &&
1503 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1504 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1506 catch
{unset ordertok
}
1508 if {[info exists varcid
($view,$p)]} {
1509 fix_reversal
$p $a $view
1515 set scripts
[check_interest
$id $scripts]
1519 global numcommits hlview
1521 if {$view == $curview} {
1522 set numcommits
$commitidx($view)
1525 if {[info exists hlview
] && $view == $hlview} {
1526 # we never actually get here...
1529 foreach s
$scripts {
1536 proc chewcommits
{} {
1537 global curview hlview viewcomplete
1538 global pending_select
1541 if {$viewcomplete($curview)} {
1542 global commitidx varctok
1543 global numcommits startmsecs
1545 if {[info exists pending_select
]} {
1547 reset_pending_select
{}
1549 if {[commitinview
$pending_select $curview]} {
1550 selectline
[rowofcommit
$pending_select] 1
1552 set row
[first_real_row
]
1556 if {$commitidx($curview) > 0} {
1557 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1558 #puts "overall $ms ms for $numcommits commits"
1559 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1561 show_status
[mc
"No commits selected"]
1568 proc do_readcommit
{id
} {
1571 # Invoke git-log to handle automatic encoding conversion
1572 set fd
[open
[concat | git log
--no-color --pretty=raw
-1 $id] r
]
1573 # Read the results using i18n.logoutputencoding
1574 fconfigure
$fd -translation lf
-eofchar {}
1575 if {$tclencoding != {}} {
1576 fconfigure
$fd -encoding $tclencoding
1578 set contents
[read $fd]
1580 # Remove the heading line
1581 regsub
{^commit
[0-9a-f]+\n} $contents {} contents
1586 proc readcommit
{id
} {
1587 if {[catch
{set contents
[do_readcommit
$id]}]} return
1588 parsecommit
$id $contents 1
1591 proc parsecommit
{id contents listed
} {
1592 global commitinfo cdate
1601 set hdrend
[string first
"\n\n" $contents]
1603 # should never happen...
1604 set hdrend
[string length
$contents]
1606 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1607 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1608 foreach line
[split $header "\n"] {
1609 set line
[split $line " "]
1610 set tag
[lindex
$line 0]
1611 if {$tag == "author"} {
1612 set audate
[lindex
$line end-1
]
1613 set auname
[join [lrange
$line 1 end-2
] " "]
1614 } elseif
{$tag == "committer"} {
1615 set comdate
[lindex
$line end-1
]
1616 set comname
[join [lrange
$line 1 end-2
] " "]
1620 # take the first non-blank line of the comment as the headline
1621 set headline
[string trimleft
$comment]
1622 set i
[string first
"\n" $headline]
1624 set headline
[string range
$headline 0 $i]
1626 set headline
[string trimright
$headline]
1627 set i
[string first
"\r" $headline]
1629 set headline
[string trimright
[string range
$headline 0 $i]]
1632 # git log indents the comment by 4 spaces;
1633 # if we got this via git cat-file, add the indentation
1635 foreach line
[split $comment "\n"] {
1636 append newcomment
" "
1637 append newcomment
$line
1638 append newcomment
"\n"
1640 set comment
$newcomment
1642 if {$comdate != {}} {
1643 set cdate
($id) $comdate
1645 set commitinfo
($id) [list
$headline $auname $audate \
1646 $comname $comdate $comment]
1649 proc getcommit
{id
} {
1650 global commitdata commitinfo
1652 if {[info exists commitdata
($id)]} {
1653 parsecommit
$id $commitdata($id) 1
1656 if {![info exists commitinfo
($id)]} {
1657 set commitinfo
($id) [list
[mc
"No commit information available"]]
1663 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1664 # and are present in the current view.
1665 # This is fairly slow...
1666 proc longid
{prefix
} {
1667 global varcid curview
1670 foreach match
[array names varcid
"$curview,$prefix*"] {
1671 lappend ids
[lindex
[split $match ","] 1]
1677 global tagids idtags headids idheads tagobjid
1678 global otherrefids idotherrefs mainhead mainheadid
1679 global selecthead selectheadid
1682 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1685 set refd
[open
[list | git show-ref
-d] r
]
1686 while {[gets
$refd line
] >= 0} {
1687 if {[string index
$line 40] ne
" "} continue
1688 set id
[string range
$line 0 39]
1689 set ref
[string range
$line 41 end
]
1690 if {![string match
"refs/*" $ref]} continue
1691 set name
[string range
$ref 5 end
]
1692 if {[string match
"remotes/*" $name]} {
1693 if {![string match
"*/HEAD" $name] && !$hideremotes} {
1694 set headids
($name) $id
1695 lappend idheads
($id) $name
1697 } elseif
{[string match
"heads/*" $name]} {
1698 set name
[string range
$name 6 end
]
1699 set headids
($name) $id
1700 lappend idheads
($id) $name
1701 } elseif
{[string match
"tags/*" $name]} {
1702 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1703 # which is what we want since the former is the commit ID
1704 set name
[string range
$name 5 end
]
1705 if {[string match
"*^{}" $name]} {
1706 set name
[string range
$name 0 end-3
]
1708 set tagobjid
($name) $id
1710 set tagids
($name) $id
1711 lappend idtags
($id) $name
1713 set otherrefids
($name) $id
1714 lappend idotherrefs
($id) $name
1721 set mainheadid
[exec git rev-parse HEAD
]
1722 set thehead
[exec git symbolic-ref HEAD
]
1723 if {[string match
"refs/heads/*" $thehead]} {
1724 set mainhead
[string range
$thehead 11 end
]
1728 if {$selecthead ne
{}} {
1730 set selectheadid
[exec git rev-parse
--verify $selecthead]
1735 # skip over fake commits
1736 proc first_real_row
{} {
1737 global nullid nullid2 numcommits
1739 for {set row
0} {$row < $numcommits} {incr row
} {
1740 set id
[commitonrow
$row]
1741 if {$id ne
$nullid && $id ne
$nullid2} {
1748 # update things for a head moved to a child of its previous location
1749 proc movehead
{id name
} {
1750 global headids idheads
1752 removehead
$headids($name) $name
1753 set headids
($name) $id
1754 lappend idheads
($id) $name
1757 # update things when a head has been removed
1758 proc removehead
{id name
} {
1759 global headids idheads
1761 if {$idheads($id) eq
$name} {
1764 set i
[lsearch
-exact $idheads($id) $name]
1766 set idheads
($id) [lreplace
$idheads($id) $i $i]
1769 unset headids
($name)
1772 proc make_transient
{window origin
} {
1775 # In MacOS Tk 8.4 transient appears to work by setting
1776 # overrideredirect, which is utterly useless, since the
1777 # windows get no border, and are not even kept above
1779 if {!$have_tk85 && [tk windowingsystem
] eq
{aqua
}} return
1781 wm transient
$window $origin
1783 # Windows fails to place transient windows normally, so
1784 # schedule a callback to center them on the parent.
1785 if {[tk windowingsystem
] eq
{win32
}} {
1786 after idle
[list tk
::PlaceWindow
$window widget
$origin]
1790 proc show_error
{w top msg
{mc mc
}} {
1791 message
$w.m
-text $msg -justify center
-aspect 400
1792 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1793 button
$w.ok
-text [$mc OK
] -command "destroy $top"
1794 pack
$w.ok
-side bottom
-fill x
1795 bind $top <Visibility
> "grab $top; focus $top"
1796 bind $top <Key-Return
> "destroy $top"
1797 bind $top <Key-space
> "destroy $top"
1798 bind $top <Key-Escape
> "destroy $top"
1802 proc error_popup
{msg
{owner .
}} {
1805 make_transient
$w $owner
1806 show_error
$w $w $msg
1809 proc confirm_popup
{msg
{owner .
}} {
1814 make_transient
$w $owner
1815 message
$w.m
-text $msg -justify center
-aspect 400
1816 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1817 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1818 pack
$w.ok
-side left
-fill x
1819 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1820 pack
$w.cancel
-side right
-fill x
1821 bind $w <Visibility
> "grab $w; focus $w"
1822 bind $w <Key-Return
> "set confirm_ok 1; destroy $w"
1823 bind $w <Key-space
> "set confirm_ok 1; destroy $w"
1824 bind $w <Key-Escape
> "destroy $w"
1829 proc setoptions
{} {
1830 option add
*Panedwindow.showHandle
1 startupFile
1831 option add
*Panedwindow.sashRelief raised startupFile
1832 option add
*Button.font uifont startupFile
1833 option add
*Checkbutton.font uifont startupFile
1834 option add
*Radiobutton.font uifont startupFile
1835 if {[tk windowingsystem
] ne
"aqua"} {
1836 option add
*Menu.font uifont startupFile
1838 option add
*Menubutton.font uifont startupFile
1839 option add
*Label.font uifont startupFile
1840 option add
*Message.font uifont startupFile
1841 option add
*Entry.font uifont startupFile
1844 # Make a menu and submenus.
1845 # m is the window name for the menu, items is the list of menu items to add.
1846 # Each item is a list {mc label type description options...}
1847 # mc is ignored; it's so we can put mc there to alert xgettext
1848 # label is the string that appears in the menu
1849 # type is cascade, command or radiobutton (should add checkbutton)
1850 # description depends on type; it's the sublist for cascade, the
1851 # command to invoke for command, or {variable value} for radiobutton
1852 proc makemenu
{m items
} {
1854 if {[tk windowingsystem
] eq
{aqua
}} {
1860 set name
[mc
[lindex
$i 1]]
1861 set type [lindex
$i 2]
1862 set thing
[lindex
$i 3]
1863 set params
[list
$type]
1865 set u
[string first
"&" [string map
{&& x
} $name]]
1866 lappend params
-label [string map
{&& & & {}} $name]
1868 lappend params
-underline $u
1873 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1874 lappend params
-menu $m.
$submenu
1877 lappend params
-command $thing
1880 lappend params
-variable [lindex
$thing 0] \
1881 -value [lindex
$thing 1]
1884 set tail [lrange
$i 4 end
]
1885 regsub
-all {\yMeta1\y
} $tail $Meta1 tail
1886 eval $m add
$params $tail
1887 if {$type eq
"cascade"} {
1888 makemenu
$m.
$submenu $thing
1893 # translate string and remove ampersands
1895 return [string map
{&& & & {}} [mc
$str]]
1898 proc makewindow
{} {
1899 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1901 global findtype findtypemenu findloc findstring fstring geometry
1902 global entries sha1entry sha1string sha1but
1903 global diffcontextstring diffcontext
1905 global maincursor textcursor curtextcursor
1906 global rowctxmenu fakerowmenu mergemax wrapcomment
1907 global highlight_files gdttype
1908 global searchstring sstring
1909 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1910 global headctxmenu progresscanv progressitem progresscoords statusw
1911 global fprogitem fprogcoord lastprogupdate progupdatepending
1912 global rprogitem rprogcoord rownumsel numcommits
1915 # The "mc" arguments here are purely so that xgettext
1916 # sees the following string as needing to be translated
1919 {mc
"Update" command updatecommits
-accelerator F5
}
1920 {mc
"Reload" command reloadcommits
-accelerator Meta1-F5
}
1921 {mc
"Reread references" command rereadrefs
}
1922 {mc
"List references" command showrefs
-accelerator F2
}
1924 {mc
"Start git gui" command {exec git gui
&}}
1926 {mc
"Quit" command doquit
-accelerator Meta1-Q
}
1930 {mc
"Preferences" command doprefs
}
1934 {mc
"New view..." command {newview
0} -accelerator Shift-F4
}
1935 {mc
"Edit view..." command editview
-state disabled
-accelerator F4
}
1936 {mc
"Delete view" command delview
-state disabled
}
1938 {mc
"All files" radiobutton
{selectedview
0} -command {showview
0}}
1940 if {[tk windowingsystem
] ne
"aqua"} {
1943 {mc
"About gitk" command about
}
1944 {mc
"Key bindings" command keys
}
1946 set bar
[list
$file $edit $view $help]
1948 proc
::tk
::mac
::ShowPreferences
{} {doprefs
}
1949 proc
::tk
::mac
::Quit
{} {doquit
}
1950 lset
file end
[lreplace
[lindex
$file end
] end-1 end
]
1952 xx
"Apple" cascade
{
1953 {mc
"About gitk" command about
}
1958 {mc
"Key bindings" command keys
}
1960 set bar
[list
$apple $file $view $help]
1963 . configure
-menu .bar
1965 # the gui has upper and lower half, parts of a paned window.
1966 panedwindow .ctop
-orient vertical
1968 # possibly use assumed geometry
1969 if {![info exists geometry
(pwsash0
)]} {
1970 set geometry
(topheight
) [expr {15 * $linespc}]
1971 set geometry
(topwidth
) [expr {80 * $charspc}]
1972 set geometry
(botheight
) [expr {15 * $linespc}]
1973 set geometry
(botwidth
) [expr {50 * $charspc}]
1974 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1975 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1978 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1979 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1981 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1983 # create three canvases
1984 set cscroll .tf.histframe.csb
1985 set canv .tf.histframe.pwclist.canv
1987 -selectbackground $selectbgcolor \
1988 -background $bgcolor -bd 0 \
1989 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1990 .tf.histframe.pwclist add
$canv
1991 set canv2 .tf.histframe.pwclist.canv2
1993 -selectbackground $selectbgcolor \
1994 -background $bgcolor -bd 0 -yscrollincr $linespc
1995 .tf.histframe.pwclist add
$canv2
1996 set canv3 .tf.histframe.pwclist.canv3
1998 -selectbackground $selectbgcolor \
1999 -background $bgcolor -bd 0 -yscrollincr $linespc
2000 .tf.histframe.pwclist add
$canv3
2001 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
2002 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
2004 # a scroll bar to rule them
2005 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
2006 pack
$cscroll -side right
-fill y
2007 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
2008 lappend bglist
$canv $canv2 $canv3
2009 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
2011 # we have two button bars at bottom of top frame. Bar 1
2013 frame .tf.lbar
-height 15
2015 set sha1entry .tf.bar.sha1
2016 set entries
$sha1entry
2017 set sha1but .tf.bar.sha1label
2018 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
2019 -command gotocommit
-width 8
2020 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
2021 pack .tf.bar.sha1label
-side left
2022 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
2023 trace add variable sha1string
write sha1change
2024 pack
$sha1entry -side left
-pady 2
2026 image create bitmap bm-left
-data {
2027 #define left_width 16
2028 #define left_height 16
2029 static unsigned char left_bits
[] = {
2030 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2031 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2032 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2034 image create bitmap bm-right
-data {
2035 #define right_width 16
2036 #define right_height 16
2037 static unsigned char right_bits
[] = {
2038 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2039 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2040 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2042 button .tf.bar.leftbut
-image bm-left
-command goback \
2043 -state disabled
-width 26
2044 pack .tf.bar.leftbut
-side left
-fill y
2045 button .tf.bar.rightbut
-image bm-right
-command goforw \
2046 -state disabled
-width 26
2047 pack .tf.bar.rightbut
-side left
-fill y
2049 label .tf.bar.rowlabel
-text [mc
"Row"]
2051 label .tf.bar.rownum
-width 7 -font textfont
-textvariable rownumsel \
2052 -relief sunken
-anchor e
2053 label .tf.bar.rowlabel2
-text "/"
2054 label .tf.bar.numcommits
-width 7 -font textfont
-textvariable numcommits \
2055 -relief sunken
-anchor e
2056 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2059 trace add variable selectedline
write selectedline_change
2061 # Status label and progress bar
2062 set statusw .tf.bar.status
2063 label
$statusw -width 15 -relief sunken
2064 pack
$statusw -side left
-padx 5
2065 set h
[expr {[font metrics uifont
-linespace] + 2}]
2066 set progresscanv .tf.bar.progress
2067 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
2068 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
2069 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
2070 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
2071 pack
$progresscanv -side right
-expand 1 -fill x
2072 set progresscoords
{0 0}
2075 bind $progresscanv <Configure
> adjustprogress
2076 set lastprogupdate
[clock clicks
-milliseconds]
2077 set progupdatepending
0
2079 # build up the bottom bar of upper window
2080 label .tf.lbar.flabel
-text "[mc "Find
"] "
2081 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
2082 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
2083 label .tf.lbar.flab2
-text " [mc "commit
"] "
2084 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2086 set gdttype
[mc
"containing:"]
2087 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
2088 [mc
"containing:"] \
2089 [mc
"touching paths:"] \
2090 [mc
"adding/removing string:"]]
2091 trace add variable gdttype
write gdttype_change
2092 pack .tf.lbar.gdttype
-side left
-fill y
2095 set fstring .tf.lbar.findstring
2096 lappend entries
$fstring
2097 entry
$fstring -width 30 -font textfont
-textvariable findstring
2098 trace add variable findstring
write find_change
2099 set findtype
[mc
"Exact"]
2100 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
2101 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
2102 trace add variable findtype
write findcom_change
2103 set findloc
[mc
"All fields"]
2104 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
2105 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
2106 trace add variable findloc
write find_change
2107 pack .tf.lbar.findloc
-side right
2108 pack .tf.lbar.findtype
-side right
2109 pack
$fstring -side left
-expand 1 -fill x
2111 # Finish putting the upper half of the viewer together
2112 pack .tf.lbar
-in .tf
-side bottom
-fill x
2113 pack .tf.bar
-in .tf
-side bottom
-fill x
2114 pack .tf.histframe
-fill both
-side top
-expand 1
2116 .ctop paneconfigure .tf
-height $geometry(topheight
)
2117 .ctop paneconfigure .tf
-width $geometry(topwidth
)
2119 # now build up the bottom
2120 panedwindow .pwbottom
-orient horizontal
2122 # lower left, a text box over search bar, scroll bar to the right
2123 # if we know window height, then that will set the lower text height, otherwise
2124 # we set lower text height which will drive window height
2125 if {[info exists geometry
(main
)]} {
2126 frame .bleft
-width $geometry(botwidth
)
2128 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
2134 button .bleft.top.search
-text [mc
"Search"] -command dosearch
2135 pack .bleft.top.search
-side left
-padx 5
2136 set sstring .bleft.top.sstring
2137 entry
$sstring -width 20 -font textfont
-textvariable searchstring
2138 lappend entries
$sstring
2139 trace add variable searchstring
write incrsearch
2140 pack
$sstring -side left
-expand 1 -fill x
2141 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
2142 -command changediffdisp
-variable diffelide
-value {0 0}
2143 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
2144 -command changediffdisp
-variable diffelide
-value {0 1}
2145 radiobutton .bleft.mid.new
-text [mc
"New version"] \
2146 -command changediffdisp
-variable diffelide
-value {1 0}
2147 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
2148 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
2149 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
2150 -from 0 -increment 1 -to 10000000 \
2151 -validate all
-validatecommand "diffcontextvalidate %P" \
2152 -textvariable diffcontextstring
2153 .bleft.mid.diffcontext
set $diffcontext
2154 trace add variable diffcontextstring
write diffcontextchange
2155 lappend entries .bleft.mid.diffcontext
2156 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
2157 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
2158 -command changeignorespace
-variable ignorespace
2159 pack .bleft.mid.ignspace
-side left
-padx 5
2160 set ctext .bleft.bottom.ctext
2161 text
$ctext -background $bgcolor -foreground $fgcolor \
2162 -state disabled
-font textfont \
2163 -yscrollcommand scrolltext
-wrap none \
2164 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2166 $ctext conf
-tabstyle wordprocessor
2168 scrollbar .bleft.bottom.sb
-command "$ctext yview"
2169 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
2171 pack .bleft.top
-side top
-fill x
2172 pack .bleft.mid
-side top
-fill x
2173 grid
$ctext .bleft.bottom.sb
-sticky nsew
2174 grid .bleft.bottom.sbhorizontal
-sticky ew
2175 grid columnconfigure .bleft.bottom
0 -weight 1
2176 grid rowconfigure .bleft.bottom
0 -weight 1
2177 grid rowconfigure .bleft.bottom
1 -weight 0
2178 pack .bleft.bottom
-side top
-fill both
-expand 1
2179 lappend bglist
$ctext
2180 lappend fglist
$ctext
2182 $ctext tag conf comment
-wrap $wrapcomment
2183 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2184 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2185 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2186 $ctext tag conf dresult
-fore [lindex
$diffcolors 1]
2187 $ctext tag conf m0
-fore red
2188 $ctext tag conf m1
-fore blue
2189 $ctext tag conf m2
-fore green
2190 $ctext tag conf m3
-fore purple
2191 $ctext tag conf
m4 -fore brown
2192 $ctext tag conf m5
-fore "#009090"
2193 $ctext tag conf m6
-fore magenta
2194 $ctext tag conf m7
-fore "#808000"
2195 $ctext tag conf m8
-fore "#009000"
2196 $ctext tag conf m9
-fore "#ff0080"
2197 $ctext tag conf m10
-fore cyan
2198 $ctext tag conf m11
-fore "#b07070"
2199 $ctext tag conf m12
-fore "#70b0f0"
2200 $ctext tag conf m13
-fore "#70f0b0"
2201 $ctext tag conf m14
-fore "#f0b070"
2202 $ctext tag conf m15
-fore "#ff70b0"
2203 $ctext tag conf mmax
-fore darkgrey
2205 $ctext tag conf mresult
-font textfontbold
2206 $ctext tag conf msep
-font textfontbold
2207 $ctext tag conf found
-back yellow
2209 .pwbottom add .bleft
2210 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2215 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2216 -command reselectline
-variable cmitmode
-value "patch"
2217 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2218 -command reselectline
-variable cmitmode
-value "tree"
2219 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2220 pack .bright.mode
-side top
-fill x
2221 set cflist .bright.cfiles
2222 set indent
[font measure mainfont
"nn"]
2224 -selectbackground $selectbgcolor \
2225 -background $bgcolor -foreground $fgcolor \
2227 -tabs [list
$indent [expr {2 * $indent}]] \
2228 -yscrollcommand ".bright.sb set" \
2229 -cursor [. cget
-cursor] \
2230 -spacing1 1 -spacing3 1
2231 lappend bglist
$cflist
2232 lappend fglist
$cflist
2233 scrollbar .bright.sb
-command "$cflist yview"
2234 pack .bright.sb
-side right
-fill y
2235 pack
$cflist -side left
-fill both
-expand 1
2236 $cflist tag configure highlight \
2237 -background [$cflist cget
-selectbackground]
2238 $cflist tag configure bold
-font mainfontbold
2240 .pwbottom add .bright
2243 # restore window width & height if known
2244 if {[info exists geometry
(main
)]} {
2245 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2246 if {$w > [winfo screenwidth .
]} {
2247 set w
[winfo screenwidth .
]
2249 if {$h > [winfo screenheight .
]} {
2250 set h
[winfo screenheight .
]
2252 wm geometry .
"${w}x$h"
2256 if {[info exists geometry
(state
)] && $geometry(state
) eq
"zoomed"} {
2257 wm state .
$geometry(state
)
2260 if {[tk windowingsystem
] eq
{aqua
}} {
2268 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2269 pack .ctop
-fill both
-expand 1
2270 bindall
<1> {selcanvline
%W
%x
%y
}
2271 #bindall <B1-Motion> {selcanvline %W %x %y}
2272 if {[tk windowingsystem
] == "win32"} {
2273 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2274 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2276 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2277 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2278 if {[tk windowingsystem
] eq
"aqua"} {
2279 bindall
<MouseWheel
> {
2280 set delta
[expr {- (%D
)}]
2281 allcanvs yview scroll
$delta units
2283 bindall
<Shift-MouseWheel
> {
2284 set delta
[expr {- (%D
)}]
2285 $canv xview scroll
$delta units
2289 bindall
<$
::BM
> "canvscan mark %W %x %y"
2290 bindall
<B$
::BM-Motion
> "canvscan dragto %W %x %y"
2291 bindkey
<Home
> selfirstline
2292 bindkey
<End
> sellastline
2293 bind .
<Key-Up
> "selnextline -1"
2294 bind .
<Key-Down
> "selnextline 1"
2295 bind .
<Shift-Key-Up
> "dofind -1 0"
2296 bind .
<Shift-Key-Down
> "dofind 1 0"
2297 bindkey
<Key-Right
> "goforw"
2298 bindkey
<Key-Left
> "goback"
2299 bind .
<Key-Prior
> "selnextpage -1"
2300 bind .
<Key-Next
> "selnextpage 1"
2301 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2302 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2303 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2304 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2305 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2306 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2307 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2308 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2309 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2310 bindkey p
"selnextline -1"
2311 bindkey n
"selnextline 1"
2314 bindkey i
"selnextline -1"
2315 bindkey k
"selnextline 1"
2319 bindkey d
"$ctext yview scroll 18 units"
2320 bindkey u
"$ctext yview scroll -18 units"
2321 bindkey
/ {focus
$fstring}
2322 bindkey
<Key-KP_Divide
> {focus
$fstring}
2323 bindkey
<Key-Return
> {dofind
1 1}
2324 bindkey ?
{dofind
-1 1}
2326 bind .
<F5
> updatecommits
2327 bind .
<$M1B-F5> reloadcommits
2328 bind .
<F2
> showrefs
2329 bind .
<Shift-F4
> {newview
0}
2330 catch
{ bind .
<Shift-Key-XF86_Switch_VT_4
> {newview
0} }
2331 bind .
<F4
> edit_or_newview
2332 bind .
<$M1B-q> doquit
2333 bind .
<$M1B-f> {dofind
1 1}
2334 bind .
<$M1B-g> {dofind
1 0}
2335 bind .
<$M1B-r> dosearchback
2336 bind .
<$M1B-s> dosearch
2337 bind .
<$M1B-equal> {incrfont
1}
2338 bind .
<$M1B-plus> {incrfont
1}
2339 bind .
<$M1B-KP_Add> {incrfont
1}
2340 bind .
<$M1B-minus> {incrfont
-1}
2341 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2342 wm protocol . WM_DELETE_WINDOW doquit
2343 bind .
<Destroy
> {stop_backends
}
2344 bind .
<Button-1
> "click %W"
2345 bind $fstring <Key-Return
> {dofind
1 1}
2346 bind $sha1entry <Key-Return
> {gotocommit
; break}
2347 bind $sha1entry <<PasteSelection>> clearsha1
2348 bind $cflist <1> {sel_flist %W %x %y; break}
2349 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2350 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2352 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2353 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2355 set maincursor [. cget -cursor]
2356 set textcursor [$ctext cget -cursor]
2357 set curtextcursor $textcursor
2359 set rowctxmenu .rowctxmenu
2360 makemenu $rowctxmenu {
2361 {mc "Diff this -> selected" command {diffvssel 0}}
2362 {mc "Diff selected -> this" command {diffvssel 1}}
2363 {mc "Make patch" command mkpatch}
2364 {mc "Create tag" command mktag}
2365 {mc "Write commit to file" command writecommit}
2366 {mc "Create new branch" command mkbranch}
2367 {mc "Cherry-pick this commit" command cherrypick}
2368 {mc "Reset HEAD branch to here" command resethead}
2369 {mc "Mark this commit" command markhere}
2370 {mc "Return to mark" command gotomark}
2371 {mc "Find descendant of this and mark" command find_common_desc}
2372 {mc "Compare with marked commit" command compare_commits}
2374 $rowctxmenu configure -tearoff 0
2376 set fakerowmenu .fakerowmenu
2377 makemenu $fakerowmenu {
2378 {mc "Diff this -> selected" command {diffvssel 0}}
2379 {mc "Diff selected -> this" command {diffvssel 1}}
2380 {mc "Make patch" command mkpatch}
2382 $fakerowmenu configure -tearoff 0
2384 set headctxmenu .headctxmenu
2385 makemenu $headctxmenu {
2386 {mc "Check out this branch" command cobranch}
2387 {mc "Remove this branch" command rmbranch}
2389 $headctxmenu configure -tearoff 0
2392 set flist_menu .flistctxmenu
2393 makemenu $flist_menu {
2394 {mc "Highlight this too" command {flist_hl 0}}
2395 {mc "Highlight this only" command {flist_hl 1}}
2396 {mc "External diff" command {external_diff}}
2397 {mc "Blame parent commit" command {external_blame 1}}
2399 $flist_menu configure -tearoff 0
2402 set diff_menu .diffctxmenu
2403 makemenu $diff_menu {
2404 {mc "Show origin of this line" command show_line_source}
2405 {mc "Run git gui blame on this line" command {external_blame_diff}}
2407 $diff_menu configure -tearoff 0
2410 # Windows sends all mouse wheel events to the current focused window, not
2411 # the one where the mouse hovers, so bind those events here and redirect
2412 # to the correct window
2413 proc windows_mousewheel_redirector {W X Y D} {
2414 global canv canv2 canv3
2415 set w [winfo containing -displayof $W $X $Y]
2417 set u [expr {$D < 0 ? 5 : -5}]
2418 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2419 allcanvs yview scroll $u units
2422 $w yview scroll $u units
2428 # Update row number label when selectedline changes
2429 proc selectedline_change {n1 n2 op} {
2430 global selectedline rownumsel
2432 if {$selectedline eq {}} {
2435 set rownumsel [expr {$selectedline + 1}]
2439 # mouse-2 makes all windows scan vertically, but only the one
2440 # the cursor is in scans horizontally
2441 proc canvscan {op w x y} {
2442 global canv canv2 canv3
2443 foreach c [list $canv $canv2 $canv3] {
2452 proc scrollcanv {cscroll f0 f1} {
2453 $cscroll set $f0 $f1
2458 # when we make a key binding for the toplevel, make sure
2459 # it doesn't get triggered when that key is pressed in the
2460 # find string entry widget.
2461 proc bindkey {ev script} {
2464 set escript [bind Entry $ev]
2465 if {$escript == {}} {
2466 set escript [bind Entry <Key>]
2468 foreach e $entries {
2469 bind $e $ev "$escript; break"
2473 # set the focus back to the toplevel for any click outside
2476 global ctext entries
2477 foreach e [concat $entries $ctext] {
2478 if {$w == $e} return
2483 # Adjust the progress bar for a change in requested extent or canvas size
2484 proc adjustprogress {} {
2485 global progresscanv progressitem progresscoords
2486 global fprogitem fprogcoord lastprogupdate progupdatepending
2487 global rprogitem rprogcoord
2489 set w [expr {[winfo width $progresscanv] - 4}]
2490 set x0 [expr {$w * [lindex $progresscoords 0]}]
2491 set x1 [expr {$w * [lindex $progresscoords 1]}]
2492 set h [winfo height $progresscanv]
2493 $progresscanv coords $progressitem $x0 0 $x1 $h
2494 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2495 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2496 set now [clock clicks -milliseconds]
2497 if {$now >= $lastprogupdate + 100} {
2498 set progupdatepending 0
2500 } elseif {!$progupdatepending} {
2501 set progupdatepending 1
2502 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2506 proc doprogupdate {} {
2507 global lastprogupdate progupdatepending
2509 if {$progupdatepending} {
2510 set progupdatepending 0
2511 set lastprogupdate [clock clicks -milliseconds]
2516 proc savestuff {w} {
2517 global canv canv2 canv3 mainfont textfont uifont tabstop
2518 global stuffsaved findmergefiles maxgraphpct
2519 global maxwidth showneartags showlocalchanges
2520 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2521 global cmitmode wrapcomment datetimeformat limitdiffs
2522 global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2523 global autoselect extdifftool perfile_attrs markbgcolor
2526 if {$stuffsaved} return
2527 if {![winfo viewable .]} return
2529 if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2530 set f [open "~/.gitk-new" w]
2531 if {$::tcl_platform(platform) eq {windows}} {
2532 file attributes "~/.gitk-new" -hidden true
2534 puts $f [list set mainfont $mainfont]
2535 puts $f [list set textfont $textfont]
2536 puts $f [list set uifont $uifont]
2537 puts $f [list set tabstop $tabstop]
2538 puts $f [list set findmergefiles $findmergefiles]
2539 puts $f [list set maxgraphpct $maxgraphpct]
2540 puts $f [list set maxwidth $maxwidth]
2541 puts $f [list set cmitmode $cmitmode]
2542 puts $f [list set wrapcomment $wrapcomment]
2543 puts $f [list set autoselect $autoselect]
2544 puts $f [list set showneartags $showneartags]
2545 puts $f [list set hideremotes $hideremotes]
2546 puts $f [list set showlocalchanges $showlocalchanges]
2547 puts $f [list set datetimeformat $datetimeformat]
2548 puts $f [list set limitdiffs $limitdiffs]
2549 puts $f [list set uicolor $uicolor]
2550 puts $f [list set bgcolor $bgcolor]
2551 puts $f [list set fgcolor $fgcolor]
2552 puts $f [list set colors $colors]
2553 puts $f [list set diffcolors $diffcolors]
2554 puts $f [list set markbgcolor $markbgcolor]
2555 puts $f [list set diffcontext $diffcontext]
2556 puts $f [list set selectbgcolor $selectbgcolor]
2557 puts $f [list set extdifftool $extdifftool]
2558 puts $f [list set perfile_attrs $perfile_attrs]
2560 puts $f "set geometry(main) [wm geometry .]"
2561 puts $f "set geometry(state) [wm state .]"
2562 puts $f "set geometry(topwidth) [winfo width .tf]"
2563 puts $f "set geometry(topheight) [winfo height .tf]"
2564 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2565 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2566 puts $f "set geometry(botwidth) [winfo width .bleft]"
2567 puts $f "set geometry(botheight) [winfo height .bleft]"
2569 puts -nonewline $f "set permviews {"
2570 for {set v 0} {$v < $nextviewnum} {incr v} {
2571 if {$viewperm($v)} {
2572 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2577 file rename -force "~/.gitk-new" "~/.gitk"
2582 proc resizeclistpanes {win w} {
2584 if {[info exists oldwidth($win)]} {
2585 set s0 [$win sash coord 0]
2586 set s1 [$win sash coord 1]
2588 set sash0 [expr {int($w/2 - 2)}]
2589 set sash1 [expr {int($w*5/6 - 2)}]
2591 set factor [expr {1.0 * $w / $oldwidth($win)}]
2592 set sash0 [expr {int($factor * [lindex $s0 0])}]
2593 set sash1 [expr {int($factor * [lindex $s1 0])}]
2597 if {$sash1 < $sash0 + 20} {
2598 set sash1 [expr {$sash0 + 20}]
2600 if {$sash1 > $w - 10} {
2601 set sash1 [expr {$w - 10}]
2602 if {$sash0 > $sash1 - 20} {
2603 set sash0 [expr {$sash1 - 20}]
2607 $win sash place 0 $sash0 [lindex $s0 1]
2608 $win sash place 1 $sash1 [lindex $s1 1]
2610 set oldwidth($win) $w
2613 proc resizecdetpanes {win w} {
2615 if {[info exists oldwidth($win)]} {
2616 set s0 [$win sash coord 0]
2618 set sash0 [expr {int($w*3/4 - 2)}]
2620 set factor [expr {1.0 * $w / $oldwidth($win)}]
2621 set sash0 [expr {int($factor * [lindex $s0 0])}]
2625 if {$sash0 > $w - 15} {
2626 set sash0 [expr {$w - 15}]
2629 $win sash place 0 $sash0 [lindex $s0 1]
2631 set oldwidth($win) $w
2634 proc allcanvs args {
2635 global canv canv2 canv3
2641 proc bindall {event action} {
2642 global canv canv2 canv3
2643 bind $canv $event $action
2644 bind $canv2 $event $action
2645 bind $canv3 $event $action
2651 if {[winfo exists $w]} {
2656 wm title $w [mc "About gitk"]
2658 message $w.m -text [mc "
2659 Gitk - a commit viewer for git
2661 Copyright © 2005-2008 Paul Mackerras
2663 Use and redistribute under the terms of the GNU General Public License"] \
2664 -justify center -aspect 400 -border 2 -bg white -relief groove
2665 pack $w.m -side top -fill x -padx 2 -pady 2
2666 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2667 pack $w.ok -side bottom
2668 bind $w <Visibility> "focus $w.ok"
2669 bind $w <Key-Escape> "destroy $w"
2670 bind $w <Key-Return> "destroy $w"
2675 if {[winfo exists $w]} {
2679 if {[tk windowingsystem] eq {aqua}} {
2685 wm title $w [mc "Gitk key bindings"]
2687 message $w.m -text "
2688 [mc "Gitk key bindings:"]
2690 [mc "<%s-Q> Quit" $M1T]
2691 [mc "<Home> Move to first commit"]
2692 [mc "<End> Move to last commit"]
2693 [mc "<Up>, p, i Move up one commit"]
2694 [mc "<Down>, n, k Move down one commit"]
2695 [mc "<Left>, z, j Go back in history list"]
2696 [mc "<Right>, x, l Go forward in history list"]
2697 [mc "<PageUp> Move up one page in commit list"]
2698 [mc "<PageDown> Move down one page in commit list"]
2699 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2700 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2701 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2702 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2703 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2704 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2705 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2706 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2707 [mc "<Delete>, b Scroll diff view up one page"]
2708 [mc "<Backspace> Scroll diff view up one page"]
2709 [mc "<Space> Scroll diff view down one page"]
2710 [mc "u Scroll diff view up 18 lines"]
2711 [mc "d Scroll diff view down 18 lines"]
2712 [mc "<%s-F> Find" $M1T]
2713 [mc "<%s-G> Move to next find hit" $M1T]
2714 [mc "<Return> Move to next find hit"]
2715 [mc "/ Focus the search box"]
2716 [mc "? Move to previous find hit"]
2717 [mc "f Scroll diff view to next file"]
2718 [mc "<%s-S> Search for next hit in diff view" $M1T]
2719 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2720 [mc "<%s-KP+> Increase font size" $M1T]
2721 [mc "<%s-plus> Increase font size" $M1T]
2722 [mc "<%s-KP-> Decrease font size" $M1T]
2723 [mc "<%s-minus> Decrease font size" $M1T]
2726 -justify left -bg white -border 2 -relief groove
2727 pack $w.m -side top -fill both -padx 2 -pady 2
2728 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2729 bind $w <Key-Escape> [list destroy $w]
2730 pack $w.ok -side bottom
2731 bind $w <Visibility> "focus $w.ok"
2732 bind $w <Key-Escape> "destroy $w"
2733 bind $w <Key-Return> "destroy $w"
2736 # Procedures for manipulating the file list window at the
2737 # bottom right of the overall window.
2739 proc treeview {w l openlevs} {
2740 global treecontents treediropen treeheight treeparent treeindex
2750 set treecontents() {}
2751 $w conf -state normal
2753 while {[string range $f 0 $prefixend] ne $prefix} {
2754 if {$lev <= $openlevs} {
2755 $w mark set e:$treeindex($prefix) "end -1c"
2756 $w mark gravity e:$treeindex($prefix) left
2758 set treeheight($prefix) $ht
2759 incr ht [lindex $htstack end]
2760 set htstack [lreplace $htstack end end]
2761 set prefixend [lindex $prefendstack end]
2762 set prefendstack [lreplace $prefendstack end end]
2763 set prefix [string range $prefix 0 $prefixend]
2766 set tail [string range $f [expr {$prefixend+1}] end]
2767 while {[set slash [string first "/" $tail]] >= 0} {
2770 lappend prefendstack $prefixend
2771 incr prefixend [expr {$slash + 1}]
2772 set d [string range $tail 0 $slash]
2773 lappend treecontents($prefix) $d
2774 set oldprefix $prefix
2776 set treecontents($prefix) {}
2777 set treeindex($prefix) [incr ix]
2778 set treeparent($prefix) $oldprefix
2779 set tail [string range $tail [expr {$slash+1}] end]
2780 if {$lev <= $openlevs} {
2782 set treediropen($prefix) [expr {$lev < $openlevs}]
2783 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2784 $w mark set d:$ix "end -1c"
2785 $w mark gravity d:$ix left
2787 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2789 $w image create end -align center -image $bm -padx 1 \
2791 $w insert end $d [highlight_tag $prefix]
2792 $w mark set s:$ix "end -1c"
2793 $w mark gravity s:$ix left
2798 if {$lev <= $openlevs} {
2801 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2803 $w insert end $tail [highlight_tag $f]
2805 lappend treecontents($prefix) $tail
2808 while {$htstack ne {}} {
2809 set treeheight($prefix) $ht
2810 incr ht [lindex $htstack end]
2811 set htstack [lreplace $htstack end end]
2812 set prefixend [lindex $prefendstack end]
2813 set prefendstack [lreplace $prefendstack end end]
2814 set prefix [string range $prefix 0 $prefixend]
2816 $w conf -state disabled
2819 proc linetoelt {l} {
2820 global treeheight treecontents
2825 foreach e $treecontents($prefix) {
2830 if {[string index $e end] eq "/"} {
2831 set n $treeheight($prefix$e)
2843 proc highlight_tree {y prefix} {
2844 global treeheight treecontents cflist
2846 foreach e $treecontents($prefix) {
2848 if {[highlight_tag $path] ne {}} {
2849 $cflist tag add bold $y.0 "$y.0 lineend"
2852 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2853 set y [highlight_tree $y $path]
2859 proc treeclosedir {w dir} {
2860 global treediropen treeheight treeparent treeindex
2862 set ix $treeindex($dir)
2863 $w conf -state normal
2864 $w delete s:$ix e:$ix
2865 set treediropen($dir) 0
2866 $w image configure a:$ix -image tri-rt
2867 $w conf -state disabled
2868 set n [expr {1 - $treeheight($dir)}]
2869 while {$dir ne {}} {
2870 incr treeheight($dir) $n
2871 set dir $treeparent($dir)
2875 proc treeopendir {w dir} {
2876 global treediropen treeheight treeparent treecontents treeindex
2878 set ix $treeindex($dir)
2879 $w conf -state normal
2880 $w image configure a:$ix -image tri-dn
2881 $w mark set e:$ix s:$ix
2882 $w mark gravity e:$ix right
2885 set n [llength $treecontents($dir)]
2886 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2889 incr treeheight($x) $n
2891 foreach e $treecontents($dir) {
2893 if {[string index $e end] eq "/"} {
2894 set iy $treeindex($de)
2895 $w mark set d:$iy e:$ix
2896 $w mark gravity d:$iy left
2897 $w insert e:$ix $str
2898 set treediropen($de) 0
2899 $w image create e:$ix -align center -image tri-rt -padx 1 \
2901 $w insert e:$ix $e [highlight_tag $de]
2902 $w mark set s:$iy e:$ix
2903 $w mark gravity s:$iy left
2904 set treeheight($de) 1
2906 $w insert e:$ix $str
2907 $w insert e:$ix $e [highlight_tag $de]
2910 $w mark gravity e:$ix right
2911 $w conf -state disabled
2912 set treediropen($dir) 1
2913 set top [lindex [split [$w index @0,0] .] 0]
2914 set ht [$w cget -height]
2915 set l [lindex [split [$w index s:$ix] .] 0]
2918 } elseif {$l + $n + 1 > $top + $ht} {
2919 set top [expr {$l + $n + 2 - $ht}]
2927 proc treeclick {w x y} {
2928 global treediropen cmitmode ctext cflist cflist_top
2930 if {$cmitmode ne "tree"} return
2931 if {![info exists cflist_top]} return
2932 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2933 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2934 $cflist tag add highlight $l.0 "$l.0 lineend"
2940 set e [linetoelt $l]
2941 if {[string index $e end] ne "/"} {
2943 } elseif {$treediropen($e)} {
2950 proc setfilelist {id} {
2951 global treefilelist cflist jump_to_here
2953 treeview $cflist $treefilelist($id) 0
2954 if {$jump_to_here ne {}} {
2955 set f [lindex $jump_to_here 0]
2956 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2962 image create bitmap tri-rt -background black -foreground blue -data {
2963 #define tri-rt_width 13
2964 #define tri-rt_height 13
2965 static unsigned char tri-rt_bits[] = {
2966 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2967 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2970 #define tri-rt-mask_width 13
2971 #define tri-rt-mask_height 13
2972 static unsigned char tri-rt-mask_bits[] = {
2973 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2974 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2977 image create bitmap tri-dn -background black -foreground blue -data {
2978 #define tri-dn_width 13
2979 #define tri-dn_height 13
2980 static unsigned char tri-dn_bits[] = {
2981 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2982 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2985 #define tri-dn-mask_width 13
2986 #define tri-dn-mask_height 13
2987 static unsigned char tri-dn-mask_bits[] = {
2988 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2989 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2993 image create bitmap reficon-T -background black -foreground yellow -data {
2994 #define tagicon_width 13
2995 #define tagicon_height 9
2996 static unsigned char tagicon_bits[] = {
2997 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2998 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3000 #define tagicon-mask_width 13
3001 #define tagicon-mask_height 9
3002 static unsigned char tagicon-mask_bits[] = {
3003 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3004 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3007 #define headicon_width 13
3008 #define headicon_height 9
3009 static unsigned char headicon_bits[] = {
3010 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3011 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3014 #define headicon-mask_width 13
3015 #define headicon-mask_height 9
3016 static unsigned char headicon-mask_bits[] = {
3017 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3018 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3020 image create bitmap reficon-H -background black -foreground green \
3021 -data $rectdata -maskdata $rectmask
3022 image create bitmap reficon-o -background black -foreground "#ddddff" \
3023 -data $rectdata -maskdata $rectmask
3025 proc init_flist {first} {
3026 global cflist cflist_top difffilestart
3028 $cflist conf -state normal
3029 $cflist delete 0.0 end
3031 $cflist insert end $first
3033 $cflist tag add highlight 1.0 "1.0 lineend"
3035 catch {unset cflist_top}
3037 $cflist conf -state disabled
3038 set difffilestart {}
3041 proc highlight_tag {f} {
3042 global highlight_paths
3044 foreach p $highlight_paths {
3045 if {[string match $p $f]} {
3052 proc highlight_filelist {} {
3053 global cmitmode cflist
3055 $cflist conf -state normal
3056 if {$cmitmode ne "tree"} {
3057 set end [lindex [split [$cflist index end] .] 0]
3058 for {set l 2} {$l < $end} {incr l} {
3059 set line [$cflist get $l.0 "$l.0 lineend"]
3060 if {[highlight_tag $line] ne {}} {
3061 $cflist tag add bold $l.0 "$l.0 lineend"
3067 $cflist conf -state disabled
3070 proc unhighlight_filelist {} {
3073 $cflist conf -state normal
3074 $cflist tag remove bold 1.0 end
3075 $cflist conf -state disabled
3078 proc add_flist {fl} {
3081 $cflist conf -state normal
3083 $cflist insert end "\n"
3084 $cflist insert end $f [highlight_tag $f]
3086 $cflist conf -state disabled
3089 proc sel_flist {w x y} {
3090 global ctext difffilestart cflist cflist_top cmitmode
3092 if {$cmitmode eq "tree"} return
3093 if {![info exists cflist_top]} return
3094 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3095 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3096 $cflist tag add highlight $l.0 "$l.0 lineend"
3101 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3105 proc pop_flist_menu {w X Y x y} {
3106 global ctext cflist cmitmode flist_menu flist_menu_file
3107 global treediffs diffids
3110 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3112 if {$cmitmode eq "tree"} {
3113 set e [linetoelt $l]
3114 if {[string index $e end] eq "/"} return
3116 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3118 set flist_menu_file $e
3119 set xdiffstate "normal"
3120 if {$cmitmode eq "tree"} {
3121 set xdiffstate "disabled"
3123 # Disable "External diff" item in tree mode
3124 $flist_menu entryconf 2 -state $xdiffstate
3125 tk_popup $flist_menu $X $Y
3128 proc find_ctext_fileinfo {line} {
3129 global ctext_file_names ctext_file_lines
3131 set ok [bsearch $ctext_file_lines $line]
3132 set tline [lindex $ctext_file_lines $ok]
3134 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3137 return [list [lindex $ctext_file_names $ok] $tline]
3141 proc pop_diff_menu {w X Y x y} {
3142 global ctext diff_menu flist_menu_file
3143 global diff_menu_txtpos diff_menu_line
3144 global diff_menu_filebase
3146 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3147 set diff_menu_line [lindex $diff_menu_txtpos 0]
3148 # don't pop up the menu on hunk-separator or file-separator lines
3149 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3153 set f [find_ctext_fileinfo $diff_menu_line]
3154 if {$f eq {}} return
3155 set flist_menu_file [lindex $f 0]
3156 set diff_menu_filebase [lindex $f 1]
3157 tk_popup $diff_menu $X $Y
3160 proc flist_hl {only} {
3161 global flist_menu_file findstring gdttype
3163 set x [shellquote $flist_menu_file]
3164 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3167 append findstring " " $x
3169 set gdttype [mc "touching paths:"]
3172 proc gitknewtmpdir {} {
3173 global diffnum gitktmpdir gitdir
3175 if {![info exists gitktmpdir]} {
3176 set gitktmpdir [file join [file dirname $gitdir] \
3177 [format ".gitk-tmp.%s" [pid]]]
3178 if {[catch {file mkdir $gitktmpdir} err]} {
3179 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3186 set diffdir [file join $gitktmpdir $diffnum]
3187 if {[catch {file mkdir $diffdir} err]} {
3188 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3194 proc save_file_from_commit {filename output what} {
3197 if {[catch {exec git show $filename -- > $output} err]} {
3198 if {[string match "fatal: bad revision *" $err]} {
3201 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3207 proc external_diff_get_one_file {diffid filename diffdir} {
3208 global nullid nullid2 nullfile
3211 if {$diffid == $nullid} {
3212 set difffile [file join [file dirname $gitdir] $filename]
3213 if {[file exists $difffile]} {
3218 if {$diffid == $nullid2} {
3219 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3220 return [save_file_from_commit :$filename $difffile index]
3222 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3223 return [save_file_from_commit $diffid:$filename $difffile \
3227 proc external_diff {} {
3228 global nullid nullid2
3229 global flist_menu_file
3233 if {[llength $diffids] == 1} {
3234 # no reference commit given
3235 set diffidto [lindex $diffids 0]
3236 if {$diffidto eq $nullid} {
3237 # diffing working copy with index
3238 set diffidfrom $nullid2
3239 } elseif {$diffidto eq $nullid2} {
3240 # diffing index with HEAD
3241 set diffidfrom "HEAD"
3243 # use first parent commit
3244 global parentlist selectedline
3245 set diffidfrom [lindex $parentlist $selectedline 0]
3248 set diffidfrom [lindex $diffids 0]
3249 set diffidto [lindex $diffids 1]
3252 # make sure that several diffs wont collide
3253 set diffdir [gitknewtmpdir]
3254 if {$diffdir eq {}} return
3256 # gather files to diff
3257 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3258 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3260 if {$difffromfile ne {} && $difftofile ne {}} {
3261 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3262 if {[catch {set fl [open |$cmd r]} err]} {
3263 file delete -force $diffdir
3264 error_popup "$extdifftool: [mc "command failed:"] $err"
3266 fconfigure $fl -blocking 0
3267 filerun $fl [list delete_at_eof $fl $diffdir]
3272 proc find_hunk_blamespec {base line} {
3275 # Find and parse the hunk header
3276 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3277 if {$s_lix eq {}} return
3279 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3280 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3281 s_line old_specs osz osz1 new_line nsz]} {
3285 # base lines for the parents
3286 set base_lines [list $new_line]
3287 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3288 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3289 old_spec old_line osz]} {
3292 lappend base_lines $old_line
3295 # Now scan the lines to determine offset within the hunk
3296 set max_parent [expr {[llength $base_lines]-2}]
3298 set s_lno [lindex [split $s_lix "."] 0]
3300 # Determine if the line is removed
3301 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3302 if {[string match {[-+ ]*} $chunk]} {
3303 set removed_idx [string first "-" $chunk]
3304 # Choose a parent index
3305 if {$removed_idx >= 0} {
3306 set parent $removed_idx
3308 set unchanged_idx [string first " " $chunk]
3309 if {$unchanged_idx >= 0} {
3310 set parent $unchanged_idx
3312 # blame the current commit
3316 # then count other lines that belong to it
3317 for {set i $line} {[incr i -1] > $s_lno} {} {
3318 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3319 # Determine if the line is removed
3320 set removed_idx [string first "-" $chunk]
3322 set code [string index $chunk $parent]
3323 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3327 if {$removed_idx < 0} {
3337 incr dline [lindex $base_lines $parent]
3338 return [list $parent $dline]
3341 proc external_blame_diff {} {
3342 global currentid cmitmode
3343 global diff_menu_txtpos diff_menu_line
3344 global diff_menu_filebase flist_menu_file
3346 if {$cmitmode eq "tree"} {
3348 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3350 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3352 set parent_idx [lindex $hinfo 0]
3353 set line [lindex $hinfo 1]
3360 external_blame $parent_idx $line
3363 # Find the SHA1 ID of the blob for file $fname in the index
3365 proc index_sha1 {fname} {
3366 set f [open [list | git ls-files -s $fname] r]
3367 while {[gets $f line] >= 0} {
3368 set info [lindex [split $line "\t"] 0]
3369 set stage [lindex $info 2]
3370 if {$stage eq "0" || $stage eq "2"} {
3372 return [lindex $info 1]
3379 # Turn an absolute path into one relative to the current directory
3380 proc make_relative {f} {
3381 if {[file pathtype $f] eq "relative"} {
3384 set elts [file split $f]
3385 set here [file split [pwd]]
3390 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3397 set elts [concat $res [lrange $elts $ei end]]
3398 return [eval file join $elts]
3401 proc external_blame {parent_idx {line {}}} {
3402 global flist_menu_file gitdir
3403 global nullid nullid2
3404 global parentlist selectedline currentid
3406 if {$parent_idx > 0} {
3407 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3409 set base_commit $currentid
3412 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3413 error_popup [mc "No such commit"]
3417 set cmdline [list git gui blame]
3418 if {$line ne {} && $line > 1} {
3419 lappend cmdline "--line=$line"
3421 set f [file join [file dirname $gitdir] $flist_menu_file]
3422 # Unfortunately it seems git gui blame doesn't like
3423 # being given an absolute path...
3424 set f [make_relative $f]
3425 lappend cmdline $base_commit $f
3426 if {[catch {eval exec $cmdline &} err]} {
3427 error_popup "[mc "git gui blame: command failed:"] $err"
3431 proc show_line_source {} {
3432 global cmitmode currentid parents curview blamestuff blameinst
3433 global diff_menu_line diff_menu_filebase flist_menu_file
3434 global nullid nullid2 gitdir
3437 if {$cmitmode eq "tree"} {
3439 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3441 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3442 if {$h eq {}} return
3443 set pi [lindex $h 0]
3445 mark_ctext_line $diff_menu_line
3449 if {$currentid eq $nullid} {
3451 # must be a merge in progress...
3453 # get the last line from .git/MERGE_HEAD
3454 set f [open [file join $gitdir MERGE_HEAD] r]
3455 set id [lindex [split [read $f] "\n"] end-1]
3458 error_popup [mc "Couldn't read merge head: %s" $err]
3461 } elseif {$parents($curview,$currentid) eq $nullid2} {
3462 # need to do the blame from the index
3464 set from_index [index_sha1 $flist_menu_file]
3466 error_popup [mc "Error reading index: %s" $err]
3470 set id $parents($curview,$currentid)
3473 set id [lindex $parents($curview,$currentid) $pi]
3475 set line [lindex $h 1]
3478 if {$from_index ne {}} {
3479 lappend blameargs | git cat-file blob $from_index
3481 lappend blameargs | git blame -p -L$line,+1
3482 if {$from_index ne {}} {
3483 lappend blameargs --contents -
3485 lappend blameargs $id
3487 lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
3489 set f [open $blameargs r]
3491 error_popup [mc "Couldn't start git blame: %s" $err]
3494 nowbusy blaming [mc "Searching"]
3495 fconfigure $f -blocking 0
3496 set i [reg_instance $f]
3497 set blamestuff($i) {}
3499 filerun $f [list read_line_source $f $i]
3502 proc stopblaming {} {
3505 if {[info exists blameinst]} {
3506 stop_instance $blameinst
3512 proc read_line_source {fd inst} {
3513 global blamestuff curview commfd blameinst nullid nullid2
3515 while {[gets $fd line] >= 0} {
3516 lappend blamestuff($inst) $line
3524 fconfigure $fd -blocking 1
3525 if {[catch {close $fd} err]} {
3526 error_popup [mc "Error running git blame: %s" $err]
3531 set line [split [lindex $blamestuff($inst) 0] " "]
3532 set id [lindex $line 0]
3533 set lnum [lindex $line 1]
3534 if {[string length $id] == 40 && [string is xdigit $id] &&
3535 [string is digit -strict $lnum]} {
3536 # look for "filename" line
3537 foreach l $blamestuff($inst) {
3538 if {[string match "filename *" $l]} {
3539 set fname [string range $l 9 end]
3545 # all looks good, select it
3546 if {$id eq $nullid} {
3547 # blame uses all-zeroes to mean not committed,
3548 # which would mean a change in the index
3551 if {[commitinview $id $curview]} {
3552 selectline [rowofcommit $id] 1 [list $fname $lnum]
3554 error_popup [mc "That line comes from commit %s, \
3555 which is not in this view" [shortids $id]]
3558 puts "oops couldn't parse git blame output"
3563 # delete $dir when we see eof on $f (presumably because the child has exited)
3564 proc delete_at_eof {f dir} {
3565 while {[gets $f line] >= 0} {}
3567 if {[catch {close $f} err]} {
3568 error_popup "[mc "External diff viewer failed:"] $err"
3570 file delete -force $dir
3576 # Functions for adding and removing shell-type quoting
3578 proc shellquote {str} {
3579 if {![string match "*\['\"\\ \t]*" $str]} {
3582 if {![string match "*\['\"\\]*" $str]} {
3585 if {![string match "*'*" $str]} {
3588 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3591 proc shellarglist {l} {
3597 append str [shellquote $a]
3602 proc shelldequote {str} {
3607 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3608 append ret [string range $str $used end]
3609 set used [string length $str]
3612 set first [lindex $first 0]
3613 set ch [string index $str $first]
3614 if {$first > $used} {
3615 append ret [string range $str $used [expr {$first - 1}]]
3618 if {$ch eq " " || $ch eq "\t"} break
3621 set first [string first "'" $str $used]
3623 error "unmatched single-quote"
3625 append ret [string range $str $used [expr {$first - 1}]]
3630 if {$used >= [string length $str]} {
3631 error "trailing backslash"
3633 append ret [string index $str $used]
3638 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3639 error "unmatched double-quote"
3641 set first [lindex $first 0]
3642 set ch [string index $str $first]
3643 if {$first > $used} {
3644 append ret [string range $str $used [expr {$first - 1}]]
3647 if {$ch eq "\""} break
3649 append ret [string index $str $used]
3653 return [list $used $ret]
3656 proc shellsplit {str} {
3659 set str [string trimleft $str]
3660 if {$str eq {}} break
3661 set dq [shelldequote $str]
3662 set n [lindex $dq 0]
3663 set word [lindex $dq 1]
3664 set str [string range $str $n end]
3670 # Code to implement multiple views
3672 proc newview {ishighlight} {
3673 global nextviewnum newviewname newishighlight
3674 global revtreeargs viewargscmd newviewopts curview
3676 set newishighlight $ishighlight
3678 if {[winfo exists $top]} {
3682 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3683 set newviewopts($nextviewnum,perm) 0
3684 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3685 decode_view_opts $nextviewnum $revtreeargs
3686 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3689 set known_view_options {
3690 {perm b . {} {mc "Remember this view"}}
3691 {reflabel l + {} {mc "References (space separated list):"}}
3692 {refs t15 .. {} {mc "Branches & tags:"}}
3693 {allrefs b *. "--all" {mc "All refs"}}
3694 {branches b . "--branches" {mc "All (local) branches"}}
3695 {tags b . "--tags" {mc "All tags"}}
3696 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3697 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3698 {author t15 .. "--author=*" {mc "Author:"}}
3699 {committer t15 . "--committer=*" {mc "Committer:"}}
3700 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3701 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3702 {changes_l l + {} {mc "Changes to Files:"}}
3703 {pickaxe_s r0 . {} {mc "Fixed String"}}
3704 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3705 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3706 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3707 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3708 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3709 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3710 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3711 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3712 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3713 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3714 {lright b . "--left-right" {mc "Mark branch sides"}}
3715 {first b . "--first-parent" {mc "Limit to first parent"}}
3716 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
3717 {args t50 *. {} {mc "Additional arguments to git log:"}}
3718 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
3719 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3722 proc encode_view_opts {n} {
3723 global known_view_options newviewopts
3726 foreach opt $known_view_options {
3727 set patterns [lindex $opt 3]
3728 if {$patterns eq {}} continue
3729 set pattern [lindex $patterns 0]
3731 if {[lindex $opt 1] eq "b"} {
3732 set val $newviewopts($n,[lindex $opt 0])
3734 lappend rargs $pattern
3736 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3737 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3738 set val $newviewopts($n,$button_id)
3739 if {$val eq $value} {
3740 lappend rargs $pattern
3743 set val $newviewopts($n,[lindex $opt 0])
3744 set val [string trim $val]
3746 set pfix [string range $pattern 0 end-1]
3747 lappend rargs $pfix$val
3751 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3752 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3755 proc decode_view_opts {n view_args} {
3756 global known_view_options newviewopts
3758 foreach opt $known_view_options {
3759 set id [lindex $opt 0]
3760 if {[lindex $opt 1] eq "b"} {
3763 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3765 regexp {^(.*_)} $id uselessvar id
3771 set newviewopts($n,$id) $val
3775 foreach arg $view_args {
3776 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3777 && ![info exists found(limit)]} {
3778 set newviewopts($n,limit) $cnt
3783 foreach opt $known_view_options {
3784 set id [lindex $opt 0]
3785 if {[info exists found($id)]} continue
3786 foreach pattern [lindex $opt 3] {
3787 if {![string match $pattern $arg]} continue
3788 if {[lindex $opt 1] eq "b"} {
3791 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3793 regexp {^(.*_)} $id uselessvar id
3797 set size [string length $pattern]
3798 set val [string range $arg [expr {$size-1}] end]
3800 set newviewopts($n,$id) $val
3804 if {[info exists val]} break
3806 if {[info exists val]} continue
3807 if {[regexp {^-} $arg]} {
3810 lappend refargs $arg
3813 set newviewopts($n,refs) [shellarglist $refargs]
3814 set newviewopts($n,args) [shellarglist $oargs]
3817 proc edit_or_newview {} {
3829 global viewname viewperm newviewname newviewopts
3830 global viewargs viewargscmd
3832 set top .gitkvedit-$curview
3833 if {[winfo exists $top]} {
3837 set newviewname($curview) $viewname($curview)
3838 set newviewopts($curview,perm) $viewperm($curview)
3839 set newviewopts($curview,cmd) $viewargscmd($curview)
3840 decode_view_opts $curview $viewargs($curview)
3841 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3844 proc vieweditor {top n title} {
3845 global newviewname newviewopts viewfiles bgcolor
3846 global known_view_options
3849 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
3850 make_transient $top .
3854 label $top.nl -text [mc "View Name:"]
3855 entry $top.name -width 20 -textvariable newviewname($n)
3856 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3857 pack $top.nl -in $top.nfr -side left -padx {0 5}
3858 pack $top.name -in $top.nfr -side left -padx {0 25}
3864 foreach opt $known_view_options {
3865 set id [lindex $opt 0]
3866 set type [lindex $opt 1]
3867 set flags [lindex $opt 2]
3868 set title [eval [lindex $opt 4]]
3871 if {$flags eq "+" || $flags eq "*"} {
3872 set cframe $top.fr$cnt
3875 pack $cframe -in $top -fill x -pady 3 -padx 3
3876 set cexpand [expr {$flags eq "*"}]
3877 } elseif {$flags eq ".." || $flags eq "*."} {
3878 set cframe $top.fr$cnt
3881 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
3882 set cexpand [expr {$flags eq "*."}]
3888 label $cframe.l_$id -text $title
3889 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
3890 } elseif {$type eq "b"} {
3891 checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3892 pack $cframe.c_$id -in $cframe -side left \
3893 -padx [list $lxpad 0] -expand $cexpand -anchor w
3894 } elseif {[regexp {^r(\d+)$} $type type sz]} {
3895 regexp {^(.*_)} $id uselessvar button_id
3896 radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
3897 pack $cframe.c_$id -in $cframe -side left \
3898 -padx [list $lxpad 0] -expand $cexpand -anchor w
3899 } elseif {[regexp {^t(\d+)$} $type type sz]} {
3900 message $cframe.l_$id -aspect 1500 -text $title
3901 entry $cframe.e_$id -width $sz -background $bgcolor \
3902 -textvariable newviewopts($n,$id)
3903 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3904 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3905 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3906 message $cframe.l_$id -aspect 1500 -text $title
3907 entry $cframe.e_$id -width $sz -background $bgcolor \
3908 -textvariable newviewopts($n,$id)
3909 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3910 pack $cframe.e_$id -in $cframe -side top -fill x
3911 } elseif {$type eq "path"} {
3912 message $top.l -aspect 1500 -text $title
3913 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
3914 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3915 if {[info exists viewfiles($n)]} {
3916 foreach f $viewfiles($n) {
3917 $top.t insert end $f
3918 $top.t insert end "\n"
3920 $top.t delete {end - 1c} end
3921 $top.t mark set insert 0.0
3923 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3928 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3929 button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3930 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3931 bind $top <Control-Return> [list newviewok $top $n]
3932 bind $top <F5> [list newviewok $top $n 1]
3933 bind $top <Escape> [list destroy $top]
3934 grid $top.buts.ok $top.buts.apply $top.buts.can
3935 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3936 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3937 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3938 pack $top.buts -in $top -side top -fill x
3942 proc doviewmenu {m first cmd op argv} {
3943 set nmenu [$m index end]
3944 for {set i $first} {$i <= $nmenu} {incr i} {
3945 if {[$m entrycget $i -command] eq $cmd} {
3946 eval $m $op $i $argv
3952 proc allviewmenus {n op args} {
3955 doviewmenu .bar.view 5 [list showview $n] $op $args
3956 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3959 proc newviewok {top n {apply 0}} {
3960 global nextviewnum newviewperm newviewname newishighlight
3961 global viewname viewfiles viewperm selectedview curview
3962 global viewargs viewargscmd newviewopts viewhlmenu
3965 set newargs [encode_view_opts $n]
3967 error_popup "[mc "Error in commit selection arguments:"] $err" $top
3971 foreach f [split [$top.t get 0.0 end] "\n"] {
3972 set ft [string trim $f]
3977 if {![info exists viewfiles($n)]} {
3978 # creating a new view
3980 set viewname($n) $newviewname($n)
3981 set viewperm($n) $newviewopts($n,perm)
3982 set viewfiles($n) $files
3983 set viewargs($n) $newargs
3984 set viewargscmd($n) $newviewopts($n,cmd)
3986 if {!$newishighlight} {
3989 run addvhighlight $n
3992 # editing an existing view
3993 set viewperm($n) $newviewopts($n,perm)
3994 if {$newviewname($n) ne $viewname($n)} {
3995 set viewname($n) $newviewname($n)
3996 doviewmenu .bar.view 5 [list showview $n] \
3997 entryconf [list -label $viewname($n)]
3998 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3999 # entryconf [list -label $viewname($n) -value $viewname($n)]
4001 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4002 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4003 set viewfiles($n) $files
4004 set viewargs($n) $newargs
4005 set viewargscmd($n) $newviewopts($n,cmd)
4006 if {$curview == $n} {
4012 catch {destroy $top}
4016 global curview viewperm hlview selectedhlview
4018 if {$curview == 0} return
4019 if {[info exists hlview] && $hlview == $curview} {
4020 set selectedhlview [mc "None"]
4023 allviewmenus $curview delete
4024 set viewperm($curview) 0
4028 proc addviewmenu {n} {
4029 global viewname viewhlmenu
4031 .bar.view add radiobutton -label $viewname($n) \
4032 -command [list showview $n] -variable selectedview -value $n
4033 #$viewhlmenu add radiobutton -label $viewname($n) \
4034 # -command [list addvhighlight $n] -variable selectedhlview
4038 global curview cached_commitrow ordertok
4039 global displayorder parentlist rowidlist rowisopt rowfinal
4040 global colormap rowtextx nextcolor canvxmax
4041 global numcommits viewcomplete
4042 global selectedline currentid canv canvy0
4044 global pending_select mainheadid
4047 global hlview selectedhlview commitinterest
4049 if {$n == $curview} return
4051 set ymax [lindex [$canv cget -scrollregion] 3]
4052 set span [$canv yview]
4053 set ytop [expr {[lindex $span 0] * $ymax}]
4054 set ybot [expr {[lindex $span 1] * $ymax}]
4055 set yscreen [expr {($ybot - $ytop) / 2}]
4056 if {$selectedline ne {}} {
4057 set selid $currentid
4058 set y [yc $selectedline]
4059 if {$ytop < $y && $y < $ybot} {
4060 set yscreen [expr {$y - $ytop}]
4062 } elseif {[info exists pending_select]} {
4063 set selid $pending_select
4064 unset pending_select
4068 catch {unset treediffs}
4070 if {[info exists hlview] && $hlview == $n} {
4072 set selectedhlview [mc "None"]
4074 catch {unset commitinterest}
4075 catch {unset cached_commitrow}
4076 catch {unset ordertok}
4080 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4081 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4084 if {![info exists viewcomplete($n)]} {
4094 set numcommits $commitidx($n)
4096 catch {unset colormap}
4097 catch {unset rowtextx}
4099 set canvxmax [$canv cget -width]
4105 if {$selid ne {} && [commitinview $selid $n]} {
4106 set row [rowofcommit $selid]
4107 # try to get the selected row in the same position on the screen
4108 set ymax [lindex [$canv cget -scrollregion] 3]
4109 set ytop [expr {[yc $row] - $yscreen}]
4113 set yf [expr {$ytop * 1.0 / $ymax}]
4115 allcanvs yview moveto $yf
4119 } elseif {!$viewcomplete($n)} {
4120 reset_pending_select $selid
4122 reset_pending_select {}
4124 if {[commitinview $pending_select $curview]} {
4125 selectline [rowofcommit $pending_select] 1
4127 set row [first_real_row]
4128 if {$row < $numcommits} {
4133 if {!$viewcomplete($n)} {
4134 if {$numcommits == 0} {
4135 show_status [mc "Reading commits..."]
4137 } elseif {$numcommits == 0} {
4138 show_status [mc "No commits selected"]
4142 # Stuff relating to the highlighting facility
4144 proc ishighlighted {id} {
4145 global vhighlights fhighlights nhighlights rhighlights
4147 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4148 return $nhighlights($id)
4150 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4151 return $vhighlights($id)
4153 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4154 return $fhighlights($id)
4156 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4157 return $rhighlights($id)
4162 proc bolden {id font} {
4163 global canv linehtag currentid boldids need_redisplay markedid
4165 # need_redisplay = 1 means the display is stale and about to be redrawn
4166 if {$need_redisplay} return
4168 $canv itemconf $linehtag($id) -font $font
4169 if {[info exists currentid] && $id eq $currentid} {
4171 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4172 -outline {{}} -tags secsel \
4173 -fill [$canv cget -selectbackground]]
4176 if {[info exists markedid] && $id eq $markedid} {
4181 proc bolden_name {id font} {
4182 global canv2 linentag currentid boldnameids need_redisplay
4184 if {$need_redisplay} return
4185 lappend boldnameids $id
4186 $canv2 itemconf $linentag($id) -font $font
4187 if {[info exists currentid] && $id eq $currentid} {
4188 $canv2 delete secsel
4189 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4190 -outline {{}} -tags secsel \
4191 -fill [$canv2 cget -selectbackground]]
4200 foreach id $boldids {
4201 if {![ishighlighted $id]} {
4204 lappend stillbold $id
4207 set boldids $stillbold
4210 proc addvhighlight {n} {
4211 global hlview viewcomplete curview vhl_done commitidx
4213 if {[info exists hlview]} {
4217 if {$n != $curview && ![info exists viewcomplete($n)]} {
4220 set vhl_done $commitidx($hlview)
4221 if {$vhl_done > 0} {
4226 proc delvhighlight {} {
4227 global hlview vhighlights
4229 if {![info exists hlview]} return
4231 catch {unset vhighlights}
4235 proc vhighlightmore {} {
4236 global hlview vhl_done commitidx vhighlights curview
4238 set max $commitidx($hlview)
4239 set vr [visiblerows]
4240 set r0 [lindex $vr 0]
4241 set r1 [lindex $vr 1]
4242 for {set i $vhl_done} {$i < $max} {incr i} {
4243 set id [commitonrow $i $hlview]
4244 if {[commitinview $id $curview]} {
4245 set row [rowofcommit $id]
4246 if {$r0 <= $row && $row <= $r1} {
4247 if {![highlighted $row]} {
4248 bolden $id mainfontbold
4250 set vhighlights($id) 1
4258 proc askvhighlight {row id} {
4259 global hlview vhighlights iddrawn
4261 if {[commitinview $id $hlview]} {
4262 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4263 bolden $id mainfontbold
4265 set vhighlights($id) 1
4267 set vhighlights($id) 0
4271 proc hfiles_change {} {
4272 global highlight_files filehighlight fhighlights fh_serial
4273 global highlight_paths
4275 if {[info exists filehighlight]} {
4276 # delete previous highlights
4277 catch {close $filehighlight}
4279 catch {unset fhighlights}
4281 unhighlight_filelist
4283 set highlight_paths {}
4284 after cancel do_file_hl $fh_serial
4286 if {$highlight_files ne {}} {
4287 after 300 do_file_hl $fh_serial
4291 proc gdttype_change {name ix op} {
4292 global gdttype highlight_files findstring findpattern
4295 if {$findstring ne {}} {
4296 if {$gdttype eq [mc "containing:"]} {
4297 if {$highlight_files ne {}} {
4298 set highlight_files {}
4303 if {$findpattern ne {}} {
4307 set highlight_files $findstring
4312 # enable/disable findtype/findloc menus too
4315 proc find_change {name ix op} {
4316 global gdttype findstring highlight_files
4319 if {$gdttype eq [mc "containing:"]} {
4322 if {$highlight_files ne $findstring} {
4323 set highlight_files $findstring
4330 proc findcom_change args {
4331 global nhighlights boldnameids
4332 global findpattern findtype findstring gdttype
4335 # delete previous highlights, if any
4336 foreach id $boldnameids {
4337 bolden_name $id mainfont
4340 catch {unset nhighlights}
4343 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4345 } elseif {$findtype eq [mc "Regexp"]} {
4346 set findpattern $findstring
4348 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4350 set findpattern "*$e*"
4354 proc makepatterns {l} {
4357 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4358 if {[string index $ee end] eq "/"} {
4368 proc do_file_hl {serial} {
4369 global highlight_files filehighlight highlight_paths gdttype fhl_list
4371 if {$gdttype eq [mc "touching paths:"]} {
4372 if {[catch {set paths [shellsplit $highlight_files]}]} return
4373 set highlight_paths [makepatterns $paths]
4375 set gdtargs [concat -- $paths]
4376 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4377 set gdtargs [list "-S$highlight_files"]
4379 # must be "containing:", i.e. we're searching commit info
4382 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4383 set filehighlight [open $cmd r+]
4384 fconfigure $filehighlight -blocking 0
4385 filerun $filehighlight readfhighlight
4391 proc flushhighlights {} {
4392 global filehighlight fhl_list
4394 if {[info exists filehighlight]} {
4396 puts $filehighlight ""
4397 flush $filehighlight
4401 proc askfilehighlight {row id} {
4402 global filehighlight fhighlights fhl_list
4404 lappend fhl_list $id
4405 set fhighlights($id) -1
4406 puts $filehighlight $id
4409 proc readfhighlight {} {
4410 global filehighlight fhighlights curview iddrawn
4411 global fhl_list find_dirn
4413 if {![info exists filehighlight]} {
4417 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4418 set line [string trim $line]
4419 set i [lsearch -exact $fhl_list $line]
4420 if {$i < 0} continue
4421 for {set j 0} {$j < $i} {incr j} {
4422 set id [lindex $fhl_list $j]
4423 set fhighlights($id) 0
4425 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4426 if {$line eq {}} continue
4427 if {![commitinview $line $curview]} continue
4428 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4429 bolden $line mainfontbold
4431 set fhighlights($line) 1
4433 if {[eof $filehighlight]} {
4435 puts "oops, git diff-tree died"
4436 catch {close $filehighlight}
4440 if {[info exists find_dirn]} {
4446 proc doesmatch {f} {
4447 global findtype findpattern
4449 if {$findtype eq [mc "Regexp"]} {
4450 return [regexp $findpattern $f]
4451 } elseif {$findtype eq [mc "IgnCase"]} {
4452 return [string match -nocase $findpattern $f]
4454 return [string match $findpattern $f]
4458 proc askfindhighlight {row id} {
4459 global nhighlights commitinfo iddrawn
4461 global markingmatches
4463 if {![info exists commitinfo($id)]} {
4466 set info $commitinfo($id)
4468 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4469 foreach f $info ty $fldtypes {
4470 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4472 if {$ty eq [mc "Author"]} {
4479 if {$isbold && [info exists iddrawn($id)]} {
4480 if {![ishighlighted $id]} {
4481 bolden $id mainfontbold
4483 bolden_name $id mainfontbold
4486 if {$markingmatches} {
4487 markrowmatches $row $id
4490 set nhighlights($id) $isbold
4493 proc markrowmatches {row id} {
4494 global canv canv2 linehtag linentag commitinfo findloc
4496 set headline [lindex $commitinfo($id) 0]
4497 set author [lindex $commitinfo($id) 1]
4498 $canv delete match$row
4499 $canv2 delete match$row
4500 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4501 set m [findmatches $headline]
4503 markmatches $canv $row $headline $linehtag($id) $m \
4504 [$canv itemcget $linehtag($id) -font] $row
4507 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4508 set m [findmatches $author]
4510 markmatches $canv2 $row $author $linentag($id) $m \
4511 [$canv2 itemcget $linentag($id) -font] $row
4516 proc vrel_change {name ix op} {
4517 global highlight_related
4520 if {$highlight_related ne [mc "None"]} {
4525 # prepare for testing whether commits are descendents or ancestors of a
4526 proc rhighlight_sel {a} {
4527 global descendent desc_todo ancestor anc_todo
4528 global highlight_related
4530 catch {unset descendent}
4531 set desc_todo [list $a]
4532 catch {unset ancestor}
4533 set anc_todo [list $a]
4534 if {$highlight_related ne [mc "None"]} {
4540 proc rhighlight_none {} {
4543 catch {unset rhighlights}
4547 proc is_descendent {a} {
4548 global curview children descendent desc_todo
4551 set la [rowofcommit $a]
4555 for {set i 0} {$i < [llength $todo]} {incr i} {
4556 set do [lindex $todo $i]
4557 if {[rowofcommit $do] < $la} {
4558 lappend leftover $do
4561 foreach nk $children($v,$do) {
4562 if {![info exists descendent($nk)]} {
4563 set descendent($nk) 1
4571 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4575 set descendent($a) 0
4576 set desc_todo $leftover
4579 proc is_ancestor {a} {
4580 global curview parents ancestor anc_todo
4583 set la [rowofcommit $a]
4587 for {set i 0} {$i < [llength $todo]} {incr i} {
4588 set do [lindex $todo $i]
4589 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4590 lappend leftover $do
4593 foreach np $parents($v,$do) {
4594 if {![info exists ancestor($np)]} {
4603 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4608 set anc_todo $leftover
4611 proc askrelhighlight {row id} {
4612 global descendent highlight_related iddrawn rhighlights
4613 global selectedline ancestor
4615 if {$selectedline eq {}} return
4617 if {$highlight_related eq [mc "Descendant"] ||
4618 $highlight_related eq [mc "Not descendant"]} {
4619 if {![info exists descendent($id)]} {
4622 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4625 } elseif {$highlight_related eq [mc "Ancestor"] ||
4626 $highlight_related eq [mc "Not ancestor"]} {
4627 if {![info exists ancestor($id)]} {
4630 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4634 if {[info exists iddrawn($id)]} {
4635 if {$isbold && ![ishighlighted $id]} {
4636 bolden $id mainfontbold
4639 set rhighlights($id) $isbold
4642 # Graph layout functions
4644 proc shortids {ids} {
4647 if {[llength $id] > 1} {
4648 lappend res [shortids $id]
4649 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4650 lappend res [string range $id 0 7]
4661 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4662 if {($n & $mask) != 0} {
4663 set ret [concat $ret $o]
4665 set o [concat $o $o]
4670 proc ordertoken {id} {
4671 global ordertok curview varcid varcstart varctok curview parents children
4672 global nullid nullid2
4674 if {[info exists ordertok($id)]} {
4675 return $ordertok($id)
4680 if {[info exists varcid($curview,$id)]} {
4681 set a $varcid($curview,$id)
4682 set p [lindex $varcstart($curview) $a]
4684 set p [lindex $children($curview,$id) 0]
4686 if {[info exists ordertok($p)]} {
4687 set tok $ordertok($p)
4690 set id [first_real_child $curview,$p]
4693 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4696 if {[llength $parents($curview,$id)] == 1} {
4697 lappend todo [list $p {}]
4699 set j [lsearch -exact $parents($curview,$id) $p]
4701 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4703 lappend todo [list $p [strrep $j]]
4706 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4707 set p [lindex $todo $i 0]
4708 append tok [lindex $todo $i 1]
4709 set ordertok($p) $tok
4711 set ordertok($origid) $tok
4715 # Work out where id should go in idlist so that order-token
4716 # values increase from left to right
4717 proc idcol {idlist id {i 0}} {
4718 set t [ordertoken $id]
4722 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4723 if {$i > [llength $idlist]} {
4724 set i [llength $idlist]
4726 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4729 if {$t > [ordertoken [lindex $idlist $i]]} {
4730 while {[incr i] < [llength $idlist] &&
4731 $t >= [ordertoken [lindex $idlist $i]]} {}
4737 proc initlayout {} {
4738 global rowidlist rowisopt rowfinal displayorder parentlist
4739 global numcommits canvxmax canv
4741 global colormap rowtextx
4750 set canvxmax [$canv cget -width]
4751 catch {unset colormap}
4752 catch {unset rowtextx}
4756 proc setcanvscroll {} {
4757 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4758 global lastscrollset lastscrollrows
4760 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4761 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4762 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4763 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4764 set lastscrollset [clock clicks -milliseconds]
4765 set lastscrollrows $numcommits
4768 proc visiblerows {} {
4769 global canv numcommits linespc
4771 set ymax [lindex [$canv cget -scrollregion] 3]
4772 if {$ymax eq {} || $ymax == 0} return
4774 set y0 [expr {int([lindex $f 0] * $ymax)}]
4775 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4779 set y1 [expr {int([lindex $f 1] * $ymax)}]
4780 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4781 if {$r1 >= $numcommits} {
4782 set r1 [expr {$numcommits - 1}]
4784 return [list $r0 $r1]
4787 proc layoutmore {} {
4788 global commitidx viewcomplete curview
4789 global numcommits pending_select curview
4790 global lastscrollset lastscrollrows
4792 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4793 [clock clicks -milliseconds] - $lastscrollset > 500} {
4796 if {[info exists pending_select] &&
4797 [commitinview $pending_select $curview]} {
4799 selectline [rowofcommit $pending_select] 1
4804 # With path limiting, we mightn't get the actual HEAD commit,
4805 # so ask git rev-list what is the first ancestor of HEAD that
4806 # touches a file in the path limit.
4807 proc get_viewmainhead {view} {
4808 global viewmainheadid vfilelimit viewinstances mainheadid
4811 set rfd [open [concat | git rev-list -1 $mainheadid \
4812 -- $vfilelimit($view)] r]
4813 set j [reg_instance $rfd]
4814 lappend viewinstances($view) $j
4815 fconfigure $rfd -blocking 0
4816 filerun $rfd [list getviewhead $rfd $j $view]
4817 set viewmainheadid($curview) {}
4821 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4822 proc getviewhead {fd inst view} {
4823 global viewmainheadid commfd curview viewinstances showlocalchanges
4826 if {[gets $fd line] < 0} {
4830 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4833 set viewmainheadid($view) $id
4836 set i [lsearch -exact $viewinstances($view) $inst]
4838 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4840 if {$showlocalchanges && $id ne {} && $view == $curview} {
4846 proc doshowlocalchanges {} {
4847 global curview viewmainheadid
4849 if {$viewmainheadid($curview) eq {}} return
4850 if {[commitinview $viewmainheadid($curview) $curview]} {
4853 interestedin $viewmainheadid($curview) dodiffindex
4857 proc dohidelocalchanges {} {
4858 global nullid nullid2 lserial curview
4860 if {[commitinview $nullid $curview]} {
4861 removefakerow $nullid
4863 if {[commitinview $nullid2 $curview]} {
4864 removefakerow $nullid2
4869 # spawn off a process to do git diff-index --cached HEAD
4870 proc dodiffindex {} {
4871 global lserial showlocalchanges vfilelimit curview
4874 if {!$showlocalchanges || !$isworktree} return
4876 set cmd "|git diff-index --cached HEAD"
4877 if {$vfilelimit($curview) ne {}} {
4878 set cmd [concat $cmd -- $vfilelimit($curview)]
4880 set fd [open $cmd r]
4881 fconfigure $fd -blocking 0
4882 set i [reg_instance $fd]
4883 filerun $fd [list readdiffindex $fd $lserial $i]
4886 proc readdiffindex {fd serial inst} {
4887 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
4891 if {[gets $fd line] < 0} {
4897 # we only need to see one line and we don't really care what it says...
4900 if {$serial != $lserial} {
4904 # now see if there are any local changes not checked in to the index
4905 set cmd "|git diff-files"
4906 if {$vfilelimit($curview) ne {}} {
4907 set cmd [concat $cmd -- $vfilelimit($curview)]
4909 set fd [open $cmd r]
4910 fconfigure $fd -blocking 0
4911 set i [reg_instance $fd]
4912 filerun $fd [list readdifffiles $fd $serial $i]
4914 if {$isdiff && ![commitinview $nullid2 $curview]} {
4915 # add the line for the changes in the index to the graph
4916 set hl [mc "Local changes checked in to index but not committed"]
4917 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4918 set commitdata($nullid2) "\n $hl\n"
4919 if {[commitinview $nullid $curview]} {
4920 removefakerow $nullid
4922 insertfakerow $nullid2 $viewmainheadid($curview)
4923 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4924 if {[commitinview $nullid $curview]} {
4925 removefakerow $nullid
4927 removefakerow $nullid2
4932 proc readdifffiles {fd serial inst} {
4933 global viewmainheadid nullid nullid2 curview
4934 global commitinfo commitdata lserial
4937 if {[gets $fd line] < 0} {
4943 # we only need to see one line and we don't really care what it says...
4946 if {$serial != $lserial} {
4950 if {$isdiff && ![commitinview $nullid $curview]} {
4951 # add the line for the local diff to the graph
4952 set hl [mc "Local uncommitted changes, not checked in to index"]
4953 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4954 set commitdata($nullid) "\n $hl\n"
4955 if {[commitinview $nullid2 $curview]} {
4958 set p $viewmainheadid($curview)
4960 insertfakerow $nullid $p
4961 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4962 removefakerow $nullid
4967 proc nextuse {id row} {
4968 global curview children
4970 if {[info exists children($curview,$id)]} {
4971 foreach kid $children($curview,$id) {
4972 if {![commitinview $kid $curview]} {
4975 if {[rowofcommit $kid] > $row} {
4976 return [rowofcommit $kid]
4980 if {[commitinview $id $curview]} {
4981 return [rowofcommit $id]
4986 proc prevuse {id row} {
4987 global curview children
4990 if {[info exists children($curview,$id)]} {
4991 foreach kid $children($curview,$id) {
4992 if {![commitinview $kid $curview]} break
4993 if {[rowofcommit $kid] < $row} {
4994 set ret [rowofcommit $kid]
5001 proc make_idlist {row} {
5002 global displayorder parentlist uparrowlen downarrowlen mingaplen
5003 global commitidx curview children
5005 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5009 set ra [expr {$row - $downarrowlen}]
5013 set rb [expr {$row + $uparrowlen}]
5014 if {$rb > $commitidx($curview)} {
5015 set rb $commitidx($curview)
5017 make_disporder $r [expr {$rb + 1}]
5019 for {} {$r < $ra} {incr r} {
5020 set nextid [lindex $displayorder [expr {$r + 1}]]
5021 foreach p [lindex $parentlist $r] {
5022 if {$p eq $nextid} continue
5023 set rn [nextuse $p $r]
5025 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5026 lappend ids [list [ordertoken $p] $p]
5030 for {} {$r < $row} {incr r} {
5031 set nextid [lindex $displayorder [expr {$r + 1}]]
5032 foreach p [lindex $parentlist $r] {
5033 if {$p eq $nextid} continue
5034 set rn [nextuse $p $r]
5035 if {$rn < 0 || $rn >= $row} {
5036 lappend ids [list [ordertoken $p] $p]
5040 set id [lindex $displayorder $row]
5041 lappend ids [list [ordertoken $id] $id]
5043 foreach p [lindex $parentlist $r] {
5044 set firstkid [lindex $children($curview,$p) 0]
5045 if {[rowofcommit $firstkid] < $row} {
5046 lappend ids [list [ordertoken $p] $p]
5050 set id [lindex $displayorder $r]
5052 set firstkid [lindex $children($curview,$id) 0]
5053 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5054 lappend ids [list [ordertoken $id] $id]
5059 foreach idx [lsort -unique $ids] {
5060 lappend idlist [lindex $idx 1]
5065 proc rowsequal {a b} {
5066 while {[set i [lsearch -exact $a {}]] >= 0} {
5067 set a [lreplace $a $i $i]
5069 while {[set i [lsearch -exact $b {}]] >= 0} {
5070 set b [lreplace $b $i $i]
5072 return [expr {$a eq $b}]
5075 proc makeupline {id row rend col} {
5076 global rowidlist uparrowlen downarrowlen mingaplen
5078 for {set r $rend} {1} {set r $rstart} {
5079 set rstart [prevuse $id $r]
5080 if {$rstart < 0} return
5081 if {$rstart < $row} break
5083 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5084 set rstart [expr {$rend - $uparrowlen - 1}]
5086 for {set r $rstart} {[incr r] <= $row} {} {
5087 set idlist [lindex $rowidlist $r]
5088 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5089 set col [idcol $idlist $id $col]
5090 lset rowidlist $r [linsert $idlist $col $id]
5096 proc layoutrows {row endrow} {
5097 global rowidlist rowisopt rowfinal displayorder
5098 global uparrowlen downarrowlen maxwidth mingaplen
5099 global children parentlist
5100 global commitidx viewcomplete curview
5102 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5105 set rm1 [expr {$row - 1}]
5106 foreach id [lindex $rowidlist $rm1] {
5111 set final [lindex $rowfinal $rm1]
5113 for {} {$row < $endrow} {incr row} {
5114 set rm1 [expr {$row - 1}]
5115 if {$rm1 < 0 || $idlist eq {}} {
5116 set idlist [make_idlist $row]
5119 set id [lindex $displayorder $rm1]
5120 set col [lsearch -exact $idlist $id]
5121 set idlist [lreplace $idlist $col $col]
5122 foreach p [lindex $parentlist $rm1] {
5123 if {[lsearch -exact $idlist $p] < 0} {
5124 set col [idcol $idlist $p $col]
5125 set idlist [linsert $idlist $col $p]
5126 # if not the first child, we have to insert a line going up
5127 if {$id ne [lindex $children($curview,$p) 0]} {
5128 makeupline $p $rm1 $row $col
5132 set id [lindex $displayorder $row]
5133 if {$row > $downarrowlen} {
5134 set termrow [expr {$row - $downarrowlen - 1}]
5135 foreach p [lindex $parentlist $termrow] {
5136 set i [lsearch -exact $idlist $p]
5137 if {$i < 0} continue
5138 set nr [nextuse $p $termrow]
5139 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5140 set idlist [lreplace $idlist $i $i]
5144 set col [lsearch -exact $idlist $id]
5146 set col [idcol $idlist $id]
5147 set idlist [linsert $idlist $col $id]
5148 if {$children($curview,$id) ne {}} {
5149 makeupline $id $rm1 $row $col
5152 set r [expr {$row + $uparrowlen - 1}]
5153 if {$r < $commitidx($curview)} {
5155 foreach p [lindex $parentlist $r] {
5156 if {[lsearch -exact $idlist $p] >= 0} continue
5157 set fk [lindex $children($curview,$p) 0]
5158 if {[rowofcommit $fk] < $row} {
5159 set x [idcol $idlist $p $x]
5160 set idlist [linsert $idlist $x $p]
5163 if {[incr r] < $commitidx($curview)} {
5164 set p [lindex $displayorder $r]
5165 if {[lsearch -exact $idlist $p] < 0} {
5166 set fk [lindex $children($curview,$p) 0]
5167 if {$fk ne {} && [rowofcommit $fk] < $row} {
5168 set x [idcol $idlist $p $x]
5169 set idlist [linsert $idlist $x $p]
5175 if {$final && !$viewcomplete($curview) &&
5176 $row + $uparrowlen + $mingaplen + $downarrowlen
5177 >= $commitidx($curview)} {
5180 set l [llength $rowidlist]
5182 lappend rowidlist $idlist
5184 lappend rowfinal $final
5185 } elseif {$row < $l} {
5186 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5187 lset rowidlist $row $idlist
5190 lset rowfinal $row $final
5192 set pad [ntimes [expr {$row - $l}] {}]
5193 set rowidlist [concat $rowidlist $pad]
5194 lappend rowidlist $idlist
5195 set rowfinal [concat $rowfinal $pad]
5196 lappend rowfinal $final
5197 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5203 proc changedrow {row} {
5204 global displayorder iddrawn rowisopt need_redisplay
5206 set l [llength $rowisopt]
5208 lset rowisopt $row 0
5209 if {$row + 1 < $l} {
5210 lset rowisopt [expr {$row + 1}] 0
5211 if {$row + 2 < $l} {
5212 lset rowisopt [expr {$row + 2}] 0
5216 set id [lindex $displayorder $row]
5217 if {[info exists iddrawn($id)]} {
5218 set need_redisplay 1
5222 proc insert_pad {row col npad} {
5225 set pad [ntimes $npad {}]
5226 set idlist [lindex $rowidlist $row]
5227 set bef [lrange $idlist 0 [expr {$col - 1}]]
5228 set aft [lrange $idlist $col end]
5229 set i [lsearch -exact $aft {}]
5231 set aft [lreplace $aft $i $i]
5233 lset rowidlist $row [concat $bef $pad $aft]
5237 proc optimize_rows {row col endrow} {
5238 global rowidlist rowisopt displayorder curview children
5243 for {} {$row < $endrow} {incr row; set col 0} {
5244 if {[lindex $rowisopt $row]} continue
5246 set y0 [expr {$row - 1}]
5247 set ym [expr {$row - 2}]
5248 set idlist [lindex $rowidlist $row]
5249 set previdlist [lindex $rowidlist $y0]
5250 if {$idlist eq {} || $previdlist eq {}} continue
5252 set pprevidlist [lindex $rowidlist $ym]
5253 if {$pprevidlist eq {}} continue
5259 for {} {$col < [llength $idlist]} {incr col} {
5260 set id [lindex $idlist $col]
5261 if {[lindex $previdlist $col] eq $id} continue
5266 set x0 [lsearch -exact $previdlist $id]
5267 if {$x0 < 0} continue
5268 set z [expr {$x0 - $col}]
5272 set xm [lsearch -exact $pprevidlist $id]
5274 set z0 [expr {$xm - $x0}]
5278 # if row y0 is the first child of $id then it's not an arrow
5279 if {[lindex $children($curview,$id) 0] ne
5280 [lindex $displayorder $y0]} {
5284 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5285 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5288 # Looking at lines from this row to the previous row,
5289 # make them go straight up if they end in an arrow on
5290 # the previous row; otherwise make them go straight up
5292 if {$z < -1 || ($z < 0 && $isarrow)} {
5293 # Line currently goes left too much;
5294 # insert pads in the previous row, then optimize it
5295 set npad [expr {-1 - $z + $isarrow}]
5296 insert_pad $y0 $x0 $npad
5298 optimize_rows $y0 $x0 $row
5300 set previdlist [lindex $rowidlist $y0]
5301 set x0 [lsearch -exact $previdlist $id]
5302 set z [expr {$x0 - $col}]
5304 set pprevidlist [lindex $rowidlist $ym]
5305 set xm [lsearch -exact $pprevidlist $id]
5306 set z0 [expr {$xm - $x0}]
5308 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5309 # Line currently goes right too much;
5310 # insert pads in this line
5311 set npad [expr {$z - 1 + $isarrow}]
5312 insert_pad $row $col $npad
5313 set idlist [lindex $rowidlist $row]
5315 set z [expr {$x0 - $col}]
5318 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5319 # this line links to its first child on row $row-2
5320 set id [lindex $displayorder $ym]
5321 set xc [lsearch -exact $pprevidlist $id]
5323 set z0 [expr {$xc - $x0}]
5326 # avoid lines jigging left then immediately right
5327 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5328 insert_pad $y0 $x0 1
5330 optimize_rows $y0 $x0 $row
5331 set previdlist [lindex $rowidlist $y0]
5335 # Find the first column that doesn't have a line going right
5336 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5337 set id [lindex $idlist $col]
5338 if {$id eq {}} break
5339 set x0 [lsearch -exact $previdlist $id]
5341 # check if this is the link to the first child
5342 set kid [lindex $displayorder $y0]
5343 if {[lindex $children($curview,$id) 0] eq $kid} {
5344 # it is, work out offset to child
5345 set x0 [lsearch -exact $previdlist $kid]
5348 if {$x0 <= $col} break
5350 # Insert a pad at that column as long as it has a line and
5351 # isn't the last column
5352 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5353 set idlist [linsert $idlist $col {}]
5354 lset rowidlist $row $idlist
5362 global canvx0 linespc
5363 return [expr {$canvx0 + $col * $linespc}]
5367 global canvy0 linespc
5368 return [expr {$canvy0 + $row * $linespc}]
5371 proc linewidth {id} {
5372 global thickerline lthickness
5375 if {[info exists thickerline] && $id eq $thickerline} {
5376 set wid [expr {2 * $lthickness}]
5381 proc rowranges {id} {
5382 global curview children uparrowlen downarrowlen
5385 set kids $children($curview,$id)
5391 foreach child $kids {
5392 if {![commitinview $child $curview]} break
5393 set row [rowofcommit $child]
5394 if {![info exists prev]} {
5395 lappend ret [expr {$row + 1}]
5397 if {$row <= $prevrow} {
5398 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5400 # see if the line extends the whole way from prevrow to row
5401 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5402 [lsearch -exact [lindex $rowidlist \
5403 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5404 # it doesn't, see where it ends
5405 set r [expr {$prevrow + $downarrowlen}]
5406 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5407 while {[incr r -1] > $prevrow &&
5408 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5410 while {[incr r] <= $row &&
5411 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5415 # see where it starts up again
5416 set r [expr {$row - $uparrowlen}]
5417 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5418 while {[incr r] < $row &&
5419 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5421 while {[incr r -1] >= $prevrow &&
5422 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5428 if {$child eq $id} {
5437 proc drawlineseg {id row endrow arrowlow} {
5438 global rowidlist displayorder iddrawn linesegs
5439 global canv colormap linespc curview maxlinelen parentlist
5441 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5442 set le [expr {$row + 1}]
5445 set c [lsearch -exact [lindex $rowidlist $le] $id]
5451 set x [lindex $displayorder $le]
5456 if {[info exists iddrawn($x)] || $le == $endrow} {
5457 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5473 if {[info exists linesegs($id)]} {
5474 set lines $linesegs($id)
5476 set r0 [lindex $li 0]
5478 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5488 set li [lindex $lines [expr {$i-1}]]
5489 set r1 [lindex $li 1]
5490 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5495 set x [lindex $cols [expr {$le - $row}]]
5496 set xp [lindex $cols [expr {$le - 1 - $row}]]
5497 set dir [expr {$xp - $x}]
5499 set ith [lindex $lines $i 2]
5500 set coords [$canv coords $ith]
5501 set ah [$canv itemcget $ith -arrow]
5502 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5503 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5504 if {$x2 ne {} && $x - $x2 == $dir} {
5505 set coords [lrange $coords 0 end-2]
5508 set coords [list [xc $le $x] [yc $le]]
5511 set itl [lindex $lines [expr {$i-1}] 2]
5512 set al [$canv itemcget $itl -arrow]
5513 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5514 } elseif {$arrowlow} {
5515 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5516 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5520 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5521 for {set y $le} {[incr y -1] > $row} {} {
5523 set xp [lindex $cols [expr {$y - 1 - $row}]]
5524 set ndir [expr {$xp - $x}]
5525 if {$dir != $ndir || $xp < 0} {
5526 lappend coords [xc $y $x] [yc $y]
5532 # join parent line to first child
5533 set ch [lindex $displayorder $row]
5534 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5536 puts "oops: drawlineseg: child $ch not on row $row"
5537 } elseif {$xc != $x} {
5538 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5539 set d [expr {int(0.5 * $linespc)}]
5542 set x2 [expr {$x1 - $d}]
5544 set x2 [expr {$x1 + $d}]
5547 set y1 [expr {$y2 + $d}]
5548 lappend coords $x1 $y1 $x2 $y2
5549 } elseif {$xc < $x - 1} {
5550 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5551 } elseif {$xc > $x + 1} {
5552 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5556 lappend coords [xc $row $x] [yc $row]
5558 set xn [xc $row $xp]
5560 lappend coords $xn $yn
5564 set t [$canv create line $coords -width [linewidth $id] \
5565 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5568 set lines [linsert $lines $i [list $row $le $t]]
5570 $canv coords $ith $coords
5571 if {$arrow ne $ah} {
5572 $canv itemconf $ith -arrow $arrow
5574 lset lines $i 0 $row
5577 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5578 set ndir [expr {$xo - $xp}]
5579 set clow [$canv coords $itl]
5580 if {$dir == $ndir} {
5581 set clow [lrange $clow 2 end]
5583 set coords [concat $coords $clow]
5585 lset lines [expr {$i-1}] 1 $le
5587 # coalesce two pieces
5589 set b [lindex $lines [expr {$i-1}] 0]
5590 set e [lindex $lines $i 1]
5591 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5593 $canv coords $itl $coords
5594 if {$arrow ne $al} {
5595 $canv itemconf $itl -arrow $arrow
5599 set linesegs($id) $lines
5603 proc drawparentlinks {id row} {
5604 global rowidlist canv colormap curview parentlist
5605 global idpos linespc
5607 set rowids [lindex $rowidlist $row]
5608 set col [lsearch -exact $rowids $id]
5609 if {$col < 0} return
5610 set olds [lindex $parentlist $row]
5611 set row2 [expr {$row + 1}]
5612 set x [xc $row $col]
5615 set d [expr {int(0.5 * $linespc)}]
5616 set ymid [expr {$y + $d}]
5617 set ids [lindex $rowidlist $row2]
5618 # rmx = right-most X coord used
5621 set i [lsearch -exact $ids $p]
5623 puts "oops, parent $p of $id not in list"
5626 set x2 [xc $row2 $i]
5630 set j [lsearch -exact $rowids $p]
5632 # drawlineseg will do this one for us
5636 # should handle duplicated parents here...
5637 set coords [list $x $y]
5639 # if attaching to a vertical segment, draw a smaller
5640 # slant for visual distinctness
5643 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5645 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5647 } elseif {$i < $col && $i < $j} {
5648 # segment slants towards us already
5649 lappend coords [xc $row $j] $y
5651 if {$i < $col - 1} {
5652 lappend coords [expr {$x2 + $linespc}] $y
5653 } elseif {$i > $col + 1} {
5654 lappend coords [expr {$x2 - $linespc}] $y
5656 lappend coords $x2 $y2
5659 lappend coords $x2 $y2
5661 set t [$canv create line $coords -width [linewidth $p] \
5662 -fill $colormap($p) -tags lines.$p]
5666 if {$rmx > [lindex $idpos($id) 1]} {
5667 lset idpos($id) 1 $rmx
5672 proc drawlines {id} {
5675 $canv itemconf lines.$id -width [linewidth $id]
5678 proc drawcmittext {id row col} {
5679 global linespc canv canv2 canv3 fgcolor curview
5680 global cmitlisted commitinfo rowidlist parentlist
5681 global rowtextx idpos idtags idheads idotherrefs
5682 global linehtag linentag linedtag selectedline
5683 global canvxmax boldids boldnameids fgcolor markedid
5684 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5686 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5687 set listed $cmitlisted($curview,$id)
5688 if {$id eq $nullid} {
5690 } elseif {$id eq $nullid2} {
5692 } elseif {$id eq $mainheadid} {
5695 set ofill [lindex $circlecolors $listed]
5697 set x [xc $row $col]
5699 set orad [expr {$linespc / 3}]
5701 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5702 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5703 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5704 } elseif {$listed == 3} {
5705 # triangle pointing left for left-side commits
5706 set t [$canv create polygon \
5707 [expr {$x - $orad}] $y \
5708 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5709 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5710 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5712 # triangle pointing right for right-side commits
5713 set t [$canv create polygon \
5714 [expr {$x + $orad - 1}] $y \
5715 [expr {$x - $orad}] [expr {$y - $orad}] \
5716 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5717 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5719 set circleitem($row) $t
5721 $canv bind $t <1> {selcanvline {} %x %y}
5722 set rmx [llength [lindex $rowidlist $row]]
5723 set olds [lindex $parentlist $row]
5725 set nextids [lindex $rowidlist [expr {$row + 1}]]
5727 set i [lsearch -exact $nextids $p]
5733 set xt [xc $row $rmx]
5734 set rowtextx($row) $xt
5735 set idpos($id) [list $x $xt $y]
5736 if {[info exists idtags($id)] || [info exists idheads($id)]
5737 || [info exists idotherrefs($id)]} {
5738 set xt [drawtags $id $x $xt $y]
5740 set headline [lindex $commitinfo($id) 0]
5741 set name [lindex $commitinfo($id) 1]
5742 set date [lindex $commitinfo($id) 2]
5743 set date [formatdate $date]
5746 set isbold [ishighlighted $id]
5749 set font mainfontbold
5751 lappend boldnameids $id
5752 set nfont mainfontbold
5755 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5756 -text $headline -font $font -tags text]
5757 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5758 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5759 -text $name -font $nfont -tags text]
5760 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5761 -text $date -font mainfont -tags text]
5762 if {$selectedline == $row} {
5765 if {[info exists markedid] && $markedid eq $id} {
5768 set xr [expr {$xt + [font measure $font $headline]}]
5769 if {$xr > $canvxmax} {
5775 proc drawcmitrow {row} {
5776 global displayorder rowidlist nrows_drawn
5777 global iddrawn markingmatches
5778 global commitinfo numcommits
5779 global filehighlight fhighlights findpattern nhighlights
5780 global hlview vhighlights
5781 global highlight_related rhighlights
5783 if {$row >= $numcommits} return
5785 set id [lindex $displayorder $row]
5786 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5787 askvhighlight $row $id
5789 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5790 askfilehighlight $row $id
5792 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5793 askfindhighlight $row $id
5795 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5796 askrelhighlight $row $id
5798 if {![info exists iddrawn($id)]} {
5799 set col [lsearch -exact [lindex $rowidlist $row] $id]
5801 puts "oops, row $row id $id not in list"
5804 if {![info exists commitinfo($id)]} {
5808 drawcmittext $id $row $col
5812 if {$markingmatches} {
5813 markrowmatches $row $id
5817 proc drawcommits {row {endrow {}}} {
5818 global numcommits iddrawn displayorder curview need_redisplay
5819 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5824 if {$endrow eq {}} {
5827 if {$endrow >= $numcommits} {
5828 set endrow [expr {$numcommits - 1}]
5831 set rl1 [expr {$row - $downarrowlen - 3}]
5835 set ro1 [expr {$row - 3}]
5839 set r2 [expr {$endrow + $uparrowlen + 3}]
5840 if {$r2 > $numcommits} {
5843 for {set r $rl1} {$r < $r2} {incr r} {
5844 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5848 set rl1 [expr {$r + 1}]
5854 optimize_rows $ro1 0 $r2
5855 if {$need_redisplay || $nrows_drawn > 2000} {
5859 # make the lines join to already-drawn rows either side
5860 set r [expr {$row - 1}]
5861 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5864 set er [expr {$endrow + 1}]
5865 if {$er >= $numcommits ||
5866 ![info exists iddrawn([lindex $displayorder $er])]} {
5869 for {} {$r <= $er} {incr r} {
5870 set id [lindex $displayorder $r]
5871 set wasdrawn [info exists iddrawn($id)]
5873 if {$r == $er} break
5874 set nextid [lindex $displayorder [expr {$r + 1}]]
5875 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5876 drawparentlinks $id $r
5878 set rowids [lindex $rowidlist $r]
5879 foreach lid $rowids {
5880 if {$lid eq {}} continue
5881 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5883 # see if this is the first child of any of its parents
5884 foreach p [lindex $parentlist $r] {
5885 if {[lsearch -exact $rowids $p] < 0} {
5886 # make this line extend up to the child
5887 set lineend($p) [drawlineseg $p $r $er 0]
5891 set lineend($lid) [drawlineseg $lid $r $er 1]
5897 proc undolayout {row} {
5898 global uparrowlen mingaplen downarrowlen
5899 global rowidlist rowisopt rowfinal need_redisplay
5901 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5905 if {[llength $rowidlist] > $r} {
5907 set rowidlist [lrange $rowidlist 0 $r]
5908 set rowfinal [lrange $rowfinal 0 $r]
5909 set rowisopt [lrange $rowisopt 0 $r]
5910 set need_redisplay 1
5915 proc drawvisible {} {
5916 global canv linespc curview vrowmod selectedline targetrow targetid
5917 global need_redisplay cscroll numcommits
5919 set fs [$canv yview]
5920 set ymax [lindex [$canv cget -scrollregion] 3]
5921 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5922 set f0 [lindex $fs 0]
5923 set f1 [lindex $fs 1]
5924 set y0 [expr {int($f0 * $ymax)}]
5925 set y1 [expr {int($f1 * $ymax)}]
5927 if {[info exists targetid]} {
5928 if {[commitinview $targetid $curview]} {
5929 set r [rowofcommit $targetid]
5930 if {$r != $targetrow} {
5931 # Fix up the scrollregion and change the scrolling position
5932 # now that our target row has moved.
5933 set diff [expr {($r - $targetrow) * $linespc}]
5936 set ymax [lindex [$canv cget -scrollregion] 3]
5939 set f0 [expr {$y0 / $ymax}]
5940 set f1 [expr {$y1 / $ymax}]
5941 allcanvs yview moveto $f0
5942 $cscroll set $f0 $f1
5943 set need_redisplay 1
5950 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5951 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5952 if {$endrow >= $vrowmod($curview)} {
5953 update_arcrows $curview
5955 if {$selectedline ne {} &&
5956 $row <= $selectedline && $selectedline <= $endrow} {
5957 set targetrow $selectedline
5958 } elseif {[info exists targetid]} {
5959 set targetrow [expr {int(($row + $endrow) / 2)}]
5961 if {[info exists targetrow]} {
5962 if {$targetrow >= $numcommits} {
5963 set targetrow [expr {$numcommits - 1}]
5965 set targetid [commitonrow $targetrow]
5967 drawcommits $row $endrow
5970 proc clear_display {} {
5971 global iddrawn linesegs need_redisplay nrows_drawn
5972 global vhighlights fhighlights nhighlights rhighlights
5973 global linehtag linentag linedtag boldids boldnameids
5976 catch {unset iddrawn}
5977 catch {unset linesegs}
5978 catch {unset linehtag}
5979 catch {unset linentag}
5980 catch {unset linedtag}
5983 catch {unset vhighlights}
5984 catch {unset fhighlights}
5985 catch {unset nhighlights}
5986 catch {unset rhighlights}
5987 set need_redisplay 0
5991 proc findcrossings {id} {
5992 global rowidlist parentlist numcommits displayorder
5996 foreach {s e} [rowranges $id] {
5997 if {$e >= $numcommits} {
5998 set e [expr {$numcommits - 1}]
6000 if {$e <= $s} continue
6001 for {set row $e} {[incr row -1] >= $s} {} {
6002 set x [lsearch -exact [lindex $rowidlist $row] $id]
6004 set olds [lindex $parentlist $row]
6005 set kid [lindex $displayorder $row]
6006 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6007 if {$kidx < 0} continue
6008 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6010 set px [lsearch -exact $nextrow $p]
6011 if {$px < 0} continue
6012 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6013 if {[lsearch -exact $ccross $p] >= 0} continue
6014 if {$x == $px + ($kidx < $px? -1: 1)} {
6016 } elseif {[lsearch -exact $cross $p] < 0} {
6023 return [concat $ccross {{}} $cross]
6026 proc assigncolor {id} {
6027 global colormap colors nextcolor
6028 global parents children children curview
6030 if {[info exists colormap($id)]} return
6031 set ncolors [llength $colors]
6032 if {[info exists children($curview,$id)]} {
6033 set kids $children($curview,$id)
6037 if {[llength $kids] == 1} {
6038 set child [lindex $kids 0]
6039 if {[info exists colormap($child)]
6040 && [llength $parents($curview,$child)] == 1} {
6041 set colormap($id) $colormap($child)
6047 foreach x [findcrossings $id] {
6049 # delimiter between corner crossings and other crossings
6050 if {[llength $badcolors] >= $ncolors - 1} break
6051 set origbad $badcolors
6053 if {[info exists colormap($x)]
6054 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6055 lappend badcolors $colormap($x)
6058 if {[llength $badcolors] >= $ncolors} {
6059 set badcolors $origbad
6061 set origbad $badcolors
6062 if {[llength $badcolors] < $ncolors - 1} {
6063 foreach child $kids {
6064 if {[info exists colormap($child)]
6065 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6066 lappend badcolors $colormap($child)
6068 foreach p $parents($curview,$child) {
6069 if {[info exists colormap($p)]
6070 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6071 lappend badcolors $colormap($p)
6075 if {[llength $badcolors] >= $ncolors} {
6076 set badcolors $origbad
6079 for {set i 0} {$i <= $ncolors} {incr i} {
6080 set c [lindex $colors $nextcolor]
6081 if {[incr nextcolor] >= $ncolors} {
6084 if {[lsearch -exact $badcolors $c]} break
6086 set colormap($id) $c
6089 proc bindline {t id} {
6092 $canv bind $t <Enter> "lineenter %x %y $id"
6093 $canv bind $t <Motion> "linemotion %x %y $id"
6094 $canv bind $t <Leave> "lineleave $id"
6095 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6098 proc drawtags {id x xt y1} {
6099 global idtags idheads idotherrefs mainhead
6100 global linespc lthickness
6101 global canv rowtextx curview fgcolor bgcolor ctxbut
6106 if {[info exists idtags($id)]} {
6107 set marks $idtags($id)
6108 set ntags [llength $marks]
6110 if {[info exists idheads($id)]} {
6111 set marks [concat $marks $idheads($id)]
6112 set nheads [llength $idheads($id)]
6114 if {[info exists idotherrefs($id)]} {
6115 set marks [concat $marks $idotherrefs($id)]
6121 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6122 set yt [expr {$y1 - 0.5 * $linespc}]
6123 set yb [expr {$yt + $linespc - 1}]
6127 foreach tag $marks {
6129 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6130 set wid [font measure mainfontbold $tag]
6132 set wid [font measure mainfont $tag]
6136 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6138 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6139 -width $lthickness -fill black -tags tag.$id]
6141 foreach tag $marks x $xvals wid $wvals {
6142 set xl [expr {$x + $delta}]
6143 set xr [expr {$x + $delta + $wid + $lthickness}]
6145 if {[incr ntags -1] >= 0} {
6147 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6148 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6149 -width 1 -outline black -fill yellow -tags tag.$id]
6150 $canv bind $t <1> [list showtag $tag 1]
6151 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6153 # draw a head or other ref
6154 if {[incr nheads -1] >= 0} {
6156 if {$tag eq $mainhead} {
6157 set font mainfontbold
6162 set xl [expr {$xl - $delta/2}]
6163 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6164 -width 1 -outline black -fill $col -tags tag.$id
6165 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6166 set rwid [font measure mainfont $remoteprefix]
6167 set xi [expr {$x + 1}]
6168 set yti [expr {$yt + 1}]
6169 set xri [expr {$x + $rwid}]
6170 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6171 -width 0 -fill "#ffddaa" -tags tag.$id
6174 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6175 -font $font -tags [list tag.$id text]]
6177 $canv bind $t <1> [list showtag $tag 1]
6178 } elseif {$nheads >= 0} {
6179 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6185 proc xcoord {i level ln} {
6186 global canvx0 xspc1 xspc2
6188 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6189 if {$i > 0 && $i == $level} {
6190 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6191 } elseif {$i > $level} {
6192 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6197 proc show_status {msg} {
6201 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6202 -tags text -fill $fgcolor
6205 # Don't change the text pane cursor if it is currently the hand cursor,
6206 # showing that we are over a sha1 ID link.
6207 proc settextcursor {c} {
6208 global ctext curtextcursor
6210 if {[$ctext cget -cursor] == $curtextcursor} {
6211 $ctext config -cursor $c
6213 set curtextcursor $c
6216 proc nowbusy {what {name {}}} {
6217 global isbusy busyname statusw
6219 if {[array names isbusy] eq {}} {
6220 . config -cursor watch
6224 set busyname($what) $name
6226 $statusw conf -text $name
6230 proc notbusy {what} {
6231 global isbusy maincursor textcursor busyname statusw
6235 if {$busyname($what) ne {} &&
6236 [$statusw cget -text] eq $busyname($what)} {
6237 $statusw conf -text {}
6240 if {[array names isbusy] eq {}} {
6241 . config -cursor $maincursor
6242 settextcursor $textcursor
6246 proc findmatches {f} {
6247 global findtype findstring
6248 if {$findtype == [mc "Regexp"]} {
6249 set matches [regexp -indices -all -inline $findstring $f]
6252 if {$findtype == [mc "IgnCase"]} {
6253 set f [string tolower $f]
6254 set fs [string tolower $fs]
6258 set l [string length $fs]
6259 while {[set j [string first $fs $f $i]] >= 0} {
6260 lappend matches [list $j [expr {$j+$l-1}]]
6261 set i [expr {$j + $l}]
6267 proc dofind {{dirn 1} {wrap 1}} {
6268 global findstring findstartline findcurline selectedline numcommits
6269 global gdttype filehighlight fh_serial find_dirn findallowwrap
6271 if {[info exists find_dirn]} {
6272 if {$find_dirn == $dirn} return
6276 if {$findstring eq {} || $numcommits == 0} return
6277 if {$selectedline eq {}} {
6278 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6280 set findstartline $selectedline
6282 set findcurline $findstartline
6283 nowbusy finding [mc "Searching"]
6284 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6285 after cancel do_file_hl $fh_serial
6286 do_file_hl $fh_serial
6289 set findallowwrap $wrap
6293 proc stopfinding {} {
6294 global find_dirn findcurline fprogcoord
6296 if {[info exists find_dirn]} {
6307 global commitdata commitinfo numcommits findpattern findloc
6308 global findstartline findcurline findallowwrap
6309 global find_dirn gdttype fhighlights fprogcoord
6310 global curview varcorder vrownum varccommits vrowmod
6312 if {![info exists find_dirn]} {
6315 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6318 if {$find_dirn > 0} {
6320 if {$l >= $numcommits} {
6323 if {$l <= $findstartline} {
6324 set lim [expr {$findstartline + 1}]
6327 set moretodo $findallowwrap
6334 if {$l >= $findstartline} {
6335 set lim [expr {$findstartline - 1}]
6338 set moretodo $findallowwrap
6341 set n [expr {($lim - $l) * $find_dirn}]
6346 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6347 update_arcrows $curview
6351 set ai [bsearch $vrownum($curview) $l]
6352 set a [lindex $varcorder($curview) $ai]
6353 set arow [lindex $vrownum($curview) $ai]
6354 set ids [lindex $varccommits($curview,$a)]
6355 set arowend [expr {$arow + [llength $ids]}]
6356 if {$gdttype eq [mc "containing:"]} {
6357 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6358 if {$l < $arow || $l >= $arowend} {
6360 set a [lindex $varcorder($curview) $ai]
6361 set arow [lindex $vrownum($curview) $ai]
6362 set ids [lindex $varccommits($curview,$a)]
6363 set arowend [expr {$arow + [llength $ids]}]
6365 set id [lindex $ids [expr {$l - $arow}]]
6366 # shouldn't happen unless git log doesn't give all the commits...
6367 if {![info exists commitdata($id)] ||
6368 ![doesmatch $commitdata($id)]} {
6371 if {![info exists commitinfo($id)]} {
6374 set info $commitinfo($id)
6375 foreach f $info ty $fldtypes {
6376 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6385 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6386 if {$l < $arow || $l >= $arowend} {
6388 set a [lindex $varcorder($curview) $ai]
6389 set arow [lindex $vrownum($curview) $ai]
6390 set ids [lindex $varccommits($curview,$a)]
6391 set arowend [expr {$arow + [llength $ids]}]
6393 set id [lindex $ids [expr {$l - $arow}]]
6394 if {![info exists fhighlights($id)]} {
6395 # this sets fhighlights($id) to -1
6396 askfilehighlight $l $id
6398 if {$fhighlights($id) > 0} {
6402 if {$fhighlights($id) < 0} {
6405 set findcurline [expr {$l - $find_dirn}]
6410 if {$found || ($domore && !$moretodo)} {
6426 set findcurline [expr {$l - $find_dirn}]
6428 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6432 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6437 proc findselectline {l} {
6438 global findloc commentend ctext findcurline markingmatches gdttype
6440 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6443 if {$markingmatches &&
6444 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6445 # highlight the matches in the comments
6446 set f [$ctext get 1.0 $commentend]
6447 set matches [findmatches $f]
6448 foreach match $matches {
6449 set start [lindex $match 0]
6450 set end [expr {[lindex $match 1] + 1}]
6451 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6457 # mark the bits of a headline or author that match a find string
6458 proc markmatches {canv l str tag matches font row} {
6461 set bbox [$canv bbox $tag]
6462 set x0 [lindex $bbox 0]
6463 set y0 [lindex $bbox 1]
6464 set y1 [lindex $bbox 3]
6465 foreach match $matches {
6466 set start [lindex $match 0]
6467 set end [lindex $match 1]
6468 if {$start > $end} continue
6469 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6470 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6471 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6472 [expr {$x0+$xlen+2}] $y1 \
6473 -outline {} -tags [list match$l matches] -fill yellow]
6475 if {$row == $selectedline} {
6476 $canv raise $t secsel
6481 proc unmarkmatches {} {
6482 global markingmatches
6484 allcanvs delete matches
6485 set markingmatches 0
6489 proc selcanvline {w x y} {
6490 global canv canvy0 ctext linespc
6492 set ymax [lindex [$canv cget -scrollregion] 3]
6493 if {$ymax == {}} return
6494 set yfrac [lindex [$canv yview] 0]
6495 set y [expr {$y + $yfrac * $ymax}]
6496 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6501 set xmax [lindex [$canv cget -scrollregion] 2]
6502 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6503 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6509 proc commit_descriptor {p} {
6511 if {![info exists commitinfo($p)]} {
6515 if {[llength $commitinfo($p)] > 1} {
6516 set l [lindex $commitinfo($p) 0]
6521 # append some text to the ctext widget, and make any SHA1 ID
6522 # that we know about be a clickable link.
6523 proc appendwithlinks {text tags} {
6524 global ctext linknum curview
6526 set start [$ctext index "end - 1c"]
6527 $ctext insert end $text $tags
6528 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6532 set linkid [string range $text $s $e]
6534 $ctext tag delete link$linknum
6535 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6536 setlink $linkid link$linknum
6541 proc setlink {id lk} {
6542 global curview ctext pendinglinks
6545 if {[string length $id] < 40} {
6546 set matches [longid $id]
6547 if {[llength $matches] > 0} {
6548 if {[llength $matches] > 1} return
6550 set id [lindex $matches 0]
6553 set known [commitinview $id $curview]
6556 $ctext tag conf $lk -foreground blue -underline 1
6557 $ctext tag bind $lk <1> [list selbyid $id]
6558 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6559 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6561 lappend pendinglinks($id) $lk
6562 interestedin $id {makelink %P}
6566 proc appendshortlink {id {pre {}} {post {}}} {
6567 global ctext linknum
6569 $ctext insert end $pre
6570 $ctext tag delete link$linknum
6571 $ctext insert end [string range $id 0 7] link$linknum
6572 $ctext insert end $post
6573 setlink $id link$linknum
6577 proc makelink {id} {
6580 if {![info exists pendinglinks($id)]} return
6581 foreach lk $pendinglinks($id) {
6584 unset pendinglinks($id)
6587 proc linkcursor {w inc} {
6588 global linkentercount curtextcursor
6590 if {[incr linkentercount $inc] > 0} {
6591 $w configure -cursor hand2
6593 $w configure -cursor $curtextcursor
6594 if {$linkentercount < 0} {
6595 set linkentercount 0
6600 proc viewnextline {dir} {
6604 set ymax [lindex [$canv cget -scrollregion] 3]
6605 set wnow [$canv yview]
6606 set wtop [expr {[lindex $wnow 0] * $ymax}]
6607 set newtop [expr {$wtop + $dir * $linespc}]
6610 } elseif {$newtop > $ymax} {
6613 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6616 # add a list of tag or branch names at position pos
6617 # returns the number of names inserted
6618 proc appendrefs {pos ids var} {
6619 global ctext linknum curview $var maxrefs
6621 if {[catch {$ctext index $pos}]} {
6624 $ctext conf -state normal
6625 $ctext delete $pos "$pos lineend"
6628 foreach tag [set $var\($id\)] {
6629 lappend tags [list $tag $id]
6632 if {[llength $tags] > $maxrefs} {
6633 $ctext insert $pos "[mc "many"] ([llength $tags])"
6635 set tags [lsort -index 0 -decreasing $tags]
6638 set id [lindex $ti 1]
6641 $ctext tag delete $lk
6642 $ctext insert $pos $sep
6643 $ctext insert $pos [lindex $ti 0] $lk
6648 $ctext conf -state disabled
6649 return [llength $tags]
6652 # called when we have finished computing the nearby tags
6653 proc dispneartags {delay} {
6654 global selectedline currentid showneartags tagphase
6656 if {$selectedline eq {} || !$showneartags} return
6657 after cancel dispnexttag
6659 after 200 dispnexttag
6662 after idle dispnexttag
6667 proc dispnexttag {} {
6668 global selectedline currentid showneartags tagphase ctext
6670 if {$selectedline eq {} || !$showneartags} return
6671 switch -- $tagphase {
6673 set dtags [desctags $currentid]
6675 appendrefs precedes $dtags idtags
6679 set atags [anctags $currentid]
6681 appendrefs follows $atags idtags
6685 set dheads [descheads $currentid]
6686 if {$dheads ne {}} {
6687 if {[appendrefs branch $dheads idheads] > 1
6688 && [$ctext get "branch -3c"] eq "h"} {
6689 # turn "Branch" into "Branches"
6690 $ctext conf -state normal
6691 $ctext insert "branch -2c" "es"
6692 $ctext conf -state disabled
6697 if {[incr tagphase] <= 2} {
6698 after idle dispnexttag
6702 proc make_secsel {id} {
6703 global linehtag linentag linedtag canv canv2 canv3
6705 if {![info exists linehtag($id)]} return
6707 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6708 -tags secsel -fill [$canv cget -selectbackground]]
6710 $canv2 delete secsel
6711 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6712 -tags secsel -fill [$canv2 cget -selectbackground]]
6714 $canv3 delete secsel
6715 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6716 -tags secsel -fill [$canv3 cget -selectbackground]]
6720 proc make_idmark {id} {
6721 global linehtag canv fgcolor
6723 if {![info exists linehtag($id)]} return
6725 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6726 -tags markid -outline $fgcolor]
6730 proc selectline {l isnew {desired_loc {}}} {
6731 global canv ctext commitinfo selectedline
6732 global canvy0 linespc parents children curview
6733 global currentid sha1entry
6734 global commentend idtags linknum
6735 global mergemax numcommits pending_select
6736 global cmitmode showneartags allcommits
6737 global targetrow targetid lastscrollrows
6738 global autoselect jump_to_here
6740 catch {unset pending_select}
6745 if {$l < 0 || $l >= $numcommits} return
6746 set id [commitonrow $l]
6751 if {$lastscrollrows < $numcommits} {
6755 set y [expr {$canvy0 + $l * $linespc}]
6756 set ymax [lindex [$canv cget -scrollregion] 3]
6757 set ytop [expr {$y - $linespc - 1}]
6758 set ybot [expr {$y + $linespc + 1}]
6759 set wnow [$canv yview]
6760 set wtop [expr {[lindex $wnow 0] * $ymax}]
6761 set wbot [expr {[lindex $wnow 1] * $ymax}]
6762 set wh [expr {$wbot - $wtop}]
6764 if {$ytop < $wtop} {
6765 if {$ybot < $wtop} {
6766 set newtop [expr {$y - $wh / 2.0}]
6769 if {$newtop > $wtop - $linespc} {
6770 set newtop [expr {$wtop - $linespc}]
6773 } elseif {$ybot > $wbot} {
6774 if {$ytop > $wbot} {
6775 set newtop [expr {$y - $wh / 2.0}]
6777 set newtop [expr {$ybot - $wh}]
6778 if {$newtop < $wtop + $linespc} {
6779 set newtop [expr {$wtop + $linespc}]
6783 if {$newtop != $wtop} {
6787 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6794 addtohistory [list selbyid $id]
6797 $sha1entry delete 0 end
6798 $sha1entry insert 0 $id
6800 $sha1entry selection from 0
6801 $sha1entry selection to end
6805 $ctext conf -state normal
6808 if {![info exists commitinfo($id)]} {
6811 set info $commitinfo($id)
6812 set date [formatdate [lindex $info 2]]
6813 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6814 set date [formatdate [lindex $info 4]]
6815 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6816 if {[info exists idtags($id)]} {
6817 $ctext insert end [mc "Tags:"]
6818 foreach tag $idtags($id) {
6819 $ctext insert end " $tag"
6821 $ctext insert end "\n"
6825 set olds $parents($curview,$id)
6826 if {[llength $olds] > 1} {
6829 if {$np >= $mergemax} {
6834 $ctext insert end "[mc "Parent"]: " $tag
6835 appendwithlinks [commit_descriptor $p] {}
6840 append headers "[mc "Parent"]: [commit_descriptor $p]"
6844 foreach c $children($curview,$id) {
6845 append headers "[mc "Child"]: [commit_descriptor $c]"
6848 # make anything that looks like a SHA1 ID be a clickable link
6849 appendwithlinks $headers {}
6850 if {$showneartags} {
6851 if {![info exists allcommits]} {
6854 $ctext insert end "[mc "Branch"]: "
6855 $ctext mark set branch "end -1c"
6856 $ctext mark gravity branch left
6857 $ctext insert end "\n[mc "Follows"]: "
6858 $ctext mark set follows "end -1c"
6859 $ctext mark gravity follows left
6860 $ctext insert end "\n[mc "Precedes"]: "
6861 $ctext mark set precedes "end -1c"
6862 $ctext mark gravity precedes left
6863 $ctext insert end "\n"
6866 $ctext insert end "\n"
6867 set comment [lindex $info 5]
6868 if {[string first "\r" $comment] >= 0} {
6869 set comment [string map {"\r" "\n "} $comment]
6871 appendwithlinks $comment {comment}
6873 $ctext tag remove found 1.0 end
6874 $ctext conf -state disabled
6875 set commentend [$ctext index "end - 1c"]
6877 set jump_to_here $desired_loc
6878 init_flist [mc "Comments"]
6879 if {$cmitmode eq "tree"} {
6881 } elseif {[llength $olds] <= 1} {
6888 proc selfirstline {} {
6893 proc sellastline {} {
6896 set l [expr {$numcommits - 1}]
6900 proc selnextline {dir} {
6903 if {$selectedline eq {}} return
6904 set l [expr {$selectedline + $dir}]
6909 proc selnextpage {dir} {
6910 global canv linespc selectedline numcommits
6912 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6916 allcanvs yview scroll [expr {$dir * $lpp}] units
6918 if {$selectedline eq {}} return
6919 set l [expr {$selectedline + $dir * $lpp}]
6922 } elseif {$l >= $numcommits} {
6923 set l [expr $numcommits - 1]
6929 proc unselectline {} {
6930 global selectedline currentid
6933 catch {unset currentid}
6934 allcanvs delete secsel
6938 proc reselectline {} {
6941 if {$selectedline ne {}} {
6942 selectline $selectedline 0
6946 proc addtohistory {cmd} {
6947 global history historyindex curview
6949 set elt [list $curview $cmd]
6950 if {$historyindex > 0
6951 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6955 if {$historyindex < [llength $history]} {
6956 set history [lreplace $history $historyindex end $elt]
6958 lappend history $elt
6961 if {$historyindex > 1} {
6962 .tf.bar.leftbut conf -state normal
6964 .tf.bar.leftbut conf -state disabled
6966 .tf.bar.rightbut conf -state disabled
6972 set view [lindex $elt 0]
6973 set cmd [lindex $elt 1]
6974 if {$curview != $view} {
6981 global history historyindex
6984 if {$historyindex > 1} {
6985 incr historyindex -1
6986 godo [lindex $history [expr {$historyindex - 1}]]
6987 .tf.bar.rightbut conf -state normal
6989 if {$historyindex <= 1} {
6990 .tf.bar.leftbut conf -state disabled
6995 global history historyindex
6998 if {$historyindex < [llength $history]} {
6999 set cmd [lindex $history $historyindex]
7002 .tf.bar.leftbut conf -state normal
7004 if {$historyindex >= [llength $history]} {
7005 .tf.bar.rightbut conf -state disabled
7010 global treefilelist treeidlist diffids diffmergeid treepending
7011 global nullid nullid2
7014 catch {unset diffmergeid}
7015 if {![info exists treefilelist($id)]} {
7016 if {![info exists treepending]} {
7017 if {$id eq $nullid} {
7018 set cmd [list | git ls-files]
7019 } elseif {$id eq $nullid2} {
7020 set cmd [list | git ls-files --stage -t]
7022 set cmd [list | git ls-tree -r $id]
7024 if {[catch {set gtf [open $cmd r]}]} {
7028 set treefilelist($id) {}
7029 set treeidlist($id) {}
7030 fconfigure $gtf -blocking 0 -encoding binary
7031 filerun $gtf [list gettreeline $gtf $id]
7038 proc gettreeline {gtf id} {
7039 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7042 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7043 if {$diffids eq $nullid} {
7046 set i [string first "\t" $line]
7047 if {$i < 0} continue
7048 set fname [string range $line [expr {$i+1}] end]
7049 set line [string range $line 0 [expr {$i-1}]]
7050 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7051 set sha1 [lindex $line 2]
7052 lappend treeidlist($id) $sha1
7054 if {[string index $fname 0] eq "\""} {
7055 set fname [lindex $fname 0]
7057 set fname [encoding convertfrom $fname]
7058 lappend treefilelist($id) $fname
7061 return [expr {$nl >= 1000? 2: 1}]
7065 if {$cmitmode ne "tree"} {
7066 if {![info exists diffmergeid]} {
7067 gettreediffs $diffids
7069 } elseif {$id ne $diffids} {
7078 global treefilelist treeidlist diffids nullid nullid2
7079 global ctext_file_names ctext_file_lines
7080 global ctext commentend
7082 set i [lsearch -exact $treefilelist($diffids) $f]
7084 puts "oops, $f not in list for id $diffids"
7087 if {$diffids eq $nullid} {
7088 if {[catch {set bf [open $f r]} err]} {
7089 puts "oops, can't read $f: $err"
7093 set blob [lindex $treeidlist($diffids) $i]
7094 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7095 puts "oops, error reading blob $blob: $err"
7099 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7100 filerun $bf [list getblobline $bf $diffids]
7101 $ctext config -state normal
7102 clear_ctext $commentend
7103 lappend ctext_file_names $f
7104 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7105 $ctext insert end "\n"
7106 $ctext insert end "$f\n" filesep
7107 $ctext config -state disabled
7108 $ctext yview $commentend
7112 proc getblobline {bf id} {
7113 global diffids cmitmode ctext
7115 if {$id ne $diffids || $cmitmode ne "tree"} {
7119 $ctext config -state normal
7121 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7122 $ctext insert end "$line\n"
7125 global jump_to_here ctext_file_names commentend
7127 # delete last newline
7128 $ctext delete "end - 2c" "end - 1c"
7130 if {$jump_to_here ne {} &&
7131 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7132 set lnum [expr {[lindex $jump_to_here 1] +
7133 [lindex [split $commentend .] 0]}]
7134 mark_ctext_line $lnum
7138 $ctext config -state disabled
7139 return [expr {$nl >= 1000? 2: 1}]
7142 proc mark_ctext_line {lnum} {
7143 global ctext markbgcolor
7145 $ctext tag delete omark
7146 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7147 $ctext tag conf omark -background $markbgcolor
7151 proc mergediff {id} {
7153 global diffids treediffs
7154 global parents curview
7158 set treediffs($id) {}
7159 set np [llength $parents($curview,$id)]
7164 proc startdiff {ids} {
7165 global treediffs diffids treepending diffmergeid nullid nullid2
7169 catch {unset diffmergeid}
7170 if {![info exists treediffs($ids)] ||
7171 [lsearch -exact $ids $nullid] >= 0 ||
7172 [lsearch -exact $ids $nullid2] >= 0} {
7173 if {![info exists treepending]} {
7181 proc path_filter {filter name} {
7183 set l [string length $p]
7184 if {[string index $p end] eq "/"} {
7185 if {[string compare -length $l $p $name] == 0} {
7189 if {[string compare -length $l $p $name] == 0 &&
7190 ([string length $name] == $l ||
7191 [string index $name $l] eq "/")} {
7199 proc addtocflist {ids} {
7202 add_flist $treediffs($ids)
7206 proc diffcmd {ids flags} {
7207 global nullid nullid2
7209 set i [lsearch -exact $ids $nullid]
7210 set j [lsearch -exact $ids $nullid2]
7212 if {[llength $ids] > 1 && $j < 0} {
7213 # comparing working directory with some specific revision
7214 set cmd [concat | git diff-index $flags]
7216 lappend cmd -R [lindex $ids 1]
7218 lappend cmd [lindex $ids 0]
7221 # comparing working directory with index
7222 set cmd [concat | git diff-files $flags]
7227 } elseif {$j >= 0} {
7228 set cmd [concat | git diff-index --cached $flags]
7229 if {[llength $ids] > 1} {
7230 # comparing index with specific revision
7232 lappend cmd -R [lindex $ids 1]
7234 lappend cmd [lindex $ids 0]
7237 # comparing index with HEAD
7241 set cmd [concat | git diff-tree -r $flags $ids]
7246 proc gettreediffs {ids} {
7247 global treediff treepending
7249 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7251 set treepending $ids
7253 fconfigure $gdtf -blocking 0 -encoding binary
7254 filerun $gdtf [list gettreediffline $gdtf $ids]
7257 proc gettreediffline {gdtf ids} {
7258 global treediff treediffs treepending diffids diffmergeid
7259 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7264 if {$perfile_attrs} {
7265 # cache_gitattr is slow, and even slower on win32 where we
7266 # have to invoke it for only about 30 paths at a time
7268 if {[tk windowingsystem] == "win32"} {
7272 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7273 set i [string first "\t" $line]
7275 set file [string range $line [expr {$i+1}] end]
7276 if {[string index $file 0] eq "\""} {
7277 set file [lindex $file 0]
7279 set file [encoding convertfrom $file]
7280 if {$file ne [lindex $treediff end]} {
7281 lappend treediff $file
7282 lappend sublist $file
7286 if {$perfile_attrs} {
7287 cache_gitattr encoding $sublist
7290 return [expr {$nr >= $max? 2: 1}]
7293 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7295 foreach f $treediff {
7296 if {[path_filter $vfilelimit($curview) $f]} {
7300 set treediffs($ids) $flist
7302 set treediffs($ids) $treediff
7305 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7307 } elseif {$ids != $diffids} {
7308 if {![info exists diffmergeid]} {
7309 gettreediffs $diffids
7317 # empty string or positive integer
7318 proc diffcontextvalidate {v} {
7319 return [regexp {^(|[1-9][0-9]*)$} $v]
7322 proc diffcontextchange {n1 n2 op} {
7323 global diffcontextstring diffcontext
7325 if {[string is integer -strict $diffcontextstring]} {
7326 if {$diffcontextstring >= 0} {
7327 set diffcontext $diffcontextstring
7333 proc changeignorespace {} {
7337 proc getblobdiffs {ids} {
7338 global blobdifffd diffids env
7339 global diffinhdr treediffs
7342 global limitdiffs vfilelimit curview
7343 global diffencoding targetline diffnparents
7347 if {[package vcompare $git_version "1.6.1"] >= 0} {
7348 set textconv "--textconv"
7351 if {[package vcompare $git_version "1.6.6"] >= 0} {
7352 set submodule "--submodule"
7354 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
7358 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7359 set cmd [concat $cmd -- $vfilelimit($curview)]
7361 if {[catch {set bdf [open $cmd r]} err]} {
7362 error_popup [mc "Error getting diffs: %s" $err]
7368 set diffencoding [get_path_encoding {}]
7369 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7370 set blobdifffd($ids) $bdf
7371 filerun $bdf [list getblobdiffline $bdf $diffids]
7374 proc setinlist {var i val} {
7377 while {[llength [set $var]] < $i} {
7380 if {[llength [set $var]] == $i} {
7387 proc makediffhdr {fname ids} {
7388 global ctext curdiffstart treediffs diffencoding
7389 global ctext_file_names jump_to_here targetline diffline
7391 set fname [encoding convertfrom $fname]
7392 set diffencoding [get_path_encoding $fname]
7393 set i [lsearch -exact $treediffs($ids) $fname]
7395 setinlist difffilestart $i $curdiffstart
7397 lset ctext_file_names end $fname
7398 set l [expr {(78 - [string length $fname]) / 2}]
7399 set pad [string range "----------------------------------------" 1 $l]
7400 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7402 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7403 set targetline [lindex $jump_to_here 1]
7408 proc getblobdiffline {bdf ids} {
7409 global diffids blobdifffd ctext curdiffstart
7410 global diffnexthead diffnextnote difffilestart
7411 global ctext_file_names ctext_file_lines
7412 global diffinhdr treediffs mergemax diffnparents
7413 global diffencoding jump_to_here targetline diffline
7416 $ctext conf -state normal
7417 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7418 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7422 if {![string compare -length 5 "diff " $line]} {
7423 if {![regexp {^diff (--cc|--git) } $line m type]} {
7424 set line [encoding convertfrom $line]
7425 $ctext insert end "$line\n" hunksep
7428 # start of a new file
7430 $ctext insert end "\n"
7431 set curdiffstart [$ctext index "end - 1c"]
7432 lappend ctext_file_names ""
7433 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7434 $ctext insert end "\n" filesep
7436 if {$type eq "--cc"} {
7437 # start of a new file in a merge diff
7438 set fname [string range $line 10 end]
7439 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7440 lappend treediffs($ids) $fname
7441 add_flist [list $fname]
7445 set line [string range $line 11 end]
7446 # If the name hasn't changed the length will be odd,
7447 # the middle char will be a space, and the two bits either
7448 # side will be a/name and b/name, or "a/name" and "b/name".
7449 # If the name has changed we'll get "rename from" and
7450 # "rename to" or "copy from" and "copy to" lines following
7451 # this, and we'll use them to get the filenames.
7452 # This complexity is necessary because spaces in the
7453 # filename(s) don't get escaped.
7454 set l [string length $line]
7455 set i [expr {$l / 2}]
7456 if {!(($l & 1) && [string index $line $i] eq " " &&
7457 [string range $line 2 [expr {$i - 1}]] eq \
7458 [string range $line [expr {$i + 3}] end])} {
7461 # unescape if quoted and chop off the a/ from the front
7462 if {[string index $line 0] eq "\""} {
7463 set fname [string range [lindex $line 0] 2 end]
7465 set fname [string range $line 2 [expr {$i - 1}]]
7468 makediffhdr $fname $ids
7470 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7471 set fname [encoding convertfrom [string range $line 16 end]]
7472 $ctext insert end "\n"
7473 set curdiffstart [$ctext index "end - 1c"]
7474 lappend ctext_file_names $fname
7475 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7476 $ctext insert end "$line\n" filesep
7477 set i [lsearch -exact $treediffs($ids) $fname]
7479 setinlist difffilestart $i $curdiffstart
7482 } elseif {![string compare -length 2 "@@" $line]} {
7483 regexp {^@@+} $line ats
7484 set line [encoding convertfrom $diffencoding $line]
7485 $ctext insert end "$line\n" hunksep
7486 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7489 set diffnparents [expr {[string length $ats] - 1}]
7492 } elseif {![string compare -length 10 "Submodule " $line]} {
7493 # start of a new submodule
7494 if {[string compare [$ctext get "end - 4c" end] "\n \n\n"]} {
7495 $ctext insert end "\n"; # Add newline after commit message
7497 set curdiffstart [$ctext index "end - 1c"]
7498 lappend ctext_file_names ""
7499 set fname [string range $line 10 [expr [string last " " $line] - 1]]
7500 lappend ctext_file_lines $fname
7501 makediffhdr $fname $ids
7502 $ctext insert end "\n$line\n" filesep
7503 } elseif {![string compare -length 3 " >" $line]} {
7504 $ctext insert end "$line\n" dresult
7505 } elseif {![string compare -length 3 " <" $line]} {
7506 $ctext insert end "$line\n" d0
7507 } elseif {$diffinhdr} {
7508 if {![string compare -length 12 "rename from " $line]} {
7509 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7510 if {[string index $fname 0] eq "\""} {
7511 set fname [lindex $fname 0]
7513 set fname [encoding convertfrom $fname]
7514 set i [lsearch -exact $treediffs($ids) $fname]
7516 setinlist difffilestart $i $curdiffstart
7518 } elseif {![string compare -length 10 $line "rename to "] ||
7519 ![string compare -length 8 $line "copy to "]} {
7520 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7521 if {[string index $fname 0] eq "\""} {
7522 set fname [lindex $fname 0]
7524 makediffhdr $fname $ids
7525 } elseif {[string compare -length 3 $line "---"] == 0} {
7528 } elseif {[string compare -length 3 $line "+++"] == 0} {
7532 $ctext insert end "$line\n" filesep
7535 set line [string map {\x1A ^Z} \
7536 [encoding convertfrom $diffencoding $line]]
7537 # parse the prefix - one ' ', '-' or '+' for each parent
7538 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7539 set tag [expr {$diffnparents > 1? "m": "d"}]
7540 if {[string trim $prefix " -+"] eq {}} {
7541 # prefix only has " ", "-" and "+" in it: normal diff line
7542 set num [string first "-" $prefix]
7544 # removed line, first parent with line is $num
7545 if {$num >= $mergemax} {
7548 $ctext insert end "$line\n" $tag$num
7551 if {[string first "+" $prefix] >= 0} {
7553 lappend tags ${tag}result
7554 if {$diffnparents > 1} {
7555 set num [string first " " $prefix]
7557 if {$num >= $mergemax} {
7564 if {$targetline ne {}} {
7565 if {$diffline == $targetline} {
7566 set seehere [$ctext index "end - 1 chars"]
7572 $ctext insert end "$line\n" $tags
7575 # "\ No newline at end of file",
7576 # or something else we don't recognize
7577 $ctext insert end "$line\n" hunksep
7581 if {[info exists seehere]} {
7582 mark_ctext_line [lindex [split $seehere .] 0]
7584 $ctext conf -state disabled
7589 return [expr {$nr >= 1000? 2: 1}]
7592 proc changediffdisp {} {
7593 global ctext diffelide
7595 $ctext tag conf d0 -elide [lindex $diffelide 0]
7596 $ctext tag conf dresult -elide [lindex $diffelide 1]
7599 proc highlightfile {loc cline} {
7600 global ctext cflist cflist_top
7603 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7604 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7605 $cflist see $cline.0
7606 set cflist_top $cline
7610 global difffilestart ctext cmitmode
7612 if {$cmitmode eq "tree"} return
7615 set here [$ctext index @0,0]
7616 foreach loc $difffilestart {
7617 if {[$ctext compare $loc >= $here]} {
7618 highlightfile $prev $prevline
7624 highlightfile $prev $prevline
7628 global difffilestart ctext cmitmode
7630 if {$cmitmode eq "tree"} return
7631 set here [$ctext index @0,0]
7633 foreach loc $difffilestart {
7635 if {[$ctext compare $loc > $here]} {
7636 highlightfile $loc $line
7642 proc clear_ctext {{first 1.0}} {
7643 global ctext smarktop smarkbot
7644 global ctext_file_names ctext_file_lines
7647 set l [lindex [split $first .] 0]
7648 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7651 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7654 $ctext delete $first end
7655 if {$first eq "1.0"} {
7656 catch {unset pendinglinks}
7658 set ctext_file_names {}
7659 set ctext_file_lines {}
7662 proc settabs {{firstab {}}} {
7663 global firsttabstop tabstop ctext have_tk85
7665 if {$firstab ne {} && $have_tk85} {
7666 set firsttabstop $firstab
7668 set w [font measure textfont "0"]
7669 if {$firsttabstop != 0} {
7670 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7671 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7672 } elseif {$have_tk85 || $tabstop != 8} {
7673 $ctext conf -tabs [expr {$tabstop * $w}]
7675 $ctext conf -tabs {}
7679 proc incrsearch {name ix op} {
7680 global ctext searchstring searchdirn
7682 $ctext tag remove found 1.0 end
7683 if {[catch {$ctext index anchor}]} {
7684 # no anchor set, use start of selection, or of visible area
7685 set sel [$ctext tag ranges sel]
7687 $ctext mark set anchor [lindex $sel 0]
7688 } elseif {$searchdirn eq "-forwards"} {
7689 $ctext mark set anchor @0,0
7691 $ctext mark set anchor @0,[winfo height $ctext]
7694 if {$searchstring ne {}} {
7695 set here [$ctext search $searchdirn -- $searchstring anchor]
7704 global sstring ctext searchstring searchdirn
7707 $sstring icursor end
7708 set searchdirn -forwards
7709 if {$searchstring ne {}} {
7710 set sel [$ctext tag ranges sel]
7712 set start "[lindex $sel 0] + 1c"
7713 } elseif {[catch {set start [$ctext index anchor]}]} {
7716 set match [$ctext search -count mlen -- $searchstring $start]
7717 $ctext tag remove sel 1.0 end
7723 set mend "$match + $mlen c"
7724 $ctext tag add sel $match $mend
7725 $ctext mark unset anchor
7729 proc dosearchback {} {
7730 global sstring ctext searchstring searchdirn
7733 $sstring icursor end
7734 set searchdirn -backwards
7735 if {$searchstring ne {}} {
7736 set sel [$ctext tag ranges sel]
7738 set start [lindex $sel 0]
7739 } elseif {[catch {set start [$ctext index anchor]}]} {
7740 set start @0,[winfo height $ctext]
7742 set match [$ctext search -backwards -count ml -- $searchstring $start]
7743 $ctext tag remove sel 1.0 end
7749 set mend "$match + $ml c"
7750 $ctext tag add sel $match $mend
7751 $ctext mark unset anchor
7755 proc searchmark {first last} {
7756 global ctext searchstring
7760 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7761 if {$match eq {}} break
7762 set mend "$match + $mlen c"
7763 $ctext tag add found $match $mend
7767 proc searchmarkvisible {doall} {
7768 global ctext smarktop smarkbot
7770 set topline [lindex [split [$ctext index @0,0] .] 0]
7771 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7772 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7773 # no overlap with previous
7774 searchmark $topline $botline
7775 set smarktop $topline
7776 set smarkbot $botline
7778 if {$topline < $smarktop} {
7779 searchmark $topline [expr {$smarktop-1}]
7780 set smarktop $topline
7782 if {$botline > $smarkbot} {
7783 searchmark [expr {$smarkbot+1}] $botline
7784 set smarkbot $botline
7789 proc scrolltext {f0 f1} {
7792 .bleft.bottom.sb set $f0 $f1
7793 if {$searchstring ne {}} {
7799 global linespc charspc canvx0 canvy0
7800 global xspc1 xspc2 lthickness
7802 set linespc [font metrics mainfont -linespace]
7803 set charspc [font measure mainfont "m"]
7804 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7805 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7806 set lthickness [expr {int($linespc / 9) + 1}]
7807 set xspc1(0) $linespc
7815 set ymax [lindex [$canv cget -scrollregion] 3]
7816 if {$ymax eq {} || $ymax == 0} return
7817 set span [$canv yview]
7820 allcanvs yview moveto [lindex $span 0]
7822 if {$selectedline ne {}} {
7823 selectline $selectedline 0
7824 allcanvs yview moveto [lindex $span 0]
7828 proc parsefont {f n} {
7831 set fontattr($f,family) [lindex $n 0]
7833 if {$s eq {} || $s == 0} {
7836 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7838 set fontattr($f,size) $s
7839 set fontattr($f,weight) normal
7840 set fontattr($f,slant) roman
7841 foreach style [lrange $n 2 end] {
7844 "bold" {set fontattr($f,weight) $style}
7846 "italic" {set fontattr($f,slant) $style}
7851 proc fontflags {f {isbold 0}} {
7854 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7855 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7856 -slant $fontattr($f,slant)]
7862 set n [list $fontattr($f,family) $fontattr($f,size)]
7863 if {$fontattr($f,weight) eq "bold"} {
7866 if {$fontattr($f,slant) eq "italic"} {
7872 proc incrfont {inc} {
7873 global mainfont textfont ctext canv cflist showrefstop
7874 global stopped entries fontattr
7877 set s $fontattr(mainfont,size)
7882 set fontattr(mainfont,size) $s
7883 font config mainfont -size $s
7884 font config mainfontbold -size $s
7885 set mainfont [fontname mainfont]
7886 set s $fontattr(textfont,size)
7891 set fontattr(textfont,size) $s
7892 font config textfont -size $s
7893 font config textfontbold -size $s
7894 set textfont [fontname textfont]
7901 global sha1entry sha1string
7902 if {[string length $sha1string] == 40} {
7903 $sha1entry delete 0 end
7907 proc sha1change {n1 n2 op} {
7908 global sha1string currentid sha1but
7909 if {$sha1string == {}
7910 || ([info exists currentid] && $sha1string == $currentid)} {
7915 if {[$sha1but cget -state] == $state} return
7916 if {$state == "normal"} {
7917 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7919 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7923 proc gotocommit {} {
7924 global sha1string tagids headids curview varcid
7926 if {$sha1string == {}
7927 || ([info exists currentid] && $sha1string == $currentid)} return
7928 if {[info exists tagids($sha1string)]} {
7929 set id $tagids($sha1string)
7930 } elseif {[info exists headids($sha1string)]} {
7931 set id $headids($sha1string)
7933 set id [string tolower $sha1string]
7934 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7935 set matches [longid $id]
7936 if {$matches ne {}} {
7937 if {[llength $matches] > 1} {
7938 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7941 set id [lindex $matches 0]
7944 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
7945 error_popup [mc "Revision %s is not known" $sha1string]
7950 if {[commitinview $id $curview]} {
7951 selectline [rowofcommit $id] 1
7954 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7955 set msg [mc "SHA1 id %s is not known" $sha1string]
7957 set msg [mc "Revision %s is not in the current view" $sha1string]
7962 proc lineenter {x y id} {
7963 global hoverx hovery hoverid hovertimer
7964 global commitinfo canv
7966 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7970 if {[info exists hovertimer]} {
7971 after cancel $hovertimer
7973 set hovertimer [after 500 linehover]
7977 proc linemotion {x y id} {
7978 global hoverx hovery hoverid hovertimer
7980 if {[info exists hoverid] && $id == $hoverid} {
7983 if {[info exists hovertimer]} {
7984 after cancel $hovertimer
7986 set hovertimer [after 500 linehover]
7990 proc lineleave {id} {
7991 global hoverid hovertimer canv
7993 if {[info exists hoverid] && $id == $hoverid} {
7995 if {[info exists hovertimer]} {
7996 after cancel $hovertimer
8004 global hoverx hovery hoverid hovertimer
8005 global canv linespc lthickness
8008 set text [lindex $commitinfo($hoverid) 0]
8009 set ymax [lindex [$canv cget -scrollregion] 3]
8010 if {$ymax == {}} return
8011 set yfrac [lindex [$canv yview] 0]
8012 set x [expr {$hoverx + 2 * $linespc}]
8013 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8014 set x0 [expr {$x - 2 * $lthickness}]
8015 set y0 [expr {$y - 2 * $lthickness}]
8016 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8017 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8018 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8019 -fill \#ffff80 -outline black -width 1 -tags hover]
8021 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8026 proc clickisonarrow {id y} {
8029 set ranges [rowranges $id]
8030 set thresh [expr {2 * $lthickness + 6}]
8031 set n [expr {[llength $ranges] - 1}]
8032 for {set i 1} {$i < $n} {incr i} {
8033 set row [lindex $ranges $i]
8034 if {abs([yc $row] - $y) < $thresh} {
8041 proc arrowjump {id n y} {
8044 # 1 <-> 2, 3 <-> 4, etc...
8045 set n [expr {(($n - 1) ^ 1) + 1}]
8046 set row [lindex [rowranges $id] $n]
8048 set ymax [lindex [$canv cget -scrollregion] 3]
8049 if {$ymax eq {} || $ymax <= 0} return
8050 set view [$canv yview]
8051 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8052 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8056 allcanvs yview moveto $yfrac
8059 proc lineclick {x y id isnew} {
8060 global ctext commitinfo children canv thickerline curview
8062 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8067 # draw this line thicker than normal
8071 set ymax [lindex [$canv cget -scrollregion] 3]
8072 if {$ymax eq {}} return
8073 set yfrac [lindex [$canv yview] 0]
8074 set y [expr {$y + $yfrac * $ymax}]
8076 set dirn [clickisonarrow $id $y]
8078 arrowjump $id $dirn $y
8083 addtohistory [list lineclick $x $y $id 0]
8085 # fill the details pane with info about this line
8086 $ctext conf -state normal
8089 $ctext insert end "[mc "Parent"]:\t"
8090 $ctext insert end $id link0
8092 set info $commitinfo($id)
8093 $ctext insert end "\n\t[lindex $info 0]\n"
8094 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8095 set date [formatdate [lindex $info 2]]
8096 $ctext insert end "\t[mc "Date"]:\t$date\n"
8097 set kids $children($curview,$id)
8099 $ctext insert end "\n[mc "Children"]:"
8101 foreach child $kids {
8103 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8104 set info $commitinfo($child)
8105 $ctext insert end "\n\t"
8106 $ctext insert end $child link$i
8107 setlink $child link$i
8108 $ctext insert end "\n\t[lindex $info 0]"
8109 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8110 set date [formatdate [lindex $info 2]]
8111 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8114 $ctext conf -state disabled
8118 proc normalline {} {
8120 if {[info exists thickerline]} {
8129 if {[commitinview $id $curview]} {
8130 selectline [rowofcommit $id] 1
8136 if {![info exists startmstime]} {
8137 set startmstime [clock clicks -milliseconds]
8139 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8142 proc rowmenu {x y id} {
8143 global rowctxmenu selectedline rowmenuid curview
8144 global nullid nullid2 fakerowmenu mainhead markedid
8148 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8153 if {$id ne $nullid && $id ne $nullid2} {
8154 set menu $rowctxmenu
8155 if {$mainhead ne {}} {
8156 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8158 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8160 if {[info exists markedid] && $markedid ne $id} {
8161 $menu entryconfigure 9 -state normal
8162 $menu entryconfigure 10 -state normal
8163 $menu entryconfigure 11 -state normal
8165 $menu entryconfigure 9 -state disabled
8166 $menu entryconfigure 10 -state disabled
8167 $menu entryconfigure 11 -state disabled
8170 set menu $fakerowmenu
8172 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8173 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8174 $menu entryconfigure [mca "Make patch"] -state $state
8175 tk_popup $menu $x $y
8179 global rowmenuid markedid canv
8181 set markedid $rowmenuid
8182 make_idmark $markedid
8188 if {[info exists markedid]} {
8193 proc replace_by_kids {l r} {
8194 global curview children
8196 set id [commitonrow $r]
8197 set l [lreplace $l 0 0]
8198 foreach kid $children($curview,$id) {
8199 lappend l [rowofcommit $kid]
8201 return [lsort -integer -decreasing -unique $l]
8204 proc find_common_desc {} {
8205 global markedid rowmenuid curview children
8207 if {![info exists markedid]} return
8208 if {![commitinview $markedid $curview] ||
8209 ![commitinview $rowmenuid $curview]} return
8210 #set t1 [clock clicks -milliseconds]
8211 set l1 [list [rowofcommit $markedid]]
8212 set l2 [list [rowofcommit $rowmenuid]]
8214 set r1 [lindex $l1 0]
8215 set r2 [lindex $l2 0]
8216 if {$r1 eq {} || $r2 eq {}} break
8222 set l1 [replace_by_kids $l1 $r1]
8224 set l2 [replace_by_kids $l2 $r2]
8227 #set t2 [clock clicks -milliseconds]
8228 #puts "took [expr {$t2-$t1}]ms"
8231 proc compare_commits {} {
8232 global markedid rowmenuid curview children
8234 if {![info exists markedid]} return
8235 if {![commitinview $markedid $curview]} return
8236 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8237 do_cmp_commits $markedid $rowmenuid
8240 proc getpatchid {id} {
8243 if {![info exists patchids($id)]} {
8244 set cmd [diffcmd [list $id] {-p --root}]
8245 # trim off the initial "|"
8246 set cmd [lrange $cmd 1 end]
8248 set x [eval exec $cmd | git patch-id]
8249 set patchids($id) [lindex $x 0]
8251 set patchids($id) "error"
8254 return $patchids($id)
8257 proc do_cmp_commits {a b} {
8258 global ctext curview parents children patchids commitinfo
8260 $ctext conf -state normal
8263 for {set i 0} {$i < 100} {incr i} {
8266 if {[llength $parents($curview,$a)] > 1} {
8267 appendshortlink $a [mc "Skipping merge commit "] "\n"
8270 set patcha [getpatchid $a]
8272 if {[llength $parents($curview,$b)] > 1} {
8273 appendshortlink $b [mc "Skipping merge commit "] "\n"
8276 set patchb [getpatchid $b]
8278 if {!$skipa && !$skipb} {
8279 set heada [lindex $commitinfo($a) 0]
8280 set headb [lindex $commitinfo($b) 0]
8281 if {$patcha eq "error"} {
8282 appendshortlink $a [mc "Error getting patch ID for "] \
8283 [mc " - stopping\n"]
8286 if {$patchb eq "error"} {
8287 appendshortlink $b [mc "Error getting patch ID for "] \
8288 [mc " - stopping\n"]
8291 if {$patcha eq $patchb} {
8292 if {$heada eq $headb} {
8293 appendshortlink $a [mc "Commit "]
8294 appendshortlink $b " == " " $heada\n"
8296 appendshortlink $a [mc "Commit "] " $heada\n"
8297 appendshortlink $b [mc " is the same patch as\n "] \
8303 $ctext insert end "\n"
8304 appendshortlink $a [mc "Commit "] " $heada\n"
8305 appendshortlink $b [mc " differs from\n "] \
8307 $ctext insert end [mc "Diff of commits:\n\n"]
8308 $ctext conf -state disabled
8315 if {[llength $children($curview,$a)] != 1} {
8316 $ctext insert end "\n"
8317 appendshortlink $a [mc "Commit "] \
8318 [mc " has %s children - stopping\n" \
8319 [llength $children($curview,$a)]]
8322 set a [lindex $children($curview,$a) 0]
8325 if {[llength $children($curview,$b)] != 1} {
8326 appendshortlink $b [mc "Commit "] \
8327 [mc " has %s children - stopping\n" \
8328 [llength $children($curview,$b)]]
8331 set b [lindex $children($curview,$b) 0]
8334 $ctext conf -state disabled
8337 proc diffcommits {a b} {
8338 global diffcontext diffids blobdifffd diffinhdr
8340 set tmpdir [gitknewtmpdir]
8341 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8342 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8344 exec git diff-tree -p --pretty $a >$fna
8345 exec git diff-tree -p --pretty $b >$fnb
8347 error_popup [mc "Error writing commit to file: %s" $err]
8351 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8353 error_popup [mc "Error diffing commits: %s" $err]
8356 set diffids [list commits $a $b]
8357 set blobdifffd($diffids) $fd
8359 filerun $fd [list getblobdiffline $fd $diffids]
8362 proc diffvssel {dirn} {
8363 global rowmenuid selectedline
8365 if {$selectedline eq {}} return
8367 set oldid [commitonrow $selectedline]
8368 set newid $rowmenuid
8370 set oldid $rowmenuid
8371 set newid [commitonrow $selectedline]
8373 addtohistory [list doseldiff $oldid $newid]
8374 doseldiff $oldid $newid
8377 proc doseldiff {oldid newid} {
8381 $ctext conf -state normal
8383 init_flist [mc "Top"]
8384 $ctext insert end "[mc "From"] "
8385 $ctext insert end $oldid link0
8386 setlink $oldid link0
8387 $ctext insert end "\n "
8388 $ctext insert end [lindex $commitinfo($oldid) 0]
8389 $ctext insert end "\n\n[mc "To"] "
8390 $ctext insert end $newid link1
8391 setlink $newid link1
8392 $ctext insert end "\n "
8393 $ctext insert end [lindex $commitinfo($newid) 0]
8394 $ctext insert end "\n"
8395 $ctext conf -state disabled
8396 $ctext tag remove found 1.0 end
8397 startdiff [list $oldid $newid]
8401 global rowmenuid currentid commitinfo patchtop patchnum
8403 if {![info exists currentid]} return
8404 set oldid $currentid
8405 set oldhead [lindex $commitinfo($oldid) 0]
8406 set newid $rowmenuid
8407 set newhead [lindex $commitinfo($newid) 0]
8410 catch {destroy $top}
8412 make_transient $top .
8413 label $top.title -text [mc "Generate patch"]
8414 grid $top.title - -pady 10
8415 label $top.from -text [mc "From:"]
8416 entry $top.fromsha1 -width 40 -relief flat
8417 $top.fromsha1 insert 0 $oldid
8418 $top.fromsha1 conf -state readonly
8419 grid $top.from $top.fromsha1 -sticky w
8420 entry $top.fromhead -width 60 -relief flat
8421 $top.fromhead insert 0 $oldhead
8422 $top.fromhead conf -state readonly
8423 grid x $top.fromhead -sticky w
8424 label $top.to -text [mc "To:"]
8425 entry $top.tosha1 -width 40 -relief flat
8426 $top.tosha1 insert 0 $newid
8427 $top.tosha1 conf -state readonly
8428 grid $top.to $top.tosha1 -sticky w
8429 entry $top.tohead -width 60 -relief flat
8430 $top.tohead insert 0 $newhead
8431 $top.tohead conf -state readonly
8432 grid x $top.tohead -sticky w
8433 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8434 grid $top.rev x -pady 10
8435 label $top.flab -text [mc "Output file:"]
8436 entry $top.fname -width 60
8437 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8439 grid $top.flab $top.fname -sticky w
8441 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8442 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8443 bind $top <Key-Return> mkpatchgo
8444 bind $top <Key-Escape> mkpatchcan
8445 grid $top.buts.gen $top.buts.can
8446 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8447 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8448 grid $top.buts - -pady 10 -sticky ew
8452 proc mkpatchrev {} {
8455 set oldid [$patchtop.fromsha1 get]
8456 set oldhead [$patchtop.fromhead get]
8457 set newid [$patchtop.tosha1 get]
8458 set newhead [$patchtop.tohead get]
8459 foreach e [list fromsha1 fromhead tosha1 tohead] \
8460 v [list $newid $newhead $oldid $oldhead] {
8461 $patchtop.$e conf -state normal
8462 $patchtop.$e delete 0 end
8463 $patchtop.$e insert 0 $v
8464 $patchtop.$e conf -state readonly
8469 global patchtop nullid nullid2
8471 set oldid [$patchtop.fromsha1 get]
8472 set newid [$patchtop.tosha1 get]
8473 set fname [$patchtop.fname get]
8474 set cmd [diffcmd [list $oldid $newid] -p]
8475 # trim off the initial "|"
8476 set cmd [lrange $cmd 1 end]
8477 lappend cmd >$fname &
8478 if {[catch {eval exec $cmd} err]} {
8479 error_popup "[mc "Error creating patch:"] $err" $patchtop
8481 catch {destroy $patchtop}
8485 proc mkpatchcan {} {
8488 catch {destroy $patchtop}
8493 global rowmenuid mktagtop commitinfo
8497 catch {destroy $top}
8499 make_transient $top .
8500 label $top.title -text [mc "Create tag"]
8501 grid $top.title - -pady 10
8502 label $top.id -text [mc "ID:"]
8503 entry $top.sha1 -width 40 -relief flat
8504 $top.sha1 insert 0 $rowmenuid
8505 $top.sha1 conf -state readonly
8506 grid $top.id $top.sha1 -sticky w
8507 entry $top.head -width 60 -relief flat
8508 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8509 $top.head conf -state readonly
8510 grid x $top.head -sticky w
8511 label $top.tlab -text [mc "Tag name:"]
8512 entry $top.tag -width 60
8513 grid $top.tlab $top.tag -sticky w
8515 button $top.buts.gen -text [mc "Create"] -command mktaggo
8516 button $top.buts.can -text [mc "Cancel"] -command mktagcan
8517 bind $top <Key-Return> mktaggo
8518 bind $top <Key-Escape> mktagcan
8519 grid $top.buts.gen $top.buts.can
8520 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8521 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8522 grid $top.buts - -pady 10 -sticky ew
8527 global mktagtop env tagids idtags
8529 set id [$mktagtop.sha1 get]
8530 set tag [$mktagtop.tag get]
8532 error_popup [mc "No tag name specified"] $mktagtop
8535 if {[info exists tagids($tag)]} {
8536 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8540 exec git tag $tag $id
8542 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8546 set tagids($tag) $id
8547 lappend idtags($id) $tag
8555 proc redrawtags {id} {
8556 global canv linehtag idpos currentid curview cmitlisted markedid
8557 global canvxmax iddrawn circleitem mainheadid circlecolors
8559 if {![commitinview $id $curview]} return
8560 if {![info exists iddrawn($id)]} return
8561 set row [rowofcommit $id]
8562 if {$id eq $mainheadid} {
8565 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8567 $canv itemconf $circleitem($row) -fill $ofill
8568 $canv delete tag.$id
8569 set xt [eval drawtags $id $idpos($id)]
8570 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8571 set text [$canv itemcget $linehtag($id) -text]
8572 set font [$canv itemcget $linehtag($id) -font]
8573 set xr [expr {$xt + [font measure $font $text]}]
8574 if {$xr > $canvxmax} {
8578 if {[info exists currentid] && $currentid == $id} {
8581 if {[info exists markedid] && $markedid eq $id} {
8589 catch {destroy $mktagtop}
8594 if {![domktag]} return
8598 proc writecommit {} {
8599 global rowmenuid wrcomtop commitinfo wrcomcmd
8601 set top .writecommit
8603 catch {destroy $top}
8605 make_transient $top .
8606 label $top.title -text [mc "Write commit to file"]
8607 grid $top.title - -pady 10
8608 label $top.id -text [mc "ID:"]
8609 entry $top.sha1 -width 40 -relief flat
8610 $top.sha1 insert 0 $rowmenuid
8611 $top.sha1 conf -state readonly
8612 grid $top.id $top.sha1 -sticky w
8613 entry $top.head -width 60 -relief flat
8614 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8615 $top.head conf -state readonly
8616 grid x $top.head -sticky w
8617 label $top.clab -text [mc "Command:"]
8618 entry $top.cmd -width 60 -textvariable wrcomcmd
8619 grid $top.clab $top.cmd -sticky w -pady 10
8620 label $top.flab -text [mc "Output file:"]
8621 entry $top.fname -width 60
8622 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8623 grid $top.flab $top.fname -sticky w
8625 button $top.buts.gen -text [mc "Write"] -command wrcomgo
8626 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8627 bind $top <Key-Return> wrcomgo
8628 bind $top <Key-Escape> wrcomcan
8629 grid $top.buts.gen $top.buts.can
8630 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8631 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8632 grid $top.buts - -pady 10 -sticky ew
8639 set id [$wrcomtop.sha1 get]
8640 set cmd "echo $id | [$wrcomtop.cmd get]"
8641 set fname [$wrcomtop.fname get]
8642 if {[catch {exec sh -c $cmd >$fname &} err]} {
8643 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8645 catch {destroy $wrcomtop}
8652 catch {destroy $wrcomtop}
8657 global rowmenuid mkbrtop
8660 catch {destroy $top}
8662 make_transient $top .
8663 label $top.title -text [mc "Create new branch"]
8664 grid $top.title - -pady 10
8665 label $top.id -text [mc "ID:"]
8666 entry $top.sha1 -width 40 -relief flat
8667 $top.sha1 insert 0 $rowmenuid
8668 $top.sha1 conf -state readonly
8669 grid $top.id $top.sha1 -sticky w
8670 label $top.nlab -text [mc "Name:"]
8671 entry $top.name -width 40
8672 grid $top.nlab $top.name -sticky w
8674 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8675 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8676 bind $top <Key-Return> [list mkbrgo $top]
8677 bind $top <Key-Escape> "catch {destroy $top}"
8678 grid $top.buts.go $top.buts.can
8679 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8680 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8681 grid $top.buts - -pady 10 -sticky ew
8686 global headids idheads
8688 set name [$top.name get]
8689 set id [$top.sha1 get]
8693 error_popup [mc "Please specify a name for the new branch"] $top
8696 if {[info exists headids($name)]} {
8697 if {![confirm_popup [mc \
8698 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8701 set old_id $headids($name)
8704 catch {destroy $top}
8705 lappend cmdargs $name $id
8709 eval exec git branch $cmdargs
8715 if {$old_id ne {}} {
8721 set headids($name) $id
8722 lappend idheads($id) $name
8731 proc exec_citool {tool_args {baseid {}}} {
8732 global commitinfo env
8734 set save_env [array get env GIT_AUTHOR_*]
8736 if {$baseid ne {}} {
8737 if {![info exists commitinfo($baseid)]} {
8740 set author [lindex $commitinfo($baseid) 1]
8741 set date [lindex $commitinfo($baseid) 2]
8742 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8743 $author author name email]
8745 set env(GIT_AUTHOR_NAME) $name
8746 set env(GIT_AUTHOR_EMAIL) $email
8747 set env(GIT_AUTHOR_DATE) $date
8751 eval exec git citool $tool_args &
8753 array unset env GIT_AUTHOR_*
8754 array set env $save_env
8757 proc cherrypick {} {
8758 global rowmenuid curview
8759 global mainhead mainheadid
8761 set oldhead [exec git rev-parse HEAD]
8762 set dheads [descheads $rowmenuid]
8763 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8764 set ok [confirm_popup [mc "Commit %s is already\
8765 included in branch %s -- really re-apply it?" \
8766 [string range $rowmenuid 0 7] $mainhead]]
8769 nowbusy cherrypick [mc "Cherry-picking"]
8771 # Unfortunately git-cherry-pick writes stuff to stderr even when
8772 # no error occurs, and exec takes that as an indication of error...
8773 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8776 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8778 error_popup [mc "Cherry-pick failed because of local changes\
8779 to file '%s'.\nPlease commit, reset or stash\
8780 your changes and try again." $fname]
8781 } elseif {[regexp -line \
8782 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8784 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8785 conflict.\nDo you wish to run git citool to\
8787 # Force citool to read MERGE_MSG
8788 file delete [file join [gitdir] "GITGUI_MSG"]
8789 exec_citool {} $rowmenuid
8797 set newhead [exec git rev-parse HEAD]
8798 if {$newhead eq $oldhead} {
8800 error_popup [mc "No changes committed"]
8803 addnewchild $newhead $oldhead
8804 if {[commitinview $oldhead $curview]} {
8805 # XXX this isn't right if we have a path limit...
8806 insertrow $newhead $oldhead $curview
8807 if {$mainhead ne {}} {
8808 movehead $newhead $mainhead
8809 movedhead $newhead $mainhead
8811 set mainheadid $newhead
8820 global mainhead rowmenuid confirm_ok resettype
8823 set w ".confirmreset"
8826 wm title $w [mc "Confirm reset"]
8827 message $w.m -text \
8828 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8829 -justify center -aspect 1000
8830 pack $w.m -side top -fill x -padx 20 -pady 20
8831 frame $w.f -relief sunken -border 2
8832 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8833 grid $w.f.rt -sticky w
8835 radiobutton $w.f.soft -value soft -variable resettype -justify left \
8836 -text [mc "Soft: Leave working tree and index untouched"]
8837 grid $w.f.soft -sticky w
8838 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8839 -text [mc "Mixed: Leave working tree untouched, reset index"]
8840 grid $w.f.mixed -sticky w
8841 radiobutton $w.f.hard -value hard -variable resettype -justify left \
8842 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8843 grid $w.f.hard -sticky w
8844 pack $w.f -side top -fill x
8845 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8846 pack $w.ok -side left -fill x -padx 20 -pady 20
8847 button $w.cancel -text [mc Cancel] -command "destroy $w"
8848 bind $w <Key-Escape> [list destroy $w]
8849 pack $w.cancel -side right -fill x -padx 20 -pady 20
8850 bind $w <Visibility> "grab $w; focus $w"
8852 if {!$confirm_ok} return
8853 if {[catch {set fd [open \
8854 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8858 filerun $fd [list readresetstat $fd]
8859 nowbusy reset [mc "Resetting"]
8864 proc readresetstat {fd} {
8865 global mainhead mainheadid showlocalchanges rprogcoord
8867 if {[gets $fd line] >= 0} {
8868 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8869 set rprogcoord [expr {1.0 * $m / $n}]
8877 if {[catch {close $fd} err]} {
8880 set oldhead $mainheadid
8881 set newhead [exec git rev-parse HEAD]
8882 if {$newhead ne $oldhead} {
8883 movehead $newhead $mainhead
8884 movedhead $newhead $mainhead
8885 set mainheadid $newhead
8889 if {$showlocalchanges} {
8895 # context menu for a head
8896 proc headmenu {x y id head} {
8897 global headmenuid headmenuhead headctxmenu mainhead
8901 set headmenuhead $head
8903 if {[string match "remotes/*" $head]} {
8906 if {$head eq $mainhead} {
8909 $headctxmenu entryconfigure 0 -state $state
8910 $headctxmenu entryconfigure 1 -state $state
8911 tk_popup $headctxmenu $x $y
8915 global headmenuid headmenuhead headids
8916 global showlocalchanges
8918 # check the tree is clean first??
8919 nowbusy checkout [mc "Checking out"]
8923 set fd [open [list | git checkout $headmenuhead 2>@1] r]
8927 if {$showlocalchanges} {
8931 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8935 proc readcheckoutstat {fd newhead newheadid} {
8936 global mainhead mainheadid headids showlocalchanges progresscoords
8937 global viewmainheadid curview
8939 if {[gets $fd line] >= 0} {
8940 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8941 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8946 set progresscoords {0 0}
8949 if {[catch {close $fd} err]} {
8952 set oldmainid $mainheadid
8953 set mainhead $newhead
8954 set mainheadid $newheadid
8955 set viewmainheadid($curview) $newheadid
8956 redrawtags $oldmainid
8957 redrawtags $newheadid
8959 if {$showlocalchanges} {
8965 global headmenuid headmenuhead mainhead
8968 set head $headmenuhead
8970 # this check shouldn't be needed any more...
8971 if {$head eq $mainhead} {
8972 error_popup [mc "Cannot delete the currently checked-out branch"]
8975 set dheads [descheads $id]
8976 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8977 # the stuff on this branch isn't on any other branch
8978 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8979 branch.\nReally delete branch %s?" $head $head]]} return
8983 if {[catch {exec git branch -D $head} err]} {
8988 removehead $id $head
8989 removedhead $id $head
8996 # Display a list of tags and heads
8998 global showrefstop bgcolor fgcolor selectbgcolor
8999 global bglist fglist reflistfilter reflist maincursor
9002 set showrefstop $top
9003 if {[winfo exists $top]} {
9009 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9010 make_transient $top .
9011 text $top.list -background $bgcolor -foreground $fgcolor \
9012 -selectbackground $selectbgcolor -font mainfont \
9013 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9014 -width 30 -height 20 -cursor $maincursor \
9015 -spacing1 1 -spacing3 1 -state disabled
9016 $top.list tag configure highlight -background $selectbgcolor
9017 lappend bglist $top.list
9018 lappend fglist $top.list
9019 scrollbar $top.ysb -command "$top.list yview" -orient vertical
9020 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9021 grid $top.list $top.ysb -sticky nsew
9022 grid $top.xsb x -sticky ew
9024 label $top.f.l -text "[mc "Filter"]: "
9025 entry $top.f.e -width 20 -textvariable reflistfilter
9026 set reflistfilter "*"
9027 trace add variable reflistfilter write reflistfilter_change
9028 pack $top.f.e -side right -fill x -expand 1
9029 pack $top.f.l -side left
9030 grid $top.f - -sticky ew -pady 2
9031 button $top.close -command [list destroy $top] -text [mc "Close"]
9032 bind $top <Key-Escape> [list destroy $top]
9034 grid columnconfigure $top 0 -weight 1
9035 grid rowconfigure $top 0 -weight 1
9036 bind $top.list <1> {break}
9037 bind $top.list <B1-Motion> {break}
9038 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9043 proc sel_reflist {w x y} {
9044 global showrefstop reflist headids tagids otherrefids
9046 if {![winfo exists $showrefstop]} return
9047 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9048 set ref [lindex $reflist [expr {$l-1}]]
9049 set n [lindex $ref 0]
9050 switch -- [lindex $ref 1] {
9051 "H" {selbyid $headids($n)}
9052 "T" {selbyid $tagids($n)}
9053 "o" {selbyid $otherrefids($n)}
9055 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9058 proc unsel_reflist {} {
9061 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9062 $showrefstop.list tag remove highlight 0.0 end
9065 proc reflistfilter_change {n1 n2 op} {
9066 global reflistfilter
9068 after cancel refill_reflist
9069 after 200 refill_reflist
9072 proc refill_reflist {} {
9073 global reflist reflistfilter showrefstop headids tagids otherrefids
9076 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9078 foreach n [array names headids] {
9079 if {[string match $reflistfilter $n]} {
9080 if {[commitinview $headids($n) $curview]} {
9081 lappend refs [list $n H]
9083 interestedin $headids($n) {run refill_reflist}
9087 foreach n [array names tagids] {
9088 if {[string match $reflistfilter $n]} {
9089 if {[commitinview $tagids($n) $curview]} {
9090 lappend refs [list $n T]
9092 interestedin $tagids($n) {run refill_reflist}
9096 foreach n [array names otherrefids] {
9097 if {[string match $reflistfilter $n]} {
9098 if {[commitinview $otherrefids($n) $curview]} {
9099 lappend refs [list $n o]
9101 interestedin $otherrefids($n) {run refill_reflist}
9105 set refs [lsort -index 0 $refs]
9106 if {$refs eq $reflist} return
9108 # Update the contents of $showrefstop.list according to the
9109 # differences between $reflist (old) and $refs (new)
9110 $showrefstop.list conf -state normal
9111 $showrefstop.list insert end "\n"
9114 while {$i < [llength $reflist] || $j < [llength $refs]} {
9115 if {$i < [llength $reflist]} {
9116 if {$j < [llength $refs]} {
9117 set cmp [string compare [lindex $reflist $i 0] \
9118 [lindex $refs $j 0]]
9120 set cmp [string compare [lindex $reflist $i 1] \
9121 [lindex $refs $j 1]]
9131 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9139 set l [expr {$j + 1}]
9140 $showrefstop.list image create $l.0 -align baseline \
9141 -image reficon-[lindex $refs $j 1] -padx 2
9142 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9148 # delete last newline
9149 $showrefstop.list delete end-2c end-1c
9150 $showrefstop.list conf -state disabled
9153 # Stuff for finding nearby tags
9154 proc getallcommits {} {
9155 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9156 global idheads idtags idotherrefs allparents tagobjid
9158 if {![info exists allcommits]} {
9164 set allccache [file join [gitdir] "gitk.cache"]
9166 set f [open $allccache r]
9175 set cmd [list | git rev-list --parents]
9176 set allcupdate [expr {$seeds ne {}}]
9180 set refs [concat [array names idheads] [array names idtags] \
9181 [array names idotherrefs]]
9184 foreach name [array names tagobjid] {
9185 lappend tagobjs $tagobjid($name)
9187 foreach id [lsort -unique $refs] {
9188 if {![info exists allparents($id)] &&
9189 [lsearch -exact $tagobjs $id] < 0} {
9200 set fd [open [concat $cmd $ids] r]
9201 fconfigure $fd -blocking 0
9204 filerun $fd [list getallclines $fd]
9210 # Since most commits have 1 parent and 1 child, we group strings of
9211 # such commits into "arcs" joining branch/merge points (BMPs), which
9212 # are commits that either don't have 1 parent or don't have 1 child.
9214 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9215 # arcout(id) - outgoing arcs for BMP
9216 # arcids(a) - list of IDs on arc including end but not start
9217 # arcstart(a) - BMP ID at start of arc
9218 # arcend(a) - BMP ID at end of arc
9219 # growing(a) - arc a is still growing
9220 # arctags(a) - IDs out of arcids (excluding end) that have tags
9221 # archeads(a) - IDs out of arcids (excluding end) that have heads
9222 # The start of an arc is at the descendent end, so "incoming" means
9223 # coming from descendents, and "outgoing" means going towards ancestors.
9225 proc getallclines {fd} {
9226 global allparents allchildren idtags idheads nextarc
9227 global arcnos arcids arctags arcout arcend arcstart archeads growing
9228 global seeds allcommits cachedarcs allcupdate
9231 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9232 set id [lindex $line 0]
9233 if {[info exists allparents($id)]} {
9238 set olds [lrange $line 1 end]
9239 set allparents($id) $olds
9240 if {![info exists allchildren($id)]} {
9241 set allchildren($id) {}
9246 if {[llength $olds] == 1 && [llength $a] == 1} {
9247 lappend arcids($a) $id
9248 if {[info exists idtags($id)]} {
9249 lappend arctags($a) $id
9251 if {[info exists idheads($id)]} {
9252 lappend archeads($a) $id
9254 if {[info exists allparents($olds)]} {
9255 # seen parent already
9256 if {![info exists arcout($olds)]} {
9259 lappend arcids($a) $olds
9260 set arcend($a) $olds
9263 lappend allchildren($olds) $id
9264 lappend arcnos($olds) $a
9268 foreach a $arcnos($id) {
9269 lappend arcids($a) $id
9276 lappend allchildren($p) $id
9277 set a [incr nextarc]
9278 set arcstart($a) $id
9285 if {[info exists allparents($p)]} {
9286 # seen it already, may need to make a new branch
9287 if {![info exists arcout($p)]} {
9290 lappend arcids($a) $p
9294 lappend arcnos($p) $a
9299 global cached_dheads cached_dtags cached_atags
9300 catch {unset cached_dheads}
9301 catch {unset cached_dtags}
9302 catch {unset cached_atags}
9305 return [expr {$nid >= 1000? 2: 1}]
9309 fconfigure $fd -blocking 1
9312 # got an error reading the list of commits
9313 # if we were updating, try rereading the whole thing again
9319 error_popup "[mc "Error reading commit topology information;\
9320 branch and preceding/following tag information\
9321 will be incomplete."]\n($err)"
9324 if {[incr allcommits -1] == 0} {
9334 proc recalcarc {a} {
9335 global arctags archeads arcids idtags idheads
9339 foreach id [lrange $arcids($a) 0 end-1] {
9340 if {[info exists idtags($id)]} {
9343 if {[info exists idheads($id)]} {
9348 set archeads($a) $ah
9352 global arcnos arcids nextarc arctags archeads idtags idheads
9353 global arcstart arcend arcout allparents growing
9356 if {[llength $a] != 1} {
9357 puts "oops splitarc called but [llength $a] arcs already"
9361 set i [lsearch -exact $arcids($a) $p]
9363 puts "oops splitarc $p not in arc $a"
9366 set na [incr nextarc]
9367 if {[info exists arcend($a)]} {
9368 set arcend($na) $arcend($a)
9370 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9371 set j [lsearch -exact $arcnos($l) $a]
9372 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9374 set tail [lrange $arcids($a) [expr {$i+1}] end]
9375 set arcids($a) [lrange $arcids($a) 0 $i]
9377 set arcstart($na) $p
9379 set arcids($na) $tail
9380 if {[info exists growing($a)]} {
9386 if {[llength $arcnos($id)] == 1} {
9389 set j [lsearch -exact $arcnos($id) $a]
9390 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9394 # reconstruct tags and heads lists
9395 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9400 set archeads($na) {}
9404 # Update things for a new commit added that is a child of one
9405 # existing commit. Used when cherry-picking.
9406 proc addnewchild {id p} {
9407 global allparents allchildren idtags nextarc
9408 global arcnos arcids arctags arcout arcend arcstart archeads growing
9409 global seeds allcommits
9411 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9412 set allparents($id) [list $p]
9413 set allchildren($id) {}
9416 lappend allchildren($p) $id
9417 set a [incr nextarc]
9418 set arcstart($a) $id
9421 set arcids($a) [list $p]
9423 if {![info exists arcout($p)]} {
9426 lappend arcnos($p) $a
9427 set arcout($id) [list $a]
9430 # This implements a cache for the topology information.
9431 # The cache saves, for each arc, the start and end of the arc,
9432 # the ids on the arc, and the outgoing arcs from the end.
9433 proc readcache {f} {
9434 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9435 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9440 if {$lim - $a > 500} {
9441 set lim [expr {$a + 500}]
9445 # finish reading the cache and setting up arctags, etc.
9447 if {$line ne "1"} {error "bad final version"}
9449 foreach id [array names idtags] {
9450 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9451 [llength $allparents($id)] == 1} {
9452 set a [lindex $arcnos($id) 0]
9453 if {$arctags($a) eq {}} {
9458 foreach id [array names idheads] {
9459 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9460 [llength $allparents($id)] == 1} {
9461 set a [lindex $arcnos($id) 0]
9462 if {$archeads($a) eq {}} {
9467 foreach id [lsort -unique $possible_seeds] {
9468 if {$arcnos($id) eq {}} {
9474 while {[incr a] <= $lim} {
9476 if {[llength $line] != 3} {error "bad line"}
9477 set s [lindex $line 0]
9479 lappend arcout($s) $a
9480 if {![info exists arcnos($s)]} {
9481 lappend possible_seeds $s
9484 set e [lindex $line 1]
9489 if {![info exists arcout($e)]} {
9493 set arcids($a) [lindex $line 2]
9494 foreach id $arcids($a) {
9495 lappend allparents($s) $id
9497 lappend arcnos($id) $a
9499 if {![info exists allparents($s)]} {
9500 set allparents($s) {}
9505 set nextarc [expr {$a - 1}]
9518 global nextarc cachedarcs possible_seeds
9522 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9523 # make sure it's an integer
9524 set cachedarcs [expr {int([lindex $line 1])}]
9525 if {$cachedarcs < 0} {error "bad number of arcs"}
9527 set possible_seeds {}
9535 proc dropcache {err} {
9536 global allcwait nextarc cachedarcs seeds
9538 #puts "dropping cache ($err)"
9539 foreach v {arcnos arcout arcids arcstart arcend growing \
9540 arctags archeads allparents allchildren} {
9551 proc writecache {f} {
9552 global cachearc cachedarcs allccache
9553 global arcstart arcend arcnos arcids arcout
9557 if {$lim - $a > 1000} {
9558 set lim [expr {$a + 1000}]
9561 while {[incr a] <= $lim} {
9562 if {[info exists arcend($a)]} {
9563 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9565 puts $f [list $arcstart($a) {} $arcids($a)]
9570 catch {file delete $allccache}
9571 #puts "writing cache failed ($err)"
9574 set cachearc [expr {$a - 1}]
9575 if {$a > $cachedarcs} {
9584 global nextarc cachedarcs cachearc allccache
9586 if {$nextarc == $cachedarcs} return
9588 set cachedarcs $nextarc
9590 set f [open $allccache w]
9591 puts $f [list 1 $cachedarcs]
9596 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9597 # or 0 if neither is true.
9598 proc anc_or_desc {a b} {
9599 global arcout arcstart arcend arcnos cached_isanc
9601 if {$arcnos($a) eq $arcnos($b)} {
9602 # Both are on the same arc(s); either both are the same BMP,
9603 # or if one is not a BMP, the other is also not a BMP or is
9604 # the BMP at end of the arc (and it only has 1 incoming arc).
9605 # Or both can be BMPs with no incoming arcs.
9606 if {$a eq $b || $arcnos($a) eq {}} {
9609 # assert {[llength $arcnos($a)] == 1}
9610 set arc [lindex $arcnos($a) 0]
9611 set i [lsearch -exact $arcids($arc) $a]
9612 set j [lsearch -exact $arcids($arc) $b]
9613 if {$i < 0 || $i > $j} {
9620 if {![info exists arcout($a)]} {
9621 set arc [lindex $arcnos($a) 0]
9622 if {[info exists arcend($arc)]} {
9623 set aend $arcend($arc)
9627 set a $arcstart($arc)
9631 if {![info exists arcout($b)]} {
9632 set arc [lindex $arcnos($b) 0]
9633 if {[info exists arcend($arc)]} {
9634 set bend $arcend($arc)
9638 set b $arcstart($arc)
9648 if {[info exists cached_isanc($a,$bend)]} {
9649 if {$cached_isanc($a,$bend)} {
9653 if {[info exists cached_isanc($b,$aend)]} {
9654 if {$cached_isanc($b,$aend)} {
9657 if {[info exists cached_isanc($a,$bend)]} {
9662 set todo [list $a $b]
9665 for {set i 0} {$i < [llength $todo]} {incr i} {
9666 set x [lindex $todo $i]
9667 if {$anc($x) eq {}} {
9670 foreach arc $arcnos($x) {
9671 set xd $arcstart($arc)
9673 set cached_isanc($a,$bend) 1
9674 set cached_isanc($b,$aend) 0
9676 } elseif {$xd eq $aend} {
9677 set cached_isanc($b,$aend) 1
9678 set cached_isanc($a,$bend) 0
9681 if {![info exists anc($xd)]} {
9682 set anc($xd) $anc($x)
9684 } elseif {$anc($xd) ne $anc($x)} {
9689 set cached_isanc($a,$bend) 0
9690 set cached_isanc($b,$aend) 0
9694 # This identifies whether $desc has an ancestor that is
9695 # a growing tip of the graph and which is not an ancestor of $anc
9696 # and returns 0 if so and 1 if not.
9697 # If we subsequently discover a tag on such a growing tip, and that
9698 # turns out to be a descendent of $anc (which it could, since we
9699 # don't necessarily see children before parents), then $desc
9700 # isn't a good choice to display as a descendent tag of
9701 # $anc (since it is the descendent of another tag which is
9702 # a descendent of $anc). Similarly, $anc isn't a good choice to
9703 # display as a ancestor tag of $desc.
9705 proc is_certain {desc anc} {
9706 global arcnos arcout arcstart arcend growing problems
9709 if {[llength $arcnos($anc)] == 1} {
9710 # tags on the same arc are certain
9711 if {$arcnos($desc) eq $arcnos($anc)} {
9714 if {![info exists arcout($anc)]} {
9715 # if $anc is partway along an arc, use the start of the arc instead
9716 set a [lindex $arcnos($anc) 0]
9717 set anc $arcstart($a)
9720 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9723 set a [lindex $arcnos($desc) 0]
9729 set anclist [list $x]
9733 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9734 set x [lindex $anclist $i]
9739 foreach a $arcout($x) {
9740 if {[info exists growing($a)]} {
9741 if {![info exists growanc($x)] && $dl($x)} {
9747 if {[info exists dl($y)]} {
9751 if {![info exists done($y)]} {
9754 if {[info exists growanc($x)]} {
9758 for {set k 0} {$k < [llength $xl]} {incr k} {
9759 set z [lindex $xl $k]
9760 foreach c $arcout($z) {
9761 if {[info exists arcend($c)]} {
9763 if {[info exists dl($v)] && $dl($v)} {
9765 if {![info exists done($v)]} {
9768 if {[info exists growanc($v)]} {
9778 } elseif {$y eq $anc || !$dl($x)} {
9789 foreach x [array names growanc] {
9798 proc validate_arctags {a} {
9799 global arctags idtags
9803 foreach id $arctags($a) {
9805 if {![info exists idtags($id)]} {
9806 set na [lreplace $na $i $i]
9813 proc validate_archeads {a} {
9814 global archeads idheads
9817 set na $archeads($a)
9818 foreach id $archeads($a) {
9820 if {![info exists idheads($id)]} {
9821 set na [lreplace $na $i $i]
9825 set archeads($a) $na
9828 # Return the list of IDs that have tags that are descendents of id,
9829 # ignoring IDs that are descendents of IDs already reported.
9830 proc desctags {id} {
9831 global arcnos arcstart arcids arctags idtags allparents
9832 global growing cached_dtags
9834 if {![info exists allparents($id)]} {
9837 set t1 [clock clicks -milliseconds]
9839 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9840 # part-way along an arc; check that arc first
9841 set a [lindex $arcnos($id) 0]
9842 if {$arctags($a) ne {}} {
9844 set i [lsearch -exact $arcids($a) $id]
9846 foreach t $arctags($a) {
9847 set j [lsearch -exact $arcids($a) $t]
9855 set id $arcstart($a)
9856 if {[info exists idtags($id)]} {
9860 if {[info exists cached_dtags($id)]} {
9861 return $cached_dtags($id)
9868 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9869 set id [lindex $todo $i]
9871 set ta [info exists hastaggedancestor($id)]
9875 # ignore tags on starting node
9876 if {!$ta && $i > 0} {
9877 if {[info exists idtags($id)]} {
9880 } elseif {[info exists cached_dtags($id)]} {
9881 set tagloc($id) $cached_dtags($id)
9885 foreach a $arcnos($id) {
9887 if {!$ta && $arctags($a) ne {}} {
9889 if {$arctags($a) ne {}} {
9890 lappend tagloc($id) [lindex $arctags($a) end]
9893 if {$ta || $arctags($a) ne {}} {
9894 set tomark [list $d]
9895 for {set j 0} {$j < [llength $tomark]} {incr j} {
9896 set dd [lindex $tomark $j]
9897 if {![info exists hastaggedancestor($dd)]} {
9898 if {[info exists done($dd)]} {
9899 foreach b $arcnos($dd) {
9900 lappend tomark $arcstart($b)
9902 if {[info exists tagloc($dd)]} {
9905 } elseif {[info exists queued($dd)]} {
9908 set hastaggedancestor($dd) 1
9912 if {![info exists queued($d)]} {
9915 if {![info exists hastaggedancestor($d)]} {
9922 foreach id [array names tagloc] {
9923 if {![info exists hastaggedancestor($id)]} {
9924 foreach t $tagloc($id) {
9925 if {[lsearch -exact $tags $t] < 0} {
9931 set t2 [clock clicks -milliseconds]
9934 # remove tags that are descendents of other tags
9935 for {set i 0} {$i < [llength $tags]} {incr i} {
9936 set a [lindex $tags $i]
9937 for {set j 0} {$j < $i} {incr j} {
9938 set b [lindex $tags $j]
9939 set r [anc_or_desc $a $b]
9941 set tags [lreplace $tags $j $j]
9944 } elseif {$r == -1} {
9945 set tags [lreplace $tags $i $i]
9952 if {[array names growing] ne {}} {
9953 # graph isn't finished, need to check if any tag could get
9954 # eclipsed by another tag coming later. Simply ignore any
9955 # tags that could later get eclipsed.
9958 if {[is_certain $t $origid]} {
9962 if {$tags eq $ctags} {
9963 set cached_dtags($origid) $tags
9968 set cached_dtags($origid) $tags
9970 set t3 [clock clicks -milliseconds]
9971 if {0 && $t3 - $t1 >= 100} {
9972 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9973 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9979 global arcnos arcids arcout arcend arctags idtags allparents
9980 global growing cached_atags
9982 if {![info exists allparents($id)]} {
9985 set t1 [clock clicks -milliseconds]
9987 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9988 # part-way along an arc; check that arc first
9989 set a [lindex $arcnos($id) 0]
9990 if {$arctags($a) ne {}} {
9992 set i [lsearch -exact $arcids($a) $id]
9993 foreach t $arctags($a) {
9994 set j [lsearch -exact $arcids($a) $t]
10000 if {![info exists arcend($a)]} {
10004 if {[info exists idtags($id)]} {
10008 if {[info exists cached_atags($id)]} {
10009 return $cached_atags($id)
10013 set todo [list $id]
10017 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10018 set id [lindex $todo $i]
10020 set td [info exists hastaggeddescendent($id)]
10024 # ignore tags on starting node
10025 if {!$td && $i > 0} {
10026 if {[info exists idtags($id)]} {
10027 set tagloc($id) $id
10029 } elseif {[info exists cached_atags($id)]} {
10030 set tagloc($id) $cached_atags($id)
10034 foreach a $arcout($id) {
10035 if {!$td && $arctags($a) ne {}} {
10036 validate_arctags $a
10037 if {$arctags($a) ne {}} {
10038 lappend tagloc($id) [lindex $arctags($a) 0]
10041 if {![info exists arcend($a)]} continue
10043 if {$td || $arctags($a) ne {}} {
10044 set tomark [list $d]
10045 for {set j 0} {$j < [llength $tomark]} {incr j} {
10046 set dd [lindex $tomark $j]
10047 if {![info exists hastaggeddescendent($dd)]} {
10048 if {[info exists done($dd)]} {
10049 foreach b $arcout($dd) {
10050 if {[info exists arcend($b)]} {
10051 lappend tomark $arcend($b)
10054 if {[info exists tagloc($dd)]} {
10057 } elseif {[info exists queued($dd)]} {
10060 set hastaggeddescendent($dd) 1
10064 if {![info exists queued($d)]} {
10067 if {![info exists hastaggeddescendent($d)]} {
10073 set t2 [clock clicks -milliseconds]
10076 foreach id [array names tagloc] {
10077 if {![info exists hastaggeddescendent($id)]} {
10078 foreach t $tagloc($id) {
10079 if {[lsearch -exact $tags $t] < 0} {
10086 # remove tags that are ancestors of other tags
10087 for {set i 0} {$i < [llength $tags]} {incr i} {
10088 set a [lindex $tags $i]
10089 for {set j 0} {$j < $i} {incr j} {
10090 set b [lindex $tags $j]
10091 set r [anc_or_desc $a $b]
10093 set tags [lreplace $tags $j $j]
10096 } elseif {$r == 1} {
10097 set tags [lreplace $tags $i $i]
10104 if {[array names growing] ne {}} {
10105 # graph isn't finished, need to check if any tag could get
10106 # eclipsed by another tag coming later. Simply ignore any
10107 # tags that could later get eclipsed.
10110 if {[is_certain $origid $t]} {
10114 if {$tags eq $ctags} {
10115 set cached_atags($origid) $tags
10120 set cached_atags($origid) $tags
10122 set t3 [clock clicks -milliseconds]
10123 if {0 && $t3 - $t1 >= 100} {
10124 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10125 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10130 # Return the list of IDs that have heads that are descendents of id,
10131 # including id itself if it has a head.
10132 proc descheads {id} {
10133 global arcnos arcstart arcids archeads idheads cached_dheads
10136 if {![info exists allparents($id)]} {
10140 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10141 # part-way along an arc; check it first
10142 set a [lindex $arcnos($id) 0]
10143 if {$archeads($a) ne {}} {
10144 validate_archeads $a
10145 set i [lsearch -exact $arcids($a) $id]
10146 foreach t $archeads($a) {
10147 set j [lsearch -exact $arcids($a) $t]
10152 set id $arcstart($a)
10155 set todo [list $id]
10158 for {set i 0} {$i < [llength $todo]} {incr i} {
10159 set id [lindex $todo $i]
10160 if {[info exists cached_dheads($id)]} {
10161 set ret [concat $ret $cached_dheads($id)]
10163 if {[info exists idheads($id)]} {
10166 foreach a $arcnos($id) {
10167 if {$archeads($a) ne {}} {
10168 validate_archeads $a
10169 if {$archeads($a) ne {}} {
10170 set ret [concat $ret $archeads($a)]
10173 set d $arcstart($a)
10174 if {![info exists seen($d)]} {
10181 set ret [lsort -unique $ret]
10182 set cached_dheads($origid) $ret
10183 return [concat $ret $aret]
10186 proc addedtag {id} {
10187 global arcnos arcout cached_dtags cached_atags
10189 if {![info exists arcnos($id)]} return
10190 if {![info exists arcout($id)]} {
10191 recalcarc [lindex $arcnos($id) 0]
10193 catch {unset cached_dtags}
10194 catch {unset cached_atags}
10197 proc addedhead {hid head} {
10198 global arcnos arcout cached_dheads
10200 if {![info exists arcnos($hid)]} return
10201 if {![info exists arcout($hid)]} {
10202 recalcarc [lindex $arcnos($hid) 0]
10204 catch {unset cached_dheads}
10207 proc removedhead {hid head} {
10208 global cached_dheads
10210 catch {unset cached_dheads}
10213 proc movedhead {hid head} {
10214 global arcnos arcout cached_dheads
10216 if {![info exists arcnos($hid)]} return
10217 if {![info exists arcout($hid)]} {
10218 recalcarc [lindex $arcnos($hid) 0]
10220 catch {unset cached_dheads}
10223 proc changedrefs {} {
10224 global cached_dheads cached_dtags cached_atags
10225 global arctags archeads arcnos arcout idheads idtags
10227 foreach id [concat [array names idheads] [array names idtags]] {
10228 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10229 set a [lindex $arcnos($id) 0]
10230 if {![info exists donearc($a)]} {
10236 catch {unset cached_dtags}
10237 catch {unset cached_atags}
10238 catch {unset cached_dheads}
10241 proc rereadrefs {} {
10242 global idtags idheads idotherrefs mainheadid
10244 set refids [concat [array names idtags] \
10245 [array names idheads] [array names idotherrefs]]
10246 foreach id $refids {
10247 if {![info exists ref($id)]} {
10248 set ref($id) [listrefs $id]
10251 set oldmainhead $mainheadid
10254 set refids [lsort -unique [concat $refids [array names idtags] \
10255 [array names idheads] [array names idotherrefs]]]
10256 foreach id $refids {
10257 set v [listrefs $id]
10258 if {![info exists ref($id)] || $ref($id) != $v} {
10262 if {$oldmainhead ne $mainheadid} {
10263 redrawtags $oldmainhead
10264 redrawtags $mainheadid
10269 proc listrefs {id} {
10270 global idtags idheads idotherrefs
10273 if {[info exists idtags($id)]} {
10277 if {[info exists idheads($id)]} {
10278 set y $idheads($id)
10281 if {[info exists idotherrefs($id)]} {
10282 set z $idotherrefs($id)
10284 return [list $x $y $z]
10287 proc showtag {tag isnew} {
10288 global ctext tagcontents tagids linknum tagobjid
10291 addtohistory [list showtag $tag 0]
10293 $ctext conf -state normal
10297 if {![info exists tagcontents($tag)]} {
10299 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10302 if {[info exists tagcontents($tag)]} {
10303 set text $tagcontents($tag)
10305 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10307 appendwithlinks $text {}
10308 $ctext conf -state disabled
10320 if {[info exists gitktmpdir]} {
10321 catch {file delete -force $gitktmpdir}
10325 proc mkfontdisp {font top which} {
10326 global fontattr fontpref $font
10328 set fontpref($font) [set $font]
10329 button $top.${font}but -text $which -font optionfont \
10330 -command [list choosefont $font $which]
10331 label $top.$font -relief flat -font $font \
10332 -text $fontattr($font,family) -justify left
10333 grid x $top.${font}but $top.$font -sticky w
10336 proc choosefont {font which} {
10337 global fontparam fontlist fonttop fontattr
10340 set fontparam(which) $which
10341 set fontparam(font) $font
10342 set fontparam(family) [font actual $font -family]
10343 set fontparam(size) $fontattr($font,size)
10344 set fontparam(weight) $fontattr($font,weight)
10345 set fontparam(slant) $fontattr($font,slant)
10348 if {![winfo exists $top]} {
10350 eval font config sample [font actual $font]
10352 make_transient $top $prefstop
10353 wm title $top [mc "Gitk font chooser"]
10354 label $top.l -textvariable fontparam(which)
10355 pack $top.l -side top
10356 set fontlist [lsort [font families]]
10358 listbox $top.f.fam -listvariable fontlist \
10359 -yscrollcommand [list $top.f.sb set]
10360 bind $top.f.fam <<ListboxSelect>> selfontfam
10361 scrollbar $top.f.sb -command [list $top.f.fam yview]
10362 pack $top.f.sb -side right -fill y
10363 pack $top.f.fam -side left -fill both -expand 1
10364 pack $top.f -side top -fill both -expand 1
10366 spinbox $top.g.size -from 4 -to 40 -width 4 \
10367 -textvariable fontparam(size) \
10368 -validatecommand {string is integer -strict %s}
10369 checkbutton $top.g.bold -padx 5 \
10370 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10371 -variable fontparam(weight) -onvalue bold -offvalue normal
10372 checkbutton $top.g.ital -padx 5 \
10373 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10374 -variable fontparam(slant) -onvalue italic -offvalue roman
10375 pack $top.g.size $top.g.bold $top.g.ital -side left
10376 pack $top.g -side top
10377 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10379 $top.c create text 100 25 -anchor center -text $which -font sample \
10380 -fill black -tags text
10381 bind $top.c <Configure> [list centertext $top.c]
10382 pack $top.c -side top -fill x
10384 button $top.buts.ok -text [mc "OK"] -command fontok -default active
10385 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10386 bind $top <Key-Return> fontok
10387 bind $top <Key-Escape> fontcan
10388 grid $top.buts.ok $top.buts.can
10389 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10390 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10391 pack $top.buts -side bottom -fill x
10392 trace add variable fontparam write chg_fontparam
10395 $top.c itemconf text -text $which
10397 set i [lsearch -exact $fontlist $fontparam(family)]
10399 $top.f.fam selection set $i
10404 proc centertext {w} {
10405 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10409 global fontparam fontpref prefstop
10411 set f $fontparam(font)
10412 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10413 if {$fontparam(weight) eq "bold"} {
10414 lappend fontpref($f) "bold"
10416 if {$fontparam(slant) eq "italic"} {
10417 lappend fontpref($f) "italic"
10420 $w conf -text $fontparam(family) -font $fontpref($f)
10426 global fonttop fontparam
10428 if {[info exists fonttop]} {
10429 catch {destroy $fonttop}
10430 catch {font delete sample}
10436 proc selfontfam {} {
10437 global fonttop fontparam
10439 set i [$fonttop.f.fam curselection]
10441 set fontparam(family) [$fonttop.f.fam get $i]
10445 proc chg_fontparam {v sub op} {
10448 font config sample -$sub $fontparam($sub)
10452 global maxwidth maxgraphpct
10453 global oldprefs prefstop showneartags showlocalchanges
10454 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10455 global tabstop limitdiffs autoselect extdifftool perfile_attrs
10460 if {[winfo exists $top]} {
10464 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10465 limitdiffs tabstop perfile_attrs hideremotes} {
10466 set oldprefs($v) [set $v]
10469 wm title $top [mc "Gitk preferences"]
10470 make_transient $top .
10471 label $top.ldisp -text [mc "Commit list display options"]
10472 grid $top.ldisp - -sticky w -pady 10
10473 label $top.spacer -text " "
10474 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10476 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10477 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10478 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10480 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10481 grid x $top.maxpctl $top.maxpct -sticky w
10482 checkbutton $top.showlocal -text [mc "Show local changes"] \
10483 -font optionfont -variable showlocalchanges
10484 grid x $top.showlocal -sticky w
10485 checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10486 -font optionfont -variable autoselect
10487 grid x $top.autoselect -sticky w
10489 label $top.ddisp -text [mc "Diff display options"]
10490 grid $top.ddisp - -sticky w -pady 10
10491 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10492 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10493 grid x $top.tabstopl $top.tabstop -sticky w
10494 checkbutton $top.ntag -text [mc "Display nearby tags"] \
10495 -font optionfont -variable showneartags
10496 grid x $top.ntag -sticky w
10497 checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
10498 -font optionfont -variable hideremotes
10499 grid x $top.hideremotes -sticky w
10500 checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10501 -font optionfont -variable limitdiffs
10502 grid x $top.ldiff -sticky w
10503 checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10504 -font optionfont -variable perfile_attrs
10505 grid x $top.lattr -sticky w
10507 entry $top.extdifft -textvariable extdifftool
10508 frame $top.extdifff
10509 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10511 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10512 -command choose_extdiff
10513 pack $top.extdifff.l $top.extdifff.b -side left
10514 grid x $top.extdifff $top.extdifft -sticky w
10516 label $top.cdisp -text [mc "Colors: press to choose"]
10517 grid $top.cdisp - -sticky w -pady 10
10518 label $top.ui -padx 40 -relief sunk -background $uicolor
10519 button $top.uibut -text [mc "Interface"] -font optionfont \
10520 -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
10521 grid x $top.uibut $top.ui -sticky w
10522 label $top.bg -padx 40 -relief sunk -background $bgcolor
10523 button $top.bgbut -text [mc "Background"] -font optionfont \
10524 -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10525 grid x $top.bgbut $top.bg -sticky w
10526 label $top.fg -padx 40 -relief sunk -background $fgcolor
10527 button $top.fgbut -text [mc "Foreground"] -font optionfont \
10528 -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10529 grid x $top.fgbut $top.fg -sticky w
10530 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10531 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10532 -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10533 [list $ctext tag conf d0 -foreground]]
10534 grid x $top.diffoldbut $top.diffold -sticky w
10535 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10536 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10537 -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10538 [list $ctext tag conf dresult -foreground]]
10539 grid x $top.diffnewbut $top.diffnew -sticky w
10540 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10541 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10542 -command [list choosecolor diffcolors 2 $top.hunksep \
10543 [mc "diff hunk header"] \
10544 [list $ctext tag conf hunksep -foreground]]
10545 grid x $top.hunksepbut $top.hunksep -sticky w
10546 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10547 button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10548 -command [list choosecolor markbgcolor {} $top.markbgsep \
10549 [mc "marked line background"] \
10550 [list $ctext tag conf omark -background]]
10551 grid x $top.markbgbut $top.markbgsep -sticky w
10552 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10553 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10554 -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10555 grid x $top.selbgbut $top.selbgsep -sticky w
10557 label $top.cfont -text [mc "Fonts: press to choose"]
10558 grid $top.cfont - -sticky w -pady 10
10559 mkfontdisp mainfont $top [mc "Main font"]
10560 mkfontdisp textfont $top [mc "Diff display font"]
10561 mkfontdisp uifont $top [mc "User interface font"]
10564 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10565 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10566 bind $top <Key-Return> prefsok
10567 bind $top <Key-Escape> prefscan
10568 grid $top.buts.ok $top.buts.can
10569 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10570 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10571 grid $top.buts - - -pady 10 -sticky ew
10572 bind $top <Visibility> "focus $top.buts.ok"
10575 proc choose_extdiff {} {
10578 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10580 set extdifftool $prog
10584 proc choosecolor {v vi w x cmd} {
10587 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10588 -title [mc "Gitk: choose color for %s" $x]]
10589 if {$c eq {}} return
10590 $w conf -background $c
10595 proc setselbg {c} {
10596 global bglist cflist
10597 foreach w $bglist {
10598 $w configure -selectbackground $c
10600 $cflist tag configure highlight \
10601 -background [$cflist cget -selectbackground]
10602 allcanvs itemconf secsel -fill $c
10605 # This sets the background color and the color scheme for the whole UI.
10606 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
10607 # if we don't specify one ourselves, which makes the checkbuttons and
10608 # radiobuttons look bad. This chooses white for selectColor if the
10609 # background color is light, or black if it is dark.
10611 set bg [winfo rgb . $c]
10613 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
10616 tk_setPalette background $c selectColor $selc
10622 foreach w $bglist {
10623 $w conf -background $c
10630 foreach w $fglist {
10631 $w conf -foreground $c
10633 allcanvs itemconf text -fill $c
10634 $canv itemconf circle -outline $c
10635 $canv itemconf markid -outline $c
10639 global oldprefs prefstop
10641 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10642 limitdiffs tabstop perfile_attrs hideremotes} {
10644 set $v $oldprefs($v)
10646 catch {destroy $prefstop}
10652 global maxwidth maxgraphpct
10653 global oldprefs prefstop showneartags showlocalchanges
10654 global fontpref mainfont textfont uifont
10655 global limitdiffs treediffs perfile_attrs
10658 catch {destroy $prefstop}
10662 if {$mainfont ne $fontpref(mainfont)} {
10663 set mainfont $fontpref(mainfont)
10664 parsefont mainfont $mainfont
10665 eval font configure mainfont [fontflags mainfont]
10666 eval font configure mainfontbold [fontflags mainfont 1]
10670 if {$textfont ne $fontpref(textfont)} {
10671 set textfont $fontpref(textfont)
10672 parsefont textfont $textfont
10673 eval font configure textfont [fontflags textfont]
10674 eval font configure textfontbold [fontflags textfont 1]
10676 if {$uifont ne $fontpref(uifont)} {
10677 set uifont $fontpref(uifont)
10678 parsefont uifont $uifont
10679 eval font configure uifont [fontflags uifont]
10682 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10683 if {$showlocalchanges} {
10689 if {$limitdiffs != $oldprefs(limitdiffs) ||
10690 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10691 # treediffs elements are limited by path;
10692 # won't have encodings cached if perfile_attrs was just turned on
10693 catch {unset treediffs}
10695 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10696 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10698 } elseif {$showneartags != $oldprefs(showneartags) ||
10699 $limitdiffs != $oldprefs(limitdiffs)} {
10702 if {$hideremotes != $oldprefs(hideremotes)} {
10707 proc formatdate {d} {
10708 global datetimeformat
10710 set d [clock format $d -format $datetimeformat]
10715 # This list of encoding names and aliases is distilled from
10716 # http://www.iana.org/assignments/character-sets.
10717 # Not all of them are supported by Tcl.
10718 set encoding_aliases {
10719 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10720 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10721 { ISO-10646-UTF-1 csISO10646UTF1 }
10722 { ISO_646.basic:1983 ref csISO646basic1983 }
10723 { INVARIANT csINVARIANT }
10724 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10725 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10726 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10727 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10728 { NATS-DANO iso-ir-9-1 csNATSDANO }
10729 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10730 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10731 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10732 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10733 { ISO-2022-KR csISO2022KR }
10735 { ISO-2022-JP csISO2022JP }
10736 { ISO-2022-JP-2 csISO2022JP2 }
10737 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10738 csISO13JISC6220jp }
10739 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10740 { IT iso-ir-15 ISO646-IT csISO15Italian }
10741 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10742 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10743 { greek7-old iso-ir-18 csISO18Greek7Old }
10744 { latin-greek iso-ir-19 csISO19LatinGreek }
10745 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10746 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10747 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10748 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10749 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10750 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10751 { INIS iso-ir-49 csISO49INIS }
10752 { INIS-8 iso-ir-50 csISO50INIS8 }
10753 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10754 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10755 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10756 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10757 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10758 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10759 csISO60Norwegian1 }
10760 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10761 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10762 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10763 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10764 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10765 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10766 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10767 { greek7 iso-ir-88 csISO88Greek7 }
10768 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10769 { iso-ir-90 csISO90 }
10770 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10771 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10772 csISO92JISC62991984b }
10773 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10774 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10775 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10776 csISO95JIS62291984handadd }
10777 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10778 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10779 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10780 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10781 CP819 csISOLatin1 }
10782 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10783 { T.61-7bit iso-ir-102 csISO102T617bit }
10784 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10785 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10786 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10787 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10788 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10789 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10790 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10791 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10792 arabic csISOLatinArabic }
10793 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10794 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10795 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10796 greek greek8 csISOLatinGreek }
10797 { T.101-G2 iso-ir-128 csISO128T101G2 }
10798 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10800 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10801 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10802 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10803 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10804 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10805 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10806 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10807 csISOLatinCyrillic }
10808 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10809 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10810 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10811 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10812 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10813 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10814 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10815 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10816 { ISO_10367-box iso-ir-155 csISO10367Box }
10817 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10818 { latin-lap lap iso-ir-158 csISO158Lap }
10819 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10820 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10823 { JIS_X0201 X0201 csHalfWidthKatakana }
10824 { KSC5636 ISO646-KR csKSC5636 }
10825 { ISO-10646-UCS-2 csUnicode }
10826 { ISO-10646-UCS-4 csUCS4 }
10827 { DEC-MCS dec csDECMCS }
10828 { hp-roman8 roman8 r8 csHPRoman8 }
10829 { macintosh mac csMacintosh }
10830 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10832 { IBM038 EBCDIC-INT cp038 csIBM038 }
10833 { IBM273 CP273 csIBM273 }
10834 { IBM274 EBCDIC-BE CP274 csIBM274 }
10835 { IBM275 EBCDIC-BR cp275 csIBM275 }
10836 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10837 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10838 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10839 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10840 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10841 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10842 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10843 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10844 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10845 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10846 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10847 { IBM437 cp437 437 csPC8CodePage437 }
10848 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10849 { IBM775 cp775 csPC775Baltic }
10850 { IBM850 cp850 850 csPC850Multilingual }
10851 { IBM851 cp851 851 csIBM851 }
10852 { IBM852 cp852 852 csPCp852 }
10853 { IBM855 cp855 855 csIBM855 }
10854 { IBM857 cp857 857 csIBM857 }
10855 { IBM860 cp860 860 csIBM860 }
10856 { IBM861 cp861 861 cp-is csIBM861 }
10857 { IBM862 cp862 862 csPC862LatinHebrew }
10858 { IBM863 cp863 863 csIBM863 }
10859 { IBM864 cp864 csIBM864 }
10860 { IBM865 cp865 865 csIBM865 }
10861 { IBM866 cp866 866 csIBM866 }
10862 { IBM868 CP868 cp-ar csIBM868 }
10863 { IBM869 cp869 869 cp-gr csIBM869 }
10864 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10865 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10866 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10867 { IBM891 cp891 csIBM891 }
10868 { IBM903 cp903 csIBM903 }
10869 { IBM904 cp904 904 csIBBM904 }
10870 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10871 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10872 { IBM1026 CP1026 csIBM1026 }
10873 { EBCDIC-AT-DE csIBMEBCDICATDE }
10874 { EBCDIC-AT-DE-A csEBCDICATDEA }
10875 { EBCDIC-CA-FR csEBCDICCAFR }
10876 { EBCDIC-DK-NO csEBCDICDKNO }
10877 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10878 { EBCDIC-FI-SE csEBCDICFISE }
10879 { EBCDIC-FI-SE-A csEBCDICFISEA }
10880 { EBCDIC-FR csEBCDICFR }
10881 { EBCDIC-IT csEBCDICIT }
10882 { EBCDIC-PT csEBCDICPT }
10883 { EBCDIC-ES csEBCDICES }
10884 { EBCDIC-ES-A csEBCDICESA }
10885 { EBCDIC-ES-S csEBCDICESS }
10886 { EBCDIC-UK csEBCDICUK }
10887 { EBCDIC-US csEBCDICUS }
10888 { UNKNOWN-8BIT csUnknown8BiT }
10889 { MNEMONIC csMnemonic }
10891 { VISCII csVISCII }
10894 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10895 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10896 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10897 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10898 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10899 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10900 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10901 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10902 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10903 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10904 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10905 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10906 { IBM1047 IBM-1047 }
10907 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10908 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10909 { UNICODE-1-1 csUnicode11 }
10910 { CESU-8 csCESU-8 }
10911 { BOCU-1 csBOCU-1 }
10912 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10913 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10915 { ISO-8859-15 ISO_8859-15 Latin-9 }
10916 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10917 { GBK CP936 MS936 windows-936 }
10918 { JIS_Encoding csJISEncoding }
10919 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10920 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10922 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10923 { ISO-10646-UCS-Basic csUnicodeASCII }
10924 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10925 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10926 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10927 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10928 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10929 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10930 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10931 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10932 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10933 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10934 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10935 { Ventura-US csVenturaUS }
10936 { Ventura-International csVenturaInternational }
10937 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10938 { PC8-Turkish csPC8Turkish }
10939 { IBM-Symbols csIBMSymbols }
10940 { IBM-Thai csIBMThai }
10941 { HP-Legal csHPLegal }
10942 { HP-Pi-font csHPPiFont }
10943 { HP-Math8 csHPMath8 }
10944 { Adobe-Symbol-Encoding csHPPSMath }
10945 { HP-DeskTop csHPDesktop }
10946 { Ventura-Math csVenturaMath }
10947 { Microsoft-Publishing csMicrosoftPublishing }
10948 { Windows-31J csWindows31J }
10949 { GB2312 csGB2312 }
10953 proc tcl_encoding {enc} {
10954 global encoding_aliases tcl_encoding_cache
10955 if {[info exists tcl_encoding_cache($enc)]} {
10956 return $tcl_encoding_cache($enc)
10958 set names [encoding names]
10959 set lcnames [string tolower $names]
10960 set enc [string tolower $enc]
10961 set i [lsearch -exact $lcnames $enc]
10963 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10964 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10965 set i [lsearch -exact $lcnames $encx]
10969 foreach l $encoding_aliases {
10970 set ll [string tolower $l]
10971 if {[lsearch -exact $ll $enc] < 0} continue
10972 # look through the aliases for one that tcl knows about
10974 set i [lsearch -exact $lcnames $e]
10976 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10977 set i [lsearch -exact $lcnames $ex]
10987 set tclenc [lindex $names $i]
10989 set tcl_encoding_cache($enc) $tclenc
10993 proc gitattr {path attr default} {
10994 global path_attr_cache
10995 if {[info exists path_attr_cache($attr,$path)]} {
10996 set r $path_attr_cache($attr,$path)
10998 set r "unspecified"
10999 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11000 regexp "(.*): $attr: (.*)" $line m f r
11002 set path_attr_cache($attr,$path) $r
11004 if {$r eq "unspecified"} {
11010 proc cache_gitattr {attr pathlist} {
11011 global path_attr_cache
11013 foreach path $pathlist {
11014 if {![info exists path_attr_cache($attr,$path)]} {
11015 lappend newlist $path
11019 if {[tk windowingsystem] == "win32"} {
11020 # windows has a 32k limit on the arguments to a command...
11023 while {$newlist ne {}} {
11024 set head [lrange $newlist 0 [expr {$lim - 1}]]
11025 set newlist [lrange $newlist $lim end]
11026 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11027 foreach row [split $rlist "\n"] {
11028 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11029 if {[string index $path 0] eq "\""} {
11030 set path [encoding convertfrom [lindex $path 0]]
11032 set path_attr_cache($attr,$path) $value
11039 proc get_path_encoding {path} {
11040 global gui_encoding perfile_attrs
11041 set tcl_enc $gui_encoding
11042 if {$path ne {} && $perfile_attrs} {
11043 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11051 # First check that Tcl/Tk is recent enough
11052 if {[catch {package require Tk 8.4} err]} {
11053 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11054 Gitk requires at least Tcl/Tk 8.4." list
11059 set wrcomcmd "git diff-tree --stdin -p --pretty"
11063 set gitencoding [exec git config --get i18n.commitencoding]
11066 set gitencoding [exec git config --get i18n.logoutputencoding]
11068 if {$gitencoding == ""} {
11069 set gitencoding "utf-8"
11071 set tclencoding [tcl_encoding $gitencoding]
11072 if {$tclencoding == {}} {
11073 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11076 set gui_encoding [encoding system]
11078 set enc [exec git config --get gui.encoding]
11080 set tclenc [tcl_encoding $enc]
11081 if {$tclenc ne {}} {
11082 set gui_encoding $tclenc
11084 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11089 if {[tk windowingsystem] eq "aqua"} {
11090 set mainfont {{Lucida Grande} 9}
11091 set textfont {Monaco 9}
11092 set uifont {{Lucida Grande} 9 bold}
11094 set mainfont {Helvetica 9}
11095 set textfont {Courier 9}
11096 set uifont {Helvetica 9 bold}
11099 set findmergefiles 0
11107 set cmitmode "patch"
11108 set wrapcomment "none"
11113 set showlocalchanges 1
11115 set datetimeformat "%Y-%m-%d %H:%M:%S"
11117 set perfile_attrs 0
11119 if {[tk windowingsystem] eq "aqua"} {
11120 set extdifftool "opendiff"
11122 set extdifftool "meld"
11125 set colors {green red blue magenta darkgrey brown orange}
11129 set diffcolors {red "#00a000" blue}
11132 set selectbgcolor gray85
11133 set markbgcolor "#e0e0ff"
11135 set circlecolors {white blue gray blue blue}
11137 # button for popping up context menus
11138 if {[tk windowingsystem] eq "aqua"} {
11139 set ctxbut <Button-2>
11141 set ctxbut <Button-3>
11144 ## For msgcat loading, first locate the installation location.
11145 if { [info exists ::env(GITK_MSGSDIR)] } {
11146 ## Msgsdir was manually set in the environment.
11147 set gitk_msgsdir $::env(GITK_MSGSDIR)
11149 ## Let's guess the prefix from argv0.
11150 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11151 set gitk_libdir [file join $gitk_prefix share gitk lib]
11152 set gitk_msgsdir [file join $gitk_libdir msgs]
11156 ## Internationalization (i18n) through msgcat and gettext. See
11157 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11158 package require msgcat
11159 namespace import ::msgcat::mc
11160 ## And eventually load the actual message catalog
11161 ::msgcat::mcload $gitk_msgsdir
11163 catch {source ~/.gitk}
11165 font create optionfont -family sans-serif -size -12
11167 parsefont mainfont $mainfont
11168 eval font create mainfont [fontflags mainfont]
11169 eval font create mainfontbold [fontflags mainfont 1]
11171 parsefont textfont $textfont
11172 eval font create textfont [fontflags textfont]
11173 eval font create textfontbold [fontflags textfont 1]
11175 parsefont uifont $uifont
11176 eval font create uifont [fontflags uifont]
11182 # check that we can find a .git directory somewhere...
11183 if {[catch {set gitdir [gitdir]}]} {
11184 show_error {} . [mc "Cannot find a git repository here."]
11187 if {![file isdirectory $gitdir]} {
11188 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11193 set selectheadid {}
11196 set cmdline_files {}
11198 set revtreeargscmd {}
11199 foreach arg $argv {
11200 switch -glob -- $arg {
11203 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11206 "--select-commit=*" {
11207 set selecthead [string range $arg 16 end]
11210 set revtreeargscmd [string range $arg 10 end]
11213 lappend revtreeargs $arg
11219 if {$selecthead eq "HEAD"} {
11223 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11224 # no -- on command line, but some arguments (other than --argscmd)
11226 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11227 set cmdline_files [split $f "\n"]
11228 set n [llength $cmdline_files]
11229 set revtreeargs [lrange $revtreeargs 0 end-$n]
11230 # Unfortunately git rev-parse doesn't produce an error when
11231 # something is both a revision and a filename. To be consistent
11232 # with git log and git rev-list, check revtreeargs for filenames.
11233 foreach arg $revtreeargs {
11234 if {[file exists $arg]} {
11235 show_error {} . [mc "Ambiguous argument '%s': both revision\
11236 and filename" $arg]
11241 # unfortunately we get both stdout and stderr in $err,
11242 # so look for "fatal:".
11243 set i [string first "fatal:" $err]
11245 set err [string range $err [expr {$i + 6}] end]
11247 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11252 set nullid "0000000000000000000000000000000000000000"
11253 set nullid2 "0000000000000000000000000000000000000001"
11254 set nullfile "/dev/null"
11256 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11257 set git_version [join [lrange [split [lindex [exec git version] end] .] 0 2] .]
11264 set highlight_paths {}
11266 set searchdirn -forwards
11269 set diffelide {0 0}
11270 set markingmatches 0
11271 set linkentercount 0
11272 set need_redisplay 0
11279 set selectedhlview [mc "None"]
11280 set highlight_related [mc "None"]
11281 set highlight_files {}
11282 set viewfiles(0) {}
11285 set viewargscmd(0) {}
11287 set selectedline {}
11295 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11299 image create photo gitlogo -width 16 -height 16
11301 image create photo gitlogominus -width 4 -height 2
11302 gitlogominus put #C00000 -to 0 0 4 2
11303 gitlogo copy gitlogominus -to 1 5
11304 gitlogo copy gitlogominus -to 6 5
11305 gitlogo copy gitlogominus -to 11 5
11306 image delete gitlogominus
11308 image create photo gitlogoplus -width 4 -height 4
11309 gitlogoplus put #008000 -to 1 0 3 4
11310 gitlogoplus put #008000 -to 0 1 4 3
11311 gitlogo copy gitlogoplus -to 1 9
11312 gitlogo copy gitlogoplus -to 6 9
11313 gitlogo copy gitlogoplus -to 11 9
11314 image delete gitlogoplus
11316 image create photo gitlogo32 -width 32 -height 32
11317 gitlogo32 copy gitlogo -zoom 2 2
11319 wm iconphoto . -default gitlogo gitlogo32
11321 # wait for the window to become visible
11322 tkwait visibility .
11323 wm title . "[file tail $argv0]: [file tail [pwd]]"
11327 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11328 # create a view for the files/dirs specified on the command line
11332 set viewname(1) [mc "Command line"]
11333 set viewfiles(1) $cmdline_files
11334 set viewargs(1) $revtreeargs
11335 set viewargscmd(1) $revtreeargscmd
11339 .bar.view entryconf [mca "Edit view..."] -state normal
11340 .bar.view entryconf [mca "Delete view"] -state normal
11343 if {[info exists permviews]} {
11344 foreach v $permviews {
11347 set viewname($n) [lindex $v 0]
11348 set viewfiles($n) [lindex $v 1]
11349 set viewargs($n) [lindex $v 2]
11350 set viewargscmd($n) [lindex $v 3]
11356 if {[tk windowingsystem] eq "win32"} {