2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright © 2005-2009 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.
14 if {[info exists env
(GIT_DIR
)]} {
17 return [exec git rev-parse
--git-dir]
21 # A simple scheduler for compute-intensive stuff.
22 # The aim is to make sure that event handlers for GUI actions can
23 # run at least every 50-100 ms. Unfortunately fileevent handlers are
24 # run before X event handlers, so reading from a fast source can
25 # make the GUI completely unresponsive.
27 global isonrunq runq currunq
30 if {[info exists isonrunq
($script)]} return
31 if {$runq eq
{} && ![info exists currunq
]} {
34 lappend runq
[list
{} $script]
35 set isonrunq
($script) 1
38 proc filerun
{fd
script} {
39 fileevent
$fd readable
[list filereadable
$fd $script]
42 proc filereadable
{fd
script} {
45 fileevent
$fd readable
{}
46 if {$runq eq
{} && ![info exists currunq
]} {
49 lappend runq
[list
$fd $script]
55 for {set i
0} {$i < [llength
$runq]} {} {
56 if {[lindex
$runq $i 0] eq
$fd} {
57 set runq
[lreplace
$runq $i $i]
65 global isonrunq runq currunq
67 set tstart
[clock clicks
-milliseconds]
69 while {[llength
$runq] > 0} {
70 set fd
[lindex
$runq 0 0]
71 set script [lindex
$runq 0 1]
72 set currunq
[lindex
$runq 0]
73 set runq
[lrange
$runq 1 end
]
74 set repeat
[eval $script]
76 set t1
[clock clicks
-milliseconds]
77 set t
[expr {$t1 - $t0}]
78 if {$repeat ne
{} && $repeat} {
79 if {$fd eq
{} ||
$repeat == 2} {
80 # script returns 1 if it wants to be readded
81 # file readers return 2 if they could do more straight away
82 lappend runq
[list
$fd $script]
84 fileevent
$fd readable
[list filereadable
$fd $script]
86 } elseif
{$fd eq
{}} {
87 unset isonrunq
($script)
90 if {$t1 - $tstart >= 80} break
97 proc reg_instance
{fd
} {
98 global commfd leftover loginstance
100 set i
[incr loginstance
]
106 proc unmerged_files
{files
} {
109 # find the list of unmerged files
113 set fd
[open
"| git ls-files -u" r
]
115 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
118 while {[gets $fd line] >= 0} {
119 set i [string first "\t" $line]
121 set fname [string range $line [expr {$i+1}] end]
122 if {[lsearch -exact $mlist $fname] >= 0} continue
124 if {$files eq {} || [path_filter $files $fname]} {
132 proc parseviewargs {n arglist} {
133 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
141 set origargs $arglist
145 foreach arg $arglist {
152 switch -glob -- $arg {
156 # remove from origargs in case we hit an unknown option
157 set origargs [lreplace $origargs $i $i]
161 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
162 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
163 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
164 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
165 "--ignore-space-change" - "-U*" - "--unified=*" {
166 # These request or affect diff output, which we don't want.
167 # Some could be used to set our defaults for diff display.
168 lappend diffargs
$arg
170 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
171 "--name-only" - "--name-status" - "--color" - "--color-words" -
172 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
173 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
174 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
175 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
176 "--objects" - "--objects-edge" - "--reverse" {
177 # These cause our parsing of git log's output to fail, or else
178 # they're options we want to set ourselves, so ignore them.
180 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
181 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
182 "--full-history" - "--dense" - "--sparse" -
183 "--follow" - "--left-right" - "--encoding=*" {
184 # These are harmless, and some are even useful
187 "--diff-filter=*" - "--no-merges" - "--unpacked" -
188 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
189 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
190 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
191 "--remove-empty" - "--first-parent" - "--cherry-pick" -
192 "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
193 "--simplify-by-decoration" {
194 # These mean that we get a subset of the commits
199 # This appears to be the only one that has a value as a
200 # separate word following it
210 # git rev-parse doesn't understand --merge
211 lappend revargs
--gitk-symmetric-diff-marker MERGE_HEAD...HEAD
213 "--no-replace-objects" {
214 set env
(GIT_NO_REPLACE_OBJECTS
) "1"
217 # Other flag arguments including -<n>
218 if {[string is digit
-strict [string range
$arg 1 end
]]} {
221 # a flag argument that we don't recognize;
222 # that means we can't optimize
228 # Non-flag arguments specify commits or ranges of commits
229 if {[string match
"*...*" $arg]} {
230 lappend revargs
--gitk-symmetric-diff-marker
236 set vdflags
($n) $diffargs
237 set vflags
($n) $glflags
238 set vrevs
($n) $revargs
239 set vfiltered
($n) $filtered
240 set vorigargs
($n) $origargs
244 proc parseviewrevs
{view revs
} {
245 global vposids vnegids
250 if {[catch
{set ids
[eval exec git rev-parse
$revs]} err
]} {
251 # we get stdout followed by stderr in $err
252 # for an unknown rev, git rev-parse echoes it and then errors out
253 set errlines
[split $err "\n"]
255 for {set l
0} {$l < [llength
$errlines]} {incr l
} {
256 set line
[lindex
$errlines $l]
257 if {!([string length
$line] == 40 && [string is xdigit
$line])} {
258 if {[string match
"fatal:*" $line]} {
259 if {[string match
"fatal: ambiguous argument*" $line]
261 if {[llength
$badrev] == 1} {
262 set err
"unknown revision $badrev"
264 set err
"unknown revisions: [join $badrev ", "]"
267 set err
[join [lrange
$errlines $l end
] "\n"]
274 error_popup
"[mc "Error parsing revisions
:"] $err"
281 foreach id
[split $ids "\n"] {
282 if {$id eq
"--gitk-symmetric-diff-marker"} {
284 } elseif
{[string match
"^*" $id]} {
291 lappend neg
[string range
$id 1 end
]
296 lset ret end
$id...
[lindex
$ret end
]
302 set vposids
($view) $pos
303 set vnegids
($view) $neg
307 # Start off a git log process and arrange to read its output
308 proc start_rev_list
{view
} {
309 global startmsecs commitidx viewcomplete curview
311 global viewargs viewargscmd viewfiles vfilelimit
312 global showlocalchanges
313 global viewactive viewinstances vmergeonly
314 global mainheadid viewmainheadid viewmainheadid_orig
315 global vcanopt vflags vrevs vorigargs
318 set startmsecs
[clock clicks
-milliseconds]
319 set commitidx
($view) 0
320 # these are set this way for the error exits
321 set viewcomplete
($view) 1
322 set viewactive
($view) 0
325 set args
$viewargs($view)
326 if {$viewargscmd($view) ne
{}} {
328 set str
[exec sh
-c $viewargscmd($view)]
330 error_popup
"[mc "Error executing
--argscmd command:"] $err"
333 set args
[concat
$args [split $str "\n"]]
335 set vcanopt
($view) [parseviewargs
$view $args]
337 set files
$viewfiles($view)
338 if {$vmergeonly($view)} {
339 set files
[unmerged_files
$files]
342 if {$nr_unmerged == 0} {
343 error_popup
[mc
"No files selected: --merge specified but\
344 no files are unmerged."]
346 error_popup
[mc
"No files selected: --merge specified but\
347 no unmerged files are within file limit."]
352 set vfilelimit
($view) $files
354 if {$vcanopt($view)} {
355 set revs
[parseviewrevs
$view $vrevs($view)]
359 set args
[concat
$vflags($view) $revs]
361 set args
$vorigargs($view)
365 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
366 --parents --boundary $args "--" $files] r
]
368 error_popup
"[mc "Error executing git log
:"] $err"
371 set i
[reg_instance
$fd]
372 set viewinstances
($view) [list
$i]
373 set viewmainheadid
($view) $mainheadid
374 set viewmainheadid_orig
($view) $mainheadid
375 if {$files ne
{} && $mainheadid ne
{}} {
376 get_viewmainhead
$view
378 if {$showlocalchanges && $viewmainheadid($view) ne
{}} {
379 interestedin
$viewmainheadid($view) dodiffindex
381 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
382 if {$tclencoding != {}} {
383 fconfigure
$fd -encoding $tclencoding
385 filerun
$fd [list getcommitlines
$fd $i $view 0]
386 nowbusy
$view [mc
"Reading"]
387 set viewcomplete
($view) 0
388 set viewactive
($view) 1
392 proc stop_instance
{inst
} {
393 global commfd leftover
395 set fd
$commfd($inst)
399 if {$
::tcl_platform
(platform
) eq
{windows
}} {
408 unset leftover
($inst)
411 proc stop_backends
{} {
414 foreach inst
[array names commfd
] {
419 proc stop_rev_list
{view
} {
422 foreach inst
$viewinstances($view) {
425 set viewinstances
($view) {}
428 proc reset_pending_select
{selid
} {
429 global pending_select mainheadid selectheadid
432 set pending_select
$selid
433 } elseif
{$selectheadid ne
{}} {
434 set pending_select
$selectheadid
436 set pending_select
$mainheadid
440 proc getcommits
{selid
} {
441 global canv curview need_redisplay viewactive
444 if {[start_rev_list
$curview]} {
445 reset_pending_select
$selid
446 show_status
[mc
"Reading commits..."]
449 show_status
[mc
"No commits selected"]
453 proc updatecommits
{} {
454 global curview vcanopt vorigargs vfilelimit viewinstances
455 global viewactive viewcomplete tclencoding
456 global startmsecs showneartags showlocalchanges
457 global mainheadid viewmainheadid viewmainheadid_orig pending_select
459 global varcid vposids vnegids vflags vrevs
462 set isworktree
[expr {[exec git rev-parse
--is-inside-work-tree] == "true"}]
465 if {$mainheadid ne
$viewmainheadid_orig($view)} {
466 if {$showlocalchanges} {
469 set viewmainheadid
($view) $mainheadid
470 set viewmainheadid_orig
($view) $mainheadid
471 if {$vfilelimit($view) ne
{}} {
472 get_viewmainhead
$view
475 if {$showlocalchanges} {
478 if {$vcanopt($view)} {
479 set oldpos
$vposids($view)
480 set oldneg
$vnegids($view)
481 set revs
[parseviewrevs
$view $vrevs($view)]
485 # note: getting the delta when negative refs change is hard,
486 # and could require multiple git log invocations, so in that
487 # case we ask git log for all the commits (not just the delta)
488 if {$oldneg eq
$vnegids($view)} {
491 # take out positive refs that we asked for before or
492 # that we have already seen
494 if {[string length
$rev] == 40} {
495 if {[lsearch
-exact $oldpos $rev] < 0
496 && ![info exists varcid
($view,$rev)]} {
501 lappend
$newrevs $rev
504 if {$npos == 0} return
506 set vposids
($view) [lsort
-unique [concat
$oldpos $vposids($view)]]
508 set args
[concat
$vflags($view) $revs --not $oldpos]
510 set args
$vorigargs($view)
513 set fd
[open
[concat | git log
--no-color -z --pretty=raw
$show_notes \
514 --parents --boundary $args "--" $vfilelimit($view)] r
]
516 error_popup
"[mc "Error executing git log
:"] $err"
519 if {$viewactive($view) == 0} {
520 set startmsecs
[clock clicks
-milliseconds]
522 set i
[reg_instance
$fd]
523 lappend viewinstances
($view) $i
524 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
525 if {$tclencoding != {}} {
526 fconfigure
$fd -encoding $tclencoding
528 filerun
$fd [list getcommitlines
$fd $i $view 1]
529 incr viewactive
($view)
530 set viewcomplete
($view) 0
531 reset_pending_select
{}
532 nowbusy
$view [mc
"Reading"]
538 proc reloadcommits
{} {
539 global curview viewcomplete selectedline currentid thickerline
540 global showneartags treediffs commitinterest cached_commitrow
544 if {$selectedline ne
{}} {
548 if {!$viewcomplete($curview)} {
549 stop_rev_list
$curview
553 catch
{unset currentid
}
554 catch
{unset thickerline
}
555 catch
{unset treediffs
}
562 catch
{unset commitinterest
}
563 catch
{unset cached_commitrow
}
564 catch
{unset targetid
}
570 # This makes a string representation of a positive integer which
571 # sorts as a string in numerical order
574 return [format
"%x" $n]
575 } elseif
{$n < 256} {
576 return [format
"x%.2x" $n]
577 } elseif
{$n < 65536} {
578 return [format
"y%.4x" $n]
580 return [format
"z%.8x" $n]
583 # Procedures used in reordering commits from git log (without
584 # --topo-order) into the order for display.
586 proc varcinit
{view
} {
587 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
588 global vtokmod varcmod vrowmod varcix vlastins
590 set varcstart
($view) {{}}
591 set vupptr
($view) {0}
592 set vdownptr
($view) {0}
593 set vleftptr
($view) {0}
594 set vbackptr
($view) {0}
595 set varctok
($view) {{}}
596 set varcrow
($view) {{}}
597 set vtokmod
($view) {}
600 set varcix
($view) {{}}
601 set vlastins
($view) {0}
604 proc resetvarcs
{view
} {
605 global varcid varccommits parents children vseedcount ordertok
607 foreach vid
[array names varcid
$view,*] {
612 # some commits might have children but haven't been seen yet
613 foreach vid
[array names children
$view,*] {
616 foreach va
[array names varccommits
$view,*] {
617 unset varccommits
($va)
619 foreach vd
[array names vseedcount
$view,*] {
620 unset vseedcount
($vd)
622 catch
{unset ordertok
}
625 # returns a list of the commits with no children
627 global vdownptr vleftptr varcstart
630 set a
[lindex
$vdownptr($v) 0]
632 lappend ret
[lindex
$varcstart($v) $a]
633 set a
[lindex
$vleftptr($v) $a]
638 proc newvarc
{view id
} {
639 global varcid varctok parents children vdatemode
640 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
641 global commitdata commitinfo vseedcount varccommits vlastins
643 set a
[llength
$varctok($view)]
645 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
646 if {![info exists commitinfo
($id)]} {
647 parsecommit
$id $commitdata($id) 1
649 set cdate
[lindex
$commitinfo($id) 4]
650 if {![string is integer
-strict $cdate]} {
653 if {![info exists vseedcount
($view,$cdate)]} {
654 set vseedcount
($view,$cdate) -1
656 set c
[incr vseedcount
($view,$cdate)]
657 set cdate
[expr {$cdate ^
0xffffffff}]
658 set tok
"s[strrep $cdate][strrep $c]"
663 if {[llength
$children($vid)] > 0} {
664 set kid
[lindex
$children($vid) end
]
665 set k
$varcid($view,$kid)
666 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
669 set tok
[lindex
$varctok($view) $k]
673 set i
[lsearch
-exact $parents($view,$ki) $id]
674 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
675 append tok
[strrep
$j]
677 set c
[lindex
$vlastins($view) $ka]
678 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
680 set b
[lindex
$vdownptr($view) $ka]
682 set b
[lindex
$vleftptr($view) $c]
684 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
686 set b
[lindex
$vleftptr($view) $c]
689 lset vdownptr
($view) $ka $a
690 lappend vbackptr
($view) 0
692 lset vleftptr
($view) $c $a
693 lappend vbackptr
($view) $c
695 lset vlastins
($view) $ka $a
696 lappend vupptr
($view) $ka
697 lappend vleftptr
($view) $b
699 lset vbackptr
($view) $b $a
701 lappend varctok
($view) $tok
702 lappend varcstart
($view) $id
703 lappend vdownptr
($view) 0
704 lappend varcrow
($view) {}
705 lappend varcix
($view) {}
706 set varccommits
($view,$a) {}
707 lappend vlastins
($view) 0
711 proc splitvarc
{p v
} {
712 global varcid varcstart varccommits varctok vtokmod
713 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
715 set oa
$varcid($v,$p)
716 set otok
[lindex
$varctok($v) $oa]
717 set ac
$varccommits($v,$oa)
718 set i
[lsearch
-exact $varccommits($v,$oa) $p]
720 set na
[llength
$varctok($v)]
721 # "%" sorts before "0"...
722 set tok
"$otok%[strrep $i]"
723 lappend varctok
($v) $tok
724 lappend varcrow
($v) {}
725 lappend varcix
($v) {}
726 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
727 set varccommits
($v,$na) [lrange
$ac $i end
]
728 lappend varcstart
($v) $p
729 foreach id
$varccommits($v,$na) {
730 set varcid
($v,$id) $na
732 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
733 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
734 lset vdownptr
($v) $oa $na
735 lset vlastins
($v) $oa 0
736 lappend vupptr
($v) $oa
737 lappend vleftptr
($v) 0
738 lappend vbackptr
($v) 0
739 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
740 lset vupptr
($v) $b $na
742 if {[string compare
$otok $vtokmod($v)] <= 0} {
747 proc renumbervarc
{a v
} {
748 global parents children varctok varcstart varccommits
749 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
751 set t1
[clock clicks
-milliseconds]
757 if {[info exists isrelated
($a)]} {
759 set id
[lindex
$varccommits($v,$a) end
]
760 foreach p
$parents($v,$id) {
761 if {[info exists varcid
($v,$p)]} {
762 set isrelated
($varcid($v,$p)) 1
767 set b
[lindex
$vdownptr($v) $a]
770 set b
[lindex
$vleftptr($v) $a]
772 set a
[lindex
$vupptr($v) $a]
778 if {![info exists kidchanged
($a)]} continue
779 set id
[lindex
$varcstart($v) $a]
780 if {[llength
$children($v,$id)] > 1} {
781 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
784 set oldtok
[lindex
$varctok($v) $a]
785 if {!$vdatemode($v)} {
791 set kid
[last_real_child
$v,$id]
793 set k
$varcid($v,$kid)
794 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
797 set tok
[lindex
$varctok($v) $k]
801 set i
[lsearch
-exact $parents($v,$ki) $id]
802 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
803 append tok
[strrep
$j]
805 if {$tok eq
$oldtok} {
808 set id
[lindex
$varccommits($v,$a) end
]
809 foreach p
$parents($v,$id) {
810 if {[info exists varcid
($v,$p)]} {
811 set kidchanged
($varcid($v,$p)) 1
816 lset varctok
($v) $a $tok
817 set b
[lindex
$vupptr($v) $a]
819 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
822 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
825 set c
[lindex
$vbackptr($v) $a]
826 set d
[lindex
$vleftptr($v) $a]
828 lset vdownptr
($v) $b $d
830 lset vleftptr
($v) $c $d
833 lset vbackptr
($v) $d $c
835 if {[lindex
$vlastins($v) $b] == $a} {
836 lset vlastins
($v) $b $c
838 lset vupptr
($v) $a $ka
839 set c
[lindex
$vlastins($v) $ka]
841 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
843 set b
[lindex
$vdownptr($v) $ka]
845 set b
[lindex
$vleftptr($v) $c]
848 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
850 set b
[lindex
$vleftptr($v) $c]
853 lset vdownptr
($v) $ka $a
854 lset vbackptr
($v) $a 0
856 lset vleftptr
($v) $c $a
857 lset vbackptr
($v) $a $c
859 lset vleftptr
($v) $a $b
861 lset vbackptr
($v) $b $a
863 lset vlastins
($v) $ka $a
866 foreach id
[array names sortkids
] {
867 if {[llength
$children($v,$id)] > 1} {
868 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
872 set t2
[clock clicks
-milliseconds]
873 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
876 # Fix up the graph after we have found out that in view $v,
877 # $p (a commit that we have already seen) is actually the parent
878 # of the last commit in arc $a.
879 proc fix_reversal
{p a v
} {
880 global varcid varcstart varctok vupptr
882 set pa
$varcid($v,$p)
883 if {$p ne
[lindex
$varcstart($v) $pa]} {
885 set pa
$varcid($v,$p)
887 # seeds always need to be renumbered
888 if {[lindex
$vupptr($v) $pa] == 0 ||
889 [string compare
[lindex
$varctok($v) $a] \
890 [lindex
$varctok($v) $pa]] > 0} {
895 proc insertrow
{id p v
} {
896 global cmitlisted children parents varcid varctok vtokmod
897 global varccommits ordertok commitidx numcommits curview
898 global targetid targetrow
902 set cmitlisted
($vid) 1
903 set children
($vid) {}
904 set parents
($vid) [list
$p]
905 set a
[newvarc
$v $id]
907 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
910 lappend varccommits
($v,$a) $id
912 if {[llength
[lappend children
($vp) $id]] > 1} {
913 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
914 catch
{unset ordertok
}
916 fix_reversal
$p $a $v
918 if {$v == $curview} {
919 set numcommits
$commitidx($v)
921 if {[info exists targetid
]} {
922 if {![comes_before
$targetid $p]} {
929 proc insertfakerow
{id p
} {
930 global varcid varccommits parents children cmitlisted
931 global commitidx varctok vtokmod targetid targetrow curview numcommits
935 set i
[lsearch
-exact $varccommits($v,$a) $p]
937 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
940 set children
($v,$id) {}
941 set parents
($v,$id) [list
$p]
942 set varcid
($v,$id) $a
943 lappend children
($v,$p) $id
944 set cmitlisted
($v,$id) 1
945 set numcommits
[incr commitidx
($v)]
946 # note we deliberately don't update varcstart($v) even if $i == 0
947 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
949 if {[info exists targetid
]} {
950 if {![comes_before
$targetid $p]} {
958 proc removefakerow
{id
} {
959 global varcid varccommits parents children commitidx
960 global varctok vtokmod cmitlisted currentid selectedline
961 global targetid curview numcommits
964 if {[llength
$parents($v,$id)] != 1} {
965 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
968 set p
[lindex
$parents($v,$id) 0]
969 set a
$varcid($v,$id)
970 set i
[lsearch
-exact $varccommits($v,$a) $id]
972 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
976 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
977 unset parents
($v,$id)
978 unset children
($v,$id)
979 unset cmitlisted
($v,$id)
980 set numcommits
[incr commitidx
($v) -1]
981 set j
[lsearch
-exact $children($v,$p) $id]
983 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
986 if {[info exist currentid
] && $id eq
$currentid} {
990 if {[info exists targetid
] && $targetid eq
$id} {
997 proc real_children
{vp
} {
998 global children nullid nullid2
1001 foreach id
$children($vp) {
1002 if {$id ne
$nullid && $id ne
$nullid2} {
1009 proc first_real_child
{vp
} {
1010 global children nullid nullid2
1012 foreach id
$children($vp) {
1013 if {$id ne
$nullid && $id ne
$nullid2} {
1020 proc last_real_child
{vp
} {
1021 global children nullid nullid2
1023 set kids
$children($vp)
1024 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
1025 set id
[lindex
$kids $i]
1026 if {$id ne
$nullid && $id ne
$nullid2} {
1033 proc vtokcmp
{v a b
} {
1034 global varctok varcid
1036 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1037 [lindex
$varctok($v) $varcid($v,$b)]]
1040 # This assumes that if lim is not given, the caller has checked that
1041 # arc a's token is less than $vtokmod($v)
1042 proc modify_arc
{v a
{lim
{}}} {
1043 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1046 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
1049 set r
[lindex
$varcrow($v) $a]
1050 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
1053 set vtokmod
($v) [lindex
$varctok($v) $a]
1055 if {$v == $curview} {
1056 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
1057 set a
[lindex
$vupptr($v) $a]
1063 set lim
[llength
$varccommits($v,$a)]
1065 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
1072 proc update_arcrows
{v
} {
1073 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1074 global varcid vrownum varcorder varcix varccommits
1075 global vupptr vdownptr vleftptr varctok
1076 global displayorder parentlist curview cached_commitrow
1078 if {$vrowmod($v) == $commitidx($v)} return
1079 if {$v == $curview} {
1080 if {[llength
$displayorder] > $vrowmod($v)} {
1081 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
1082 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
1084 catch
{unset cached_commitrow
}
1086 set narctot
[expr {[llength
$varctok($v)] - 1}]
1088 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
1089 # go up the tree until we find something that has a row number,
1090 # or we get to a seed
1091 set a
[lindex
$vupptr($v) $a]
1094 set a
[lindex
$vdownptr($v) 0]
1097 set varcorder
($v) [list
$a]
1098 lset varcix
($v) $a 0
1099 lset varcrow
($v) $a 0
1103 set arcn
[lindex
$varcix($v) $a]
1104 if {[llength
$vrownum($v)] > $arcn + 1} {
1105 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
1106 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
1108 set row
[lindex
$varcrow($v) $a]
1112 incr row
[llength
$varccommits($v,$a)]
1113 # go down if possible
1114 set b
[lindex
$vdownptr($v) $a]
1116 # if not, go left, or go up until we can go left
1118 set b
[lindex
$vleftptr($v) $a]
1120 set a
[lindex
$vupptr($v) $a]
1126 lappend vrownum
($v) $row
1127 lappend varcorder
($v) $a
1128 lset varcix
($v) $a $arcn
1129 lset varcrow
($v) $a $row
1131 set vtokmod
($v) [lindex
$varctok($v) $p]
1133 set vrowmod
($v) $row
1134 if {[info exists currentid
]} {
1135 set selectedline
[rowofcommit
$currentid]
1139 # Test whether view $v contains commit $id
1140 proc commitinview
{id v
} {
1143 return [info exists varcid
($v,$id)]
1146 # Return the row number for commit $id in the current view
1147 proc rowofcommit
{id
} {
1148 global varcid varccommits varcrow curview cached_commitrow
1149 global varctok vtokmod
1152 if {![info exists varcid
($v,$id)]} {
1153 puts
"oops rowofcommit no arc for [shortids $id]"
1156 set a
$varcid($v,$id)
1157 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
1160 if {[info exists cached_commitrow
($id)]} {
1161 return $cached_commitrow($id)
1163 set i
[lsearch
-exact $varccommits($v,$a) $id]
1165 puts
"oops didn't find commit [shortids $id] in arc $a"
1168 incr i
[lindex
$varcrow($v) $a]
1169 set cached_commitrow
($id) $i
1173 # Returns 1 if a is on an earlier row than b, otherwise 0
1174 proc comes_before
{a b
} {
1175 global varcid varctok curview
1178 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
1179 ![info exists varcid
($v,$b)]} {
1182 if {$varcid($v,$a) != $varcid($v,$b)} {
1183 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
1184 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
1186 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
1189 proc bsearch
{l elt
} {
1190 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
1195 while {$hi - $lo > 1} {
1196 set mid
[expr {int
(($lo + $hi) / 2)}]
1197 set t
[lindex
$l $mid]
1200 } elseif
{$elt > $t} {
1209 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1210 proc make_disporder
{start end
} {
1211 global vrownum curview commitidx displayorder parentlist
1212 global varccommits varcorder parents vrowmod varcrow
1213 global d_valid_start d_valid_end
1215 if {$end > $vrowmod($curview)} {
1216 update_arcrows
$curview
1218 set ai
[bsearch
$vrownum($curview) $start]
1219 set start
[lindex
$vrownum($curview) $ai]
1220 set narc
[llength
$vrownum($curview)]
1221 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
1222 set a
[lindex
$varcorder($curview) $ai]
1223 set l
[llength
$displayorder]
1224 set al
[llength
$varccommits($curview,$a)]
1225 if {$l < $r + $al} {
1227 set pad
[ntimes
[expr {$r - $l}] {}]
1228 set displayorder
[concat
$displayorder $pad]
1229 set parentlist
[concat
$parentlist $pad]
1230 } elseif
{$l > $r} {
1231 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
1232 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
1234 foreach id
$varccommits($curview,$a) {
1235 lappend displayorder
$id
1236 lappend parentlist
$parents($curview,$id)
1238 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
1240 foreach id
$varccommits($curview,$a) {
1241 lset displayorder
$i $id
1242 lset parentlist
$i $parents($curview,$id)
1250 proc commitonrow
{row
} {
1253 set id
[lindex
$displayorder $row]
1255 make_disporder
$row [expr {$row + 1}]
1256 set id
[lindex
$displayorder $row]
1261 proc closevarcs
{v
} {
1262 global varctok varccommits varcid parents children
1263 global cmitlisted commitidx vtokmod
1265 set missing_parents
0
1267 set narcs
[llength
$varctok($v)]
1268 for {set a
1} {$a < $narcs} {incr a
} {
1269 set id
[lindex
$varccommits($v,$a) end
]
1270 foreach p
$parents($v,$id) {
1271 if {[info exists varcid
($v,$p)]} continue
1272 # add p as a new commit
1273 incr missing_parents
1274 set cmitlisted
($v,$p) 0
1275 set parents
($v,$p) {}
1276 if {[llength
$children($v,$p)] == 1 &&
1277 [llength
$parents($v,$id)] == 1} {
1280 set b
[newvarc
$v $p]
1282 set varcid
($v,$p) $b
1283 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1286 lappend varccommits
($v,$b) $p
1288 set scripts
[check_interest
$p $scripts]
1291 if {$missing_parents > 0} {
1292 foreach s
$scripts {
1298 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1299 # Assumes we already have an arc for $rwid.
1300 proc rewrite_commit
{v id rwid
} {
1301 global children parents varcid varctok vtokmod varccommits
1303 foreach ch
$children($v,$id) {
1304 # make $rwid be $ch's parent in place of $id
1305 set i
[lsearch
-exact $parents($v,$ch) $id]
1307 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1309 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1310 # add $ch to $rwid's children and sort the list if necessary
1311 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1312 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1313 $children($v,$rwid)]
1315 # fix the graph after joining $id to $rwid
1316 set a
$varcid($v,$ch)
1317 fix_reversal
$rwid $a $v
1318 # parentlist is wrong for the last element of arc $a
1319 # even if displayorder is right, hence the 3rd arg here
1320 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1324 # Mechanism for registering a command to be executed when we come
1325 # across a particular commit. To handle the case when only the
1326 # prefix of the commit is known, the commitinterest array is now
1327 # indexed by the first 4 characters of the ID. Each element is a
1328 # list of id, cmd pairs.
1329 proc interestedin
{id cmd
} {
1330 global commitinterest
1332 lappend commitinterest
([string range
$id 0 3]) $id $cmd
1335 proc check_interest
{id scripts
} {
1336 global commitinterest
1338 set prefix
[string range
$id 0 3]
1339 if {[info exists commitinterest
($prefix)]} {
1341 foreach
{i
script} $commitinterest($prefix) {
1342 if {[string match
"$i*" $id]} {
1343 lappend scripts
[string map
[list
"%I" $id "%P" $i] $script]
1345 lappend newlist
$i $script
1348 if {$newlist ne
{}} {
1349 set commitinterest
($prefix) $newlist
1351 unset commitinterest
($prefix)
1357 proc getcommitlines
{fd inst view updating
} {
1358 global cmitlisted leftover
1359 global commitidx commitdata vdatemode
1360 global parents children curview hlview
1361 global idpending ordertok
1362 global varccommits varcid varctok vtokmod vfilelimit
1364 set stuff
[read $fd 500000]
1365 # git log doesn't terminate the last commit with a null...
1366 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1373 global commfd viewcomplete viewactive viewname
1374 global viewinstances
1376 set i
[lsearch
-exact $viewinstances($view) $inst]
1378 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1380 # set it blocking so we wait for the process to terminate
1381 fconfigure
$fd -blocking 1
1382 if {[catch
{close
$fd} err
]} {
1384 if {$view != $curview} {
1385 set fv
" for the \"$viewname($view)\" view"
1387 if {[string range
$err 0 4] == "usage"} {
1388 set err
"Gitk: error reading commits$fv:\
1389 bad arguments to git log."
1390 if {$viewname($view) eq
"Command line"} {
1392 " (Note: arguments to gitk are passed to git log\
1393 to allow selection of commits to be displayed.)"
1396 set err
"Error reading commits$fv: $err"
1400 if {[incr viewactive
($view) -1] <= 0} {
1401 set viewcomplete
($view) 1
1402 # Check if we have seen any ids listed as parents that haven't
1403 # appeared in the list
1407 if {$view == $curview} {
1416 set i
[string first
"\0" $stuff $start]
1418 append leftover
($inst) [string range
$stuff $start end
]
1422 set cmit
$leftover($inst)
1423 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1424 set leftover
($inst) {}
1426 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1428 set start
[expr {$i + 1}]
1429 set j
[string first
"\n" $cmit]
1432 if {$j >= 0 && [string match
"commit *" $cmit]} {
1433 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1434 if {[string match
{[-^
<>]*} $ids]} {
1435 switch
-- [string index
$ids 0] {
1441 set ids
[string range
$ids 1 end
]
1445 if {[string length
$id] != 40} {
1453 if {[string length
$shortcmit] > 80} {
1454 set shortcmit
"[string range $shortcmit 0 80]..."
1456 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1459 set id [lindex $ids 0]
1462 if {!$listed && $updating && ![info exists varcid($vid)] &&
1463 $vfilelimit($view) ne {}} {
1464 # git log doesn't rewrite parents
for unlisted commits
1465 # when doing path limiting, so work around that here
1466 # by working out the rewritten parent with git rev-list
1467 # and if we already know about it, using the rewritten
1468 # parent as a substitute parent for $id's children.
1470 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1471 $id -- $vfilelimit($view)]
1473 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1474 # use $rwid in place of $id
1475 rewrite_commit
$view $id $rwid
1482 if {[info exists varcid
($vid)]} {
1483 if {$cmitlisted($vid) ||
!$listed} continue
1487 set olds
[lrange
$ids 1 end
]
1491 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1492 set cmitlisted
($vid) $listed
1493 set parents
($vid) $olds
1494 if {![info exists children
($vid)]} {
1495 set children
($vid) {}
1496 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1497 set k
[lindex
$children($vid) 0]
1498 if {[llength
$parents($view,$k)] == 1 &&
1499 (!$vdatemode($view) ||
1500 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1501 set a
$varcid($view,$k)
1506 set a
[newvarc
$view $id]
1508 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1511 if {![info exists varcid
($vid)]} {
1513 lappend varccommits
($view,$a) $id
1514 incr commitidx
($view)
1519 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1521 if {[llength
[lappend children
($vp) $id]] > 1 &&
1522 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1523 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1525 catch
{unset ordertok
}
1527 if {[info exists varcid
($view,$p)]} {
1528 fix_reversal
$p $a $view
1534 set scripts
[check_interest
$id $scripts]
1538 global numcommits hlview
1540 if {$view == $curview} {
1541 set numcommits
$commitidx($view)
1544 if {[info exists hlview
] && $view == $hlview} {
1545 # we never actually get here...
1548 foreach s
$scripts {
1555 proc chewcommits
{} {
1556 global curview hlview viewcomplete
1557 global pending_select
1560 if {$viewcomplete($curview)} {
1561 global commitidx varctok
1562 global numcommits startmsecs
1564 if {[info exists pending_select
]} {
1566 reset_pending_select
{}
1568 if {[commitinview
$pending_select $curview]} {
1569 selectline
[rowofcommit
$pending_select] 1
1571 set row
[first_real_row
]
1575 if {$commitidx($curview) > 0} {
1576 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1577 #puts "overall $ms ms for $numcommits commits"
1578 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1580 show_status
[mc
"No commits selected"]
1587 proc do_readcommit
{id
} {
1590 # Invoke git-log to handle automatic encoding conversion
1591 set fd
[open
[concat | git log
--no-color --pretty=raw
-1 $id] r
]
1592 # Read the results using i18n.logoutputencoding
1593 fconfigure
$fd -translation lf
-eofchar {}
1594 if {$tclencoding != {}} {
1595 fconfigure
$fd -encoding $tclencoding
1597 set contents
[read $fd]
1599 # Remove the heading line
1600 regsub
{^commit
[0-9a-f]+\n} $contents {} contents
1605 proc readcommit
{id
} {
1606 if {[catch
{set contents
[do_readcommit
$id]}]} return
1607 parsecommit
$id $contents 1
1610 proc parsecommit
{id contents listed
} {
1611 global commitinfo cdate
1620 set hdrend
[string first
"\n\n" $contents]
1622 # should never happen...
1623 set hdrend
[string length
$contents]
1625 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1626 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1627 foreach line
[split $header "\n"] {
1628 set line
[split $line " "]
1629 set tag
[lindex
$line 0]
1630 if {$tag == "author"} {
1631 set audate
[lindex
$line end-1
]
1632 set auname
[join [lrange
$line 1 end-2
] " "]
1633 } elseif
{$tag == "committer"} {
1634 set comdate
[lindex
$line end-1
]
1635 set comname
[join [lrange
$line 1 end-2
] " "]
1639 # take the first non-blank line of the comment as the headline
1640 set headline
[string trimleft
$comment]
1641 set i
[string first
"\n" $headline]
1643 set headline
[string range
$headline 0 $i]
1645 set headline
[string trimright
$headline]
1646 set i
[string first
"\r" $headline]
1648 set headline
[string trimright
[string range
$headline 0 $i]]
1651 # git log indents the comment by 4 spaces;
1652 # if we got this via git cat-file, add the indentation
1654 foreach line
[split $comment "\n"] {
1655 append newcomment
" "
1656 append newcomment
$line
1657 append newcomment
"\n"
1659 set comment
$newcomment
1661 if {$comdate != {}} {
1662 set cdate
($id) $comdate
1664 set commitinfo
($id) [list
$headline $auname $audate \
1665 $comname $comdate $comment]
1668 proc getcommit
{id
} {
1669 global commitdata commitinfo
1671 if {[info exists commitdata
($id)]} {
1672 parsecommit
$id $commitdata($id) 1
1675 if {![info exists commitinfo
($id)]} {
1676 set commitinfo
($id) [list
[mc
"No commit information available"]]
1682 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1683 # and are present in the current view.
1684 # This is fairly slow...
1685 proc longid
{prefix
} {
1686 global varcid curview
1689 foreach match
[array names varcid
"$curview,$prefix*"] {
1690 lappend ids
[lindex
[split $match ","] 1]
1696 global tagids idtags headids idheads tagobjid
1697 global otherrefids idotherrefs mainhead mainheadid
1698 global selecthead selectheadid
1701 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1704 set refd
[open
[list | git show-ref
-d] r
]
1705 while {[gets
$refd line
] >= 0} {
1706 if {[string index
$line 40] ne
" "} continue
1707 set id
[string range
$line 0 39]
1708 set ref
[string range
$line 41 end
]
1709 if {![string match
"refs/*" $ref]} continue
1710 set name
[string range
$ref 5 end
]
1711 if {[string match
"remotes/*" $name]} {
1712 if {![string match
"*/HEAD" $name] && !$hideremotes} {
1713 set headids
($name) $id
1714 lappend idheads
($id) $name
1716 } elseif
{[string match
"heads/*" $name]} {
1717 set name
[string range
$name 6 end
]
1718 set headids
($name) $id
1719 lappend idheads
($id) $name
1720 } elseif
{[string match
"tags/*" $name]} {
1721 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1722 # which is what we want since the former is the commit ID
1723 set name
[string range
$name 5 end
]
1724 if {[string match
"*^{}" $name]} {
1725 set name
[string range
$name 0 end-3
]
1727 set tagobjid
($name) $id
1729 set tagids
($name) $id
1730 lappend idtags
($id) $name
1732 set otherrefids
($name) $id
1733 lappend idotherrefs
($id) $name
1740 set mainheadid
[exec git rev-parse HEAD
]
1741 set thehead
[exec git symbolic-ref HEAD
]
1742 if {[string match
"refs/heads/*" $thehead]} {
1743 set mainhead
[string range
$thehead 11 end
]
1747 if {$selecthead ne
{}} {
1749 set selectheadid
[exec git rev-parse
--verify $selecthead]
1754 # skip over fake commits
1755 proc first_real_row
{} {
1756 global nullid nullid2 numcommits
1758 for {set row
0} {$row < $numcommits} {incr row
} {
1759 set id
[commitonrow
$row]
1760 if {$id ne
$nullid && $id ne
$nullid2} {
1767 # update things for a head moved to a child of its previous location
1768 proc movehead
{id name
} {
1769 global headids idheads
1771 removehead
$headids($name) $name
1772 set headids
($name) $id
1773 lappend idheads
($id) $name
1776 # update things when a head has been removed
1777 proc removehead
{id name
} {
1778 global headids idheads
1780 if {$idheads($id) eq
$name} {
1783 set i
[lsearch
-exact $idheads($id) $name]
1785 set idheads
($id) [lreplace
$idheads($id) $i $i]
1788 unset headids
($name)
1791 proc ttk_toplevel
{w args
} {
1793 eval [linsert
$args 0 ::toplevel
$w]
1795 place
[ttk
::frame
$w._toplevel_background
] -x 0 -y 0 -relwidth 1 -relheight 1
1800 proc make_transient
{window origin
} {
1803 # In MacOS Tk 8.4 transient appears to work by setting
1804 # overrideredirect, which is utterly useless, since the
1805 # windows get no border, and are not even kept above
1807 if {!$have_tk85 && [tk windowingsystem
] eq
{aqua
}} return
1809 wm transient
$window $origin
1811 # Windows fails to place transient windows normally, so
1812 # schedule a callback to center them on the parent.
1813 if {[tk windowingsystem
] eq
{win32
}} {
1814 after idle
[list tk
::PlaceWindow
$window widget
$origin]
1818 proc show_error
{w top msg
{mc mc
}} {
1820 if {![info exists NS
]} {set NS
""}
1821 if {[wm state
$top] eq
"withdrawn"} { wm deiconify
$top }
1822 message
$w.m
-text $msg -justify center
-aspect 400
1823 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1824 ${NS}::button
$w.ok
-default active
-text [$mc OK
] -command "destroy $top"
1825 pack
$w.ok
-side bottom
-fill x
1826 bind $top <Visibility
> "grab $top; focus $top"
1827 bind $top <Key-Return
> "destroy $top"
1828 bind $top <Key-space
> "destroy $top"
1829 bind $top <Key-Escape
> "destroy $top"
1833 proc error_popup
{msg
{owner .
}} {
1834 if {[tk windowingsystem
] eq
"win32"} {
1835 tk_messageBox
-icon error
-type ok
-title [wm title .
] \
1836 -parent $owner -message $msg
1840 make_transient
$w $owner
1841 show_error
$w $w $msg
1845 proc confirm_popup
{msg
{owner .
}} {
1846 global confirm_ok NS
1850 make_transient
$w $owner
1851 message
$w.m
-text $msg -justify center
-aspect 400
1852 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1853 ${NS}::button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1854 pack
$w.ok
-side left
-fill x
1855 ${NS}::button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1856 pack
$w.cancel
-side right
-fill x
1857 bind $w <Visibility
> "grab $w; focus $w"
1858 bind $w <Key-Return
> "set confirm_ok 1; destroy $w"
1859 bind $w <Key-space
> "set confirm_ok 1; destroy $w"
1860 bind $w <Key-Escape
> "destroy $w"
1861 tk
::PlaceWindow
$w widget
$owner
1866 proc setoptions
{} {
1867 if {[tk windowingsystem
] ne
"win32"} {
1868 option add
*Panedwindow.showHandle
1 startupFile
1869 option add
*Panedwindow.sashRelief raised startupFile
1870 if {[tk windowingsystem
] ne
"aqua"} {
1871 option add
*Menu.font uifont startupFile
1874 option add
*Menu.TearOff
0 startupFile
1876 option add
*Button.font uifont startupFile
1877 option add
*Checkbutton.font uifont startupFile
1878 option add
*Radiobutton.font uifont startupFile
1879 option add
*Menubutton.font uifont startupFile
1880 option add
*Label.font uifont startupFile
1881 option add
*Message.font uifont startupFile
1882 option add
*Entry.font textfont startupFile
1883 option add
*Text.font textfont startupFile
1884 option add
*Labelframe.font uifont startupFile
1885 option add
*Spinbox.font textfont startupFile
1886 option add
*Listbox.font mainfont startupFile
1889 # Make a menu and submenus.
1890 # m is the window name for the menu, items is the list of menu items to add.
1891 # Each item is a list {mc label type description options...}
1892 # mc is ignored; it's so we can put mc there to alert xgettext
1893 # label is the string that appears in the menu
1894 # type is cascade, command or radiobutton (should add checkbutton)
1895 # description depends on type; it's the sublist for cascade, the
1896 # command to invoke for command, or {variable value} for radiobutton
1897 proc makemenu
{m items
} {
1899 if {[tk windowingsystem
] eq
{aqua
}} {
1905 set name
[mc
[lindex
$i 1]]
1906 set type [lindex
$i 2]
1907 set thing
[lindex
$i 3]
1908 set params
[list
$type]
1910 set u
[string first
"&" [string map
{&& x
} $name]]
1911 lappend params
-label [string map
{&& & & {}} $name]
1913 lappend params
-underline $u
1918 set submenu
[string tolower
[string map
{& ""} [lindex
$i 1]]]
1919 lappend params
-menu $m.
$submenu
1922 lappend params
-command $thing
1925 lappend params
-variable [lindex
$thing 0] \
1926 -value [lindex
$thing 1]
1929 set tail [lrange
$i 4 end
]
1930 regsub
-all {\yMeta1\y
} $tail $Meta1 tail
1931 eval $m add
$params $tail
1932 if {$type eq
"cascade"} {
1933 makemenu
$m.
$submenu $thing
1938 # translate string and remove ampersands
1940 return [string map
{&& & & {}} [mc
$str]]
1943 proc makedroplist
{w varname args
} {
1947 foreach label
$args {
1948 set cx
[string length
$label]
1949 if {$cx > $width} {set width
$cx}
1951 set gm
[ttk
::combobox
$w -width $width -state readonly\
1952 -textvariable $varname -values $args]
1954 set gm
[eval [linsert
$args 0 tk_optionMenu
$w $varname]]
1959 proc makewindow
{} {
1960 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1962 global findtype findtypemenu findloc findstring fstring geometry
1963 global entries sha1entry sha1string sha1but
1964 global diffcontextstring diffcontext
1966 global maincursor textcursor curtextcursor
1967 global rowctxmenu fakerowmenu mergemax wrapcomment
1968 global highlight_files gdttype
1969 global searchstring sstring
1970 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1971 global headctxmenu progresscanv progressitem progresscoords statusw
1972 global fprogitem fprogcoord lastprogupdate progupdatepending
1973 global rprogitem rprogcoord rownumsel numcommits
1974 global have_tk85 use_ttk NS
1976 # The "mc" arguments here are purely so that xgettext
1977 # sees the following string as needing to be translated
1980 {mc
"Update" command updatecommits
-accelerator F5
}
1981 {mc
"Reload" command reloadcommits
-accelerator Meta1-F5
}
1982 {mc
"Reread references" command rereadrefs
}
1983 {mc
"List references" command showrefs
-accelerator F2
}
1985 {mc
"Start git gui" command {exec git gui
&}}
1987 {mc
"Quit" command doquit
-accelerator Meta1-Q
}
1991 {mc
"Preferences" command doprefs
}
1995 {mc
"New view..." command {newview
0} -accelerator Shift-F4
}
1996 {mc
"Edit view..." command editview
-state disabled
-accelerator F4
}
1997 {mc
"Delete view" command delview
-state disabled
}
1999 {mc
"All files" radiobutton
{selectedview
0} -command {showview
0}}
2001 if {[tk windowingsystem
] ne
"aqua"} {
2004 {mc
"About gitk" command about
}
2005 {mc
"Key bindings" command keys
}
2007 set bar
[list
$file $edit $view $help]
2009 proc
::tk
::mac
::ShowPreferences
{} {doprefs
}
2010 proc
::tk
::mac
::Quit
{} {doquit
}
2011 lset
file end
[lreplace
[lindex
$file end
] end-1 end
]
2013 xx
"Apple" cascade
{
2014 {mc
"About gitk" command about
}
2019 {mc
"Key bindings" command keys
}
2021 set bar
[list
$apple $file $view $help]
2024 . configure
-menu .bar
2027 # cover the non-themed toplevel with a themed frame.
2028 place
[ttk
::frame ._main_background
] -x 0 -y 0 -relwidth 1 -relheight 1
2031 # the gui has upper and lower half, parts of a paned window.
2032 ${NS}::panedwindow .ctop
-orient vertical
2034 # possibly use assumed geometry
2035 if {![info exists geometry
(pwsash0
)]} {
2036 set geometry
(topheight
) [expr {15 * $linespc}]
2037 set geometry
(topwidth
) [expr {80 * $charspc}]
2038 set geometry
(botheight
) [expr {15 * $linespc}]
2039 set geometry
(botwidth
) [expr {50 * $charspc}]
2040 set geometry
(pwsash0
) [list
[expr {40 * $charspc}] 2]
2041 set geometry
(pwsash1
) [list
[expr {60 * $charspc}] 2]
2044 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2045 ${NS}::frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
2046 ${NS}::frame .tf.histframe
2047 ${NS}::panedwindow .tf.histframe.pwclist
-orient horizontal
2049 .tf.histframe.pwclist configure
-sashpad 0 -handlesize 4
2052 # create three canvases
2053 set cscroll .tf.histframe.csb
2054 set canv .tf.histframe.pwclist.canv
2056 -selectbackground $selectbgcolor \
2057 -background $bgcolor -bd 0 \
2058 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2059 .tf.histframe.pwclist add
$canv
2060 set canv2 .tf.histframe.pwclist.canv2
2062 -selectbackground $selectbgcolor \
2063 -background $bgcolor -bd 0 -yscrollincr $linespc
2064 .tf.histframe.pwclist add
$canv2
2065 set canv3 .tf.histframe.pwclist.canv3
2067 -selectbackground $selectbgcolor \
2068 -background $bgcolor -bd 0 -yscrollincr $linespc
2069 .tf.histframe.pwclist add
$canv3
2071 bind .tf.histframe.pwclist
<Map
> {
2073 .tf.histframe.pwclist sashpos
1 [lindex $
::geometry
(pwsash1
) 0]
2074 .tf.histframe.pwclist sashpos
0 [lindex $
::geometry
(pwsash0
) 0]
2077 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
2078 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
2081 # a scroll bar to rule them
2082 ${NS}::scrollbar
$cscroll -command {allcanvs yview
}
2083 if {!$use_ttk} {$cscroll configure
-highlightthickness 0}
2084 pack
$cscroll -side right
-fill y
2085 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
2086 lappend bglist
$canv $canv2 $canv3
2087 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
2089 # we have two button bars at bottom of top frame. Bar 1
2090 ${NS}::frame .tf.bar
2091 ${NS}::frame .tf.lbar
-height 15
2093 set sha1entry .tf.bar.sha1
2094 set entries
$sha1entry
2095 set sha1but .tf.bar.sha1label
2096 button
$sha1but -text "[mc "SHA1 ID
:"] " -state disabled
-relief flat \
2097 -command gotocommit
-width 8
2098 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
2099 pack .tf.bar.sha1label
-side left
2100 ${NS}::entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
2101 trace add variable sha1string
write sha1change
2102 pack
$sha1entry -side left
-pady 2
2104 image create bitmap bm-left
-data {
2105 #define left_width 16
2106 #define left_height 16
2107 static unsigned char left_bits
[] = {
2108 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2109 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2110 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2112 image create bitmap bm-right
-data {
2113 #define right_width 16
2114 #define right_height 16
2115 static unsigned char right_bits
[] = {
2116 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2117 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2118 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2120 ${NS}::button .tf.bar.leftbut
-image bm-left
-command goback \
2121 -state disabled
-width 26
2122 pack .tf.bar.leftbut
-side left
-fill y
2123 ${NS}::button .tf.bar.rightbut
-image bm-right
-command goforw \
2124 -state disabled
-width 26
2125 pack .tf.bar.rightbut
-side left
-fill y
2127 ${NS}::label .tf.bar.rowlabel
-text [mc
"Row"]
2129 ${NS}::label .tf.bar.rownum
-width 7 -textvariable rownumsel \
2130 -relief sunken
-anchor e
2131 ${NS}::label .tf.bar.rowlabel2
-text "/"
2132 ${NS}::label .tf.bar.numcommits
-width 7 -textvariable numcommits \
2133 -relief sunken
-anchor e
2134 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2137 foreach w
{rownum numcommits
} {.tf.bar.
$w configure
-font textfont
}
2140 trace add variable selectedline
write selectedline_change
2142 # Status label and progress bar
2143 set statusw .tf.bar.status
2144 ${NS}::label
$statusw -width 15 -relief sunken
2145 pack
$statusw -side left
-padx 5
2147 set progresscanv
[ttk
::progressbar .tf.bar.progress
]
2149 set h
[expr {[font metrics uifont
-linespace] + 2}]
2150 set progresscanv .tf.bar.progress
2151 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
2152 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
2153 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
2154 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
2156 pack
$progresscanv -side right
-expand 1 -fill x
-padx {0 2}
2157 set progresscoords
{0 0}
2160 bind $progresscanv <Configure
> adjustprogress
2161 set lastprogupdate
[clock clicks
-milliseconds]
2162 set progupdatepending
0
2164 # build up the bottom bar of upper window
2165 ${NS}::label .tf.lbar.flabel
-text "[mc "Find
"] "
2166 ${NS}::button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
2167 ${NS}::button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
2168 ${NS}::label .tf.lbar.flab2
-text " [mc "commit
"] "
2169 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2171 set gdttype
[mc
"containing:"]
2172 set gm
[makedroplist .tf.lbar.gdttype gdttype \
2173 [mc
"containing:"] \
2174 [mc
"touching paths:"] \
2175 [mc
"adding/removing string:"]]
2176 trace add variable gdttype
write gdttype_change
2177 pack .tf.lbar.gdttype
-side left
-fill y
2180 set fstring .tf.lbar.findstring
2181 lappend entries
$fstring
2182 ${NS}::entry
$fstring -width 30 -textvariable findstring
2183 trace add variable findstring
write find_change
2184 set findtype
[mc
"Exact"]
2185 set findtypemenu
[makedroplist .tf.lbar.findtype \
2186 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
2187 trace add variable findtype
write findcom_change
2188 set findloc
[mc
"All fields"]
2189 makedroplist .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
2190 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
2191 trace add variable findloc
write find_change
2192 pack .tf.lbar.findloc
-side right
2193 pack .tf.lbar.findtype
-side right
2194 pack
$fstring -side left
-expand 1 -fill x
2196 # Finish putting the upper half of the viewer together
2197 pack .tf.lbar
-in .tf
-side bottom
-fill x
2198 pack .tf.bar
-in .tf
-side bottom
-fill x
2199 pack .tf.histframe
-fill both
-side top
-expand 1
2202 .ctop paneconfigure .tf
-height $geometry(topheight
)
2203 .ctop paneconfigure .tf
-width $geometry(topwidth
)
2206 # now build up the bottom
2207 ${NS}::panedwindow .pwbottom
-orient horizontal
2209 # lower left, a text box over search bar, scroll bar to the right
2210 # if we know window height, then that will set the lower text height, otherwise
2211 # we set lower text height which will drive window height
2212 if {[info exists geometry
(main
)]} {
2213 ${NS}::frame .bleft
-width $geometry(botwidth
)
2215 ${NS}::frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
2217 ${NS}::frame .bleft.top
2218 ${NS}::frame .bleft.mid
2219 ${NS}::frame .bleft.bottom
2221 ${NS}::button .bleft.top.search
-text [mc
"Search"] -command dosearch
2222 pack .bleft.top.search
-side left
-padx 5
2223 set sstring .bleft.top.sstring
2225 ${NS}::entry
$sstring -width 20 -textvariable searchstring
2226 lappend entries
$sstring
2227 trace add variable searchstring
write incrsearch
2228 pack
$sstring -side left
-expand 1 -fill x
2229 ${NS}::radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
2230 -command changediffdisp
-variable diffelide
-value {0 0}
2231 ${NS}::radiobutton .bleft.mid.old
-text [mc
"Old version"] \
2232 -command changediffdisp
-variable diffelide
-value {0 1}
2233 ${NS}::radiobutton .bleft.mid.new
-text [mc
"New version"] \
2234 -command changediffdisp
-variable diffelide
-value {1 0}
2235 ${NS}::label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
2236 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
2237 spinbox .bleft.mid.diffcontext
-width 5 \
2238 -from 0 -increment 1 -to 10000000 \
2239 -validate all
-validatecommand "diffcontextvalidate %P" \
2240 -textvariable diffcontextstring
2241 .bleft.mid.diffcontext
set $diffcontext
2242 trace add variable diffcontextstring
write diffcontextchange
2243 lappend entries .bleft.mid.diffcontext
2244 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
2245 ${NS}::checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
2246 -command changeignorespace
-variable ignorespace
2247 pack .bleft.mid.ignspace
-side left
-padx 5
2248 set ctext .bleft.bottom.ctext
2249 text
$ctext -background $bgcolor -foreground $fgcolor \
2250 -state disabled
-font textfont \
2251 -yscrollcommand scrolltext
-wrap none \
2252 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2254 $ctext conf
-tabstyle wordprocessor
2256 ${NS}::scrollbar .bleft.bottom.sb
-command "$ctext yview"
2257 ${NS}::scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h
2258 pack .bleft.top
-side top
-fill x
2259 pack .bleft.mid
-side top
-fill x
2260 grid
$ctext .bleft.bottom.sb
-sticky nsew
2261 grid .bleft.bottom.sbhorizontal
-sticky ew
2262 grid columnconfigure .bleft.bottom
0 -weight 1
2263 grid rowconfigure .bleft.bottom
0 -weight 1
2264 grid rowconfigure .bleft.bottom
1 -weight 0
2265 pack .bleft.bottom
-side top
-fill both
-expand 1
2266 lappend bglist
$ctext
2267 lappend fglist
$ctext
2269 $ctext tag conf comment
-wrap $wrapcomment
2270 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
2271 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
2272 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
2273 $ctext tag conf dresult
-fore [lindex
$diffcolors 1]
2274 $ctext tag conf m0
-fore red
2275 $ctext tag conf m1
-fore blue
2276 $ctext tag conf m2
-fore green
2277 $ctext tag conf m3
-fore purple
2278 $ctext tag conf
m4 -fore brown
2279 $ctext tag conf m5
-fore "#009090"
2280 $ctext tag conf m6
-fore magenta
2281 $ctext tag conf m7
-fore "#808000"
2282 $ctext tag conf m8
-fore "#009000"
2283 $ctext tag conf m9
-fore "#ff0080"
2284 $ctext tag conf m10
-fore cyan
2285 $ctext tag conf m11
-fore "#b07070"
2286 $ctext tag conf m12
-fore "#70b0f0"
2287 $ctext tag conf m13
-fore "#70f0b0"
2288 $ctext tag conf m14
-fore "#f0b070"
2289 $ctext tag conf m15
-fore "#ff70b0"
2290 $ctext tag conf mmax
-fore darkgrey
2292 $ctext tag conf mresult
-font textfontbold
2293 $ctext tag conf msep
-font textfontbold
2294 $ctext tag conf found
-back yellow
2296 .pwbottom add .bleft
2298 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
2302 ${NS}::frame .bright
2303 ${NS}::frame .bright.mode
2304 ${NS}::radiobutton .bright.mode.
patch -text [mc
"Patch"] \
2305 -command reselectline
-variable cmitmode
-value "patch"
2306 ${NS}::radiobutton .bright.mode.tree
-text [mc
"Tree"] \
2307 -command reselectline
-variable cmitmode
-value "tree"
2308 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
2309 pack .bright.mode
-side top
-fill x
2310 set cflist .bright.cfiles
2311 set indent
[font measure mainfont
"nn"]
2313 -selectbackground $selectbgcolor \
2314 -background $bgcolor -foreground $fgcolor \
2316 -tabs [list
$indent [expr {2 * $indent}]] \
2317 -yscrollcommand ".bright.sb set" \
2318 -cursor [. cget
-cursor] \
2319 -spacing1 1 -spacing3 1
2320 lappend bglist
$cflist
2321 lappend fglist
$cflist
2322 ${NS}::scrollbar .bright.sb
-command "$cflist yview"
2323 pack .bright.sb
-side right
-fill y
2324 pack
$cflist -side left
-fill both
-expand 1
2325 $cflist tag configure highlight \
2326 -background [$cflist cget
-selectbackground]
2327 $cflist tag configure bold
-font mainfontbold
2329 .pwbottom add .bright
2332 # restore window width & height if known
2333 if {[info exists geometry
(main
)]} {
2334 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
2335 if {$w > [winfo screenwidth .
]} {
2336 set w
[winfo screenwidth .
]
2338 if {$h > [winfo screenheight .
]} {
2339 set h
[winfo screenheight .
]
2341 wm geometry .
"${w}x$h"
2345 if {[info exists geometry
(state
)] && $geometry(state
) eq
"zoomed"} {
2346 wm state .
$geometry(state
)
2349 if {[tk windowingsystem
] eq
{aqua
}} {
2360 %W sashpos
0 $
::geometry
(topheight
)
2362 bind .pwbottom
<Map
> {
2364 %W sashpos
0 $
::geometry
(botwidth
)
2368 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
2369 pack .ctop
-fill both
-expand 1
2370 bindall
<1> {selcanvline
%W
%x
%y
}
2371 #bindall <B1-Motion> {selcanvline %W %x %y}
2372 if {[tk windowingsystem
] == "win32"} {
2373 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
2374 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
2376 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
2377 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
2378 if {[tk windowingsystem
] eq
"aqua"} {
2379 bindall
<MouseWheel
> {
2380 set delta
[expr {- (%D
)}]
2381 allcanvs yview scroll
$delta units
2383 bindall
<Shift-MouseWheel
> {
2384 set delta
[expr {- (%D
)}]
2385 $canv xview scroll
$delta units
2389 bindall
<$
::BM
> "canvscan mark %W %x %y"
2390 bindall
<B$
::BM-Motion
> "canvscan dragto %W %x %y"
2391 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2392 bind .
<$M1B-Key-w> doquit
2393 bindkey
<Home
> selfirstline
2394 bindkey
<End
> sellastline
2395 bind .
<Key-Up
> "selnextline -1"
2396 bind .
<Key-Down
> "selnextline 1"
2397 bind .
<Shift-Key-Up
> "dofind -1 0"
2398 bind .
<Shift-Key-Down
> "dofind 1 0"
2399 bindkey
<Key-Right
> "goforw"
2400 bindkey
<Key-Left
> "goback"
2401 bind .
<Key-Prior
> "selnextpage -1"
2402 bind .
<Key-Next
> "selnextpage 1"
2403 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
2404 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
2405 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
2406 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
2407 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2408 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2409 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
2410 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
2411 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
2412 bindkey p
"selnextline -1"
2413 bindkey n
"selnextline 1"
2416 bindkey i
"selnextline -1"
2417 bindkey k
"selnextline 1"
2421 bindkey d
"$ctext yview scroll 18 units"
2422 bindkey u
"$ctext yview scroll -18 units"
2423 bindkey
/ {focus
$fstring}
2424 bindkey
<Key-KP_Divide
> {focus
$fstring}
2425 bindkey
<Key-Return
> {dofind
1 1}
2426 bindkey ?
{dofind
-1 1}
2428 bind .
<F5
> updatecommits
2429 bind .
<$M1B-F5> reloadcommits
2430 bind .
<F2
> showrefs
2431 bind .
<Shift-F4
> {newview
0}
2432 catch
{ bind .
<Shift-Key-XF86_Switch_VT_4
> {newview
0} }
2433 bind .
<F4
> edit_or_newview
2434 bind .
<$M1B-q> doquit
2435 bind .
<$M1B-f> {dofind
1 1}
2436 bind .
<$M1B-g> {dofind
1 0}
2437 bind .
<$M1B-r> dosearchback
2438 bind .
<$M1B-s> dosearch
2439 bind .
<$M1B-equal> {incrfont
1}
2440 bind .
<$M1B-plus> {incrfont
1}
2441 bind .
<$M1B-KP_Add> {incrfont
1}
2442 bind .
<$M1B-minus> {incrfont
-1}
2443 bind .
<$M1B-KP_Subtract> {incrfont
-1}
2444 wm protocol . WM_DELETE_WINDOW doquit
2445 bind .
<Destroy
> {stop_backends
}
2446 bind .
<Button-1
> "click %W"
2447 bind $fstring <Key-Return
> {dofind
1 1}
2448 bind $sha1entry <Key-Return
> {gotocommit
; break}
2449 bind $sha1entry <<PasteSelection>> clearsha1
2450 bind $cflist <1> {sel_flist %W %x %y; break}
2451 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2452 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2454 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2455 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2457 set maincursor [. cget -cursor]
2458 set textcursor [$ctext cget -cursor]
2459 set curtextcursor $textcursor
2461 set rowctxmenu .rowctxmenu
2462 makemenu $rowctxmenu {
2463 {mc "Diff this -> selected" command {diffvssel 0}}
2464 {mc "Diff selected -> this" command {diffvssel 1}}
2465 {mc "Make patch" command mkpatch}
2466 {mc "Create tag" command mktag}
2467 {mc "Write commit to file" command writecommit}
2468 {mc "Create new branch" command mkbranch}
2469 {mc "Cherry-pick this commit" command cherrypick}
2470 {mc "Reset HEAD branch to here" command resethead}
2471 {mc "Mark this commit" command markhere}
2472 {mc "Return to mark" command gotomark}
2473 {mc "Find descendant of this and mark" command find_common_desc}
2474 {mc "Compare with marked commit" command compare_commits}
2476 $rowctxmenu configure -tearoff 0
2478 set fakerowmenu .fakerowmenu
2479 makemenu $fakerowmenu {
2480 {mc "Diff this -> selected" command {diffvssel 0}}
2481 {mc "Diff selected -> this" command {diffvssel 1}}
2482 {mc "Make patch" command mkpatch}
2484 $fakerowmenu configure -tearoff 0
2486 set headctxmenu .headctxmenu
2487 makemenu $headctxmenu {
2488 {mc "Check out this branch" command cobranch}
2489 {mc "Remove this branch" command rmbranch}
2491 $headctxmenu configure -tearoff 0
2494 set flist_menu .flistctxmenu
2495 makemenu $flist_menu {
2496 {mc "Highlight this too" command {flist_hl 0}}
2497 {mc "Highlight this only" command {flist_hl 1}}
2498 {mc "External diff" command {external_diff}}
2499 {mc "Blame parent commit" command {external_blame 1}}
2501 $flist_menu configure -tearoff 0
2504 set diff_menu .diffctxmenu
2505 makemenu $diff_menu {
2506 {mc "Show origin of this line" command show_line_source}
2507 {mc "Run git gui blame on this line" command {external_blame_diff}}
2509 $diff_menu configure -tearoff 0
2512 # Windows sends all mouse wheel events to the current focused window, not
2513 # the one where the mouse hovers, so bind those events here and redirect
2514 # to the correct window
2515 proc windows_mousewheel_redirector {W X Y D} {
2516 global canv canv2 canv3
2517 set w [winfo containing -displayof $W $X $Y]
2519 set u [expr {$D < 0 ? 5 : -5}]
2520 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2521 allcanvs yview scroll $u units
2524 $w yview scroll $u units
2530 # Update row number label when selectedline changes
2531 proc selectedline_change {n1 n2 op} {
2532 global selectedline rownumsel
2534 if {$selectedline eq {}} {
2537 set rownumsel [expr {$selectedline + 1}]
2541 # mouse-2 makes all windows scan vertically, but only the one
2542 # the cursor is in scans horizontally
2543 proc canvscan {op w x y} {
2544 global canv canv2 canv3
2545 foreach c [list $canv $canv2 $canv3] {
2554 proc scrollcanv {cscroll f0 f1} {
2555 $cscroll set $f0 $f1
2560 # when we make a key binding for the toplevel, make sure
2561 # it doesn't get triggered when that key is pressed in the
2562 # find string entry widget.
2563 proc bindkey {ev script} {
2566 set escript [bind Entry $ev]
2567 if {$escript == {}} {
2568 set escript [bind Entry <Key>]
2570 foreach e $entries {
2571 bind $e $ev "$escript; break"
2575 # set the focus back to the toplevel for any click outside
2578 global ctext entries
2579 foreach e [concat $entries $ctext] {
2580 if {$w == $e} return
2585 # Adjust the progress bar for a change in requested extent or canvas size
2586 proc adjustprogress {} {
2587 global progresscanv progressitem progresscoords
2588 global fprogitem fprogcoord lastprogupdate progupdatepending
2589 global rprogitem rprogcoord use_ttk
2592 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2596 set w [expr {[winfo width $progresscanv] - 4}]
2597 set x0 [expr {$w * [lindex $progresscoords 0]}]
2598 set x1 [expr {$w * [lindex $progresscoords 1]}]
2599 set h [winfo height $progresscanv]
2600 $progresscanv coords $progressitem $x0 0 $x1 $h
2601 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2602 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2603 set now [clock clicks -milliseconds]
2604 if {$now >= $lastprogupdate + 100} {
2605 set progupdatepending 0
2607 } elseif {!$progupdatepending} {
2608 set progupdatepending 1
2609 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2613 proc doprogupdate {} {
2614 global lastprogupdate progupdatepending
2616 if {$progupdatepending} {
2617 set progupdatepending 0
2618 set lastprogupdate [clock clicks -milliseconds]
2623 proc savestuff {w} {
2624 global canv canv2 canv3 mainfont textfont uifont tabstop
2625 global stuffsaved findmergefiles maxgraphpct
2626 global maxwidth showneartags showlocalchanges
2627 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2628 global cmitmode wrapcomment datetimeformat limitdiffs
2629 global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2630 global autoselect extdifftool perfile_attrs markbgcolor use_ttk
2631 global hideremotes want_ttk
2633 if {$stuffsaved} return
2634 if {![winfo viewable .]} return
2636 if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2637 set f [open "~/.gitk-new" w]
2638 if {$::tcl_platform(platform) eq {windows}} {
2639 file attributes "~/.gitk-new" -hidden true
2641 puts $f [list set mainfont $mainfont]
2642 puts $f [list set textfont $textfont]
2643 puts $f [list set uifont $uifont]
2644 puts $f [list set tabstop $tabstop]
2645 puts $f [list set findmergefiles $findmergefiles]
2646 puts $f [list set maxgraphpct $maxgraphpct]
2647 puts $f [list set maxwidth $maxwidth]
2648 puts $f [list set cmitmode $cmitmode]
2649 puts $f [list set wrapcomment $wrapcomment]
2650 puts $f [list set autoselect $autoselect]
2651 puts $f [list set showneartags $showneartags]
2652 puts $f [list set hideremotes $hideremotes]
2653 puts $f [list set showlocalchanges $showlocalchanges]
2654 puts $f [list set datetimeformat $datetimeformat]
2655 puts $f [list set limitdiffs $limitdiffs]
2656 puts $f [list set uicolor $uicolor]
2657 puts $f [list set want_ttk $want_ttk]
2658 puts $f [list set bgcolor $bgcolor]
2659 puts $f [list set fgcolor $fgcolor]
2660 puts $f [list set colors $colors]
2661 puts $f [list set diffcolors $diffcolors]
2662 puts $f [list set markbgcolor $markbgcolor]
2663 puts $f [list set diffcontext $diffcontext]
2664 puts $f [list set selectbgcolor $selectbgcolor]
2665 puts $f [list set extdifftool $extdifftool]
2666 puts $f [list set perfile_attrs $perfile_attrs]
2668 puts $f "set geometry(main) [wm geometry .]"
2669 puts $f "set geometry(state) [wm state .]"
2670 puts $f "set geometry(topwidth) [winfo width .tf]"
2671 puts $f "set geometry(topheight) [winfo height .tf]"
2673 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2674 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2676 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2677 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2679 puts $f "set geometry(botwidth) [winfo width .bleft]"
2680 puts $f "set geometry(botheight) [winfo height .bleft]"
2682 puts -nonewline $f "set permviews {"
2683 for {set v 0} {$v < $nextviewnum} {incr v} {
2684 if {$viewperm($v)} {
2685 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2690 file rename -force "~/.gitk-new" "~/.gitk"
2695 proc resizeclistpanes {win w} {
2696 global oldwidth use_ttk
2697 if {[info exists oldwidth($win)]} {
2699 set s0 [$win sashpos 0]
2700 set s1 [$win sashpos 1]
2702 set s0 [$win sash coord 0]
2703 set s1 [$win sash coord 1]
2706 set sash0 [expr {int($w/2 - 2)}]
2707 set sash1 [expr {int($w*5/6 - 2)}]
2709 set factor [expr {1.0 * $w / $oldwidth($win)}]
2710 set sash0 [expr {int($factor * [lindex $s0 0])}]
2711 set sash1 [expr {int($factor * [lindex $s1 0])}]
2715 if {$sash1 < $sash0 + 20} {
2716 set sash1 [expr {$sash0 + 20}]
2718 if {$sash1 > $w - 10} {
2719 set sash1 [expr {$w - 10}]
2720 if {$sash0 > $sash1 - 20} {
2721 set sash0 [expr {$sash1 - 20}]
2726 $win sashpos 0 $sash0
2727 $win sashpos 1 $sash1
2729 $win sash place 0 $sash0 [lindex $s0 1]
2730 $win sash place 1 $sash1 [lindex $s1 1]
2733 set oldwidth($win) $w
2736 proc resizecdetpanes {win w} {
2737 global oldwidth use_ttk
2738 if {[info exists oldwidth($win)]} {
2740 set s0 [$win sashpos 0]
2742 set s0 [$win sash coord 0]
2745 set sash0 [expr {int($w*3/4 - 2)}]
2747 set factor [expr {1.0 * $w / $oldwidth($win)}]
2748 set sash0 [expr {int($factor * [lindex $s0 0])}]
2752 if {$sash0 > $w - 15} {
2753 set sash0 [expr {$w - 15}]
2757 $win sashpos 0 $sash0
2759 $win sash place 0 $sash0 [lindex $s0 1]
2762 set oldwidth($win) $w
2765 proc allcanvs args {
2766 global canv canv2 canv3
2772 proc bindall {event action} {
2773 global canv canv2 canv3
2774 bind $canv $event $action
2775 bind $canv2 $event $action
2776 bind $canv3 $event $action
2782 if {[winfo exists $w]} {
2787 wm title $w [mc "About gitk"]
2789 message $w.m -text [mc "
2790 Gitk - a commit viewer for git
2792 Copyright \u00a9 2005-2010 Paul Mackerras
2794 Use and redistribute under the terms of the GNU General Public License"] \
2795 -justify center -aspect 400 -border 2 -bg white -relief groove
2796 pack $w.m -side top -fill x -padx 2 -pady 2
2797 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2798 pack $w.ok -side bottom
2799 bind $w <Visibility> "focus $w.ok"
2800 bind $w <Key-Escape> "destroy $w"
2801 bind $w <Key-Return> "destroy $w"
2802 tk::PlaceWindow $w widget .
2808 if {[winfo exists $w]} {
2812 if {[tk windowingsystem] eq {aqua}} {
2818 wm title $w [mc "Gitk key bindings"]
2820 message $w.m -text "
2821 [mc "Gitk key bindings:"]
2823 [mc "<%s-Q> Quit" $M1T]
2824 [mc "<%s-W> Close window" $M1T]
2825 [mc "<Home> Move to first commit"]
2826 [mc "<End> Move to last commit"]
2827 [mc "<Up>, p, i Move up one commit"]
2828 [mc "<Down>, n, k Move down one commit"]
2829 [mc "<Left>, z, j Go back in history list"]
2830 [mc "<Right>, x, l Go forward in history list"]
2831 [mc "<PageUp> Move up one page in commit list"]
2832 [mc "<PageDown> Move down one page in commit list"]
2833 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2834 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2835 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2836 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2837 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2838 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2839 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2840 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2841 [mc "<Delete>, b Scroll diff view up one page"]
2842 [mc "<Backspace> Scroll diff view up one page"]
2843 [mc "<Space> Scroll diff view down one page"]
2844 [mc "u Scroll diff view up 18 lines"]
2845 [mc "d Scroll diff view down 18 lines"]
2846 [mc "<%s-F> Find" $M1T]
2847 [mc "<%s-G> Move to next find hit" $M1T]
2848 [mc "<Return> Move to next find hit"]
2849 [mc "/ Focus the search box"]
2850 [mc "? Move to previous find hit"]
2851 [mc "f Scroll diff view to next file"]
2852 [mc "<%s-S> Search for next hit in diff view" $M1T]
2853 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2854 [mc "<%s-KP+> Increase font size" $M1T]
2855 [mc "<%s-plus> Increase font size" $M1T]
2856 [mc "<%s-KP-> Decrease font size" $M1T]
2857 [mc "<%s-minus> Decrease font size" $M1T]
2860 -justify left -bg white -border 2 -relief groove
2861 pack $w.m -side top -fill both -padx 2 -pady 2
2862 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2863 bind $w <Key-Escape> [list destroy $w]
2864 pack $w.ok -side bottom
2865 bind $w <Visibility> "focus $w.ok"
2866 bind $w <Key-Escape> "destroy $w"
2867 bind $w <Key-Return> "destroy $w"
2870 # Procedures for manipulating the file list window at the
2871 # bottom right of the overall window.
2873 proc treeview {w l openlevs} {
2874 global treecontents treediropen treeheight treeparent treeindex
2884 set treecontents() {}
2885 $w conf -state normal
2887 while {[string range $f 0 $prefixend] ne $prefix} {
2888 if {$lev <= $openlevs} {
2889 $w mark set e:$treeindex($prefix) "end -1c"
2890 $w mark gravity e:$treeindex($prefix) left
2892 set treeheight($prefix) $ht
2893 incr ht [lindex $htstack end]
2894 set htstack [lreplace $htstack end end]
2895 set prefixend [lindex $prefendstack end]
2896 set prefendstack [lreplace $prefendstack end end]
2897 set prefix [string range $prefix 0 $prefixend]
2900 set tail [string range $f [expr {$prefixend+1}] end]
2901 while {[set slash [string first "/" $tail]] >= 0} {
2904 lappend prefendstack $prefixend
2905 incr prefixend [expr {$slash + 1}]
2906 set d [string range $tail 0 $slash]
2907 lappend treecontents($prefix) $d
2908 set oldprefix $prefix
2910 set treecontents($prefix) {}
2911 set treeindex($prefix) [incr ix]
2912 set treeparent($prefix) $oldprefix
2913 set tail [string range $tail [expr {$slash+1}] end]
2914 if {$lev <= $openlevs} {
2916 set treediropen($prefix) [expr {$lev < $openlevs}]
2917 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2918 $w mark set d:$ix "end -1c"
2919 $w mark gravity d:$ix left
2921 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2923 $w image create end -align center -image $bm -padx 1 \
2925 $w insert end $d [highlight_tag $prefix]
2926 $w mark set s:$ix "end -1c"
2927 $w mark gravity s:$ix left
2932 if {$lev <= $openlevs} {
2935 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2937 $w insert end $tail [highlight_tag $f]
2939 lappend treecontents($prefix) $tail
2942 while {$htstack ne {}} {
2943 set treeheight($prefix) $ht
2944 incr ht [lindex $htstack end]
2945 set htstack [lreplace $htstack end end]
2946 set prefixend [lindex $prefendstack end]
2947 set prefendstack [lreplace $prefendstack end end]
2948 set prefix [string range $prefix 0 $prefixend]
2950 $w conf -state disabled
2953 proc linetoelt {l} {
2954 global treeheight treecontents
2959 foreach e $treecontents($prefix) {
2964 if {[string index $e end] eq "/"} {
2965 set n $treeheight($prefix$e)
2977 proc highlight_tree {y prefix} {
2978 global treeheight treecontents cflist
2980 foreach e $treecontents($prefix) {
2982 if {[highlight_tag $path] ne {}} {
2983 $cflist tag add bold $y.0 "$y.0 lineend"
2986 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2987 set y [highlight_tree $y $path]
2993 proc treeclosedir {w dir} {
2994 global treediropen treeheight treeparent treeindex
2996 set ix $treeindex($dir)
2997 $w conf -state normal
2998 $w delete s:$ix e:$ix
2999 set treediropen($dir) 0
3000 $w image configure a:$ix -image tri-rt
3001 $w conf -state disabled
3002 set n [expr {1 - $treeheight($dir)}]
3003 while {$dir ne {}} {
3004 incr treeheight($dir) $n
3005 set dir $treeparent($dir)
3009 proc treeopendir {w dir} {
3010 global treediropen treeheight treeparent treecontents treeindex
3012 set ix $treeindex($dir)
3013 $w conf -state normal
3014 $w image configure a:$ix -image tri-dn
3015 $w mark set e:$ix s:$ix
3016 $w mark gravity e:$ix right
3019 set n [llength $treecontents($dir)]
3020 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3023 incr treeheight($x) $n
3025 foreach e $treecontents($dir) {
3027 if {[string index $e end] eq "/"} {
3028 set iy $treeindex($de)
3029 $w mark set d:$iy e:$ix
3030 $w mark gravity d:$iy left
3031 $w insert e:$ix $str
3032 set treediropen($de) 0
3033 $w image create e:$ix -align center -image tri-rt -padx 1 \
3035 $w insert e:$ix $e [highlight_tag $de]
3036 $w mark set s:$iy e:$ix
3037 $w mark gravity s:$iy left
3038 set treeheight($de) 1
3040 $w insert e:$ix $str
3041 $w insert e:$ix $e [highlight_tag $de]
3044 $w mark gravity e:$ix right
3045 $w conf -state disabled
3046 set treediropen($dir) 1
3047 set top [lindex [split [$w index @0,0] .] 0]
3048 set ht [$w cget -height]
3049 set l [lindex [split [$w index s:$ix] .] 0]
3052 } elseif {$l + $n + 1 > $top + $ht} {
3053 set top [expr {$l + $n + 2 - $ht}]
3061 proc treeclick {w x y} {
3062 global treediropen cmitmode ctext cflist cflist_top
3064 if {$cmitmode ne "tree"} return
3065 if {![info exists cflist_top]} return
3066 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3067 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3068 $cflist tag add highlight $l.0 "$l.0 lineend"
3074 set e [linetoelt $l]
3075 if {[string index $e end] ne "/"} {
3077 } elseif {$treediropen($e)} {
3084 proc setfilelist {id} {
3085 global treefilelist cflist jump_to_here
3087 treeview $cflist $treefilelist($id) 0
3088 if {$jump_to_here ne {}} {
3089 set f [lindex $jump_to_here 0]
3090 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3096 image create bitmap tri-rt -background black -foreground blue -data {
3097 #define tri-rt_width 13
3098 #define tri-rt_height 13
3099 static unsigned char tri-rt_bits[] = {
3100 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3101 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3104 #define tri-rt-mask_width 13
3105 #define tri-rt-mask_height 13
3106 static unsigned char tri-rt-mask_bits[] = {
3107 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3108 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3111 image create bitmap tri-dn -background black -foreground blue -data {
3112 #define tri-dn_width 13
3113 #define tri-dn_height 13
3114 static unsigned char tri-dn_bits[] = {
3115 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3116 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3119 #define tri-dn-mask_width 13
3120 #define tri-dn-mask_height 13
3121 static unsigned char tri-dn-mask_bits[] = {
3122 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3123 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3127 image create bitmap reficon-T -background black -foreground yellow -data {
3128 #define tagicon_width 13
3129 #define tagicon_height 9
3130 static unsigned char tagicon_bits[] = {
3131 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3132 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3134 #define tagicon-mask_width 13
3135 #define tagicon-mask_height 9
3136 static unsigned char tagicon-mask_bits[] = {
3137 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3138 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3141 #define headicon_width 13
3142 #define headicon_height 9
3143 static unsigned char headicon_bits[] = {
3144 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3145 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3148 #define headicon-mask_width 13
3149 #define headicon-mask_height 9
3150 static unsigned char headicon-mask_bits[] = {
3151 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3152 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3154 image create bitmap reficon-H -background black -foreground green \
3155 -data $rectdata -maskdata $rectmask
3156 image create bitmap reficon-o -background black -foreground "#ddddff" \
3157 -data $rectdata -maskdata $rectmask
3159 proc init_flist {first} {
3160 global cflist cflist_top difffilestart
3162 $cflist conf -state normal
3163 $cflist delete 0.0 end
3165 $cflist insert end $first
3167 $cflist tag add highlight 1.0 "1.0 lineend"
3169 catch {unset cflist_top}
3171 $cflist conf -state disabled
3172 set difffilestart {}
3175 proc highlight_tag {f} {
3176 global highlight_paths
3178 foreach p $highlight_paths {
3179 if {[string match $p $f]} {
3186 proc highlight_filelist {} {
3187 global cmitmode cflist
3189 $cflist conf -state normal
3190 if {$cmitmode ne "tree"} {
3191 set end [lindex [split [$cflist index end] .] 0]
3192 for {set l 2} {$l < $end} {incr l} {
3193 set line [$cflist get $l.0 "$l.0 lineend"]
3194 if {[highlight_tag $line] ne {}} {
3195 $cflist tag add bold $l.0 "$l.0 lineend"
3201 $cflist conf -state disabled
3204 proc unhighlight_filelist {} {
3207 $cflist conf -state normal
3208 $cflist tag remove bold 1.0 end
3209 $cflist conf -state disabled
3212 proc add_flist {fl} {
3215 $cflist conf -state normal
3217 $cflist insert end "\n"
3218 $cflist insert end $f [highlight_tag $f]
3220 $cflist conf -state disabled
3223 proc sel_flist {w x y} {
3224 global ctext difffilestart cflist cflist_top cmitmode
3226 if {$cmitmode eq "tree"} return
3227 if {![info exists cflist_top]} return
3228 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3229 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3230 $cflist tag add highlight $l.0 "$l.0 lineend"
3235 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3239 proc pop_flist_menu {w X Y x y} {
3240 global ctext cflist cmitmode flist_menu flist_menu_file
3241 global treediffs diffids
3244 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3246 if {$cmitmode eq "tree"} {
3247 set e [linetoelt $l]
3248 if {[string index $e end] eq "/"} return
3250 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3252 set flist_menu_file $e
3253 set xdiffstate "normal"
3254 if {$cmitmode eq "tree"} {
3255 set xdiffstate "disabled"
3257 # Disable "External diff" item in tree mode
3258 $flist_menu entryconf 2 -state $xdiffstate
3259 tk_popup $flist_menu $X $Y
3262 proc find_ctext_fileinfo {line} {
3263 global ctext_file_names ctext_file_lines
3265 set ok [bsearch $ctext_file_lines $line]
3266 set tline [lindex $ctext_file_lines $ok]
3268 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3271 return [list [lindex $ctext_file_names $ok] $tline]
3275 proc pop_diff_menu {w X Y x y} {
3276 global ctext diff_menu flist_menu_file
3277 global diff_menu_txtpos diff_menu_line
3278 global diff_menu_filebase
3280 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3281 set diff_menu_line [lindex $diff_menu_txtpos 0]
3282 # don't pop up the menu on hunk-separator or file-separator lines
3283 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3287 set f [find_ctext_fileinfo $diff_menu_line]
3288 if {$f eq {}} return
3289 set flist_menu_file [lindex $f 0]
3290 set diff_menu_filebase [lindex $f 1]
3291 tk_popup $diff_menu $X $Y
3294 proc flist_hl {only} {
3295 global flist_menu_file findstring gdttype
3297 set x [shellquote $flist_menu_file]
3298 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3301 append findstring " " $x
3303 set gdttype [mc "touching paths:"]
3306 proc gitknewtmpdir {} {
3307 global diffnum gitktmpdir gitdir
3309 if {![info exists gitktmpdir]} {
3310 set gitktmpdir [file join [file dirname $gitdir] \
3311 [format ".gitk-tmp.%s" [pid]]]
3312 if {[catch {file mkdir $gitktmpdir} err]} {
3313 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3320 set diffdir [file join $gitktmpdir $diffnum]
3321 if {[catch {file mkdir $diffdir} err]} {
3322 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3328 proc save_file_from_commit {filename output what} {
3331 if {[catch {exec git show $filename -- > $output} err]} {
3332 if {[string match "fatal: bad revision *" $err]} {
3335 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3341 proc external_diff_get_one_file {diffid filename diffdir} {
3342 global nullid nullid2 nullfile
3345 if {$diffid == $nullid} {
3346 set difffile [file join [file dirname $gitdir] $filename]
3347 if {[file exists $difffile]} {
3352 if {$diffid == $nullid2} {
3353 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3354 return [save_file_from_commit :$filename $difffile index]
3356 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3357 return [save_file_from_commit $diffid:$filename $difffile \
3361 proc external_diff {} {
3362 global nullid nullid2
3363 global flist_menu_file
3367 if {[llength $diffids] == 1} {
3368 # no reference commit given
3369 set diffidto [lindex $diffids 0]
3370 if {$diffidto eq $nullid} {
3371 # diffing working copy with index
3372 set diffidfrom $nullid2
3373 } elseif {$diffidto eq $nullid2} {
3374 # diffing index with HEAD
3375 set diffidfrom "HEAD"
3377 # use first parent commit
3378 global parentlist selectedline
3379 set diffidfrom [lindex $parentlist $selectedline 0]
3382 set diffidfrom [lindex $diffids 0]
3383 set diffidto [lindex $diffids 1]
3386 # make sure that several diffs wont collide
3387 set diffdir [gitknewtmpdir]
3388 if {$diffdir eq {}} return
3390 # gather files to diff
3391 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3392 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3394 if {$difffromfile ne {} && $difftofile ne {}} {
3395 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3396 if {[catch {set fl [open |$cmd r]} err]} {
3397 file delete -force $diffdir
3398 error_popup "$extdifftool: [mc "command failed:"] $err"
3400 fconfigure $fl -blocking 0
3401 filerun $fl [list delete_at_eof $fl $diffdir]
3406 proc find_hunk_blamespec {base line} {
3409 # Find and parse the hunk header
3410 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3411 if {$s_lix eq {}} return
3413 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3414 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3415 s_line old_specs osz osz1 new_line nsz]} {
3419 # base lines for the parents
3420 set base_lines [list $new_line]
3421 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3422 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3423 old_spec old_line osz]} {
3426 lappend base_lines $old_line
3429 # Now scan the lines to determine offset within the hunk
3430 set max_parent [expr {[llength $base_lines]-2}]
3432 set s_lno [lindex [split $s_lix "."] 0]
3434 # Determine if the line is removed
3435 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3436 if {[string match {[-+ ]*} $chunk]} {
3437 set removed_idx [string first "-" $chunk]
3438 # Choose a parent index
3439 if {$removed_idx >= 0} {
3440 set parent $removed_idx
3442 set unchanged_idx [string first " " $chunk]
3443 if {$unchanged_idx >= 0} {
3444 set parent $unchanged_idx
3446 # blame the current commit
3450 # then count other lines that belong to it
3451 for {set i $line} {[incr i -1] > $s_lno} {} {
3452 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3453 # Determine if the line is removed
3454 set removed_idx [string first "-" $chunk]
3456 set code [string index $chunk $parent]
3457 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3461 if {$removed_idx < 0} {
3471 incr dline [lindex $base_lines $parent]
3472 return [list $parent $dline]
3475 proc external_blame_diff {} {
3476 global currentid cmitmode
3477 global diff_menu_txtpos diff_menu_line
3478 global diff_menu_filebase flist_menu_file
3480 if {$cmitmode eq "tree"} {
3482 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3484 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3486 set parent_idx [lindex $hinfo 0]
3487 set line [lindex $hinfo 1]
3494 external_blame $parent_idx $line
3497 # Find the SHA1 ID of the blob for file $fname in the index
3499 proc index_sha1 {fname} {
3500 set f [open [list | git ls-files -s $fname] r]
3501 while {[gets $f line] >= 0} {
3502 set info [lindex [split $line "\t"] 0]
3503 set stage [lindex $info 2]
3504 if {$stage eq "0" || $stage eq "2"} {
3506 return [lindex $info 1]
3513 # Turn an absolute path into one relative to the current directory
3514 proc make_relative {f} {
3515 if {[file pathtype $f] eq "relative"} {
3518 set elts [file split $f]
3519 set here [file split [pwd]]
3524 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3531 set elts [concat $res [lrange $elts $ei end]]
3532 return [eval file join $elts]
3535 proc external_blame {parent_idx {line {}}} {
3536 global flist_menu_file gitdir
3537 global nullid nullid2
3538 global parentlist selectedline currentid
3540 if {$parent_idx > 0} {
3541 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3543 set base_commit $currentid
3546 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3547 error_popup [mc "No such commit"]
3551 set cmdline [list git gui blame]
3552 if {$line ne {} && $line > 1} {
3553 lappend cmdline "--line=$line"
3555 set f [file join [file dirname $gitdir] $flist_menu_file]
3556 # Unfortunately it seems git gui blame doesn't like
3557 # being given an absolute path...
3558 set f [make_relative $f]
3559 lappend cmdline $base_commit $f
3560 if {[catch {eval exec $cmdline &} err]} {
3561 error_popup "[mc "git gui blame: command failed:"] $err"
3565 proc show_line_source {} {
3566 global cmitmode currentid parents curview blamestuff blameinst
3567 global diff_menu_line diff_menu_filebase flist_menu_file
3568 global nullid nullid2 gitdir
3571 if {$cmitmode eq "tree"} {
3573 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3575 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3576 if {$h eq {}} return
3577 set pi [lindex $h 0]
3579 mark_ctext_line $diff_menu_line
3583 if {$currentid eq $nullid} {
3585 # must be a merge in progress...
3587 # get the last line from .git/MERGE_HEAD
3588 set f [open [file join $gitdir MERGE_HEAD] r]
3589 set id [lindex [split [read $f] "\n"] end-1]
3592 error_popup [mc "Couldn't read merge head: %s" $err]
3595 } elseif {$parents($curview,$currentid) eq $nullid2} {
3596 # need to do the blame from the index
3598 set from_index [index_sha1 $flist_menu_file]
3600 error_popup [mc "Error reading index: %s" $err]
3604 set id $parents($curview,$currentid)
3607 set id [lindex $parents($curview,$currentid) $pi]
3609 set line [lindex $h 1]
3612 if {$from_index ne {}} {
3613 lappend blameargs | git cat-file blob $from_index
3615 lappend blameargs | git blame -p -L$line,+1
3616 if {$from_index ne {}} {
3617 lappend blameargs --contents -
3619 lappend blameargs $id
3621 lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
3623 set f [open $blameargs r]
3625 error_popup [mc "Couldn't start git blame: %s" $err]
3628 nowbusy blaming [mc "Searching"]
3629 fconfigure $f -blocking 0
3630 set i [reg_instance $f]
3631 set blamestuff($i) {}
3633 filerun $f [list read_line_source $f $i]
3636 proc stopblaming {} {
3639 if {[info exists blameinst]} {
3640 stop_instance $blameinst
3646 proc read_line_source {fd inst} {
3647 global blamestuff curview commfd blameinst nullid nullid2
3649 while {[gets $fd line] >= 0} {
3650 lappend blamestuff($inst) $line
3658 fconfigure $fd -blocking 1
3659 if {[catch {close $fd} err]} {
3660 error_popup [mc "Error running git blame: %s" $err]
3665 set line [split [lindex $blamestuff($inst) 0] " "]
3666 set id [lindex $line 0]
3667 set lnum [lindex $line 1]
3668 if {[string length $id] == 40 && [string is xdigit $id] &&
3669 [string is digit -strict $lnum]} {
3670 # look for "filename" line
3671 foreach l $blamestuff($inst) {
3672 if {[string match "filename *" $l]} {
3673 set fname [string range $l 9 end]
3679 # all looks good, select it
3680 if {$id eq $nullid} {
3681 # blame uses all-zeroes to mean not committed,
3682 # which would mean a change in the index
3685 if {[commitinview $id $curview]} {
3686 selectline [rowofcommit $id] 1 [list $fname $lnum]
3688 error_popup [mc "That line comes from commit %s, \
3689 which is not in this view" [shortids $id]]
3692 puts "oops couldn't parse git blame output"
3697 # delete $dir when we see eof on $f (presumably because the child has exited)
3698 proc delete_at_eof {f dir} {
3699 while {[gets $f line] >= 0} {}
3701 if {[catch {close $f} err]} {
3702 error_popup "[mc "External diff viewer failed:"] $err"
3704 file delete -force $dir
3710 # Functions for adding and removing shell-type quoting
3712 proc shellquote {str} {
3713 if {![string match "*\['\"\\ \t]*" $str]} {
3716 if {![string match "*\['\"\\]*" $str]} {
3719 if {![string match "*'*" $str]} {
3722 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3725 proc shellarglist {l} {
3731 append str [shellquote $a]
3736 proc shelldequote {str} {
3741 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3742 append ret [string range $str $used end]
3743 set used [string length $str]
3746 set first [lindex $first 0]
3747 set ch [string index $str $first]
3748 if {$first > $used} {
3749 append ret [string range $str $used [expr {$first - 1}]]
3752 if {$ch eq " " || $ch eq "\t"} break
3755 set first [string first "'" $str $used]
3757 error "unmatched single-quote"
3759 append ret [string range $str $used [expr {$first - 1}]]
3764 if {$used >= [string length $str]} {
3765 error "trailing backslash"
3767 append ret [string index $str $used]
3772 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3773 error "unmatched double-quote"
3775 set first [lindex $first 0]
3776 set ch [string index $str $first]
3777 if {$first > $used} {
3778 append ret [string range $str $used [expr {$first - 1}]]
3781 if {$ch eq "\""} break
3783 append ret [string index $str $used]
3787 return [list $used $ret]
3790 proc shellsplit {str} {
3793 set str [string trimleft $str]
3794 if {$str eq {}} break
3795 set dq [shelldequote $str]
3796 set n [lindex $dq 0]
3797 set word [lindex $dq 1]
3798 set str [string range $str $n end]
3804 # Code to implement multiple views
3806 proc newview {ishighlight} {
3807 global nextviewnum newviewname newishighlight
3808 global revtreeargs viewargscmd newviewopts curview
3810 set newishighlight $ishighlight
3812 if {[winfo exists $top]} {
3816 decode_view_opts $nextviewnum $revtreeargs
3817 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3818 set newviewopts($nextviewnum,perm) 0
3819 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3820 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3823 set known_view_options {
3824 {perm b . {} {mc "Remember this view"}}
3825 {reflabel l + {} {mc "References (space separated list):"}}
3826 {refs t15 .. {} {mc "Branches & tags:"}}
3827 {allrefs b *. "--all" {mc "All refs"}}
3828 {branches b . "--branches" {mc "All (local) branches"}}
3829 {tags b . "--tags" {mc "All tags"}}
3830 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3831 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3832 {author t15 .. "--author=*" {mc "Author:"}}
3833 {committer t15 . "--committer=*" {mc "Committer:"}}
3834 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3835 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3836 {changes_l l + {} {mc "Changes to Files:"}}
3837 {pickaxe_s r0 . {} {mc "Fixed String"}}
3838 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3839 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3840 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3841 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3842 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3843 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3844 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3845 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3846 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3847 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3848 {lright b . "--left-right" {mc "Mark branch sides"}}
3849 {first b . "--first-parent" {mc "Limit to first parent"}}
3850 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
3851 {args t50 *. {} {mc "Additional arguments to git log:"}}
3852 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
3853 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3856 # Convert $newviewopts($n, ...) into args for git log.
3857 proc encode_view_opts {n} {
3858 global known_view_options newviewopts
3861 foreach opt $known_view_options {
3862 set patterns [lindex $opt 3]
3863 if {$patterns eq {}} continue
3864 set pattern [lindex $patterns 0]
3866 if {[lindex $opt 1] eq "b"} {
3867 set val $newviewopts($n,[lindex $opt 0])
3869 lappend rargs $pattern
3871 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3872 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3873 set val $newviewopts($n,$button_id)
3874 if {$val eq $value} {
3875 lappend rargs $pattern
3878 set val $newviewopts($n,[lindex $opt 0])
3879 set val [string trim $val]
3881 set pfix [string range $pattern 0 end-1]
3882 lappend rargs $pfix$val
3886 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
3887 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3890 # Fill $newviewopts($n, ...) based on args for git log.
3891 proc decode_view_opts {n view_args} {
3892 global known_view_options newviewopts
3894 foreach opt $known_view_options {
3895 set id [lindex $opt 0]
3896 if {[lindex $opt 1] eq "b"} {
3899 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3901 regexp {^(.*_)} $id uselessvar id
3907 set newviewopts($n,$id) $val
3911 foreach arg $view_args {
3912 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3913 && ![info exists found(limit)]} {
3914 set newviewopts($n,limit) $cnt
3919 foreach opt $known_view_options {
3920 set id [lindex $opt 0]
3921 if {[info exists found($id)]} continue
3922 foreach pattern [lindex $opt 3] {
3923 if {![string match $pattern $arg]} continue
3924 if {[lindex $opt 1] eq "b"} {
3927 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
3929 regexp {^(.*_)} $id uselessvar id
3933 set size [string length $pattern]
3934 set val [string range $arg [expr {$size-1}] end]
3936 set newviewopts($n,$id) $val
3940 if {[info exists val]} break
3942 if {[info exists val]} continue
3943 if {[regexp {^-} $arg]} {
3946 lappend refargs $arg
3949 set newviewopts($n,refs) [shellarglist $refargs]
3950 set newviewopts($n,args) [shellarglist $oargs]
3953 proc edit_or_newview {} {
3965 global viewname viewperm newviewname newviewopts
3966 global viewargs viewargscmd
3968 set top .gitkvedit-$curview
3969 if {[winfo exists $top]} {
3973 decode_view_opts $curview $viewargs($curview)
3974 set newviewname($curview) $viewname($curview)
3975 set newviewopts($curview,perm) $viewperm($curview)
3976 set newviewopts($curview,cmd) $viewargscmd($curview)
3977 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
3980 proc vieweditor {top n title} {
3981 global newviewname newviewopts viewfiles bgcolor
3982 global known_view_options NS
3985 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
3986 make_transient $top .
3989 ${NS}::frame $top.nfr
3990 ${NS}::label $top.nl -text [mc "View Name"]
3991 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
3992 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3993 pack $top.nl -in $top.nfr -side left -padx {0 5}
3994 pack $top.name -in $top.nfr -side left -padx {0 25}
4000 foreach opt $known_view_options {
4001 set id [lindex $opt 0]
4002 set type [lindex $opt 1]
4003 set flags [lindex $opt 2]
4004 set title [eval [lindex $opt 4]]
4007 if {$flags eq "+" || $flags eq "*"} {
4008 set cframe $top.fr$cnt
4010 ${NS}::frame $cframe
4011 pack $cframe -in $top -fill x -pady 3 -padx 3
4012 set cexpand [expr {$flags eq "*"}]
4013 } elseif {$flags eq ".." || $flags eq "*."} {
4014 set cframe $top.fr$cnt
4016 ${NS}::frame $cframe
4017 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4018 set cexpand [expr {$flags eq "*."}]
4024 ${NS}::label $cframe.l_$id -text $title
4025 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4026 } elseif {$type eq "b"} {
4027 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4028 pack $cframe.c_$id -in $cframe -side left \
4029 -padx [list $lxpad 0] -expand $cexpand -anchor w
4030 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4031 regexp {^(.*_)} $id uselessvar button_id
4032 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4033 pack $cframe.c_$id -in $cframe -side left \
4034 -padx [list $lxpad 0] -expand $cexpand -anchor w
4035 } elseif {[regexp {^t(\d+)$} $type type sz]} {
4036 ${NS}::label $cframe.l_$id -text $title
4037 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4038 -textvariable newviewopts($n,$id)
4039 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4040 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4041 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4042 ${NS}::label $cframe.l_$id -text $title
4043 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4044 -textvariable newviewopts($n,$id)
4045 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4046 pack $cframe.e_$id -in $cframe -side top -fill x
4047 } elseif {$type eq "path"} {
4048 ${NS}::label $top.l -text $title
4049 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4050 text $top.t -width 40 -height 5 -background $bgcolor
4051 if {[info exists viewfiles($n)]} {
4052 foreach f $viewfiles($n) {
4053 $top.t insert end $f
4054 $top.t insert end "\n"
4056 $top.t delete {end - 1c} end
4057 $top.t mark set insert 0.0
4059 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4063 ${NS}::frame $top.buts
4064 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4065 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4066 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4067 bind $top <Control-Return> [list newviewok $top $n]
4068 bind $top <F5> [list newviewok $top $n 1]
4069 bind $top <Escape> [list destroy $top]
4070 grid $top.buts.ok $top.buts.apply $top.buts.can
4071 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4072 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4073 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4074 pack $top.buts -in $top -side top -fill x
4078 proc doviewmenu {m first cmd op argv} {
4079 set nmenu [$m index end]
4080 for {set i $first} {$i <= $nmenu} {incr i} {
4081 if {[$m entrycget $i -command] eq $cmd} {
4082 eval $m $op $i $argv
4088 proc allviewmenus {n op args} {
4091 doviewmenu .bar.view 5 [list showview $n] $op $args
4092 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4095 proc newviewok {top n {apply 0}} {
4096 global nextviewnum newviewperm newviewname newishighlight
4097 global viewname viewfiles viewperm selectedview curview
4098 global viewargs viewargscmd newviewopts viewhlmenu
4101 set newargs [encode_view_opts $n]
4103 error_popup "[mc "Error in commit selection arguments:"] $err" $top
4107 foreach f [split [$top.t get 0.0 end] "\n"] {
4108 set ft [string trim $f]
4113 if {![info exists viewfiles($n)]} {
4114 # creating a new view
4116 set viewname($n) $newviewname($n)
4117 set viewperm($n) $newviewopts($n,perm)
4118 set viewfiles($n) $files
4119 set viewargs($n) $newargs
4120 set viewargscmd($n) $newviewopts($n,cmd)
4122 if {!$newishighlight} {
4125 run addvhighlight $n
4128 # editing an existing view
4129 set viewperm($n) $newviewopts($n,perm)
4130 if {$newviewname($n) ne $viewname($n)} {
4131 set viewname($n) $newviewname($n)
4132 doviewmenu .bar.view 5 [list showview $n] \
4133 entryconf [list -label $viewname($n)]
4134 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4135 # entryconf [list -label $viewname($n) -value $viewname($n)]
4137 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4138 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4139 set viewfiles($n) $files
4140 set viewargs($n) $newargs
4141 set viewargscmd($n) $newviewopts($n,cmd)
4142 if {$curview == $n} {
4148 catch {destroy $top}
4152 global curview viewperm hlview selectedhlview
4154 if {$curview == 0} return
4155 if {[info exists hlview] && $hlview == $curview} {
4156 set selectedhlview [mc "None"]
4159 allviewmenus $curview delete
4160 set viewperm($curview) 0
4164 proc addviewmenu {n} {
4165 global viewname viewhlmenu
4167 .bar.view add radiobutton -label $viewname($n) \
4168 -command [list showview $n] -variable selectedview -value $n
4169 #$viewhlmenu add radiobutton -label $viewname($n) \
4170 # -command [list addvhighlight $n] -variable selectedhlview
4174 global curview cached_commitrow ordertok
4175 global displayorder parentlist rowidlist rowisopt rowfinal
4176 global colormap rowtextx nextcolor canvxmax
4177 global numcommits viewcomplete
4178 global selectedline currentid canv canvy0
4180 global pending_select mainheadid
4183 global hlview selectedhlview commitinterest
4185 if {$n == $curview} return
4187 set ymax [lindex [$canv cget -scrollregion] 3]
4188 set span [$canv yview]
4189 set ytop [expr {[lindex $span 0] * $ymax}]
4190 set ybot [expr {[lindex $span 1] * $ymax}]
4191 set yscreen [expr {($ybot - $ytop) / 2}]
4192 if {$selectedline ne {}} {
4193 set selid $currentid
4194 set y [yc $selectedline]
4195 if {$ytop < $y && $y < $ybot} {
4196 set yscreen [expr {$y - $ytop}]
4198 } elseif {[info exists pending_select]} {
4199 set selid $pending_select
4200 unset pending_select
4204 catch {unset treediffs}
4206 if {[info exists hlview] && $hlview == $n} {
4208 set selectedhlview [mc "None"]
4210 catch {unset commitinterest}
4211 catch {unset cached_commitrow}
4212 catch {unset ordertok}
4216 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4217 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4220 if {![info exists viewcomplete($n)]} {
4230 set numcommits $commitidx($n)
4232 catch {unset colormap}
4233 catch {unset rowtextx}
4235 set canvxmax [$canv cget -width]
4241 if {$selid ne {} && [commitinview $selid $n]} {
4242 set row [rowofcommit $selid]
4243 # try to get the selected row in the same position on the screen
4244 set ymax [lindex [$canv cget -scrollregion] 3]
4245 set ytop [expr {[yc $row] - $yscreen}]
4249 set yf [expr {$ytop * 1.0 / $ymax}]
4251 allcanvs yview moveto $yf
4255 } elseif {!$viewcomplete($n)} {
4256 reset_pending_select $selid
4258 reset_pending_select {}
4260 if {[commitinview $pending_select $curview]} {
4261 selectline [rowofcommit $pending_select] 1
4263 set row [first_real_row]
4264 if {$row < $numcommits} {
4269 if {!$viewcomplete($n)} {
4270 if {$numcommits == 0} {
4271 show_status [mc "Reading commits..."]
4273 } elseif {$numcommits == 0} {
4274 show_status [mc "No commits selected"]
4278 # Stuff relating to the highlighting facility
4280 proc ishighlighted {id} {
4281 global vhighlights fhighlights nhighlights rhighlights
4283 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4284 return $nhighlights($id)
4286 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4287 return $vhighlights($id)
4289 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4290 return $fhighlights($id)
4292 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4293 return $rhighlights($id)
4298 proc bolden {id font} {
4299 global canv linehtag currentid boldids need_redisplay markedid
4301 # need_redisplay = 1 means the display is stale and about to be redrawn
4302 if {$need_redisplay} return
4304 $canv itemconf $linehtag($id) -font $font
4305 if {[info exists currentid] && $id eq $currentid} {
4307 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4308 -outline {{}} -tags secsel \
4309 -fill [$canv cget -selectbackground]]
4312 if {[info exists markedid] && $id eq $markedid} {
4317 proc bolden_name {id font} {
4318 global canv2 linentag currentid boldnameids need_redisplay
4320 if {$need_redisplay} return
4321 lappend boldnameids $id
4322 $canv2 itemconf $linentag($id) -font $font
4323 if {[info exists currentid] && $id eq $currentid} {
4324 $canv2 delete secsel
4325 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4326 -outline {{}} -tags secsel \
4327 -fill [$canv2 cget -selectbackground]]
4336 foreach id $boldids {
4337 if {![ishighlighted $id]} {
4340 lappend stillbold $id
4343 set boldids $stillbold
4346 proc addvhighlight {n} {
4347 global hlview viewcomplete curview vhl_done commitidx
4349 if {[info exists hlview]} {
4353 if {$n != $curview && ![info exists viewcomplete($n)]} {
4356 set vhl_done $commitidx($hlview)
4357 if {$vhl_done > 0} {
4362 proc delvhighlight {} {
4363 global hlview vhighlights
4365 if {![info exists hlview]} return
4367 catch {unset vhighlights}
4371 proc vhighlightmore {} {
4372 global hlview vhl_done commitidx vhighlights curview
4374 set max $commitidx($hlview)
4375 set vr [visiblerows]
4376 set r0 [lindex $vr 0]
4377 set r1 [lindex $vr 1]
4378 for {set i $vhl_done} {$i < $max} {incr i} {
4379 set id [commitonrow $i $hlview]
4380 if {[commitinview $id $curview]} {
4381 set row [rowofcommit $id]
4382 if {$r0 <= $row && $row <= $r1} {
4383 if {![highlighted $row]} {
4384 bolden $id mainfontbold
4386 set vhighlights($id) 1
4394 proc askvhighlight {row id} {
4395 global hlview vhighlights iddrawn
4397 if {[commitinview $id $hlview]} {
4398 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4399 bolden $id mainfontbold
4401 set vhighlights($id) 1
4403 set vhighlights($id) 0
4407 proc hfiles_change {} {
4408 global highlight_files filehighlight fhighlights fh_serial
4409 global highlight_paths
4411 if {[info exists filehighlight]} {
4412 # delete previous highlights
4413 catch {close $filehighlight}
4415 catch {unset fhighlights}
4417 unhighlight_filelist
4419 set highlight_paths {}
4420 after cancel do_file_hl $fh_serial
4422 if {$highlight_files ne {}} {
4423 after 300 do_file_hl $fh_serial
4427 proc gdttype_change {name ix op} {
4428 global gdttype highlight_files findstring findpattern
4431 if {$findstring ne {}} {
4432 if {$gdttype eq [mc "containing:"]} {
4433 if {$highlight_files ne {}} {
4434 set highlight_files {}
4439 if {$findpattern ne {}} {
4443 set highlight_files $findstring
4448 # enable/disable findtype/findloc menus too
4451 proc find_change {name ix op} {
4452 global gdttype findstring highlight_files
4455 if {$gdttype eq [mc "containing:"]} {
4458 if {$highlight_files ne $findstring} {
4459 set highlight_files $findstring
4466 proc findcom_change args {
4467 global nhighlights boldnameids
4468 global findpattern findtype findstring gdttype
4471 # delete previous highlights, if any
4472 foreach id $boldnameids {
4473 bolden_name $id mainfont
4476 catch {unset nhighlights}
4479 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4481 } elseif {$findtype eq [mc "Regexp"]} {
4482 set findpattern $findstring
4484 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4486 set findpattern "*$e*"
4490 proc makepatterns {l} {
4493 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4494 if {[string index $ee end] eq "/"} {
4504 proc do_file_hl {serial} {
4505 global highlight_files filehighlight highlight_paths gdttype fhl_list
4507 if {$gdttype eq [mc "touching paths:"]} {
4508 if {[catch {set paths [shellsplit $highlight_files]}]} return
4509 set highlight_paths [makepatterns $paths]
4511 set gdtargs [concat -- $paths]
4512 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4513 set gdtargs [list "-S$highlight_files"]
4515 # must be "containing:", i.e. we're searching commit info
4518 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4519 set filehighlight [open $cmd r+]
4520 fconfigure $filehighlight -blocking 0
4521 filerun $filehighlight readfhighlight
4527 proc flushhighlights {} {
4528 global filehighlight fhl_list
4530 if {[info exists filehighlight]} {
4532 puts $filehighlight ""
4533 flush $filehighlight
4537 proc askfilehighlight {row id} {
4538 global filehighlight fhighlights fhl_list
4540 lappend fhl_list $id
4541 set fhighlights($id) -1
4542 puts $filehighlight $id
4545 proc readfhighlight {} {
4546 global filehighlight fhighlights curview iddrawn
4547 global fhl_list find_dirn
4549 if {![info exists filehighlight]} {
4553 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4554 set line [string trim $line]
4555 set i [lsearch -exact $fhl_list $line]
4556 if {$i < 0} continue
4557 for {set j 0} {$j < $i} {incr j} {
4558 set id [lindex $fhl_list $j]
4559 set fhighlights($id) 0
4561 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4562 if {$line eq {}} continue
4563 if {![commitinview $line $curview]} continue
4564 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4565 bolden $line mainfontbold
4567 set fhighlights($line) 1
4569 if {[eof $filehighlight]} {
4571 puts "oops, git diff-tree died"
4572 catch {close $filehighlight}
4576 if {[info exists find_dirn]} {
4582 proc doesmatch {f} {
4583 global findtype findpattern
4585 if {$findtype eq [mc "Regexp"]} {
4586 return [regexp $findpattern $f]
4587 } elseif {$findtype eq [mc "IgnCase"]} {
4588 return [string match -nocase $findpattern $f]
4590 return [string match $findpattern $f]
4594 proc askfindhighlight {row id} {
4595 global nhighlights commitinfo iddrawn
4597 global markingmatches
4599 if {![info exists commitinfo($id)]} {
4602 set info $commitinfo($id)
4604 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4605 foreach f $info ty $fldtypes {
4606 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4608 if {$ty eq [mc "Author"]} {
4615 if {$isbold && [info exists iddrawn($id)]} {
4616 if {![ishighlighted $id]} {
4617 bolden $id mainfontbold
4619 bolden_name $id mainfontbold
4622 if {$markingmatches} {
4623 markrowmatches $row $id
4626 set nhighlights($id) $isbold
4629 proc markrowmatches {row id} {
4630 global canv canv2 linehtag linentag commitinfo findloc
4632 set headline [lindex $commitinfo($id) 0]
4633 set author [lindex $commitinfo($id) 1]
4634 $canv delete match$row
4635 $canv2 delete match$row
4636 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4637 set m [findmatches $headline]
4639 markmatches $canv $row $headline $linehtag($id) $m \
4640 [$canv itemcget $linehtag($id) -font] $row
4643 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4644 set m [findmatches $author]
4646 markmatches $canv2 $row $author $linentag($id) $m \
4647 [$canv2 itemcget $linentag($id) -font] $row
4652 proc vrel_change {name ix op} {
4653 global highlight_related
4656 if {$highlight_related ne [mc "None"]} {
4661 # prepare for testing whether commits are descendents or ancestors of a
4662 proc rhighlight_sel {a} {
4663 global descendent desc_todo ancestor anc_todo
4664 global highlight_related
4666 catch {unset descendent}
4667 set desc_todo [list $a]
4668 catch {unset ancestor}
4669 set anc_todo [list $a]
4670 if {$highlight_related ne [mc "None"]} {
4676 proc rhighlight_none {} {
4679 catch {unset rhighlights}
4683 proc is_descendent {a} {
4684 global curview children descendent desc_todo
4687 set la [rowofcommit $a]
4691 for {set i 0} {$i < [llength $todo]} {incr i} {
4692 set do [lindex $todo $i]
4693 if {[rowofcommit $do] < $la} {
4694 lappend leftover $do
4697 foreach nk $children($v,$do) {
4698 if {![info exists descendent($nk)]} {
4699 set descendent($nk) 1
4707 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4711 set descendent($a) 0
4712 set desc_todo $leftover
4715 proc is_ancestor {a} {
4716 global curview parents ancestor anc_todo
4719 set la [rowofcommit $a]
4723 for {set i 0} {$i < [llength $todo]} {incr i} {
4724 set do [lindex $todo $i]
4725 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4726 lappend leftover $do
4729 foreach np $parents($v,$do) {
4730 if {![info exists ancestor($np)]} {
4739 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4744 set anc_todo $leftover
4747 proc askrelhighlight {row id} {
4748 global descendent highlight_related iddrawn rhighlights
4749 global selectedline ancestor
4751 if {$selectedline eq {}} return
4753 if {$highlight_related eq [mc "Descendant"] ||
4754 $highlight_related eq [mc "Not descendant"]} {
4755 if {![info exists descendent($id)]} {
4758 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4761 } elseif {$highlight_related eq [mc "Ancestor"] ||
4762 $highlight_related eq [mc "Not ancestor"]} {
4763 if {![info exists ancestor($id)]} {
4766 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4770 if {[info exists iddrawn($id)]} {
4771 if {$isbold && ![ishighlighted $id]} {
4772 bolden $id mainfontbold
4775 set rhighlights($id) $isbold
4778 # Graph layout functions
4780 proc shortids {ids} {
4783 if {[llength $id] > 1} {
4784 lappend res [shortids $id]
4785 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4786 lappend res [string range $id 0 7]
4797 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4798 if {($n & $mask) != 0} {
4799 set ret [concat $ret $o]
4801 set o [concat $o $o]
4806 proc ordertoken {id} {
4807 global ordertok curview varcid varcstart varctok curview parents children
4808 global nullid nullid2
4810 if {[info exists ordertok($id)]} {
4811 return $ordertok($id)
4816 if {[info exists varcid($curview,$id)]} {
4817 set a $varcid($curview,$id)
4818 set p [lindex $varcstart($curview) $a]
4820 set p [lindex $children($curview,$id) 0]
4822 if {[info exists ordertok($p)]} {
4823 set tok $ordertok($p)
4826 set id [first_real_child $curview,$p]
4829 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4832 if {[llength $parents($curview,$id)] == 1} {
4833 lappend todo [list $p {}]
4835 set j [lsearch -exact $parents($curview,$id) $p]
4837 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4839 lappend todo [list $p [strrep $j]]
4842 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4843 set p [lindex $todo $i 0]
4844 append tok [lindex $todo $i 1]
4845 set ordertok($p) $tok
4847 set ordertok($origid) $tok
4851 # Work out where id should go in idlist so that order-token
4852 # values increase from left to right
4853 proc idcol {idlist id {i 0}} {
4854 set t [ordertoken $id]
4858 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4859 if {$i > [llength $idlist]} {
4860 set i [llength $idlist]
4862 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4865 if {$t > [ordertoken [lindex $idlist $i]]} {
4866 while {[incr i] < [llength $idlist] &&
4867 $t >= [ordertoken [lindex $idlist $i]]} {}
4873 proc initlayout {} {
4874 global rowidlist rowisopt rowfinal displayorder parentlist
4875 global numcommits canvxmax canv
4877 global colormap rowtextx
4886 set canvxmax [$canv cget -width]
4887 catch {unset colormap}
4888 catch {unset rowtextx}
4892 proc setcanvscroll {} {
4893 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4894 global lastscrollset lastscrollrows
4896 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4897 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4898 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4899 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4900 set lastscrollset [clock clicks -milliseconds]
4901 set lastscrollrows $numcommits
4904 proc visiblerows {} {
4905 global canv numcommits linespc
4907 set ymax [lindex [$canv cget -scrollregion] 3]
4908 if {$ymax eq {} || $ymax == 0} return
4910 set y0 [expr {int([lindex $f 0] * $ymax)}]
4911 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4915 set y1 [expr {int([lindex $f 1] * $ymax)}]
4916 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4917 if {$r1 >= $numcommits} {
4918 set r1 [expr {$numcommits - 1}]
4920 return [list $r0 $r1]
4923 proc layoutmore {} {
4924 global commitidx viewcomplete curview
4925 global numcommits pending_select curview
4926 global lastscrollset lastscrollrows
4928 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4929 [clock clicks -milliseconds] - $lastscrollset > 500} {
4932 if {[info exists pending_select] &&
4933 [commitinview $pending_select $curview]} {
4935 selectline [rowofcommit $pending_select] 1
4940 # With path limiting, we mightn't get the actual HEAD commit,
4941 # so ask git rev-list what is the first ancestor of HEAD that
4942 # touches a file in the path limit.
4943 proc get_viewmainhead {view} {
4944 global viewmainheadid vfilelimit viewinstances mainheadid
4947 set rfd [open [concat | git rev-list -1 $mainheadid \
4948 -- $vfilelimit($view)] r]
4949 set j [reg_instance $rfd]
4950 lappend viewinstances($view) $j
4951 fconfigure $rfd -blocking 0
4952 filerun $rfd [list getviewhead $rfd $j $view]
4953 set viewmainheadid($curview) {}
4957 # git rev-list should give us just 1 line to use as viewmainheadid($view)
4958 proc getviewhead {fd inst view} {
4959 global viewmainheadid commfd curview viewinstances showlocalchanges
4962 if {[gets $fd line] < 0} {
4966 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4969 set viewmainheadid($view) $id
4972 set i [lsearch -exact $viewinstances($view) $inst]
4974 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4976 if {$showlocalchanges && $id ne {} && $view == $curview} {
4982 proc doshowlocalchanges {} {
4983 global curview viewmainheadid
4985 if {$viewmainheadid($curview) eq {}} return
4986 if {[commitinview $viewmainheadid($curview) $curview]} {
4989 interestedin $viewmainheadid($curview) dodiffindex
4993 proc dohidelocalchanges {} {
4994 global nullid nullid2 lserial curview
4996 if {[commitinview $nullid $curview]} {
4997 removefakerow $nullid
4999 if {[commitinview $nullid2 $curview]} {
5000 removefakerow $nullid2
5005 # spawn off a process to do git diff-index --cached HEAD
5006 proc dodiffindex {} {
5007 global lserial showlocalchanges vfilelimit curview
5010 if {!$showlocalchanges || !$isworktree} return
5012 set cmd "|git diff-index --cached HEAD"
5013 if {$vfilelimit($curview) ne {}} {
5014 set cmd [concat $cmd -- $vfilelimit($curview)]
5016 set fd [open $cmd r]
5017 fconfigure $fd -blocking 0
5018 set i [reg_instance $fd]
5019 filerun $fd [list readdiffindex $fd $lserial $i]
5022 proc readdiffindex {fd serial inst} {
5023 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5027 if {[gets $fd line] < 0} {
5033 # we only need to see one line and we don't really care what it says...
5036 if {$serial != $lserial} {
5040 # now see if there are any local changes not checked in to the index
5041 set cmd "|git diff-files"
5042 if {$vfilelimit($curview) ne {}} {
5043 set cmd [concat $cmd -- $vfilelimit($curview)]
5045 set fd [open $cmd r]
5046 fconfigure $fd -blocking 0
5047 set i [reg_instance $fd]
5048 filerun $fd [list readdifffiles $fd $serial $i]
5050 if {$isdiff && ![commitinview $nullid2 $curview]} {
5051 # add the line for the changes in the index to the graph
5052 set hl [mc "Local changes checked in to index but not committed"]
5053 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5054 set commitdata($nullid2) "\n $hl\n"
5055 if {[commitinview $nullid $curview]} {
5056 removefakerow $nullid
5058 insertfakerow $nullid2 $viewmainheadid($curview)
5059 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5060 if {[commitinview $nullid $curview]} {
5061 removefakerow $nullid
5063 removefakerow $nullid2
5068 proc readdifffiles {fd serial inst} {
5069 global viewmainheadid nullid nullid2 curview
5070 global commitinfo commitdata lserial
5073 if {[gets $fd line] < 0} {
5079 # we only need to see one line and we don't really care what it says...
5082 if {$serial != $lserial} {
5086 if {$isdiff && ![commitinview $nullid $curview]} {
5087 # add the line for the local diff to the graph
5088 set hl [mc "Local uncommitted changes, not checked in to index"]
5089 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5090 set commitdata($nullid) "\n $hl\n"
5091 if {[commitinview $nullid2 $curview]} {
5094 set p $viewmainheadid($curview)
5096 insertfakerow $nullid $p
5097 } elseif {!$isdiff && [commitinview $nullid $curview]} {
5098 removefakerow $nullid
5103 proc nextuse {id row} {
5104 global curview children
5106 if {[info exists children($curview,$id)]} {
5107 foreach kid $children($curview,$id) {
5108 if {![commitinview $kid $curview]} {
5111 if {[rowofcommit $kid] > $row} {
5112 return [rowofcommit $kid]
5116 if {[commitinview $id $curview]} {
5117 return [rowofcommit $id]
5122 proc prevuse {id row} {
5123 global curview children
5126 if {[info exists children($curview,$id)]} {
5127 foreach kid $children($curview,$id) {
5128 if {![commitinview $kid $curview]} break
5129 if {[rowofcommit $kid] < $row} {
5130 set ret [rowofcommit $kid]
5137 proc make_idlist {row} {
5138 global displayorder parentlist uparrowlen downarrowlen mingaplen
5139 global commitidx curview children
5141 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5145 set ra [expr {$row - $downarrowlen}]
5149 set rb [expr {$row + $uparrowlen}]
5150 if {$rb > $commitidx($curview)} {
5151 set rb $commitidx($curview)
5153 make_disporder $r [expr {$rb + 1}]
5155 for {} {$r < $ra} {incr r} {
5156 set nextid [lindex $displayorder [expr {$r + 1}]]
5157 foreach p [lindex $parentlist $r] {
5158 if {$p eq $nextid} continue
5159 set rn [nextuse $p $r]
5161 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5162 lappend ids [list [ordertoken $p] $p]
5166 for {} {$r < $row} {incr r} {
5167 set nextid [lindex $displayorder [expr {$r + 1}]]
5168 foreach p [lindex $parentlist $r] {
5169 if {$p eq $nextid} continue
5170 set rn [nextuse $p $r]
5171 if {$rn < 0 || $rn >= $row} {
5172 lappend ids [list [ordertoken $p] $p]
5176 set id [lindex $displayorder $row]
5177 lappend ids [list [ordertoken $id] $id]
5179 foreach p [lindex $parentlist $r] {
5180 set firstkid [lindex $children($curview,$p) 0]
5181 if {[rowofcommit $firstkid] < $row} {
5182 lappend ids [list [ordertoken $p] $p]
5186 set id [lindex $displayorder $r]
5188 set firstkid [lindex $children($curview,$id) 0]
5189 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5190 lappend ids [list [ordertoken $id] $id]
5195 foreach idx [lsort -unique $ids] {
5196 lappend idlist [lindex $idx 1]
5201 proc rowsequal {a b} {
5202 while {[set i [lsearch -exact $a {}]] >= 0} {
5203 set a [lreplace $a $i $i]
5205 while {[set i [lsearch -exact $b {}]] >= 0} {
5206 set b [lreplace $b $i $i]
5208 return [expr {$a eq $b}]
5211 proc makeupline {id row rend col} {
5212 global rowidlist uparrowlen downarrowlen mingaplen
5214 for {set r $rend} {1} {set r $rstart} {
5215 set rstart [prevuse $id $r]
5216 if {$rstart < 0} return
5217 if {$rstart < $row} break
5219 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5220 set rstart [expr {$rend - $uparrowlen - 1}]
5222 for {set r $rstart} {[incr r] <= $row} {} {
5223 set idlist [lindex $rowidlist $r]
5224 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5225 set col [idcol $idlist $id $col]
5226 lset rowidlist $r [linsert $idlist $col $id]
5232 proc layoutrows {row endrow} {
5233 global rowidlist rowisopt rowfinal displayorder
5234 global uparrowlen downarrowlen maxwidth mingaplen
5235 global children parentlist
5236 global commitidx viewcomplete curview
5238 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5241 set rm1 [expr {$row - 1}]
5242 foreach id [lindex $rowidlist $rm1] {
5247 set final [lindex $rowfinal $rm1]
5249 for {} {$row < $endrow} {incr row} {
5250 set rm1 [expr {$row - 1}]
5251 if {$rm1 < 0 || $idlist eq {}} {
5252 set idlist [make_idlist $row]
5255 set id [lindex $displayorder $rm1]
5256 set col [lsearch -exact $idlist $id]
5257 set idlist [lreplace $idlist $col $col]
5258 foreach p [lindex $parentlist $rm1] {
5259 if {[lsearch -exact $idlist $p] < 0} {
5260 set col [idcol $idlist $p $col]
5261 set idlist [linsert $idlist $col $p]
5262 # if not the first child, we have to insert a line going up
5263 if {$id ne [lindex $children($curview,$p) 0]} {
5264 makeupline $p $rm1 $row $col
5268 set id [lindex $displayorder $row]
5269 if {$row > $downarrowlen} {
5270 set termrow [expr {$row - $downarrowlen - 1}]
5271 foreach p [lindex $parentlist $termrow] {
5272 set i [lsearch -exact $idlist $p]
5273 if {$i < 0} continue
5274 set nr [nextuse $p $termrow]
5275 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5276 set idlist [lreplace $idlist $i $i]
5280 set col [lsearch -exact $idlist $id]
5282 set col [idcol $idlist $id]
5283 set idlist [linsert $idlist $col $id]
5284 if {$children($curview,$id) ne {}} {
5285 makeupline $id $rm1 $row $col
5288 set r [expr {$row + $uparrowlen - 1}]
5289 if {$r < $commitidx($curview)} {
5291 foreach p [lindex $parentlist $r] {
5292 if {[lsearch -exact $idlist $p] >= 0} continue
5293 set fk [lindex $children($curview,$p) 0]
5294 if {[rowofcommit $fk] < $row} {
5295 set x [idcol $idlist $p $x]
5296 set idlist [linsert $idlist $x $p]
5299 if {[incr r] < $commitidx($curview)} {
5300 set p [lindex $displayorder $r]
5301 if {[lsearch -exact $idlist $p] < 0} {
5302 set fk [lindex $children($curview,$p) 0]
5303 if {$fk ne {} && [rowofcommit $fk] < $row} {
5304 set x [idcol $idlist $p $x]
5305 set idlist [linsert $idlist $x $p]
5311 if {$final && !$viewcomplete($curview) &&
5312 $row + $uparrowlen + $mingaplen + $downarrowlen
5313 >= $commitidx($curview)} {
5316 set l [llength $rowidlist]
5318 lappend rowidlist $idlist
5320 lappend rowfinal $final
5321 } elseif {$row < $l} {
5322 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5323 lset rowidlist $row $idlist
5326 lset rowfinal $row $final
5328 set pad [ntimes [expr {$row - $l}] {}]
5329 set rowidlist [concat $rowidlist $pad]
5330 lappend rowidlist $idlist
5331 set rowfinal [concat $rowfinal $pad]
5332 lappend rowfinal $final
5333 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5339 proc changedrow {row} {
5340 global displayorder iddrawn rowisopt need_redisplay
5342 set l [llength $rowisopt]
5344 lset rowisopt $row 0
5345 if {$row + 1 < $l} {
5346 lset rowisopt [expr {$row + 1}] 0
5347 if {$row + 2 < $l} {
5348 lset rowisopt [expr {$row + 2}] 0
5352 set id [lindex $displayorder $row]
5353 if {[info exists iddrawn($id)]} {
5354 set need_redisplay 1
5358 proc insert_pad {row col npad} {
5361 set pad [ntimes $npad {}]
5362 set idlist [lindex $rowidlist $row]
5363 set bef [lrange $idlist 0 [expr {$col - 1}]]
5364 set aft [lrange $idlist $col end]
5365 set i [lsearch -exact $aft {}]
5367 set aft [lreplace $aft $i $i]
5369 lset rowidlist $row [concat $bef $pad $aft]
5373 proc optimize_rows {row col endrow} {
5374 global rowidlist rowisopt displayorder curview children
5379 for {} {$row < $endrow} {incr row; set col 0} {
5380 if {[lindex $rowisopt $row]} continue
5382 set y0 [expr {$row - 1}]
5383 set ym [expr {$row - 2}]
5384 set idlist [lindex $rowidlist $row]
5385 set previdlist [lindex $rowidlist $y0]
5386 if {$idlist eq {} || $previdlist eq {}} continue
5388 set pprevidlist [lindex $rowidlist $ym]
5389 if {$pprevidlist eq {}} continue
5395 for {} {$col < [llength $idlist]} {incr col} {
5396 set id [lindex $idlist $col]
5397 if {[lindex $previdlist $col] eq $id} continue
5402 set x0 [lsearch -exact $previdlist $id]
5403 if {$x0 < 0} continue
5404 set z [expr {$x0 - $col}]
5408 set xm [lsearch -exact $pprevidlist $id]
5410 set z0 [expr {$xm - $x0}]
5414 # if row y0 is the first child of $id then it's not an arrow
5415 if {[lindex $children($curview,$id) 0] ne
5416 [lindex $displayorder $y0]} {
5420 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5421 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5424 # Looking at lines from this row to the previous row,
5425 # make them go straight up if they end in an arrow on
5426 # the previous row; otherwise make them go straight up
5428 if {$z < -1 || ($z < 0 && $isarrow)} {
5429 # Line currently goes left too much;
5430 # insert pads in the previous row, then optimize it
5431 set npad [expr {-1 - $z + $isarrow}]
5432 insert_pad $y0 $x0 $npad
5434 optimize_rows $y0 $x0 $row
5436 set previdlist [lindex $rowidlist $y0]
5437 set x0 [lsearch -exact $previdlist $id]
5438 set z [expr {$x0 - $col}]
5440 set pprevidlist [lindex $rowidlist $ym]
5441 set xm [lsearch -exact $pprevidlist $id]
5442 set z0 [expr {$xm - $x0}]
5444 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5445 # Line currently goes right too much;
5446 # insert pads in this line
5447 set npad [expr {$z - 1 + $isarrow}]
5448 insert_pad $row $col $npad
5449 set idlist [lindex $rowidlist $row]
5451 set z [expr {$x0 - $col}]
5454 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5455 # this line links to its first child on row $row-2
5456 set id [lindex $displayorder $ym]
5457 set xc [lsearch -exact $pprevidlist $id]
5459 set z0 [expr {$xc - $x0}]
5462 # avoid lines jigging left then immediately right
5463 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5464 insert_pad $y0 $x0 1
5466 optimize_rows $y0 $x0 $row
5467 set previdlist [lindex $rowidlist $y0]
5471 # Find the first column that doesn't have a line going right
5472 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5473 set id [lindex $idlist $col]
5474 if {$id eq {}} break
5475 set x0 [lsearch -exact $previdlist $id]
5477 # check if this is the link to the first child
5478 set kid [lindex $displayorder $y0]
5479 if {[lindex $children($curview,$id) 0] eq $kid} {
5480 # it is, work out offset to child
5481 set x0 [lsearch -exact $previdlist $kid]
5484 if {$x0 <= $col} break
5486 # Insert a pad at that column as long as it has a line and
5487 # isn't the last column
5488 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5489 set idlist [linsert $idlist $col {}]
5490 lset rowidlist $row $idlist
5498 global canvx0 linespc
5499 return [expr {$canvx0 + $col * $linespc}]
5503 global canvy0 linespc
5504 return [expr {$canvy0 + $row * $linespc}]
5507 proc linewidth {id} {
5508 global thickerline lthickness
5511 if {[info exists thickerline] && $id eq $thickerline} {
5512 set wid [expr {2 * $lthickness}]
5517 proc rowranges {id} {
5518 global curview children uparrowlen downarrowlen
5521 set kids $children($curview,$id)
5527 foreach child $kids {
5528 if {![commitinview $child $curview]} break
5529 set row [rowofcommit $child]
5530 if {![info exists prev]} {
5531 lappend ret [expr {$row + 1}]
5533 if {$row <= $prevrow} {
5534 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5536 # see if the line extends the whole way from prevrow to row
5537 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5538 [lsearch -exact [lindex $rowidlist \
5539 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5540 # it doesn't, see where it ends
5541 set r [expr {$prevrow + $downarrowlen}]
5542 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5543 while {[incr r -1] > $prevrow &&
5544 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5546 while {[incr r] <= $row &&
5547 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5551 # see where it starts up again
5552 set r [expr {$row - $uparrowlen}]
5553 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5554 while {[incr r] < $row &&
5555 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5557 while {[incr r -1] >= $prevrow &&
5558 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5564 if {$child eq $id} {
5573 proc drawlineseg {id row endrow arrowlow} {
5574 global rowidlist displayorder iddrawn linesegs
5575 global canv colormap linespc curview maxlinelen parentlist
5577 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5578 set le [expr {$row + 1}]
5581 set c [lsearch -exact [lindex $rowidlist $le] $id]
5587 set x [lindex $displayorder $le]
5592 if {[info exists iddrawn($x)] || $le == $endrow} {
5593 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5609 if {[info exists linesegs($id)]} {
5610 set lines $linesegs($id)
5612 set r0 [lindex $li 0]
5614 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5624 set li [lindex $lines [expr {$i-1}]]
5625 set r1 [lindex $li 1]
5626 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5631 set x [lindex $cols [expr {$le - $row}]]
5632 set xp [lindex $cols [expr {$le - 1 - $row}]]
5633 set dir [expr {$xp - $x}]
5635 set ith [lindex $lines $i 2]
5636 set coords [$canv coords $ith]
5637 set ah [$canv itemcget $ith -arrow]
5638 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5639 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5640 if {$x2 ne {} && $x - $x2 == $dir} {
5641 set coords [lrange $coords 0 end-2]
5644 set coords [list [xc $le $x] [yc $le]]
5647 set itl [lindex $lines [expr {$i-1}] 2]
5648 set al [$canv itemcget $itl -arrow]
5649 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5650 } elseif {$arrowlow} {
5651 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5652 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5656 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5657 for {set y $le} {[incr y -1] > $row} {} {
5659 set xp [lindex $cols [expr {$y - 1 - $row}]]
5660 set ndir [expr {$xp - $x}]
5661 if {$dir != $ndir || $xp < 0} {
5662 lappend coords [xc $y $x] [yc $y]
5668 # join parent line to first child
5669 set ch [lindex $displayorder $row]
5670 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5672 puts "oops: drawlineseg: child $ch not on row $row"
5673 } elseif {$xc != $x} {
5674 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5675 set d [expr {int(0.5 * $linespc)}]
5678 set x2 [expr {$x1 - $d}]
5680 set x2 [expr {$x1 + $d}]
5683 set y1 [expr {$y2 + $d}]
5684 lappend coords $x1 $y1 $x2 $y2
5685 } elseif {$xc < $x - 1} {
5686 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5687 } elseif {$xc > $x + 1} {
5688 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5692 lappend coords [xc $row $x] [yc $row]
5694 set xn [xc $row $xp]
5696 lappend coords $xn $yn
5700 set t [$canv create line $coords -width [linewidth $id] \
5701 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5704 set lines [linsert $lines $i [list $row $le $t]]
5706 $canv coords $ith $coords
5707 if {$arrow ne $ah} {
5708 $canv itemconf $ith -arrow $arrow
5710 lset lines $i 0 $row
5713 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5714 set ndir [expr {$xo - $xp}]
5715 set clow [$canv coords $itl]
5716 if {$dir == $ndir} {
5717 set clow [lrange $clow 2 end]
5719 set coords [concat $coords $clow]
5721 lset lines [expr {$i-1}] 1 $le
5723 # coalesce two pieces
5725 set b [lindex $lines [expr {$i-1}] 0]
5726 set e [lindex $lines $i 1]
5727 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5729 $canv coords $itl $coords
5730 if {$arrow ne $al} {
5731 $canv itemconf $itl -arrow $arrow
5735 set linesegs($id) $lines
5739 proc drawparentlinks {id row} {
5740 global rowidlist canv colormap curview parentlist
5741 global idpos linespc
5743 set rowids [lindex $rowidlist $row]
5744 set col [lsearch -exact $rowids $id]
5745 if {$col < 0} return
5746 set olds [lindex $parentlist $row]
5747 set row2 [expr {$row + 1}]
5748 set x [xc $row $col]
5751 set d [expr {int(0.5 * $linespc)}]
5752 set ymid [expr {$y + $d}]
5753 set ids [lindex $rowidlist $row2]
5754 # rmx = right-most X coord used
5757 set i [lsearch -exact $ids $p]
5759 puts "oops, parent $p of $id not in list"
5762 set x2 [xc $row2 $i]
5766 set j [lsearch -exact $rowids $p]
5768 # drawlineseg will do this one for us
5772 # should handle duplicated parents here...
5773 set coords [list $x $y]
5775 # if attaching to a vertical segment, draw a smaller
5776 # slant for visual distinctness
5779 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5781 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5783 } elseif {$i < $col && $i < $j} {
5784 # segment slants towards us already
5785 lappend coords [xc $row $j] $y
5787 if {$i < $col - 1} {
5788 lappend coords [expr {$x2 + $linespc}] $y
5789 } elseif {$i > $col + 1} {
5790 lappend coords [expr {$x2 - $linespc}] $y
5792 lappend coords $x2 $y2
5795 lappend coords $x2 $y2
5797 set t [$canv create line $coords -width [linewidth $p] \
5798 -fill $colormap($p) -tags lines.$p]
5802 if {$rmx > [lindex $idpos($id) 1]} {
5803 lset idpos($id) 1 $rmx
5808 proc drawlines {id} {
5811 $canv itemconf lines.$id -width [linewidth $id]
5814 proc drawcmittext {id row col} {
5815 global linespc canv canv2 canv3 fgcolor curview
5816 global cmitlisted commitinfo rowidlist parentlist
5817 global rowtextx idpos idtags idheads idotherrefs
5818 global linehtag linentag linedtag selectedline
5819 global canvxmax boldids boldnameids fgcolor markedid
5820 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5822 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5823 set listed $cmitlisted($curview,$id)
5824 if {$id eq $nullid} {
5826 } elseif {$id eq $nullid2} {
5828 } elseif {$id eq $mainheadid} {
5831 set ofill [lindex $circlecolors $listed]
5833 set x [xc $row $col]
5835 set orad [expr {$linespc / 3}]
5837 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5838 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5839 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5840 } elseif {$listed == 3} {
5841 # triangle pointing left for left-side commits
5842 set t [$canv create polygon \
5843 [expr {$x - $orad}] $y \
5844 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5845 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5846 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5848 # triangle pointing right for right-side commits
5849 set t [$canv create polygon \
5850 [expr {$x + $orad - 1}] $y \
5851 [expr {$x - $orad}] [expr {$y - $orad}] \
5852 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5853 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5855 set circleitem($row) $t
5857 $canv bind $t <1> {selcanvline {} %x %y}
5858 set rmx [llength [lindex $rowidlist $row]]
5859 set olds [lindex $parentlist $row]
5861 set nextids [lindex $rowidlist [expr {$row + 1}]]
5863 set i [lsearch -exact $nextids $p]
5869 set xt [xc $row $rmx]
5870 set rowtextx($row) $xt
5871 set idpos($id) [list $x $xt $y]
5872 if {[info exists idtags($id)] || [info exists idheads($id)]
5873 || [info exists idotherrefs($id)]} {
5874 set xt [drawtags $id $x $xt $y]
5876 set headline [lindex $commitinfo($id) 0]
5877 set name [lindex $commitinfo($id) 1]
5878 set date [lindex $commitinfo($id) 2]
5879 set date [formatdate $date]
5882 set isbold [ishighlighted $id]
5885 set font mainfontbold
5887 lappend boldnameids $id
5888 set nfont mainfontbold
5891 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5892 -text $headline -font $font -tags text]
5893 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5894 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5895 -text $name -font $nfont -tags text]
5896 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5897 -text $date -font mainfont -tags text]
5898 if {$selectedline == $row} {
5901 if {[info exists markedid] && $markedid eq $id} {
5904 set xr [expr {$xt + [font measure $font $headline]}]
5905 if {$xr > $canvxmax} {
5911 proc drawcmitrow {row} {
5912 global displayorder rowidlist nrows_drawn
5913 global iddrawn markingmatches
5914 global commitinfo numcommits
5915 global filehighlight fhighlights findpattern nhighlights
5916 global hlview vhighlights
5917 global highlight_related rhighlights
5919 if {$row >= $numcommits} return
5921 set id [lindex $displayorder $row]
5922 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5923 askvhighlight $row $id
5925 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5926 askfilehighlight $row $id
5928 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5929 askfindhighlight $row $id
5931 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5932 askrelhighlight $row $id
5934 if {![info exists iddrawn($id)]} {
5935 set col [lsearch -exact [lindex $rowidlist $row] $id]
5937 puts "oops, row $row id $id not in list"
5940 if {![info exists commitinfo($id)]} {
5944 drawcmittext $id $row $col
5948 if {$markingmatches} {
5949 markrowmatches $row $id
5953 proc drawcommits {row {endrow {}}} {
5954 global numcommits iddrawn displayorder curview need_redisplay
5955 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5960 if {$endrow eq {}} {
5963 if {$endrow >= $numcommits} {
5964 set endrow [expr {$numcommits - 1}]
5967 set rl1 [expr {$row - $downarrowlen - 3}]
5971 set ro1 [expr {$row - 3}]
5975 set r2 [expr {$endrow + $uparrowlen + 3}]
5976 if {$r2 > $numcommits} {
5979 for {set r $rl1} {$r < $r2} {incr r} {
5980 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5984 set rl1 [expr {$r + 1}]
5990 optimize_rows $ro1 0 $r2
5991 if {$need_redisplay || $nrows_drawn > 2000} {
5995 # make the lines join to already-drawn rows either side
5996 set r [expr {$row - 1}]
5997 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6000 set er [expr {$endrow + 1}]
6001 if {$er >= $numcommits ||
6002 ![info exists iddrawn([lindex $displayorder $er])]} {
6005 for {} {$r <= $er} {incr r} {
6006 set id [lindex $displayorder $r]
6007 set wasdrawn [info exists iddrawn($id)]
6009 if {$r == $er} break
6010 set nextid [lindex $displayorder [expr {$r + 1}]]
6011 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6012 drawparentlinks $id $r
6014 set rowids [lindex $rowidlist $r]
6015 foreach lid $rowids {
6016 if {$lid eq {}} continue
6017 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6019 # see if this is the first child of any of its parents
6020 foreach p [lindex $parentlist $r] {
6021 if {[lsearch -exact $rowids $p] < 0} {
6022 # make this line extend up to the child
6023 set lineend($p) [drawlineseg $p $r $er 0]
6027 set lineend($lid) [drawlineseg $lid $r $er 1]
6033 proc undolayout {row} {
6034 global uparrowlen mingaplen downarrowlen
6035 global rowidlist rowisopt rowfinal need_redisplay
6037 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6041 if {[llength $rowidlist] > $r} {
6043 set rowidlist [lrange $rowidlist 0 $r]
6044 set rowfinal [lrange $rowfinal 0 $r]
6045 set rowisopt [lrange $rowisopt 0 $r]
6046 set need_redisplay 1
6051 proc drawvisible {} {
6052 global canv linespc curview vrowmod selectedline targetrow targetid
6053 global need_redisplay cscroll numcommits
6055 set fs [$canv yview]
6056 set ymax [lindex [$canv cget -scrollregion] 3]
6057 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6058 set f0 [lindex $fs 0]
6059 set f1 [lindex $fs 1]
6060 set y0 [expr {int($f0 * $ymax)}]
6061 set y1 [expr {int($f1 * $ymax)}]
6063 if {[info exists targetid]} {
6064 if {[commitinview $targetid $curview]} {
6065 set r [rowofcommit $targetid]
6066 if {$r != $targetrow} {
6067 # Fix up the scrollregion and change the scrolling position
6068 # now that our target row has moved.
6069 set diff [expr {($r - $targetrow) * $linespc}]
6072 set ymax [lindex [$canv cget -scrollregion] 3]
6075 set f0 [expr {$y0 / $ymax}]
6076 set f1 [expr {$y1 / $ymax}]
6077 allcanvs yview moveto $f0
6078 $cscroll set $f0 $f1
6079 set need_redisplay 1
6086 set row [expr {int(($y0 - 3) / $linespc) - 1}]
6087 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6088 if {$endrow >= $vrowmod($curview)} {
6089 update_arcrows $curview
6091 if {$selectedline ne {} &&
6092 $row <= $selectedline && $selectedline <= $endrow} {
6093 set targetrow $selectedline
6094 } elseif {[info exists targetid]} {
6095 set targetrow [expr {int(($row + $endrow) / 2)}]
6097 if {[info exists targetrow]} {
6098 if {$targetrow >= $numcommits} {
6099 set targetrow [expr {$numcommits - 1}]
6101 set targetid [commitonrow $targetrow]
6103 drawcommits $row $endrow
6106 proc clear_display {} {
6107 global iddrawn linesegs need_redisplay nrows_drawn
6108 global vhighlights fhighlights nhighlights rhighlights
6109 global linehtag linentag linedtag boldids boldnameids
6112 catch {unset iddrawn}
6113 catch {unset linesegs}
6114 catch {unset linehtag}
6115 catch {unset linentag}
6116 catch {unset linedtag}
6119 catch {unset vhighlights}
6120 catch {unset fhighlights}
6121 catch {unset nhighlights}
6122 catch {unset rhighlights}
6123 set need_redisplay 0
6127 proc findcrossings {id} {
6128 global rowidlist parentlist numcommits displayorder
6132 foreach {s e} [rowranges $id] {
6133 if {$e >= $numcommits} {
6134 set e [expr {$numcommits - 1}]
6136 if {$e <= $s} continue
6137 for {set row $e} {[incr row -1] >= $s} {} {
6138 set x [lsearch -exact [lindex $rowidlist $row] $id]
6140 set olds [lindex $parentlist $row]
6141 set kid [lindex $displayorder $row]
6142 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6143 if {$kidx < 0} continue
6144 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6146 set px [lsearch -exact $nextrow $p]
6147 if {$px < 0} continue
6148 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6149 if {[lsearch -exact $ccross $p] >= 0} continue
6150 if {$x == $px + ($kidx < $px? -1: 1)} {
6152 } elseif {[lsearch -exact $cross $p] < 0} {
6159 return [concat $ccross {{}} $cross]
6162 proc assigncolor {id} {
6163 global colormap colors nextcolor
6164 global parents children children curview
6166 if {[info exists colormap($id)]} return
6167 set ncolors [llength $colors]
6168 if {[info exists children($curview,$id)]} {
6169 set kids $children($curview,$id)
6173 if {[llength $kids] == 1} {
6174 set child [lindex $kids 0]
6175 if {[info exists colormap($child)]
6176 && [llength $parents($curview,$child)] == 1} {
6177 set colormap($id) $colormap($child)
6183 foreach x [findcrossings $id] {
6185 # delimiter between corner crossings and other crossings
6186 if {[llength $badcolors] >= $ncolors - 1} break
6187 set origbad $badcolors
6189 if {[info exists colormap($x)]
6190 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6191 lappend badcolors $colormap($x)
6194 if {[llength $badcolors] >= $ncolors} {
6195 set badcolors $origbad
6197 set origbad $badcolors
6198 if {[llength $badcolors] < $ncolors - 1} {
6199 foreach child $kids {
6200 if {[info exists colormap($child)]
6201 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6202 lappend badcolors $colormap($child)
6204 foreach p $parents($curview,$child) {
6205 if {[info exists colormap($p)]
6206 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6207 lappend badcolors $colormap($p)
6211 if {[llength $badcolors] >= $ncolors} {
6212 set badcolors $origbad
6215 for {set i 0} {$i <= $ncolors} {incr i} {
6216 set c [lindex $colors $nextcolor]
6217 if {[incr nextcolor] >= $ncolors} {
6220 if {[lsearch -exact $badcolors $c]} break
6222 set colormap($id) $c
6225 proc bindline {t id} {
6228 $canv bind $t <Enter> "lineenter %x %y $id"
6229 $canv bind $t <Motion> "linemotion %x %y $id"
6230 $canv bind $t <Leave> "lineleave $id"
6231 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6234 proc drawtags {id x xt y1} {
6235 global idtags idheads idotherrefs mainhead
6236 global linespc lthickness
6237 global canv rowtextx curview fgcolor bgcolor ctxbut
6242 if {[info exists idtags($id)]} {
6243 set marks $idtags($id)
6244 set ntags [llength $marks]
6246 if {[info exists idheads($id)]} {
6247 set marks [concat $marks $idheads($id)]
6248 set nheads [llength $idheads($id)]
6250 if {[info exists idotherrefs($id)]} {
6251 set marks [concat $marks $idotherrefs($id)]
6257 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6258 set yt [expr {$y1 - 0.5 * $linespc}]
6259 set yb [expr {$yt + $linespc - 1}]
6263 foreach tag $marks {
6265 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6266 set wid [font measure mainfontbold $tag]
6268 set wid [font measure mainfont $tag]
6272 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6274 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6275 -width $lthickness -fill black -tags tag.$id]
6277 foreach tag $marks x $xvals wid $wvals {
6278 set xl [expr {$x + $delta}]
6279 set xr [expr {$x + $delta + $wid + $lthickness}]
6281 if {[incr ntags -1] >= 0} {
6283 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6284 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6285 -width 1 -outline black -fill yellow -tags tag.$id]
6286 $canv bind $t <1> [list showtag $tag 1]
6287 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6289 # draw a head or other ref
6290 if {[incr nheads -1] >= 0} {
6292 if {$tag eq $mainhead} {
6293 set font mainfontbold
6298 set xl [expr {$xl - $delta/2}]
6299 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6300 -width 1 -outline black -fill $col -tags tag.$id
6301 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6302 set rwid [font measure mainfont $remoteprefix]
6303 set xi [expr {$x + 1}]
6304 set yti [expr {$yt + 1}]
6305 set xri [expr {$x + $rwid}]
6306 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6307 -width 0 -fill "#ffddaa" -tags tag.$id
6310 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6311 -font $font -tags [list tag.$id text]]
6313 $canv bind $t <1> [list showtag $tag 1]
6314 } elseif {$nheads >= 0} {
6315 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
6321 proc xcoord {i level ln} {
6322 global canvx0 xspc1 xspc2
6324 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6325 if {$i > 0 && $i == $level} {
6326 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6327 } elseif {$i > $level} {
6328 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6333 proc show_status {msg} {
6337 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6338 -tags text -fill $fgcolor
6341 # Don't change the text pane cursor if it is currently the hand cursor,
6342 # showing that we are over a sha1 ID link.
6343 proc settextcursor {c} {
6344 global ctext curtextcursor
6346 if {[$ctext cget -cursor] == $curtextcursor} {
6347 $ctext config -cursor $c
6349 set curtextcursor $c
6352 proc nowbusy {what {name {}}} {
6353 global isbusy busyname statusw
6355 if {[array names isbusy] eq {}} {
6356 . config -cursor watch
6360 set busyname($what) $name
6362 $statusw conf -text $name
6366 proc notbusy {what} {
6367 global isbusy maincursor textcursor busyname statusw
6371 if {$busyname($what) ne {} &&
6372 [$statusw cget -text] eq $busyname($what)} {
6373 $statusw conf -text {}
6376 if {[array names isbusy] eq {}} {
6377 . config -cursor $maincursor
6378 settextcursor $textcursor
6382 proc findmatches {f} {
6383 global findtype findstring
6384 if {$findtype == [mc "Regexp"]} {
6385 set matches [regexp -indices -all -inline $findstring $f]
6388 if {$findtype == [mc "IgnCase"]} {
6389 set f [string tolower $f]
6390 set fs [string tolower $fs]
6394 set l [string length $fs]
6395 while {[set j [string first $fs $f $i]] >= 0} {
6396 lappend matches [list $j [expr {$j+$l-1}]]
6397 set i [expr {$j + $l}]
6403 proc dofind {{dirn 1} {wrap 1}} {
6404 global findstring findstartline findcurline selectedline numcommits
6405 global gdttype filehighlight fh_serial find_dirn findallowwrap
6407 if {[info exists find_dirn]} {
6408 if {$find_dirn == $dirn} return
6412 if {$findstring eq {} || $numcommits == 0} return
6413 if {$selectedline eq {}} {
6414 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6416 set findstartline $selectedline
6418 set findcurline $findstartline
6419 nowbusy finding [mc "Searching"]
6420 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6421 after cancel do_file_hl $fh_serial
6422 do_file_hl $fh_serial
6425 set findallowwrap $wrap
6429 proc stopfinding {} {
6430 global find_dirn findcurline fprogcoord
6432 if {[info exists find_dirn]} {
6443 global commitdata commitinfo numcommits findpattern findloc
6444 global findstartline findcurline findallowwrap
6445 global find_dirn gdttype fhighlights fprogcoord
6446 global curview varcorder vrownum varccommits vrowmod
6448 if {![info exists find_dirn]} {
6451 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6454 if {$find_dirn > 0} {
6456 if {$l >= $numcommits} {
6459 if {$l <= $findstartline} {
6460 set lim [expr {$findstartline + 1}]
6463 set moretodo $findallowwrap
6470 if {$l >= $findstartline} {
6471 set lim [expr {$findstartline - 1}]
6474 set moretodo $findallowwrap
6477 set n [expr {($lim - $l) * $find_dirn}]
6482 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6483 update_arcrows $curview
6487 set ai [bsearch $vrownum($curview) $l]
6488 set a [lindex $varcorder($curview) $ai]
6489 set arow [lindex $vrownum($curview) $ai]
6490 set ids [lindex $varccommits($curview,$a)]
6491 set arowend [expr {$arow + [llength $ids]}]
6492 if {$gdttype eq [mc "containing:"]} {
6493 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6494 if {$l < $arow || $l >= $arowend} {
6496 set a [lindex $varcorder($curview) $ai]
6497 set arow [lindex $vrownum($curview) $ai]
6498 set ids [lindex $varccommits($curview,$a)]
6499 set arowend [expr {$arow + [llength $ids]}]
6501 set id [lindex $ids [expr {$l - $arow}]]
6502 # shouldn't happen unless git log doesn't give all the commits...
6503 if {![info exists commitdata($id)] ||
6504 ![doesmatch $commitdata($id)]} {
6507 if {![info exists commitinfo($id)]} {
6510 set info $commitinfo($id)
6511 foreach f $info ty $fldtypes {
6512 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6521 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6522 if {$l < $arow || $l >= $arowend} {
6524 set a [lindex $varcorder($curview) $ai]
6525 set arow [lindex $vrownum($curview) $ai]
6526 set ids [lindex $varccommits($curview,$a)]
6527 set arowend [expr {$arow + [llength $ids]}]
6529 set id [lindex $ids [expr {$l - $arow}]]
6530 if {![info exists fhighlights($id)]} {
6531 # this sets fhighlights($id) to -1
6532 askfilehighlight $l $id
6534 if {$fhighlights($id) > 0} {
6538 if {$fhighlights($id) < 0} {
6541 set findcurline [expr {$l - $find_dirn}]
6546 if {$found || ($domore && !$moretodo)} {
6562 set findcurline [expr {$l - $find_dirn}]
6564 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6568 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6573 proc findselectline {l} {
6574 global findloc commentend ctext findcurline markingmatches gdttype
6576 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6579 if {$markingmatches &&
6580 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6581 # highlight the matches in the comments
6582 set f [$ctext get 1.0 $commentend]
6583 set matches [findmatches $f]
6584 foreach match $matches {
6585 set start [lindex $match 0]
6586 set end [expr {[lindex $match 1] + 1}]
6587 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6593 # mark the bits of a headline or author that match a find string
6594 proc markmatches {canv l str tag matches font row} {
6597 set bbox [$canv bbox $tag]
6598 set x0 [lindex $bbox 0]
6599 set y0 [lindex $bbox 1]
6600 set y1 [lindex $bbox 3]
6601 foreach match $matches {
6602 set start [lindex $match 0]
6603 set end [lindex $match 1]
6604 if {$start > $end} continue
6605 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6606 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6607 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6608 [expr {$x0+$xlen+2}] $y1 \
6609 -outline {} -tags [list match$l matches] -fill yellow]
6611 if {$row == $selectedline} {
6612 $canv raise $t secsel
6617 proc unmarkmatches {} {
6618 global markingmatches
6620 allcanvs delete matches
6621 set markingmatches 0
6625 proc selcanvline {w x y} {
6626 global canv canvy0 ctext linespc
6628 set ymax [lindex [$canv cget -scrollregion] 3]
6629 if {$ymax == {}} return
6630 set yfrac [lindex [$canv yview] 0]
6631 set y [expr {$y + $yfrac * $ymax}]
6632 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6637 set xmax [lindex [$canv cget -scrollregion] 2]
6638 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6639 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6645 proc commit_descriptor {p} {
6647 if {![info exists commitinfo($p)]} {
6651 if {[llength $commitinfo($p)] > 1} {
6652 set l [lindex $commitinfo($p) 0]
6657 # append some text to the ctext widget, and make any SHA1 ID
6658 # that we know about be a clickable link.
6659 proc appendwithlinks {text tags} {
6660 global ctext linknum curview
6662 set start [$ctext index "end - 1c"]
6663 $ctext insert end $text $tags
6664 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6668 set linkid [string range $text $s $e]
6670 $ctext tag delete link$linknum
6671 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6672 setlink $linkid link$linknum
6677 proc setlink {id lk} {
6678 global curview ctext pendinglinks
6681 if {[string length $id] < 40} {
6682 set matches [longid $id]
6683 if {[llength $matches] > 0} {
6684 if {[llength $matches] > 1} return
6686 set id [lindex $matches 0]
6689 set known [commitinview $id $curview]
6692 $ctext tag conf $lk -foreground blue -underline 1
6693 $ctext tag bind $lk <1> [list selbyid $id]
6694 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6695 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6697 lappend pendinglinks($id) $lk
6698 interestedin $id {makelink %P}
6702 proc appendshortlink {id {pre {}} {post {}}} {
6703 global ctext linknum
6705 $ctext insert end $pre
6706 $ctext tag delete link$linknum
6707 $ctext insert end [string range $id 0 7] link$linknum
6708 $ctext insert end $post
6709 setlink $id link$linknum
6713 proc makelink {id} {
6716 if {![info exists pendinglinks($id)]} return
6717 foreach lk $pendinglinks($id) {
6720 unset pendinglinks($id)
6723 proc linkcursor {w inc} {
6724 global linkentercount curtextcursor
6726 if {[incr linkentercount $inc] > 0} {
6727 $w configure -cursor hand2
6729 $w configure -cursor $curtextcursor
6730 if {$linkentercount < 0} {
6731 set linkentercount 0
6736 proc viewnextline {dir} {
6740 set ymax [lindex [$canv cget -scrollregion] 3]
6741 set wnow [$canv yview]
6742 set wtop [expr {[lindex $wnow 0] * $ymax}]
6743 set newtop [expr {$wtop + $dir * $linespc}]
6746 } elseif {$newtop > $ymax} {
6749 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6752 # add a list of tag or branch names at position pos
6753 # returns the number of names inserted
6754 proc appendrefs {pos ids var} {
6755 global ctext linknum curview $var maxrefs
6757 if {[catch {$ctext index $pos}]} {
6760 $ctext conf -state normal
6761 $ctext delete $pos "$pos lineend"
6764 foreach tag [set $var\($id\)] {
6765 lappend tags [list $tag $id]
6768 if {[llength $tags] > $maxrefs} {
6769 $ctext insert $pos "[mc "many"] ([llength $tags])"
6771 set tags [lsort -index 0 -decreasing $tags]
6774 set id [lindex $ti 1]
6777 $ctext tag delete $lk
6778 $ctext insert $pos $sep
6779 $ctext insert $pos [lindex $ti 0] $lk
6784 $ctext conf -state disabled
6785 return [llength $tags]
6788 # called when we have finished computing the nearby tags
6789 proc dispneartags {delay} {
6790 global selectedline currentid showneartags tagphase
6792 if {$selectedline eq {} || !$showneartags} return
6793 after cancel dispnexttag
6795 after 200 dispnexttag
6798 after idle dispnexttag
6803 proc dispnexttag {} {
6804 global selectedline currentid showneartags tagphase ctext
6806 if {$selectedline eq {} || !$showneartags} return
6807 switch -- $tagphase {
6809 set dtags [desctags $currentid]
6811 appendrefs precedes $dtags idtags
6815 set atags [anctags $currentid]
6817 appendrefs follows $atags idtags
6821 set dheads [descheads $currentid]
6822 if {$dheads ne {}} {
6823 if {[appendrefs branch $dheads idheads] > 1
6824 && [$ctext get "branch -3c"] eq "h"} {
6825 # turn "Branch" into "Branches"
6826 $ctext conf -state normal
6827 $ctext insert "branch -2c" "es"
6828 $ctext conf -state disabled
6833 if {[incr tagphase] <= 2} {
6834 after idle dispnexttag
6838 proc make_secsel {id} {
6839 global linehtag linentag linedtag canv canv2 canv3
6841 if {![info exists linehtag($id)]} return
6843 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6844 -tags secsel -fill [$canv cget -selectbackground]]
6846 $canv2 delete secsel
6847 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6848 -tags secsel -fill [$canv2 cget -selectbackground]]
6850 $canv3 delete secsel
6851 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6852 -tags secsel -fill [$canv3 cget -selectbackground]]
6856 proc make_idmark {id} {
6857 global linehtag canv fgcolor
6859 if {![info exists linehtag($id)]} return
6861 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6862 -tags markid -outline $fgcolor]
6866 proc selectline {l isnew {desired_loc {}}} {
6867 global canv ctext commitinfo selectedline
6868 global canvy0 linespc parents children curview
6869 global currentid sha1entry
6870 global commentend idtags linknum
6871 global mergemax numcommits pending_select
6872 global cmitmode showneartags allcommits
6873 global targetrow targetid lastscrollrows
6874 global autoselect jump_to_here
6876 catch {unset pending_select}
6881 if {$l < 0 || $l >= $numcommits} return
6882 set id [commitonrow $l]
6887 if {$lastscrollrows < $numcommits} {
6891 set y [expr {$canvy0 + $l * $linespc}]
6892 set ymax [lindex [$canv cget -scrollregion] 3]
6893 set ytop [expr {$y - $linespc - 1}]
6894 set ybot [expr {$y + $linespc + 1}]
6895 set wnow [$canv yview]
6896 set wtop [expr {[lindex $wnow 0] * $ymax}]
6897 set wbot [expr {[lindex $wnow 1] * $ymax}]
6898 set wh [expr {$wbot - $wtop}]
6900 if {$ytop < $wtop} {
6901 if {$ybot < $wtop} {
6902 set newtop [expr {$y - $wh / 2.0}]
6905 if {$newtop > $wtop - $linespc} {
6906 set newtop [expr {$wtop - $linespc}]
6909 } elseif {$ybot > $wbot} {
6910 if {$ytop > $wbot} {
6911 set newtop [expr {$y - $wh / 2.0}]
6913 set newtop [expr {$ybot - $wh}]
6914 if {$newtop < $wtop + $linespc} {
6915 set newtop [expr {$wtop + $linespc}]
6919 if {$newtop != $wtop} {
6923 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6930 addtohistory [list selbyid $id 0] savecmitpos
6933 $sha1entry delete 0 end
6934 $sha1entry insert 0 $id
6936 $sha1entry selection range 0 end
6940 $ctext conf -state normal
6943 if {![info exists commitinfo($id)]} {
6946 set info $commitinfo($id)
6947 set date [formatdate [lindex $info 2]]
6948 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6949 set date [formatdate [lindex $info 4]]
6950 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6951 if {[info exists idtags($id)]} {
6952 $ctext insert end [mc "Tags:"]
6953 foreach tag $idtags($id) {
6954 $ctext insert end " $tag"
6956 $ctext insert end "\n"
6960 set olds $parents($curview,$id)
6961 if {[llength $olds] > 1} {
6964 if {$np >= $mergemax} {
6969 $ctext insert end "[mc "Parent"]: " $tag
6970 appendwithlinks [commit_descriptor $p] {}
6975 append headers "[mc "Parent"]: [commit_descriptor $p]"
6979 foreach c $children($curview,$id) {
6980 append headers "[mc "Child"]: [commit_descriptor $c]"
6983 # make anything that looks like a SHA1 ID be a clickable link
6984 appendwithlinks $headers {}
6985 if {$showneartags} {
6986 if {![info exists allcommits]} {
6989 $ctext insert end "[mc "Branch"]: "
6990 $ctext mark set branch "end -1c"
6991 $ctext mark gravity branch left
6992 $ctext insert end "\n[mc "Follows"]: "
6993 $ctext mark set follows "end -1c"
6994 $ctext mark gravity follows left
6995 $ctext insert end "\n[mc "Precedes"]: "
6996 $ctext mark set precedes "end -1c"
6997 $ctext mark gravity precedes left
6998 $ctext insert end "\n"
7001 $ctext insert end "\n"
7002 set comment [lindex $info 5]
7003 if {[string first "\r" $comment] >= 0} {
7004 set comment [string map {"\r" "\n "} $comment]
7006 appendwithlinks $comment {comment}
7008 $ctext tag remove found 1.0 end
7009 $ctext conf -state disabled
7010 set commentend [$ctext index "end - 1c"]
7012 set jump_to_here $desired_loc
7013 init_flist [mc "Comments"]
7014 if {$cmitmode eq "tree"} {
7016 } elseif {[llength $olds] <= 1} {
7023 proc selfirstline {} {
7028 proc sellastline {} {
7031 set l [expr {$numcommits - 1}]
7035 proc selnextline {dir} {
7038 if {$selectedline eq {}} return
7039 set l [expr {$selectedline + $dir}]
7044 proc selnextpage {dir} {
7045 global canv linespc selectedline numcommits
7047 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7051 allcanvs yview scroll [expr {$dir * $lpp}] units
7053 if {$selectedline eq {}} return
7054 set l [expr {$selectedline + $dir * $lpp}]
7057 } elseif {$l >= $numcommits} {
7058 set l [expr $numcommits - 1]
7064 proc unselectline {} {
7065 global selectedline currentid
7068 catch {unset currentid}
7069 allcanvs delete secsel
7073 proc reselectline {} {
7076 if {$selectedline ne {}} {
7077 selectline $selectedline 0
7081 proc addtohistory {cmd {saveproc {}}} {
7082 global history historyindex curview
7086 set elt [list $curview $cmd $saveproc {}]
7087 if {$historyindex > 0
7088 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7092 if {$historyindex < [llength $history]} {
7093 set history [lreplace $history $historyindex end $elt]
7095 lappend history $elt
7098 if {$historyindex > 1} {
7099 .tf.bar.leftbut conf -state normal
7101 .tf.bar.leftbut conf -state disabled
7103 .tf.bar.rightbut conf -state disabled
7106 # save the scrolling position of the diff display pane
7107 proc save_position {} {
7108 global historyindex history
7110 if {$historyindex < 1} return
7111 set hi [expr {$historyindex - 1}]
7112 set fn [lindex $history $hi 2]
7114 lset history $hi 3 [eval $fn]
7118 proc unset_posvars {} {
7121 if {[info exists last_posvars]} {
7122 foreach {var val} $last_posvars {
7131 global curview last_posvars
7133 set view [lindex $elt 0]
7134 set cmd [lindex $elt 1]
7135 set pv [lindex $elt 3]
7136 if {$curview != $view} {
7140 foreach {var val} $pv {
7144 set last_posvars $pv
7149 global history historyindex
7152 if {$historyindex > 1} {
7154 incr historyindex -1
7155 godo [lindex $history [expr {$historyindex - 1}]]
7156 .tf.bar.rightbut conf -state normal
7158 if {$historyindex <= 1} {
7159 .tf.bar.leftbut conf -state disabled
7164 global history historyindex
7167 if {$historyindex < [llength $history]} {
7169 set cmd [lindex $history $historyindex]
7172 .tf.bar.leftbut conf -state normal
7174 if {$historyindex >= [llength $history]} {
7175 .tf.bar.rightbut conf -state disabled
7180 global treefilelist treeidlist diffids diffmergeid treepending
7181 global nullid nullid2
7184 catch {unset diffmergeid}
7185 if {![info exists treefilelist($id)]} {
7186 if {![info exists treepending]} {
7187 if {$id eq $nullid} {
7188 set cmd [list | git ls-files]
7189 } elseif {$id eq $nullid2} {
7190 set cmd [list | git ls-files --stage -t]
7192 set cmd [list | git ls-tree -r $id]
7194 if {[catch {set gtf [open $cmd r]}]} {
7198 set treefilelist($id) {}
7199 set treeidlist($id) {}
7200 fconfigure $gtf -blocking 0 -encoding binary
7201 filerun $gtf [list gettreeline $gtf $id]
7208 proc gettreeline {gtf id} {
7209 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7212 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7213 if {$diffids eq $nullid} {
7216 set i [string first "\t" $line]
7217 if {$i < 0} continue
7218 set fname [string range $line [expr {$i+1}] end]
7219 set line [string range $line 0 [expr {$i-1}]]
7220 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7221 set sha1 [lindex $line 2]
7222 lappend treeidlist($id) $sha1
7224 if {[string index $fname 0] eq "\""} {
7225 set fname [lindex $fname 0]
7227 set fname [encoding convertfrom $fname]
7228 lappend treefilelist($id) $fname
7231 return [expr {$nl >= 1000? 2: 1}]
7235 if {$cmitmode ne "tree"} {
7236 if {![info exists diffmergeid]} {
7237 gettreediffs $diffids
7239 } elseif {$id ne $diffids} {
7248 global treefilelist treeidlist diffids nullid nullid2
7249 global ctext_file_names ctext_file_lines
7250 global ctext commentend
7252 set i [lsearch -exact $treefilelist($diffids) $f]
7254 puts "oops, $f not in list for id $diffids"
7257 if {$diffids eq $nullid} {
7258 if {[catch {set bf [open $f r]} err]} {
7259 puts "oops, can't read $f: $err"
7263 set blob [lindex $treeidlist($diffids) $i]
7264 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7265 puts "oops, error reading blob $blob: $err"
7269 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7270 filerun $bf [list getblobline $bf $diffids]
7271 $ctext config -state normal
7272 clear_ctext $commentend
7273 lappend ctext_file_names $f
7274 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7275 $ctext insert end "\n"
7276 $ctext insert end "$f\n" filesep
7277 $ctext config -state disabled
7278 $ctext yview $commentend
7282 proc getblobline {bf id} {
7283 global diffids cmitmode ctext
7285 if {$id ne $diffids || $cmitmode ne "tree"} {
7289 $ctext config -state normal
7291 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7292 $ctext insert end "$line\n"
7295 global jump_to_here ctext_file_names commentend
7297 # delete last newline
7298 $ctext delete "end - 2c" "end - 1c"
7300 if {$jump_to_here ne {} &&
7301 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7302 set lnum [expr {[lindex $jump_to_here 1] +
7303 [lindex [split $commentend .] 0]}]
7304 mark_ctext_line $lnum
7308 $ctext config -state disabled
7309 return [expr {$nl >= 1000? 2: 1}]
7312 proc mark_ctext_line {lnum} {
7313 global ctext markbgcolor
7315 $ctext tag delete omark
7316 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7317 $ctext tag conf omark -background $markbgcolor
7321 proc mergediff {id} {
7323 global diffids treediffs
7324 global parents curview
7328 set treediffs($id) {}
7329 set np [llength $parents($curview,$id)]
7334 proc startdiff {ids} {
7335 global treediffs diffids treepending diffmergeid nullid nullid2
7339 catch {unset diffmergeid}
7340 if {![info exists treediffs($ids)] ||
7341 [lsearch -exact $ids $nullid] >= 0 ||
7342 [lsearch -exact $ids $nullid2] >= 0} {
7343 if {![info exists treepending]} {
7351 proc path_filter {filter name} {
7353 set l [string length $p]
7354 if {[string index $p end] eq "/"} {
7355 if {[string compare -length $l $p $name] == 0} {
7359 if {[string compare -length $l $p $name] == 0 &&
7360 ([string length $name] == $l ||
7361 [string index $name $l] eq "/")} {
7369 proc addtocflist {ids} {
7372 add_flist $treediffs($ids)
7376 proc diffcmd {ids flags} {
7377 global nullid nullid2
7379 set i [lsearch -exact $ids $nullid]
7380 set j [lsearch -exact $ids $nullid2]
7382 if {[llength $ids] > 1 && $j < 0} {
7383 # comparing working directory with some specific revision
7384 set cmd [concat | git diff-index $flags]
7386 lappend cmd -R [lindex $ids 1]
7388 lappend cmd [lindex $ids 0]
7391 # comparing working directory with index
7392 set cmd [concat | git diff-files $flags]
7397 } elseif {$j >= 0} {
7398 set cmd [concat | git diff-index --cached $flags]
7399 if {[llength $ids] > 1} {
7400 # comparing index with specific revision
7402 lappend cmd -R [lindex $ids 1]
7404 lappend cmd [lindex $ids 0]
7407 # comparing index with HEAD
7411 set cmd [concat | git diff-tree -r $flags $ids]
7416 proc gettreediffs {ids} {
7417 global treediff treepending
7419 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7421 set treepending $ids
7423 fconfigure $gdtf -blocking 0 -encoding binary
7424 filerun $gdtf [list gettreediffline $gdtf $ids]
7427 proc gettreediffline {gdtf ids} {
7428 global treediff treediffs treepending diffids diffmergeid
7429 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7434 if {$perfile_attrs} {
7435 # cache_gitattr is slow, and even slower on win32 where we
7436 # have to invoke it for only about 30 paths at a time
7438 if {[tk windowingsystem] == "win32"} {
7442 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7443 set i [string first "\t" $line]
7445 set file [string range $line [expr {$i+1}] end]
7446 if {[string index $file 0] eq "\""} {
7447 set file [lindex $file 0]
7449 set file [encoding convertfrom $file]
7450 if {$file ne [lindex $treediff end]} {
7451 lappend treediff $file
7452 lappend sublist $file
7456 if {$perfile_attrs} {
7457 cache_gitattr encoding $sublist
7460 return [expr {$nr >= $max? 2: 1}]
7463 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7465 foreach f $treediff {
7466 if {[path_filter $vfilelimit($curview) $f]} {
7470 set treediffs($ids) $flist
7472 set treediffs($ids) $treediff
7475 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7477 } elseif {$ids != $diffids} {
7478 if {![info exists diffmergeid]} {
7479 gettreediffs $diffids
7487 # empty string or positive integer
7488 proc diffcontextvalidate {v} {
7489 return [regexp {^(|[1-9][0-9]*)$} $v]
7492 proc diffcontextchange {n1 n2 op} {
7493 global diffcontextstring diffcontext
7495 if {[string is integer -strict $diffcontextstring]} {
7496 if {$diffcontextstring >= 0} {
7497 set diffcontext $diffcontextstring
7503 proc changeignorespace {} {
7507 proc getblobdiffs {ids} {
7508 global blobdifffd diffids env
7509 global diffinhdr treediffs
7512 global limitdiffs vfilelimit curview
7513 global diffencoding targetline diffnparents
7514 global git_version currdiffsubmod
7517 if {[package vcompare $git_version "1.6.1"] >= 0} {
7518 set textconv "--textconv"
7521 if {[package vcompare $git_version "1.6.6"] >= 0} {
7522 set submodule "--submodule"
7524 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
7528 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7529 set cmd [concat $cmd -- $vfilelimit($curview)]
7531 if {[catch {set bdf [open $cmd r]} err]} {
7532 error_popup [mc "Error getting diffs: %s" $err]
7538 set diffencoding [get_path_encoding {}]
7539 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7540 set blobdifffd($ids) $bdf
7541 set currdiffsubmod ""
7542 filerun $bdf [list getblobdiffline $bdf $diffids]
7545 proc savecmitpos {} {
7546 global ctext cmitmode
7548 if {$cmitmode eq "tree"} {
7551 return [list target_scrollpos [$ctext index @0,0]]
7554 proc savectextpos {} {
7557 return [list target_scrollpos [$ctext index @0,0]]
7560 proc maybe_scroll_ctext {ateof} {
7561 global ctext target_scrollpos
7563 if {![info exists target_scrollpos]} return
7565 set nlines [expr {[winfo height $ctext]
7566 / [font metrics textfont -linespace]}]
7567 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7569 $ctext yview $target_scrollpos
7570 unset target_scrollpos
7573 proc setinlist {var i val} {
7576 while {[llength [set $var]] < $i} {
7579 if {[llength [set $var]] == $i} {
7586 proc makediffhdr {fname ids} {
7587 global ctext curdiffstart treediffs diffencoding
7588 global ctext_file_names jump_to_here targetline diffline
7590 set fname [encoding convertfrom $fname]
7591 set diffencoding [get_path_encoding $fname]
7592 set i [lsearch -exact $treediffs($ids) $fname]
7594 setinlist difffilestart $i $curdiffstart
7596 lset ctext_file_names end $fname
7597 set l [expr {(78 - [string length $fname]) / 2}]
7598 set pad [string range "----------------------------------------" 1 $l]
7599 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7601 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7602 set targetline [lindex $jump_to_here 1]
7607 proc getblobdiffline {bdf ids} {
7608 global diffids blobdifffd ctext curdiffstart
7609 global diffnexthead diffnextnote difffilestart
7610 global ctext_file_names ctext_file_lines
7611 global diffinhdr treediffs mergemax diffnparents
7612 global diffencoding jump_to_here targetline diffline currdiffsubmod
7615 $ctext conf -state normal
7616 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7617 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7621 if {![string compare -length 5 "diff " $line]} {
7622 if {![regexp {^diff (--cc|--git) } $line m type]} {
7623 set line [encoding convertfrom $line]
7624 $ctext insert end "$line\n" hunksep
7627 # start of a new file
7629 $ctext insert end "\n"
7630 set curdiffstart [$ctext index "end - 1c"]
7631 lappend ctext_file_names ""
7632 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7633 $ctext insert end "\n" filesep
7635 if {$type eq "--cc"} {
7636 # start of a new file in a merge diff
7637 set fname [string range $line 10 end]
7638 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7639 lappend treediffs($ids) $fname
7640 add_flist [list $fname]
7644 set line [string range $line 11 end]
7645 # If the name hasn't changed the length will be odd,
7646 # the middle char will be a space, and the two bits either
7647 # side will be a/name and b/name, or "a/name" and "b/name".
7648 # If the name has changed we'll get "rename from" and
7649 # "rename to" or "copy from" and "copy to" lines following
7650 # this, and we'll use them to get the filenames.
7651 # This complexity is necessary because spaces in the
7652 # filename(s) don't get escaped.
7653 set l [string length $line]
7654 set i [expr {$l / 2}]
7655 if {!(($l & 1) && [string index $line $i] eq " " &&
7656 [string range $line 2 [expr {$i - 1}]] eq \
7657 [string range $line [expr {$i + 3}] end])} {
7660 # unescape if quoted and chop off the a/ from the front
7661 if {[string index $line 0] eq "\""} {
7662 set fname [string range [lindex $line 0] 2 end]
7664 set fname [string range $line 2 [expr {$i - 1}]]
7667 makediffhdr $fname $ids
7669 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7670 set fname [encoding convertfrom [string range $line 16 end]]
7671 $ctext insert end "\n"
7672 set curdiffstart [$ctext index "end - 1c"]
7673 lappend ctext_file_names $fname
7674 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7675 $ctext insert end "$line\n" filesep
7676 set i [lsearch -exact $treediffs($ids) $fname]
7678 setinlist difffilestart $i $curdiffstart
7681 } elseif {![string compare -length 2 "@@" $line]} {
7682 regexp {^@@+} $line ats
7683 set line [encoding convertfrom $diffencoding $line]
7684 $ctext insert end "$line\n" hunksep
7685 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7688 set diffnparents [expr {[string length $ats] - 1}]
7691 } elseif {![string compare -length 10 "Submodule " $line]} {
7692 # start of a new submodule
7693 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7694 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7696 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7698 if {$currdiffsubmod != $fname} {
7699 $ctext insert end "\n"; # Add newline after commit message
7701 set curdiffstart [$ctext index "end - 1c"]
7702 lappend ctext_file_names ""
7703 if {$currdiffsubmod != $fname} {
7704 lappend ctext_file_lines $fname
7705 makediffhdr $fname $ids
7706 set currdiffsubmod $fname
7707 $ctext insert end "\n$line\n" filesep
7709 $ctext insert end "$line\n" filesep
7711 } elseif {![string compare -length 3 " >" $line]} {
7712 set $currdiffsubmod ""
7713 set line [encoding convertfrom $diffencoding $line]
7714 $ctext insert end "$line\n" dresult
7715 } elseif {![string compare -length 3 " <" $line]} {
7716 set $currdiffsubmod ""
7717 set line [encoding convertfrom $diffencoding $line]
7718 $ctext insert end "$line\n" d0
7719 } elseif {$diffinhdr} {
7720 if {![string compare -length 12 "rename from " $line]} {
7721 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7722 if {[string index $fname 0] eq "\""} {
7723 set fname [lindex $fname 0]
7725 set fname [encoding convertfrom $fname]
7726 set i [lsearch -exact $treediffs($ids) $fname]
7728 setinlist difffilestart $i $curdiffstart
7730 } elseif {![string compare -length 10 $line "rename to "] ||
7731 ![string compare -length 8 $line "copy to "]} {
7732 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7733 if {[string index $fname 0] eq "\""} {
7734 set fname [lindex $fname 0]
7736 makediffhdr $fname $ids
7737 } elseif {[string compare -length 3 $line "---"] == 0} {
7740 } elseif {[string compare -length 3 $line "+++"] == 0} {
7744 $ctext insert end "$line\n" filesep
7747 set line [string map {\x1A ^Z} \
7748 [encoding convertfrom $diffencoding $line]]
7749 # parse the prefix - one ' ', '-' or '+' for each parent
7750 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7751 set tag [expr {$diffnparents > 1? "m": "d"}]
7752 if {[string trim $prefix " -+"] eq {}} {
7753 # prefix only has " ", "-" and "+" in it: normal diff line
7754 set num [string first "-" $prefix]
7756 # removed line, first parent with line is $num
7757 if {$num >= $mergemax} {
7760 $ctext insert end "$line\n" $tag$num
7763 if {[string first "+" $prefix] >= 0} {
7765 lappend tags ${tag}result
7766 if {$diffnparents > 1} {
7767 set num [string first " " $prefix]
7769 if {$num >= $mergemax} {
7776 if {$targetline ne {}} {
7777 if {$diffline == $targetline} {
7778 set seehere [$ctext index "end - 1 chars"]
7784 $ctext insert end "$line\n" $tags
7787 # "\ No newline at end of file",
7788 # or something else we don't recognize
7789 $ctext insert end "$line\n" hunksep
7793 if {[info exists seehere]} {
7794 mark_ctext_line [lindex [split $seehere .] 0]
7796 maybe_scroll_ctext [eof $bdf]
7797 $ctext conf -state disabled
7802 return [expr {$nr >= 1000? 2: 1}]
7805 proc changediffdisp {} {
7806 global ctext diffelide
7808 $ctext tag conf d0 -elide [lindex $diffelide 0]
7809 $ctext tag conf dresult -elide [lindex $diffelide 1]
7812 proc highlightfile {loc cline} {
7813 global ctext cflist cflist_top
7816 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7817 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7818 $cflist see $cline.0
7819 set cflist_top $cline
7823 global difffilestart ctext cmitmode
7825 if {$cmitmode eq "tree"} return
7828 set here [$ctext index @0,0]
7829 foreach loc $difffilestart {
7830 if {[$ctext compare $loc >= $here]} {
7831 highlightfile $prev $prevline
7837 highlightfile $prev $prevline
7841 global difffilestart ctext cmitmode
7843 if {$cmitmode eq "tree"} return
7844 set here [$ctext index @0,0]
7846 foreach loc $difffilestart {
7848 if {[$ctext compare $loc > $here]} {
7849 highlightfile $loc $line
7855 proc clear_ctext {{first 1.0}} {
7856 global ctext smarktop smarkbot
7857 global ctext_file_names ctext_file_lines
7860 set l [lindex [split $first .] 0]
7861 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7864 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7867 $ctext delete $first end
7868 if {$first eq "1.0"} {
7869 catch {unset pendinglinks}
7871 set ctext_file_names {}
7872 set ctext_file_lines {}
7875 proc settabs {{firstab {}}} {
7876 global firsttabstop tabstop ctext have_tk85
7878 if {$firstab ne {} && $have_tk85} {
7879 set firsttabstop $firstab
7881 set w [font measure textfont "0"]
7882 if {$firsttabstop != 0} {
7883 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7884 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7885 } elseif {$have_tk85 || $tabstop != 8} {
7886 $ctext conf -tabs [expr {$tabstop * $w}]
7888 $ctext conf -tabs {}
7892 proc incrsearch {name ix op} {
7893 global ctext searchstring searchdirn
7895 $ctext tag remove found 1.0 end
7896 if {[catch {$ctext index anchor}]} {
7897 # no anchor set, use start of selection, or of visible area
7898 set sel [$ctext tag ranges sel]
7900 $ctext mark set anchor [lindex $sel 0]
7901 } elseif {$searchdirn eq "-forwards"} {
7902 $ctext mark set anchor @0,0
7904 $ctext mark set anchor @0,[winfo height $ctext]
7907 if {$searchstring ne {}} {
7908 set here [$ctext search $searchdirn -- $searchstring anchor]
7917 global sstring ctext searchstring searchdirn
7920 $sstring icursor end
7921 set searchdirn -forwards
7922 if {$searchstring ne {}} {
7923 set sel [$ctext tag ranges sel]
7925 set start "[lindex $sel 0] + 1c"
7926 } elseif {[catch {set start [$ctext index anchor]}]} {
7929 set match [$ctext search -count mlen -- $searchstring $start]
7930 $ctext tag remove sel 1.0 end
7936 set mend "$match + $mlen c"
7937 $ctext tag add sel $match $mend
7938 $ctext mark unset anchor
7942 proc dosearchback {} {
7943 global sstring ctext searchstring searchdirn
7946 $sstring icursor end
7947 set searchdirn -backwards
7948 if {$searchstring ne {}} {
7949 set sel [$ctext tag ranges sel]
7951 set start [lindex $sel 0]
7952 } elseif {[catch {set start [$ctext index anchor]}]} {
7953 set start @0,[winfo height $ctext]
7955 set match [$ctext search -backwards -count ml -- $searchstring $start]
7956 $ctext tag remove sel 1.0 end
7962 set mend "$match + $ml c"
7963 $ctext tag add sel $match $mend
7964 $ctext mark unset anchor
7968 proc searchmark {first last} {
7969 global ctext searchstring
7973 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7974 if {$match eq {}} break
7975 set mend "$match + $mlen c"
7976 $ctext tag add found $match $mend
7980 proc searchmarkvisible {doall} {
7981 global ctext smarktop smarkbot
7983 set topline [lindex [split [$ctext index @0,0] .] 0]
7984 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7985 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7986 # no overlap with previous
7987 searchmark $topline $botline
7988 set smarktop $topline
7989 set smarkbot $botline
7991 if {$topline < $smarktop} {
7992 searchmark $topline [expr {$smarktop-1}]
7993 set smarktop $topline
7995 if {$botline > $smarkbot} {
7996 searchmark [expr {$smarkbot+1}] $botline
7997 set smarkbot $botline
8002 proc scrolltext {f0 f1} {
8005 .bleft.bottom.sb set $f0 $f1
8006 if {$searchstring ne {}} {
8012 global linespc charspc canvx0 canvy0
8013 global xspc1 xspc2 lthickness
8015 set linespc [font metrics mainfont -linespace]
8016 set charspc [font measure mainfont "m"]
8017 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8018 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8019 set lthickness [expr {int($linespc / 9) + 1}]
8020 set xspc1(0) $linespc
8028 set ymax [lindex [$canv cget -scrollregion] 3]
8029 if {$ymax eq {} || $ymax == 0} return
8030 set span [$canv yview]
8033 allcanvs yview moveto [lindex $span 0]
8035 if {$selectedline ne {}} {
8036 selectline $selectedline 0
8037 allcanvs yview moveto [lindex $span 0]
8041 proc parsefont {f n} {
8044 set fontattr($f,family) [lindex $n 0]
8046 if {$s eq {} || $s == 0} {
8049 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8051 set fontattr($f,size) $s
8052 set fontattr($f,weight) normal
8053 set fontattr($f,slant) roman
8054 foreach style [lrange $n 2 end] {
8057 "bold" {set fontattr($f,weight) $style}
8059 "italic" {set fontattr($f,slant) $style}
8064 proc fontflags {f {isbold 0}} {
8067 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8068 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8069 -slant $fontattr($f,slant)]
8075 set n [list $fontattr($f,family) $fontattr($f,size)]
8076 if {$fontattr($f,weight) eq "bold"} {
8079 if {$fontattr($f,slant) eq "italic"} {
8085 proc incrfont {inc} {
8086 global mainfont textfont ctext canv cflist showrefstop
8087 global stopped entries fontattr
8090 set s $fontattr(mainfont,size)
8095 set fontattr(mainfont,size) $s
8096 font config mainfont -size $s
8097 font config mainfontbold -size $s
8098 set mainfont [fontname mainfont]
8099 set s $fontattr(textfont,size)
8104 set fontattr(textfont,size) $s
8105 font config textfont -size $s
8106 font config textfontbold -size $s
8107 set textfont [fontname textfont]
8114 global sha1entry sha1string
8115 if {[string length $sha1string] == 40} {
8116 $sha1entry delete 0 end
8120 proc sha1change {n1 n2 op} {
8121 global sha1string currentid sha1but
8122 if {$sha1string == {}
8123 || ([info exists currentid] && $sha1string == $currentid)} {
8128 if {[$sha1but cget -state] == $state} return
8129 if {$state == "normal"} {
8130 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8132 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8136 proc gotocommit {} {
8137 global sha1string tagids headids curview varcid
8139 if {$sha1string == {}
8140 || ([info exists currentid] && $sha1string == $currentid)} return
8141 if {[info exists tagids($sha1string)]} {
8142 set id $tagids($sha1string)
8143 } elseif {[info exists headids($sha1string)]} {
8144 set id $headids($sha1string)
8146 set id [string tolower $sha1string]
8147 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8148 set matches [longid $id]
8149 if {$matches ne {}} {
8150 if {[llength $matches] > 1} {
8151 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8154 set id [lindex $matches 0]
8157 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8158 error_popup [mc "Revision %s is not known" $sha1string]
8163 if {[commitinview $id $curview]} {
8164 selectline [rowofcommit $id] 1
8167 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8168 set msg [mc "SHA1 id %s is not known" $sha1string]
8170 set msg [mc "Revision %s is not in the current view" $sha1string]
8175 proc lineenter {x y id} {
8176 global hoverx hovery hoverid hovertimer
8177 global commitinfo canv
8179 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8183 if {[info exists hovertimer]} {
8184 after cancel $hovertimer
8186 set hovertimer [after 500 linehover]
8190 proc linemotion {x y id} {
8191 global hoverx hovery hoverid hovertimer
8193 if {[info exists hoverid] && $id == $hoverid} {
8196 if {[info exists hovertimer]} {
8197 after cancel $hovertimer
8199 set hovertimer [after 500 linehover]
8203 proc lineleave {id} {
8204 global hoverid hovertimer canv
8206 if {[info exists hoverid] && $id == $hoverid} {
8208 if {[info exists hovertimer]} {
8209 after cancel $hovertimer
8217 global hoverx hovery hoverid hovertimer
8218 global canv linespc lthickness
8221 set text [lindex $commitinfo($hoverid) 0]
8222 set ymax [lindex [$canv cget -scrollregion] 3]
8223 if {$ymax == {}} return
8224 set yfrac [lindex [$canv yview] 0]
8225 set x [expr {$hoverx + 2 * $linespc}]
8226 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8227 set x0 [expr {$x - 2 * $lthickness}]
8228 set y0 [expr {$y - 2 * $lthickness}]
8229 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8230 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8231 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8232 -fill \#ffff80 -outline black -width 1 -tags hover]
8234 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8239 proc clickisonarrow {id y} {
8242 set ranges [rowranges $id]
8243 set thresh [expr {2 * $lthickness + 6}]
8244 set n [expr {[llength $ranges] - 1}]
8245 for {set i 1} {$i < $n} {incr i} {
8246 set row [lindex $ranges $i]
8247 if {abs([yc $row] - $y) < $thresh} {
8254 proc arrowjump {id n y} {
8257 # 1 <-> 2, 3 <-> 4, etc...
8258 set n [expr {(($n - 1) ^ 1) + 1}]
8259 set row [lindex [rowranges $id] $n]
8261 set ymax [lindex [$canv cget -scrollregion] 3]
8262 if {$ymax eq {} || $ymax <= 0} return
8263 set view [$canv yview]
8264 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8265 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8269 allcanvs yview moveto $yfrac
8272 proc lineclick {x y id isnew} {
8273 global ctext commitinfo children canv thickerline curview
8275 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8280 # draw this line thicker than normal
8284 set ymax [lindex [$canv cget -scrollregion] 3]
8285 if {$ymax eq {}} return
8286 set yfrac [lindex [$canv yview] 0]
8287 set y [expr {$y + $yfrac * $ymax}]
8289 set dirn [clickisonarrow $id $y]
8291 arrowjump $id $dirn $y
8296 addtohistory [list lineclick $x $y $id 0] savectextpos
8298 # fill the details pane with info about this line
8299 $ctext conf -state normal
8302 $ctext insert end "[mc "Parent"]:\t"
8303 $ctext insert end $id link0
8305 set info $commitinfo($id)
8306 $ctext insert end "\n\t[lindex $info 0]\n"
8307 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8308 set date [formatdate [lindex $info 2]]
8309 $ctext insert end "\t[mc "Date"]:\t$date\n"
8310 set kids $children($curview,$id)
8312 $ctext insert end "\n[mc "Children"]:"
8314 foreach child $kids {
8316 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8317 set info $commitinfo($child)
8318 $ctext insert end "\n\t"
8319 $ctext insert end $child link$i
8320 setlink $child link$i
8321 $ctext insert end "\n\t[lindex $info 0]"
8322 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8323 set date [formatdate [lindex $info 2]]
8324 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8327 maybe_scroll_ctext 1
8328 $ctext conf -state disabled
8332 proc normalline {} {
8334 if {[info exists thickerline]} {
8341 proc selbyid {id {isnew 1}} {
8343 if {[commitinview $id $curview]} {
8344 selectline [rowofcommit $id] $isnew
8350 if {![info exists startmstime]} {
8351 set startmstime [clock clicks -milliseconds]
8353 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8356 proc rowmenu {x y id} {
8357 global rowctxmenu selectedline rowmenuid curview
8358 global nullid nullid2 fakerowmenu mainhead markedid
8362 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8367 if {$id ne $nullid && $id ne $nullid2} {
8368 set menu $rowctxmenu
8369 if {$mainhead ne {}} {
8370 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8372 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8374 if {[info exists markedid] && $markedid ne $id} {
8375 $menu entryconfigure 9 -state normal
8376 $menu entryconfigure 10 -state normal
8377 $menu entryconfigure 11 -state normal
8379 $menu entryconfigure 9 -state disabled
8380 $menu entryconfigure 10 -state disabled
8381 $menu entryconfigure 11 -state disabled
8384 set menu $fakerowmenu
8386 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8387 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8388 $menu entryconfigure [mca "Make patch"] -state $state
8389 tk_popup $menu $x $y
8393 global rowmenuid markedid canv
8395 set markedid $rowmenuid
8396 make_idmark $markedid
8402 if {[info exists markedid]} {
8407 proc replace_by_kids {l r} {
8408 global curview children
8410 set id [commitonrow $r]
8411 set l [lreplace $l 0 0]
8412 foreach kid $children($curview,$id) {
8413 lappend l [rowofcommit $kid]
8415 return [lsort -integer -decreasing -unique $l]
8418 proc find_common_desc {} {
8419 global markedid rowmenuid curview children
8421 if {![info exists markedid]} return
8422 if {![commitinview $markedid $curview] ||
8423 ![commitinview $rowmenuid $curview]} return
8424 #set t1 [clock clicks -milliseconds]
8425 set l1 [list [rowofcommit $markedid]]
8426 set l2 [list [rowofcommit $rowmenuid]]
8428 set r1 [lindex $l1 0]
8429 set r2 [lindex $l2 0]
8430 if {$r1 eq {} || $r2 eq {}} break
8436 set l1 [replace_by_kids $l1 $r1]
8438 set l2 [replace_by_kids $l2 $r2]
8441 #set t2 [clock clicks -milliseconds]
8442 #puts "took [expr {$t2-$t1}]ms"
8445 proc compare_commits {} {
8446 global markedid rowmenuid curview children
8448 if {![info exists markedid]} return
8449 if {![commitinview $markedid $curview]} return
8450 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8451 do_cmp_commits $markedid $rowmenuid
8454 proc getpatchid {id} {
8457 if {![info exists patchids($id)]} {
8458 set cmd [diffcmd [list $id] {-p --root}]
8459 # trim off the initial "|"
8460 set cmd [lrange $cmd 1 end]
8462 set x [eval exec $cmd | git patch-id]
8463 set patchids($id) [lindex $x 0]
8465 set patchids($id) "error"
8468 return $patchids($id)
8471 proc do_cmp_commits {a b} {
8472 global ctext curview parents children patchids commitinfo
8474 $ctext conf -state normal
8477 for {set i 0} {$i < 100} {incr i} {
8480 if {[llength $parents($curview,$a)] > 1} {
8481 appendshortlink $a [mc "Skipping merge commit "] "\n"
8484 set patcha [getpatchid $a]
8486 if {[llength $parents($curview,$b)] > 1} {
8487 appendshortlink $b [mc "Skipping merge commit "] "\n"
8490 set patchb [getpatchid $b]
8492 if {!$skipa && !$skipb} {
8493 set heada [lindex $commitinfo($a) 0]
8494 set headb [lindex $commitinfo($b) 0]
8495 if {$patcha eq "error"} {
8496 appendshortlink $a [mc "Error getting patch ID for "] \
8497 [mc " - stopping\n"]
8500 if {$patchb eq "error"} {
8501 appendshortlink $b [mc "Error getting patch ID for "] \
8502 [mc " - stopping\n"]
8505 if {$patcha eq $patchb} {
8506 if {$heada eq $headb} {
8507 appendshortlink $a [mc "Commit "]
8508 appendshortlink $b " == " " $heada\n"
8510 appendshortlink $a [mc "Commit "] " $heada\n"
8511 appendshortlink $b [mc " is the same patch as\n "] \
8517 $ctext insert end "\n"
8518 appendshortlink $a [mc "Commit "] " $heada\n"
8519 appendshortlink $b [mc " differs from\n "] \
8521 $ctext insert end [mc "Diff of commits:\n\n"]
8522 $ctext conf -state disabled
8529 set kids [real_children $curview,$a]
8530 if {[llength $kids] != 1} {
8531 $ctext insert end "\n"
8532 appendshortlink $a [mc "Commit "] \
8533 [mc " has %s children - stopping\n" [llength $kids]]
8536 set a [lindex $kids 0]
8539 set kids [real_children $curview,$b]
8540 if {[llength $kids] != 1} {
8541 appendshortlink $b [mc "Commit "] \
8542 [mc " has %s children - stopping\n" [llength $kids]]
8545 set b [lindex $kids 0]
8548 $ctext conf -state disabled
8551 proc diffcommits {a b} {
8552 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8554 set tmpdir [gitknewtmpdir]
8555 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8556 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8558 exec git diff-tree -p --pretty $a >$fna
8559 exec git diff-tree -p --pretty $b >$fnb
8561 error_popup [mc "Error writing commit to file: %s" $err]
8565 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8567 error_popup [mc "Error diffing commits: %s" $err]
8570 set diffids [list commits $a $b]
8571 set blobdifffd($diffids) $fd
8573 set currdiffsubmod ""
8574 filerun $fd [list getblobdiffline $fd $diffids]
8577 proc diffvssel {dirn} {
8578 global rowmenuid selectedline
8580 if {$selectedline eq {}} return
8582 set oldid [commitonrow $selectedline]
8583 set newid $rowmenuid
8585 set oldid $rowmenuid
8586 set newid [commitonrow $selectedline]
8588 addtohistory [list doseldiff $oldid $newid] savectextpos
8589 doseldiff $oldid $newid
8592 proc doseldiff {oldid newid} {
8596 $ctext conf -state normal
8598 init_flist [mc "Top"]
8599 $ctext insert end "[mc "From"] "
8600 $ctext insert end $oldid link0
8601 setlink $oldid link0
8602 $ctext insert end "\n "
8603 $ctext insert end [lindex $commitinfo($oldid) 0]
8604 $ctext insert end "\n\n[mc "To"] "
8605 $ctext insert end $newid link1
8606 setlink $newid link1
8607 $ctext insert end "\n "
8608 $ctext insert end [lindex $commitinfo($newid) 0]
8609 $ctext insert end "\n"
8610 $ctext conf -state disabled
8611 $ctext tag remove found 1.0 end
8612 startdiff [list $oldid $newid]
8616 global rowmenuid currentid commitinfo patchtop patchnum NS
8618 if {![info exists currentid]} return
8619 set oldid $currentid
8620 set oldhead [lindex $commitinfo($oldid) 0]
8621 set newid $rowmenuid
8622 set newhead [lindex $commitinfo($newid) 0]
8625 catch {destroy $top}
8627 make_transient $top .
8628 ${NS}::label $top.title -text [mc "Generate patch"]
8629 grid $top.title - -pady 10
8630 ${NS}::label $top.from -text [mc "From:"]
8631 ${NS}::entry $top.fromsha1 -width 40
8632 $top.fromsha1 insert 0 $oldid
8633 $top.fromsha1 conf -state readonly
8634 grid $top.from $top.fromsha1 -sticky w
8635 ${NS}::entry $top.fromhead -width 60
8636 $top.fromhead insert 0 $oldhead
8637 $top.fromhead conf -state readonly
8638 grid x $top.fromhead -sticky w
8639 ${NS}::label $top.to -text [mc "To:"]
8640 ${NS}::entry $top.tosha1 -width 40
8641 $top.tosha1 insert 0 $newid
8642 $top.tosha1 conf -state readonly
8643 grid $top.to $top.tosha1 -sticky w
8644 ${NS}::entry $top.tohead -width 60
8645 $top.tohead insert 0 $newhead
8646 $top.tohead conf -state readonly
8647 grid x $top.tohead -sticky w
8648 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8649 grid $top.rev x -pady 10 -padx 5
8650 ${NS}::label $top.flab -text [mc "Output file:"]
8651 ${NS}::entry $top.fname -width 60
8652 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8654 grid $top.flab $top.fname -sticky w
8655 ${NS}::frame $top.buts
8656 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8657 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8658 bind $top <Key-Return> mkpatchgo
8659 bind $top <Key-Escape> mkpatchcan
8660 grid $top.buts.gen $top.buts.can
8661 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8662 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8663 grid $top.buts - -pady 10 -sticky ew
8667 proc mkpatchrev {} {
8670 set oldid [$patchtop.fromsha1 get]
8671 set oldhead [$patchtop.fromhead get]
8672 set newid [$patchtop.tosha1 get]
8673 set newhead [$patchtop.tohead get]
8674 foreach e [list fromsha1 fromhead tosha1 tohead] \
8675 v [list $newid $newhead $oldid $oldhead] {
8676 $patchtop.$e conf -state normal
8677 $patchtop.$e delete 0 end
8678 $patchtop.$e insert 0 $v
8679 $patchtop.$e conf -state readonly
8684 global patchtop nullid nullid2
8686 set oldid [$patchtop.fromsha1 get]
8687 set newid [$patchtop.tosha1 get]
8688 set fname [$patchtop.fname get]
8689 set cmd [diffcmd [list $oldid $newid] -p]
8690 # trim off the initial "|"
8691 set cmd [lrange $cmd 1 end]
8692 lappend cmd >$fname &
8693 if {[catch {eval exec $cmd} err]} {
8694 error_popup "[mc "Error creating patch:"] $err" $patchtop
8696 catch {destroy $patchtop}
8700 proc mkpatchcan {} {
8703 catch {destroy $patchtop}
8708 global rowmenuid mktagtop commitinfo NS
8712 catch {destroy $top}
8714 make_transient $top .
8715 ${NS}::label $top.title -text [mc "Create tag"]
8716 grid $top.title - -pady 10
8717 ${NS}::label $top.id -text [mc "ID:"]
8718 ${NS}::entry $top.sha1 -width 40
8719 $top.sha1 insert 0 $rowmenuid
8720 $top.sha1 conf -state readonly
8721 grid $top.id $top.sha1 -sticky w
8722 ${NS}::entry $top.head -width 60
8723 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8724 $top.head conf -state readonly
8725 grid x $top.head -sticky w
8726 ${NS}::label $top.tlab -text [mc "Tag name:"]
8727 ${NS}::entry $top.tag -width 60
8728 grid $top.tlab $top.tag -sticky w
8729 ${NS}::label $top.op -text [mc "Tag message is optional"]
8730 grid $top.op -columnspan 2 -sticky we
8731 ${NS}::label $top.mlab -text [mc "Tag message:"]
8732 ${NS}::entry $top.msg -width 60
8733 grid $top.mlab $top.msg -sticky w
8734 ${NS}::frame $top.buts
8735 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8736 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8737 bind $top <Key-Return> mktaggo
8738 bind $top <Key-Escape> mktagcan
8739 grid $top.buts.gen $top.buts.can
8740 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8741 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8742 grid $top.buts - -pady 10 -sticky ew
8747 global mktagtop env tagids idtags
8749 set id [$mktagtop.sha1 get]
8750 set tag [$mktagtop.tag get]
8751 set msg [$mktagtop.msg get]
8753 error_popup [mc "No tag name specified"] $mktagtop
8756 if {[info exists tagids($tag)]} {
8757 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8762 exec git tag -a -m $msg $tag $id
8764 exec git tag $tag $id
8767 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8771 set tagids($tag) $id
8772 lappend idtags($id) $tag
8780 proc redrawtags {id} {
8781 global canv linehtag idpos currentid curview cmitlisted markedid
8782 global canvxmax iddrawn circleitem mainheadid circlecolors
8784 if {![commitinview $id $curview]} return
8785 if {![info exists iddrawn($id)]} return
8786 set row [rowofcommit $id]
8787 if {$id eq $mainheadid} {
8790 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8792 $canv itemconf $circleitem($row) -fill $ofill
8793 $canv delete tag.$id
8794 set xt [eval drawtags $id $idpos($id)]
8795 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8796 set text [$canv itemcget $linehtag($id) -text]
8797 set font [$canv itemcget $linehtag($id) -font]
8798 set xr [expr {$xt + [font measure $font $text]}]
8799 if {$xr > $canvxmax} {
8803 if {[info exists currentid] && $currentid == $id} {
8806 if {[info exists markedid] && $markedid eq $id} {
8814 catch {destroy $mktagtop}
8819 if {![domktag]} return
8823 proc writecommit {} {
8824 global rowmenuid wrcomtop commitinfo wrcomcmd NS
8826 set top .writecommit
8828 catch {destroy $top}
8830 make_transient $top .
8831 ${NS}::label $top.title -text [mc "Write commit to file"]
8832 grid $top.title - -pady 10
8833 ${NS}::label $top.id -text [mc "ID:"]
8834 ${NS}::entry $top.sha1 -width 40
8835 $top.sha1 insert 0 $rowmenuid
8836 $top.sha1 conf -state readonly
8837 grid $top.id $top.sha1 -sticky w
8838 ${NS}::entry $top.head -width 60
8839 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8840 $top.head conf -state readonly
8841 grid x $top.head -sticky w
8842 ${NS}::label $top.clab -text [mc "Command:"]
8843 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8844 grid $top.clab $top.cmd -sticky w -pady 10
8845 ${NS}::label $top.flab -text [mc "Output file:"]
8846 ${NS}::entry $top.fname -width 60
8847 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8848 grid $top.flab $top.fname -sticky w
8849 ${NS}::frame $top.buts
8850 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8851 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8852 bind $top <Key-Return> wrcomgo
8853 bind $top <Key-Escape> wrcomcan
8854 grid $top.buts.gen $top.buts.can
8855 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8856 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8857 grid $top.buts - -pady 10 -sticky ew
8864 set id [$wrcomtop.sha1 get]
8865 set cmd "echo $id | [$wrcomtop.cmd get]"
8866 set fname [$wrcomtop.fname get]
8867 if {[catch {exec sh -c $cmd >$fname &} err]} {
8868 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8870 catch {destroy $wrcomtop}
8877 catch {destroy $wrcomtop}
8882 global rowmenuid mkbrtop NS
8885 catch {destroy $top}
8887 make_transient $top .
8888 ${NS}::label $top.title -text [mc "Create new branch"]
8889 grid $top.title - -pady 10
8890 ${NS}::label $top.id -text [mc "ID:"]
8891 ${NS}::entry $top.sha1 -width 40
8892 $top.sha1 insert 0 $rowmenuid
8893 $top.sha1 conf -state readonly
8894 grid $top.id $top.sha1 -sticky w
8895 ${NS}::label $top.nlab -text [mc "Name:"]
8896 ${NS}::entry $top.name -width 40
8897 grid $top.nlab $top.name -sticky w
8898 ${NS}::frame $top.buts
8899 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8900 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8901 bind $top <Key-Return> [list mkbrgo $top]
8902 bind $top <Key-Escape> "catch {destroy $top}"
8903 grid $top.buts.go $top.buts.can
8904 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8905 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8906 grid $top.buts - -pady 10 -sticky ew
8911 global headids idheads
8913 set name [$top.name get]
8914 set id [$top.sha1 get]
8918 error_popup [mc "Please specify a name for the new branch"] $top
8921 if {[info exists headids($name)]} {
8922 if {![confirm_popup [mc \
8923 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8926 set old_id $headids($name)
8929 catch {destroy $top}
8930 lappend cmdargs $name $id
8934 eval exec git branch $cmdargs
8940 if {$old_id ne {}} {
8946 set headids($name) $id
8947 lappend idheads($id) $name
8956 proc exec_citool {tool_args {baseid {}}} {
8957 global commitinfo env
8959 set save_env [array get env GIT_AUTHOR_*]
8961 if {$baseid ne {}} {
8962 if {![info exists commitinfo($baseid)]} {
8965 set author [lindex $commitinfo($baseid) 1]
8966 set date [lindex $commitinfo($baseid) 2]
8967 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8968 $author author name email]
8970 set env(GIT_AUTHOR_NAME) $name
8971 set env(GIT_AUTHOR_EMAIL) $email
8972 set env(GIT_AUTHOR_DATE) $date
8976 eval exec git citool $tool_args &
8978 array unset env GIT_AUTHOR_*
8979 array set env $save_env
8982 proc cherrypick {} {
8983 global rowmenuid curview
8984 global mainhead mainheadid
8986 set oldhead [exec git rev-parse HEAD]
8987 set dheads [descheads $rowmenuid]
8988 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8989 set ok [confirm_popup [mc "Commit %s is already\
8990 included in branch %s -- really re-apply it?" \
8991 [string range $rowmenuid 0 7] $mainhead]]
8994 nowbusy cherrypick [mc "Cherry-picking"]
8996 # Unfortunately git-cherry-pick writes stuff to stderr even when
8997 # no error occurs, and exec takes that as an indication of error...
8998 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9001 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9003 error_popup [mc "Cherry-pick failed because of local changes\
9004 to file '%s'.\nPlease commit, reset or stash\
9005 your changes and try again." $fname]
9006 } elseif {[regexp -line \
9007 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
9009 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9010 conflict.\nDo you wish to run git citool to\
9012 # Force citool to read MERGE_MSG
9013 file delete [file join [gitdir] "GITGUI_MSG"]
9014 exec_citool {} $rowmenuid
9022 set newhead [exec git rev-parse HEAD]
9023 if {$newhead eq $oldhead} {
9025 error_popup [mc "No changes committed"]
9028 addnewchild $newhead $oldhead
9029 if {[commitinview $oldhead $curview]} {
9030 # XXX this isn't right if we have a path limit...
9031 insertrow $newhead $oldhead $curview
9032 if {$mainhead ne {}} {
9033 movehead $newhead $mainhead
9034 movedhead $newhead $mainhead
9036 set mainheadid $newhead
9045 global mainhead rowmenuid confirm_ok resettype NS
9048 set w ".confirmreset"
9051 wm title $w [mc "Confirm reset"]
9052 ${NS}::label $w.m -text \
9053 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9054 pack $w.m -side top -fill x -padx 20 -pady 20
9055 ${NS}::labelframe $w.f -text [mc "Reset type:"]
9057 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9058 -text [mc "Soft: Leave working tree and index untouched"]
9059 grid $w.f.soft -sticky w
9060 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9061 -text [mc "Mixed: Leave working tree untouched, reset index"]
9062 grid $w.f.mixed -sticky w
9063 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9064 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9065 grid $w.f.hard -sticky w
9066 pack $w.f -side top -fill x -padx 4
9067 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9068 pack $w.ok -side left -fill x -padx 20 -pady 20
9069 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9070 bind $w <Key-Escape> [list destroy $w]
9071 pack $w.cancel -side right -fill x -padx 20 -pady 20
9072 bind $w <Visibility> "grab $w; focus $w"
9074 if {!$confirm_ok} return
9075 if {[catch {set fd [open \
9076 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9080 filerun $fd [list readresetstat $fd]
9081 nowbusy reset [mc "Resetting"]
9086 proc readresetstat {fd} {
9087 global mainhead mainheadid showlocalchanges rprogcoord
9089 if {[gets $fd line] >= 0} {
9090 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9091 set rprogcoord [expr {1.0 * $m / $n}]
9099 if {[catch {close $fd} err]} {
9102 set oldhead $mainheadid
9103 set newhead [exec git rev-parse HEAD]
9104 if {$newhead ne $oldhead} {
9105 movehead $newhead $mainhead
9106 movedhead $newhead $mainhead
9107 set mainheadid $newhead
9111 if {$showlocalchanges} {
9117 # context menu for a head
9118 proc headmenu {x y id head} {
9119 global headmenuid headmenuhead headctxmenu mainhead
9123 set headmenuhead $head
9125 if {[string match "remotes/*" $head]} {
9128 if {$head eq $mainhead} {
9131 $headctxmenu entryconfigure 0 -state $state
9132 $headctxmenu entryconfigure 1 -state $state
9133 tk_popup $headctxmenu $x $y
9137 global headmenuid headmenuhead headids
9138 global showlocalchanges
9140 # check the tree is clean first??
9141 nowbusy checkout [mc "Checking out"]
9145 set fd [open [list | git checkout $headmenuhead 2>@1] r]
9149 if {$showlocalchanges} {
9153 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9157 proc readcheckoutstat {fd newhead newheadid} {
9158 global mainhead mainheadid headids showlocalchanges progresscoords
9159 global viewmainheadid curview
9161 if {[gets $fd line] >= 0} {
9162 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9163 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9168 set progresscoords {0 0}
9171 if {[catch {close $fd} err]} {
9174 set oldmainid $mainheadid
9175 set mainhead $newhead
9176 set mainheadid $newheadid
9177 set viewmainheadid($curview) $newheadid
9178 redrawtags $oldmainid
9179 redrawtags $newheadid
9181 if {$showlocalchanges} {
9187 global headmenuid headmenuhead mainhead
9190 set head $headmenuhead
9192 # this check shouldn't be needed any more...
9193 if {$head eq $mainhead} {
9194 error_popup [mc "Cannot delete the currently checked-out branch"]
9197 set dheads [descheads $id]
9198 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9199 # the stuff on this branch isn't on any other branch
9200 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9201 branch.\nReally delete branch %s?" $head $head]]} return
9205 if {[catch {exec git branch -D $head} err]} {
9210 removehead $id $head
9211 removedhead $id $head
9218 # Display a list of tags and heads
9220 global showrefstop bgcolor fgcolor selectbgcolor NS
9221 global bglist fglist reflistfilter reflist maincursor
9224 set showrefstop $top
9225 if {[winfo exists $top]} {
9231 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9232 make_transient $top .
9233 text $top.list -background $bgcolor -foreground $fgcolor \
9234 -selectbackground $selectbgcolor -font mainfont \
9235 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9236 -width 30 -height 20 -cursor $maincursor \
9237 -spacing1 1 -spacing3 1 -state disabled
9238 $top.list tag configure highlight -background $selectbgcolor
9239 lappend bglist $top.list
9240 lappend fglist $top.list
9241 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9242 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9243 grid $top.list $top.ysb -sticky nsew
9244 grid $top.xsb x -sticky ew
9246 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9247 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9248 set reflistfilter "*"
9249 trace add variable reflistfilter write reflistfilter_change
9250 pack $top.f.e -side right -fill x -expand 1
9251 pack $top.f.l -side left
9252 grid $top.f - -sticky ew -pady 2
9253 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9254 bind $top <Key-Escape> [list destroy $top]
9256 grid columnconfigure $top 0 -weight 1
9257 grid rowconfigure $top 0 -weight 1
9258 bind $top.list <1> {break}
9259 bind $top.list <B1-Motion> {break}
9260 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9265 proc sel_reflist {w x y} {
9266 global showrefstop reflist headids tagids otherrefids
9268 if {![winfo exists $showrefstop]} return
9269 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9270 set ref [lindex $reflist [expr {$l-1}]]
9271 set n [lindex $ref 0]
9272 switch -- [lindex $ref 1] {
9273 "H" {selbyid $headids($n)}
9274 "T" {selbyid $tagids($n)}
9275 "o" {selbyid $otherrefids($n)}
9277 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9280 proc unsel_reflist {} {
9283 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9284 $showrefstop.list tag remove highlight 0.0 end
9287 proc reflistfilter_change {n1 n2 op} {
9288 global reflistfilter
9290 after cancel refill_reflist
9291 after 200 refill_reflist
9294 proc refill_reflist {} {
9295 global reflist reflistfilter showrefstop headids tagids otherrefids
9298 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9300 foreach n [array names headids] {
9301 if {[string match $reflistfilter $n]} {
9302 if {[commitinview $headids($n) $curview]} {
9303 lappend refs [list $n H]
9305 interestedin $headids($n) {run refill_reflist}
9309 foreach n [array names tagids] {
9310 if {[string match $reflistfilter $n]} {
9311 if {[commitinview $tagids($n) $curview]} {
9312 lappend refs [list $n T]
9314 interestedin $tagids($n) {run refill_reflist}
9318 foreach n [array names otherrefids] {
9319 if {[string match $reflistfilter $n]} {
9320 if {[commitinview $otherrefids($n) $curview]} {
9321 lappend refs [list $n o]
9323 interestedin $otherrefids($n) {run refill_reflist}
9327 set refs [lsort -index 0 $refs]
9328 if {$refs eq $reflist} return
9330 # Update the contents of $showrefstop.list according to the
9331 # differences between $reflist (old) and $refs (new)
9332 $showrefstop.list conf -state normal
9333 $showrefstop.list insert end "\n"
9336 while {$i < [llength $reflist] || $j < [llength $refs]} {
9337 if {$i < [llength $reflist]} {
9338 if {$j < [llength $refs]} {
9339 set cmp [string compare [lindex $reflist $i 0] \
9340 [lindex $refs $j 0]]
9342 set cmp [string compare [lindex $reflist $i 1] \
9343 [lindex $refs $j 1]]
9353 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9361 set l [expr {$j + 1}]
9362 $showrefstop.list image create $l.0 -align baseline \
9363 -image reficon-[lindex $refs $j 1] -padx 2
9364 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9370 # delete last newline
9371 $showrefstop.list delete end-2c end-1c
9372 $showrefstop.list conf -state disabled
9375 # Stuff for finding nearby tags
9376 proc getallcommits {} {
9377 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9378 global idheads idtags idotherrefs allparents tagobjid
9380 if {![info exists allcommits]} {
9386 set allccache [file join [gitdir] "gitk.cache"]
9388 set f [open $allccache r]
9397 set cmd [list | git rev-list --parents]
9398 set allcupdate [expr {$seeds ne {}}]
9402 set refs [concat [array names idheads] [array names idtags] \
9403 [array names idotherrefs]]
9406 foreach name [array names tagobjid] {
9407 lappend tagobjs $tagobjid($name)
9409 foreach id [lsort -unique $refs] {
9410 if {![info exists allparents($id)] &&
9411 [lsearch -exact $tagobjs $id] < 0} {
9422 set fd [open [concat $cmd $ids] r]
9423 fconfigure $fd -blocking 0
9426 filerun $fd [list getallclines $fd]
9432 # Since most commits have 1 parent and 1 child, we group strings of
9433 # such commits into "arcs" joining branch/merge points (BMPs), which
9434 # are commits that either don't have 1 parent or don't have 1 child.
9436 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9437 # arcout(id) - outgoing arcs for BMP
9438 # arcids(a) - list of IDs on arc including end but not start
9439 # arcstart(a) - BMP ID at start of arc
9440 # arcend(a) - BMP ID at end of arc
9441 # growing(a) - arc a is still growing
9442 # arctags(a) - IDs out of arcids (excluding end) that have tags
9443 # archeads(a) - IDs out of arcids (excluding end) that have heads
9444 # The start of an arc is at the descendent end, so "incoming" means
9445 # coming from descendents, and "outgoing" means going towards ancestors.
9447 proc getallclines {fd} {
9448 global allparents allchildren idtags idheads nextarc
9449 global arcnos arcids arctags arcout arcend arcstart archeads growing
9450 global seeds allcommits cachedarcs allcupdate
9453 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9454 set id [lindex $line 0]
9455 if {[info exists allparents($id)]} {
9460 set olds [lrange $line 1 end]
9461 set allparents($id) $olds
9462 if {![info exists allchildren($id)]} {
9463 set allchildren($id) {}
9468 if {[llength $olds] == 1 && [llength $a] == 1} {
9469 lappend arcids($a) $id
9470 if {[info exists idtags($id)]} {
9471 lappend arctags($a) $id
9473 if {[info exists idheads($id)]} {
9474 lappend archeads($a) $id
9476 if {[info exists allparents($olds)]} {
9477 # seen parent already
9478 if {![info exists arcout($olds)]} {
9481 lappend arcids($a) $olds
9482 set arcend($a) $olds
9485 lappend allchildren($olds) $id
9486 lappend arcnos($olds) $a
9490 foreach a $arcnos($id) {
9491 lappend arcids($a) $id
9498 lappend allchildren($p) $id
9499 set a [incr nextarc]
9500 set arcstart($a) $id
9507 if {[info exists allparents($p)]} {
9508 # seen it already, may need to make a new branch
9509 if {![info exists arcout($p)]} {
9512 lappend arcids($a) $p
9516 lappend arcnos($p) $a
9521 global cached_dheads cached_dtags cached_atags
9522 catch {unset cached_dheads}
9523 catch {unset cached_dtags}
9524 catch {unset cached_atags}
9527 return [expr {$nid >= 1000? 2: 1}]
9531 fconfigure $fd -blocking 1
9534 # got an error reading the list of commits
9535 # if we were updating, try rereading the whole thing again
9541 error_popup "[mc "Error reading commit topology information;\
9542 branch and preceding/following tag information\
9543 will be incomplete."]\n($err)"
9546 if {[incr allcommits -1] == 0} {
9556 proc recalcarc {a} {
9557 global arctags archeads arcids idtags idheads
9561 foreach id [lrange $arcids($a) 0 end-1] {
9562 if {[info exists idtags($id)]} {
9565 if {[info exists idheads($id)]} {
9570 set archeads($a) $ah
9574 global arcnos arcids nextarc arctags archeads idtags idheads
9575 global arcstart arcend arcout allparents growing
9578 if {[llength $a] != 1} {
9579 puts "oops splitarc called but [llength $a] arcs already"
9583 set i [lsearch -exact $arcids($a) $p]
9585 puts "oops splitarc $p not in arc $a"
9588 set na [incr nextarc]
9589 if {[info exists arcend($a)]} {
9590 set arcend($na) $arcend($a)
9592 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9593 set j [lsearch -exact $arcnos($l) $a]
9594 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9596 set tail [lrange $arcids($a) [expr {$i+1}] end]
9597 set arcids($a) [lrange $arcids($a) 0 $i]
9599 set arcstart($na) $p
9601 set arcids($na) $tail
9602 if {[info exists growing($a)]} {
9608 if {[llength $arcnos($id)] == 1} {
9611 set j [lsearch -exact $arcnos($id) $a]
9612 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9616 # reconstruct tags and heads lists
9617 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9622 set archeads($na) {}
9626 # Update things for a new commit added that is a child of one
9627 # existing commit. Used when cherry-picking.
9628 proc addnewchild {id p} {
9629 global allparents allchildren idtags nextarc
9630 global arcnos arcids arctags arcout arcend arcstart archeads growing
9631 global seeds allcommits
9633 if {![info exists allcommits] || ![info exists arcnos($p)]} return
9634 set allparents($id) [list $p]
9635 set allchildren($id) {}
9638 lappend allchildren($p) $id
9639 set a [incr nextarc]
9640 set arcstart($a) $id
9643 set arcids($a) [list $p]
9645 if {![info exists arcout($p)]} {
9648 lappend arcnos($p) $a
9649 set arcout($id) [list $a]
9652 # This implements a cache for the topology information.
9653 # The cache saves, for each arc, the start and end of the arc,
9654 # the ids on the arc, and the outgoing arcs from the end.
9655 proc readcache {f} {
9656 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9657 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9662 if {$lim - $a > 500} {
9663 set lim [expr {$a + 500}]
9667 # finish reading the cache and setting up arctags, etc.
9669 if {$line ne "1"} {error "bad final version"}
9671 foreach id [array names idtags] {
9672 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9673 [llength $allparents($id)] == 1} {
9674 set a [lindex $arcnos($id) 0]
9675 if {$arctags($a) eq {}} {
9680 foreach id [array names idheads] {
9681 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9682 [llength $allparents($id)] == 1} {
9683 set a [lindex $arcnos($id) 0]
9684 if {$archeads($a) eq {}} {
9689 foreach id [lsort -unique $possible_seeds] {
9690 if {$arcnos($id) eq {}} {
9696 while {[incr a] <= $lim} {
9698 if {[llength $line] != 3} {error "bad line"}
9699 set s [lindex $line 0]
9701 lappend arcout($s) $a
9702 if {![info exists arcnos($s)]} {
9703 lappend possible_seeds $s
9706 set e [lindex $line 1]
9711 if {![info exists arcout($e)]} {
9715 set arcids($a) [lindex $line 2]
9716 foreach id $arcids($a) {
9717 lappend allparents($s) $id
9719 lappend arcnos($id) $a
9721 if {![info exists allparents($s)]} {
9722 set allparents($s) {}
9727 set nextarc [expr {$a - 1}]
9740 global nextarc cachedarcs possible_seeds
9744 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9745 # make sure it's an integer
9746 set cachedarcs [expr {int([lindex $line 1])}]
9747 if {$cachedarcs < 0} {error "bad number of arcs"}
9749 set possible_seeds {}
9757 proc dropcache {err} {
9758 global allcwait nextarc cachedarcs seeds
9760 #puts "dropping cache ($err)"
9761 foreach v {arcnos arcout arcids arcstart arcend growing \
9762 arctags archeads allparents allchildren} {
9773 proc writecache {f} {
9774 global cachearc cachedarcs allccache
9775 global arcstart arcend arcnos arcids arcout
9779 if {$lim - $a > 1000} {
9780 set lim [expr {$a + 1000}]
9783 while {[incr a] <= $lim} {
9784 if {[info exists arcend($a)]} {
9785 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9787 puts $f [list $arcstart($a) {} $arcids($a)]
9792 catch {file delete $allccache}
9793 #puts "writing cache failed ($err)"
9796 set cachearc [expr {$a - 1}]
9797 if {$a > $cachedarcs} {
9806 global nextarc cachedarcs cachearc allccache
9808 if {$nextarc == $cachedarcs} return
9810 set cachedarcs $nextarc
9812 set f [open $allccache w]
9813 puts $f [list 1 $cachedarcs]
9818 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9819 # or 0 if neither is true.
9820 proc anc_or_desc {a b} {
9821 global arcout arcstart arcend arcnos cached_isanc
9823 if {$arcnos($a) eq $arcnos($b)} {
9824 # Both are on the same arc(s); either both are the same BMP,
9825 # or if one is not a BMP, the other is also not a BMP or is
9826 # the BMP at end of the arc (and it only has 1 incoming arc).
9827 # Or both can be BMPs with no incoming arcs.
9828 if {$a eq $b || $arcnos($a) eq {}} {
9831 # assert {[llength $arcnos($a)] == 1}
9832 set arc [lindex $arcnos($a) 0]
9833 set i [lsearch -exact $arcids($arc) $a]
9834 set j [lsearch -exact $arcids($arc) $b]
9835 if {$i < 0 || $i > $j} {
9842 if {![info exists arcout($a)]} {
9843 set arc [lindex $arcnos($a) 0]
9844 if {[info exists arcend($arc)]} {
9845 set aend $arcend($arc)
9849 set a $arcstart($arc)
9853 if {![info exists arcout($b)]} {
9854 set arc [lindex $arcnos($b) 0]
9855 if {[info exists arcend($arc)]} {
9856 set bend $arcend($arc)
9860 set b $arcstart($arc)
9870 if {[info exists cached_isanc($a,$bend)]} {
9871 if {$cached_isanc($a,$bend)} {
9875 if {[info exists cached_isanc($b,$aend)]} {
9876 if {$cached_isanc($b,$aend)} {
9879 if {[info exists cached_isanc($a,$bend)]} {
9884 set todo [list $a $b]
9887 for {set i 0} {$i < [llength $todo]} {incr i} {
9888 set x [lindex $todo $i]
9889 if {$anc($x) eq {}} {
9892 foreach arc $arcnos($x) {
9893 set xd $arcstart($arc)
9895 set cached_isanc($a,$bend) 1
9896 set cached_isanc($b,$aend) 0
9898 } elseif {$xd eq $aend} {
9899 set cached_isanc($b,$aend) 1
9900 set cached_isanc($a,$bend) 0
9903 if {![info exists anc($xd)]} {
9904 set anc($xd) $anc($x)
9906 } elseif {$anc($xd) ne $anc($x)} {
9911 set cached_isanc($a,$bend) 0
9912 set cached_isanc($b,$aend) 0
9916 # This identifies whether $desc has an ancestor that is
9917 # a growing tip of the graph and which is not an ancestor of $anc
9918 # and returns 0 if so and 1 if not.
9919 # If we subsequently discover a tag on such a growing tip, and that
9920 # turns out to be a descendent of $anc (which it could, since we
9921 # don't necessarily see children before parents), then $desc
9922 # isn't a good choice to display as a descendent tag of
9923 # $anc (since it is the descendent of another tag which is
9924 # a descendent of $anc). Similarly, $anc isn't a good choice to
9925 # display as a ancestor tag of $desc.
9927 proc is_certain {desc anc} {
9928 global arcnos arcout arcstart arcend growing problems
9931 if {[llength $arcnos($anc)] == 1} {
9932 # tags on the same arc are certain
9933 if {$arcnos($desc) eq $arcnos($anc)} {
9936 if {![info exists arcout($anc)]} {
9937 # if $anc is partway along an arc, use the start of the arc instead
9938 set a [lindex $arcnos($anc) 0]
9939 set anc $arcstart($a)
9942 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9945 set a [lindex $arcnos($desc) 0]
9951 set anclist [list $x]
9955 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9956 set x [lindex $anclist $i]
9961 foreach a $arcout($x) {
9962 if {[info exists growing($a)]} {
9963 if {![info exists growanc($x)] && $dl($x)} {
9969 if {[info exists dl($y)]} {
9973 if {![info exists done($y)]} {
9976 if {[info exists growanc($x)]} {
9980 for {set k 0} {$k < [llength $xl]} {incr k} {
9981 set z [lindex $xl $k]
9982 foreach c $arcout($z) {
9983 if {[info exists arcend($c)]} {
9985 if {[info exists dl($v)] && $dl($v)} {
9987 if {![info exists done($v)]} {
9990 if {[info exists growanc($v)]} {
10000 } elseif {$y eq $anc || !$dl($x)} {
10011 foreach x [array names growanc] {
10020 proc validate_arctags {a} {
10021 global arctags idtags
10024 set na $arctags($a)
10025 foreach id $arctags($a) {
10027 if {![info exists idtags($id)]} {
10028 set na [lreplace $na $i $i]
10032 set arctags($a) $na
10035 proc validate_archeads {a} {
10036 global archeads idheads
10039 set na $archeads($a)
10040 foreach id $archeads($a) {
10042 if {![info exists idheads($id)]} {
10043 set na [lreplace $na $i $i]
10047 set archeads($a) $na
10050 # Return the list of IDs that have tags that are descendents of id,
10051 # ignoring IDs that are descendents of IDs already reported.
10052 proc desctags {id} {
10053 global arcnos arcstart arcids arctags idtags allparents
10054 global growing cached_dtags
10056 if {![info exists allparents($id)]} {
10059 set t1 [clock clicks -milliseconds]
10061 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10062 # part-way along an arc; check that arc first
10063 set a [lindex $arcnos($id) 0]
10064 if {$arctags($a) ne {}} {
10065 validate_arctags $a
10066 set i [lsearch -exact $arcids($a) $id]
10068 foreach t $arctags($a) {
10069 set j [lsearch -exact $arcids($a) $t]
10070 if {$j >= $i} break
10077 set id $arcstart($a)
10078 if {[info exists idtags($id)]} {
10082 if {[info exists cached_dtags($id)]} {
10083 return $cached_dtags($id)
10087 set todo [list $id]
10090 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10091 set id [lindex $todo $i]
10093 set ta [info exists hastaggedancestor($id)]
10097 # ignore tags on starting node
10098 if {!$ta && $i > 0} {
10099 if {[info exists idtags($id)]} {
10100 set tagloc($id) $id
10102 } elseif {[info exists cached_dtags($id)]} {
10103 set tagloc($id) $cached_dtags($id)
10107 foreach a $arcnos($id) {
10108 set d $arcstart($a)
10109 if {!$ta && $arctags($a) ne {}} {
10110 validate_arctags $a
10111 if {$arctags($a) ne {}} {
10112 lappend tagloc($id) [lindex $arctags($a) end]
10115 if {$ta || $arctags($a) ne {}} {
10116 set tomark [list $d]
10117 for {set j 0} {$j < [llength $tomark]} {incr j} {
10118 set dd [lindex $tomark $j]
10119 if {![info exists hastaggedancestor($dd)]} {
10120 if {[info exists done($dd)]} {
10121 foreach b $arcnos($dd) {
10122 lappend tomark $arcstart($b)
10124 if {[info exists tagloc($dd)]} {
10127 } elseif {[info exists queued($dd)]} {
10130 set hastaggedancestor($dd) 1
10134 if {![info exists queued($d)]} {
10137 if {![info exists hastaggedancestor($d)]} {
10144 foreach id [array names tagloc] {
10145 if {![info exists hastaggedancestor($id)]} {
10146 foreach t $tagloc($id) {
10147 if {[lsearch -exact $tags $t] < 0} {
10153 set t2 [clock clicks -milliseconds]
10156 # remove tags that are descendents of other tags
10157 for {set i 0} {$i < [llength $tags]} {incr i} {
10158 set a [lindex $tags $i]
10159 for {set j 0} {$j < $i} {incr j} {
10160 set b [lindex $tags $j]
10161 set r [anc_or_desc $a $b]
10163 set tags [lreplace $tags $j $j]
10166 } elseif {$r == -1} {
10167 set tags [lreplace $tags $i $i]
10174 if {[array names growing] ne {}} {
10175 # graph isn't finished, need to check if any tag could get
10176 # eclipsed by another tag coming later. Simply ignore any
10177 # tags that could later get eclipsed.
10180 if {[is_certain $t $origid]} {
10184 if {$tags eq $ctags} {
10185 set cached_dtags($origid) $tags
10190 set cached_dtags($origid) $tags
10192 set t3 [clock clicks -milliseconds]
10193 if {0 && $t3 - $t1 >= 100} {
10194 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10195 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10200 proc anctags {id} {
10201 global arcnos arcids arcout arcend arctags idtags allparents
10202 global growing cached_atags
10204 if {![info exists allparents($id)]} {
10207 set t1 [clock clicks -milliseconds]
10209 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10210 # part-way along an arc; check that arc first
10211 set a [lindex $arcnos($id) 0]
10212 if {$arctags($a) ne {}} {
10213 validate_arctags $a
10214 set i [lsearch -exact $arcids($a) $id]
10215 foreach t $arctags($a) {
10216 set j [lsearch -exact $arcids($a) $t]
10222 if {![info exists arcend($a)]} {
10226 if {[info exists idtags($id)]} {
10230 if {[info exists cached_atags($id)]} {
10231 return $cached_atags($id)
10235 set todo [list $id]
10239 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10240 set id [lindex $todo $i]
10242 set td [info exists hastaggeddescendent($id)]
10246 # ignore tags on starting node
10247 if {!$td && $i > 0} {
10248 if {[info exists idtags($id)]} {
10249 set tagloc($id) $id
10251 } elseif {[info exists cached_atags($id)]} {
10252 set tagloc($id) $cached_atags($id)
10256 foreach a $arcout($id) {
10257 if {!$td && $arctags($a) ne {}} {
10258 validate_arctags $a
10259 if {$arctags($a) ne {}} {
10260 lappend tagloc($id) [lindex $arctags($a) 0]
10263 if {![info exists arcend($a)]} continue
10265 if {$td || $arctags($a) ne {}} {
10266 set tomark [list $d]
10267 for {set j 0} {$j < [llength $tomark]} {incr j} {
10268 set dd [lindex $tomark $j]
10269 if {![info exists hastaggeddescendent($dd)]} {
10270 if {[info exists done($dd)]} {
10271 foreach b $arcout($dd) {
10272 if {[info exists arcend($b)]} {
10273 lappend tomark $arcend($b)
10276 if {[info exists tagloc($dd)]} {
10279 } elseif {[info exists queued($dd)]} {
10282 set hastaggeddescendent($dd) 1
10286 if {![info exists queued($d)]} {
10289 if {![info exists hastaggeddescendent($d)]} {
10295 set t2 [clock clicks -milliseconds]
10298 foreach id [array names tagloc] {
10299 if {![info exists hastaggeddescendent($id)]} {
10300 foreach t $tagloc($id) {
10301 if {[lsearch -exact $tags $t] < 0} {
10308 # remove tags that are ancestors of other tags
10309 for {set i 0} {$i < [llength $tags]} {incr i} {
10310 set a [lindex $tags $i]
10311 for {set j 0} {$j < $i} {incr j} {
10312 set b [lindex $tags $j]
10313 set r [anc_or_desc $a $b]
10315 set tags [lreplace $tags $j $j]
10318 } elseif {$r == 1} {
10319 set tags [lreplace $tags $i $i]
10326 if {[array names growing] ne {}} {
10327 # graph isn't finished, need to check if any tag could get
10328 # eclipsed by another tag coming later. Simply ignore any
10329 # tags that could later get eclipsed.
10332 if {[is_certain $origid $t]} {
10336 if {$tags eq $ctags} {
10337 set cached_atags($origid) $tags
10342 set cached_atags($origid) $tags
10344 set t3 [clock clicks -milliseconds]
10345 if {0 && $t3 - $t1 >= 100} {
10346 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10347 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10352 # Return the list of IDs that have heads that are descendents of id,
10353 # including id itself if it has a head.
10354 proc descheads {id} {
10355 global arcnos arcstart arcids archeads idheads cached_dheads
10358 if {![info exists allparents($id)]} {
10362 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10363 # part-way along an arc; check it first
10364 set a [lindex $arcnos($id) 0]
10365 if {$archeads($a) ne {}} {
10366 validate_archeads $a
10367 set i [lsearch -exact $arcids($a) $id]
10368 foreach t $archeads($a) {
10369 set j [lsearch -exact $arcids($a) $t]
10374 set id $arcstart($a)
10377 set todo [list $id]
10380 for {set i 0} {$i < [llength $todo]} {incr i} {
10381 set id [lindex $todo $i]
10382 if {[info exists cached_dheads($id)]} {
10383 set ret [concat $ret $cached_dheads($id)]
10385 if {[info exists idheads($id)]} {
10388 foreach a $arcnos($id) {
10389 if {$archeads($a) ne {}} {
10390 validate_archeads $a
10391 if {$archeads($a) ne {}} {
10392 set ret [concat $ret $archeads($a)]
10395 set d $arcstart($a)
10396 if {![info exists seen($d)]} {
10403 set ret [lsort -unique $ret]
10404 set cached_dheads($origid) $ret
10405 return [concat $ret $aret]
10408 proc addedtag {id} {
10409 global arcnos arcout cached_dtags cached_atags
10411 if {![info exists arcnos($id)]} return
10412 if {![info exists arcout($id)]} {
10413 recalcarc [lindex $arcnos($id) 0]
10415 catch {unset cached_dtags}
10416 catch {unset cached_atags}
10419 proc addedhead {hid head} {
10420 global arcnos arcout cached_dheads
10422 if {![info exists arcnos($hid)]} return
10423 if {![info exists arcout($hid)]} {
10424 recalcarc [lindex $arcnos($hid) 0]
10426 catch {unset cached_dheads}
10429 proc removedhead {hid head} {
10430 global cached_dheads
10432 catch {unset cached_dheads}
10435 proc movedhead {hid head} {
10436 global arcnos arcout cached_dheads
10438 if {![info exists arcnos($hid)]} return
10439 if {![info exists arcout($hid)]} {
10440 recalcarc [lindex $arcnos($hid) 0]
10442 catch {unset cached_dheads}
10445 proc changedrefs {} {
10446 global cached_dheads cached_dtags cached_atags
10447 global arctags archeads arcnos arcout idheads idtags
10449 foreach id [concat [array names idheads] [array names idtags]] {
10450 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10451 set a [lindex $arcnos($id) 0]
10452 if {![info exists donearc($a)]} {
10458 catch {unset cached_dtags}
10459 catch {unset cached_atags}
10460 catch {unset cached_dheads}
10463 proc rereadrefs {} {
10464 global idtags idheads idotherrefs mainheadid
10466 set refids [concat [array names idtags] \
10467 [array names idheads] [array names idotherrefs]]
10468 foreach id $refids {
10469 if {![info exists ref($id)]} {
10470 set ref($id) [listrefs $id]
10473 set oldmainhead $mainheadid
10476 set refids [lsort -unique [concat $refids [array names idtags] \
10477 [array names idheads] [array names idotherrefs]]]
10478 foreach id $refids {
10479 set v [listrefs $id]
10480 if {![info exists ref($id)] || $ref($id) != $v} {
10484 if {$oldmainhead ne $mainheadid} {
10485 redrawtags $oldmainhead
10486 redrawtags $mainheadid
10491 proc listrefs {id} {
10492 global idtags idheads idotherrefs
10495 if {[info exists idtags($id)]} {
10499 if {[info exists idheads($id)]} {
10500 set y $idheads($id)
10503 if {[info exists idotherrefs($id)]} {
10504 set z $idotherrefs($id)
10506 return [list $x $y $z]
10509 proc showtag {tag isnew} {
10510 global ctext tagcontents tagids linknum tagobjid
10513 addtohistory [list showtag $tag 0] savectextpos
10515 $ctext conf -state normal
10519 if {![info exists tagcontents($tag)]} {
10521 set tagcontents($tag) [exec git cat-file tag $tag]
10524 if {[info exists tagcontents($tag)]} {
10525 set text $tagcontents($tag)
10527 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
10529 appendwithlinks $text {}
10530 maybe_scroll_ctext 1
10531 $ctext conf -state disabled
10543 if {[info exists gitktmpdir]} {
10544 catch {file delete -force $gitktmpdir}
10548 proc mkfontdisp {font top which} {
10549 global fontattr fontpref $font NS use_ttk
10551 set fontpref($font) [set $font]
10552 ${NS}::button $top.${font}but -text $which \
10553 -command [list choosefont $font $which]
10554 ${NS}::label $top.$font -relief flat -font $font \
10555 -text $fontattr($font,family) -justify left
10556 grid x $top.${font}but $top.$font -sticky w
10559 proc choosefont {font which} {
10560 global fontparam fontlist fonttop fontattr
10563 set fontparam(which) $which
10564 set fontparam(font) $font
10565 set fontparam(family) [font actual $font -family]
10566 set fontparam(size) $fontattr($font,size)
10567 set fontparam(weight) $fontattr($font,weight)
10568 set fontparam(slant) $fontattr($font,slant)
10571 if {![winfo exists $top]} {
10573 eval font config sample [font actual $font]
10575 make_transient $top $prefstop
10576 wm title $top [mc "Gitk font chooser"]
10577 ${NS}::label $top.l -textvariable fontparam(which)
10578 pack $top.l -side top
10579 set fontlist [lsort [font families]]
10580 ${NS}::frame $top.f
10581 listbox $top.f.fam -listvariable fontlist \
10582 -yscrollcommand [list $top.f.sb set]
10583 bind $top.f.fam <<ListboxSelect>> selfontfam
10584 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10585 pack $top.f.sb -side right -fill y
10586 pack $top.f.fam -side left -fill both -expand 1
10587 pack $top.f -side top -fill both -expand 1
10588 ${NS}::frame $top.g
10589 spinbox $top.g.size -from 4 -to 40 -width 4 \
10590 -textvariable fontparam(size) \
10591 -validatecommand {string is integer -strict %s}
10592 checkbutton $top.g.bold -padx 5 \
10593 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10594 -variable fontparam(weight) -onvalue bold -offvalue normal
10595 checkbutton $top.g.ital -padx 5 \
10596 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
10597 -variable fontparam(slant) -onvalue italic -offvalue roman
10598 pack $top.g.size $top.g.bold $top.g.ital -side left
10599 pack $top.g -side top
10600 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10602 $top.c create text 100 25 -anchor center -text $which -font sample \
10603 -fill black -tags text
10604 bind $top.c <Configure> [list centertext $top.c]
10605 pack $top.c -side top -fill x
10606 ${NS}::frame $top.buts
10607 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10608 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10609 bind $top <Key-Return> fontok
10610 bind $top <Key-Escape> fontcan
10611 grid $top.buts.ok $top.buts.can
10612 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10613 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10614 pack $top.buts -side bottom -fill x
10615 trace add variable fontparam write chg_fontparam
10618 $top.c itemconf text -text $which
10620 set i [lsearch -exact $fontlist $fontparam(family)]
10622 $top.f.fam selection set $i
10627 proc centertext {w} {
10628 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10632 global fontparam fontpref prefstop
10634 set f $fontparam(font)
10635 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10636 if {$fontparam(weight) eq "bold"} {
10637 lappend fontpref($f) "bold"
10639 if {$fontparam(slant) eq "italic"} {
10640 lappend fontpref($f) "italic"
10643 $w conf -text $fontparam(family) -font $fontpref($f)
10649 global fonttop fontparam
10651 if {[info exists fonttop]} {
10652 catch {destroy $fonttop}
10653 catch {font delete sample}
10659 if {[package vsatisfies [package provide Tk] 8.6]} {
10660 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10661 # function to make use of it.
10662 proc choosefont {font which} {
10663 tk fontchooser configure -title $which -font $font \
10664 -command [list on_choosefont $font $which]
10665 tk fontchooser show
10667 proc on_choosefont {font which newfont} {
10669 puts stderr "$font $newfont"
10670 array set f [font actual $newfont]
10671 set fontparam(which) $which
10672 set fontparam(font) $font
10673 set fontparam(family) $f(-family)
10674 set fontparam(size) $f(-size)
10675 set fontparam(weight) $f(-weight)
10676 set fontparam(slant) $f(-slant)
10681 proc selfontfam {} {
10682 global fonttop fontparam
10684 set i [$fonttop.f.fam curselection]
10686 set fontparam(family) [$fonttop.f.fam get $i]
10690 proc chg_fontparam {v sub op} {
10693 font config sample -$sub $fontparam($sub)
10697 global maxwidth maxgraphpct use_ttk NS
10698 global oldprefs prefstop showneartags showlocalchanges
10699 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10700 global tabstop limitdiffs autoselect extdifftool perfile_attrs
10701 global hideremotes want_ttk have_ttk
10705 if {[winfo exists $top]} {
10709 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10710 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10711 set oldprefs($v) [set $v]
10714 wm title $top [mc "Gitk preferences"]
10715 make_transient $top .
10716 ${NS}::label $top.ldisp -text [mc "Commit list display options"]
10717 grid $top.ldisp - -sticky w -pady 10
10718 ${NS}::label $top.spacer -text " "
10719 ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
10720 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10721 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10722 ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
10723 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10724 grid x $top.maxpctl $top.maxpct -sticky w
10725 ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
10726 -variable showlocalchanges
10727 grid x $top.showlocal -sticky w
10728 ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10729 -variable autoselect
10730 grid x $top.autoselect -sticky w
10731 ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
10732 -variable hideremotes
10733 grid x $top.hideremotes -sticky w
10735 ${NS}::label $top.ddisp -text [mc "Diff display options"]
10736 grid $top.ddisp - -sticky w -pady 10
10737 ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
10738 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10739 grid x $top.tabstopl $top.tabstop -sticky w
10740 ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
10741 -variable showneartags
10742 grid x $top.ntag -sticky w
10743 ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10744 -variable limitdiffs
10745 grid x $top.ldiff -sticky w
10746 ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10747 -variable perfile_attrs
10748 grid x $top.lattr -sticky w
10750 ${NS}::entry $top.extdifft -textvariable extdifftool
10751 ${NS}::frame $top.extdifff
10752 ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
10753 ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10754 pack $top.extdifff.l $top.extdifff.b -side left
10755 pack configure $top.extdifff.l -padx 10
10756 grid x $top.extdifff $top.extdifft -sticky ew
10758 ${NS}::label $top.lgen -text [mc "General options"]
10759 grid $top.lgen - -sticky w -pady 10
10760 ${NS}::checkbutton $top.want_ttk -variable want_ttk \
10761 -text [mc "Use themed widgets"]
10763 ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
10765 ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
10767 grid x $top.want_ttk $top.ttk_note -sticky w
10769 ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
10770 grid $top.cdisp - -sticky w -pady 10
10771 label $top.ui -padx 40 -relief sunk -background $uicolor
10772 ${NS}::button $top.uibut -text [mc "Interface"] \
10773 -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
10774 grid x $top.uibut $top.ui -sticky w
10775 label $top.bg -padx 40 -relief sunk -background $bgcolor
10776 ${NS}::button $top.bgbut -text [mc "Background"] \
10777 -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
10778 grid x $top.bgbut $top.bg -sticky w
10779 label $top.fg -padx 40 -relief sunk -background $fgcolor
10780 ${NS}::button $top.fgbut -text [mc "Foreground"] \
10781 -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
10782 grid x $top.fgbut $top.fg -sticky w
10783 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10784 ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
10785 -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
10786 [list $ctext tag conf d0 -foreground]]
10787 grid x $top.diffoldbut $top.diffold -sticky w
10788 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10789 ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
10790 -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
10791 [list $ctext tag conf dresult -foreground]]
10792 grid x $top.diffnewbut $top.diffnew -sticky w
10793 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10794 ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
10795 -command [list choosecolor diffcolors 2 $top.hunksep \
10796 [mc "diff hunk header"] \
10797 [list $ctext tag conf hunksep -foreground]]
10798 grid x $top.hunksepbut $top.hunksep -sticky w
10799 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10800 ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
10801 -command [list choosecolor markbgcolor {} $top.markbgsep \
10802 [mc "marked line background"] \
10803 [list $ctext tag conf omark -background]]
10804 grid x $top.markbgbut $top.markbgsep -sticky w
10805 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10806 ${NS}::button $top.selbgbut -text [mc "Select bg"] \
10807 -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
10808 grid x $top.selbgbut $top.selbgsep -sticky w
10810 ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
10811 grid $top.cfont - -sticky w -pady 10
10812 mkfontdisp mainfont $top [mc "Main font"]
10813 mkfontdisp textfont $top [mc "Diff display font"]
10814 mkfontdisp uifont $top [mc "User interface font"]
10816 ${NS}::frame $top.buts
10817 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10818 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10819 bind $top <Key-Return> prefsok
10820 bind $top <Key-Escape> prefscan
10821 grid $top.buts.ok $top.buts.can
10822 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10823 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10824 grid $top.buts - - -pady 10 -sticky ew
10825 grid columnconfigure $top 2 -weight 1
10826 bind $top <Visibility> "focus $top.buts.ok"
10829 proc choose_extdiff {} {
10832 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
10834 set extdifftool $prog
10838 proc choosecolor {v vi w x cmd} {
10841 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10842 -title [mc "Gitk: choose color for %s" $x]]
10843 if {$c eq {}} return
10844 $w conf -background $c
10849 proc setselbg {c} {
10850 global bglist cflist
10851 foreach w $bglist {
10852 $w configure -selectbackground $c
10854 $cflist tag configure highlight \
10855 -background [$cflist cget -selectbackground]
10856 allcanvs itemconf secsel -fill $c
10859 # This sets the background color and the color scheme for the whole UI.
10860 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
10861 # if we don't specify one ourselves, which makes the checkbuttons and
10862 # radiobuttons look bad. This chooses white for selectColor if the
10863 # background color is light, or black if it is dark.
10865 if {[tk windowingsystem] eq "win32"} { return }
10866 set bg [winfo rgb . $c]
10868 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
10871 tk_setPalette background $c selectColor $selc
10877 foreach w $bglist {
10878 $w conf -background $c
10885 foreach w $fglist {
10886 $w conf -foreground $c
10888 allcanvs itemconf text -fill $c
10889 $canv itemconf circle -outline $c
10890 $canv itemconf markid -outline $c
10894 global oldprefs prefstop
10896 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10897 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10899 set $v $oldprefs($v)
10901 catch {destroy $prefstop}
10907 global maxwidth maxgraphpct
10908 global oldprefs prefstop showneartags showlocalchanges
10909 global fontpref mainfont textfont uifont
10910 global limitdiffs treediffs perfile_attrs
10913 catch {destroy $prefstop}
10917 if {$mainfont ne $fontpref(mainfont)} {
10918 set mainfont $fontpref(mainfont)
10919 parsefont mainfont $mainfont
10920 eval font configure mainfont [fontflags mainfont]
10921 eval font configure mainfontbold [fontflags mainfont 1]
10925 if {$textfont ne $fontpref(textfont)} {
10926 set textfont $fontpref(textfont)
10927 parsefont textfont $textfont
10928 eval font configure textfont [fontflags textfont]
10929 eval font configure textfontbold [fontflags textfont 1]
10931 if {$uifont ne $fontpref(uifont)} {
10932 set uifont $fontpref(uifont)
10933 parsefont uifont $uifont
10934 eval font configure uifont [fontflags uifont]
10937 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10938 if {$showlocalchanges} {
10944 if {$limitdiffs != $oldprefs(limitdiffs) ||
10945 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10946 # treediffs elements are limited by path;
10947 # won't have encodings cached if perfile_attrs was just turned on
10948 catch {unset treediffs}
10950 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10951 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10953 } elseif {$showneartags != $oldprefs(showneartags) ||
10954 $limitdiffs != $oldprefs(limitdiffs)} {
10957 if {$hideremotes != $oldprefs(hideremotes)} {
10962 proc formatdate {d} {
10963 global datetimeformat
10965 set d [clock format $d -format $datetimeformat]
10970 # This list of encoding names and aliases is distilled from
10971 # http://www.iana.org/assignments/character-sets.
10972 # Not all of them are supported by Tcl.
10973 set encoding_aliases {
10974 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10975 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10976 { ISO-10646-UTF-1 csISO10646UTF1 }
10977 { ISO_646.basic:1983 ref csISO646basic1983 }
10978 { INVARIANT csINVARIANT }
10979 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10980 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10981 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10982 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10983 { NATS-DANO iso-ir-9-1 csNATSDANO }
10984 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10985 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10986 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10987 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10988 { ISO-2022-KR csISO2022KR }
10990 { ISO-2022-JP csISO2022JP }
10991 { ISO-2022-JP-2 csISO2022JP2 }
10992 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10993 csISO13JISC6220jp }
10994 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10995 { IT iso-ir-15 ISO646-IT csISO15Italian }
10996 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10997 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10998 { greek7-old iso-ir-18 csISO18Greek7Old }
10999 { latin-greek iso-ir-19 csISO19LatinGreek }
11000 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11001 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11002 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11003 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11004 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11005 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11006 { INIS iso-ir-49 csISO49INIS }
11007 { INIS-8 iso-ir-50 csISO50INIS8 }
11008 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11009 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11010 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11011 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11012 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11013 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11014 csISO60Norwegian1 }
11015 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11016 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11017 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11018 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11019 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11020 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11021 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11022 { greek7 iso-ir-88 csISO88Greek7 }
11023 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11024 { iso-ir-90 csISO90 }
11025 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11026 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11027 csISO92JISC62991984b }
11028 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11029 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11030 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11031 csISO95JIS62291984handadd }
11032 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11033 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11034 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11035 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11036 CP819 csISOLatin1 }
11037 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11038 { T.61-7bit iso-ir-102 csISO102T617bit }
11039 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11040 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11041 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11042 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11043 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11044 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11045 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11046 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11047 arabic csISOLatinArabic }
11048 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11049 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11050 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11051 greek greek8 csISOLatinGreek }
11052 { T.101-G2 iso-ir-128 csISO128T101G2 }
11053 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11055 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11056 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11057 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11058 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11059 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11060 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11061 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11062 csISOLatinCyrillic }
11063 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11064 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11065 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11066 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11067 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11068 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11069 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11070 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11071 { ISO_10367-box iso-ir-155 csISO10367Box }
11072 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11073 { latin-lap lap iso-ir-158 csISO158Lap }
11074 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11075 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11078 { JIS_X0201 X0201 csHalfWidthKatakana }
11079 { KSC5636 ISO646-KR csKSC5636 }
11080 { ISO-10646-UCS-2 csUnicode }
11081 { ISO-10646-UCS-4 csUCS4 }
11082 { DEC-MCS dec csDECMCS }
11083 { hp-roman8 roman8 r8 csHPRoman8 }
11084 { macintosh mac csMacintosh }
11085 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11087 { IBM038 EBCDIC-INT cp038 csIBM038 }
11088 { IBM273 CP273 csIBM273 }
11089 { IBM274 EBCDIC-BE CP274 csIBM274 }
11090 { IBM275 EBCDIC-BR cp275 csIBM275 }
11091 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11092 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11093 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11094 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11095 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11096 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11097 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11098 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11099 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11100 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11101 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11102 { IBM437 cp437 437 csPC8CodePage437 }
11103 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11104 { IBM775 cp775 csPC775Baltic }
11105 { IBM850 cp850 850 csPC850Multilingual }
11106 { IBM851 cp851 851 csIBM851 }
11107 { IBM852 cp852 852 csPCp852 }
11108 { IBM855 cp855 855 csIBM855 }
11109 { IBM857 cp857 857 csIBM857 }
11110 { IBM860 cp860 860 csIBM860 }
11111 { IBM861 cp861 861 cp-is csIBM861 }
11112 { IBM862 cp862 862 csPC862LatinHebrew }
11113 { IBM863 cp863 863 csIBM863 }
11114 { IBM864 cp864 csIBM864 }
11115 { IBM865 cp865 865 csIBM865 }
11116 { IBM866 cp866 866 csIBM866 }
11117 { IBM868 CP868 cp-ar csIBM868 }
11118 { IBM869 cp869 869 cp-gr csIBM869 }
11119 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11120 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11121 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11122 { IBM891 cp891 csIBM891 }
11123 { IBM903 cp903 csIBM903 }
11124 { IBM904 cp904 904 csIBBM904 }
11125 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11126 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11127 { IBM1026 CP1026 csIBM1026 }
11128 { EBCDIC-AT-DE csIBMEBCDICATDE }
11129 { EBCDIC-AT-DE-A csEBCDICATDEA }
11130 { EBCDIC-CA-FR csEBCDICCAFR }
11131 { EBCDIC-DK-NO csEBCDICDKNO }
11132 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11133 { EBCDIC-FI-SE csEBCDICFISE }
11134 { EBCDIC-FI-SE-A csEBCDICFISEA }
11135 { EBCDIC-FR csEBCDICFR }
11136 { EBCDIC-IT csEBCDICIT }
11137 { EBCDIC-PT csEBCDICPT }
11138 { EBCDIC-ES csEBCDICES }
11139 { EBCDIC-ES-A csEBCDICESA }
11140 { EBCDIC-ES-S csEBCDICESS }
11141 { EBCDIC-UK csEBCDICUK }
11142 { EBCDIC-US csEBCDICUS }
11143 { UNKNOWN-8BIT csUnknown8BiT }
11144 { MNEMONIC csMnemonic }
11146 { VISCII csVISCII }
11149 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11150 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11151 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11152 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11153 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11154 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11155 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11156 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11157 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11158 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11159 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11160 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11161 { IBM1047 IBM-1047 }
11162 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11163 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11164 { UNICODE-1-1 csUnicode11 }
11165 { CESU-8 csCESU-8 }
11166 { BOCU-1 csBOCU-1 }
11167 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11168 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11170 { ISO-8859-15 ISO_8859-15 Latin-9 }
11171 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11172 { GBK CP936 MS936 windows-936 }
11173 { JIS_Encoding csJISEncoding }
11174 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11175 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11177 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11178 { ISO-10646-UCS-Basic csUnicodeASCII }
11179 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11180 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11181 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11182 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11183 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11184 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11185 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11186 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11187 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11188 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11189 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11190 { Ventura-US csVenturaUS }
11191 { Ventura-International csVenturaInternational }
11192 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11193 { PC8-Turkish csPC8Turkish }
11194 { IBM-Symbols csIBMSymbols }
11195 { IBM-Thai csIBMThai }
11196 { HP-Legal csHPLegal }
11197 { HP-Pi-font csHPPiFont }
11198 { HP-Math8 csHPMath8 }
11199 { Adobe-Symbol-Encoding csHPPSMath }
11200 { HP-DeskTop csHPDesktop }
11201 { Ventura-Math csVenturaMath }
11202 { Microsoft-Publishing csMicrosoftPublishing }
11203 { Windows-31J csWindows31J }
11204 { GB2312 csGB2312 }
11208 proc tcl_encoding {enc} {
11209 global encoding_aliases tcl_encoding_cache
11210 if {[info exists tcl_encoding_cache($enc)]} {
11211 return $tcl_encoding_cache($enc)
11213 set names [encoding names]
11214 set lcnames [string tolower $names]
11215 set enc [string tolower $enc]
11216 set i [lsearch -exact $lcnames $enc]
11218 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11219 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11220 set i [lsearch -exact $lcnames $encx]
11224 foreach l $encoding_aliases {
11225 set ll [string tolower $l]
11226 if {[lsearch -exact $ll $enc] < 0} continue
11227 # look through the aliases for one that tcl knows about
11229 set i [lsearch -exact $lcnames $e]
11231 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11232 set i [lsearch -exact $lcnames $ex]
11242 set tclenc [lindex $names $i]
11244 set tcl_encoding_cache($enc) $tclenc
11248 proc gitattr {path attr default} {
11249 global path_attr_cache
11250 if {[info exists path_attr_cache($attr,$path)]} {
11251 set r $path_attr_cache($attr,$path)
11253 set r "unspecified"
11254 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11255 regexp "(.*): $attr: (.*)" $line m f r
11257 set path_attr_cache($attr,$path) $r
11259 if {$r eq "unspecified"} {
11265 proc cache_gitattr {attr pathlist} {
11266 global path_attr_cache
11268 foreach path $pathlist {
11269 if {![info exists path_attr_cache($attr,$path)]} {
11270 lappend newlist $path
11274 if {[tk windowingsystem] == "win32"} {
11275 # windows has a 32k limit on the arguments to a command...
11278 while {$newlist ne {}} {
11279 set head [lrange $newlist 0 [expr {$lim - 1}]]
11280 set newlist [lrange $newlist $lim end]
11281 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11282 foreach row [split $rlist "\n"] {
11283 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11284 if {[string index $path 0] eq "\""} {
11285 set path [encoding convertfrom [lindex $path 0]]
11287 set path_attr_cache($attr,$path) $value
11294 proc get_path_encoding {path} {
11295 global gui_encoding perfile_attrs
11296 set tcl_enc $gui_encoding
11297 if {$path ne {} && $perfile_attrs} {
11298 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11306 # First check that Tcl/Tk is recent enough
11307 if {[catch {package require Tk 8.4} err]} {
11308 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11309 Gitk requires at least Tcl/Tk 8.4." list
11314 set wrcomcmd "git diff-tree --stdin -p --pretty"
11318 set gitencoding [exec git config --get i18n.commitencoding]
11321 set gitencoding [exec git config --get i18n.logoutputencoding]
11323 if {$gitencoding == ""} {
11324 set gitencoding "utf-8"
11326 set tclencoding [tcl_encoding $gitencoding]
11327 if {$tclencoding == {}} {
11328 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11331 set gui_encoding [encoding system]
11333 set enc [exec git config --get gui.encoding]
11335 set tclenc [tcl_encoding $enc]
11336 if {$tclenc ne {}} {
11337 set gui_encoding $tclenc
11339 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11344 if {[tk windowingsystem] eq "aqua"} {
11345 set mainfont {{Lucida Grande} 9}
11346 set textfont {Monaco 9}
11347 set uifont {{Lucida Grande} 9 bold}
11349 set mainfont {Helvetica 9}
11350 set textfont {Courier 9}
11351 set uifont {Helvetica 9 bold}
11354 set findmergefiles 0
11362 set cmitmode "patch"
11363 set wrapcomment "none"
11368 set showlocalchanges 1
11370 set datetimeformat "%Y-%m-%d %H:%M:%S"
11372 set perfile_attrs 0
11375 if {[tk windowingsystem] eq "aqua"} {
11376 set extdifftool "opendiff"
11378 set extdifftool "meld"
11381 set colors {green red blue magenta darkgrey brown orange}
11382 if {[tk windowingsystem] eq "win32"} {
11383 set uicolor SystemButtonFace
11384 set bgcolor SystemWindow
11385 set fgcolor SystemButtonText
11386 set selectbgcolor SystemHighlight
11391 set selectbgcolor gray85
11393 set diffcolors {red "#00a000" blue}
11396 set markbgcolor "#e0e0ff"
11398 set circlecolors {white blue gray blue blue}
11400 # button for popping up context menus
11401 if {[tk windowingsystem] eq "aqua"} {
11402 set ctxbut <Button-2>
11404 set ctxbut <Button-3>
11407 ## For msgcat loading, first locate the installation location.
11408 if { [info exists ::env(GITK_MSGSDIR)] } {
11409 ## Msgsdir was manually set in the environment.
11410 set gitk_msgsdir $::env(GITK_MSGSDIR)
11412 ## Let's guess the prefix from argv0.
11413 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11414 set gitk_libdir [file join $gitk_prefix share gitk lib]
11415 set gitk_msgsdir [file join $gitk_libdir msgs]
11419 ## Internationalization (i18n) through msgcat and gettext. See
11420 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11421 package require msgcat
11422 namespace import ::msgcat::mc
11423 ## And eventually load the actual message catalog
11424 ::msgcat::mcload $gitk_msgsdir
11426 catch {source ~/.gitk}
11428 parsefont mainfont $mainfont
11429 eval font create mainfont [fontflags mainfont]
11430 eval font create mainfontbold [fontflags mainfont 1]
11432 parsefont textfont $textfont
11433 eval font create textfont [fontflags textfont]
11434 eval font create textfontbold [fontflags textfont 1]
11436 parsefont uifont $uifont
11437 eval font create uifont [fontflags uifont]
11443 # check that we can find a .git directory somewhere...
11444 if {[catch {set gitdir [gitdir]}]} {
11445 show_error {} . [mc "Cannot find a git repository here."]
11448 if {![file isdirectory $gitdir]} {
11449 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
11454 set selectheadid {}
11457 set cmdline_files {}
11459 set revtreeargscmd {}
11460 foreach arg $argv {
11461 switch -glob -- $arg {
11464 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11467 "--select-commit=*" {
11468 set selecthead [string range $arg 16 end]
11471 set revtreeargscmd [string range $arg 10 end]
11474 lappend revtreeargs $arg
11480 if {$selecthead eq "HEAD"} {
11484 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11485 # no -- on command line, but some arguments (other than --argscmd)
11487 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11488 set cmdline_files [split $f "\n"]
11489 set n [llength $cmdline_files]
11490 set revtreeargs [lrange $revtreeargs 0 end-$n]
11491 # Unfortunately git rev-parse doesn't produce an error when
11492 # something is both a revision and a filename. To be consistent
11493 # with git log and git rev-list, check revtreeargs for filenames.
11494 foreach arg $revtreeargs {
11495 if {[file exists $arg]} {
11496 show_error {} . [mc "Ambiguous argument '%s': both revision\
11497 and filename" $arg]
11502 # unfortunately we get both stdout and stderr in $err,
11503 # so look for "fatal:".
11504 set i [string first "fatal:" $err]
11506 set err [string range $err [expr {$i + 6}] end]
11508 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11513 set nullid "0000000000000000000000000000000000000000"
11514 set nullid2 "0000000000000000000000000000000000000001"
11515 set nullfile "/dev/null"
11517 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11518 if {![info exists have_ttk]} {
11519 set have_ttk [llength [info commands ::ttk::style]]
11521 set use_ttk [expr {$have_ttk && $want_ttk}]
11522 set NS [expr {$use_ttk ? "ttk" : ""}]
11524 set git_version [join [lrange [split [lindex [exec git version] end] .] 0 2] .]
11527 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11528 set show_notes "--show-notes"
11536 set highlight_paths {}
11538 set searchdirn -forwards
11541 set diffelide {0 0}
11542 set markingmatches 0
11543 set linkentercount 0
11544 set need_redisplay 0
11551 set selectedhlview [mc "None"]
11552 set highlight_related [mc "None"]
11553 set highlight_files {}
11554 set viewfiles(0) {}
11557 set viewargscmd(0) {}
11559 set selectedline {}
11567 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
11571 image create photo gitlogo -width 16 -height 16
11573 image create photo gitlogominus -width 4 -height 2
11574 gitlogominus put #C00000 -to 0 0 4 2
11575 gitlogo copy gitlogominus -to 1 5
11576 gitlogo copy gitlogominus -to 6 5
11577 gitlogo copy gitlogominus -to 11 5
11578 image delete gitlogominus
11580 image create photo gitlogoplus -width 4 -height 4
11581 gitlogoplus put #008000 -to 1 0 3 4
11582 gitlogoplus put #008000 -to 0 1 4 3
11583 gitlogo copy gitlogoplus -to 1 9
11584 gitlogo copy gitlogoplus -to 6 9
11585 gitlogo copy gitlogoplus -to 11 9
11586 image delete gitlogoplus
11588 image create photo gitlogo32 -width 32 -height 32
11589 gitlogo32 copy gitlogo -zoom 2 2
11591 wm iconphoto . -default gitlogo gitlogo32
11593 # wait for the window to become visible
11594 tkwait visibility .
11595 wm title . "[file tail $argv0]: [file tail [pwd]]"
11599 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11600 # create a view for the files/dirs specified on the command line
11604 set viewname(1) [mc "Command line"]
11605 set viewfiles(1) $cmdline_files
11606 set viewargs(1) $revtreeargs
11607 set viewargscmd(1) $revtreeargscmd
11611 .bar.view entryconf [mca "Edit view..."] -state normal
11612 .bar.view entryconf [mca "Delete view"] -state normal
11615 if {[info exists permviews]} {
11616 foreach v $permviews {
11619 set viewname($n) [lindex $v 0]
11620 set viewfiles($n) [lindex $v 1]
11621 set viewargs($n) [lindex $v 2]
11622 set viewargscmd($n) [lindex $v 3]
11628 if {[tk windowingsystem] eq "win32"} {
11636 # indent-tabs-mode: t