2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env
(GIT_DIR
)]} {
15 return [exec git rev-parse
--git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
28 if {[info exists isonrunq
($script)]} return
32 lappend runq
[list
{} $script]
33 set isonrunq
($script) 1
36 proc filerun
{fd
script} {
37 fileevent
$fd readable
[list filereadable
$fd $script]
40 proc filereadable
{fd
script} {
43 fileevent
$fd readable
{}
47 lappend runq
[list
$fd $script]
53 for {set i
0} {$i < [llength
$runq]} {} {
54 if {[lindex
$runq $i 0] eq
$fd} {
55 set runq
[lreplace
$runq $i $i]
65 set tstart
[clock clicks
-milliseconds]
67 while {[llength
$runq] > 0} {
68 set fd
[lindex
$runq 0 0]
69 set script [lindex
$runq 0 1]
70 set repeat
[eval $script]
71 set t1
[clock clicks
-milliseconds]
72 set t
[expr {$t1 - $t0}]
73 set runq
[lrange
$runq 1 end
]
74 if {$repeat ne
{} && $repeat} {
75 if {$fd eq
{} ||
$repeat == 2} {
76 # script returns 1 if it wants to be readded
77 # file readers return 2 if they could do more straight away
78 lappend runq
[list
$fd $script]
80 fileevent
$fd readable
[list filereadable
$fd $script]
82 } elseif
{$fd eq
{}} {
83 unset isonrunq
($script)
86 if {$t1 - $tstart >= 80} break
93 # Start off a git log process and arrange to read its output
94 proc start_rev_list
{view
} {
96 global commfd leftover tclencoding datemode
97 global viewargs viewfiles commitidx viewcomplete
98 global showlocalchanges commitinterest mainheadid
99 global progressdirn progresscoords proglastnc curview
100 global viewactive loginstance viewinstances
101 global pending_select mainheadid
103 set startmsecs
[clock clicks
-milliseconds]
104 set commitidx
($view) 0
105 set viewcomplete
($view) 0
106 set viewactive
($view) 1
110 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
111 --boundary $viewargs($view) "--" $viewfiles($view)] r
]
113 error_popup
"[mc "Error executing git log
:"] $err"
116 set i
[incr loginstance
]
117 set viewinstances
($view) [list
$i]
120 if {$showlocalchanges} {
121 lappend commitinterest
($mainheadid) {dodiffindex
}
123 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
124 if {$tclencoding != {}} {
125 fconfigure
$fd -encoding $tclencoding
127 filerun
$fd [list getcommitlines
$fd $i $view 0]
128 nowbusy
$view [mc
"Reading"]
129 if {$view == $curview} {
131 set progresscoords
{0 0}
133 set pending_select
$mainheadid
137 proc stop_rev_list
{view
} {
138 global commfd viewinstances leftover
140 foreach inst
$viewinstances($view) {
141 set fd
$commfd($inst)
149 unset leftover
($inst)
151 set viewinstances
($view) {}
155 global canv curview need_redisplay
158 start_rev_list
$curview
159 show_status
[mc
"Reading commits..."]
163 proc updatecommits
{} {
164 global curview viewargs viewfiles viewinstances
165 global viewactive viewcomplete loginstance tclencoding mainheadid
166 global startmsecs commfd showneartags showlocalchanges leftover
167 global mainheadid pending_select
169 set oldmainid
$mainheadid
171 if {$showlocalchanges} {
172 if {$mainheadid ne
$oldmainid} {
175 if {[commitinview
$mainheadid $curview]} {
181 set fd
[open
[concat | git log
--no-color -z --pretty=raw
--parents \
182 --boundary $viewargs($view) --not [seeds
$view] \
183 "--" $viewfiles($view)] r
]
185 error_popup
"Error executing git log: $err"
188 if {$viewactive($view) == 0} {
189 set startmsecs
[clock clicks
-milliseconds]
191 set i
[incr loginstance
]
192 lappend viewinstances
($view) $i
195 fconfigure
$fd -blocking 0 -translation lf
-eofchar {}
196 if {$tclencoding != {}} {
197 fconfigure
$fd -encoding $tclencoding
199 filerun
$fd [list getcommitlines
$fd $i $view 1]
200 incr viewactive
($view)
201 set viewcomplete
($view) 0
202 set pending_select
$mainheadid
203 nowbusy
$view "Reading"
209 proc reloadcommits
{} {
210 global curview viewcomplete selectedline currentid thickerline
211 global showneartags treediffs commitinterest cached_commitrow
212 global progresscoords targetid
214 if {!$viewcomplete($curview)} {
215 stop_rev_list
$curview
216 set progresscoords
{0 0}
220 catch
{unset selectedline
}
221 catch
{unset currentid
}
222 catch
{unset thickerline
}
223 catch
{unset treediffs
}
230 catch
{unset commitinterest
}
231 catch
{unset cached_commitrow
}
232 catch
{unset targetid
}
238 # This makes a string representation of a positive integer which
239 # sorts as a string in numerical order
242 return [format
"%x" $n]
243 } elseif
{$n < 256} {
244 return [format
"x%.2x" $n]
245 } elseif
{$n < 65536} {
246 return [format
"y%.4x" $n]
248 return [format
"z%.8x" $n]
251 # Procedures used in reordering commits from git log (without
252 # --topo-order) into the order for display.
254 proc varcinit
{view
} {
255 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
256 global vtokmod varcmod vrowmod varcix vlastins
258 set varcstart
($view) {{}}
259 set vupptr
($view) {0}
260 set vdownptr
($view) {0}
261 set vleftptr
($view) {0}
262 set vbackptr
($view) {0}
263 set varctok
($view) {{}}
264 set varcrow
($view) {{}}
265 set vtokmod
($view) {}
268 set varcix
($view) {{}}
269 set vlastins
($view) {0}
272 proc resetvarcs
{view
} {
273 global varcid varccommits parents children vseedcount ordertok
275 foreach vid
[array names varcid
$view,*] {
280 # some commits might have children but haven't been seen yet
281 foreach vid
[array names children
$view,*] {
284 foreach va
[array names varccommits
$view,*] {
285 unset varccommits
($va)
287 foreach vd
[array names vseedcount
$view,*] {
288 unset vseedcount
($vd)
290 catch
{unset ordertok
}
293 # returns a list of the commits with no children
295 global vdownptr vleftptr varcstart
298 set a
[lindex
$vdownptr($v) 0]
300 lappend ret
[lindex
$varcstart($v) $a]
301 set a
[lindex
$vleftptr($v) $a]
306 proc newvarc
{view id
} {
307 global varcid varctok parents children datemode
308 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
309 global commitdata commitinfo vseedcount varccommits vlastins
311 set a
[llength
$varctok($view)]
313 if {[llength
$children($vid)] == 0 ||
$datemode} {
314 if {![info exists commitinfo
($id)]} {
315 parsecommit
$id $commitdata($id) 1
317 set cdate
[lindex
$commitinfo($id) 4]
318 if {![string is integer
-strict $cdate]} {
321 if {![info exists vseedcount
($view,$cdate)]} {
322 set vseedcount
($view,$cdate) -1
324 set c
[incr vseedcount
($view,$cdate)]
325 set cdate
[expr {$cdate ^
0xffffffff}]
326 set tok
"s[strrep $cdate][strrep $c]"
331 if {[llength
$children($vid)] > 0} {
332 set kid
[lindex
$children($vid) end
]
333 set k
$varcid($view,$kid)
334 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
337 set tok
[lindex
$varctok($view) $k]
341 set i
[lsearch
-exact $parents($view,$ki) $id]
342 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
343 append tok
[strrep
$j]
345 set c
[lindex
$vlastins($view) $ka]
346 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
348 set b
[lindex
$vdownptr($view) $ka]
350 set b
[lindex
$vleftptr($view) $c]
352 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
354 set b
[lindex
$vleftptr($view) $c]
357 lset vdownptr
($view) $ka $a
358 lappend vbackptr
($view) 0
360 lset vleftptr
($view) $c $a
361 lappend vbackptr
($view) $c
363 lset vlastins
($view) $ka $a
364 lappend vupptr
($view) $ka
365 lappend vleftptr
($view) $b
367 lset vbackptr
($view) $b $a
369 lappend varctok
($view) $tok
370 lappend varcstart
($view) $id
371 lappend vdownptr
($view) 0
372 lappend varcrow
($view) {}
373 lappend varcix
($view) {}
374 set varccommits
($view,$a) {}
375 lappend vlastins
($view) 0
379 proc splitvarc
{p v
} {
380 global varcid varcstart varccommits varctok
381 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
383 set oa
$varcid($v,$p)
384 set ac
$varccommits($v,$oa)
385 set i
[lsearch
-exact $varccommits($v,$oa) $p]
387 set na
[llength
$varctok($v)]
388 # "%" sorts before "0"...
389 set tok
"[lindex $varctok($v) $oa]%[strrep $i]"
390 lappend varctok
($v) $tok
391 lappend varcrow
($v) {}
392 lappend varcix
($v) {}
393 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
394 set varccommits
($v,$na) [lrange
$ac $i end
]
395 lappend varcstart
($v) $p
396 foreach id
$varccommits($v,$na) {
397 set varcid
($v,$id) $na
399 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
400 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
401 lset vdownptr
($v) $oa $na
402 lset vlastins
($v) $oa 0
403 lappend vupptr
($v) $oa
404 lappend vleftptr
($v) 0
405 lappend vbackptr
($v) 0
406 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
407 lset vupptr
($v) $b $na
411 proc renumbervarc
{a v
} {
412 global parents children varctok varcstart varccommits
413 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
415 set t1
[clock clicks
-milliseconds]
421 if {[info exists isrelated
($a)]} {
423 set id
[lindex
$varccommits($v,$a) end
]
424 foreach p
$parents($v,$id) {
425 if {[info exists varcid
($v,$p)]} {
426 set isrelated
($varcid($v,$p)) 1
431 set b
[lindex
$vdownptr($v) $a]
434 set b
[lindex
$vleftptr($v) $a]
436 set a
[lindex
$vupptr($v) $a]
442 if {![info exists kidchanged
($a)]} continue
443 set id
[lindex
$varcstart($v) $a]
444 if {[llength
$children($v,$id)] > 1} {
445 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
448 set oldtok
[lindex
$varctok($v) $a]
455 set kid
[last_real_child
$v,$id]
457 set k
$varcid($v,$kid)
458 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
461 set tok
[lindex
$varctok($v) $k]
465 set i
[lsearch
-exact $parents($v,$ki) $id]
466 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
467 append tok
[strrep
$j]
469 if {$tok eq
$oldtok} {
472 set id
[lindex
$varccommits($v,$a) end
]
473 foreach p
$parents($v,$id) {
474 if {[info exists varcid
($v,$p)]} {
475 set kidchanged
($varcid($v,$p)) 1
480 lset varctok
($v) $a $tok
481 set b
[lindex
$vupptr($v) $a]
483 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
486 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
489 set c
[lindex
$vbackptr($v) $a]
490 set d
[lindex
$vleftptr($v) $a]
492 lset vdownptr
($v) $b $d
494 lset vleftptr
($v) $c $d
497 lset vbackptr
($v) $d $c
499 if {[lindex
$vlastins($v) $b] == $a} {
500 lset vlastins
($v) $b $c
502 lset vupptr
($v) $a $ka
503 set c
[lindex
$vlastins($v) $ka]
505 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
507 set b
[lindex
$vdownptr($v) $ka]
509 set b
[lindex
$vleftptr($v) $c]
512 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
514 set b
[lindex
$vleftptr($v) $c]
517 lset vdownptr
($v) $ka $a
518 lset vbackptr
($v) $a 0
520 lset vleftptr
($v) $c $a
521 lset vbackptr
($v) $a $c
523 lset vleftptr
($v) $a $b
525 lset vbackptr
($v) $b $a
527 lset vlastins
($v) $ka $a
530 foreach id
[array names sortkids
] {
531 if {[llength
$children($v,$id)] > 1} {
532 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
536 set t2
[clock clicks
-milliseconds]
537 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
540 # Fix up the graph after we have found out that in view $v,
541 # $p (a commit that we have already seen) is actually the parent
542 # of the last commit in arc $a.
543 proc fix_reversal
{p a v
} {
544 global varcid varcstart varctok vupptr
546 set pa
$varcid($v,$p)
547 if {$p ne
[lindex
$varcstart($v) $pa]} {
549 set pa
$varcid($v,$p)
551 # seeds always need to be renumbered
552 if {[lindex
$vupptr($v) $pa] == 0 ||
553 [string compare
[lindex
$varctok($v) $a] \
554 [lindex
$varctok($v) $pa]] > 0} {
559 proc insertrow
{id p v
} {
560 global cmitlisted children parents varcid varctok vtokmod
561 global varccommits ordertok commitidx numcommits curview
562 global targetid targetrow
566 set cmitlisted
($vid) 1
567 set children
($vid) {}
568 set parents
($vid) [list
$p]
569 set a
[newvarc
$v $id]
571 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
574 lappend varccommits
($v,$a) $id
576 if {[llength
[lappend children
($vp) $id]] > 1} {
577 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
578 catch
{unset ordertok
}
580 fix_reversal
$p $a $v
582 if {$v == $curview} {
583 set numcommits
$commitidx($v)
585 if {[info exists targetid
]} {
586 if {![comes_before
$targetid $p]} {
593 proc insertfakerow
{id p
} {
594 global varcid varccommits parents children cmitlisted
595 global commitidx varctok vtokmod targetid targetrow curview numcommits
599 set i
[lsearch
-exact $varccommits($v,$a) $p]
601 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
604 set children
($v,$id) {}
605 set parents
($v,$id) [list
$p]
606 set varcid
($v,$id) $a
607 lappend children
($v,$p) $id
608 set cmitlisted
($v,$id) 1
609 set numcommits
[incr commitidx
($v)]
610 # note we deliberately don't update varcstart($v) even if $i == 0
611 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
613 if {[info exists targetid
]} {
614 if {![comes_before
$targetid $p]} {
622 proc removefakerow
{id
} {
623 global varcid varccommits parents children commitidx
624 global varctok vtokmod cmitlisted currentid selectedline
625 global targetid curview numcommits
628 if {[llength
$parents($v,$id)] != 1} {
629 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
632 set p
[lindex
$parents($v,$id) 0]
633 set a
$varcid($v,$id)
634 set i
[lsearch
-exact $varccommits($v,$a) $id]
636 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
640 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
641 unset parents
($v,$id)
642 unset children
($v,$id)
643 unset cmitlisted
($v,$id)
644 set numcommits
[incr commitidx
($v) -1]
645 set j
[lsearch
-exact $children($v,$p) $id]
647 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
650 if {[info exist currentid
] && $id eq
$currentid} {
654 if {[info exists targetid
] && $targetid eq
$id} {
661 proc first_real_child
{vp
} {
662 global children nullid nullid2
664 foreach id
$children($vp) {
665 if {$id ne
$nullid && $id ne
$nullid2} {
672 proc last_real_child
{vp
} {
673 global children nullid nullid2
675 set kids
$children($vp)
676 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
677 set id
[lindex
$kids $i]
678 if {$id ne
$nullid && $id ne
$nullid2} {
685 proc vtokcmp
{v a b
} {
686 global varctok varcid
688 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
689 [lindex
$varctok($v) $varcid($v,$b)]]
692 # This assumes that if lim is not given, the caller has checked that
693 # arc a's token is less than $vtokmod($v)
694 proc modify_arc
{v a
{lim
{}}} {
695 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
698 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
701 set r
[lindex
$varcrow($v) $a]
702 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
705 set vtokmod
($v) [lindex
$varctok($v) $a]
707 if {$v == $curview} {
708 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
709 set a
[lindex
$vupptr($v) $a]
715 set lim
[llength
$varccommits($v,$a)]
717 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
724 proc update_arcrows
{v
} {
725 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
726 global varcid vrownum varcorder varcix varccommits
727 global vupptr vdownptr vleftptr varctok
728 global displayorder parentlist curview cached_commitrow
730 if {$vrowmod($v) == $commitidx($v)} return
731 if {$v == $curview} {
732 if {[llength
$displayorder] > $vrowmod($v)} {
733 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
734 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
736 catch
{unset cached_commitrow
}
738 set narctot
[expr {[llength
$varctok($v)] - 1}]
740 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
741 # go up the tree until we find something that has a row number,
742 # or we get to a seed
743 set a
[lindex
$vupptr($v) $a]
746 set a
[lindex
$vdownptr($v) 0]
749 set varcorder
($v) [list
$a]
751 lset varcrow
($v) $a 0
755 set arcn
[lindex
$varcix($v) $a]
756 if {[llength
$vrownum($v)] > $arcn + 1} {
757 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
758 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
760 set row
[lindex
$varcrow($v) $a]
764 incr row
[llength
$varccommits($v,$a)]
765 # go down if possible
766 set b
[lindex
$vdownptr($v) $a]
768 # if not, go left, or go up until we can go left
770 set b
[lindex
$vleftptr($v) $a]
772 set a
[lindex
$vupptr($v) $a]
778 lappend vrownum
($v) $row
779 lappend varcorder
($v) $a
780 lset varcix
($v) $a $arcn
781 lset varcrow
($v) $a $row
783 set vtokmod
($v) [lindex
$varctok($v) $p]
786 if {[info exists currentid
]} {
787 set selectedline
[rowofcommit
$currentid]
791 # Test whether view $v contains commit $id
792 proc commitinview
{id v
} {
795 return [info exists varcid
($v,$id)]
798 # Return the row number for commit $id in the current view
799 proc rowofcommit
{id
} {
800 global varcid varccommits varcrow curview cached_commitrow
801 global varctok vtokmod
804 if {![info exists varcid
($v,$id)]} {
805 puts
"oops rowofcommit no arc for [shortids $id]"
808 set a
$varcid($v,$id)
809 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
812 if {[info exists cached_commitrow
($id)]} {
813 return $cached_commitrow($id)
815 set i
[lsearch
-exact $varccommits($v,$a) $id]
817 puts
"oops didn't find commit [shortids $id] in arc $a"
820 incr i
[lindex
$varcrow($v) $a]
821 set cached_commitrow
($id) $i
825 # Returns 1 if a is on an earlier row than b, otherwise 0
826 proc comes_before
{a b
} {
827 global varcid varctok curview
830 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
831 ![info exists varcid
($v,$b)]} {
834 if {$varcid($v,$a) != $varcid($v,$b)} {
835 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
836 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
838 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
841 proc bsearch
{l elt
} {
842 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
847 while {$hi - $lo > 1} {
848 set mid
[expr {int
(($lo + $hi) / 2)}]
849 set t
[lindex
$l $mid]
852 } elseif
{$elt > $t} {
861 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
862 proc make_disporder
{start end
} {
863 global vrownum curview commitidx displayorder parentlist
864 global varccommits varcorder parents vrowmod varcrow
865 global d_valid_start d_valid_end
867 if {$end > $vrowmod($curview)} {
868 update_arcrows
$curview
870 set ai
[bsearch
$vrownum($curview) $start]
871 set start
[lindex
$vrownum($curview) $ai]
872 set narc
[llength
$vrownum($curview)]
873 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
874 set a
[lindex
$varcorder($curview) $ai]
875 set l
[llength
$displayorder]
876 set al
[llength
$varccommits($curview,$a)]
879 set pad
[ntimes
[expr {$r - $l}] {}]
880 set displayorder
[concat
$displayorder $pad]
881 set parentlist
[concat
$parentlist $pad]
883 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
884 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
886 foreach id
$varccommits($curview,$a) {
887 lappend displayorder
$id
888 lappend parentlist
$parents($curview,$id)
890 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
892 foreach id
$varccommits($curview,$a) {
893 lset displayorder
$i $id
894 lset parentlist
$i $parents($curview,$id)
902 proc commitonrow
{row
} {
905 set id
[lindex
$displayorder $row]
907 make_disporder
$row [expr {$row + 1}]
908 set id
[lindex
$displayorder $row]
913 proc closevarcs
{v
} {
914 global varctok varccommits varcid parents children
915 global cmitlisted commitidx commitinterest vtokmod
917 set missing_parents
0
919 set narcs
[llength
$varctok($v)]
920 for {set a
1} {$a < $narcs} {incr a
} {
921 set id
[lindex
$varccommits($v,$a) end
]
922 foreach p
$parents($v,$id) {
923 if {[info exists varcid
($v,$p)]} continue
924 # add p as a new commit
926 set cmitlisted
($v,$p) 0
927 set parents
($v,$p) {}
928 if {[llength
$children($v,$p)] == 1 &&
929 [llength
$parents($v,$id)] == 1} {
932 set b
[newvarc
$v $p]
935 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
938 lappend varccommits
($v,$b) $p
940 if {[info exists commitinterest
($p)]} {
941 foreach
script $commitinterest($p) {
942 lappend scripts
[string map
[list
"%I" $p] $script]
944 unset commitinterest
($id)
948 if {$missing_parents > 0} {
955 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
956 # Assumes we already have an arc for $rwid.
957 proc rewrite_commit
{v id rwid
} {
958 global children parents varcid varctok vtokmod varccommits
960 foreach ch
$children($v,$id) {
961 # make $rwid be $ch's parent in place of $id
962 set i
[lsearch
-exact $parents($v,$ch) $id]
964 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
966 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
967 # add $ch to $rwid's children and sort the list if necessary
968 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
969 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
972 # fix the graph after joining $id to $rwid
973 set a
$varcid($v,$ch)
974 fix_reversal
$rwid $a $v
975 # parentlist is wrong for the last element of arc $a
976 # even if displayorder is right, hence the 3rd arg here
977 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
981 proc getcommitlines
{fd inst view updating
} {
982 global cmitlisted commitinterest leftover
983 global commitidx commitdata datemode
984 global parents children curview hlview
985 global idpending ordertok
986 global varccommits varcid varctok vtokmod viewfiles
988 set stuff
[read $fd 500000]
989 # git log doesn't terminate the last commit with a null...
990 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
997 global commfd viewcomplete viewactive viewname progresscoords
1000 set i
[lsearch
-exact $viewinstances($view) $inst]
1002 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1004 # set it blocking so we wait for the process to terminate
1005 fconfigure
$fd -blocking 1
1006 if {[catch
{close
$fd} err
]} {
1008 if {$view != $curview} {
1009 set fv
" for the \"$viewname($view)\" view"
1011 if {[string range
$err 0 4] == "usage"} {
1012 set err
"Gitk: error reading commits$fv:\
1013 bad arguments to git log."
1014 if {$viewname($view) eq
"Command line"} {
1016 " (Note: arguments to gitk are passed to git log\
1017 to allow selection of commits to be displayed.)"
1020 set err
"Error reading commits$fv: $err"
1024 if {[incr viewactive
($view) -1] <= 0} {
1025 set viewcomplete
($view) 1
1026 # Check if we have seen any ids listed as parents that haven't
1027 # appeared in the list
1030 set progresscoords
{0 0}
1033 if {$view == $curview} {
1042 set i
[string first
"\0" $stuff $start]
1044 append leftover
($inst) [string range
$stuff $start end
]
1048 set cmit
$leftover($inst)
1049 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1050 set leftover
($inst) {}
1052 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1054 set start
[expr {$i + 1}]
1055 set j
[string first
"\n" $cmit]
1058 if {$j >= 0 && [string match
"commit *" $cmit]} {
1059 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1060 if {[string match
{[-^
<>]*} $ids]} {
1061 switch
-- [string index
$ids 0] {
1067 set ids
[string range
$ids 1 end
]
1071 if {[string length
$id] != 40} {
1079 if {[string length
$shortcmit] > 80} {
1080 set shortcmit
"[string range $shortcmit 0 80]..."
1082 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1085 set id [lindex $ids 0]
1088 if {!$listed && $updating && ![info exists varcid($vid)] &&
1089 $viewfiles($view) ne {}} {
1090 # git log doesn't rewrite parents
for unlisted commits
1091 # when doing path limiting, so work around that here
1092 # by working out the rewritten parent with git rev-list
1093 # and if we already know about it, using the rewritten
1094 # parent as a substitute parent for $id's children.
1096 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1097 $id -- $viewfiles($view)]
1099 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1100 # use $rwid in place of $id
1101 rewrite_commit
$view $id $rwid
1108 if {[info exists varcid
($vid)]} {
1109 if {$cmitlisted($vid) ||
!$listed} continue
1113 set olds
[lrange
$ids 1 end
]
1117 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1118 set cmitlisted
($vid) $listed
1119 set parents
($vid) $olds
1120 if {![info exists children
($vid)]} {
1121 set children
($vid) {}
1122 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1123 set k
[lindex
$children($vid) 0]
1124 if {[llength
$parents($view,$k)] == 1 &&
1126 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1127 set a
$varcid($view,$k)
1132 set a
[newvarc
$view $id]
1134 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1137 if {![info exists varcid
($vid)]} {
1139 lappend varccommits
($view,$a) $id
1140 incr commitidx
($view)
1145 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1147 if {[llength
[lappend children
($vp) $id]] > 1 &&
1148 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1149 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1151 catch
{unset ordertok
}
1153 if {[info exists varcid
($view,$p)]} {
1154 fix_reversal
$p $a $view
1160 if {[info exists commitinterest
($id)]} {
1161 foreach
script $commitinterest($id) {
1162 lappend scripts
[string map
[list
"%I" $id] $script]
1164 unset commitinterest
($id)
1169 global numcommits hlview
1171 if {$view == $curview} {
1172 set numcommits
$commitidx($view)
1175 if {[info exists hlview
] && $view == $hlview} {
1176 # we never actually get here...
1179 foreach s
$scripts {
1182 if {$view == $curview} {
1183 # update progress bar
1184 global progressdirn progresscoords proglastnc
1185 set inc
[expr {($commitidx($view) - $proglastnc) * 0.0002}]
1186 set proglastnc
$commitidx($view)
1187 set l
[lindex
$progresscoords 0]
1188 set r
[lindex
$progresscoords 1]
1189 if {$progressdirn} {
1190 set r
[expr {$r + $inc}]
1196 set l
[expr {$r - 0.2}]
1199 set l
[expr {$l - $inc}]
1204 set r
[expr {$l + 0.2}]
1206 set progresscoords
[list
$l $r]
1213 proc chewcommits
{} {
1214 global curview hlview viewcomplete
1215 global pending_select
1218 if {$viewcomplete($curview)} {
1219 global commitidx varctok
1220 global numcommits startmsecs
1221 global mainheadid commitinfo nullid
1223 if {[info exists pending_select
]} {
1224 set row
[first_real_row
]
1227 if {$commitidx($curview) > 0} {
1228 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1229 #puts "overall $ms ms for $numcommits commits"
1230 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1232 show_status
[mc
"No commits selected"]
1239 proc readcommit
{id
} {
1240 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
1241 parsecommit
$id $contents 0
1244 proc parsecommit
{id contents listed
} {
1245 global commitinfo cdate
1254 set hdrend
[string first
"\n\n" $contents]
1256 # should never happen...
1257 set hdrend
[string length
$contents]
1259 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1260 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1261 foreach line
[split $header "\n"] {
1262 set tag
[lindex
$line 0]
1263 if {$tag == "author"} {
1264 set audate
[lindex
$line end-1
]
1265 set auname
[lrange
$line 1 end-2
]
1266 } elseif
{$tag == "committer"} {
1267 set comdate
[lindex
$line end-1
]
1268 set comname
[lrange
$line 1 end-2
]
1272 # take the first non-blank line of the comment as the headline
1273 set headline
[string trimleft
$comment]
1274 set i
[string first
"\n" $headline]
1276 set headline
[string range
$headline 0 $i]
1278 set headline
[string trimright
$headline]
1279 set i
[string first
"\r" $headline]
1281 set headline
[string trimright
[string range
$headline 0 $i]]
1284 # git log indents the comment by 4 spaces;
1285 # if we got this via git cat-file, add the indentation
1287 foreach line
[split $comment "\n"] {
1288 append newcomment
" "
1289 append newcomment
$line
1290 append newcomment
"\n"
1292 set comment
$newcomment
1294 if {$comdate != {}} {
1295 set cdate
($id) $comdate
1297 set commitinfo
($id) [list
$headline $auname $audate \
1298 $comname $comdate $comment]
1301 proc getcommit
{id
} {
1302 global commitdata commitinfo
1304 if {[info exists commitdata
($id)]} {
1305 parsecommit
$id $commitdata($id) 1
1308 if {![info exists commitinfo
($id)]} {
1309 set commitinfo
($id) [list
[mc
"No commit information available"]]
1316 global tagids idtags headids idheads tagobjid
1317 global otherrefids idotherrefs mainhead mainheadid
1319 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1322 set refd
[open
[list | git show-ref
-d] r
]
1323 while {[gets
$refd line
] >= 0} {
1324 if {[string index
$line 40] ne
" "} continue
1325 set id
[string range
$line 0 39]
1326 set ref
[string range
$line 41 end
]
1327 if {![string match
"refs/*" $ref]} continue
1328 set name
[string range
$ref 5 end
]
1329 if {[string match
"remotes/*" $name]} {
1330 if {![string match
"*/HEAD" $name]} {
1331 set headids
($name) $id
1332 lappend idheads
($id) $name
1334 } elseif
{[string match
"heads/*" $name]} {
1335 set name
[string range
$name 6 end
]
1336 set headids
($name) $id
1337 lappend idheads
($id) $name
1338 } elseif
{[string match
"tags/*" $name]} {
1339 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1340 # which is what we want since the former is the commit ID
1341 set name
[string range
$name 5 end
]
1342 if {[string match
"*^{}" $name]} {
1343 set name
[string range
$name 0 end-3
]
1345 set tagobjid
($name) $id
1347 set tagids
($name) $id
1348 lappend idtags
($id) $name
1350 set otherrefids
($name) $id
1351 lappend idotherrefs
($id) $name
1358 set thehead
[exec git symbolic-ref HEAD
]
1359 if {[string match
"refs/heads/*" $thehead]} {
1360 set mainhead
[string range
$thehead 11 end
]
1361 if {[info exists headids
($mainhead)]} {
1362 set mainheadid
$headids($mainhead)
1368 # skip over fake commits
1369 proc first_real_row
{} {
1370 global nullid nullid2 numcommits
1372 for {set row
0} {$row < $numcommits} {incr row
} {
1373 set id
[commitonrow
$row]
1374 if {$id ne
$nullid && $id ne
$nullid2} {
1381 # update things for a head moved to a child of its previous location
1382 proc movehead
{id name
} {
1383 global headids idheads
1385 removehead
$headids($name) $name
1386 set headids
($name) $id
1387 lappend idheads
($id) $name
1390 # update things when a head has been removed
1391 proc removehead
{id name
} {
1392 global headids idheads
1394 if {$idheads($id) eq
$name} {
1397 set i
[lsearch
-exact $idheads($id) $name]
1399 set idheads
($id) [lreplace
$idheads($id) $i $i]
1402 unset headids
($name)
1405 proc show_error
{w top msg
} {
1406 message
$w.m
-text $msg -justify center
-aspect 400
1407 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1408 button
$w.ok
-text [mc OK
] -command "destroy $top"
1409 pack
$w.ok
-side bottom
-fill x
1410 bind $top <Visibility
> "grab $top; focus $top"
1411 bind $top <Key-Return
> "destroy $top"
1415 proc error_popup msg
{
1419 show_error
$w $w $msg
1422 proc confirm_popup msg
{
1428 message
$w.m
-text $msg -justify center
-aspect 400
1429 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1430 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1431 pack
$w.ok
-side left
-fill x
1432 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1433 pack
$w.cancel
-side right
-fill x
1434 bind $w <Visibility
> "grab $w; focus $w"
1439 proc setoptions
{} {
1440 option add
*Panedwindow.showHandle
1 startupFile
1441 option add
*Panedwindow.sashRelief raised startupFile
1442 option add
*Button.font uifont startupFile
1443 option add
*Checkbutton.font uifont startupFile
1444 option add
*Radiobutton.font uifont startupFile
1445 option add
*Menu.font uifont startupFile
1446 option add
*Menubutton.font uifont startupFile
1447 option add
*Label.font uifont startupFile
1448 option add
*Message.font uifont startupFile
1449 option add
*Entry.font uifont startupFile
1452 proc makewindow
{} {
1453 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1455 global findtype findtypemenu findloc findstring fstring geometry
1456 global entries sha1entry sha1string sha1but
1457 global diffcontextstring diffcontext
1459 global maincursor textcursor curtextcursor
1460 global rowctxmenu fakerowmenu mergemax wrapcomment
1461 global highlight_files gdttype
1462 global searchstring sstring
1463 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1464 global headctxmenu progresscanv progressitem progresscoords statusw
1465 global fprogitem fprogcoord lastprogupdate progupdatepending
1466 global rprogitem rprogcoord
1470 .bar add cascade
-label [mc
"File"] -menu .bar.
file
1472 .bar.
file add
command -label [mc
"Update"] -command updatecommits
1473 .bar.
file add
command -label [mc
"Reload"] -command reloadcommits
1474 .bar.
file add
command -label [mc
"Reread references"] -command rereadrefs
1475 .bar.
file add
command -label [mc
"List references"] -command showrefs
1476 .bar.
file add
command -label [mc
"Quit"] -command doquit
1478 .bar add cascade
-label [mc
"Edit"] -menu .bar.edit
1479 .bar.edit add
command -label [mc
"Preferences"] -command doprefs
1482 .bar add cascade
-label [mc
"View"] -menu .bar.view
1483 .bar.view add
command -label [mc
"New view..."] -command {newview
0}
1484 .bar.view add
command -label [mc
"Edit view..."] -command editview \
1486 .bar.view add
command -label [mc
"Delete view"] -command delview
-state disabled
1487 .bar.view add separator
1488 .bar.view add radiobutton
-label [mc
"All files"] -command {showview
0} \
1489 -variable selectedview
-value 0
1492 .bar add cascade
-label [mc
"Help"] -menu .bar.
help
1493 .bar.
help add
command -label [mc
"About gitk"] -command about
1494 .bar.
help add
command -label [mc
"Key bindings"] -command keys
1496 . configure
-menu .bar
1498 # the gui has upper and lower half, parts of a paned window.
1499 panedwindow .ctop
-orient vertical
1501 # possibly use assumed geometry
1502 if {![info exists geometry
(pwsash0
)]} {
1503 set geometry
(topheight
) [expr {15 * $linespc}]
1504 set geometry
(topwidth
) [expr {80 * $charspc}]
1505 set geometry
(botheight
) [expr {15 * $linespc}]
1506 set geometry
(botwidth
) [expr {50 * $charspc}]
1507 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1508 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1511 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1512 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1514 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1516 # create three canvases
1517 set cscroll .tf.histframe.csb
1518 set canv .tf.histframe.pwclist.canv
1520 -selectbackground $selectbgcolor \
1521 -background $bgcolor -bd 0 \
1522 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1523 .tf.histframe.pwclist add
$canv
1524 set canv2 .tf.histframe.pwclist.canv2
1526 -selectbackground $selectbgcolor \
1527 -background $bgcolor -bd 0 -yscrollincr $linespc
1528 .tf.histframe.pwclist add
$canv2
1529 set canv3 .tf.histframe.pwclist.canv3
1531 -selectbackground $selectbgcolor \
1532 -background $bgcolor -bd 0 -yscrollincr $linespc
1533 .tf.histframe.pwclist add
$canv3
1534 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1535 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1537 # a scroll bar to rule them
1538 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1539 pack
$cscroll -side right
-fill y
1540 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1541 lappend bglist
$canv $canv2 $canv3
1542 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1544 # we have two button bars at bottom of top frame. Bar 1
1546 frame .tf.lbar
-height 15
1548 set sha1entry .tf.bar.sha1
1549 set entries
$sha1entry
1550 set sha1but .tf.bar.sha1label
1551 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1552 -command gotocommit
-width 8
1553 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1554 pack .tf.bar.sha1label
-side left
1555 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1556 trace add variable sha1string
write sha1change
1557 pack
$sha1entry -side left
-pady 2
1559 image create bitmap bm-left
-data {
1560 #define left_width 16
1561 #define left_height 16
1562 static unsigned char left_bits
[] = {
1563 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1564 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1565 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1567 image create bitmap bm-right
-data {
1568 #define right_width 16
1569 #define right_height 16
1570 static unsigned char right_bits
[] = {
1571 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1572 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1573 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1575 button .tf.bar.leftbut
-image bm-left
-command goback \
1576 -state disabled
-width 26
1577 pack .tf.bar.leftbut
-side left
-fill y
1578 button .tf.bar.rightbut
-image bm-right
-command goforw \
1579 -state disabled
-width 26
1580 pack .tf.bar.rightbut
-side left
-fill y
1582 # Status label and progress bar
1583 set statusw .tf.bar.status
1584 label
$statusw -width 15 -relief sunken
1585 pack
$statusw -side left
-padx 5
1586 set h
[expr {[font metrics uifont
-linespace] + 2}]
1587 set progresscanv .tf.bar.progress
1588 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1589 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1590 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1591 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1592 pack
$progresscanv -side right
-expand 1 -fill x
1593 set progresscoords
{0 0}
1596 bind $progresscanv <Configure
> adjustprogress
1597 set lastprogupdate
[clock clicks
-milliseconds]
1598 set progupdatepending
0
1600 # build up the bottom bar of upper window
1601 label .tf.lbar.flabel
-text "[mc "Find
"] "
1602 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1603 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1604 label .tf.lbar.flab2
-text " [mc "commit
"] "
1605 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1607 set gdttype
[mc
"containing:"]
1608 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
1609 [mc
"containing:"] \
1610 [mc
"touching paths:"] \
1611 [mc
"adding/removing string:"]]
1612 trace add variable gdttype
write gdttype_change
1613 pack .tf.lbar.gdttype
-side left
-fill y
1616 set fstring .tf.lbar.findstring
1617 lappend entries
$fstring
1618 entry
$fstring -width 30 -font textfont
-textvariable findstring
1619 trace add variable findstring
write find_change
1620 set findtype
[mc
"Exact"]
1621 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
1622 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
1623 trace add variable findtype
write findcom_change
1624 set findloc
[mc
"All fields"]
1625 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
1626 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
1627 trace add variable findloc
write find_change
1628 pack .tf.lbar.findloc
-side right
1629 pack .tf.lbar.findtype
-side right
1630 pack
$fstring -side left
-expand 1 -fill x
1632 # Finish putting the upper half of the viewer together
1633 pack .tf.lbar
-in .tf
-side bottom
-fill x
1634 pack .tf.bar
-in .tf
-side bottom
-fill x
1635 pack .tf.histframe
-fill both
-side top
-expand 1
1637 .ctop paneconfigure .tf
-height $geometry(topheight
)
1638 .ctop paneconfigure .tf
-width $geometry(topwidth
)
1640 # now build up the bottom
1641 panedwindow .pwbottom
-orient horizontal
1643 # lower left, a text box over search bar, scroll bar to the right
1644 # if we know window height, then that will set the lower text height, otherwise
1645 # we set lower text height which will drive window height
1646 if {[info exists geometry
(main
)]} {
1647 frame .bleft
-width $geometry(botwidth
)
1649 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
1654 button .bleft.top.search
-text [mc
"Search"] -command dosearch
1655 pack .bleft.top.search
-side left
-padx 5
1656 set sstring .bleft.top.sstring
1657 entry
$sstring -width 20 -font textfont
-textvariable searchstring
1658 lappend entries
$sstring
1659 trace add variable searchstring
write incrsearch
1660 pack
$sstring -side left
-expand 1 -fill x
1661 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
1662 -command changediffdisp
-variable diffelide
-value {0 0}
1663 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
1664 -command changediffdisp
-variable diffelide
-value {0 1}
1665 radiobutton .bleft.mid.new
-text [mc
"New version"] \
1666 -command changediffdisp
-variable diffelide
-value {1 0}
1667 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
1668 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
1669 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
1670 -from 1 -increment 1 -to 10000000 \
1671 -validate all
-validatecommand "diffcontextvalidate %P" \
1672 -textvariable diffcontextstring
1673 .bleft.mid.diffcontext
set $diffcontext
1674 trace add variable diffcontextstring
write diffcontextchange
1675 lappend entries .bleft.mid.diffcontext
1676 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
1677 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
1678 -command changeignorespace
-variable ignorespace
1679 pack .bleft.mid.ignspace
-side left
-padx 5
1680 set ctext .bleft.ctext
1681 text
$ctext -background $bgcolor -foreground $fgcolor \
1682 -state disabled
-font textfont \
1683 -yscrollcommand scrolltext
-wrap none
1685 $ctext conf
-tabstyle wordprocessor
1687 scrollbar .bleft.sb
-command "$ctext yview"
1688 pack .bleft.top
-side top
-fill x
1689 pack .bleft.mid
-side top
-fill x
1690 pack .bleft.sb
-side right
-fill y
1691 pack
$ctext -side left
-fill both
-expand 1
1692 lappend bglist
$ctext
1693 lappend fglist
$ctext
1695 $ctext tag conf comment
-wrap $wrapcomment
1696 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
1697 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
1698 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
1699 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
1700 $ctext tag conf m0
-fore red
1701 $ctext tag conf m1
-fore blue
1702 $ctext tag conf m2
-fore green
1703 $ctext tag conf m3
-fore purple
1704 $ctext tag conf
m4 -fore brown
1705 $ctext tag conf m5
-fore "#009090"
1706 $ctext tag conf m6
-fore magenta
1707 $ctext tag conf m7
-fore "#808000"
1708 $ctext tag conf m8
-fore "#009000"
1709 $ctext tag conf m9
-fore "#ff0080"
1710 $ctext tag conf m10
-fore cyan
1711 $ctext tag conf m11
-fore "#b07070"
1712 $ctext tag conf m12
-fore "#70b0f0"
1713 $ctext tag conf m13
-fore "#70f0b0"
1714 $ctext tag conf m14
-fore "#f0b070"
1715 $ctext tag conf m15
-fore "#ff70b0"
1716 $ctext tag conf mmax
-fore darkgrey
1718 $ctext tag conf mresult
-font textfontbold
1719 $ctext tag conf msep
-font textfontbold
1720 $ctext tag conf found
-back yellow
1722 .pwbottom add .bleft
1723 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
1728 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
1729 -command reselectline
-variable cmitmode
-value "patch"
1730 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
1731 -command reselectline
-variable cmitmode
-value "tree"
1732 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
1733 pack .bright.mode
-side top
-fill x
1734 set cflist .bright.cfiles
1735 set indent
[font measure mainfont
"nn"]
1737 -selectbackground $selectbgcolor \
1738 -background $bgcolor -foreground $fgcolor \
1740 -tabs [list
$indent [expr {2 * $indent}]] \
1741 -yscrollcommand ".bright.sb set" \
1742 -cursor [. cget
-cursor] \
1743 -spacing1 1 -spacing3 1
1744 lappend bglist
$cflist
1745 lappend fglist
$cflist
1746 scrollbar .bright.sb
-command "$cflist yview"
1747 pack .bright.sb
-side right
-fill y
1748 pack
$cflist -side left
-fill both
-expand 1
1749 $cflist tag configure highlight \
1750 -background [$cflist cget
-selectbackground]
1751 $cflist tag configure bold
-font mainfontbold
1753 .pwbottom add .bright
1756 # restore window position if known
1757 if {[info exists geometry
(main
)]} {
1758 wm geometry .
"$geometry(main)"
1761 if {[tk windowingsystem
] eq
{aqua
}} {
1767 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
1768 pack .ctop
-fill both
-expand 1
1769 bindall
<1> {selcanvline
%W
%x
%y
}
1770 #bindall <B1-Motion> {selcanvline %W %x %y}
1771 if {[tk windowingsystem
] == "win32"} {
1772 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
1773 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
1775 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
1776 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
1777 if {[tk windowingsystem
] eq
"aqua"} {
1778 bindall
<MouseWheel
> {
1779 set delta
[expr {- (%D
)}]
1780 allcanvs yview scroll
$delta units
1784 bindall
<2> "canvscan mark %W %x %y"
1785 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
1786 bindkey
<Home
> selfirstline
1787 bindkey
<End
> sellastline
1788 bind .
<Key-Up
> "selnextline -1"
1789 bind .
<Key-Down
> "selnextline 1"
1790 bind .
<Shift-Key-Up
> "dofind -1 0"
1791 bind .
<Shift-Key-Down
> "dofind 1 0"
1792 bindkey
<Key-Right
> "goforw"
1793 bindkey
<Key-Left
> "goback"
1794 bind .
<Key-Prior
> "selnextpage -1"
1795 bind .
<Key-Next
> "selnextpage 1"
1796 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
1797 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
1798 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
1799 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
1800 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1801 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1802 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
1803 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
1804 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
1805 bindkey p
"selnextline -1"
1806 bindkey n
"selnextline 1"
1809 bindkey i
"selnextline -1"
1810 bindkey k
"selnextline 1"
1813 bindkey b
"$ctext yview scroll -1 pages"
1814 bindkey d
"$ctext yview scroll 18 units"
1815 bindkey u
"$ctext yview scroll -18 units"
1816 bindkey
/ {dofind
1 1}
1817 bindkey
<Key-Return
> {dofind
1 1}
1818 bindkey ?
{dofind
-1 1}
1820 bindkey
<F5
> updatecommits
1821 bind .
<$M1B-q> doquit
1822 bind .
<$M1B-f> {dofind
1 1}
1823 bind .
<$M1B-g> {dofind
1 0}
1824 bind .
<$M1B-r> dosearchback
1825 bind .
<$M1B-s> dosearch
1826 bind .
<$M1B-equal> {incrfont
1}
1827 bind .
<$M1B-plus> {incrfont
1}
1828 bind .
<$M1B-KP_Add> {incrfont
1}
1829 bind .
<$M1B-minus> {incrfont
-1}
1830 bind .
<$M1B-KP_Subtract> {incrfont
-1}
1831 wm protocol . WM_DELETE_WINDOW doquit
1832 bind .
<Button-1
> "click %W"
1833 bind $fstring <Key-Return
> {dofind
1 1}
1834 bind $sha1entry <Key-Return
> gotocommit
1835 bind $sha1entry <<PasteSelection>> clearsha1
1836 bind $cflist <1> {sel_flist %W %x %y; break}
1837 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1838 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1839 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1841 set maincursor [. cget -cursor]
1842 set textcursor [$ctext cget -cursor]
1843 set curtextcursor $textcursor
1845 set rowctxmenu .rowctxmenu
1846 menu $rowctxmenu -tearoff 0
1847 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1848 -command {diffvssel 0}
1849 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1850 -command {diffvssel 1}
1851 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1852 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1853 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1854 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1855 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1857 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1860 set fakerowmenu .fakerowmenu
1861 menu $fakerowmenu -tearoff 0
1862 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1863 -command {diffvssel 0}
1864 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1865 -command {diffvssel 1}
1866 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1867 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1868 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1869 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1871 set headctxmenu .headctxmenu
1872 menu $headctxmenu -tearoff 0
1873 $headctxmenu add command -label [mc "Check out this branch"] \
1875 $headctxmenu add command -label [mc "Remove this branch"] \
1879 set flist_menu .flistctxmenu
1880 menu $flist_menu -tearoff 0
1881 $flist_menu add command -label [mc "Highlight this too"] \
1882 -command {flist_hl 0}
1883 $flist_menu add command -label [mc "Highlight this only"] \
1884 -command {flist_hl 1}
1887 # Windows sends all mouse wheel events to the current focused window, not
1888 # the one where the mouse hovers, so bind those events here and redirect
1889 # to the correct window
1890 proc windows_mousewheel_redirector {W X Y D} {
1891 global canv canv2 canv3
1892 set w [winfo containing -displayof $W $X $Y]
1894 set u [expr {$D < 0 ? 5 : -5}]
1895 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1896 allcanvs yview scroll $u units
1899 $w yview scroll $u units
1905 # mouse-2 makes all windows scan vertically, but only the one
1906 # the cursor is in scans horizontally
1907 proc canvscan {op w x y} {
1908 global canv canv2 canv3
1909 foreach c [list $canv $canv2 $canv3] {
1918 proc scrollcanv {cscroll f0 f1} {
1919 $cscroll set $f0 $f1
1924 # when we make a key binding for the toplevel, make sure
1925 # it doesn't get triggered when that key is pressed in the
1926 # find string entry widget.
1927 proc bindkey {ev script} {
1930 set escript [bind Entry $ev]
1931 if {$escript == {}} {
1932 set escript [bind Entry <Key>]
1934 foreach e $entries {
1935 bind $e $ev "$escript; break"
1939 # set the focus back to the toplevel for any click outside
1942 global ctext entries
1943 foreach e [concat $entries $ctext] {
1944 if {$w == $e} return
1949 # Adjust the progress bar for a change in requested extent or canvas size
1950 proc adjustprogress {} {
1951 global progresscanv progressitem progresscoords
1952 global fprogitem fprogcoord lastprogupdate progupdatepending
1953 global rprogitem rprogcoord
1955 set w [expr {[winfo width $progresscanv] - 4}]
1956 set x0 [expr {$w * [lindex $progresscoords 0]}]
1957 set x1 [expr {$w * [lindex $progresscoords 1]}]
1958 set h [winfo height $progresscanv]
1959 $progresscanv coords $progressitem $x0 0 $x1 $h
1960 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1961 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1962 set now [clock clicks -milliseconds]
1963 if {$now >= $lastprogupdate + 100} {
1964 set progupdatepending 0
1966 } elseif {!$progupdatepending} {
1967 set progupdatepending 1
1968 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1972 proc doprogupdate {} {
1973 global lastprogupdate progupdatepending
1975 if {$progupdatepending} {
1976 set progupdatepending 0
1977 set lastprogupdate [clock clicks -milliseconds]
1982 proc savestuff {w} {
1983 global canv canv2 canv3 mainfont textfont uifont tabstop
1984 global stuffsaved findmergefiles maxgraphpct
1985 global maxwidth showneartags showlocalchanges
1986 global viewname viewfiles viewargs viewperm nextviewnum
1987 global cmitmode wrapcomment datetimeformat limitdiffs
1988 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1990 if {$stuffsaved} return
1991 if {![winfo viewable .]} return
1993 set f [open "~/.gitk-new" w]
1994 puts $f [list set mainfont $mainfont]
1995 puts $f [list set textfont $textfont]
1996 puts $f [list set uifont $uifont]
1997 puts $f [list set tabstop $tabstop]
1998 puts $f [list set findmergefiles $findmergefiles]
1999 puts $f [list set maxgraphpct $maxgraphpct]
2000 puts $f [list set maxwidth $maxwidth]
2001 puts $f [list set cmitmode $cmitmode]
2002 puts $f [list set wrapcomment $wrapcomment]
2003 puts $f [list set showneartags $showneartags]
2004 puts $f [list set showlocalchanges $showlocalchanges]
2005 puts $f [list set datetimeformat $datetimeformat]
2006 puts $f [list set limitdiffs $limitdiffs]
2007 puts $f [list set bgcolor $bgcolor]
2008 puts $f [list set fgcolor $fgcolor]
2009 puts $f [list set colors $colors]
2010 puts $f [list set diffcolors $diffcolors]
2011 puts $f [list set diffcontext $diffcontext]
2012 puts $f [list set selectbgcolor $selectbgcolor]
2014 puts $f "set geometry(main) [wm geometry .]"
2015 puts $f "set geometry(topwidth) [winfo width .tf]"
2016 puts $f "set geometry(topheight) [winfo height .tf]"
2017 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2018 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2019 puts $f "set geometry(botwidth) [winfo width .bleft]"
2020 puts $f "set geometry(botheight) [winfo height .bleft]"
2022 puts -nonewline $f "set permviews {"
2023 for {set v 0} {$v < $nextviewnum} {incr v} {
2024 if {$viewperm($v)} {
2025 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
2030 file rename -force "~/.gitk-new" "~/.gitk"
2035 proc resizeclistpanes {win w} {
2037 if {[info exists oldwidth($win)]} {
2038 set s0 [$win sash coord 0]
2039 set s1 [$win sash coord 1]
2041 set sash0 [expr {int($w/2 - 2)}]
2042 set sash1 [expr {int($w*5/6 - 2)}]
2044 set factor [expr {1.0 * $w / $oldwidth($win)}]
2045 set sash0 [expr {int($factor * [lindex $s0 0])}]
2046 set sash1 [expr {int($factor * [lindex $s1 0])}]
2050 if {$sash1 < $sash0 + 20} {
2051 set sash1 [expr {$sash0 + 20}]
2053 if {$sash1 > $w - 10} {
2054 set sash1 [expr {$w - 10}]
2055 if {$sash0 > $sash1 - 20} {
2056 set sash0 [expr {$sash1 - 20}]
2060 $win sash place 0 $sash0 [lindex $s0 1]
2061 $win sash place 1 $sash1 [lindex $s1 1]
2063 set oldwidth($win) $w
2066 proc resizecdetpanes {win w} {
2068 if {[info exists oldwidth($win)]} {
2069 set s0 [$win sash coord 0]
2071 set sash0 [expr {int($w*3/4 - 2)}]
2073 set factor [expr {1.0 * $w / $oldwidth($win)}]
2074 set sash0 [expr {int($factor * [lindex $s0 0])}]
2078 if {$sash0 > $w - 15} {
2079 set sash0 [expr {$w - 15}]
2082 $win sash place 0 $sash0 [lindex $s0 1]
2084 set oldwidth($win) $w
2087 proc allcanvs args {
2088 global canv canv2 canv3
2094 proc bindall {event action} {
2095 global canv canv2 canv3
2096 bind $canv $event $action
2097 bind $canv2 $event $action
2098 bind $canv3 $event $action
2104 if {[winfo exists $w]} {
2109 wm title $w [mc "About gitk"]
2110 message $w.m -text [mc "
2111 Gitk - a commit viewer for git
2113 Copyright © 2005-2006 Paul Mackerras
2115 Use and redistribute under the terms of the GNU General Public License"] \
2116 -justify center -aspect 400 -border 2 -bg white -relief groove
2117 pack $w.m -side top -fill x -padx 2 -pady 2
2118 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2119 pack $w.ok -side bottom
2120 bind $w <Visibility> "focus $w.ok"
2121 bind $w <Key-Escape> "destroy $w"
2122 bind $w <Key-Return> "destroy $w"
2127 if {[winfo exists $w]} {
2131 if {[tk windowingsystem] eq {aqua}} {
2137 wm title $w [mc "Gitk key bindings"]
2138 message $w.m -text "
2139 [mc "Gitk key bindings:"]
2141 [mc "<%s-Q> Quit" $M1T]
2142 [mc "<Home> Move to first commit"]
2143 [mc "<End> Move to last commit"]
2144 [mc "<Up>, p, i Move up one commit"]
2145 [mc "<Down>, n, k Move down one commit"]
2146 [mc "<Left>, z, j Go back in history list"]
2147 [mc "<Right>, x, l Go forward in history list"]
2148 [mc "<PageUp> Move up one page in commit list"]
2149 [mc "<PageDown> Move down one page in commit list"]
2150 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2151 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2152 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2153 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2154 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2155 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2156 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2157 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2158 [mc "<Delete>, b Scroll diff view up one page"]
2159 [mc "<Backspace> Scroll diff view up one page"]
2160 [mc "<Space> Scroll diff view down one page"]
2161 [mc "u Scroll diff view up 18 lines"]
2162 [mc "d Scroll diff view down 18 lines"]
2163 [mc "<%s-F> Find" $M1T]
2164 [mc "<%s-G> Move to next find hit" $M1T]
2165 [mc "<Return> Move to next find hit"]
2166 [mc "/ Move to next find hit, or redo find"]
2167 [mc "? Move to previous find hit"]
2168 [mc "f Scroll diff view to next file"]
2169 [mc "<%s-S> Search for next hit in diff view" $M1T]
2170 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2171 [mc "<%s-KP+> Increase font size" $M1T]
2172 [mc "<%s-plus> Increase font size" $M1T]
2173 [mc "<%s-KP-> Decrease font size" $M1T]
2174 [mc "<%s-minus> Decrease font size" $M1T]
2177 -justify left -bg white -border 2 -relief groove
2178 pack $w.m -side top -fill both -padx 2 -pady 2
2179 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2180 pack $w.ok -side bottom
2181 bind $w <Visibility> "focus $w.ok"
2182 bind $w <Key-Escape> "destroy $w"
2183 bind $w <Key-Return> "destroy $w"
2186 # Procedures for manipulating the file list window at the
2187 # bottom right of the overall window.
2189 proc treeview {w l openlevs} {
2190 global treecontents treediropen treeheight treeparent treeindex
2200 set treecontents() {}
2201 $w conf -state normal
2203 while {[string range $f 0 $prefixend] ne $prefix} {
2204 if {$lev <= $openlevs} {
2205 $w mark set e:$treeindex($prefix) "end -1c"
2206 $w mark gravity e:$treeindex($prefix) left
2208 set treeheight($prefix) $ht
2209 incr ht [lindex $htstack end]
2210 set htstack [lreplace $htstack end end]
2211 set prefixend [lindex $prefendstack end]
2212 set prefendstack [lreplace $prefendstack end end]
2213 set prefix [string range $prefix 0 $prefixend]
2216 set tail [string range $f [expr {$prefixend+1}] end]
2217 while {[set slash [string first "/" $tail]] >= 0} {
2220 lappend prefendstack $prefixend
2221 incr prefixend [expr {$slash + 1}]
2222 set d [string range $tail 0 $slash]
2223 lappend treecontents($prefix) $d
2224 set oldprefix $prefix
2226 set treecontents($prefix) {}
2227 set treeindex($prefix) [incr ix]
2228 set treeparent($prefix) $oldprefix
2229 set tail [string range $tail [expr {$slash+1}] end]
2230 if {$lev <= $openlevs} {
2232 set treediropen($prefix) [expr {$lev < $openlevs}]
2233 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2234 $w mark set d:$ix "end -1c"
2235 $w mark gravity d:$ix left
2237 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2239 $w image create end -align center -image $bm -padx 1 \
2241 $w insert end $d [highlight_tag $prefix]
2242 $w mark set s:$ix "end -1c"
2243 $w mark gravity s:$ix left
2248 if {$lev <= $openlevs} {
2251 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2253 $w insert end $tail [highlight_tag $f]
2255 lappend treecontents($prefix) $tail
2258 while {$htstack ne {}} {
2259 set treeheight($prefix) $ht
2260 incr ht [lindex $htstack end]
2261 set htstack [lreplace $htstack end end]
2262 set prefixend [lindex $prefendstack end]
2263 set prefendstack [lreplace $prefendstack end end]
2264 set prefix [string range $prefix 0 $prefixend]
2266 $w conf -state disabled
2269 proc linetoelt {l} {
2270 global treeheight treecontents
2275 foreach e $treecontents($prefix) {
2280 if {[string index $e end] eq "/"} {
2281 set n $treeheight($prefix$e)
2293 proc highlight_tree {y prefix} {
2294 global treeheight treecontents cflist
2296 foreach e $treecontents($prefix) {
2298 if {[highlight_tag $path] ne {}} {
2299 $cflist tag add bold $y.0 "$y.0 lineend"
2302 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2303 set y [highlight_tree $y $path]
2309 proc treeclosedir {w dir} {
2310 global treediropen treeheight treeparent treeindex
2312 set ix $treeindex($dir)
2313 $w conf -state normal
2314 $w delete s:$ix e:$ix
2315 set treediropen($dir) 0
2316 $w image configure a:$ix -image tri-rt
2317 $w conf -state disabled
2318 set n [expr {1 - $treeheight($dir)}]
2319 while {$dir ne {}} {
2320 incr treeheight($dir) $n
2321 set dir $treeparent($dir)
2325 proc treeopendir {w dir} {
2326 global treediropen treeheight treeparent treecontents treeindex
2328 set ix $treeindex($dir)
2329 $w conf -state normal
2330 $w image configure a:$ix -image tri-dn
2331 $w mark set e:$ix s:$ix
2332 $w mark gravity e:$ix right
2335 set n [llength $treecontents($dir)]
2336 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2339 incr treeheight($x) $n
2341 foreach e $treecontents($dir) {
2343 if {[string index $e end] eq "/"} {
2344 set iy $treeindex($de)
2345 $w mark set d:$iy e:$ix
2346 $w mark gravity d:$iy left
2347 $w insert e:$ix $str
2348 set treediropen($de) 0
2349 $w image create e:$ix -align center -image tri-rt -padx 1 \
2351 $w insert e:$ix $e [highlight_tag $de]
2352 $w mark set s:$iy e:$ix
2353 $w mark gravity s:$iy left
2354 set treeheight($de) 1
2356 $w insert e:$ix $str
2357 $w insert e:$ix $e [highlight_tag $de]
2360 $w mark gravity e:$ix left
2361 $w conf -state disabled
2362 set treediropen($dir) 1
2363 set top [lindex [split [$w index @0,0] .] 0]
2364 set ht [$w cget -height]
2365 set l [lindex [split [$w index s:$ix] .] 0]
2368 } elseif {$l + $n + 1 > $top + $ht} {
2369 set top [expr {$l + $n + 2 - $ht}]
2377 proc treeclick {w x y} {
2378 global treediropen cmitmode ctext cflist cflist_top
2380 if {$cmitmode ne "tree"} return
2381 if {![info exists cflist_top]} return
2382 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2383 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2384 $cflist tag add highlight $l.0 "$l.0 lineend"
2390 set e [linetoelt $l]
2391 if {[string index $e end] ne "/"} {
2393 } elseif {$treediropen($e)} {
2400 proc setfilelist {id} {
2401 global treefilelist cflist
2403 treeview $cflist $treefilelist($id) 0
2406 image create bitmap tri-rt -background black -foreground blue -data {
2407 #define tri-rt_width 13
2408 #define tri-rt_height 13
2409 static unsigned char tri-rt_bits[] = {
2410 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2411 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2414 #define tri-rt-mask_width 13
2415 #define tri-rt-mask_height 13
2416 static unsigned char tri-rt-mask_bits[] = {
2417 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2418 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2421 image create bitmap tri-dn -background black -foreground blue -data {
2422 #define tri-dn_width 13
2423 #define tri-dn_height 13
2424 static unsigned char tri-dn_bits[] = {
2425 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2426 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2429 #define tri-dn-mask_width 13
2430 #define tri-dn-mask_height 13
2431 static unsigned char tri-dn-mask_bits[] = {
2432 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2433 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2437 image create bitmap reficon-T -background black -foreground yellow -data {
2438 #define tagicon_width 13
2439 #define tagicon_height 9
2440 static unsigned char tagicon_bits[] = {
2441 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2442 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2444 #define tagicon-mask_width 13
2445 #define tagicon-mask_height 9
2446 static unsigned char tagicon-mask_bits[] = {
2447 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2448 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2451 #define headicon_width 13
2452 #define headicon_height 9
2453 static unsigned char headicon_bits[] = {
2454 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2455 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2458 #define headicon-mask_width 13
2459 #define headicon-mask_height 9
2460 static unsigned char headicon-mask_bits[] = {
2461 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2462 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2464 image create bitmap reficon-H -background black -foreground green \
2465 -data $rectdata -maskdata $rectmask
2466 image create bitmap reficon-o -background black -foreground "#ddddff" \
2467 -data $rectdata -maskdata $rectmask
2469 proc init_flist {first} {
2470 global cflist cflist_top difffilestart
2472 $cflist conf -state normal
2473 $cflist delete 0.0 end
2475 $cflist insert end $first
2477 $cflist tag add highlight 1.0 "1.0 lineend"
2479 catch {unset cflist_top}
2481 $cflist conf -state disabled
2482 set difffilestart {}
2485 proc highlight_tag {f} {
2486 global highlight_paths
2488 foreach p $highlight_paths {
2489 if {[string match $p $f]} {
2496 proc highlight_filelist {} {
2497 global cmitmode cflist
2499 $cflist conf -state normal
2500 if {$cmitmode ne "tree"} {
2501 set end [lindex [split [$cflist index end] .] 0]
2502 for {set l 2} {$l < $end} {incr l} {
2503 set line [$cflist get $l.0 "$l.0 lineend"]
2504 if {[highlight_tag $line] ne {}} {
2505 $cflist tag add bold $l.0 "$l.0 lineend"
2511 $cflist conf -state disabled
2514 proc unhighlight_filelist {} {
2517 $cflist conf -state normal
2518 $cflist tag remove bold 1.0 end
2519 $cflist conf -state disabled
2522 proc add_flist {fl} {
2525 $cflist conf -state normal
2527 $cflist insert end "\n"
2528 $cflist insert end $f [highlight_tag $f]
2530 $cflist conf -state disabled
2533 proc sel_flist {w x y} {
2534 global ctext difffilestart cflist cflist_top cmitmode
2536 if {$cmitmode eq "tree"} return
2537 if {![info exists cflist_top]} return
2538 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2539 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2540 $cflist tag add highlight $l.0 "$l.0 lineend"
2545 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2549 proc pop_flist_menu {w X Y x y} {
2550 global ctext cflist cmitmode flist_menu flist_menu_file
2551 global treediffs diffids
2554 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2556 if {$cmitmode eq "tree"} {
2557 set e [linetoelt $l]
2558 if {[string index $e end] eq "/"} return
2560 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2562 set flist_menu_file $e
2563 tk_popup $flist_menu $X $Y
2566 proc flist_hl {only} {
2567 global flist_menu_file findstring gdttype
2569 set x [shellquote $flist_menu_file]
2570 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2573 append findstring " " $x
2575 set gdttype [mc "touching paths:"]
2578 # Functions for adding and removing shell-type quoting
2580 proc shellquote {str} {
2581 if {![string match "*\['\"\\ \t]*" $str]} {
2584 if {![string match "*\['\"\\]*" $str]} {
2587 if {![string match "*'*" $str]} {
2590 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2593 proc shellarglist {l} {
2599 append str [shellquote $a]
2604 proc shelldequote {str} {
2609 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2610 append ret [string range $str $used end]
2611 set used [string length $str]
2614 set first [lindex $first 0]
2615 set ch [string index $str $first]
2616 if {$first > $used} {
2617 append ret [string range $str $used [expr {$first - 1}]]
2620 if {$ch eq " " || $ch eq "\t"} break
2623 set first [string first "'" $str $used]
2625 error "unmatched single-quote"
2627 append ret [string range $str $used [expr {$first - 1}]]
2632 if {$used >= [string length $str]} {
2633 error "trailing backslash"
2635 append ret [string index $str $used]
2640 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2641 error "unmatched double-quote"
2643 set first [lindex $first 0]
2644 set ch [string index $str $first]
2645 if {$first > $used} {
2646 append ret [string range $str $used [expr {$first - 1}]]
2649 if {$ch eq "\""} break
2651 append ret [string index $str $used]
2655 return [list $used $ret]
2658 proc shellsplit {str} {
2661 set str [string trimleft $str]
2662 if {$str eq {}} break
2663 set dq [shelldequote $str]
2664 set n [lindex $dq 0]
2665 set word [lindex $dq 1]
2666 set str [string range $str $n end]
2672 # Code to implement multiple views
2674 proc newview {ishighlight} {
2675 global nextviewnum newviewname newviewperm newishighlight
2676 global newviewargs revtreeargs
2678 set newishighlight $ishighlight
2680 if {[winfo exists $top]} {
2684 set newviewname($nextviewnum) "View $nextviewnum"
2685 set newviewperm($nextviewnum) 0
2686 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2687 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2692 global viewname viewperm newviewname newviewperm
2693 global viewargs newviewargs
2695 set top .gitkvedit-$curview
2696 if {[winfo exists $top]} {
2700 set newviewname($curview) $viewname($curview)
2701 set newviewperm($curview) $viewperm($curview)
2702 set newviewargs($curview) [shellarglist $viewargs($curview)]
2703 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2706 proc vieweditor {top n title} {
2707 global newviewname newviewperm viewfiles bgcolor
2710 wm title $top $title
2711 label $top.nl -text [mc "Name"]
2712 entry $top.name -width 20 -textvariable newviewname($n)
2713 grid $top.nl $top.name -sticky w -pady 5
2714 checkbutton $top.perm -text [mc "Remember this view"] \
2715 -variable newviewperm($n)
2716 grid $top.perm - -pady 5 -sticky w
2717 message $top.al -aspect 1000 \
2718 -text [mc "Commits to include (arguments to git log):"]
2719 grid $top.al - -sticky w -pady 5
2720 entry $top.args -width 50 -textvariable newviewargs($n) \
2721 -background $bgcolor
2722 grid $top.args - -sticky ew -padx 5
2723 message $top.l -aspect 1000 \
2724 -text [mc "Enter files and directories to include, one per line:"]
2725 grid $top.l - -sticky w
2726 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2727 if {[info exists viewfiles($n)]} {
2728 foreach f $viewfiles($n) {
2729 $top.t insert end $f
2730 $top.t insert end "\n"
2732 $top.t delete {end - 1c} end
2733 $top.t mark set insert 0.0
2735 grid $top.t - -sticky ew -padx 5
2737 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2738 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2739 grid $top.buts.ok $top.buts.can
2740 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2741 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2742 grid $top.buts - -pady 10 -sticky ew
2746 proc doviewmenu {m first cmd op argv} {
2747 set nmenu [$m index end]
2748 for {set i $first} {$i <= $nmenu} {incr i} {
2749 if {[$m entrycget $i -command] eq $cmd} {
2750 eval $m $op $i $argv
2756 proc allviewmenus {n op args} {
2759 doviewmenu .bar.view 5 [list showview $n] $op $args
2760 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2763 proc newviewok {top n} {
2764 global nextviewnum newviewperm newviewname newishighlight
2765 global viewname viewfiles viewperm selectedview curview
2766 global viewargs newviewargs viewhlmenu
2769 set newargs [shellsplit $newviewargs($n)]
2771 error_popup "[mc "Error in commit selection arguments:"] $err"
2777 foreach f [split [$top.t get 0.0 end] "\n"] {
2778 set ft [string trim $f]
2783 if {![info exists viewfiles($n)]} {
2784 # creating a new view
2786 set viewname($n) $newviewname($n)
2787 set viewperm($n) $newviewperm($n)
2788 set viewfiles($n) $files
2789 set viewargs($n) $newargs
2791 if {!$newishighlight} {
2794 run addvhighlight $n
2797 # editing an existing view
2798 set viewperm($n) $newviewperm($n)
2799 if {$newviewname($n) ne $viewname($n)} {
2800 set viewname($n) $newviewname($n)
2801 doviewmenu .bar.view 5 [list showview $n] \
2802 entryconf [list -label $viewname($n)]
2803 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2804 # entryconf [list -label $viewname($n) -value $viewname($n)]
2806 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2807 set viewfiles($n) $files
2808 set viewargs($n) $newargs
2809 if {$curview == $n} {
2814 catch {destroy $top}
2818 global curview viewperm hlview selectedhlview
2820 if {$curview == 0} return
2821 if {[info exists hlview] && $hlview == $curview} {
2822 set selectedhlview [mc "None"]
2825 allviewmenus $curview delete
2826 set viewperm($curview) 0
2830 proc addviewmenu {n} {
2831 global viewname viewhlmenu
2833 .bar.view add radiobutton -label $viewname($n) \
2834 -command [list showview $n] -variable selectedview -value $n
2835 #$viewhlmenu add radiobutton -label $viewname($n) \
2836 # -command [list addvhighlight $n] -variable selectedhlview
2840 global curview viewfiles cached_commitrow ordertok
2841 global displayorder parentlist rowidlist rowisopt rowfinal
2842 global colormap rowtextx nextcolor canvxmax
2843 global numcommits viewcomplete
2844 global selectedline currentid canv canvy0
2846 global pending_select mainheadid
2849 global hlview selectedhlview commitinterest
2851 if {$n == $curview} return
2853 set ymax [lindex [$canv cget -scrollregion] 3]
2854 set span [$canv yview]
2855 set ytop [expr {[lindex $span 0] * $ymax}]
2856 set ybot [expr {[lindex $span 1] * $ymax}]
2857 set yscreen [expr {($ybot - $ytop) / 2}]
2858 if {[info exists selectedline]} {
2859 set selid $currentid
2860 set y [yc $selectedline]
2861 if {$ytop < $y && $y < $ybot} {
2862 set yscreen [expr {$y - $ytop}]
2864 } elseif {[info exists pending_select]} {
2865 set selid $pending_select
2866 unset pending_select
2870 catch {unset treediffs}
2872 if {[info exists hlview] && $hlview == $n} {
2874 set selectedhlview [mc "None"]
2876 catch {unset commitinterest}
2877 catch {unset cached_commitrow}
2878 catch {unset ordertok}
2882 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2883 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2886 if {![info exists viewcomplete($n)]} {
2888 set pending_select $selid
2899 set numcommits $commitidx($n)
2901 catch {unset colormap}
2902 catch {unset rowtextx}
2904 set canvxmax [$canv cget -width]
2910 if {$selid ne {} && [commitinview $selid $n]} {
2911 set row [rowofcommit $selid]
2912 # try to get the selected row in the same position on the screen
2913 set ymax [lindex [$canv cget -scrollregion] 3]
2914 set ytop [expr {[yc $row] - $yscreen}]
2918 set yf [expr {$ytop * 1.0 / $ymax}]
2920 allcanvs yview moveto $yf
2924 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
2925 selectline [rowofcommit $mainheadid] 1
2926 } elseif {!$viewcomplete($n)} {
2928 set pending_select $selid
2930 set pending_select $mainheadid
2933 set row [first_real_row]
2934 if {$row < $numcommits} {
2938 if {!$viewcomplete($n)} {
2939 if {$numcommits == 0} {
2940 show_status [mc "Reading commits..."]
2942 } elseif {$numcommits == 0} {
2943 show_status [mc "No commits selected"]
2947 # Stuff relating to the highlighting facility
2949 proc ishighlighted {id} {
2950 global vhighlights fhighlights nhighlights rhighlights
2952 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
2953 return $nhighlights($id)
2955 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
2956 return $vhighlights($id)
2958 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
2959 return $fhighlights($id)
2961 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
2962 return $rhighlights($id)
2967 proc bolden {row font} {
2968 global canv linehtag selectedline boldrows
2970 lappend boldrows $row
2971 $canv itemconf $linehtag($row) -font $font
2972 if {[info exists selectedline] && $row == $selectedline} {
2974 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2975 -outline {{}} -tags secsel \
2976 -fill [$canv cget -selectbackground]]
2981 proc bolden_name {row font} {
2982 global canv2 linentag selectedline boldnamerows
2984 lappend boldnamerows $row
2985 $canv2 itemconf $linentag($row) -font $font
2986 if {[info exists selectedline] && $row == $selectedline} {
2987 $canv2 delete secsel
2988 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2989 -outline {{}} -tags secsel \
2990 -fill [$canv2 cget -selectbackground]]
2999 foreach row $boldrows {
3000 if {![ishighlighted [commitonrow $row]]} {
3001 bolden $row mainfont
3003 lappend stillbold $row
3006 set boldrows $stillbold
3009 proc addvhighlight {n} {
3010 global hlview viewcomplete curview vhl_done commitidx
3012 if {[info exists hlview]} {
3016 if {$n != $curview && ![info exists viewcomplete($n)]} {
3019 set vhl_done $commitidx($hlview)
3020 if {$vhl_done > 0} {
3025 proc delvhighlight {} {
3026 global hlview vhighlights
3028 if {![info exists hlview]} return
3030 catch {unset vhighlights}
3034 proc vhighlightmore {} {
3035 global hlview vhl_done commitidx vhighlights curview
3037 set max $commitidx($hlview)
3038 set vr [visiblerows]
3039 set r0 [lindex $vr 0]
3040 set r1 [lindex $vr 1]
3041 for {set i $vhl_done} {$i < $max} {incr i} {
3042 set id [commitonrow $i $hlview]
3043 if {[commitinview $id $curview]} {
3044 set row [rowofcommit $id]
3045 if {$r0 <= $row && $row <= $r1} {
3046 if {![highlighted $row]} {
3047 bolden $row mainfontbold
3049 set vhighlights($id) 1
3057 proc askvhighlight {row id} {
3058 global hlview vhighlights iddrawn
3060 if {[commitinview $id $hlview]} {
3061 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3062 bolden $row mainfontbold
3064 set vhighlights($id) 1
3066 set vhighlights($id) 0
3070 proc hfiles_change {} {
3071 global highlight_files filehighlight fhighlights fh_serial
3072 global highlight_paths gdttype
3074 if {[info exists filehighlight]} {
3075 # delete previous highlights
3076 catch {close $filehighlight}
3078 catch {unset fhighlights}
3080 unhighlight_filelist
3082 set highlight_paths {}
3083 after cancel do_file_hl $fh_serial
3085 if {$highlight_files ne {}} {
3086 after 300 do_file_hl $fh_serial
3090 proc gdttype_change {name ix op} {
3091 global gdttype highlight_files findstring findpattern
3094 if {$findstring ne {}} {
3095 if {$gdttype eq [mc "containing:"]} {
3096 if {$highlight_files ne {}} {
3097 set highlight_files {}
3102 if {$findpattern ne {}} {
3106 set highlight_files $findstring
3111 # enable/disable findtype/findloc menus too
3114 proc find_change {name ix op} {
3115 global gdttype findstring highlight_files
3118 if {$gdttype eq [mc "containing:"]} {
3121 if {$highlight_files ne $findstring} {
3122 set highlight_files $findstring
3129 proc findcom_change args {
3130 global nhighlights boldnamerows
3131 global findpattern findtype findstring gdttype
3134 # delete previous highlights, if any
3135 foreach row $boldnamerows {
3136 bolden_name $row mainfont
3139 catch {unset nhighlights}
3142 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3144 } elseif {$findtype eq [mc "Regexp"]} {
3145 set findpattern $findstring
3147 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3149 set findpattern "*$e*"
3153 proc makepatterns {l} {
3156 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3157 if {[string index $ee end] eq "/"} {
3167 proc do_file_hl {serial} {
3168 global highlight_files filehighlight highlight_paths gdttype fhl_list
3170 if {$gdttype eq [mc "touching paths:"]} {
3171 if {[catch {set paths [shellsplit $highlight_files]}]} return
3172 set highlight_paths [makepatterns $paths]
3174 set gdtargs [concat -- $paths]
3175 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3176 set gdtargs [list "-S$highlight_files"]
3178 # must be "containing:", i.e. we're searching commit info
3181 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3182 set filehighlight [open $cmd r+]
3183 fconfigure $filehighlight -blocking 0
3184 filerun $filehighlight readfhighlight
3190 proc flushhighlights {} {
3191 global filehighlight fhl_list
3193 if {[info exists filehighlight]} {
3195 puts $filehighlight ""
3196 flush $filehighlight
3200 proc askfilehighlight {row id} {
3201 global filehighlight fhighlights fhl_list
3203 lappend fhl_list $id
3204 set fhighlights($id) -1
3205 puts $filehighlight $id
3208 proc readfhighlight {} {
3209 global filehighlight fhighlights curview iddrawn
3210 global fhl_list find_dirn
3212 if {![info exists filehighlight]} {
3216 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3217 set line [string trim $line]
3218 set i [lsearch -exact $fhl_list $line]
3219 if {$i < 0} continue
3220 for {set j 0} {$j < $i} {incr j} {
3221 set id [lindex $fhl_list $j]
3222 set fhighlights($id) 0
3224 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3225 if {$line eq {}} continue
3226 if {![commitinview $line $curview]} continue
3227 set row [rowofcommit $line]
3228 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3229 bolden $row mainfontbold
3231 set fhighlights($line) 1
3233 if {[eof $filehighlight]} {
3235 puts "oops, git diff-tree died"
3236 catch {close $filehighlight}
3240 if {[info exists find_dirn]} {
3246 proc doesmatch {f} {
3247 global findtype findpattern
3249 if {$findtype eq [mc "Regexp"]} {
3250 return [regexp $findpattern $f]
3251 } elseif {$findtype eq [mc "IgnCase"]} {
3252 return [string match -nocase $findpattern $f]
3254 return [string match $findpattern $f]
3258 proc askfindhighlight {row id} {
3259 global nhighlights commitinfo iddrawn
3261 global markingmatches
3263 if {![info exists commitinfo($id)]} {
3266 set info $commitinfo($id)
3268 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3269 foreach f $info ty $fldtypes {
3270 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3272 if {$ty eq [mc "Author"]} {
3279 if {$isbold && [info exists iddrawn($id)]} {
3280 if {![ishighlighted $id]} {
3281 bolden $row mainfontbold
3283 bolden_name $row mainfontbold
3286 if {$markingmatches} {
3287 markrowmatches $row $id
3290 set nhighlights($id) $isbold
3293 proc markrowmatches {row id} {
3294 global canv canv2 linehtag linentag commitinfo findloc
3296 set headline [lindex $commitinfo($id) 0]
3297 set author [lindex $commitinfo($id) 1]
3298 $canv delete match$row
3299 $canv2 delete match$row
3300 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3301 set m [findmatches $headline]
3303 markmatches $canv $row $headline $linehtag($row) $m \
3304 [$canv itemcget $linehtag($row) -font] $row
3307 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3308 set m [findmatches $author]
3310 markmatches $canv2 $row $author $linentag($row) $m \
3311 [$canv2 itemcget $linentag($row) -font] $row
3316 proc vrel_change {name ix op} {
3317 global highlight_related
3320 if {$highlight_related ne [mc "None"]} {
3325 # prepare for testing whether commits are descendents or ancestors of a
3326 proc rhighlight_sel {a} {
3327 global descendent desc_todo ancestor anc_todo
3328 global highlight_related
3330 catch {unset descendent}
3331 set desc_todo [list $a]
3332 catch {unset ancestor}
3333 set anc_todo [list $a]
3334 if {$highlight_related ne [mc "None"]} {
3340 proc rhighlight_none {} {
3343 catch {unset rhighlights}
3347 proc is_descendent {a} {
3348 global curview children descendent desc_todo
3351 set la [rowofcommit $a]
3355 for {set i 0} {$i < [llength $todo]} {incr i} {
3356 set do [lindex $todo $i]
3357 if {[rowofcommit $do] < $la} {
3358 lappend leftover $do
3361 foreach nk $children($v,$do) {
3362 if {![info exists descendent($nk)]} {
3363 set descendent($nk) 1
3371 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3375 set descendent($a) 0
3376 set desc_todo $leftover
3379 proc is_ancestor {a} {
3380 global curview parents ancestor anc_todo
3383 set la [rowofcommit $a]
3387 for {set i 0} {$i < [llength $todo]} {incr i} {
3388 set do [lindex $todo $i]
3389 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3390 lappend leftover $do
3393 foreach np $parents($v,$do) {
3394 if {![info exists ancestor($np)]} {
3403 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3408 set anc_todo $leftover
3411 proc askrelhighlight {row id} {
3412 global descendent highlight_related iddrawn rhighlights
3413 global selectedline ancestor
3415 if {![info exists selectedline]} return
3417 if {$highlight_related eq [mc "Descendant"] ||
3418 $highlight_related eq [mc "Not descendant"]} {
3419 if {![info exists descendent($id)]} {
3422 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3425 } elseif {$highlight_related eq [mc "Ancestor"] ||
3426 $highlight_related eq [mc "Not ancestor"]} {
3427 if {![info exists ancestor($id)]} {
3430 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3434 if {[info exists iddrawn($id)]} {
3435 if {$isbold && ![ishighlighted $id]} {
3436 bolden $row mainfontbold
3439 set rhighlights($id) $isbold
3442 # Graph layout functions
3444 proc shortids {ids} {
3447 if {[llength $id] > 1} {
3448 lappend res [shortids $id]
3449 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3450 lappend res [string range $id 0 7]
3461 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3462 if {($n & $mask) != 0} {
3463 set ret [concat $ret $o]
3465 set o [concat $o $o]
3470 proc ordertoken {id} {
3471 global ordertok curview varcid varcstart varctok curview parents children
3472 global nullid nullid2
3474 if {[info exists ordertok($id)]} {
3475 return $ordertok($id)
3480 if {[info exists varcid($curview,$id)]} {
3481 set a $varcid($curview,$id)
3482 set p [lindex $varcstart($curview) $a]
3484 set p [lindex $children($curview,$id) 0]
3486 if {[info exists ordertok($p)]} {
3487 set tok $ordertok($p)
3490 set id [first_real_child $curview,$p]
3493 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3496 if {[llength $parents($curview,$id)] == 1} {
3497 lappend todo [list $p {}]
3499 set j [lsearch -exact $parents($curview,$id) $p]
3501 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3503 lappend todo [list $p [strrep $j]]
3506 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3507 set p [lindex $todo $i 0]
3508 append tok [lindex $todo $i 1]
3509 set ordertok($p) $tok
3511 set ordertok($origid) $tok
3515 # Work out where id should go in idlist so that order-token
3516 # values increase from left to right
3517 proc idcol {idlist id {i 0}} {
3518 set t [ordertoken $id]
3522 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3523 if {$i > [llength $idlist]} {
3524 set i [llength $idlist]
3526 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3529 if {$t > [ordertoken [lindex $idlist $i]]} {
3530 while {[incr i] < [llength $idlist] &&
3531 $t >= [ordertoken [lindex $idlist $i]]} {}
3537 proc initlayout {} {
3538 global rowidlist rowisopt rowfinal displayorder parentlist
3539 global numcommits canvxmax canv
3541 global colormap rowtextx
3550 set canvxmax [$canv cget -width]
3551 catch {unset colormap}
3552 catch {unset rowtextx}
3556 proc setcanvscroll {} {
3557 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3558 global lastscrollset lastscrollrows
3560 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3561 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3562 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3563 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3564 set lastscrollset [clock clicks -milliseconds]
3565 set lastscrollrows $numcommits
3568 proc visiblerows {} {
3569 global canv numcommits linespc
3571 set ymax [lindex [$canv cget -scrollregion] 3]
3572 if {$ymax eq {} || $ymax == 0} return
3574 set y0 [expr {int([lindex $f 0] * $ymax)}]
3575 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3579 set y1 [expr {int([lindex $f 1] * $ymax)}]
3580 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3581 if {$r1 >= $numcommits} {
3582 set r1 [expr {$numcommits - 1}]
3584 return [list $r0 $r1]
3587 proc layoutmore {} {
3588 global commitidx viewcomplete curview
3589 global numcommits pending_select selectedline curview
3590 global lastscrollset lastscrollrows commitinterest
3592 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
3593 [clock clicks -milliseconds] - $lastscrollset > 500} {
3596 if {[info exists pending_select] &&
3597 [commitinview $pending_select $curview]} {
3598 selectline [rowofcommit $pending_select] 1
3603 proc doshowlocalchanges {} {
3604 global curview mainheadid
3606 if {[commitinview $mainheadid $curview]} {
3609 lappend commitinterest($mainheadid) {dodiffindex}
3613 proc dohidelocalchanges {} {
3614 global nullid nullid2 lserial curview
3616 if {[commitinview $nullid $curview]} {
3617 removefakerow $nullid
3619 if {[commitinview $nullid2 $curview]} {
3620 removefakerow $nullid2
3625 # spawn off a process to do git diff-index --cached HEAD
3626 proc dodiffindex {} {
3627 global lserial showlocalchanges
3629 if {!$showlocalchanges} return
3631 set fd [open "|git diff-index --cached HEAD" r]
3632 fconfigure $fd -blocking 0
3633 filerun $fd [list readdiffindex $fd $lserial]
3636 proc readdiffindex {fd serial} {
3637 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3640 if {[gets $fd line] < 0} {
3646 # we only need to see one line and we don't really care what it says...
3649 if {$serial != $lserial} {
3653 # now see if there are any local changes not checked in to the index
3654 set fd [open "|git diff-files" r]
3655 fconfigure $fd -blocking 0
3656 filerun $fd [list readdifffiles $fd $serial]
3658 if {$isdiff && ![commitinview $nullid2 $curview]} {
3659 # add the line for the changes in the index to the graph
3660 set hl [mc "Local changes checked in to index but not committed"]
3661 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3662 set commitdata($nullid2) "\n $hl\n"
3663 if {[commitinview $nullid $curview]} {
3664 removefakerow $nullid
3666 insertfakerow $nullid2 $mainheadid
3667 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3668 removefakerow $nullid2
3673 proc readdifffiles {fd serial} {
3674 global mainheadid nullid nullid2 curview
3675 global commitinfo commitdata lserial
3678 if {[gets $fd line] < 0} {
3684 # we only need to see one line and we don't really care what it says...
3687 if {$serial != $lserial} {
3691 if {$isdiff && ![commitinview $nullid $curview]} {
3692 # add the line for the local diff to the graph
3693 set hl [mc "Local uncommitted changes, not checked in to index"]
3694 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3695 set commitdata($nullid) "\n $hl\n"
3696 if {[commitinview $nullid2 $curview]} {
3701 insertfakerow $nullid $p
3702 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3703 removefakerow $nullid
3708 proc nextuse {id row} {
3709 global curview children
3711 if {[info exists children($curview,$id)]} {
3712 foreach kid $children($curview,$id) {
3713 if {![commitinview $kid $curview]} {
3716 if {[rowofcommit $kid] > $row} {
3717 return [rowofcommit $kid]
3721 if {[commitinview $id $curview]} {
3722 return [rowofcommit $id]
3727 proc prevuse {id row} {
3728 global curview children
3731 if {[info exists children($curview,$id)]} {
3732 foreach kid $children($curview,$id) {
3733 if {![commitinview $kid $curview]} break
3734 if {[rowofcommit $kid] < $row} {
3735 set ret [rowofcommit $kid]
3742 proc make_idlist {row} {
3743 global displayorder parentlist uparrowlen downarrowlen mingaplen
3744 global commitidx curview children
3746 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3750 set ra [expr {$row - $downarrowlen}]
3754 set rb [expr {$row + $uparrowlen}]
3755 if {$rb > $commitidx($curview)} {
3756 set rb $commitidx($curview)
3758 make_disporder $r [expr {$rb + 1}]
3760 for {} {$r < $ra} {incr r} {
3761 set nextid [lindex $displayorder [expr {$r + 1}]]
3762 foreach p [lindex $parentlist $r] {
3763 if {$p eq $nextid} continue
3764 set rn [nextuse $p $r]
3766 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3767 lappend ids [list [ordertoken $p] $p]
3771 for {} {$r < $row} {incr r} {
3772 set nextid [lindex $displayorder [expr {$r + 1}]]
3773 foreach p [lindex $parentlist $r] {
3774 if {$p eq $nextid} continue
3775 set rn [nextuse $p $r]
3776 if {$rn < 0 || $rn >= $row} {
3777 lappend ids [list [ordertoken $p] $p]
3781 set id [lindex $displayorder $row]
3782 lappend ids [list [ordertoken $id] $id]
3784 foreach p [lindex $parentlist $r] {
3785 set firstkid [lindex $children($curview,$p) 0]
3786 if {[rowofcommit $firstkid] < $row} {
3787 lappend ids [list [ordertoken $p] $p]
3791 set id [lindex $displayorder $r]
3793 set firstkid [lindex $children($curview,$id) 0]
3794 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3795 lappend ids [list [ordertoken $id] $id]
3800 foreach idx [lsort -unique $ids] {
3801 lappend idlist [lindex $idx 1]
3806 proc rowsequal {a b} {
3807 while {[set i [lsearch -exact $a {}]] >= 0} {
3808 set a [lreplace $a $i $i]
3810 while {[set i [lsearch -exact $b {}]] >= 0} {
3811 set b [lreplace $b $i $i]
3813 return [expr {$a eq $b}]
3816 proc makeupline {id row rend col} {
3817 global rowidlist uparrowlen downarrowlen mingaplen
3819 for {set r $rend} {1} {set r $rstart} {
3820 set rstart [prevuse $id $r]
3821 if {$rstart < 0} return
3822 if {$rstart < $row} break
3824 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3825 set rstart [expr {$rend - $uparrowlen - 1}]
3827 for {set r $rstart} {[incr r] <= $row} {} {
3828 set idlist [lindex $rowidlist $r]
3829 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3830 set col [idcol $idlist $id $col]
3831 lset rowidlist $r [linsert $idlist $col $id]
3837 proc layoutrows {row endrow} {
3838 global rowidlist rowisopt rowfinal displayorder
3839 global uparrowlen downarrowlen maxwidth mingaplen
3840 global children parentlist
3841 global commitidx viewcomplete curview
3843 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3846 set rm1 [expr {$row - 1}]
3847 foreach id [lindex $rowidlist $rm1] {
3852 set final [lindex $rowfinal $rm1]
3854 for {} {$row < $endrow} {incr row} {
3855 set rm1 [expr {$row - 1}]
3856 if {$rm1 < 0 || $idlist eq {}} {
3857 set idlist [make_idlist $row]
3860 set id [lindex $displayorder $rm1]
3861 set col [lsearch -exact $idlist $id]
3862 set idlist [lreplace $idlist $col $col]
3863 foreach p [lindex $parentlist $rm1] {
3864 if {[lsearch -exact $idlist $p] < 0} {
3865 set col [idcol $idlist $p $col]
3866 set idlist [linsert $idlist $col $p]
3867 # if not the first child, we have to insert a line going up
3868 if {$id ne [lindex $children($curview,$p) 0]} {
3869 makeupline $p $rm1 $row $col
3873 set id [lindex $displayorder $row]
3874 if {$row > $downarrowlen} {
3875 set termrow [expr {$row - $downarrowlen - 1}]
3876 foreach p [lindex $parentlist $termrow] {
3877 set i [lsearch -exact $idlist $p]
3878 if {$i < 0} continue
3879 set nr [nextuse $p $termrow]
3880 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3881 set idlist [lreplace $idlist $i $i]
3885 set col [lsearch -exact $idlist $id]
3887 set col [idcol $idlist $id]
3888 set idlist [linsert $idlist $col $id]
3889 if {$children($curview,$id) ne {}} {
3890 makeupline $id $rm1 $row $col
3893 set r [expr {$row + $uparrowlen - 1}]
3894 if {$r < $commitidx($curview)} {
3896 foreach p [lindex $parentlist $r] {
3897 if {[lsearch -exact $idlist $p] >= 0} continue
3898 set fk [lindex $children($curview,$p) 0]
3899 if {[rowofcommit $fk] < $row} {
3900 set x [idcol $idlist $p $x]
3901 set idlist [linsert $idlist $x $p]
3904 if {[incr r] < $commitidx($curview)} {
3905 set p [lindex $displayorder $r]
3906 if {[lsearch -exact $idlist $p] < 0} {
3907 set fk [lindex $children($curview,$p) 0]
3908 if {$fk ne {} && [rowofcommit $fk] < $row} {
3909 set x [idcol $idlist $p $x]
3910 set idlist [linsert $idlist $x $p]
3916 if {$final && !$viewcomplete($curview) &&
3917 $row + $uparrowlen + $mingaplen + $downarrowlen
3918 >= $commitidx($curview)} {
3921 set l [llength $rowidlist]
3923 lappend rowidlist $idlist
3925 lappend rowfinal $final
3926 } elseif {$row < $l} {
3927 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3928 lset rowidlist $row $idlist
3931 lset rowfinal $row $final
3933 set pad [ntimes [expr {$row - $l}] {}]
3934 set rowidlist [concat $rowidlist $pad]
3935 lappend rowidlist $idlist
3936 set rowfinal [concat $rowfinal $pad]
3937 lappend rowfinal $final
3938 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3944 proc changedrow {row} {
3945 global displayorder iddrawn rowisopt need_redisplay
3947 set l [llength $rowisopt]
3949 lset rowisopt $row 0
3950 if {$row + 1 < $l} {
3951 lset rowisopt [expr {$row + 1}] 0
3952 if {$row + 2 < $l} {
3953 lset rowisopt [expr {$row + 2}] 0
3957 set id [lindex $displayorder $row]
3958 if {[info exists iddrawn($id)]} {
3959 set need_redisplay 1
3963 proc insert_pad {row col npad} {
3966 set pad [ntimes $npad {}]
3967 set idlist [lindex $rowidlist $row]
3968 set bef [lrange $idlist 0 [expr {$col - 1}]]
3969 set aft [lrange $idlist $col end]
3970 set i [lsearch -exact $aft {}]
3972 set aft [lreplace $aft $i $i]
3974 lset rowidlist $row [concat $bef $pad $aft]
3978 proc optimize_rows {row col endrow} {
3979 global rowidlist rowisopt displayorder curview children
3984 for {} {$row < $endrow} {incr row; set col 0} {
3985 if {[lindex $rowisopt $row]} continue
3987 set y0 [expr {$row - 1}]
3988 set ym [expr {$row - 2}]
3989 set idlist [lindex $rowidlist $row]
3990 set previdlist [lindex $rowidlist $y0]
3991 if {$idlist eq {} || $previdlist eq {}} continue
3993 set pprevidlist [lindex $rowidlist $ym]
3994 if {$pprevidlist eq {}} continue
4000 for {} {$col < [llength $idlist]} {incr col} {
4001 set id [lindex $idlist $col]
4002 if {[lindex $previdlist $col] eq $id} continue
4007 set x0 [lsearch -exact $previdlist $id]
4008 if {$x0 < 0} continue
4009 set z [expr {$x0 - $col}]
4013 set xm [lsearch -exact $pprevidlist $id]
4015 set z0 [expr {$xm - $x0}]
4019 # if row y0 is the first child of $id then it's not an arrow
4020 if {[lindex $children($curview,$id) 0] ne
4021 [lindex $displayorder $y0]} {
4025 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4026 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4029 # Looking at lines from this row to the previous row,
4030 # make them go straight up if they end in an arrow on
4031 # the previous row; otherwise make them go straight up
4033 if {$z < -1 || ($z < 0 && $isarrow)} {
4034 # Line currently goes left too much;
4035 # insert pads in the previous row, then optimize it
4036 set npad [expr {-1 - $z + $isarrow}]
4037 insert_pad $y0 $x0 $npad
4039 optimize_rows $y0 $x0 $row
4041 set previdlist [lindex $rowidlist $y0]
4042 set x0 [lsearch -exact $previdlist $id]
4043 set z [expr {$x0 - $col}]
4045 set pprevidlist [lindex $rowidlist $ym]
4046 set xm [lsearch -exact $pprevidlist $id]
4047 set z0 [expr {$xm - $x0}]
4049 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4050 # Line currently goes right too much;
4051 # insert pads in this line
4052 set npad [expr {$z - 1 + $isarrow}]
4053 insert_pad $row $col $npad
4054 set idlist [lindex $rowidlist $row]
4056 set z [expr {$x0 - $col}]
4059 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4060 # this line links to its first child on row $row-2
4061 set id [lindex $displayorder $ym]
4062 set xc [lsearch -exact $pprevidlist $id]
4064 set z0 [expr {$xc - $x0}]
4067 # avoid lines jigging left then immediately right
4068 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4069 insert_pad $y0 $x0 1
4071 optimize_rows $y0 $x0 $row
4072 set previdlist [lindex $rowidlist $y0]
4076 # Find the first column that doesn't have a line going right
4077 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4078 set id [lindex $idlist $col]
4079 if {$id eq {}} break
4080 set x0 [lsearch -exact $previdlist $id]
4082 # check if this is the link to the first child
4083 set kid [lindex $displayorder $y0]
4084 if {[lindex $children($curview,$id) 0] eq $kid} {
4085 # it is, work out offset to child
4086 set x0 [lsearch -exact $previdlist $kid]
4089 if {$x0 <= $col} break
4091 # Insert a pad at that column as long as it has a line and
4092 # isn't the last column
4093 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4094 set idlist [linsert $idlist $col {}]
4095 lset rowidlist $row $idlist
4103 global canvx0 linespc
4104 return [expr {$canvx0 + $col * $linespc}]
4108 global canvy0 linespc
4109 return [expr {$canvy0 + $row * $linespc}]
4112 proc linewidth {id} {
4113 global thickerline lthickness
4116 if {[info exists thickerline] && $id eq $thickerline} {
4117 set wid [expr {2 * $lthickness}]
4122 proc rowranges {id} {
4123 global curview children uparrowlen downarrowlen
4126 set kids $children($curview,$id)
4132 foreach child $kids {
4133 if {![commitinview $child $curview]} break
4134 set row [rowofcommit $child]
4135 if {![info exists prev]} {
4136 lappend ret [expr {$row + 1}]
4138 if {$row <= $prevrow} {
4139 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4141 # see if the line extends the whole way from prevrow to row
4142 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4143 [lsearch -exact [lindex $rowidlist \
4144 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4145 # it doesn't, see where it ends
4146 set r [expr {$prevrow + $downarrowlen}]
4147 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4148 while {[incr r -1] > $prevrow &&
4149 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4151 while {[incr r] <= $row &&
4152 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4156 # see where it starts up again
4157 set r [expr {$row - $uparrowlen}]
4158 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4159 while {[incr r] < $row &&
4160 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4162 while {[incr r -1] >= $prevrow &&
4163 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4169 if {$child eq $id} {
4178 proc drawlineseg {id row endrow arrowlow} {
4179 global rowidlist displayorder iddrawn linesegs
4180 global canv colormap linespc curview maxlinelen parentlist
4182 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4183 set le [expr {$row + 1}]
4186 set c [lsearch -exact [lindex $rowidlist $le] $id]
4192 set x [lindex $displayorder $le]
4197 if {[info exists iddrawn($x)] || $le == $endrow} {
4198 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4214 if {[info exists linesegs($id)]} {
4215 set lines $linesegs($id)
4217 set r0 [lindex $li 0]
4219 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4229 set li [lindex $lines [expr {$i-1}]]
4230 set r1 [lindex $li 1]
4231 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4236 set x [lindex $cols [expr {$le - $row}]]
4237 set xp [lindex $cols [expr {$le - 1 - $row}]]
4238 set dir [expr {$xp - $x}]
4240 set ith [lindex $lines $i 2]
4241 set coords [$canv coords $ith]
4242 set ah [$canv itemcget $ith -arrow]
4243 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4244 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4245 if {$x2 ne {} && $x - $x2 == $dir} {
4246 set coords [lrange $coords 0 end-2]
4249 set coords [list [xc $le $x] [yc $le]]
4252 set itl [lindex $lines [expr {$i-1}] 2]
4253 set al [$canv itemcget $itl -arrow]
4254 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4255 } elseif {$arrowlow} {
4256 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4257 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4261 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4262 for {set y $le} {[incr y -1] > $row} {} {
4264 set xp [lindex $cols [expr {$y - 1 - $row}]]
4265 set ndir [expr {$xp - $x}]
4266 if {$dir != $ndir || $xp < 0} {
4267 lappend coords [xc $y $x] [yc $y]
4273 # join parent line to first child
4274 set ch [lindex $displayorder $row]
4275 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4277 puts "oops: drawlineseg: child $ch not on row $row"
4278 } elseif {$xc != $x} {
4279 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4280 set d [expr {int(0.5 * $linespc)}]
4283 set x2 [expr {$x1 - $d}]
4285 set x2 [expr {$x1 + $d}]
4288 set y1 [expr {$y2 + $d}]
4289 lappend coords $x1 $y1 $x2 $y2
4290 } elseif {$xc < $x - 1} {
4291 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4292 } elseif {$xc > $x + 1} {
4293 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4297 lappend coords [xc $row $x] [yc $row]
4299 set xn [xc $row $xp]
4301 lappend coords $xn $yn
4305 set t [$canv create line $coords -width [linewidth $id] \
4306 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4309 set lines [linsert $lines $i [list $row $le $t]]
4311 $canv coords $ith $coords
4312 if {$arrow ne $ah} {
4313 $canv itemconf $ith -arrow $arrow
4315 lset lines $i 0 $row
4318 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4319 set ndir [expr {$xo - $xp}]
4320 set clow [$canv coords $itl]
4321 if {$dir == $ndir} {
4322 set clow [lrange $clow 2 end]
4324 set coords [concat $coords $clow]
4326 lset lines [expr {$i-1}] 1 $le
4328 # coalesce two pieces
4330 set b [lindex $lines [expr {$i-1}] 0]
4331 set e [lindex $lines $i 1]
4332 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4334 $canv coords $itl $coords
4335 if {$arrow ne $al} {
4336 $canv itemconf $itl -arrow $arrow
4340 set linesegs($id) $lines
4344 proc drawparentlinks {id row} {
4345 global rowidlist canv colormap curview parentlist
4346 global idpos linespc
4348 set rowids [lindex $rowidlist $row]
4349 set col [lsearch -exact $rowids $id]
4350 if {$col < 0} return
4351 set olds [lindex $parentlist $row]
4352 set row2 [expr {$row + 1}]
4353 set x [xc $row $col]
4356 set d [expr {int(0.5 * $linespc)}]
4357 set ymid [expr {$y + $d}]
4358 set ids [lindex $rowidlist $row2]
4359 # rmx = right-most X coord used
4362 set i [lsearch -exact $ids $p]
4364 puts "oops, parent $p of $id not in list"
4367 set x2 [xc $row2 $i]
4371 set j [lsearch -exact $rowids $p]
4373 # drawlineseg will do this one for us
4377 # should handle duplicated parents here...
4378 set coords [list $x $y]
4380 # if attaching to a vertical segment, draw a smaller
4381 # slant for visual distinctness
4384 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4386 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4388 } elseif {$i < $col && $i < $j} {
4389 # segment slants towards us already
4390 lappend coords [xc $row $j] $y
4392 if {$i < $col - 1} {
4393 lappend coords [expr {$x2 + $linespc}] $y
4394 } elseif {$i > $col + 1} {
4395 lappend coords [expr {$x2 - $linespc}] $y
4397 lappend coords $x2 $y2
4400 lappend coords $x2 $y2
4402 set t [$canv create line $coords -width [linewidth $p] \
4403 -fill $colormap($p) -tags lines.$p]
4407 if {$rmx > [lindex $idpos($id) 1]} {
4408 lset idpos($id) 1 $rmx
4413 proc drawlines {id} {
4416 $canv itemconf lines.$id -width [linewidth $id]
4419 proc drawcmittext {id row col} {
4420 global linespc canv canv2 canv3 fgcolor curview
4421 global cmitlisted commitinfo rowidlist parentlist
4422 global rowtextx idpos idtags idheads idotherrefs
4423 global linehtag linentag linedtag selectedline
4424 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4426 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4427 set listed $cmitlisted($curview,$id)
4428 if {$id eq $nullid} {
4430 } elseif {$id eq $nullid2} {
4433 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
4435 set x [xc $row $col]
4437 set orad [expr {$linespc / 3}]
4439 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4440 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4441 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4442 } elseif {$listed == 3} {
4443 # triangle pointing left for left-side commits
4444 set t [$canv create polygon \
4445 [expr {$x - $orad}] $y \
4446 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4447 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4448 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4450 # triangle pointing right for right-side commits
4451 set t [$canv create polygon \
4452 [expr {$x + $orad - 1}] $y \
4453 [expr {$x - $orad}] [expr {$y - $orad}] \
4454 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4455 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4458 $canv bind $t <1> {selcanvline {} %x %y}
4459 set rmx [llength [lindex $rowidlist $row]]
4460 set olds [lindex $parentlist $row]
4462 set nextids [lindex $rowidlist [expr {$row + 1}]]
4464 set i [lsearch -exact $nextids $p]
4470 set xt [xc $row $rmx]
4471 set rowtextx($row) $xt
4472 set idpos($id) [list $x $xt $y]
4473 if {[info exists idtags($id)] || [info exists idheads($id)]
4474 || [info exists idotherrefs($id)]} {
4475 set xt [drawtags $id $x $xt $y]
4477 set headline [lindex $commitinfo($id) 0]
4478 set name [lindex $commitinfo($id) 1]
4479 set date [lindex $commitinfo($id) 2]
4480 set date [formatdate $date]
4483 set isbold [ishighlighted $id]
4485 lappend boldrows $row
4486 set font mainfontbold
4488 lappend boldnamerows $row
4489 set nfont mainfontbold
4492 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4493 -text $headline -font $font -tags text]
4494 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4495 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4496 -text $name -font $nfont -tags text]
4497 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4498 -text $date -font mainfont -tags text]
4499 if {[info exists selectedline] && $selectedline == $row} {
4502 set xr [expr {$xt + [font measure $font $headline]}]
4503 if {$xr > $canvxmax} {
4509 proc drawcmitrow {row} {
4510 global displayorder rowidlist nrows_drawn
4511 global iddrawn markingmatches
4512 global commitinfo numcommits
4513 global filehighlight fhighlights findpattern nhighlights
4514 global hlview vhighlights
4515 global highlight_related rhighlights
4517 if {$row >= $numcommits} return
4519 set id [lindex $displayorder $row]
4520 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4521 askvhighlight $row $id
4523 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4524 askfilehighlight $row $id
4526 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4527 askfindhighlight $row $id
4529 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4530 askrelhighlight $row $id
4532 if {![info exists iddrawn($id)]} {
4533 set col [lsearch -exact [lindex $rowidlist $row] $id]
4535 puts "oops, row $row id $id not in list"
4538 if {![info exists commitinfo($id)]} {
4542 drawcmittext $id $row $col
4546 if {$markingmatches} {
4547 markrowmatches $row $id
4551 proc drawcommits {row {endrow {}}} {
4552 global numcommits iddrawn displayorder curview need_redisplay
4553 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4558 if {$endrow eq {}} {
4561 if {$endrow >= $numcommits} {
4562 set endrow [expr {$numcommits - 1}]
4565 set rl1 [expr {$row - $downarrowlen - 3}]
4569 set ro1 [expr {$row - 3}]
4573 set r2 [expr {$endrow + $uparrowlen + 3}]
4574 if {$r2 > $numcommits} {
4577 for {set r $rl1} {$r < $r2} {incr r} {
4578 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4582 set rl1 [expr {$r + 1}]
4588 optimize_rows $ro1 0 $r2
4589 if {$need_redisplay || $nrows_drawn > 2000} {
4594 # make the lines join to already-drawn rows either side
4595 set r [expr {$row - 1}]
4596 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4599 set er [expr {$endrow + 1}]
4600 if {$er >= $numcommits ||
4601 ![info exists iddrawn([lindex $displayorder $er])]} {
4604 for {} {$r <= $er} {incr r} {
4605 set id [lindex $displayorder $r]
4606 set wasdrawn [info exists iddrawn($id)]
4608 if {$r == $er} break
4609 set nextid [lindex $displayorder [expr {$r + 1}]]
4610 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4611 drawparentlinks $id $r
4613 set rowids [lindex $rowidlist $r]
4614 foreach lid $rowids {
4615 if {$lid eq {}} continue
4616 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4618 # see if this is the first child of any of its parents
4619 foreach p [lindex $parentlist $r] {
4620 if {[lsearch -exact $rowids $p] < 0} {
4621 # make this line extend up to the child
4622 set lineend($p) [drawlineseg $p $r $er 0]
4626 set lineend($lid) [drawlineseg $lid $r $er 1]
4632 proc undolayout {row} {
4633 global uparrowlen mingaplen downarrowlen
4634 global rowidlist rowisopt rowfinal need_redisplay
4636 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4640 if {[llength $rowidlist] > $r} {
4642 set rowidlist [lrange $rowidlist 0 $r]
4643 set rowfinal [lrange $rowfinal 0 $r]
4644 set rowisopt [lrange $rowisopt 0 $r]
4645 set need_redisplay 1
4650 proc drawvisible {} {
4651 global canv linespc curview vrowmod selectedline targetrow targetid
4652 global need_redisplay cscroll numcommits
4654 set fs [$canv yview]
4655 set ymax [lindex [$canv cget -scrollregion] 3]
4656 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
4657 set f0 [lindex $fs 0]
4658 set f1 [lindex $fs 1]
4659 set y0 [expr {int($f0 * $ymax)}]
4660 set y1 [expr {int($f1 * $ymax)}]
4662 if {[info exists targetid]} {
4663 if {[commitinview $targetid $curview]} {
4664 set r [rowofcommit $targetid]
4665 if {$r != $targetrow} {
4666 # Fix up the scrollregion and change the scrolling position
4667 # now that our target row has moved.
4668 set diff [expr {($r - $targetrow) * $linespc}]
4671 set ymax [lindex [$canv cget -scrollregion] 3]
4674 set f0 [expr {$y0 / $ymax}]
4675 set f1 [expr {$y1 / $ymax}]
4676 allcanvs yview moveto $f0
4677 $cscroll set $f0 $f1
4678 set need_redisplay 1
4685 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4686 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4687 if {$endrow >= $vrowmod($curview)} {
4688 update_arcrows $curview
4690 if {[info exists selectedline] &&
4691 $row <= $selectedline && $selectedline <= $endrow} {
4692 set targetrow $selectedline
4693 } elseif {[info exists targetid]} {
4694 set targetrow [expr {int(($row + $endrow) / 2)}]
4696 if {[info exists targetrow]} {
4697 if {$targetrow >= $numcommits} {
4698 set targetrow [expr {$numcommits - 1}]
4700 set targetid [commitonrow $targetrow]
4702 drawcommits $row $endrow
4705 proc clear_display {} {
4706 global iddrawn linesegs need_redisplay nrows_drawn
4707 global vhighlights fhighlights nhighlights rhighlights
4710 catch {unset iddrawn}
4711 catch {unset linesegs}
4712 catch {unset vhighlights}
4713 catch {unset fhighlights}
4714 catch {unset nhighlights}
4715 catch {unset rhighlights}
4716 set need_redisplay 0
4720 proc findcrossings {id} {
4721 global rowidlist parentlist numcommits displayorder
4725 foreach {s e} [rowranges $id] {
4726 if {$e >= $numcommits} {
4727 set e [expr {$numcommits - 1}]
4729 if {$e <= $s} continue
4730 for {set row $e} {[incr row -1] >= $s} {} {
4731 set x [lsearch -exact [lindex $rowidlist $row] $id]
4733 set olds [lindex $parentlist $row]
4734 set kid [lindex $displayorder $row]
4735 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4736 if {$kidx < 0} continue
4737 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4739 set px [lsearch -exact $nextrow $p]
4740 if {$px < 0} continue
4741 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4742 if {[lsearch -exact $ccross $p] >= 0} continue
4743 if {$x == $px + ($kidx < $px? -1: 1)} {
4745 } elseif {[lsearch -exact $cross $p] < 0} {
4752 return [concat $ccross {{}} $cross]
4755 proc assigncolor {id} {
4756 global colormap colors nextcolor
4757 global parents children children curview
4759 if {[info exists colormap($id)]} return
4760 set ncolors [llength $colors]
4761 if {[info exists children($curview,$id)]} {
4762 set kids $children($curview,$id)
4766 if {[llength $kids] == 1} {
4767 set child [lindex $kids 0]
4768 if {[info exists colormap($child)]
4769 && [llength $parents($curview,$child)] == 1} {
4770 set colormap($id) $colormap($child)
4776 foreach x [findcrossings $id] {
4778 # delimiter between corner crossings and other crossings
4779 if {[llength $badcolors] >= $ncolors - 1} break
4780 set origbad $badcolors
4782 if {[info exists colormap($x)]
4783 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4784 lappend badcolors $colormap($x)
4787 if {[llength $badcolors] >= $ncolors} {
4788 set badcolors $origbad
4790 set origbad $badcolors
4791 if {[llength $badcolors] < $ncolors - 1} {
4792 foreach child $kids {
4793 if {[info exists colormap($child)]
4794 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4795 lappend badcolors $colormap($child)
4797 foreach p $parents($curview,$child) {
4798 if {[info exists colormap($p)]
4799 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4800 lappend badcolors $colormap($p)
4804 if {[llength $badcolors] >= $ncolors} {
4805 set badcolors $origbad
4808 for {set i 0} {$i <= $ncolors} {incr i} {
4809 set c [lindex $colors $nextcolor]
4810 if {[incr nextcolor] >= $ncolors} {
4813 if {[lsearch -exact $badcolors $c]} break
4815 set colormap($id) $c
4818 proc bindline {t id} {
4821 $canv bind $t <Enter> "lineenter %x %y $id"
4822 $canv bind $t <Motion> "linemotion %x %y $id"
4823 $canv bind $t <Leave> "lineleave $id"
4824 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4827 proc drawtags {id x xt y1} {
4828 global idtags idheads idotherrefs mainhead
4829 global linespc lthickness
4830 global canv rowtextx curview fgcolor bgcolor
4835 if {[info exists idtags($id)]} {
4836 set marks $idtags($id)
4837 set ntags [llength $marks]
4839 if {[info exists idheads($id)]} {
4840 set marks [concat $marks $idheads($id)]
4841 set nheads [llength $idheads($id)]
4843 if {[info exists idotherrefs($id)]} {
4844 set marks [concat $marks $idotherrefs($id)]
4850 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4851 set yt [expr {$y1 - 0.5 * $linespc}]
4852 set yb [expr {$yt + $linespc - 1}]
4856 foreach tag $marks {
4858 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4859 set wid [font measure mainfontbold $tag]
4861 set wid [font measure mainfont $tag]
4865 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4867 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4868 -width $lthickness -fill black -tags tag.$id]
4870 foreach tag $marks x $xvals wid $wvals {
4871 set xl [expr {$x + $delta}]
4872 set xr [expr {$x + $delta + $wid + $lthickness}]
4874 if {[incr ntags -1] >= 0} {
4876 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4877 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4878 -width 1 -outline black -fill yellow -tags tag.$id]
4879 $canv bind $t <1> [list showtag $tag 1]
4880 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4882 # draw a head or other ref
4883 if {[incr nheads -1] >= 0} {
4885 if {$tag eq $mainhead} {
4886 set font mainfontbold
4891 set xl [expr {$xl - $delta/2}]
4892 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4893 -width 1 -outline black -fill $col -tags tag.$id
4894 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4895 set rwid [font measure mainfont $remoteprefix]
4896 set xi [expr {$x + 1}]
4897 set yti [expr {$yt + 1}]
4898 set xri [expr {$x + $rwid}]
4899 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4900 -width 0 -fill "#ffddaa" -tags tag.$id
4903 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4904 -font $font -tags [list tag.$id text]]
4906 $canv bind $t <1> [list showtag $tag 1]
4907 } elseif {$nheads >= 0} {
4908 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4914 proc xcoord {i level ln} {
4915 global canvx0 xspc1 xspc2
4917 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4918 if {$i > 0 && $i == $level} {
4919 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4920 } elseif {$i > $level} {
4921 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4926 proc show_status {msg} {
4930 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4931 -tags text -fill $fgcolor
4934 # Don't change the text pane cursor if it is currently the hand cursor,
4935 # showing that we are over a sha1 ID link.
4936 proc settextcursor {c} {
4937 global ctext curtextcursor
4939 if {[$ctext cget -cursor] == $curtextcursor} {
4940 $ctext config -cursor $c
4942 set curtextcursor $c
4945 proc nowbusy {what {name {}}} {
4946 global isbusy busyname statusw
4948 if {[array names isbusy] eq {}} {
4949 . config -cursor watch
4953 set busyname($what) $name
4955 $statusw conf -text $name
4959 proc notbusy {what} {
4960 global isbusy maincursor textcursor busyname statusw
4964 if {$busyname($what) ne {} &&
4965 [$statusw cget -text] eq $busyname($what)} {
4966 $statusw conf -text {}
4969 if {[array names isbusy] eq {}} {
4970 . config -cursor $maincursor
4971 settextcursor $textcursor
4975 proc findmatches {f} {
4976 global findtype findstring
4977 if {$findtype == [mc "Regexp"]} {
4978 set matches [regexp -indices -all -inline $findstring $f]
4981 if {$findtype == [mc "IgnCase"]} {
4982 set f [string tolower $f]
4983 set fs [string tolower $fs]
4987 set l [string length $fs]
4988 while {[set j [string first $fs $f $i]] >= 0} {
4989 lappend matches [list $j [expr {$j+$l-1}]]
4990 set i [expr {$j + $l}]
4996 proc dofind {{dirn 1} {wrap 1}} {
4997 global findstring findstartline findcurline selectedline numcommits
4998 global gdttype filehighlight fh_serial find_dirn findallowwrap
5000 if {[info exists find_dirn]} {
5001 if {$find_dirn == $dirn} return
5005 if {$findstring eq {} || $numcommits == 0} return
5006 if {![info exists selectedline]} {
5007 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5009 set findstartline $selectedline
5011 set findcurline $findstartline
5012 nowbusy finding [mc "Searching"]
5013 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5014 after cancel do_file_hl $fh_serial
5015 do_file_hl $fh_serial
5018 set findallowwrap $wrap
5022 proc stopfinding {} {
5023 global find_dirn findcurline fprogcoord
5025 if {[info exists find_dirn]} {
5035 global commitdata commitinfo numcommits findpattern findloc
5036 global findstartline findcurline findallowwrap
5037 global find_dirn gdttype fhighlights fprogcoord
5038 global curview varcorder vrownum varccommits vrowmod
5040 if {![info exists find_dirn]} {
5043 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5046 if {$find_dirn > 0} {
5048 if {$l >= $numcommits} {
5051 if {$l <= $findstartline} {
5052 set lim [expr {$findstartline + 1}]
5055 set moretodo $findallowwrap
5062 if {$l >= $findstartline} {
5063 set lim [expr {$findstartline - 1}]
5066 set moretodo $findallowwrap
5069 set n [expr {($lim - $l) * $find_dirn}]
5074 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5075 update_arcrows $curview
5079 set ai [bsearch $vrownum($curview) $l]
5080 set a [lindex $varcorder($curview) $ai]
5081 set arow [lindex $vrownum($curview) $ai]
5082 set ids [lindex $varccommits($curview,$a)]
5083 set arowend [expr {$arow + [llength $ids]}]
5084 if {$gdttype eq [mc "containing:"]} {
5085 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5086 if {$l < $arow || $l >= $arowend} {
5088 set a [lindex $varcorder($curview) $ai]
5089 set arow [lindex $vrownum($curview) $ai]
5090 set ids [lindex $varccommits($curview,$a)]
5091 set arowend [expr {$arow + [llength $ids]}]
5093 set id [lindex $ids [expr {$l - $arow}]]
5094 # shouldn't happen unless git log doesn't give all the commits...
5095 if {![info exists commitdata($id)] ||
5096 ![doesmatch $commitdata($id)]} {
5099 if {![info exists commitinfo($id)]} {
5102 set info $commitinfo($id)
5103 foreach f $info ty $fldtypes {
5104 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5113 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5114 if {$l < $arow || $l >= $arowend} {
5116 set a [lindex $varcorder($curview) $ai]
5117 set arow [lindex $vrownum($curview) $ai]
5118 set ids [lindex $varccommits($curview,$a)]
5119 set arowend [expr {$arow + [llength $ids]}]
5121 set id [lindex $ids [expr {$l - $arow}]]
5122 if {![info exists fhighlights($id)]} {
5123 # this sets fhighlights($id) to -1
5124 askfilehighlight $l $id
5126 if {$fhighlights($id) > 0} {
5130 if {$fhighlights($id) < 0} {
5133 set findcurline [expr {$l - $find_dirn}]
5138 if {$found || ($domore && !$moretodo)} {
5154 set findcurline [expr {$l - $find_dirn}]
5156 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5160 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5165 proc findselectline {l} {
5166 global findloc commentend ctext findcurline markingmatches gdttype
5168 set markingmatches 1
5171 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5172 # highlight the matches in the comments
5173 set f [$ctext get 1.0 $commentend]
5174 set matches [findmatches $f]
5175 foreach match $matches {
5176 set start [lindex $match 0]
5177 set end [expr {[lindex $match 1] + 1}]
5178 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5184 # mark the bits of a headline or author that match a find string
5185 proc markmatches {canv l str tag matches font row} {
5188 set bbox [$canv bbox $tag]
5189 set x0 [lindex $bbox 0]
5190 set y0 [lindex $bbox 1]
5191 set y1 [lindex $bbox 3]
5192 foreach match $matches {
5193 set start [lindex $match 0]
5194 set end [lindex $match 1]
5195 if {$start > $end} continue
5196 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5197 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5198 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5199 [expr {$x0+$xlen+2}] $y1 \
5200 -outline {} -tags [list match$l matches] -fill yellow]
5202 if {[info exists selectedline] && $row == $selectedline} {
5203 $canv raise $t secsel
5208 proc unmarkmatches {} {
5209 global markingmatches
5211 allcanvs delete matches
5212 set markingmatches 0
5216 proc selcanvline {w x y} {
5217 global canv canvy0 ctext linespc
5219 set ymax [lindex [$canv cget -scrollregion] 3]
5220 if {$ymax == {}} return
5221 set yfrac [lindex [$canv yview] 0]
5222 set y [expr {$y + $yfrac * $ymax}]
5223 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5228 set xmax [lindex [$canv cget -scrollregion] 2]
5229 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5230 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5236 proc commit_descriptor {p} {
5238 if {![info exists commitinfo($p)]} {
5242 if {[llength $commitinfo($p)] > 1} {
5243 set l [lindex $commitinfo($p) 0]
5248 # append some text to the ctext widget, and make any SHA1 ID
5249 # that we know about be a clickable link.
5250 proc appendwithlinks {text tags} {
5251 global ctext linknum curview pendinglinks
5253 set start [$ctext index "end - 1c"]
5254 $ctext insert end $text $tags
5255 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5259 set linkid [string range $text $s $e]
5261 $ctext tag delete link$linknum
5262 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5263 setlink $linkid link$linknum
5268 proc setlink {id lk} {
5269 global curview ctext pendinglinks commitinterest
5271 if {[commitinview $id $curview]} {
5272 $ctext tag conf $lk -foreground blue -underline 1
5273 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5274 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5275 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5277 lappend pendinglinks($id) $lk
5278 lappend commitinterest($id) {makelink %I}
5282 proc makelink {id} {
5285 if {![info exists pendinglinks($id)]} return
5286 foreach lk $pendinglinks($id) {
5289 unset pendinglinks($id)
5292 proc linkcursor {w inc} {
5293 global linkentercount curtextcursor
5295 if {[incr linkentercount $inc] > 0} {
5296 $w configure -cursor hand2
5298 $w configure -cursor $curtextcursor
5299 if {$linkentercount < 0} {
5300 set linkentercount 0
5305 proc viewnextline {dir} {
5309 set ymax [lindex [$canv cget -scrollregion] 3]
5310 set wnow [$canv yview]
5311 set wtop [expr {[lindex $wnow 0] * $ymax}]
5312 set newtop [expr {$wtop + $dir * $linespc}]
5315 } elseif {$newtop > $ymax} {
5318 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5321 # add a list of tag or branch names at position pos
5322 # returns the number of names inserted
5323 proc appendrefs {pos ids var} {
5324 global ctext linknum curview $var maxrefs
5326 if {[catch {$ctext index $pos}]} {
5329 $ctext conf -state normal
5330 $ctext delete $pos "$pos lineend"
5333 foreach tag [set $var\($id\)] {
5334 lappend tags [list $tag $id]
5337 if {[llength $tags] > $maxrefs} {
5338 $ctext insert $pos "many ([llength $tags])"
5340 set tags [lsort -index 0 -decreasing $tags]
5343 set id [lindex $ti 1]
5346 $ctext tag delete $lk
5347 $ctext insert $pos $sep
5348 $ctext insert $pos [lindex $ti 0] $lk
5353 $ctext conf -state disabled
5354 return [llength $tags]
5357 # called when we have finished computing the nearby tags
5358 proc dispneartags {delay} {
5359 global selectedline currentid showneartags tagphase
5361 if {![info exists selectedline] || !$showneartags} return
5362 after cancel dispnexttag
5364 after 200 dispnexttag
5367 after idle dispnexttag
5372 proc dispnexttag {} {
5373 global selectedline currentid showneartags tagphase ctext
5375 if {![info exists selectedline] || !$showneartags} return
5376 switch -- $tagphase {
5378 set dtags [desctags $currentid]
5380 appendrefs precedes $dtags idtags
5384 set atags [anctags $currentid]
5386 appendrefs follows $atags idtags
5390 set dheads [descheads $currentid]
5391 if {$dheads ne {}} {
5392 if {[appendrefs branch $dheads idheads] > 1
5393 && [$ctext get "branch -3c"] eq "h"} {
5394 # turn "Branch" into "Branches"
5395 $ctext conf -state normal
5396 $ctext insert "branch -2c" "es"
5397 $ctext conf -state disabled
5402 if {[incr tagphase] <= 2} {
5403 after idle dispnexttag
5407 proc make_secsel {l} {
5408 global linehtag linentag linedtag canv canv2 canv3
5410 if {![info exists linehtag($l)]} return
5412 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5413 -tags secsel -fill [$canv cget -selectbackground]]
5415 $canv2 delete secsel
5416 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5417 -tags secsel -fill [$canv2 cget -selectbackground]]
5419 $canv3 delete secsel
5420 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5421 -tags secsel -fill [$canv3 cget -selectbackground]]
5425 proc selectline {l isnew} {
5426 global canv ctext commitinfo selectedline
5427 global canvy0 linespc parents children curview
5428 global currentid sha1entry
5429 global commentend idtags linknum
5430 global mergemax numcommits pending_select
5431 global cmitmode showneartags allcommits
5432 global targetrow targetid
5434 catch {unset pending_select}
5439 if {$l < 0 || $l >= $numcommits} return
5440 set id [commitonrow $l]
5444 set y [expr {$canvy0 + $l * $linespc}]
5445 set ymax [lindex [$canv cget -scrollregion] 3]
5446 set ytop [expr {$y - $linespc - 1}]
5447 set ybot [expr {$y + $linespc + 1}]
5448 set wnow [$canv yview]
5449 set wtop [expr {[lindex $wnow 0] * $ymax}]
5450 set wbot [expr {[lindex $wnow 1] * $ymax}]
5451 set wh [expr {$wbot - $wtop}]
5453 if {$ytop < $wtop} {
5454 if {$ybot < $wtop} {
5455 set newtop [expr {$y - $wh / 2.0}]
5458 if {$newtop > $wtop - $linespc} {
5459 set newtop [expr {$wtop - $linespc}]
5462 } elseif {$ybot > $wbot} {
5463 if {$ytop > $wbot} {
5464 set newtop [expr {$y - $wh / 2.0}]
5466 set newtop [expr {$ybot - $wh}]
5467 if {$newtop < $wtop + $linespc} {
5468 set newtop [expr {$wtop + $linespc}]
5472 if {$newtop != $wtop} {
5476 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5483 addtohistory [list selbyid $id]
5488 $sha1entry delete 0 end
5489 $sha1entry insert 0 $id
5490 $sha1entry selection from 0
5491 $sha1entry selection to end
5494 $ctext conf -state normal
5497 set info $commitinfo($id)
5498 set date [formatdate [lindex $info 2]]
5499 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5500 set date [formatdate [lindex $info 4]]
5501 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5502 if {[info exists idtags($id)]} {
5503 $ctext insert end [mc "Tags:"]
5504 foreach tag $idtags($id) {
5505 $ctext insert end " $tag"
5507 $ctext insert end "\n"
5511 set olds $parents($curview,$id)
5512 if {[llength $olds] > 1} {
5515 if {$np >= $mergemax} {
5520 $ctext insert end "[mc "Parent"]: " $tag
5521 appendwithlinks [commit_descriptor $p] {}
5526 append headers "[mc "Parent"]: [commit_descriptor $p]"
5530 foreach c $children($curview,$id) {
5531 append headers "[mc "Child"]: [commit_descriptor $c]"
5534 # make anything that looks like a SHA1 ID be a clickable link
5535 appendwithlinks $headers {}
5536 if {$showneartags} {
5537 if {![info exists allcommits]} {
5540 $ctext insert end "[mc "Branch"]: "
5541 $ctext mark set branch "end -1c"
5542 $ctext mark gravity branch left
5543 $ctext insert end "\n[mc "Follows"]: "
5544 $ctext mark set follows "end -1c"
5545 $ctext mark gravity follows left
5546 $ctext insert end "\n[mc "Precedes"]: "
5547 $ctext mark set precedes "end -1c"
5548 $ctext mark gravity precedes left
5549 $ctext insert end "\n"
5552 $ctext insert end "\n"
5553 set comment [lindex $info 5]
5554 if {[string first "\r" $comment] >= 0} {
5555 set comment [string map {"\r" "\n "} $comment]
5557 appendwithlinks $comment {comment}
5559 $ctext tag remove found 1.0 end
5560 $ctext conf -state disabled
5561 set commentend [$ctext index "end - 1c"]
5563 init_flist [mc "Comments"]
5564 if {$cmitmode eq "tree"} {
5566 } elseif {[llength $olds] <= 1} {
5573 proc selfirstline {} {
5578 proc sellastline {} {
5581 set l [expr {$numcommits - 1}]
5585 proc selnextline {dir} {
5588 if {![info exists selectedline]} return
5589 set l [expr {$selectedline + $dir}]
5594 proc selnextpage {dir} {
5595 global canv linespc selectedline numcommits
5597 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5601 allcanvs yview scroll [expr {$dir * $lpp}] units
5603 if {![info exists selectedline]} return
5604 set l [expr {$selectedline + $dir * $lpp}]
5607 } elseif {$l >= $numcommits} {
5608 set l [expr $numcommits - 1]
5614 proc unselectline {} {
5615 global selectedline currentid
5617 catch {unset selectedline}
5618 catch {unset currentid}
5619 allcanvs delete secsel
5623 proc reselectline {} {
5626 if {[info exists selectedline]} {
5627 selectline $selectedline 0
5631 proc addtohistory {cmd} {
5632 global history historyindex curview
5634 set elt [list $curview $cmd]
5635 if {$historyindex > 0
5636 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5640 if {$historyindex < [llength $history]} {
5641 set history [lreplace $history $historyindex end $elt]
5643 lappend history $elt
5646 if {$historyindex > 1} {
5647 .tf.bar.leftbut conf -state normal
5649 .tf.bar.leftbut conf -state disabled
5651 .tf.bar.rightbut conf -state disabled
5657 set view [lindex $elt 0]
5658 set cmd [lindex $elt 1]
5659 if {$curview != $view} {
5666 global history historyindex
5669 if {$historyindex > 1} {
5670 incr historyindex -1
5671 godo [lindex $history [expr {$historyindex - 1}]]
5672 .tf.bar.rightbut conf -state normal
5674 if {$historyindex <= 1} {
5675 .tf.bar.leftbut conf -state disabled
5680 global history historyindex
5683 if {$historyindex < [llength $history]} {
5684 set cmd [lindex $history $historyindex]
5687 .tf.bar.leftbut conf -state normal
5689 if {$historyindex >= [llength $history]} {
5690 .tf.bar.rightbut conf -state disabled
5695 global treefilelist treeidlist diffids diffmergeid treepending
5696 global nullid nullid2
5699 catch {unset diffmergeid}
5700 if {![info exists treefilelist($id)]} {
5701 if {![info exists treepending]} {
5702 if {$id eq $nullid} {
5703 set cmd [list | git ls-files]
5704 } elseif {$id eq $nullid2} {
5705 set cmd [list | git ls-files --stage -t]
5707 set cmd [list | git ls-tree -r $id]
5709 if {[catch {set gtf [open $cmd r]}]} {
5713 set treefilelist($id) {}
5714 set treeidlist($id) {}
5715 fconfigure $gtf -blocking 0
5716 filerun $gtf [list gettreeline $gtf $id]
5723 proc gettreeline {gtf id} {
5724 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5727 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5728 if {$diffids eq $nullid} {
5731 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5732 set i [string first "\t" $line]
5733 if {$i < 0} continue
5734 set sha1 [lindex $line 2]
5735 set fname [string range $line [expr {$i+1}] end]
5736 if {[string index $fname 0] eq "\""} {
5737 set fname [lindex $fname 0]
5739 lappend treeidlist($id) $sha1
5741 lappend treefilelist($id) $fname
5744 return [expr {$nl >= 1000? 2: 1}]
5748 if {$cmitmode ne "tree"} {
5749 if {![info exists diffmergeid]} {
5750 gettreediffs $diffids
5752 } elseif {$id ne $diffids} {
5761 global treefilelist treeidlist diffids nullid nullid2
5762 global ctext commentend
5764 set i [lsearch -exact $treefilelist($diffids) $f]
5766 puts "oops, $f not in list for id $diffids"
5769 if {$diffids eq $nullid} {
5770 if {[catch {set bf [open $f r]} err]} {
5771 puts "oops, can't read $f: $err"
5775 set blob [lindex $treeidlist($diffids) $i]
5776 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5777 puts "oops, error reading blob $blob: $err"
5781 fconfigure $bf -blocking 0
5782 filerun $bf [list getblobline $bf $diffids]
5783 $ctext config -state normal
5784 clear_ctext $commentend
5785 $ctext insert end "\n"
5786 $ctext insert end "$f\n" filesep
5787 $ctext config -state disabled
5788 $ctext yview $commentend
5792 proc getblobline {bf id} {
5793 global diffids cmitmode ctext
5795 if {$id ne $diffids || $cmitmode ne "tree"} {
5799 $ctext config -state normal
5801 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5802 $ctext insert end "$line\n"
5805 # delete last newline
5806 $ctext delete "end - 2c" "end - 1c"
5810 $ctext config -state disabled
5811 return [expr {$nl >= 1000? 2: 1}]
5814 proc mergediff {id} {
5815 global diffmergeid mdifffd
5819 global limitdiffs viewfiles curview
5823 # this doesn't seem to actually affect anything...
5824 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5825 if {$limitdiffs && $viewfiles($curview) ne {}} {
5826 set cmd [concat $cmd -- $viewfiles($curview)]
5828 if {[catch {set mdf [open $cmd r]} err]} {
5829 error_popup "[mc "Error getting merge diffs:"] $err"
5832 fconfigure $mdf -blocking 0
5833 set mdifffd($id) $mdf
5834 set np [llength $parents($curview,$id)]
5836 filerun $mdf [list getmergediffline $mdf $id $np]
5839 proc getmergediffline {mdf id np} {
5840 global diffmergeid ctext cflist mergemax
5841 global difffilestart mdifffd
5843 $ctext conf -state normal
5845 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5846 if {![info exists diffmergeid] || $id != $diffmergeid
5847 || $mdf != $mdifffd($id)} {
5851 if {[regexp {^diff --cc (.*)} $line match fname]} {
5852 # start of a new file
5853 $ctext insert end "\n"
5854 set here [$ctext index "end - 1c"]
5855 lappend difffilestart $here
5856 add_flist [list $fname]
5857 set l [expr {(78 - [string length $fname]) / 2}]
5858 set pad [string range "----------------------------------------" 1 $l]
5859 $ctext insert end "$pad $fname $pad\n" filesep
5860 } elseif {[regexp {^@@} $line]} {
5861 $ctext insert end "$line\n" hunksep
5862 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5865 # parse the prefix - one ' ', '-' or '+' for each parent
5870 for {set j 0} {$j < $np} {incr j} {
5871 set c [string range $line $j $j]
5874 } elseif {$c == "-"} {
5876 } elseif {$c == "+"} {
5885 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5886 # line doesn't appear in result, parents in $minuses have the line
5887 set num [lindex $minuses 0]
5888 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5889 # line appears in result, parents in $pluses don't have the line
5890 lappend tags mresult
5891 set num [lindex $spaces 0]
5894 if {$num >= $mergemax} {
5899 $ctext insert end "$line\n" $tags
5902 $ctext conf -state disabled
5907 return [expr {$nr >= 1000? 2: 1}]
5910 proc startdiff {ids} {
5911 global treediffs diffids treepending diffmergeid nullid nullid2
5915 catch {unset diffmergeid}
5916 if {![info exists treediffs($ids)] ||
5917 [lsearch -exact $ids $nullid] >= 0 ||
5918 [lsearch -exact $ids $nullid2] >= 0} {
5919 if {![info exists treepending]} {
5927 proc path_filter {filter name} {
5929 set l [string length $p]
5930 if {[string index $p end] eq "/"} {
5931 if {[string compare -length $l $p $name] == 0} {
5935 if {[string compare -length $l $p $name] == 0 &&
5936 ([string length $name] == $l ||
5937 [string index $name $l] eq "/")} {
5945 proc addtocflist {ids} {
5948 add_flist $treediffs($ids)
5952 proc diffcmd {ids flags} {
5953 global nullid nullid2
5955 set i [lsearch -exact $ids $nullid]
5956 set j [lsearch -exact $ids $nullid2]
5958 if {[llength $ids] > 1 && $j < 0} {
5959 # comparing working directory with some specific revision
5960 set cmd [concat | git diff-index $flags]
5962 lappend cmd -R [lindex $ids 1]
5964 lappend cmd [lindex $ids 0]
5967 # comparing working directory with index
5968 set cmd [concat | git diff-files $flags]
5973 } elseif {$j >= 0} {
5974 set cmd [concat | git diff-index --cached $flags]
5975 if {[llength $ids] > 1} {
5976 # comparing index with specific revision
5978 lappend cmd -R [lindex $ids 1]
5980 lappend cmd [lindex $ids 0]
5983 # comparing index with HEAD
5987 set cmd [concat | git diff-tree -r $flags $ids]
5992 proc gettreediffs {ids} {
5993 global treediff treepending
5995 set treepending $ids
5997 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5998 fconfigure $gdtf -blocking 0
5999 filerun $gdtf [list gettreediffline $gdtf $ids]
6002 proc gettreediffline {gdtf ids} {
6003 global treediff treediffs treepending diffids diffmergeid
6004 global cmitmode viewfiles curview limitdiffs
6007 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6008 set i [string first "\t" $line]
6010 set file [string range $line [expr {$i+1}] end]
6011 if {[string index $file 0] eq "\""} {
6012 set file [lindex $file 0]
6014 lappend treediff $file
6018 return [expr {$nr >= 1000? 2: 1}]
6021 if {$limitdiffs && $viewfiles($curview) ne {}} {
6023 foreach f $treediff {
6024 if {[path_filter $viewfiles($curview) $f]} {
6028 set treediffs($ids) $flist
6030 set treediffs($ids) $treediff
6033 if {$cmitmode eq "tree"} {
6035 } elseif {$ids != $diffids} {
6036 if {![info exists diffmergeid]} {
6037 gettreediffs $diffids
6045 # empty string or positive integer
6046 proc diffcontextvalidate {v} {
6047 return [regexp {^(|[1-9][0-9]*)$} $v]
6050 proc diffcontextchange {n1 n2 op} {
6051 global diffcontextstring diffcontext
6053 if {[string is integer -strict $diffcontextstring]} {
6054 if {$diffcontextstring > 0} {
6055 set diffcontext $diffcontextstring
6061 proc changeignorespace {} {
6065 proc getblobdiffs {ids} {
6066 global blobdifffd diffids env
6067 global diffinhdr treediffs
6070 global limitdiffs viewfiles curview
6072 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6076 if {$limitdiffs && $viewfiles($curview) ne {}} {
6077 set cmd [concat $cmd -- $viewfiles($curview)]
6079 if {[catch {set bdf [open $cmd r]} err]} {
6080 puts "error getting diffs: $err"
6084 fconfigure $bdf -blocking 0
6085 set blobdifffd($ids) $bdf
6086 filerun $bdf [list getblobdiffline $bdf $diffids]
6089 proc setinlist {var i val} {
6092 while {[llength [set $var]] < $i} {
6095 if {[llength [set $var]] == $i} {
6102 proc makediffhdr {fname ids} {
6103 global ctext curdiffstart treediffs
6105 set i [lsearch -exact $treediffs($ids) $fname]
6107 setinlist difffilestart $i $curdiffstart
6109 set l [expr {(78 - [string length $fname]) / 2}]
6110 set pad [string range "----------------------------------------" 1 $l]
6111 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6114 proc getblobdiffline {bdf ids} {
6115 global diffids blobdifffd ctext curdiffstart
6116 global diffnexthead diffnextnote difffilestart
6117 global diffinhdr treediffs
6120 $ctext conf -state normal
6121 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6122 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6126 if {![string compare -length 11 "diff --git " $line]} {
6127 # trim off "diff --git "
6128 set line [string range $line 11 end]
6130 # start of a new file
6131 $ctext insert end "\n"
6132 set curdiffstart [$ctext index "end - 1c"]
6133 $ctext insert end "\n" filesep
6134 # If the name hasn't changed the length will be odd,
6135 # the middle char will be a space, and the two bits either
6136 # side will be a/name and b/name, or "a/name" and "b/name".
6137 # If the name has changed we'll get "rename from" and
6138 # "rename to" or "copy from" and "copy to" lines following this,
6139 # and we'll use them to get the filenames.
6140 # This complexity is necessary because spaces in the filename(s)
6141 # don't get escaped.
6142 set l [string length $line]
6143 set i [expr {$l / 2}]
6144 if {!(($l & 1) && [string index $line $i] eq " " &&
6145 [string range $line 2 [expr {$i - 1}]] eq \
6146 [string range $line [expr {$i + 3}] end])} {
6149 # unescape if quoted and chop off the a/ from the front
6150 if {[string index $line 0] eq "\""} {
6151 set fname [string range [lindex $line 0] 2 end]
6153 set fname [string range $line 2 [expr {$i - 1}]]
6155 makediffhdr $fname $ids
6157 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6158 $line match f1l f1c f2l f2c rest]} {
6159 $ctext insert end "$line\n" hunksep
6162 } elseif {$diffinhdr} {
6163 if {![string compare -length 12 "rename from " $line]} {
6164 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6165 if {[string index $fname 0] eq "\""} {
6166 set fname [lindex $fname 0]
6168 set i [lsearch -exact $treediffs($ids) $fname]
6170 setinlist difffilestart $i $curdiffstart
6172 } elseif {![string compare -length 10 $line "rename to "] ||
6173 ![string compare -length 8 $line "copy to "]} {
6174 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6175 if {[string index $fname 0] eq "\""} {
6176 set fname [lindex $fname 0]
6178 makediffhdr $fname $ids
6179 } elseif {[string compare -length 3 $line "---"] == 0} {
6182 } elseif {[string compare -length 3 $line "+++"] == 0} {
6186 $ctext insert end "$line\n" filesep
6189 set x [string range $line 0 0]
6190 if {$x == "-" || $x == "+"} {
6191 set tag [expr {$x == "+"}]
6192 $ctext insert end "$line\n" d$tag
6193 } elseif {$x == " "} {
6194 $ctext insert end "$line\n"
6196 # "\ No newline at end of file",
6197 # or something else we don't recognize
6198 $ctext insert end "$line\n" hunksep
6202 $ctext conf -state disabled
6207 return [expr {$nr >= 1000? 2: 1}]
6210 proc changediffdisp {} {
6211 global ctext diffelide
6213 $ctext tag conf d0 -elide [lindex $diffelide 0]
6214 $ctext tag conf d1 -elide [lindex $diffelide 1]
6218 global difffilestart ctext
6219 set prev [lindex $difffilestart 0]
6220 set here [$ctext index @0,0]
6221 foreach loc $difffilestart {
6222 if {[$ctext compare $loc >= $here]} {
6232 global difffilestart ctext
6233 set here [$ctext index @0,0]
6234 foreach loc $difffilestart {
6235 if {[$ctext compare $loc > $here]} {
6242 proc clear_ctext {{first 1.0}} {
6243 global ctext smarktop smarkbot
6246 set l [lindex [split $first .] 0]
6247 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6250 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6253 $ctext delete $first end
6254 if {$first eq "1.0"} {
6255 catch {unset pendinglinks}
6259 proc settabs {{firstab {}}} {
6260 global firsttabstop tabstop ctext have_tk85
6262 if {$firstab ne {} && $have_tk85} {
6263 set firsttabstop $firstab
6265 set w [font measure textfont "0"]
6266 if {$firsttabstop != 0} {
6267 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6268 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6269 } elseif {$have_tk85 || $tabstop != 8} {
6270 $ctext conf -tabs [expr {$tabstop * $w}]
6272 $ctext conf -tabs {}
6276 proc incrsearch {name ix op} {
6277 global ctext searchstring searchdirn
6279 $ctext tag remove found 1.0 end
6280 if {[catch {$ctext index anchor}]} {
6281 # no anchor set, use start of selection, or of visible area
6282 set sel [$ctext tag ranges sel]
6284 $ctext mark set anchor [lindex $sel 0]
6285 } elseif {$searchdirn eq "-forwards"} {
6286 $ctext mark set anchor @0,0
6288 $ctext mark set anchor @0,[winfo height $ctext]
6291 if {$searchstring ne {}} {
6292 set here [$ctext search $searchdirn -- $searchstring anchor]
6301 global sstring ctext searchstring searchdirn
6304 $sstring icursor end
6305 set searchdirn -forwards
6306 if {$searchstring ne {}} {
6307 set sel [$ctext tag ranges sel]
6309 set start "[lindex $sel 0] + 1c"
6310 } elseif {[catch {set start [$ctext index anchor]}]} {
6313 set match [$ctext search -count mlen -- $searchstring $start]
6314 $ctext tag remove sel 1.0 end
6320 set mend "$match + $mlen c"
6321 $ctext tag add sel $match $mend
6322 $ctext mark unset anchor
6326 proc dosearchback {} {
6327 global sstring ctext searchstring searchdirn
6330 $sstring icursor end
6331 set searchdirn -backwards
6332 if {$searchstring ne {}} {
6333 set sel [$ctext tag ranges sel]
6335 set start [lindex $sel 0]
6336 } elseif {[catch {set start [$ctext index anchor]}]} {
6337 set start @0,[winfo height $ctext]
6339 set match [$ctext search -backwards -count ml -- $searchstring $start]
6340 $ctext tag remove sel 1.0 end
6346 set mend "$match + $ml c"
6347 $ctext tag add sel $match $mend
6348 $ctext mark unset anchor
6352 proc searchmark {first last} {
6353 global ctext searchstring
6357 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6358 if {$match eq {}} break
6359 set mend "$match + $mlen c"
6360 $ctext tag add found $match $mend
6364 proc searchmarkvisible {doall} {
6365 global ctext smarktop smarkbot
6367 set topline [lindex [split [$ctext index @0,0] .] 0]
6368 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6369 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6370 # no overlap with previous
6371 searchmark $topline $botline
6372 set smarktop $topline
6373 set smarkbot $botline
6375 if {$topline < $smarktop} {
6376 searchmark $topline [expr {$smarktop-1}]
6377 set smarktop $topline
6379 if {$botline > $smarkbot} {
6380 searchmark [expr {$smarkbot+1}] $botline
6381 set smarkbot $botline
6386 proc scrolltext {f0 f1} {
6389 .bleft.sb set $f0 $f1
6390 if {$searchstring ne {}} {
6396 global linespc charspc canvx0 canvy0
6397 global xspc1 xspc2 lthickness
6399 set linespc [font metrics mainfont -linespace]
6400 set charspc [font measure mainfont "m"]
6401 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6402 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6403 set lthickness [expr {int($linespc / 9) + 1}]
6404 set xspc1(0) $linespc
6412 set ymax [lindex [$canv cget -scrollregion] 3]
6413 if {$ymax eq {} || $ymax == 0} return
6414 set span [$canv yview]
6417 allcanvs yview moveto [lindex $span 0]
6419 if {[info exists selectedline]} {
6420 selectline $selectedline 0
6421 allcanvs yview moveto [lindex $span 0]
6425 proc parsefont {f n} {
6428 set fontattr($f,family) [lindex $n 0]
6430 if {$s eq {} || $s == 0} {
6433 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6435 set fontattr($f,size) $s
6436 set fontattr($f,weight) normal
6437 set fontattr($f,slant) roman
6438 foreach style [lrange $n 2 end] {
6441 "bold" {set fontattr($f,weight) $style}
6443 "italic" {set fontattr($f,slant) $style}
6448 proc fontflags {f {isbold 0}} {
6451 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6452 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6453 -slant $fontattr($f,slant)]
6459 set n [list $fontattr($f,family) $fontattr($f,size)]
6460 if {$fontattr($f,weight) eq "bold"} {
6463 if {$fontattr($f,slant) eq "italic"} {
6469 proc incrfont {inc} {
6470 global mainfont textfont ctext canv cflist showrefstop
6471 global stopped entries fontattr
6474 set s $fontattr(mainfont,size)
6479 set fontattr(mainfont,size) $s
6480 font config mainfont -size $s
6481 font config mainfontbold -size $s
6482 set mainfont [fontname mainfont]
6483 set s $fontattr(textfont,size)
6488 set fontattr(textfont,size) $s
6489 font config textfont -size $s
6490 font config textfontbold -size $s
6491 set textfont [fontname textfont]
6498 global sha1entry sha1string
6499 if {[string length $sha1string] == 40} {
6500 $sha1entry delete 0 end
6504 proc sha1change {n1 n2 op} {
6505 global sha1string currentid sha1but
6506 if {$sha1string == {}
6507 || ([info exists currentid] && $sha1string == $currentid)} {
6512 if {[$sha1but cget -state] == $state} return
6513 if {$state == "normal"} {
6514 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6516 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6520 proc gotocommit {} {
6521 global sha1string tagids headids curview varcid
6523 if {$sha1string == {}
6524 || ([info exists currentid] && $sha1string == $currentid)} return
6525 if {[info exists tagids($sha1string)]} {
6526 set id $tagids($sha1string)
6527 } elseif {[info exists headids($sha1string)]} {
6528 set id $headids($sha1string)
6530 set id [string tolower $sha1string]
6531 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6532 set matches [array names varcid "$curview,$id*"]
6533 if {$matches ne {}} {
6534 if {[llength $matches] > 1} {
6535 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6538 set id [lindex [split [lindex $matches 0] ","] 1]
6542 if {[commitinview $id $curview]} {
6543 selectline [rowofcommit $id] 1
6546 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6547 set msg [mc "SHA1 id %s is not known" $sha1string]
6549 set msg [mc "Tag/Head %s is not known" $sha1string]
6554 proc lineenter {x y id} {
6555 global hoverx hovery hoverid hovertimer
6556 global commitinfo canv
6558 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6562 if {[info exists hovertimer]} {
6563 after cancel $hovertimer
6565 set hovertimer [after 500 linehover]
6569 proc linemotion {x y id} {
6570 global hoverx hovery hoverid hovertimer
6572 if {[info exists hoverid] && $id == $hoverid} {
6575 if {[info exists hovertimer]} {
6576 after cancel $hovertimer
6578 set hovertimer [after 500 linehover]
6582 proc lineleave {id} {
6583 global hoverid hovertimer canv
6585 if {[info exists hoverid] && $id == $hoverid} {
6587 if {[info exists hovertimer]} {
6588 after cancel $hovertimer
6596 global hoverx hovery hoverid hovertimer
6597 global canv linespc lthickness
6600 set text [lindex $commitinfo($hoverid) 0]
6601 set ymax [lindex [$canv cget -scrollregion] 3]
6602 if {$ymax == {}} return
6603 set yfrac [lindex [$canv yview] 0]
6604 set x [expr {$hoverx + 2 * $linespc}]
6605 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6606 set x0 [expr {$x - 2 * $lthickness}]
6607 set y0 [expr {$y - 2 * $lthickness}]
6608 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6609 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6610 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6611 -fill \#ffff80 -outline black -width 1 -tags hover]
6613 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6618 proc clickisonarrow {id y} {
6621 set ranges [rowranges $id]
6622 set thresh [expr {2 * $lthickness + 6}]
6623 set n [expr {[llength $ranges] - 1}]
6624 for {set i 1} {$i < $n} {incr i} {
6625 set row [lindex $ranges $i]
6626 if {abs([yc $row] - $y) < $thresh} {
6633 proc arrowjump {id n y} {
6636 # 1 <-> 2, 3 <-> 4, etc...
6637 set n [expr {(($n - 1) ^ 1) + 1}]
6638 set row [lindex [rowranges $id] $n]
6640 set ymax [lindex [$canv cget -scrollregion] 3]
6641 if {$ymax eq {} || $ymax <= 0} return
6642 set view [$canv yview]
6643 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6644 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6648 allcanvs yview moveto $yfrac
6651 proc lineclick {x y id isnew} {
6652 global ctext commitinfo children canv thickerline curview
6654 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6659 # draw this line thicker than normal
6663 set ymax [lindex [$canv cget -scrollregion] 3]
6664 if {$ymax eq {}} return
6665 set yfrac [lindex [$canv yview] 0]
6666 set y [expr {$y + $yfrac * $ymax}]
6668 set dirn [clickisonarrow $id $y]
6670 arrowjump $id $dirn $y
6675 addtohistory [list lineclick $x $y $id 0]
6677 # fill the details pane with info about this line
6678 $ctext conf -state normal
6681 $ctext insert end "[mc "Parent"]:\t"
6682 $ctext insert end $id link0
6684 set info $commitinfo($id)
6685 $ctext insert end "\n\t[lindex $info 0]\n"
6686 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6687 set date [formatdate [lindex $info 2]]
6688 $ctext insert end "\t[mc "Date"]:\t$date\n"
6689 set kids $children($curview,$id)
6691 $ctext insert end "\n[mc "Children"]:"
6693 foreach child $kids {
6695 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6696 set info $commitinfo($child)
6697 $ctext insert end "\n\t"
6698 $ctext insert end $child link$i
6699 setlink $child link$i
6700 $ctext insert end "\n\t[lindex $info 0]"
6701 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6702 set date [formatdate [lindex $info 2]]
6703 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6706 $ctext conf -state disabled
6710 proc normalline {} {
6712 if {[info exists thickerline]} {
6721 if {[commitinview $id $curview]} {
6722 selectline [rowofcommit $id] 1
6728 if {![info exists startmstime]} {
6729 set startmstime [clock clicks -milliseconds]
6731 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6734 proc rowmenu {x y id} {
6735 global rowctxmenu selectedline rowmenuid curview
6736 global nullid nullid2 fakerowmenu mainhead
6740 if {![info exists selectedline]
6741 || [rowofcommit $id] eq $selectedline} {
6746 if {$id ne $nullid && $id ne $nullid2} {
6747 set menu $rowctxmenu
6748 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6750 set menu $fakerowmenu
6752 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6753 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6754 $menu entryconfigure [mc "Make patch"] -state $state
6755 tk_popup $menu $x $y
6758 proc diffvssel {dirn} {
6759 global rowmenuid selectedline
6761 if {![info exists selectedline]} return
6763 set oldid [commitonrow $selectedline]
6764 set newid $rowmenuid
6766 set oldid $rowmenuid
6767 set newid [commitonrow $selectedline]
6769 addtohistory [list doseldiff $oldid $newid]
6770 doseldiff $oldid $newid
6773 proc doseldiff {oldid newid} {
6777 $ctext conf -state normal
6779 init_flist [mc "Top"]
6780 $ctext insert end "[mc "From"] "
6781 $ctext insert end $oldid link0
6782 setlink $oldid link0
6783 $ctext insert end "\n "
6784 $ctext insert end [lindex $commitinfo($oldid) 0]
6785 $ctext insert end "\n\n[mc "To"] "
6786 $ctext insert end $newid link1
6787 setlink $newid link1
6788 $ctext insert end "\n "
6789 $ctext insert end [lindex $commitinfo($newid) 0]
6790 $ctext insert end "\n"
6791 $ctext conf -state disabled
6792 $ctext tag remove found 1.0 end
6793 startdiff [list $oldid $newid]
6797 global rowmenuid currentid commitinfo patchtop patchnum
6799 if {![info exists currentid]} return
6800 set oldid $currentid
6801 set oldhead [lindex $commitinfo($oldid) 0]
6802 set newid $rowmenuid
6803 set newhead [lindex $commitinfo($newid) 0]
6806 catch {destroy $top}
6808 label $top.title -text [mc "Generate patch"]
6809 grid $top.title - -pady 10
6810 label $top.from -text [mc "From:"]
6811 entry $top.fromsha1 -width 40 -relief flat
6812 $top.fromsha1 insert 0 $oldid
6813 $top.fromsha1 conf -state readonly
6814 grid $top.from $top.fromsha1 -sticky w
6815 entry $top.fromhead -width 60 -relief flat
6816 $top.fromhead insert 0 $oldhead
6817 $top.fromhead conf -state readonly
6818 grid x $top.fromhead -sticky w
6819 label $top.to -text [mc "To:"]
6820 entry $top.tosha1 -width 40 -relief flat
6821 $top.tosha1 insert 0 $newid
6822 $top.tosha1 conf -state readonly
6823 grid $top.to $top.tosha1 -sticky w
6824 entry $top.tohead -width 60 -relief flat
6825 $top.tohead insert 0 $newhead
6826 $top.tohead conf -state readonly
6827 grid x $top.tohead -sticky w
6828 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6829 grid $top.rev x -pady 10
6830 label $top.flab -text [mc "Output file:"]
6831 entry $top.fname -width 60
6832 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6834 grid $top.flab $top.fname -sticky w
6836 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6837 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6838 grid $top.buts.gen $top.buts.can
6839 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6840 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6841 grid $top.buts - -pady 10 -sticky ew
6845 proc mkpatchrev {} {
6848 set oldid [$patchtop.fromsha1 get]
6849 set oldhead [$patchtop.fromhead get]
6850 set newid [$patchtop.tosha1 get]
6851 set newhead [$patchtop.tohead get]
6852 foreach e [list fromsha1 fromhead tosha1 tohead] \
6853 v [list $newid $newhead $oldid $oldhead] {
6854 $patchtop.$e conf -state normal
6855 $patchtop.$e delete 0 end
6856 $patchtop.$e insert 0 $v
6857 $patchtop.$e conf -state readonly
6862 global patchtop nullid nullid2
6864 set oldid [$patchtop.fromsha1 get]
6865 set newid [$patchtop.tosha1 get]
6866 set fname [$patchtop.fname get]
6867 set cmd [diffcmd [list $oldid $newid] -p]
6868 # trim off the initial "|"
6869 set cmd [lrange $cmd 1 end]
6870 lappend cmd >$fname &
6871 if {[catch {eval exec $cmd} err]} {
6872 error_popup "[mc "Error creating patch:"] $err"
6874 catch {destroy $patchtop}
6878 proc mkpatchcan {} {
6881 catch {destroy $patchtop}
6886 global rowmenuid mktagtop commitinfo
6890 catch {destroy $top}
6892 label $top.title -text [mc "Create tag"]
6893 grid $top.title - -pady 10
6894 label $top.id -text [mc "ID:"]
6895 entry $top.sha1 -width 40 -relief flat
6896 $top.sha1 insert 0 $rowmenuid
6897 $top.sha1 conf -state readonly
6898 grid $top.id $top.sha1 -sticky w
6899 entry $top.head -width 60 -relief flat
6900 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6901 $top.head conf -state readonly
6902 grid x $top.head -sticky w
6903 label $top.tlab -text [mc "Tag name:"]
6904 entry $top.tag -width 60
6905 grid $top.tlab $top.tag -sticky w
6907 button $top.buts.gen -text [mc "Create"] -command mktaggo
6908 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6909 grid $top.buts.gen $top.buts.can
6910 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6911 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6912 grid $top.buts - -pady 10 -sticky ew
6917 global mktagtop env tagids idtags
6919 set id [$mktagtop.sha1 get]
6920 set tag [$mktagtop.tag get]
6922 error_popup [mc "No tag name specified"]
6925 if {[info exists tagids($tag)]} {
6926 error_popup [mc "Tag \"%s\" already exists" $tag]
6930 exec git tag $tag $id
6932 error_popup "[mc "Error creating tag:"] $err"
6936 set tagids($tag) $id
6937 lappend idtags($id) $tag
6944 proc redrawtags {id} {
6945 global canv linehtag idpos currentid curview
6946 global canvxmax iddrawn
6948 if {![commitinview $id $curview]} return
6949 if {![info exists iddrawn($id)]} return
6950 set row [rowofcommit $id]
6951 $canv delete tag.$id
6952 set xt [eval drawtags $id $idpos($id)]
6953 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6954 set text [$canv itemcget $linehtag($row) -text]
6955 set font [$canv itemcget $linehtag($row) -font]
6956 set xr [expr {$xt + [font measure $font $text]}]
6957 if {$xr > $canvxmax} {
6961 if {[info exists currentid] && $currentid == $id} {
6969 catch {destroy $mktagtop}
6978 proc writecommit {} {
6979 global rowmenuid wrcomtop commitinfo wrcomcmd
6981 set top .writecommit
6983 catch {destroy $top}
6985 label $top.title -text [mc "Write commit to file"]
6986 grid $top.title - -pady 10
6987 label $top.id -text [mc "ID:"]
6988 entry $top.sha1 -width 40 -relief flat
6989 $top.sha1 insert 0 $rowmenuid
6990 $top.sha1 conf -state readonly
6991 grid $top.id $top.sha1 -sticky w
6992 entry $top.head -width 60 -relief flat
6993 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6994 $top.head conf -state readonly
6995 grid x $top.head -sticky w
6996 label $top.clab -text [mc "Command:"]
6997 entry $top.cmd -width 60 -textvariable wrcomcmd
6998 grid $top.clab $top.cmd -sticky w -pady 10
6999 label $top.flab -text [mc "Output file:"]
7000 entry $top.fname -width 60
7001 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7002 grid $top.flab $top.fname -sticky w
7004 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7005 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7006 grid $top.buts.gen $top.buts.can
7007 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7008 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7009 grid $top.buts - -pady 10 -sticky ew
7016 set id [$wrcomtop.sha1 get]
7017 set cmd "echo $id | [$wrcomtop.cmd get]"
7018 set fname [$wrcomtop.fname get]
7019 if {[catch {exec sh -c $cmd >$fname &} err]} {
7020 error_popup "[mc "Error writing commit:"] $err"
7022 catch {destroy $wrcomtop}
7029 catch {destroy $wrcomtop}
7034 global rowmenuid mkbrtop
7037 catch {destroy $top}
7039 label $top.title -text [mc "Create new branch"]
7040 grid $top.title - -pady 10
7041 label $top.id -text [mc "ID:"]
7042 entry $top.sha1 -width 40 -relief flat
7043 $top.sha1 insert 0 $rowmenuid
7044 $top.sha1 conf -state readonly
7045 grid $top.id $top.sha1 -sticky w
7046 label $top.nlab -text [mc "Name:"]
7047 entry $top.name -width 40
7048 grid $top.nlab $top.name -sticky w
7050 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7051 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7052 grid $top.buts.go $top.buts.can
7053 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7054 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7055 grid $top.buts - -pady 10 -sticky ew
7060 global headids idheads
7062 set name [$top.name get]
7063 set id [$top.sha1 get]
7065 error_popup [mc "Please specify a name for the new branch"]
7068 catch {destroy $top}
7072 exec git branch $name $id
7077 set headids($name) $id
7078 lappend idheads($id) $name
7087 proc cherrypick {} {
7088 global rowmenuid curview
7089 global mainhead mainheadid
7091 set oldhead [exec git rev-parse HEAD]
7092 set dheads [descheads $rowmenuid]
7093 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7094 set ok [confirm_popup [mc "Commit %s is already\
7095 included in branch %s -- really re-apply it?" \
7096 [string range $rowmenuid 0 7] $mainhead]]
7099 nowbusy cherrypick [mc "Cherry-picking"]
7101 # Unfortunately git-cherry-pick writes stuff to stderr even when
7102 # no error occurs, and exec takes that as an indication of error...
7103 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7108 set newhead [exec git rev-parse HEAD]
7109 if {$newhead eq $oldhead} {
7111 error_popup [mc "No changes committed"]
7114 addnewchild $newhead $oldhead
7115 if {[commitinview $oldhead $curview]} {
7116 insertrow $newhead $oldhead $curview
7117 if {$mainhead ne {}} {
7118 movehead $newhead $mainhead
7119 movedhead $newhead $mainhead
7120 set mainheadid $newhead
7130 global mainhead rowmenuid confirm_ok resettype
7133 set w ".confirmreset"
7136 wm title $w [mc "Confirm reset"]
7137 message $w.m -text \
7138 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7139 -justify center -aspect 1000
7140 pack $w.m -side top -fill x -padx 20 -pady 20
7141 frame $w.f -relief sunken -border 2
7142 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7143 grid $w.f.rt -sticky w
7145 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7146 -text [mc "Soft: Leave working tree and index untouched"]
7147 grid $w.f.soft -sticky w
7148 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7149 -text [mc "Mixed: Leave working tree untouched, reset index"]
7150 grid $w.f.mixed -sticky w
7151 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7152 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7153 grid $w.f.hard -sticky w
7154 pack $w.f -side top -fill x
7155 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7156 pack $w.ok -side left -fill x -padx 20 -pady 20
7157 button $w.cancel -text [mc Cancel] -command "destroy $w"
7158 pack $w.cancel -side right -fill x -padx 20 -pady 20
7159 bind $w <Visibility> "grab $w; focus $w"
7161 if {!$confirm_ok} return
7162 if {[catch {set fd [open \
7163 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7167 filerun $fd [list readresetstat $fd]
7168 nowbusy reset [mc "Resetting"]
7173 proc readresetstat {fd} {
7174 global mainhead mainheadid showlocalchanges rprogcoord
7176 if {[gets $fd line] >= 0} {
7177 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7178 set rprogcoord [expr {1.0 * $m / $n}]
7186 if {[catch {close $fd} err]} {
7189 set oldhead $mainheadid
7190 set newhead [exec git rev-parse HEAD]
7191 if {$newhead ne $oldhead} {
7192 movehead $newhead $mainhead
7193 movedhead $newhead $mainhead
7194 set mainheadid $newhead
7198 if {$showlocalchanges} {
7204 # context menu for a head
7205 proc headmenu {x y id head} {
7206 global headmenuid headmenuhead headctxmenu mainhead
7210 set headmenuhead $head
7212 if {$head eq $mainhead} {
7215 $headctxmenu entryconfigure 0 -state $state
7216 $headctxmenu entryconfigure 1 -state $state
7217 tk_popup $headctxmenu $x $y
7221 global headmenuid headmenuhead mainhead headids
7222 global showlocalchanges mainheadid
7224 # check the tree is clean first??
7225 set oldmainhead $mainhead
7226 nowbusy checkout [mc "Checking out"]
7230 exec git checkout -q $headmenuhead
7236 set mainhead $headmenuhead
7237 set mainheadid $headmenuid
7238 if {[info exists headids($oldmainhead)]} {
7239 redrawtags $headids($oldmainhead)
7241 redrawtags $headmenuid
7244 if {$showlocalchanges} {
7250 global headmenuid headmenuhead mainhead
7253 set head $headmenuhead
7255 # this check shouldn't be needed any more...
7256 if {$head eq $mainhead} {
7257 error_popup [mc "Cannot delete the currently checked-out branch"]
7260 set dheads [descheads $id]
7261 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7262 # the stuff on this branch isn't on any other branch
7263 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7264 branch.\nReally delete branch %s?" $head $head]]} return
7268 if {[catch {exec git branch -D $head} err]} {
7273 removehead $id $head
7274 removedhead $id $head
7281 # Display a list of tags and heads
7283 global showrefstop bgcolor fgcolor selectbgcolor
7284 global bglist fglist reflistfilter reflist maincursor
7287 set showrefstop $top
7288 if {[winfo exists $top]} {
7294 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7295 text $top.list -background $bgcolor -foreground $fgcolor \
7296 -selectbackground $selectbgcolor -font mainfont \
7297 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7298 -width 30 -height 20 -cursor $maincursor \
7299 -spacing1 1 -spacing3 1 -state disabled
7300 $top.list tag configure highlight -background $selectbgcolor
7301 lappend bglist $top.list
7302 lappend fglist $top.list
7303 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7304 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7305 grid $top.list $top.ysb -sticky nsew
7306 grid $top.xsb x -sticky ew
7308 label $top.f.l -text "[mc "Filter"]: "
7309 entry $top.f.e -width 20 -textvariable reflistfilter
7310 set reflistfilter "*"
7311 trace add variable reflistfilter write reflistfilter_change
7312 pack $top.f.e -side right -fill x -expand 1
7313 pack $top.f.l -side left
7314 grid $top.f - -sticky ew -pady 2
7315 button $top.close -command [list destroy $top] -text [mc "Close"]
7317 grid columnconfigure $top 0 -weight 1
7318 grid rowconfigure $top 0 -weight 1
7319 bind $top.list <1> {break}
7320 bind $top.list <B1-Motion> {break}
7321 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7326 proc sel_reflist {w x y} {
7327 global showrefstop reflist headids tagids otherrefids
7329 if {![winfo exists $showrefstop]} return
7330 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7331 set ref [lindex $reflist [expr {$l-1}]]
7332 set n [lindex $ref 0]
7333 switch -- [lindex $ref 1] {
7334 "H" {selbyid $headids($n)}
7335 "T" {selbyid $tagids($n)}
7336 "o" {selbyid $otherrefids($n)}
7338 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7341 proc unsel_reflist {} {
7344 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7345 $showrefstop.list tag remove highlight 0.0 end
7348 proc reflistfilter_change {n1 n2 op} {
7349 global reflistfilter
7351 after cancel refill_reflist
7352 after 200 refill_reflist
7355 proc refill_reflist {} {
7356 global reflist reflistfilter showrefstop headids tagids otherrefids
7357 global curview commitinterest
7359 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7361 foreach n [array names headids] {
7362 if {[string match $reflistfilter $n]} {
7363 if {[commitinview $headids($n) $curview]} {
7364 lappend refs [list $n H]
7366 set commitinterest($headids($n)) {run refill_reflist}
7370 foreach n [array names tagids] {
7371 if {[string match $reflistfilter $n]} {
7372 if {[commitinview $tagids($n) $curview]} {
7373 lappend refs [list $n T]
7375 set commitinterest($tagids($n)) {run refill_reflist}
7379 foreach n [array names otherrefids] {
7380 if {[string match $reflistfilter $n]} {
7381 if {[commitinview $otherrefids($n) $curview]} {
7382 lappend refs [list $n o]
7384 set commitinterest($otherrefids($n)) {run refill_reflist}
7388 set refs [lsort -index 0 $refs]
7389 if {$refs eq $reflist} return
7391 # Update the contents of $showrefstop.list according to the
7392 # differences between $reflist (old) and $refs (new)
7393 $showrefstop.list conf -state normal
7394 $showrefstop.list insert end "\n"
7397 while {$i < [llength $reflist] || $j < [llength $refs]} {
7398 if {$i < [llength $reflist]} {
7399 if {$j < [llength $refs]} {
7400 set cmp [string compare [lindex $reflist $i 0] \
7401 [lindex $refs $j 0]]
7403 set cmp [string compare [lindex $reflist $i 1] \
7404 [lindex $refs $j 1]]
7414 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7422 set l [expr {$j + 1}]
7423 $showrefstop.list image create $l.0 -align baseline \
7424 -image reficon-[lindex $refs $j 1] -padx 2
7425 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7431 # delete last newline
7432 $showrefstop.list delete end-2c end-1c
7433 $showrefstop.list conf -state disabled
7436 # Stuff for finding nearby tags
7437 proc getallcommits {} {
7438 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7439 global idheads idtags idotherrefs allparents tagobjid
7441 if {![info exists allcommits]} {
7447 set allccache [file join [gitdir] "gitk.cache"]
7449 set f [open $allccache r]
7458 set cmd [list | git rev-list --parents]
7459 set allcupdate [expr {$seeds ne {}}]
7463 set refs [concat [array names idheads] [array names idtags] \
7464 [array names idotherrefs]]
7467 foreach name [array names tagobjid] {
7468 lappend tagobjs $tagobjid($name)
7470 foreach id [lsort -unique $refs] {
7471 if {![info exists allparents($id)] &&
7472 [lsearch -exact $tagobjs $id] < 0} {
7483 set fd [open [concat $cmd $ids] r]
7484 fconfigure $fd -blocking 0
7487 filerun $fd [list getallclines $fd]
7493 # Since most commits have 1 parent and 1 child, we group strings of
7494 # such commits into "arcs" joining branch/merge points (BMPs), which
7495 # are commits that either don't have 1 parent or don't have 1 child.
7497 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7498 # arcout(id) - outgoing arcs for BMP
7499 # arcids(a) - list of IDs on arc including end but not start
7500 # arcstart(a) - BMP ID at start of arc
7501 # arcend(a) - BMP ID at end of arc
7502 # growing(a) - arc a is still growing
7503 # arctags(a) - IDs out of arcids (excluding end) that have tags
7504 # archeads(a) - IDs out of arcids (excluding end) that have heads
7505 # The start of an arc is at the descendent end, so "incoming" means
7506 # coming from descendents, and "outgoing" means going towards ancestors.
7508 proc getallclines {fd} {
7509 global allparents allchildren idtags idheads nextarc
7510 global arcnos arcids arctags arcout arcend arcstart archeads growing
7511 global seeds allcommits cachedarcs allcupdate
7514 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7515 set id [lindex $line 0]
7516 if {[info exists allparents($id)]} {
7521 set olds [lrange $line 1 end]
7522 set allparents($id) $olds
7523 if {![info exists allchildren($id)]} {
7524 set allchildren($id) {}
7529 if {[llength $olds] == 1 && [llength $a] == 1} {
7530 lappend arcids($a) $id
7531 if {[info exists idtags($id)]} {
7532 lappend arctags($a) $id
7534 if {[info exists idheads($id)]} {
7535 lappend archeads($a) $id
7537 if {[info exists allparents($olds)]} {
7538 # seen parent already
7539 if {![info exists arcout($olds)]} {
7542 lappend arcids($a) $olds
7543 set arcend($a) $olds
7546 lappend allchildren($olds) $id
7547 lappend arcnos($olds) $a
7551 foreach a $arcnos($id) {
7552 lappend arcids($a) $id
7559 lappend allchildren($p) $id
7560 set a [incr nextarc]
7561 set arcstart($a) $id
7568 if {[info exists allparents($p)]} {
7569 # seen it already, may need to make a new branch
7570 if {![info exists arcout($p)]} {
7573 lappend arcids($a) $p
7577 lappend arcnos($p) $a
7582 global cached_dheads cached_dtags cached_atags
7583 catch {unset cached_dheads}
7584 catch {unset cached_dtags}
7585 catch {unset cached_atags}
7588 return [expr {$nid >= 1000? 2: 1}]
7592 fconfigure $fd -blocking 1
7595 # got an error reading the list of commits
7596 # if we were updating, try rereading the whole thing again
7602 error_popup "[mc "Error reading commit topology information;\
7603 branch and preceding/following tag information\
7604 will be incomplete."]\n($err)"
7607 if {[incr allcommits -1] == 0} {
7617 proc recalcarc {a} {
7618 global arctags archeads arcids idtags idheads
7622 foreach id [lrange $arcids($a) 0 end-1] {
7623 if {[info exists idtags($id)]} {
7626 if {[info exists idheads($id)]} {
7631 set archeads($a) $ah
7635 global arcnos arcids nextarc arctags archeads idtags idheads
7636 global arcstart arcend arcout allparents growing
7639 if {[llength $a] != 1} {
7640 puts "oops splitarc called but [llength $a] arcs already"
7644 set i [lsearch -exact $arcids($a) $p]
7646 puts "oops splitarc $p not in arc $a"
7649 set na [incr nextarc]
7650 if {[info exists arcend($a)]} {
7651 set arcend($na) $arcend($a)
7653 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7654 set j [lsearch -exact $arcnos($l) $a]
7655 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7657 set tail [lrange $arcids($a) [expr {$i+1}] end]
7658 set arcids($a) [lrange $arcids($a) 0 $i]
7660 set arcstart($na) $p
7662 set arcids($na) $tail
7663 if {[info exists growing($a)]} {
7669 if {[llength $arcnos($id)] == 1} {
7672 set j [lsearch -exact $arcnos($id) $a]
7673 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7677 # reconstruct tags and heads lists
7678 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7683 set archeads($na) {}
7687 # Update things for a new commit added that is a child of one
7688 # existing commit. Used when cherry-picking.
7689 proc addnewchild {id p} {
7690 global allparents allchildren idtags nextarc
7691 global arcnos arcids arctags arcout arcend arcstart archeads growing
7692 global seeds allcommits
7694 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7695 set allparents($id) [list $p]
7696 set allchildren($id) {}
7699 lappend allchildren($p) $id
7700 set a [incr nextarc]
7701 set arcstart($a) $id
7704 set arcids($a) [list $p]
7706 if {![info exists arcout($p)]} {
7709 lappend arcnos($p) $a
7710 set arcout($id) [list $a]
7713 # This implements a cache for the topology information.
7714 # The cache saves, for each arc, the start and end of the arc,
7715 # the ids on the arc, and the outgoing arcs from the end.
7716 proc readcache {f} {
7717 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7718 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7723 if {$lim - $a > 500} {
7724 set lim [expr {$a + 500}]
7728 # finish reading the cache and setting up arctags, etc.
7730 if {$line ne "1"} {error "bad final version"}
7732 foreach id [array names idtags] {
7733 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7734 [llength $allparents($id)] == 1} {
7735 set a [lindex $arcnos($id) 0]
7736 if {$arctags($a) eq {}} {
7741 foreach id [array names idheads] {
7742 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7743 [llength $allparents($id)] == 1} {
7744 set a [lindex $arcnos($id) 0]
7745 if {$archeads($a) eq {}} {
7750 foreach id [lsort -unique $possible_seeds] {
7751 if {$arcnos($id) eq {}} {
7757 while {[incr a] <= $lim} {
7759 if {[llength $line] != 3} {error "bad line"}
7760 set s [lindex $line 0]
7762 lappend arcout($s) $a
7763 if {![info exists arcnos($s)]} {
7764 lappend possible_seeds $s
7767 set e [lindex $line 1]
7772 if {![info exists arcout($e)]} {
7776 set arcids($a) [lindex $line 2]
7777 foreach id $arcids($a) {
7778 lappend allparents($s) $id
7780 lappend arcnos($id) $a
7782 if {![info exists allparents($s)]} {
7783 set allparents($s) {}
7788 set nextarc [expr {$a - 1}]
7801 global nextarc cachedarcs possible_seeds
7805 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7806 # make sure it's an integer
7807 set cachedarcs [expr {int([lindex $line 1])}]
7808 if {$cachedarcs < 0} {error "bad number of arcs"}
7810 set possible_seeds {}
7818 proc dropcache {err} {
7819 global allcwait nextarc cachedarcs seeds
7821 #puts "dropping cache ($err)"
7822 foreach v {arcnos arcout arcids arcstart arcend growing \
7823 arctags archeads allparents allchildren} {
7834 proc writecache {f} {
7835 global cachearc cachedarcs allccache
7836 global arcstart arcend arcnos arcids arcout
7840 if {$lim - $a > 1000} {
7841 set lim [expr {$a + 1000}]
7844 while {[incr a] <= $lim} {
7845 if {[info exists arcend($a)]} {
7846 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7848 puts $f [list $arcstart($a) {} $arcids($a)]
7853 catch {file delete $allccache}
7854 #puts "writing cache failed ($err)"
7857 set cachearc [expr {$a - 1}]
7858 if {$a > $cachedarcs} {
7867 global nextarc cachedarcs cachearc allccache
7869 if {$nextarc == $cachedarcs} return
7871 set cachedarcs $nextarc
7873 set f [open $allccache w]
7874 puts $f [list 1 $cachedarcs]
7879 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7880 # or 0 if neither is true.
7881 proc anc_or_desc {a b} {
7882 global arcout arcstart arcend arcnos cached_isanc
7884 if {$arcnos($a) eq $arcnos($b)} {
7885 # Both are on the same arc(s); either both are the same BMP,
7886 # or if one is not a BMP, the other is also not a BMP or is
7887 # the BMP at end of the arc (and it only has 1 incoming arc).
7888 # Or both can be BMPs with no incoming arcs.
7889 if {$a eq $b || $arcnos($a) eq {}} {
7892 # assert {[llength $arcnos($a)] == 1}
7893 set arc [lindex $arcnos($a) 0]
7894 set i [lsearch -exact $arcids($arc) $a]
7895 set j [lsearch -exact $arcids($arc) $b]
7896 if {$i < 0 || $i > $j} {
7903 if {![info exists arcout($a)]} {
7904 set arc [lindex $arcnos($a) 0]
7905 if {[info exists arcend($arc)]} {
7906 set aend $arcend($arc)
7910 set a $arcstart($arc)
7914 if {![info exists arcout($b)]} {
7915 set arc [lindex $arcnos($b) 0]
7916 if {[info exists arcend($arc)]} {
7917 set bend $arcend($arc)
7921 set b $arcstart($arc)
7931 if {[info exists cached_isanc($a,$bend)]} {
7932 if {$cached_isanc($a,$bend)} {
7936 if {[info exists cached_isanc($b,$aend)]} {
7937 if {$cached_isanc($b,$aend)} {
7940 if {[info exists cached_isanc($a,$bend)]} {
7945 set todo [list $a $b]
7948 for {set i 0} {$i < [llength $todo]} {incr i} {
7949 set x [lindex $todo $i]
7950 if {$anc($x) eq {}} {
7953 foreach arc $arcnos($x) {
7954 set xd $arcstart($arc)
7956 set cached_isanc($a,$bend) 1
7957 set cached_isanc($b,$aend) 0
7959 } elseif {$xd eq $aend} {
7960 set cached_isanc($b,$aend) 1
7961 set cached_isanc($a,$bend) 0
7964 if {![info exists anc($xd)]} {
7965 set anc($xd) $anc($x)
7967 } elseif {$anc($xd) ne $anc($x)} {
7972 set cached_isanc($a,$bend) 0
7973 set cached_isanc($b,$aend) 0
7977 # This identifies whether $desc has an ancestor that is
7978 # a growing tip of the graph and which is not an ancestor of $anc
7979 # and returns 0 if so and 1 if not.
7980 # If we subsequently discover a tag on such a growing tip, and that
7981 # turns out to be a descendent of $anc (which it could, since we
7982 # don't necessarily see children before parents), then $desc
7983 # isn't a good choice to display as a descendent tag of
7984 # $anc (since it is the descendent of another tag which is
7985 # a descendent of $anc). Similarly, $anc isn't a good choice to
7986 # display as a ancestor tag of $desc.
7988 proc is_certain {desc anc} {
7989 global arcnos arcout arcstart arcend growing problems
7992 if {[llength $arcnos($anc)] == 1} {
7993 # tags on the same arc are certain
7994 if {$arcnos($desc) eq $arcnos($anc)} {
7997 if {![info exists arcout($anc)]} {
7998 # if $anc is partway along an arc, use the start of the arc instead
7999 set a [lindex $arcnos($anc) 0]
8000 set anc $arcstart($a)
8003 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8006 set a [lindex $arcnos($desc) 0]
8012 set anclist [list $x]
8016 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8017 set x [lindex $anclist $i]
8022 foreach a $arcout($x) {
8023 if {[info exists growing($a)]} {
8024 if {![info exists growanc($x)] && $dl($x)} {
8030 if {[info exists dl($y)]} {
8034 if {![info exists done($y)]} {
8037 if {[info exists growanc($x)]} {
8041 for {set k 0} {$k < [llength $xl]} {incr k} {
8042 set z [lindex $xl $k]
8043 foreach c $arcout($z) {
8044 if {[info exists arcend($c)]} {
8046 if {[info exists dl($v)] && $dl($v)} {
8048 if {![info exists done($v)]} {
8051 if {[info exists growanc($v)]} {
8061 } elseif {$y eq $anc || !$dl($x)} {
8072 foreach x [array names growanc] {
8081 proc validate_arctags {a} {
8082 global arctags idtags
8086 foreach id $arctags($a) {
8088 if {![info exists idtags($id)]} {
8089 set na [lreplace $na $i $i]
8096 proc validate_archeads {a} {
8097 global archeads idheads
8100 set na $archeads($a)
8101 foreach id $archeads($a) {
8103 if {![info exists idheads($id)]} {
8104 set na [lreplace $na $i $i]
8108 set archeads($a) $na
8111 # Return the list of IDs that have tags that are descendents of id,
8112 # ignoring IDs that are descendents of IDs already reported.
8113 proc desctags {id} {
8114 global arcnos arcstart arcids arctags idtags allparents
8115 global growing cached_dtags
8117 if {![info exists allparents($id)]} {
8120 set t1 [clock clicks -milliseconds]
8122 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8123 # part-way along an arc; check that arc first
8124 set a [lindex $arcnos($id) 0]
8125 if {$arctags($a) ne {}} {
8127 set i [lsearch -exact $arcids($a) $id]
8129 foreach t $arctags($a) {
8130 set j [lsearch -exact $arcids($a) $t]
8138 set id $arcstart($a)
8139 if {[info exists idtags($id)]} {
8143 if {[info exists cached_dtags($id)]} {
8144 return $cached_dtags($id)
8151 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8152 set id [lindex $todo $i]
8154 set ta [info exists hastaggedancestor($id)]
8158 # ignore tags on starting node
8159 if {!$ta && $i > 0} {
8160 if {[info exists idtags($id)]} {
8163 } elseif {[info exists cached_dtags($id)]} {
8164 set tagloc($id) $cached_dtags($id)
8168 foreach a $arcnos($id) {
8170 if {!$ta && $arctags($a) ne {}} {
8172 if {$arctags($a) ne {}} {
8173 lappend tagloc($id) [lindex $arctags($a) end]
8176 if {$ta || $arctags($a) ne {}} {
8177 set tomark [list $d]
8178 for {set j 0} {$j < [llength $tomark]} {incr j} {
8179 set dd [lindex $tomark $j]
8180 if {![info exists hastaggedancestor($dd)]} {
8181 if {[info exists done($dd)]} {
8182 foreach b $arcnos($dd) {
8183 lappend tomark $arcstart($b)
8185 if {[info exists tagloc($dd)]} {
8188 } elseif {[info exists queued($dd)]} {
8191 set hastaggedancestor($dd) 1
8195 if {![info exists queued($d)]} {
8198 if {![info exists hastaggedancestor($d)]} {
8205 foreach id [array names tagloc] {
8206 if {![info exists hastaggedancestor($id)]} {
8207 foreach t $tagloc($id) {
8208 if {[lsearch -exact $tags $t] < 0} {
8214 set t2 [clock clicks -milliseconds]
8217 # remove tags that are descendents of other tags
8218 for {set i 0} {$i < [llength $tags]} {incr i} {
8219 set a [lindex $tags $i]
8220 for {set j 0} {$j < $i} {incr j} {
8221 set b [lindex $tags $j]
8222 set r [anc_or_desc $a $b]
8224 set tags [lreplace $tags $j $j]
8227 } elseif {$r == -1} {
8228 set tags [lreplace $tags $i $i]
8235 if {[array names growing] ne {}} {
8236 # graph isn't finished, need to check if any tag could get
8237 # eclipsed by another tag coming later. Simply ignore any
8238 # tags that could later get eclipsed.
8241 if {[is_certain $t $origid]} {
8245 if {$tags eq $ctags} {
8246 set cached_dtags($origid) $tags
8251 set cached_dtags($origid) $tags
8253 set t3 [clock clicks -milliseconds]
8254 if {0 && $t3 - $t1 >= 100} {
8255 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8256 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8262 global arcnos arcids arcout arcend arctags idtags allparents
8263 global growing cached_atags
8265 if {![info exists allparents($id)]} {
8268 set t1 [clock clicks -milliseconds]
8270 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8271 # part-way along an arc; check that arc first
8272 set a [lindex $arcnos($id) 0]
8273 if {$arctags($a) ne {}} {
8275 set i [lsearch -exact $arcids($a) $id]
8276 foreach t $arctags($a) {
8277 set j [lsearch -exact $arcids($a) $t]
8283 if {![info exists arcend($a)]} {
8287 if {[info exists idtags($id)]} {
8291 if {[info exists cached_atags($id)]} {
8292 return $cached_atags($id)
8300 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8301 set id [lindex $todo $i]
8303 set td [info exists hastaggeddescendent($id)]
8307 # ignore tags on starting node
8308 if {!$td && $i > 0} {
8309 if {[info exists idtags($id)]} {
8312 } elseif {[info exists cached_atags($id)]} {
8313 set tagloc($id) $cached_atags($id)
8317 foreach a $arcout($id) {
8318 if {!$td && $arctags($a) ne {}} {
8320 if {$arctags($a) ne {}} {
8321 lappend tagloc($id) [lindex $arctags($a) 0]
8324 if {![info exists arcend($a)]} continue
8326 if {$td || $arctags($a) ne {}} {
8327 set tomark [list $d]
8328 for {set j 0} {$j < [llength $tomark]} {incr j} {
8329 set dd [lindex $tomark $j]
8330 if {![info exists hastaggeddescendent($dd)]} {
8331 if {[info exists done($dd)]} {
8332 foreach b $arcout($dd) {
8333 if {[info exists arcend($b)]} {
8334 lappend tomark $arcend($b)
8337 if {[info exists tagloc($dd)]} {
8340 } elseif {[info exists queued($dd)]} {
8343 set hastaggeddescendent($dd) 1
8347 if {![info exists queued($d)]} {
8350 if {![info exists hastaggeddescendent($d)]} {
8356 set t2 [clock clicks -milliseconds]
8359 foreach id [array names tagloc] {
8360 if {![info exists hastaggeddescendent($id)]} {
8361 foreach t $tagloc($id) {
8362 if {[lsearch -exact $tags $t] < 0} {
8369 # remove tags that are ancestors of other tags
8370 for {set i 0} {$i < [llength $tags]} {incr i} {
8371 set a [lindex $tags $i]
8372 for {set j 0} {$j < $i} {incr j} {
8373 set b [lindex $tags $j]
8374 set r [anc_or_desc $a $b]
8376 set tags [lreplace $tags $j $j]
8379 } elseif {$r == 1} {
8380 set tags [lreplace $tags $i $i]
8387 if {[array names growing] ne {}} {
8388 # graph isn't finished, need to check if any tag could get
8389 # eclipsed by another tag coming later. Simply ignore any
8390 # tags that could later get eclipsed.
8393 if {[is_certain $origid $t]} {
8397 if {$tags eq $ctags} {
8398 set cached_atags($origid) $tags
8403 set cached_atags($origid) $tags
8405 set t3 [clock clicks -milliseconds]
8406 if {0 && $t3 - $t1 >= 100} {
8407 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8408 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8413 # Return the list of IDs that have heads that are descendents of id,
8414 # including id itself if it has a head.
8415 proc descheads {id} {
8416 global arcnos arcstart arcids archeads idheads cached_dheads
8419 if {![info exists allparents($id)]} {
8423 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8424 # part-way along an arc; check it first
8425 set a [lindex $arcnos($id) 0]
8426 if {$archeads($a) ne {}} {
8427 validate_archeads $a
8428 set i [lsearch -exact $arcids($a) $id]
8429 foreach t $archeads($a) {
8430 set j [lsearch -exact $arcids($a) $t]
8435 set id $arcstart($a)
8441 for {set i 0} {$i < [llength $todo]} {incr i} {
8442 set id [lindex $todo $i]
8443 if {[info exists cached_dheads($id)]} {
8444 set ret [concat $ret $cached_dheads($id)]
8446 if {[info exists idheads($id)]} {
8449 foreach a $arcnos($id) {
8450 if {$archeads($a) ne {}} {
8451 validate_archeads $a
8452 if {$archeads($a) ne {}} {
8453 set ret [concat $ret $archeads($a)]
8457 if {![info exists seen($d)]} {
8464 set ret [lsort -unique $ret]
8465 set cached_dheads($origid) $ret
8466 return [concat $ret $aret]
8469 proc addedtag {id} {
8470 global arcnos arcout cached_dtags cached_atags
8472 if {![info exists arcnos($id)]} return
8473 if {![info exists arcout($id)]} {
8474 recalcarc [lindex $arcnos($id) 0]
8476 catch {unset cached_dtags}
8477 catch {unset cached_atags}
8480 proc addedhead {hid head} {
8481 global arcnos arcout cached_dheads
8483 if {![info exists arcnos($hid)]} return
8484 if {![info exists arcout($hid)]} {
8485 recalcarc [lindex $arcnos($hid) 0]
8487 catch {unset cached_dheads}
8490 proc removedhead {hid head} {
8491 global cached_dheads
8493 catch {unset cached_dheads}
8496 proc movedhead {hid head} {
8497 global arcnos arcout cached_dheads
8499 if {![info exists arcnos($hid)]} return
8500 if {![info exists arcout($hid)]} {
8501 recalcarc [lindex $arcnos($hid) 0]
8503 catch {unset cached_dheads}
8506 proc changedrefs {} {
8507 global cached_dheads cached_dtags cached_atags
8508 global arctags archeads arcnos arcout idheads idtags
8510 foreach id [concat [array names idheads] [array names idtags]] {
8511 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8512 set a [lindex $arcnos($id) 0]
8513 if {![info exists donearc($a)]} {
8519 catch {unset cached_dtags}
8520 catch {unset cached_atags}
8521 catch {unset cached_dheads}
8524 proc rereadrefs {} {
8525 global idtags idheads idotherrefs mainheadid
8527 set refids [concat [array names idtags] \
8528 [array names idheads] [array names idotherrefs]]
8529 foreach id $refids {
8530 if {![info exists ref($id)]} {
8531 set ref($id) [listrefs $id]
8534 set oldmainhead $mainheadid
8537 set refids [lsort -unique [concat $refids [array names idtags] \
8538 [array names idheads] [array names idotherrefs]]]
8539 foreach id $refids {
8540 set v [listrefs $id]
8541 if {![info exists ref($id)] || $ref($id) != $v ||
8542 ($id eq $oldmainhead && $id ne $mainheadid) ||
8543 ($id eq $mainheadid && $id ne $oldmainhead)} {
8550 proc listrefs {id} {
8551 global idtags idheads idotherrefs
8554 if {[info exists idtags($id)]} {
8558 if {[info exists idheads($id)]} {
8562 if {[info exists idotherrefs($id)]} {
8563 set z $idotherrefs($id)
8565 return [list $x $y $z]
8568 proc showtag {tag isnew} {
8569 global ctext tagcontents tagids linknum tagobjid
8572 addtohistory [list showtag $tag 0]
8574 $ctext conf -state normal
8578 if {![info exists tagcontents($tag)]} {
8580 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8583 if {[info exists tagcontents($tag)]} {
8584 set text $tagcontents($tag)
8586 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8588 appendwithlinks $text {}
8589 $ctext conf -state disabled
8600 proc mkfontdisp {font top which} {
8601 global fontattr fontpref $font
8603 set fontpref($font) [set $font]
8604 button $top.${font}but -text $which -font optionfont \
8605 -command [list choosefont $font $which]
8606 label $top.$font -relief flat -font $font \
8607 -text $fontattr($font,family) -justify left
8608 grid x $top.${font}but $top.$font -sticky w
8611 proc choosefont {font which} {
8612 global fontparam fontlist fonttop fontattr
8614 set fontparam(which) $which
8615 set fontparam(font) $font
8616 set fontparam(family) [font actual $font -family]
8617 set fontparam(size) $fontattr($font,size)
8618 set fontparam(weight) $fontattr($font,weight)
8619 set fontparam(slant) $fontattr($font,slant)
8622 if {![winfo exists $top]} {
8624 eval font config sample [font actual $font]
8626 wm title $top [mc "Gitk font chooser"]
8627 label $top.l -textvariable fontparam(which)
8628 pack $top.l -side top
8629 set fontlist [lsort [font families]]
8631 listbox $top.f.fam -listvariable fontlist \
8632 -yscrollcommand [list $top.f.sb set]
8633 bind $top.f.fam <<ListboxSelect>> selfontfam
8634 scrollbar $top.f.sb -command [list $top.f.fam yview]
8635 pack $top.f.sb -side right -fill y
8636 pack $top.f.fam -side left -fill both -expand 1
8637 pack $top.f -side top -fill both -expand 1
8639 spinbox $top.g.size -from 4 -to 40 -width 4 \
8640 -textvariable fontparam(size) \
8641 -validatecommand {string is integer -strict %s}
8642 checkbutton $top.g.bold -padx 5 \
8643 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8644 -variable fontparam(weight) -onvalue bold -offvalue normal
8645 checkbutton $top.g.ital -padx 5 \
8646 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8647 -variable fontparam(slant) -onvalue italic -offvalue roman
8648 pack $top.g.size $top.g.bold $top.g.ital -side left
8649 pack $top.g -side top
8650 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8652 $top.c create text 100 25 -anchor center -text $which -font sample \
8653 -fill black -tags text
8654 bind $top.c <Configure> [list centertext $top.c]
8655 pack $top.c -side top -fill x
8657 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8658 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8659 grid $top.buts.ok $top.buts.can
8660 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8661 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8662 pack $top.buts -side bottom -fill x
8663 trace add variable fontparam write chg_fontparam
8666 $top.c itemconf text -text $which
8668 set i [lsearch -exact $fontlist $fontparam(family)]
8670 $top.f.fam selection set $i
8675 proc centertext {w} {
8676 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8680 global fontparam fontpref prefstop
8682 set f $fontparam(font)
8683 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8684 if {$fontparam(weight) eq "bold"} {
8685 lappend fontpref($f) "bold"
8687 if {$fontparam(slant) eq "italic"} {
8688 lappend fontpref($f) "italic"
8691 $w conf -text $fontparam(family) -font $fontpref($f)
8697 global fonttop fontparam
8699 if {[info exists fonttop]} {
8700 catch {destroy $fonttop}
8701 catch {font delete sample}
8707 proc selfontfam {} {
8708 global fonttop fontparam
8710 set i [$fonttop.f.fam curselection]
8712 set fontparam(family) [$fonttop.f.fam get $i]
8716 proc chg_fontparam {v sub op} {
8719 font config sample -$sub $fontparam($sub)
8723 global maxwidth maxgraphpct
8724 global oldprefs prefstop showneartags showlocalchanges
8725 global bgcolor fgcolor ctext diffcolors selectbgcolor
8726 global tabstop limitdiffs
8730 if {[winfo exists $top]} {
8734 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8735 limitdiffs tabstop} {
8736 set oldprefs($v) [set $v]
8739 wm title $top [mc "Gitk preferences"]
8740 label $top.ldisp -text [mc "Commit list display options"]
8741 grid $top.ldisp - -sticky w -pady 10
8742 label $top.spacer -text " "
8743 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8745 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8746 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8747 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8749 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8750 grid x $top.maxpctl $top.maxpct -sticky w
8751 frame $top.showlocal
8752 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8753 checkbutton $top.showlocal.b -variable showlocalchanges
8754 pack $top.showlocal.b $top.showlocal.l -side left
8755 grid x $top.showlocal -sticky w
8757 label $top.ddisp -text [mc "Diff display options"]
8758 grid $top.ddisp - -sticky w -pady 10
8759 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8760 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8761 grid x $top.tabstopl $top.tabstop -sticky w
8763 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8764 checkbutton $top.ntag.b -variable showneartags
8765 pack $top.ntag.b $top.ntag.l -side left
8766 grid x $top.ntag -sticky w
8768 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8769 checkbutton $top.ldiff.b -variable limitdiffs
8770 pack $top.ldiff.b $top.ldiff.l -side left
8771 grid x $top.ldiff -sticky w
8773 label $top.cdisp -text [mc "Colors: press to choose"]
8774 grid $top.cdisp - -sticky w -pady 10
8775 label $top.bg -padx 40 -relief sunk -background $bgcolor
8776 button $top.bgbut -text [mc "Background"] -font optionfont \
8777 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8778 grid x $top.bgbut $top.bg -sticky w
8779 label $top.fg -padx 40 -relief sunk -background $fgcolor
8780 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8781 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8782 grid x $top.fgbut $top.fg -sticky w
8783 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8784 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8785 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8786 [list $ctext tag conf d0 -foreground]]
8787 grid x $top.diffoldbut $top.diffold -sticky w
8788 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8789 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8790 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8791 [list $ctext tag conf d1 -foreground]]
8792 grid x $top.diffnewbut $top.diffnew -sticky w
8793 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8794 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8795 -command [list choosecolor diffcolors 2 $top.hunksep \
8796 "diff hunk header" \
8797 [list $ctext tag conf hunksep -foreground]]
8798 grid x $top.hunksepbut $top.hunksep -sticky w
8799 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8800 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8801 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8802 grid x $top.selbgbut $top.selbgsep -sticky w
8804 label $top.cfont -text [mc "Fonts: press to choose"]
8805 grid $top.cfont - -sticky w -pady 10
8806 mkfontdisp mainfont $top [mc "Main font"]
8807 mkfontdisp textfont $top [mc "Diff display font"]
8808 mkfontdisp uifont $top [mc "User interface font"]
8811 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8812 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8813 grid $top.buts.ok $top.buts.can
8814 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8815 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8816 grid $top.buts - - -pady 10 -sticky ew
8817 bind $top <Visibility> "focus $top.buts.ok"
8820 proc choosecolor {v vi w x cmd} {
8823 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8824 -title [mc "Gitk: choose color for %s" $x]]
8825 if {$c eq {}} return
8826 $w conf -background $c
8832 global bglist cflist
8834 $w configure -selectbackground $c
8836 $cflist tag configure highlight \
8837 -background [$cflist cget -selectbackground]
8838 allcanvs itemconf secsel -fill $c
8845 $w conf -background $c
8853 $w conf -foreground $c
8855 allcanvs itemconf text -fill $c
8856 $canv itemconf circle -outline $c
8860 global oldprefs prefstop
8862 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8863 limitdiffs tabstop} {
8865 set $v $oldprefs($v)
8867 catch {destroy $prefstop}
8873 global maxwidth maxgraphpct
8874 global oldprefs prefstop showneartags showlocalchanges
8875 global fontpref mainfont textfont uifont
8876 global limitdiffs treediffs
8878 catch {destroy $prefstop}
8882 if {$mainfont ne $fontpref(mainfont)} {
8883 set mainfont $fontpref(mainfont)
8884 parsefont mainfont $mainfont
8885 eval font configure mainfont [fontflags mainfont]
8886 eval font configure mainfontbold [fontflags mainfont 1]
8890 if {$textfont ne $fontpref(textfont)} {
8891 set textfont $fontpref(textfont)
8892 parsefont textfont $textfont
8893 eval font configure textfont [fontflags textfont]
8894 eval font configure textfontbold [fontflags textfont 1]
8896 if {$uifont ne $fontpref(uifont)} {
8897 set uifont $fontpref(uifont)
8898 parsefont uifont $uifont
8899 eval font configure uifont [fontflags uifont]
8902 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8903 if {$showlocalchanges} {
8909 if {$limitdiffs != $oldprefs(limitdiffs)} {
8910 # treediffs elements are limited by path
8911 catch {unset treediffs}
8913 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8914 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8916 } elseif {$showneartags != $oldprefs(showneartags) ||
8917 $limitdiffs != $oldprefs(limitdiffs)} {
8922 proc formatdate {d} {
8923 global datetimeformat
8925 set d [clock format $d -format $datetimeformat]
8930 # This list of encoding names and aliases is distilled from
8931 # http://www.iana.org/assignments/character-sets.
8932 # Not all of them are supported by Tcl.
8933 set encoding_aliases {
8934 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8935 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8936 { ISO-10646-UTF-1 csISO10646UTF1 }
8937 { ISO_646.basic:1983 ref csISO646basic1983 }
8938 { INVARIANT csINVARIANT }
8939 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8940 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8941 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8942 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8943 { NATS-DANO iso-ir-9-1 csNATSDANO }
8944 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8945 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8946 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8947 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8948 { ISO-2022-KR csISO2022KR }
8950 { ISO-2022-JP csISO2022JP }
8951 { ISO-2022-JP-2 csISO2022JP2 }
8952 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8954 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8955 { IT iso-ir-15 ISO646-IT csISO15Italian }
8956 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8957 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8958 { greek7-old iso-ir-18 csISO18Greek7Old }
8959 { latin-greek iso-ir-19 csISO19LatinGreek }
8960 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8961 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8962 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8963 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8964 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8965 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8966 { INIS iso-ir-49 csISO49INIS }
8967 { INIS-8 iso-ir-50 csISO50INIS8 }
8968 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8969 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8970 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8971 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8972 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8973 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8975 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8976 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8977 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8978 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8979 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8980 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8981 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8982 { greek7 iso-ir-88 csISO88Greek7 }
8983 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8984 { iso-ir-90 csISO90 }
8985 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8986 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8987 csISO92JISC62991984b }
8988 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8989 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8990 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8991 csISO95JIS62291984handadd }
8992 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8993 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8994 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8995 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8997 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8998 { T.61-7bit iso-ir-102 csISO102T617bit }
8999 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9000 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9001 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9002 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9003 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9004 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9005 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9006 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9007 arabic csISOLatinArabic }
9008 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9009 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9010 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9011 greek greek8 csISOLatinGreek }
9012 { T.101-G2 iso-ir-128 csISO128T101G2 }
9013 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9015 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9016 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9017 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9018 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9019 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9020 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9021 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9022 csISOLatinCyrillic }
9023 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9024 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9025 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9026 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9027 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9028 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9029 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9030 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9031 { ISO_10367-box iso-ir-155 csISO10367Box }
9032 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9033 { latin-lap lap iso-ir-158 csISO158Lap }
9034 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9035 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9038 { JIS_X0201 X0201 csHalfWidthKatakana }
9039 { KSC5636 ISO646-KR csKSC5636 }
9040 { ISO-10646-UCS-2 csUnicode }
9041 { ISO-10646-UCS-4 csUCS4 }
9042 { DEC-MCS dec csDECMCS }
9043 { hp-roman8 roman8 r8 csHPRoman8 }
9044 { macintosh mac csMacintosh }
9045 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9047 { IBM038 EBCDIC-INT cp038 csIBM038 }
9048 { IBM273 CP273 csIBM273 }
9049 { IBM274 EBCDIC-BE CP274 csIBM274 }
9050 { IBM275 EBCDIC-BR cp275 csIBM275 }
9051 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9052 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9053 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9054 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9055 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9056 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9057 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9058 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9059 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9060 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9061 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9062 { IBM437 cp437 437 csPC8CodePage437 }
9063 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9064 { IBM775 cp775 csPC775Baltic }
9065 { IBM850 cp850 850 csPC850Multilingual }
9066 { IBM851 cp851 851 csIBM851 }
9067 { IBM852 cp852 852 csPCp852 }
9068 { IBM855 cp855 855 csIBM855 }
9069 { IBM857 cp857 857 csIBM857 }
9070 { IBM860 cp860 860 csIBM860 }
9071 { IBM861 cp861 861 cp-is csIBM861 }
9072 { IBM862 cp862 862 csPC862LatinHebrew }
9073 { IBM863 cp863 863 csIBM863 }
9074 { IBM864 cp864 csIBM864 }
9075 { IBM865 cp865 865 csIBM865 }
9076 { IBM866 cp866 866 csIBM866 }
9077 { IBM868 CP868 cp-ar csIBM868 }
9078 { IBM869 cp869 869 cp-gr csIBM869 }
9079 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9080 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9081 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9082 { IBM891 cp891 csIBM891 }
9083 { IBM903 cp903 csIBM903 }
9084 { IBM904 cp904 904 csIBBM904 }
9085 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9086 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9087 { IBM1026 CP1026 csIBM1026 }
9088 { EBCDIC-AT-DE csIBMEBCDICATDE }
9089 { EBCDIC-AT-DE-A csEBCDICATDEA }
9090 { EBCDIC-CA-FR csEBCDICCAFR }
9091 { EBCDIC-DK-NO csEBCDICDKNO }
9092 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9093 { EBCDIC-FI-SE csEBCDICFISE }
9094 { EBCDIC-FI-SE-A csEBCDICFISEA }
9095 { EBCDIC-FR csEBCDICFR }
9096 { EBCDIC-IT csEBCDICIT }
9097 { EBCDIC-PT csEBCDICPT }
9098 { EBCDIC-ES csEBCDICES }
9099 { EBCDIC-ES-A csEBCDICESA }
9100 { EBCDIC-ES-S csEBCDICESS }
9101 { EBCDIC-UK csEBCDICUK }
9102 { EBCDIC-US csEBCDICUS }
9103 { UNKNOWN-8BIT csUnknown8BiT }
9104 { MNEMONIC csMnemonic }
9109 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9110 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9111 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9112 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9113 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9114 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9115 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9116 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9117 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9118 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9119 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9120 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9121 { IBM1047 IBM-1047 }
9122 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9123 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9124 { UNICODE-1-1 csUnicode11 }
9127 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9128 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9130 { ISO-8859-15 ISO_8859-15 Latin-9 }
9131 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9132 { GBK CP936 MS936 windows-936 }
9133 { JIS_Encoding csJISEncoding }
9134 { Shift_JIS MS_Kanji csShiftJIS }
9135 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9137 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9138 { ISO-10646-UCS-Basic csUnicodeASCII }
9139 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9140 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9141 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9142 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9143 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9144 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9145 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9146 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9147 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9148 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9149 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9150 { Ventura-US csVenturaUS }
9151 { Ventura-International csVenturaInternational }
9152 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9153 { PC8-Turkish csPC8Turkish }
9154 { IBM-Symbols csIBMSymbols }
9155 { IBM-Thai csIBMThai }
9156 { HP-Legal csHPLegal }
9157 { HP-Pi-font csHPPiFont }
9158 { HP-Math8 csHPMath8 }
9159 { Adobe-Symbol-Encoding csHPPSMath }
9160 { HP-DeskTop csHPDesktop }
9161 { Ventura-Math csVenturaMath }
9162 { Microsoft-Publishing csMicrosoftPublishing }
9163 { Windows-31J csWindows31J }
9168 proc tcl_encoding {enc} {
9169 global encoding_aliases
9170 set names [encoding names]
9171 set lcnames [string tolower $names]
9172 set enc [string tolower $enc]
9173 set i [lsearch -exact $lcnames $enc]
9175 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9176 if {[regsub {^iso[-_]} $enc iso encx]} {
9177 set i [lsearch -exact $lcnames $encx]
9181 foreach l $encoding_aliases {
9182 set ll [string tolower $l]
9183 if {[lsearch -exact $ll $enc] < 0} continue
9184 # look through the aliases for one that tcl knows about
9186 set i [lsearch -exact $lcnames $e]
9188 if {[regsub {^iso[-_]} $e iso ex]} {
9189 set i [lsearch -exact $lcnames $ex]
9198 return [lindex $names $i]
9203 # First check that Tcl/Tk is recent enough
9204 if {[catch {package require Tk 8.4} err]} {
9205 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9206 Gitk requires at least Tcl/Tk 8.4."]
9212 set wrcomcmd "git diff-tree --stdin -p --pretty"
9216 set gitencoding [exec git config --get i18n.commitencoding]
9218 if {$gitencoding == ""} {
9219 set gitencoding "utf-8"
9221 set tclencoding [tcl_encoding $gitencoding]
9222 if {$tclencoding == {}} {
9223 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9226 set mainfont {Helvetica 9}
9227 set textfont {Courier 9}
9228 set uifont {Helvetica 9 bold}
9230 set findmergefiles 0
9238 set cmitmode "patch"
9239 set wrapcomment "none"
9243 set showlocalchanges 1
9245 set datetimeformat "%Y-%m-%d %H:%M:%S"
9247 set colors {green red blue magenta darkgrey brown orange}
9250 set diffcolors {red "#00a000" blue}
9253 set selectbgcolor gray85
9255 ## For msgcat loading, first locate the installation location.
9256 if { [info exists ::env(GITK_MSGSDIR)] } {
9257 ## Msgsdir was manually set in the environment.
9258 set gitk_msgsdir $::env(GITK_MSGSDIR)
9260 ## Let's guess the prefix from argv0.
9261 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9262 set gitk_libdir [file join $gitk_prefix share gitk lib]
9263 set gitk_msgsdir [file join $gitk_libdir msgs]
9267 ## Internationalization (i18n) through msgcat and gettext. See
9268 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9269 package require msgcat
9270 namespace import ::msgcat::mc
9271 ## And eventually load the actual message catalog
9272 ::msgcat::mcload $gitk_msgsdir
9274 catch {source ~/.gitk}
9276 font create optionfont -family sans-serif -size -12
9278 parsefont mainfont $mainfont
9279 eval font create mainfont [fontflags mainfont]
9280 eval font create mainfontbold [fontflags mainfont 1]
9282 parsefont textfont $textfont
9283 eval font create textfont [fontflags textfont]
9284 eval font create textfontbold [fontflags textfont 1]
9286 parsefont uifont $uifont
9287 eval font create uifont [fontflags uifont]
9291 # check that we can find a .git directory somewhere...
9292 if {[catch {set gitdir [gitdir]}]} {
9293 show_error {} . [mc "Cannot find a git repository here."]
9296 if {![file isdirectory $gitdir]} {
9297 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9303 set cmdline_files {}
9308 "-d" { set datemode 1 }
9311 lappend revtreeargs $arg
9314 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9318 lappend revtreeargs $arg
9324 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9325 # no -- on command line, but some arguments (other than -d)
9327 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9328 set cmdline_files [split $f "\n"]
9329 set n [llength $cmdline_files]
9330 set revtreeargs [lrange $revtreeargs 0 end-$n]
9331 # Unfortunately git rev-parse doesn't produce an error when
9332 # something is both a revision and a filename. To be consistent
9333 # with git log and git rev-list, check revtreeargs for filenames.
9334 foreach arg $revtreeargs {
9335 if {[file exists $arg]} {
9336 show_error {} . [mc "Ambiguous argument '%s': both revision\
9342 # unfortunately we get both stdout and stderr in $err,
9343 # so look for "fatal:".
9344 set i [string first "fatal:" $err]
9346 set err [string range $err [expr {$i + 6}] end]
9348 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9354 # find the list of unmerged files
9358 set fd [open "| git ls-files -u" r]
9360 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9363 while {[gets $fd line] >= 0} {
9364 set i [string first "\t" $line]
9365 if {$i < 0} continue
9366 set fname [string range $line [expr {$i+1}] end]
9367 if {[lsearch -exact $mlist $fname] >= 0} continue
9369 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9370 lappend mlist $fname
9375 if {$nr_unmerged == 0} {
9376 show_error {} . [mc "No files selected: --merge specified but\
9377 no files are unmerged."]
9379 show_error {} . [mc "No files selected: --merge specified but\
9380 no unmerged files are within file limit."]
9384 set cmdline_files $mlist
9387 set nullid "0000000000000000000000000000000000000000"
9388 set nullid2 "0000000000000000000000000000000000000001"
9390 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9397 set highlight_paths {}
9399 set searchdirn -forwards
9403 set markingmatches 0
9404 set linkentercount 0
9405 set need_redisplay 0
9412 set selectedhlview [mc "None"]
9413 set highlight_related [mc "None"]
9414 set highlight_files {}
9427 # wait for the window to become visible
9429 wm title . "[file tail $argv0]: [file tail [pwd]]"
9432 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9433 # create a view for the files/dirs specified on the command line
9437 set viewname(1) [mc "Command line"]
9438 set viewfiles(1) $cmdline_files
9439 set viewargs(1) $revtreeargs
9442 .bar.view entryconf [mc "Edit view..."] -state normal
9443 .bar.view entryconf [mc "Delete view"] -state normal
9446 if {[info exists permviews]} {
9447 foreach v $permviews {
9450 set viewname($n) [lindex $v 0]
9451 set viewfiles($n) [lindex $v 1]
9452 set viewargs($n) [lindex $v 2]