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 rev-list 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]
612 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
615 if {[info exists targetid
]} {
616 if {![comes_before
$targetid $p]} {
624 proc removefakerow
{id
} {
625 global varcid varccommits parents children commitidx
626 global varctok vtokmod cmitlisted currentid selectedline
627 global targetid curview numcommits
630 if {[llength
$parents($v,$id)] != 1} {
631 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
634 set p
[lindex
$parents($v,$id) 0]
635 set a
$varcid($v,$id)
636 set i
[lsearch
-exact $varccommits($v,$a) $id]
638 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
642 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
643 unset parents
($v,$id)
644 unset children
($v,$id)
645 unset cmitlisted
($v,$id)
646 set numcommits
[incr commitidx
($v) -1]
647 set j
[lsearch
-exact $children($v,$p) $id]
649 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
651 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
654 if {[info exist currentid
] && $id eq
$currentid} {
658 if {[info exists targetid
] && $targetid eq
$id} {
665 proc first_real_child
{vp
} {
666 global children nullid nullid2
668 foreach id
$children($vp) {
669 if {$id ne
$nullid && $id ne
$nullid2} {
676 proc last_real_child
{vp
} {
677 global children nullid nullid2
679 set kids
$children($vp)
680 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
681 set id
[lindex
$kids $i]
682 if {$id ne
$nullid && $id ne
$nullid2} {
689 proc vtokcmp
{v a b
} {
690 global varctok varcid
692 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
693 [lindex
$varctok($v) $varcid($v,$b)]]
696 proc modify_arc
{v a
{lim
{}}} {
697 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
699 set vtokmod
($v) [lindex
$varctok($v) $a]
701 if {$v == $curview} {
702 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
703 set a
[lindex
$vupptr($v) $a]
709 set lim
[llength
$varccommits($v,$a)]
711 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
718 proc update_arcrows
{v
} {
719 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
720 global varcid vrownum varcorder varcix varccommits
721 global vupptr vdownptr vleftptr varctok
722 global displayorder parentlist curview cached_commitrow
724 set narctot
[expr {[llength
$varctok($v)] - 1}]
726 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
727 # go up the tree until we find something that has a row number,
728 # or we get to a seed
729 set a
[lindex
$vupptr($v) $a]
732 set a
[lindex
$vdownptr($v) 0]
735 set varcorder
($v) [list
$a]
737 lset varcrow
($v) $a 0
741 set arcn
[lindex
$varcix($v) $a]
742 # see if a is the last arc; if so, nothing to do
743 if {$arcn == $narctot - 1} {
746 if {[llength
$vrownum($v)] > $arcn + 1} {
747 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
748 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
750 set row
[lindex
$varcrow($v) $a]
752 if {$v == $curview} {
753 if {[llength
$displayorder] > $vrowmod($v)} {
754 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
755 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
757 catch
{unset cached_commitrow
}
761 incr row
[llength
$varccommits($v,$a)]
762 # go down if possible
763 set b
[lindex
$vdownptr($v) $a]
765 # if not, go left, or go up until we can go left
767 set b
[lindex
$vleftptr($v) $a]
769 set a
[lindex
$vupptr($v) $a]
775 lappend vrownum
($v) $row
776 lappend varcorder
($v) $a
777 lset varcix
($v) $a $arcn
778 lset varcrow
($v) $a $row
780 set vtokmod
($v) [lindex
$varctok($v) $p]
783 if {[info exists currentid
]} {
784 set selectedline
[rowofcommit
$currentid]
788 # Test whether view $v contains commit $id
789 proc commitinview
{id v
} {
792 return [info exists varcid
($v,$id)]
795 # Return the row number for commit $id in the current view
796 proc rowofcommit
{id
} {
797 global varcid varccommits varcrow curview cached_commitrow
798 global varctok vtokmod
801 if {![info exists varcid
($v,$id)]} {
802 puts
"oops rowofcommit no arc for [shortids $id]"
805 set a
$varcid($v,$id)
806 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
809 if {[info exists cached_commitrow
($id)]} {
810 return $cached_commitrow($id)
812 set i
[lsearch
-exact $varccommits($v,$a) $id]
814 puts
"oops didn't find commit [shortids $id] in arc $a"
817 incr i
[lindex
$varcrow($v) $a]
818 set cached_commitrow
($id) $i
822 # Returns 1 if a is on an earlier row than b, otherwise 0
823 proc comes_before
{a b
} {
824 global varcid varctok curview
827 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
828 ![info exists varcid
($v,$b)]} {
831 if {$varcid($v,$a) != $varcid($v,$b)} {
832 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
833 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
835 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
838 proc bsearch
{l elt
} {
839 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
844 while {$hi - $lo > 1} {
845 set mid
[expr {int
(($lo + $hi) / 2)}]
846 set t
[lindex
$l $mid]
849 } elseif
{$elt > $t} {
858 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
859 proc make_disporder
{start end
} {
860 global vrownum curview commitidx displayorder parentlist
861 global varccommits varcorder parents vrowmod varcrow
862 global d_valid_start d_valid_end
864 if {$end > $vrowmod($curview)} {
865 update_arcrows
$curview
867 set ai
[bsearch
$vrownum($curview) $start]
868 set start
[lindex
$vrownum($curview) $ai]
869 set narc
[llength
$vrownum($curview)]
870 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
871 set a
[lindex
$varcorder($curview) $ai]
872 set l
[llength
$displayorder]
873 set al
[llength
$varccommits($curview,$a)]
876 set pad
[ntimes
[expr {$r - $l}] {}]
877 set displayorder
[concat
$displayorder $pad]
878 set parentlist
[concat
$parentlist $pad]
880 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
881 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
883 foreach id
$varccommits($curview,$a) {
884 lappend displayorder
$id
885 lappend parentlist
$parents($curview,$id)
887 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
889 foreach id
$varccommits($curview,$a) {
890 lset displayorder
$i $id
891 lset parentlist
$i $parents($curview,$id)
899 proc commitonrow
{row
} {
902 set id
[lindex
$displayorder $row]
904 make_disporder
$row [expr {$row + 1}]
905 set id
[lindex
$displayorder $row]
910 proc closevarcs
{v
} {
911 global varctok varccommits varcid parents children
912 global cmitlisted commitidx commitinterest vtokmod
914 set missing_parents
0
916 set narcs
[llength
$varctok($v)]
917 for {set a
1} {$a < $narcs} {incr a
} {
918 set id
[lindex
$varccommits($v,$a) end
]
919 foreach p
$parents($v,$id) {
920 if {[info exists varcid
($v,$p)]} continue
921 # add p as a new commit
923 set cmitlisted
($v,$p) 0
924 set parents
($v,$p) {}
925 if {[llength
$children($v,$p)] == 1 &&
926 [llength
$parents($v,$id)] == 1} {
929 set b
[newvarc
$v $p]
932 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
935 lappend varccommits
($v,$b) $p
937 if {[info exists commitinterest
($p)]} {
938 foreach
script $commitinterest($p) {
939 lappend scripts
[string map
[list
"%I" $p] $script]
941 unset commitinterest
($id)
945 if {$missing_parents > 0} {
952 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
953 # Assumes we already have an arc for $rwid.
954 proc rewrite_commit
{v id rwid
} {
955 global children parents varcid varctok vtokmod varccommits
957 foreach ch
$children($v,$id) {
958 # make $rwid be $ch's parent in place of $id
959 set i
[lsearch
-exact $parents($v,$ch) $id]
961 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
963 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
964 # add $ch to $rwid's children and sort the list if necessary
965 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
966 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
969 # fix the graph after joining $id to $rwid
970 set a
$varcid($v,$ch)
971 fix_reversal
$rwid $a $v
972 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
973 # parentlist is wrong for the last element of arc $a
974 # even if displayorder is right, hence the 3rd arg here
975 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
980 proc getcommitlines
{fd inst view updating
} {
981 global cmitlisted commitinterest leftover
982 global commitidx commitdata datemode
983 global parents children curview hlview
984 global idpending ordertok
985 global varccommits varcid varctok vtokmod viewfiles
987 set stuff
[read $fd 500000]
988 # git log doesn't terminate the last commit with a null...
989 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
996 global commfd viewcomplete viewactive viewname progresscoords
999 set i
[lsearch
-exact $viewinstances($view) $inst]
1001 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1003 # set it blocking so we wait for the process to terminate
1004 fconfigure
$fd -blocking 1
1005 if {[catch
{close
$fd} err
]} {
1007 if {$view != $curview} {
1008 set fv
" for the \"$viewname($view)\" view"
1010 if {[string range
$err 0 4] == "usage"} {
1011 set err
"Gitk: error reading commits$fv:\
1012 bad arguments to git rev-list."
1013 if {$viewname($view) eq
"Command line"} {
1015 " (Note: arguments to gitk are passed to git rev-list\
1016 to allow selection of commits to be displayed.)"
1019 set err
"Error reading commits$fv: $err"
1023 if {[incr viewactive
($view) -1] <= 0} {
1024 set viewcomplete
($view) 1
1025 # Check if we have seen any ids listed as parents that haven't
1026 # appeared in the list
1029 set progresscoords
{0 0}
1032 if {$view == $curview} {
1041 set i
[string first
"\0" $stuff $start]
1043 append leftover
($inst) [string range
$stuff $start end
]
1047 set cmit
$leftover($inst)
1048 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1049 set leftover
($inst) {}
1051 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1053 set start
[expr {$i + 1}]
1054 set j
[string first
"\n" $cmit]
1057 if {$j >= 0 && [string match
"commit *" $cmit]} {
1058 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1059 if {[string match
{[-^
<>]*} $ids]} {
1060 switch
-- [string index
$ids 0] {
1066 set ids
[string range
$ids 1 end
]
1070 if {[string length
$id] != 40} {
1078 if {[string length
$shortcmit] > 80} {
1079 set shortcmit
"[string range $shortcmit 0 80]..."
1081 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1084 set id [lindex $ids 0]
1087 if {!$listed && $updating && ![info exists varcid($vid)] &&
1088 $viewfiles($view) ne {}} {
1089 # git log doesn't rewrite parents
for unlisted commits
1090 # when doing path limiting, so work around that here
1091 # by working out the rewritten parent with git rev-list
1092 # and if we already know about it, using the rewritten
1093 # parent as a substitute parent for $id's children.
1095 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1096 $id -- $viewfiles($view)]
1098 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1099 # use $rwid in place of $id
1100 rewrite_commit
$view $id $rwid
1107 if {[info exists varcid
($vid)]} {
1108 if {$cmitlisted($vid) ||
!$listed} continue
1112 set olds
[lrange
$ids 1 end
]
1116 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1117 set cmitlisted
($vid) $listed
1118 set parents
($vid) $olds
1119 if {![info exists children
($vid)]} {
1120 set children
($vid) {}
1121 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1122 set k
[lindex
$children($vid) 0]
1123 if {[llength
$parents($view,$k)] == 1 &&
1125 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1126 set a
$varcid($view,$k)
1131 set a
[newvarc
$view $id]
1133 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1136 if {![info exists varcid
($vid)]} {
1138 lappend varccommits
($view,$a) $id
1139 incr commitidx
($view)
1144 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1146 if {[llength
[lappend children
($vp) $id]] > 1 &&
1147 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1148 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1150 catch
{unset ordertok
}
1152 if {[info exists varcid
($view,$p)]} {
1153 fix_reversal
$p $a $view
1159 if {[info exists commitinterest
($id)]} {
1160 foreach
script $commitinterest($id) {
1161 lappend scripts
[string map
[list
"%I" $id] $script]
1163 unset commitinterest
($id)
1168 global numcommits hlview
1170 if {$view == $curview} {
1171 set numcommits
$commitidx($view)
1174 if {[info exists hlview
] && $view == $hlview} {
1175 # we never actually get here...
1178 foreach s
$scripts {
1181 if {$view == $curview} {
1182 # update progress bar
1183 global progressdirn progresscoords proglastnc
1184 set inc
[expr {($commitidx($view) - $proglastnc) * 0.0002}]
1185 set proglastnc
$commitidx($view)
1186 set l
[lindex
$progresscoords 0]
1187 set r
[lindex
$progresscoords 1]
1188 if {$progressdirn} {
1189 set r
[expr {$r + $inc}]
1195 set l
[expr {$r - 0.2}]
1198 set l
[expr {$l - $inc}]
1203 set r
[expr {$l + 0.2}]
1205 set progresscoords
[list
$l $r]
1212 proc chewcommits
{} {
1213 global curview hlview viewcomplete
1214 global pending_select
1217 if {$viewcomplete($curview)} {
1218 global commitidx varctok
1219 global numcommits startmsecs
1220 global mainheadid commitinfo nullid
1222 if {[info exists pending_select
]} {
1223 set row
[first_real_row
]
1226 if {$commitidx($curview) > 0} {
1227 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1228 #puts "overall $ms ms for $numcommits commits"
1229 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1231 show_status
[mc
"No commits selected"]
1238 proc readcommit
{id
} {
1239 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
1240 parsecommit
$id $contents 0
1243 proc parsecommit
{id contents listed
} {
1244 global commitinfo cdate
1253 set hdrend
[string first
"\n\n" $contents]
1255 # should never happen...
1256 set hdrend
[string length
$contents]
1258 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1259 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1260 foreach line
[split $header "\n"] {
1261 set tag
[lindex
$line 0]
1262 if {$tag == "author"} {
1263 set audate
[lindex
$line end-1
]
1264 set auname
[lrange
$line 1 end-2
]
1265 } elseif
{$tag == "committer"} {
1266 set comdate
[lindex
$line end-1
]
1267 set comname
[lrange
$line 1 end-2
]
1271 # take the first non-blank line of the comment as the headline
1272 set headline
[string trimleft
$comment]
1273 set i
[string first
"\n" $headline]
1275 set headline
[string range
$headline 0 $i]
1277 set headline
[string trimright
$headline]
1278 set i
[string first
"\r" $headline]
1280 set headline
[string trimright
[string range
$headline 0 $i]]
1283 # git rev-list indents the comment by 4 spaces;
1284 # if we got this via git cat-file, add the indentation
1286 foreach line
[split $comment "\n"] {
1287 append newcomment
" "
1288 append newcomment
$line
1289 append newcomment
"\n"
1291 set comment
$newcomment
1293 if {$comdate != {}} {
1294 set cdate
($id) $comdate
1296 set commitinfo
($id) [list
$headline $auname $audate \
1297 $comname $comdate $comment]
1300 proc getcommit
{id
} {
1301 global commitdata commitinfo
1303 if {[info exists commitdata
($id)]} {
1304 parsecommit
$id $commitdata($id) 1
1307 if {![info exists commitinfo
($id)]} {
1308 set commitinfo
($id) [list
[mc
"No commit information available"]]
1315 global tagids idtags headids idheads tagobjid
1316 global otherrefids idotherrefs mainhead mainheadid
1318 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1321 set refd
[open
[list | git show-ref
-d] r
]
1322 while {[gets
$refd line
] >= 0} {
1323 if {[string index
$line 40] ne
" "} continue
1324 set id
[string range
$line 0 39]
1325 set ref
[string range
$line 41 end
]
1326 if {![string match
"refs/*" $ref]} continue
1327 set name
[string range
$ref 5 end
]
1328 if {[string match
"remotes/*" $name]} {
1329 if {![string match
"*/HEAD" $name]} {
1330 set headids
($name) $id
1331 lappend idheads
($id) $name
1333 } elseif
{[string match
"heads/*" $name]} {
1334 set name
[string range
$name 6 end
]
1335 set headids
($name) $id
1336 lappend idheads
($id) $name
1337 } elseif
{[string match
"tags/*" $name]} {
1338 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1339 # which is what we want since the former is the commit ID
1340 set name
[string range
$name 5 end
]
1341 if {[string match
"*^{}" $name]} {
1342 set name
[string range
$name 0 end-3
]
1344 set tagobjid
($name) $id
1346 set tagids
($name) $id
1347 lappend idtags
($id) $name
1349 set otherrefids
($name) $id
1350 lappend idotherrefs
($id) $name
1357 set thehead
[exec git symbolic-ref HEAD
]
1358 if {[string match
"refs/heads/*" $thehead]} {
1359 set mainhead
[string range
$thehead 11 end
]
1360 if {[info exists headids
($mainhead)]} {
1361 set mainheadid
$headids($mainhead)
1367 # skip over fake commits
1368 proc first_real_row
{} {
1369 global nullid nullid2 numcommits
1371 for {set row
0} {$row < $numcommits} {incr row
} {
1372 set id
[commitonrow
$row]
1373 if {$id ne
$nullid && $id ne
$nullid2} {
1380 # update things for a head moved to a child of its previous location
1381 proc movehead
{id name
} {
1382 global headids idheads
1384 removehead
$headids($name) $name
1385 set headids
($name) $id
1386 lappend idheads
($id) $name
1389 # update things when a head has been removed
1390 proc removehead
{id name
} {
1391 global headids idheads
1393 if {$idheads($id) eq
$name} {
1396 set i
[lsearch
-exact $idheads($id) $name]
1398 set idheads
($id) [lreplace
$idheads($id) $i $i]
1401 unset headids
($name)
1404 proc show_error
{w top msg
} {
1405 message
$w.m
-text $msg -justify center
-aspect 400
1406 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1407 button
$w.ok
-text [mc OK
] -command "destroy $top"
1408 pack
$w.ok
-side bottom
-fill x
1409 bind $top <Visibility
> "grab $top; focus $top"
1410 bind $top <Key-Return
> "destroy $top"
1414 proc error_popup msg
{
1418 show_error
$w $w $msg
1421 proc confirm_popup msg
{
1427 message
$w.m
-text $msg -justify center
-aspect 400
1428 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1429 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1430 pack
$w.ok
-side left
-fill x
1431 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1432 pack
$w.cancel
-side right
-fill x
1433 bind $w <Visibility
> "grab $w; focus $w"
1438 proc setoptions
{} {
1439 option add
*Panedwindow.showHandle
1 startupFile
1440 option add
*Panedwindow.sashRelief raised startupFile
1441 option add
*Button.font uifont startupFile
1442 option add
*Checkbutton.font uifont startupFile
1443 option add
*Radiobutton.font uifont startupFile
1444 option add
*Menu.font uifont startupFile
1445 option add
*Menubutton.font uifont startupFile
1446 option add
*Label.font uifont startupFile
1447 option add
*Message.font uifont startupFile
1448 option add
*Entry.font uifont startupFile
1451 proc makewindow
{} {
1452 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1454 global findtype findtypemenu findloc findstring fstring geometry
1455 global entries sha1entry sha1string sha1but
1456 global diffcontextstring diffcontext
1458 global maincursor textcursor curtextcursor
1459 global rowctxmenu fakerowmenu mergemax wrapcomment
1460 global highlight_files gdttype
1461 global searchstring sstring
1462 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1463 global headctxmenu progresscanv progressitem progresscoords statusw
1464 global fprogitem fprogcoord lastprogupdate progupdatepending
1465 global rprogitem rprogcoord
1469 .bar add cascade
-label [mc
"File"] -menu .bar.
file
1471 .bar.
file add
command -label [mc
"Update"] -command updatecommits
1472 .bar.
file add
command -label [mc
"Reload"] -command reloadcommits
1473 .bar.
file add
command -label [mc
"Reread references"] -command rereadrefs
1474 .bar.
file add
command -label [mc
"List references"] -command showrefs
1475 .bar.
file add
command -label [mc
"Quit"] -command doquit
1477 .bar add cascade
-label [mc
"Edit"] -menu .bar.edit
1478 .bar.edit add
command -label [mc
"Preferences"] -command doprefs
1481 .bar add cascade
-label [mc
"View"] -menu .bar.view
1482 .bar.view add
command -label [mc
"New view..."] -command {newview
0}
1483 .bar.view add
command -label [mc
"Edit view..."] -command editview \
1485 .bar.view add
command -label [mc
"Delete view"] -command delview
-state disabled
1486 .bar.view add separator
1487 .bar.view add radiobutton
-label [mc
"All files"] -command {showview
0} \
1488 -variable selectedview
-value 0
1491 .bar add cascade
-label [mc
"Help"] -menu .bar.
help
1492 .bar.
help add
command -label [mc
"About gitk"] -command about
1493 .bar.
help add
command -label [mc
"Key bindings"] -command keys
1495 . configure
-menu .bar
1497 # the gui has upper and lower half, parts of a paned window.
1498 panedwindow .ctop
-orient vertical
1500 # possibly use assumed geometry
1501 if {![info exists geometry
(pwsash0
)]} {
1502 set geometry
(topheight
) [expr {15 * $linespc}]
1503 set geometry
(topwidth
) [expr {80 * $charspc}]
1504 set geometry
(botheight
) [expr {15 * $linespc}]
1505 set geometry
(botwidth
) [expr {50 * $charspc}]
1506 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1507 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1510 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1511 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1513 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1515 # create three canvases
1516 set cscroll .tf.histframe.csb
1517 set canv .tf.histframe.pwclist.canv
1519 -selectbackground $selectbgcolor \
1520 -background $bgcolor -bd 0 \
1521 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1522 .tf.histframe.pwclist add
$canv
1523 set canv2 .tf.histframe.pwclist.canv2
1525 -selectbackground $selectbgcolor \
1526 -background $bgcolor -bd 0 -yscrollincr $linespc
1527 .tf.histframe.pwclist add
$canv2
1528 set canv3 .tf.histframe.pwclist.canv3
1530 -selectbackground $selectbgcolor \
1531 -background $bgcolor -bd 0 -yscrollincr $linespc
1532 .tf.histframe.pwclist add
$canv3
1533 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1534 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1536 # a scroll bar to rule them
1537 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1538 pack
$cscroll -side right
-fill y
1539 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1540 lappend bglist
$canv $canv2 $canv3
1541 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1543 # we have two button bars at bottom of top frame. Bar 1
1545 frame .tf.lbar
-height 15
1547 set sha1entry .tf.bar.sha1
1548 set entries
$sha1entry
1549 set sha1but .tf.bar.sha1label
1550 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1551 -command gotocommit
-width 8
1552 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1553 pack .tf.bar.sha1label
-side left
1554 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1555 trace add variable sha1string
write sha1change
1556 pack
$sha1entry -side left
-pady 2
1558 image create bitmap bm-left
-data {
1559 #define left_width 16
1560 #define left_height 16
1561 static unsigned char left_bits
[] = {
1562 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1563 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1564 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1566 image create bitmap bm-right
-data {
1567 #define right_width 16
1568 #define right_height 16
1569 static unsigned char right_bits
[] = {
1570 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1571 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1572 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1574 button .tf.bar.leftbut
-image bm-left
-command goback \
1575 -state disabled
-width 26
1576 pack .tf.bar.leftbut
-side left
-fill y
1577 button .tf.bar.rightbut
-image bm-right
-command goforw \
1578 -state disabled
-width 26
1579 pack .tf.bar.rightbut
-side left
-fill y
1581 # Status label and progress bar
1582 set statusw .tf.bar.status
1583 label
$statusw -width 15 -relief sunken
1584 pack
$statusw -side left
-padx 5
1585 set h
[expr {[font metrics uifont
-linespace] + 2}]
1586 set progresscanv .tf.bar.progress
1587 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1588 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1589 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1590 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1591 pack
$progresscanv -side right
-expand 1 -fill x
1592 set progresscoords
{0 0}
1595 bind $progresscanv <Configure
> adjustprogress
1596 set lastprogupdate
[clock clicks
-milliseconds]
1597 set progupdatepending
0
1599 # build up the bottom bar of upper window
1600 label .tf.lbar.flabel
-text "[mc "Find
"] "
1601 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1602 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1603 label .tf.lbar.flab2
-text " [mc "commit
"] "
1604 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1606 set gdttype
[mc
"containing:"]
1607 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
1608 [mc
"containing:"] \
1609 [mc
"touching paths:"] \
1610 [mc
"adding/removing string:"]]
1611 trace add variable gdttype
write gdttype_change
1612 pack .tf.lbar.gdttype
-side left
-fill y
1615 set fstring .tf.lbar.findstring
1616 lappend entries
$fstring
1617 entry
$fstring -width 30 -font textfont
-textvariable findstring
1618 trace add variable findstring
write find_change
1619 set findtype
[mc
"Exact"]
1620 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
1621 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
1622 trace add variable findtype
write findcom_change
1623 set findloc
[mc
"All fields"]
1624 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
1625 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
1626 trace add variable findloc
write find_change
1627 pack .tf.lbar.findloc
-side right
1628 pack .tf.lbar.findtype
-side right
1629 pack
$fstring -side left
-expand 1 -fill x
1631 # Finish putting the upper half of the viewer together
1632 pack .tf.lbar
-in .tf
-side bottom
-fill x
1633 pack .tf.bar
-in .tf
-side bottom
-fill x
1634 pack .tf.histframe
-fill both
-side top
-expand 1
1636 .ctop paneconfigure .tf
-height $geometry(topheight
)
1637 .ctop paneconfigure .tf
-width $geometry(topwidth
)
1639 # now build up the bottom
1640 panedwindow .pwbottom
-orient horizontal
1642 # lower left, a text box over search bar, scroll bar to the right
1643 # if we know window height, then that will set the lower text height, otherwise
1644 # we set lower text height which will drive window height
1645 if {[info exists geometry
(main
)]} {
1646 frame .bleft
-width $geometry(botwidth
)
1648 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
1653 button .bleft.top.search
-text [mc
"Search"] -command dosearch
1654 pack .bleft.top.search
-side left
-padx 5
1655 set sstring .bleft.top.sstring
1656 entry
$sstring -width 20 -font textfont
-textvariable searchstring
1657 lappend entries
$sstring
1658 trace add variable searchstring
write incrsearch
1659 pack
$sstring -side left
-expand 1 -fill x
1660 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
1661 -command changediffdisp
-variable diffelide
-value {0 0}
1662 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
1663 -command changediffdisp
-variable diffelide
-value {0 1}
1664 radiobutton .bleft.mid.new
-text [mc
"New version"] \
1665 -command changediffdisp
-variable diffelide
-value {1 0}
1666 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
1667 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
1668 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
1669 -from 1 -increment 1 -to 10000000 \
1670 -validate all
-validatecommand "diffcontextvalidate %P" \
1671 -textvariable diffcontextstring
1672 .bleft.mid.diffcontext
set $diffcontext
1673 trace add variable diffcontextstring
write diffcontextchange
1674 lappend entries .bleft.mid.diffcontext
1675 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
1676 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
1677 -command changeignorespace
-variable ignorespace
1678 pack .bleft.mid.ignspace
-side left
-padx 5
1679 set ctext .bleft.ctext
1680 text
$ctext -background $bgcolor -foreground $fgcolor \
1681 -state disabled
-font textfont \
1682 -yscrollcommand scrolltext
-wrap none
1684 $ctext conf
-tabstyle wordprocessor
1686 scrollbar .bleft.sb
-command "$ctext yview"
1687 pack .bleft.top
-side top
-fill x
1688 pack .bleft.mid
-side top
-fill x
1689 pack .bleft.sb
-side right
-fill y
1690 pack
$ctext -side left
-fill both
-expand 1
1691 lappend bglist
$ctext
1692 lappend fglist
$ctext
1694 $ctext tag conf comment
-wrap $wrapcomment
1695 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
1696 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
1697 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
1698 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
1699 $ctext tag conf m0
-fore red
1700 $ctext tag conf m1
-fore blue
1701 $ctext tag conf m2
-fore green
1702 $ctext tag conf m3
-fore purple
1703 $ctext tag conf
m4 -fore brown
1704 $ctext tag conf m5
-fore "#009090"
1705 $ctext tag conf m6
-fore magenta
1706 $ctext tag conf m7
-fore "#808000"
1707 $ctext tag conf m8
-fore "#009000"
1708 $ctext tag conf m9
-fore "#ff0080"
1709 $ctext tag conf m10
-fore cyan
1710 $ctext tag conf m11
-fore "#b07070"
1711 $ctext tag conf m12
-fore "#70b0f0"
1712 $ctext tag conf m13
-fore "#70f0b0"
1713 $ctext tag conf m14
-fore "#f0b070"
1714 $ctext tag conf m15
-fore "#ff70b0"
1715 $ctext tag conf mmax
-fore darkgrey
1717 $ctext tag conf mresult
-font textfontbold
1718 $ctext tag conf msep
-font textfontbold
1719 $ctext tag conf found
-back yellow
1721 .pwbottom add .bleft
1722 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
1727 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
1728 -command reselectline
-variable cmitmode
-value "patch"
1729 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
1730 -command reselectline
-variable cmitmode
-value "tree"
1731 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
1732 pack .bright.mode
-side top
-fill x
1733 set cflist .bright.cfiles
1734 set indent
[font measure mainfont
"nn"]
1736 -selectbackground $selectbgcolor \
1737 -background $bgcolor -foreground $fgcolor \
1739 -tabs [list
$indent [expr {2 * $indent}]] \
1740 -yscrollcommand ".bright.sb set" \
1741 -cursor [. cget
-cursor] \
1742 -spacing1 1 -spacing3 1
1743 lappend bglist
$cflist
1744 lappend fglist
$cflist
1745 scrollbar .bright.sb
-command "$cflist yview"
1746 pack .bright.sb
-side right
-fill y
1747 pack
$cflist -side left
-fill both
-expand 1
1748 $cflist tag configure highlight \
1749 -background [$cflist cget
-selectbackground]
1750 $cflist tag configure bold
-font mainfontbold
1752 .pwbottom add .bright
1755 # restore window position if known
1756 if {[info exists geometry
(main
)]} {
1757 wm geometry .
"$geometry(main)"
1760 if {[tk windowingsystem
] eq
{aqua
}} {
1766 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
1767 pack .ctop
-fill both
-expand 1
1768 bindall
<1> {selcanvline
%W
%x
%y
}
1769 #bindall <B1-Motion> {selcanvline %W %x %y}
1770 if {[tk windowingsystem
] == "win32"} {
1771 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
1772 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
1774 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
1775 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
1776 if {[tk windowingsystem
] eq
"aqua"} {
1777 bindall
<MouseWheel
> {
1778 set delta
[expr {- (%D
)}]
1779 allcanvs yview scroll
$delta units
1783 bindall
<2> "canvscan mark %W %x %y"
1784 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
1785 bindkey
<Home
> selfirstline
1786 bindkey
<End
> sellastline
1787 bind .
<Key-Up
> "selnextline -1"
1788 bind .
<Key-Down
> "selnextline 1"
1789 bind .
<Shift-Key-Up
> "dofind -1 0"
1790 bind .
<Shift-Key-Down
> "dofind 1 0"
1791 bindkey
<Key-Right
> "goforw"
1792 bindkey
<Key-Left
> "goback"
1793 bind .
<Key-Prior
> "selnextpage -1"
1794 bind .
<Key-Next
> "selnextpage 1"
1795 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
1796 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
1797 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
1798 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
1799 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1800 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1801 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
1802 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
1803 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
1804 bindkey p
"selnextline -1"
1805 bindkey n
"selnextline 1"
1808 bindkey i
"selnextline -1"
1809 bindkey k
"selnextline 1"
1812 bindkey b
"$ctext yview scroll -1 pages"
1813 bindkey d
"$ctext yview scroll 18 units"
1814 bindkey u
"$ctext yview scroll -18 units"
1815 bindkey
/ {dofind
1 1}
1816 bindkey
<Key-Return
> {dofind
1 1}
1817 bindkey ?
{dofind
-1 1}
1819 bindkey
<F5
> updatecommits
1820 bind .
<$M1B-q> doquit
1821 bind .
<$M1B-f> {dofind
1 1}
1822 bind .
<$M1B-g> {dofind
1 0}
1823 bind .
<$M1B-r> dosearchback
1824 bind .
<$M1B-s> dosearch
1825 bind .
<$M1B-equal> {incrfont
1}
1826 bind .
<$M1B-plus> {incrfont
1}
1827 bind .
<$M1B-KP_Add> {incrfont
1}
1828 bind .
<$M1B-minus> {incrfont
-1}
1829 bind .
<$M1B-KP_Subtract> {incrfont
-1}
1830 wm protocol . WM_DELETE_WINDOW doquit
1831 bind .
<Button-1
> "click %W"
1832 bind $fstring <Key-Return
> {dofind
1 1}
1833 bind $sha1entry <Key-Return
> gotocommit
1834 bind $sha1entry <<PasteSelection>> clearsha1
1835 bind $cflist <1> {sel_flist %W %x %y; break}
1836 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1837 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1838 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1840 set maincursor [. cget -cursor]
1841 set textcursor [$ctext cget -cursor]
1842 set curtextcursor $textcursor
1844 set rowctxmenu .rowctxmenu
1845 menu $rowctxmenu -tearoff 0
1846 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1847 -command {diffvssel 0}
1848 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1849 -command {diffvssel 1}
1850 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1851 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1852 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1853 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1854 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1856 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1859 set fakerowmenu .fakerowmenu
1860 menu $fakerowmenu -tearoff 0
1861 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1862 -command {diffvssel 0}
1863 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1864 -command {diffvssel 1}
1865 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1866 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1867 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1868 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1870 set headctxmenu .headctxmenu
1871 menu $headctxmenu -tearoff 0
1872 $headctxmenu add command -label [mc "Check out this branch"] \
1874 $headctxmenu add command -label [mc "Remove this branch"] \
1878 set flist_menu .flistctxmenu
1879 menu $flist_menu -tearoff 0
1880 $flist_menu add command -label [mc "Highlight this too"] \
1881 -command {flist_hl 0}
1882 $flist_menu add command -label [mc "Highlight this only"] \
1883 -command {flist_hl 1}
1886 # Windows sends all mouse wheel events to the current focused window, not
1887 # the one where the mouse hovers, so bind those events here and redirect
1888 # to the correct window
1889 proc windows_mousewheel_redirector {W X Y D} {
1890 global canv canv2 canv3
1891 set w [winfo containing -displayof $W $X $Y]
1893 set u [expr {$D < 0 ? 5 : -5}]
1894 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1895 allcanvs yview scroll $u units
1898 $w yview scroll $u units
1904 # mouse-2 makes all windows scan vertically, but only the one
1905 # the cursor is in scans horizontally
1906 proc canvscan {op w x y} {
1907 global canv canv2 canv3
1908 foreach c [list $canv $canv2 $canv3] {
1917 proc scrollcanv {cscroll f0 f1} {
1918 $cscroll set $f0 $f1
1923 # when we make a key binding for the toplevel, make sure
1924 # it doesn't get triggered when that key is pressed in the
1925 # find string entry widget.
1926 proc bindkey {ev script} {
1929 set escript [bind Entry $ev]
1930 if {$escript == {}} {
1931 set escript [bind Entry <Key>]
1933 foreach e $entries {
1934 bind $e $ev "$escript; break"
1938 # set the focus back to the toplevel for any click outside
1941 global ctext entries
1942 foreach e [concat $entries $ctext] {
1943 if {$w == $e} return
1948 # Adjust the progress bar for a change in requested extent or canvas size
1949 proc adjustprogress {} {
1950 global progresscanv progressitem progresscoords
1951 global fprogitem fprogcoord lastprogupdate progupdatepending
1952 global rprogitem rprogcoord
1954 set w [expr {[winfo width $progresscanv] - 4}]
1955 set x0 [expr {$w * [lindex $progresscoords 0]}]
1956 set x1 [expr {$w * [lindex $progresscoords 1]}]
1957 set h [winfo height $progresscanv]
1958 $progresscanv coords $progressitem $x0 0 $x1 $h
1959 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1960 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1961 set now [clock clicks -milliseconds]
1962 if {$now >= $lastprogupdate + 100} {
1963 set progupdatepending 0
1965 } elseif {!$progupdatepending} {
1966 set progupdatepending 1
1967 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1971 proc doprogupdate {} {
1972 global lastprogupdate progupdatepending
1974 if {$progupdatepending} {
1975 set progupdatepending 0
1976 set lastprogupdate [clock clicks -milliseconds]
1981 proc savestuff {w} {
1982 global canv canv2 canv3 mainfont textfont uifont tabstop
1983 global stuffsaved findmergefiles maxgraphpct
1984 global maxwidth showneartags showlocalchanges
1985 global viewname viewfiles viewargs viewperm nextviewnum
1986 global cmitmode wrapcomment datetimeformat limitdiffs
1987 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1989 if {$stuffsaved} return
1990 if {![winfo viewable .]} return
1992 set f [open "~/.gitk-new" w]
1993 puts $f [list set mainfont $mainfont]
1994 puts $f [list set textfont $textfont]
1995 puts $f [list set uifont $uifont]
1996 puts $f [list set tabstop $tabstop]
1997 puts $f [list set findmergefiles $findmergefiles]
1998 puts $f [list set maxgraphpct $maxgraphpct]
1999 puts $f [list set maxwidth $maxwidth]
2000 puts $f [list set cmitmode $cmitmode]
2001 puts $f [list set wrapcomment $wrapcomment]
2002 puts $f [list set showneartags $showneartags]
2003 puts $f [list set showlocalchanges $showlocalchanges]
2004 puts $f [list set datetimeformat $datetimeformat]
2005 puts $f [list set limitdiffs $limitdiffs]
2006 puts $f [list set bgcolor $bgcolor]
2007 puts $f [list set fgcolor $fgcolor]
2008 puts $f [list set colors $colors]
2009 puts $f [list set diffcolors $diffcolors]
2010 puts $f [list set diffcontext $diffcontext]
2011 puts $f [list set selectbgcolor $selectbgcolor]
2013 puts $f "set geometry(main) [wm geometry .]"
2014 puts $f "set geometry(topwidth) [winfo width .tf]"
2015 puts $f "set geometry(topheight) [winfo height .tf]"
2016 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2017 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2018 puts $f "set geometry(botwidth) [winfo width .bleft]"
2019 puts $f "set geometry(botheight) [winfo height .bleft]"
2021 puts -nonewline $f "set permviews {"
2022 for {set v 0} {$v < $nextviewnum} {incr v} {
2023 if {$viewperm($v)} {
2024 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
2029 file rename -force "~/.gitk-new" "~/.gitk"
2034 proc resizeclistpanes {win w} {
2036 if {[info exists oldwidth($win)]} {
2037 set s0 [$win sash coord 0]
2038 set s1 [$win sash coord 1]
2040 set sash0 [expr {int($w/2 - 2)}]
2041 set sash1 [expr {int($w*5/6 - 2)}]
2043 set factor [expr {1.0 * $w / $oldwidth($win)}]
2044 set sash0 [expr {int($factor * [lindex $s0 0])}]
2045 set sash1 [expr {int($factor * [lindex $s1 0])}]
2049 if {$sash1 < $sash0 + 20} {
2050 set sash1 [expr {$sash0 + 20}]
2052 if {$sash1 > $w - 10} {
2053 set sash1 [expr {$w - 10}]
2054 if {$sash0 > $sash1 - 20} {
2055 set sash0 [expr {$sash1 - 20}]
2059 $win sash place 0 $sash0 [lindex $s0 1]
2060 $win sash place 1 $sash1 [lindex $s1 1]
2062 set oldwidth($win) $w
2065 proc resizecdetpanes {win w} {
2067 if {[info exists oldwidth($win)]} {
2068 set s0 [$win sash coord 0]
2070 set sash0 [expr {int($w*3/4 - 2)}]
2072 set factor [expr {1.0 * $w / $oldwidth($win)}]
2073 set sash0 [expr {int($factor * [lindex $s0 0])}]
2077 if {$sash0 > $w - 15} {
2078 set sash0 [expr {$w - 15}]
2081 $win sash place 0 $sash0 [lindex $s0 1]
2083 set oldwidth($win) $w
2086 proc allcanvs args {
2087 global canv canv2 canv3
2093 proc bindall {event action} {
2094 global canv canv2 canv3
2095 bind $canv $event $action
2096 bind $canv2 $event $action
2097 bind $canv3 $event $action
2103 if {[winfo exists $w]} {
2108 wm title $w [mc "About gitk"]
2109 message $w.m -text [mc "
2110 Gitk - a commit viewer for git
2112 Copyright © 2005-2006 Paul Mackerras
2114 Use and redistribute under the terms of the GNU General Public License"] \
2115 -justify center -aspect 400 -border 2 -bg white -relief groove
2116 pack $w.m -side top -fill x -padx 2 -pady 2
2117 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2118 pack $w.ok -side bottom
2119 bind $w <Visibility> "focus $w.ok"
2120 bind $w <Key-Escape> "destroy $w"
2121 bind $w <Key-Return> "destroy $w"
2126 if {[winfo exists $w]} {
2130 if {[tk windowingsystem] eq {aqua}} {
2136 wm title $w [mc "Gitk key bindings"]
2137 message $w.m -text "
2138 [mc "Gitk key bindings:"]
2140 [mc "<%s-Q> Quit" $M1T]
2141 [mc "<Home> Move to first commit"]
2142 [mc "<End> Move to last commit"]
2143 [mc "<Up>, p, i Move up one commit"]
2144 [mc "<Down>, n, k Move down one commit"]
2145 [mc "<Left>, z, j Go back in history list"]
2146 [mc "<Right>, x, l Go forward in history list"]
2147 [mc "<PageUp> Move up one page in commit list"]
2148 [mc "<PageDown> Move down one page in commit list"]
2149 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2150 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2151 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2152 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2153 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2154 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2155 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2156 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2157 [mc "<Delete>, b Scroll diff view up one page"]
2158 [mc "<Backspace> Scroll diff view up one page"]
2159 [mc "<Space> Scroll diff view down one page"]
2160 [mc "u Scroll diff view up 18 lines"]
2161 [mc "d Scroll diff view down 18 lines"]
2162 [mc "<%s-F> Find" $M1T]
2163 [mc "<%s-G> Move to next find hit" $M1T]
2164 [mc "<Return> Move to next find hit"]
2165 [mc "/ Move to next find hit, or redo find"]
2166 [mc "? Move to previous find hit"]
2167 [mc "f Scroll diff view to next file"]
2168 [mc "<%s-S> Search for next hit in diff view" $M1T]
2169 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2170 [mc "<%s-KP+> Increase font size" $M1T]
2171 [mc "<%s-plus> Increase font size" $M1T]
2172 [mc "<%s-KP-> Decrease font size" $M1T]
2173 [mc "<%s-minus> Decrease font size" $M1T]
2176 -justify left -bg white -border 2 -relief groove
2177 pack $w.m -side top -fill both -padx 2 -pady 2
2178 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2179 pack $w.ok -side bottom
2180 bind $w <Visibility> "focus $w.ok"
2181 bind $w <Key-Escape> "destroy $w"
2182 bind $w <Key-Return> "destroy $w"
2185 # Procedures for manipulating the file list window at the
2186 # bottom right of the overall window.
2188 proc treeview {w l openlevs} {
2189 global treecontents treediropen treeheight treeparent treeindex
2199 set treecontents() {}
2200 $w conf -state normal
2202 while {[string range $f 0 $prefixend] ne $prefix} {
2203 if {$lev <= $openlevs} {
2204 $w mark set e:$treeindex($prefix) "end -1c"
2205 $w mark gravity e:$treeindex($prefix) left
2207 set treeheight($prefix) $ht
2208 incr ht [lindex $htstack end]
2209 set htstack [lreplace $htstack end end]
2210 set prefixend [lindex $prefendstack end]
2211 set prefendstack [lreplace $prefendstack end end]
2212 set prefix [string range $prefix 0 $prefixend]
2215 set tail [string range $f [expr {$prefixend+1}] end]
2216 while {[set slash [string first "/" $tail]] >= 0} {
2219 lappend prefendstack $prefixend
2220 incr prefixend [expr {$slash + 1}]
2221 set d [string range $tail 0 $slash]
2222 lappend treecontents($prefix) $d
2223 set oldprefix $prefix
2225 set treecontents($prefix) {}
2226 set treeindex($prefix) [incr ix]
2227 set treeparent($prefix) $oldprefix
2228 set tail [string range $tail [expr {$slash+1}] end]
2229 if {$lev <= $openlevs} {
2231 set treediropen($prefix) [expr {$lev < $openlevs}]
2232 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2233 $w mark set d:$ix "end -1c"
2234 $w mark gravity d:$ix left
2236 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2238 $w image create end -align center -image $bm -padx 1 \
2240 $w insert end $d [highlight_tag $prefix]
2241 $w mark set s:$ix "end -1c"
2242 $w mark gravity s:$ix left
2247 if {$lev <= $openlevs} {
2250 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2252 $w insert end $tail [highlight_tag $f]
2254 lappend treecontents($prefix) $tail
2257 while {$htstack ne {}} {
2258 set treeheight($prefix) $ht
2259 incr ht [lindex $htstack end]
2260 set htstack [lreplace $htstack end end]
2261 set prefixend [lindex $prefendstack end]
2262 set prefendstack [lreplace $prefendstack end end]
2263 set prefix [string range $prefix 0 $prefixend]
2265 $w conf -state disabled
2268 proc linetoelt {l} {
2269 global treeheight treecontents
2274 foreach e $treecontents($prefix) {
2279 if {[string index $e end] eq "/"} {
2280 set n $treeheight($prefix$e)
2292 proc highlight_tree {y prefix} {
2293 global treeheight treecontents cflist
2295 foreach e $treecontents($prefix) {
2297 if {[highlight_tag $path] ne {}} {
2298 $cflist tag add bold $y.0 "$y.0 lineend"
2301 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2302 set y [highlight_tree $y $path]
2308 proc treeclosedir {w dir} {
2309 global treediropen treeheight treeparent treeindex
2311 set ix $treeindex($dir)
2312 $w conf -state normal
2313 $w delete s:$ix e:$ix
2314 set treediropen($dir) 0
2315 $w image configure a:$ix -image tri-rt
2316 $w conf -state disabled
2317 set n [expr {1 - $treeheight($dir)}]
2318 while {$dir ne {}} {
2319 incr treeheight($dir) $n
2320 set dir $treeparent($dir)
2324 proc treeopendir {w dir} {
2325 global treediropen treeheight treeparent treecontents treeindex
2327 set ix $treeindex($dir)
2328 $w conf -state normal
2329 $w image configure a:$ix -image tri-dn
2330 $w mark set e:$ix s:$ix
2331 $w mark gravity e:$ix right
2334 set n [llength $treecontents($dir)]
2335 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2338 incr treeheight($x) $n
2340 foreach e $treecontents($dir) {
2342 if {[string index $e end] eq "/"} {
2343 set iy $treeindex($de)
2344 $w mark set d:$iy e:$ix
2345 $w mark gravity d:$iy left
2346 $w insert e:$ix $str
2347 set treediropen($de) 0
2348 $w image create e:$ix -align center -image tri-rt -padx 1 \
2350 $w insert e:$ix $e [highlight_tag $de]
2351 $w mark set s:$iy e:$ix
2352 $w mark gravity s:$iy left
2353 set treeheight($de) 1
2355 $w insert e:$ix $str
2356 $w insert e:$ix $e [highlight_tag $de]
2359 $w mark gravity e:$ix left
2360 $w conf -state disabled
2361 set treediropen($dir) 1
2362 set top [lindex [split [$w index @0,0] .] 0]
2363 set ht [$w cget -height]
2364 set l [lindex [split [$w index s:$ix] .] 0]
2367 } elseif {$l + $n + 1 > $top + $ht} {
2368 set top [expr {$l + $n + 2 - $ht}]
2376 proc treeclick {w x y} {
2377 global treediropen cmitmode ctext cflist cflist_top
2379 if {$cmitmode ne "tree"} return
2380 if {![info exists cflist_top]} return
2381 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2382 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2383 $cflist tag add highlight $l.0 "$l.0 lineend"
2389 set e [linetoelt $l]
2390 if {[string index $e end] ne "/"} {
2392 } elseif {$treediropen($e)} {
2399 proc setfilelist {id} {
2400 global treefilelist cflist
2402 treeview $cflist $treefilelist($id) 0
2405 image create bitmap tri-rt -background black -foreground blue -data {
2406 #define tri-rt_width 13
2407 #define tri-rt_height 13
2408 static unsigned char tri-rt_bits[] = {
2409 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2410 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2413 #define tri-rt-mask_width 13
2414 #define tri-rt-mask_height 13
2415 static unsigned char tri-rt-mask_bits[] = {
2416 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2417 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2420 image create bitmap tri-dn -background black -foreground blue -data {
2421 #define tri-dn_width 13
2422 #define tri-dn_height 13
2423 static unsigned char tri-dn_bits[] = {
2424 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2425 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2428 #define tri-dn-mask_width 13
2429 #define tri-dn-mask_height 13
2430 static unsigned char tri-dn-mask_bits[] = {
2431 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2432 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2436 image create bitmap reficon-T -background black -foreground yellow -data {
2437 #define tagicon_width 13
2438 #define tagicon_height 9
2439 static unsigned char tagicon_bits[] = {
2440 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2441 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2443 #define tagicon-mask_width 13
2444 #define tagicon-mask_height 9
2445 static unsigned char tagicon-mask_bits[] = {
2446 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2447 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2450 #define headicon_width 13
2451 #define headicon_height 9
2452 static unsigned char headicon_bits[] = {
2453 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2454 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2457 #define headicon-mask_width 13
2458 #define headicon-mask_height 9
2459 static unsigned char headicon-mask_bits[] = {
2460 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2461 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2463 image create bitmap reficon-H -background black -foreground green \
2464 -data $rectdata -maskdata $rectmask
2465 image create bitmap reficon-o -background black -foreground "#ddddff" \
2466 -data $rectdata -maskdata $rectmask
2468 proc init_flist {first} {
2469 global cflist cflist_top difffilestart
2471 $cflist conf -state normal
2472 $cflist delete 0.0 end
2474 $cflist insert end $first
2476 $cflist tag add highlight 1.0 "1.0 lineend"
2478 catch {unset cflist_top}
2480 $cflist conf -state disabled
2481 set difffilestart {}
2484 proc highlight_tag {f} {
2485 global highlight_paths
2487 foreach p $highlight_paths {
2488 if {[string match $p $f]} {
2495 proc highlight_filelist {} {
2496 global cmitmode cflist
2498 $cflist conf -state normal
2499 if {$cmitmode ne "tree"} {
2500 set end [lindex [split [$cflist index end] .] 0]
2501 for {set l 2} {$l < $end} {incr l} {
2502 set line [$cflist get $l.0 "$l.0 lineend"]
2503 if {[highlight_tag $line] ne {}} {
2504 $cflist tag add bold $l.0 "$l.0 lineend"
2510 $cflist conf -state disabled
2513 proc unhighlight_filelist {} {
2516 $cflist conf -state normal
2517 $cflist tag remove bold 1.0 end
2518 $cflist conf -state disabled
2521 proc add_flist {fl} {
2524 $cflist conf -state normal
2526 $cflist insert end "\n"
2527 $cflist insert end $f [highlight_tag $f]
2529 $cflist conf -state disabled
2532 proc sel_flist {w x y} {
2533 global ctext difffilestart cflist cflist_top cmitmode
2535 if {$cmitmode eq "tree"} return
2536 if {![info exists cflist_top]} return
2537 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2538 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2539 $cflist tag add highlight $l.0 "$l.0 lineend"
2544 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2548 proc pop_flist_menu {w X Y x y} {
2549 global ctext cflist cmitmode flist_menu flist_menu_file
2550 global treediffs diffids
2553 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2555 if {$cmitmode eq "tree"} {
2556 set e [linetoelt $l]
2557 if {[string index $e end] eq "/"} return
2559 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2561 set flist_menu_file $e
2562 tk_popup $flist_menu $X $Y
2565 proc flist_hl {only} {
2566 global flist_menu_file findstring gdttype
2568 set x [shellquote $flist_menu_file]
2569 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2572 append findstring " " $x
2574 set gdttype [mc "touching paths:"]
2577 # Functions for adding and removing shell-type quoting
2579 proc shellquote {str} {
2580 if {![string match "*\['\"\\ \t]*" $str]} {
2583 if {![string match "*\['\"\\]*" $str]} {
2586 if {![string match "*'*" $str]} {
2589 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2592 proc shellarglist {l} {
2598 append str [shellquote $a]
2603 proc shelldequote {str} {
2608 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2609 append ret [string range $str $used end]
2610 set used [string length $str]
2613 set first [lindex $first 0]
2614 set ch [string index $str $first]
2615 if {$first > $used} {
2616 append ret [string range $str $used [expr {$first - 1}]]
2619 if {$ch eq " " || $ch eq "\t"} break
2622 set first [string first "'" $str $used]
2624 error "unmatched single-quote"
2626 append ret [string range $str $used [expr {$first - 1}]]
2631 if {$used >= [string length $str]} {
2632 error "trailing backslash"
2634 append ret [string index $str $used]
2639 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2640 error "unmatched double-quote"
2642 set first [lindex $first 0]
2643 set ch [string index $str $first]
2644 if {$first > $used} {
2645 append ret [string range $str $used [expr {$first - 1}]]
2648 if {$ch eq "\""} break
2650 append ret [string index $str $used]
2654 return [list $used $ret]
2657 proc shellsplit {str} {
2660 set str [string trimleft $str]
2661 if {$str eq {}} break
2662 set dq [shelldequote $str]
2663 set n [lindex $dq 0]
2664 set word [lindex $dq 1]
2665 set str [string range $str $n end]
2671 # Code to implement multiple views
2673 proc newview {ishighlight} {
2674 global nextviewnum newviewname newviewperm newishighlight
2675 global newviewargs revtreeargs
2677 set newishighlight $ishighlight
2679 if {[winfo exists $top]} {
2683 set newviewname($nextviewnum) "View $nextviewnum"
2684 set newviewperm($nextviewnum) 0
2685 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2686 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2691 global viewname viewperm newviewname newviewperm
2692 global viewargs newviewargs
2694 set top .gitkvedit-$curview
2695 if {[winfo exists $top]} {
2699 set newviewname($curview) $viewname($curview)
2700 set newviewperm($curview) $viewperm($curview)
2701 set newviewargs($curview) [shellarglist $viewargs($curview)]
2702 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2705 proc vieweditor {top n title} {
2706 global newviewname newviewperm viewfiles bgcolor
2709 wm title $top $title
2710 label $top.nl -text [mc "Name"]
2711 entry $top.name -width 20 -textvariable newviewname($n)
2712 grid $top.nl $top.name -sticky w -pady 5
2713 checkbutton $top.perm -text [mc "Remember this view"] \
2714 -variable newviewperm($n)
2715 grid $top.perm - -pady 5 -sticky w
2716 message $top.al -aspect 1000 \
2717 -text [mc "Commits to include (arguments to git rev-list):"]
2718 grid $top.al - -sticky w -pady 5
2719 entry $top.args -width 50 -textvariable newviewargs($n) \
2720 -background $bgcolor
2721 grid $top.args - -sticky ew -padx 5
2722 message $top.l -aspect 1000 \
2723 -text [mc "Enter files and directories to include, one per line:"]
2724 grid $top.l - -sticky w
2725 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2726 if {[info exists viewfiles($n)]} {
2727 foreach f $viewfiles($n) {
2728 $top.t insert end $f
2729 $top.t insert end "\n"
2731 $top.t delete {end - 1c} end
2732 $top.t mark set insert 0.0
2734 grid $top.t - -sticky ew -padx 5
2736 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2737 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2738 grid $top.buts.ok $top.buts.can
2739 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2740 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2741 grid $top.buts - -pady 10 -sticky ew
2745 proc doviewmenu {m first cmd op argv} {
2746 set nmenu [$m index end]
2747 for {set i $first} {$i <= $nmenu} {incr i} {
2748 if {[$m entrycget $i -command] eq $cmd} {
2749 eval $m $op $i $argv
2755 proc allviewmenus {n op args} {
2758 doviewmenu .bar.view 5 [list showview $n] $op $args
2759 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2762 proc newviewok {top n} {
2763 global nextviewnum newviewperm newviewname newishighlight
2764 global viewname viewfiles viewperm selectedview curview
2765 global viewargs newviewargs viewhlmenu
2768 set newargs [shellsplit $newviewargs($n)]
2770 error_popup "[mc "Error in commit selection arguments:"] $err"
2776 foreach f [split [$top.t get 0.0 end] "\n"] {
2777 set ft [string trim $f]
2782 if {![info exists viewfiles($n)]} {
2783 # creating a new view
2785 set viewname($n) $newviewname($n)
2786 set viewperm($n) $newviewperm($n)
2787 set viewfiles($n) $files
2788 set viewargs($n) $newargs
2790 if {!$newishighlight} {
2793 run addvhighlight $n
2796 # editing an existing view
2797 set viewperm($n) $newviewperm($n)
2798 if {$newviewname($n) ne $viewname($n)} {
2799 set viewname($n) $newviewname($n)
2800 doviewmenu .bar.view 5 [list showview $n] \
2801 entryconf [list -label $viewname($n)]
2802 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2803 # entryconf [list -label $viewname($n) -value $viewname($n)]
2805 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2806 set viewfiles($n) $files
2807 set viewargs($n) $newargs
2808 if {$curview == $n} {
2813 catch {destroy $top}
2817 global curview viewperm hlview selectedhlview
2819 if {$curview == 0} return
2820 if {[info exists hlview] && $hlview == $curview} {
2821 set selectedhlview [mc "None"]
2824 allviewmenus $curview delete
2825 set viewperm($curview) 0
2829 proc addviewmenu {n} {
2830 global viewname viewhlmenu
2832 .bar.view add radiobutton -label $viewname($n) \
2833 -command [list showview $n] -variable selectedview -value $n
2834 #$viewhlmenu add radiobutton -label $viewname($n) \
2835 # -command [list addvhighlight $n] -variable selectedhlview
2839 global curview viewfiles cached_commitrow ordertok
2840 global displayorder parentlist rowidlist rowisopt rowfinal
2841 global colormap rowtextx nextcolor canvxmax
2842 global numcommits viewcomplete
2843 global selectedline currentid canv canvy0
2845 global pending_select mainheadid
2848 global hlview selectedhlview commitinterest
2850 if {$n == $curview} return
2852 set ymax [lindex [$canv cget -scrollregion] 3]
2853 set span [$canv yview]
2854 set ytop [expr {[lindex $span 0] * $ymax}]
2855 set ybot [expr {[lindex $span 1] * $ymax}]
2856 set yscreen [expr {($ybot - $ytop) / 2}]
2857 if {[info exists selectedline]} {
2858 set selid $currentid
2859 set y [yc $selectedline]
2860 if {$ytop < $y && $y < $ybot} {
2861 set yscreen [expr {$y - $ytop}]
2863 } elseif {[info exists pending_select]} {
2864 set selid $pending_select
2865 unset pending_select
2869 catch {unset treediffs}
2871 if {[info exists hlview] && $hlview == $n} {
2873 set selectedhlview [mc "None"]
2875 catch {unset commitinterest}
2876 catch {unset cached_commitrow}
2877 catch {unset ordertok}
2881 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2882 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2885 if {![info exists viewcomplete($n)]} {
2887 set pending_select $selid
2898 set numcommits $commitidx($n)
2900 catch {unset colormap}
2901 catch {unset rowtextx}
2903 set canvxmax [$canv cget -width]
2909 if {$selid ne {} && [commitinview $selid $n]} {
2910 set row [rowofcommit $selid]
2911 # try to get the selected row in the same position on the screen
2912 set ymax [lindex [$canv cget -scrollregion] 3]
2913 set ytop [expr {[yc $row] - $yscreen}]
2917 set yf [expr {$ytop * 1.0 / $ymax}]
2919 allcanvs yview moveto $yf
2923 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
2924 selectline [rowofcommit $mainheadid] 1
2925 } elseif {!$viewcomplete($n)} {
2927 set pending_select $selid
2929 set pending_select $mainheadid
2932 set row [first_real_row]
2933 if {$row < $numcommits} {
2937 if {!$viewcomplete($n)} {
2938 if {$numcommits == 0} {
2939 show_status [mc "Reading commits..."]
2941 } elseif {$numcommits == 0} {
2942 show_status [mc "No commits selected"]
2946 # Stuff relating to the highlighting facility
2948 proc ishighlighted {id} {
2949 global vhighlights fhighlights nhighlights rhighlights
2951 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
2952 return $nhighlights($id)
2954 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
2955 return $vhighlights($id)
2957 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
2958 return $fhighlights($id)
2960 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
2961 return $rhighlights($id)
2966 proc bolden {row font} {
2967 global canv linehtag selectedline boldrows
2969 lappend boldrows $row
2970 $canv itemconf $linehtag($row) -font $font
2971 if {[info exists selectedline] && $row == $selectedline} {
2973 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2974 -outline {{}} -tags secsel \
2975 -fill [$canv cget -selectbackground]]
2980 proc bolden_name {row font} {
2981 global canv2 linentag selectedline boldnamerows
2983 lappend boldnamerows $row
2984 $canv2 itemconf $linentag($row) -font $font
2985 if {[info exists selectedline] && $row == $selectedline} {
2986 $canv2 delete secsel
2987 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2988 -outline {{}} -tags secsel \
2989 -fill [$canv2 cget -selectbackground]]
2998 foreach row $boldrows {
2999 if {![ishighlighted [commitonrow $row]]} {
3000 bolden $row mainfont
3002 lappend stillbold $row
3005 set boldrows $stillbold
3008 proc addvhighlight {n} {
3009 global hlview viewcomplete curview vhl_done commitidx
3011 if {[info exists hlview]} {
3015 if {$n != $curview && ![info exists viewcomplete($n)]} {
3018 set vhl_done $commitidx($hlview)
3019 if {$vhl_done > 0} {
3024 proc delvhighlight {} {
3025 global hlview vhighlights
3027 if {![info exists hlview]} return
3029 catch {unset vhighlights}
3033 proc vhighlightmore {} {
3034 global hlview vhl_done commitidx vhighlights curview
3036 set max $commitidx($hlview)
3037 set vr [visiblerows]
3038 set r0 [lindex $vr 0]
3039 set r1 [lindex $vr 1]
3040 for {set i $vhl_done} {$i < $max} {incr i} {
3041 set id [commitonrow $i $hlview]
3042 if {[commitinview $id $curview]} {
3043 set row [rowofcommit $id]
3044 if {$r0 <= $row && $row <= $r1} {
3045 if {![highlighted $row]} {
3046 bolden $row mainfontbold
3048 set vhighlights($id) 1
3056 proc askvhighlight {row id} {
3057 global hlview vhighlights iddrawn
3059 if {[commitinview $id $hlview]} {
3060 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3061 bolden $row mainfontbold
3063 set vhighlights($id) 1
3065 set vhighlights($id) 0
3069 proc hfiles_change {} {
3070 global highlight_files filehighlight fhighlights fh_serial
3071 global highlight_paths gdttype
3073 if {[info exists filehighlight]} {
3074 # delete previous highlights
3075 catch {close $filehighlight}
3077 catch {unset fhighlights}
3079 unhighlight_filelist
3081 set highlight_paths {}
3082 after cancel do_file_hl $fh_serial
3084 if {$highlight_files ne {}} {
3085 after 300 do_file_hl $fh_serial
3089 proc gdttype_change {name ix op} {
3090 global gdttype highlight_files findstring findpattern
3093 if {$findstring ne {}} {
3094 if {$gdttype eq [mc "containing:"]} {
3095 if {$highlight_files ne {}} {
3096 set highlight_files {}
3101 if {$findpattern ne {}} {
3105 set highlight_files $findstring
3110 # enable/disable findtype/findloc menus too
3113 proc find_change {name ix op} {
3114 global gdttype findstring highlight_files
3117 if {$gdttype eq [mc "containing:"]} {
3120 if {$highlight_files ne $findstring} {
3121 set highlight_files $findstring
3128 proc findcom_change args {
3129 global nhighlights boldnamerows
3130 global findpattern findtype findstring gdttype
3133 # delete previous highlights, if any
3134 foreach row $boldnamerows {
3135 bolden_name $row mainfont
3138 catch {unset nhighlights}
3141 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3143 } elseif {$findtype eq [mc "Regexp"]} {
3144 set findpattern $findstring
3146 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3148 set findpattern "*$e*"
3152 proc makepatterns {l} {
3155 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3156 if {[string index $ee end] eq "/"} {
3166 proc do_file_hl {serial} {
3167 global highlight_files filehighlight highlight_paths gdttype fhl_list
3169 if {$gdttype eq [mc "touching paths:"]} {
3170 if {[catch {set paths [shellsplit $highlight_files]}]} return
3171 set highlight_paths [makepatterns $paths]
3173 set gdtargs [concat -- $paths]
3174 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3175 set gdtargs [list "-S$highlight_files"]
3177 # must be "containing:", i.e. we're searching commit info
3180 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3181 set filehighlight [open $cmd r+]
3182 fconfigure $filehighlight -blocking 0
3183 filerun $filehighlight readfhighlight
3189 proc flushhighlights {} {
3190 global filehighlight fhl_list
3192 if {[info exists filehighlight]} {
3194 puts $filehighlight ""
3195 flush $filehighlight
3199 proc askfilehighlight {row id} {
3200 global filehighlight fhighlights fhl_list
3202 lappend fhl_list $id
3203 set fhighlights($id) -1
3204 puts $filehighlight $id
3207 proc readfhighlight {} {
3208 global filehighlight fhighlights curview iddrawn
3209 global fhl_list find_dirn
3211 if {![info exists filehighlight]} {
3215 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3216 set line [string trim $line]
3217 set i [lsearch -exact $fhl_list $line]
3218 if {$i < 0} continue
3219 for {set j 0} {$j < $i} {incr j} {
3220 set id [lindex $fhl_list $j]
3221 set fhighlights($id) 0
3223 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3224 if {$line eq {}} continue
3225 if {![commitinview $line $curview]} continue
3226 set row [rowofcommit $line]
3227 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3228 bolden $row mainfontbold
3230 set fhighlights($line) 1
3232 if {[eof $filehighlight]} {
3234 puts "oops, git diff-tree died"
3235 catch {close $filehighlight}
3239 if {[info exists find_dirn]} {
3245 proc doesmatch {f} {
3246 global findtype findpattern
3248 if {$findtype eq [mc "Regexp"]} {
3249 return [regexp $findpattern $f]
3250 } elseif {$findtype eq [mc "IgnCase"]} {
3251 return [string match -nocase $findpattern $f]
3253 return [string match $findpattern $f]
3257 proc askfindhighlight {row id} {
3258 global nhighlights commitinfo iddrawn
3260 global markingmatches
3262 if {![info exists commitinfo($id)]} {
3265 set info $commitinfo($id)
3267 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3268 foreach f $info ty $fldtypes {
3269 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3271 if {$ty eq [mc "Author"]} {
3278 if {$isbold && [info exists iddrawn($id)]} {
3279 if {![ishighlighted $id]} {
3280 bolden $row mainfontbold
3282 bolden_name $row mainfontbold
3285 if {$markingmatches} {
3286 markrowmatches $row $id
3289 set nhighlights($id) $isbold
3292 proc markrowmatches {row id} {
3293 global canv canv2 linehtag linentag commitinfo findloc
3295 set headline [lindex $commitinfo($id) 0]
3296 set author [lindex $commitinfo($id) 1]
3297 $canv delete match$row
3298 $canv2 delete match$row
3299 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3300 set m [findmatches $headline]
3302 markmatches $canv $row $headline $linehtag($row) $m \
3303 [$canv itemcget $linehtag($row) -font] $row
3306 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3307 set m [findmatches $author]
3309 markmatches $canv2 $row $author $linentag($row) $m \
3310 [$canv2 itemcget $linentag($row) -font] $row
3315 proc vrel_change {name ix op} {
3316 global highlight_related
3319 if {$highlight_related ne [mc "None"]} {
3324 # prepare for testing whether commits are descendents or ancestors of a
3325 proc rhighlight_sel {a} {
3326 global descendent desc_todo ancestor anc_todo
3327 global highlight_related
3329 catch {unset descendent}
3330 set desc_todo [list $a]
3331 catch {unset ancestor}
3332 set anc_todo [list $a]
3333 if {$highlight_related ne [mc "None"]} {
3339 proc rhighlight_none {} {
3342 catch {unset rhighlights}
3346 proc is_descendent {a} {
3347 global curview children descendent desc_todo
3350 set la [rowofcommit $a]
3354 for {set i 0} {$i < [llength $todo]} {incr i} {
3355 set do [lindex $todo $i]
3356 if {[rowofcommit $do] < $la} {
3357 lappend leftover $do
3360 foreach nk $children($v,$do) {
3361 if {![info exists descendent($nk)]} {
3362 set descendent($nk) 1
3370 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3374 set descendent($a) 0
3375 set desc_todo $leftover
3378 proc is_ancestor {a} {
3379 global curview parents ancestor anc_todo
3382 set la [rowofcommit $a]
3386 for {set i 0} {$i < [llength $todo]} {incr i} {
3387 set do [lindex $todo $i]
3388 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3389 lappend leftover $do
3392 foreach np $parents($v,$do) {
3393 if {![info exists ancestor($np)]} {
3402 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3407 set anc_todo $leftover
3410 proc askrelhighlight {row id} {
3411 global descendent highlight_related iddrawn rhighlights
3412 global selectedline ancestor
3414 if {![info exists selectedline]} return
3416 if {$highlight_related eq [mc "Descendant"] ||
3417 $highlight_related eq [mc "Not descendant"]} {
3418 if {![info exists descendent($id)]} {
3421 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3424 } elseif {$highlight_related eq [mc "Ancestor"] ||
3425 $highlight_related eq [mc "Not ancestor"]} {
3426 if {![info exists ancestor($id)]} {
3429 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3433 if {[info exists iddrawn($id)]} {
3434 if {$isbold && ![ishighlighted $id]} {
3435 bolden $row mainfontbold
3438 set rhighlights($id) $isbold
3441 # Graph layout functions
3443 proc shortids {ids} {
3446 if {[llength $id] > 1} {
3447 lappend res [shortids $id]
3448 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3449 lappend res [string range $id 0 7]
3460 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3461 if {($n & $mask) != 0} {
3462 set ret [concat $ret $o]
3464 set o [concat $o $o]
3469 proc ordertoken {id} {
3470 global ordertok curview varcid varcstart varctok curview parents children
3471 global nullid nullid2
3473 if {[info exists ordertok($id)]} {
3474 return $ordertok($id)
3479 if {[info exists varcid($curview,$id)]} {
3480 set a $varcid($curview,$id)
3481 set p [lindex $varcstart($curview) $a]
3483 set p [lindex $children($curview,$id) 0]
3485 if {[info exists ordertok($p)]} {
3486 set tok $ordertok($p)
3489 set id [first_real_child $curview,$p]
3492 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3495 if {[llength $parents($curview,$id)] == 1} {
3496 lappend todo [list $p {}]
3498 set j [lsearch -exact $parents($curview,$id) $p]
3500 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3502 lappend todo [list $p [strrep $j]]
3505 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3506 set p [lindex $todo $i 0]
3507 append tok [lindex $todo $i 1]
3508 set ordertok($p) $tok
3510 set ordertok($origid) $tok
3514 # Work out where id should go in idlist so that order-token
3515 # values increase from left to right
3516 proc idcol {idlist id {i 0}} {
3517 set t [ordertoken $id]
3521 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3522 if {$i > [llength $idlist]} {
3523 set i [llength $idlist]
3525 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3528 if {$t > [ordertoken [lindex $idlist $i]]} {
3529 while {[incr i] < [llength $idlist] &&
3530 $t >= [ordertoken [lindex $idlist $i]]} {}
3536 proc initlayout {} {
3537 global rowidlist rowisopt rowfinal displayorder parentlist
3538 global numcommits canvxmax canv
3540 global colormap rowtextx
3549 set canvxmax [$canv cget -width]
3550 catch {unset colormap}
3551 catch {unset rowtextx}
3555 proc setcanvscroll {} {
3556 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3557 global lastscrollset lastscrollrows
3559 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3560 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3561 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3562 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3563 set lastscrollset [clock clicks -milliseconds]
3564 set lastscrollrows $numcommits
3567 proc visiblerows {} {
3568 global canv numcommits linespc
3570 set ymax [lindex [$canv cget -scrollregion] 3]
3571 if {$ymax eq {} || $ymax == 0} return
3573 set y0 [expr {int([lindex $f 0] * $ymax)}]
3574 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3578 set y1 [expr {int([lindex $f 1] * $ymax)}]
3579 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3580 if {$r1 >= $numcommits} {
3581 set r1 [expr {$numcommits - 1}]
3583 return [list $r0 $r1]
3586 proc layoutmore {} {
3587 global commitidx viewcomplete curview
3588 global numcommits pending_select selectedline curview
3589 global lastscrollset lastscrollrows commitinterest
3591 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
3592 [clock clicks -milliseconds] - $lastscrollset > 500} {
3595 if {[info exists pending_select] &&
3596 [commitinview $pending_select $curview]} {
3597 selectline [rowofcommit $pending_select] 1
3602 proc doshowlocalchanges {} {
3603 global curview mainheadid
3605 if {[commitinview $mainheadid $curview]} {
3608 lappend commitinterest($mainheadid) {dodiffindex}
3612 proc dohidelocalchanges {} {
3613 global nullid nullid2 lserial curview
3615 if {[commitinview $nullid $curview]} {
3616 removefakerow $nullid
3618 if {[commitinview $nullid2 $curview]} {
3619 removefakerow $nullid2
3624 # spawn off a process to do git diff-index --cached HEAD
3625 proc dodiffindex {} {
3626 global lserial showlocalchanges
3628 if {!$showlocalchanges} return
3630 set fd [open "|git diff-index --cached HEAD" r]
3631 fconfigure $fd -blocking 0
3632 filerun $fd [list readdiffindex $fd $lserial]
3635 proc readdiffindex {fd serial} {
3636 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3639 if {[gets $fd line] < 0} {
3645 # we only need to see one line and we don't really care what it says...
3648 if {$serial != $lserial} {
3652 # now see if there are any local changes not checked in to the index
3653 set fd [open "|git diff-files" r]
3654 fconfigure $fd -blocking 0
3655 filerun $fd [list readdifffiles $fd $serial]
3657 if {$isdiff && ![commitinview $nullid2 $curview]} {
3658 # add the line for the changes in the index to the graph
3659 set hl [mc "Local changes checked in to index but not committed"]
3660 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3661 set commitdata($nullid2) "\n $hl\n"
3662 if {[commitinview $nullid $curview]} {
3663 removefakerow $nullid
3665 insertfakerow $nullid2 $mainheadid
3666 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3667 removefakerow $nullid2
3672 proc readdifffiles {fd serial} {
3673 global mainheadid nullid nullid2 curview
3674 global commitinfo commitdata lserial
3677 if {[gets $fd line] < 0} {
3683 # we only need to see one line and we don't really care what it says...
3686 if {$serial != $lserial} {
3690 if {$isdiff && ![commitinview $nullid $curview]} {
3691 # add the line for the local diff to the graph
3692 set hl [mc "Local uncommitted changes, not checked in to index"]
3693 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3694 set commitdata($nullid) "\n $hl\n"
3695 if {[commitinview $nullid2 $curview]} {
3700 insertfakerow $nullid $p
3701 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3702 removefakerow $nullid
3707 proc nextuse {id row} {
3708 global curview children
3710 if {[info exists children($curview,$id)]} {
3711 foreach kid $children($curview,$id) {
3712 if {![commitinview $kid $curview]} {
3715 if {[rowofcommit $kid] > $row} {
3716 return [rowofcommit $kid]
3720 if {[commitinview $id $curview]} {
3721 return [rowofcommit $id]
3726 proc prevuse {id row} {
3727 global curview children
3730 if {[info exists children($curview,$id)]} {
3731 foreach kid $children($curview,$id) {
3732 if {![commitinview $kid $curview]} break
3733 if {[rowofcommit $kid] < $row} {
3734 set ret [rowofcommit $kid]
3741 proc make_idlist {row} {
3742 global displayorder parentlist uparrowlen downarrowlen mingaplen
3743 global commitidx curview children
3745 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3749 set ra [expr {$row - $downarrowlen}]
3753 set rb [expr {$row + $uparrowlen}]
3754 if {$rb > $commitidx($curview)} {
3755 set rb $commitidx($curview)
3757 make_disporder $r [expr {$rb + 1}]
3759 for {} {$r < $ra} {incr r} {
3760 set nextid [lindex $displayorder [expr {$r + 1}]]
3761 foreach p [lindex $parentlist $r] {
3762 if {$p eq $nextid} continue
3763 set rn [nextuse $p $r]
3765 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3766 lappend ids [list [ordertoken $p] $p]
3770 for {} {$r < $row} {incr r} {
3771 set nextid [lindex $displayorder [expr {$r + 1}]]
3772 foreach p [lindex $parentlist $r] {
3773 if {$p eq $nextid} continue
3774 set rn [nextuse $p $r]
3775 if {$rn < 0 || $rn >= $row} {
3776 lappend ids [list [ordertoken $p] $p]
3780 set id [lindex $displayorder $row]
3781 lappend ids [list [ordertoken $id] $id]
3783 foreach p [lindex $parentlist $r] {
3784 set firstkid [lindex $children($curview,$p) 0]
3785 if {[rowofcommit $firstkid] < $row} {
3786 lappend ids [list [ordertoken $p] $p]
3790 set id [lindex $displayorder $r]
3792 set firstkid [lindex $children($curview,$id) 0]
3793 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3794 lappend ids [list [ordertoken $id] $id]
3799 foreach idx [lsort -unique $ids] {
3800 lappend idlist [lindex $idx 1]
3805 proc rowsequal {a b} {
3806 while {[set i [lsearch -exact $a {}]] >= 0} {
3807 set a [lreplace $a $i $i]
3809 while {[set i [lsearch -exact $b {}]] >= 0} {
3810 set b [lreplace $b $i $i]
3812 return [expr {$a eq $b}]
3815 proc makeupline {id row rend col} {
3816 global rowidlist uparrowlen downarrowlen mingaplen
3818 for {set r $rend} {1} {set r $rstart} {
3819 set rstart [prevuse $id $r]
3820 if {$rstart < 0} return
3821 if {$rstart < $row} break
3823 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3824 set rstart [expr {$rend - $uparrowlen - 1}]
3826 for {set r $rstart} {[incr r] <= $row} {} {
3827 set idlist [lindex $rowidlist $r]
3828 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3829 set col [idcol $idlist $id $col]
3830 lset rowidlist $r [linsert $idlist $col $id]
3836 proc layoutrows {row endrow} {
3837 global rowidlist rowisopt rowfinal displayorder
3838 global uparrowlen downarrowlen maxwidth mingaplen
3839 global children parentlist
3840 global commitidx viewcomplete curview
3842 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3845 set rm1 [expr {$row - 1}]
3846 foreach id [lindex $rowidlist $rm1] {
3851 set final [lindex $rowfinal $rm1]
3853 for {} {$row < $endrow} {incr row} {
3854 set rm1 [expr {$row - 1}]
3855 if {$rm1 < 0 || $idlist eq {}} {
3856 set idlist [make_idlist $row]
3859 set id [lindex $displayorder $rm1]
3860 set col [lsearch -exact $idlist $id]
3861 set idlist [lreplace $idlist $col $col]
3862 foreach p [lindex $parentlist $rm1] {
3863 if {[lsearch -exact $idlist $p] < 0} {
3864 set col [idcol $idlist $p $col]
3865 set idlist [linsert $idlist $col $p]
3866 # if not the first child, we have to insert a line going up
3867 if {$id ne [lindex $children($curview,$p) 0]} {
3868 makeupline $p $rm1 $row $col
3872 set id [lindex $displayorder $row]
3873 if {$row > $downarrowlen} {
3874 set termrow [expr {$row - $downarrowlen - 1}]
3875 foreach p [lindex $parentlist $termrow] {
3876 set i [lsearch -exact $idlist $p]
3877 if {$i < 0} continue
3878 set nr [nextuse $p $termrow]
3879 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3880 set idlist [lreplace $idlist $i $i]
3884 set col [lsearch -exact $idlist $id]
3886 set col [idcol $idlist $id]
3887 set idlist [linsert $idlist $col $id]
3888 if {$children($curview,$id) ne {}} {
3889 makeupline $id $rm1 $row $col
3892 set r [expr {$row + $uparrowlen - 1}]
3893 if {$r < $commitidx($curview)} {
3895 foreach p [lindex $parentlist $r] {
3896 if {[lsearch -exact $idlist $p] >= 0} continue
3897 set fk [lindex $children($curview,$p) 0]
3898 if {[rowofcommit $fk] < $row} {
3899 set x [idcol $idlist $p $x]
3900 set idlist [linsert $idlist $x $p]
3903 if {[incr r] < $commitidx($curview)} {
3904 set p [lindex $displayorder $r]
3905 if {[lsearch -exact $idlist $p] < 0} {
3906 set fk [lindex $children($curview,$p) 0]
3907 if {$fk ne {} && [rowofcommit $fk] < $row} {
3908 set x [idcol $idlist $p $x]
3909 set idlist [linsert $idlist $x $p]
3915 if {$final && !$viewcomplete($curview) &&
3916 $row + $uparrowlen + $mingaplen + $downarrowlen
3917 >= $commitidx($curview)} {
3920 set l [llength $rowidlist]
3922 lappend rowidlist $idlist
3924 lappend rowfinal $final
3925 } elseif {$row < $l} {
3926 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3927 lset rowidlist $row $idlist
3930 lset rowfinal $row $final
3932 set pad [ntimes [expr {$row - $l}] {}]
3933 set rowidlist [concat $rowidlist $pad]
3934 lappend rowidlist $idlist
3935 set rowfinal [concat $rowfinal $pad]
3936 lappend rowfinal $final
3937 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3943 proc changedrow {row} {
3944 global displayorder iddrawn rowisopt need_redisplay
3946 set l [llength $rowisopt]
3948 lset rowisopt $row 0
3949 if {$row + 1 < $l} {
3950 lset rowisopt [expr {$row + 1}] 0
3951 if {$row + 2 < $l} {
3952 lset rowisopt [expr {$row + 2}] 0
3956 set id [lindex $displayorder $row]
3957 if {[info exists iddrawn($id)]} {
3958 set need_redisplay 1
3962 proc insert_pad {row col npad} {
3965 set pad [ntimes $npad {}]
3966 set idlist [lindex $rowidlist $row]
3967 set bef [lrange $idlist 0 [expr {$col - 1}]]
3968 set aft [lrange $idlist $col end]
3969 set i [lsearch -exact $aft {}]
3971 set aft [lreplace $aft $i $i]
3973 lset rowidlist $row [concat $bef $pad $aft]
3977 proc optimize_rows {row col endrow} {
3978 global rowidlist rowisopt displayorder curview children
3983 for {} {$row < $endrow} {incr row; set col 0} {
3984 if {[lindex $rowisopt $row]} continue
3986 set y0 [expr {$row - 1}]
3987 set ym [expr {$row - 2}]
3988 set idlist [lindex $rowidlist $row]
3989 set previdlist [lindex $rowidlist $y0]
3990 if {$idlist eq {} || $previdlist eq {}} continue
3992 set pprevidlist [lindex $rowidlist $ym]
3993 if {$pprevidlist eq {}} continue
3999 for {} {$col < [llength $idlist]} {incr col} {
4000 set id [lindex $idlist $col]
4001 if {[lindex $previdlist $col] eq $id} continue
4006 set x0 [lsearch -exact $previdlist $id]
4007 if {$x0 < 0} continue
4008 set z [expr {$x0 - $col}]
4012 set xm [lsearch -exact $pprevidlist $id]
4014 set z0 [expr {$xm - $x0}]
4018 # if row y0 is the first child of $id then it's not an arrow
4019 if {[lindex $children($curview,$id) 0] ne
4020 [lindex $displayorder $y0]} {
4024 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4025 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4028 # Looking at lines from this row to the previous row,
4029 # make them go straight up if they end in an arrow on
4030 # the previous row; otherwise make them go straight up
4032 if {$z < -1 || ($z < 0 && $isarrow)} {
4033 # Line currently goes left too much;
4034 # insert pads in the previous row, then optimize it
4035 set npad [expr {-1 - $z + $isarrow}]
4036 insert_pad $y0 $x0 $npad
4038 optimize_rows $y0 $x0 $row
4040 set previdlist [lindex $rowidlist $y0]
4041 set x0 [lsearch -exact $previdlist $id]
4042 set z [expr {$x0 - $col}]
4044 set pprevidlist [lindex $rowidlist $ym]
4045 set xm [lsearch -exact $pprevidlist $id]
4046 set z0 [expr {$xm - $x0}]
4048 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4049 # Line currently goes right too much;
4050 # insert pads in this line
4051 set npad [expr {$z - 1 + $isarrow}]
4052 insert_pad $row $col $npad
4053 set idlist [lindex $rowidlist $row]
4055 set z [expr {$x0 - $col}]
4058 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4059 # this line links to its first child on row $row-2
4060 set id [lindex $displayorder $ym]
4061 set xc [lsearch -exact $pprevidlist $id]
4063 set z0 [expr {$xc - $x0}]
4066 # avoid lines jigging left then immediately right
4067 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4068 insert_pad $y0 $x0 1
4070 optimize_rows $y0 $x0 $row
4071 set previdlist [lindex $rowidlist $y0]
4075 # Find the first column that doesn't have a line going right
4076 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4077 set id [lindex $idlist $col]
4078 if {$id eq {}} break
4079 set x0 [lsearch -exact $previdlist $id]
4081 # check if this is the link to the first child
4082 set kid [lindex $displayorder $y0]
4083 if {[lindex $children($curview,$id) 0] eq $kid} {
4084 # it is, work out offset to child
4085 set x0 [lsearch -exact $previdlist $kid]
4088 if {$x0 <= $col} break
4090 # Insert a pad at that column as long as it has a line and
4091 # isn't the last column
4092 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4093 set idlist [linsert $idlist $col {}]
4094 lset rowidlist $row $idlist
4102 global canvx0 linespc
4103 return [expr {$canvx0 + $col * $linespc}]
4107 global canvy0 linespc
4108 return [expr {$canvy0 + $row * $linespc}]
4111 proc linewidth {id} {
4112 global thickerline lthickness
4115 if {[info exists thickerline] && $id eq $thickerline} {
4116 set wid [expr {2 * $lthickness}]
4121 proc rowranges {id} {
4122 global curview children uparrowlen downarrowlen
4125 set kids $children($curview,$id)
4131 foreach child $kids {
4132 if {![commitinview $child $curview]} break
4133 set row [rowofcommit $child]
4134 if {![info exists prev]} {
4135 lappend ret [expr {$row + 1}]
4137 if {$row <= $prevrow} {
4138 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4140 # see if the line extends the whole way from prevrow to row
4141 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4142 [lsearch -exact [lindex $rowidlist \
4143 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4144 # it doesn't, see where it ends
4145 set r [expr {$prevrow + $downarrowlen}]
4146 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4147 while {[incr r -1] > $prevrow &&
4148 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4150 while {[incr r] <= $row &&
4151 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4155 # see where it starts up again
4156 set r [expr {$row - $uparrowlen}]
4157 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4158 while {[incr r] < $row &&
4159 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4161 while {[incr r -1] >= $prevrow &&
4162 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4168 if {$child eq $id} {
4177 proc drawlineseg {id row endrow arrowlow} {
4178 global rowidlist displayorder iddrawn linesegs
4179 global canv colormap linespc curview maxlinelen parentlist
4181 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4182 set le [expr {$row + 1}]
4185 set c [lsearch -exact [lindex $rowidlist $le] $id]
4191 set x [lindex $displayorder $le]
4196 if {[info exists iddrawn($x)] || $le == $endrow} {
4197 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4213 if {[info exists linesegs($id)]} {
4214 set lines $linesegs($id)
4216 set r0 [lindex $li 0]
4218 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4228 set li [lindex $lines [expr {$i-1}]]
4229 set r1 [lindex $li 1]
4230 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4235 set x [lindex $cols [expr {$le - $row}]]
4236 set xp [lindex $cols [expr {$le - 1 - $row}]]
4237 set dir [expr {$xp - $x}]
4239 set ith [lindex $lines $i 2]
4240 set coords [$canv coords $ith]
4241 set ah [$canv itemcget $ith -arrow]
4242 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4243 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4244 if {$x2 ne {} && $x - $x2 == $dir} {
4245 set coords [lrange $coords 0 end-2]
4248 set coords [list [xc $le $x] [yc $le]]
4251 set itl [lindex $lines [expr {$i-1}] 2]
4252 set al [$canv itemcget $itl -arrow]
4253 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4254 } elseif {$arrowlow} {
4255 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4256 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4260 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4261 for {set y $le} {[incr y -1] > $row} {} {
4263 set xp [lindex $cols [expr {$y - 1 - $row}]]
4264 set ndir [expr {$xp - $x}]
4265 if {$dir != $ndir || $xp < 0} {
4266 lappend coords [xc $y $x] [yc $y]
4272 # join parent line to first child
4273 set ch [lindex $displayorder $row]
4274 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4276 puts "oops: drawlineseg: child $ch not on row $row"
4277 } elseif {$xc != $x} {
4278 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4279 set d [expr {int(0.5 * $linespc)}]
4282 set x2 [expr {$x1 - $d}]
4284 set x2 [expr {$x1 + $d}]
4287 set y1 [expr {$y2 + $d}]
4288 lappend coords $x1 $y1 $x2 $y2
4289 } elseif {$xc < $x - 1} {
4290 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4291 } elseif {$xc > $x + 1} {
4292 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4296 lappend coords [xc $row $x] [yc $row]
4298 set xn [xc $row $xp]
4300 lappend coords $xn $yn
4304 set t [$canv create line $coords -width [linewidth $id] \
4305 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4308 set lines [linsert $lines $i [list $row $le $t]]
4310 $canv coords $ith $coords
4311 if {$arrow ne $ah} {
4312 $canv itemconf $ith -arrow $arrow
4314 lset lines $i 0 $row
4317 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4318 set ndir [expr {$xo - $xp}]
4319 set clow [$canv coords $itl]
4320 if {$dir == $ndir} {
4321 set clow [lrange $clow 2 end]
4323 set coords [concat $coords $clow]
4325 lset lines [expr {$i-1}] 1 $le
4327 # coalesce two pieces
4329 set b [lindex $lines [expr {$i-1}] 0]
4330 set e [lindex $lines $i 1]
4331 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4333 $canv coords $itl $coords
4334 if {$arrow ne $al} {
4335 $canv itemconf $itl -arrow $arrow
4339 set linesegs($id) $lines
4343 proc drawparentlinks {id row} {
4344 global rowidlist canv colormap curview parentlist
4345 global idpos linespc
4347 set rowids [lindex $rowidlist $row]
4348 set col [lsearch -exact $rowids $id]
4349 if {$col < 0} return
4350 set olds [lindex $parentlist $row]
4351 set row2 [expr {$row + 1}]
4352 set x [xc $row $col]
4355 set d [expr {int(0.5 * $linespc)}]
4356 set ymid [expr {$y + $d}]
4357 set ids [lindex $rowidlist $row2]
4358 # rmx = right-most X coord used
4361 set i [lsearch -exact $ids $p]
4363 puts "oops, parent $p of $id not in list"
4366 set x2 [xc $row2 $i]
4370 set j [lsearch -exact $rowids $p]
4372 # drawlineseg will do this one for us
4376 # should handle duplicated parents here...
4377 set coords [list $x $y]
4379 # if attaching to a vertical segment, draw a smaller
4380 # slant for visual distinctness
4383 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4385 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4387 } elseif {$i < $col && $i < $j} {
4388 # segment slants towards us already
4389 lappend coords [xc $row $j] $y
4391 if {$i < $col - 1} {
4392 lappend coords [expr {$x2 + $linespc}] $y
4393 } elseif {$i > $col + 1} {
4394 lappend coords [expr {$x2 - $linespc}] $y
4396 lappend coords $x2 $y2
4399 lappend coords $x2 $y2
4401 set t [$canv create line $coords -width [linewidth $p] \
4402 -fill $colormap($p) -tags lines.$p]
4406 if {$rmx > [lindex $idpos($id) 1]} {
4407 lset idpos($id) 1 $rmx
4412 proc drawlines {id} {
4415 $canv itemconf lines.$id -width [linewidth $id]
4418 proc drawcmittext {id row col} {
4419 global linespc canv canv2 canv3 fgcolor curview
4420 global cmitlisted commitinfo rowidlist parentlist
4421 global rowtextx idpos idtags idheads idotherrefs
4422 global linehtag linentag linedtag selectedline
4423 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4425 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4426 set listed $cmitlisted($curview,$id)
4427 if {$id eq $nullid} {
4429 } elseif {$id eq $nullid2} {
4432 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
4434 set x [xc $row $col]
4436 set orad [expr {$linespc / 3}]
4438 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4439 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4440 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4441 } elseif {$listed == 3} {
4442 # triangle pointing left for left-side commits
4443 set t [$canv create polygon \
4444 [expr {$x - $orad}] $y \
4445 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4446 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4447 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4449 # triangle pointing right for right-side commits
4450 set t [$canv create polygon \
4451 [expr {$x + $orad - 1}] $y \
4452 [expr {$x - $orad}] [expr {$y - $orad}] \
4453 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4454 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4457 $canv bind $t <1> {selcanvline {} %x %y}
4458 set rmx [llength [lindex $rowidlist $row]]
4459 set olds [lindex $parentlist $row]
4461 set nextids [lindex $rowidlist [expr {$row + 1}]]
4463 set i [lsearch -exact $nextids $p]
4469 set xt [xc $row $rmx]
4470 set rowtextx($row) $xt
4471 set idpos($id) [list $x $xt $y]
4472 if {[info exists idtags($id)] || [info exists idheads($id)]
4473 || [info exists idotherrefs($id)]} {
4474 set xt [drawtags $id $x $xt $y]
4476 set headline [lindex $commitinfo($id) 0]
4477 set name [lindex $commitinfo($id) 1]
4478 set date [lindex $commitinfo($id) 2]
4479 set date [formatdate $date]
4482 set isbold [ishighlighted $id]
4484 lappend boldrows $row
4485 set font mainfontbold
4487 lappend boldnamerows $row
4488 set nfont mainfontbold
4491 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4492 -text $headline -font $font -tags text]
4493 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4494 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4495 -text $name -font $nfont -tags text]
4496 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4497 -text $date -font mainfont -tags text]
4498 if {[info exists selectedline] && $selectedline == $row} {
4501 set xr [expr {$xt + [font measure $font $headline]}]
4502 if {$xr > $canvxmax} {
4508 proc drawcmitrow {row} {
4509 global displayorder rowidlist nrows_drawn
4510 global iddrawn markingmatches
4511 global commitinfo numcommits
4512 global filehighlight fhighlights findpattern nhighlights
4513 global hlview vhighlights
4514 global highlight_related rhighlights
4516 if {$row >= $numcommits} return
4518 set id [lindex $displayorder $row]
4519 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4520 askvhighlight $row $id
4522 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4523 askfilehighlight $row $id
4525 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4526 askfindhighlight $row $id
4528 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4529 askrelhighlight $row $id
4531 if {![info exists iddrawn($id)]} {
4532 set col [lsearch -exact [lindex $rowidlist $row] $id]
4534 puts "oops, row $row id $id not in list"
4537 if {![info exists commitinfo($id)]} {
4541 drawcmittext $id $row $col
4545 if {$markingmatches} {
4546 markrowmatches $row $id
4550 proc drawcommits {row {endrow {}}} {
4551 global numcommits iddrawn displayorder curview need_redisplay
4552 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4557 if {$endrow eq {}} {
4560 if {$endrow >= $numcommits} {
4561 set endrow [expr {$numcommits - 1}]
4564 set rl1 [expr {$row - $downarrowlen - 3}]
4568 set ro1 [expr {$row - 3}]
4572 set r2 [expr {$endrow + $uparrowlen + 3}]
4573 if {$r2 > $numcommits} {
4576 for {set r $rl1} {$r < $r2} {incr r} {
4577 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4581 set rl1 [expr {$r + 1}]
4587 optimize_rows $ro1 0 $r2
4588 if {$need_redisplay || $nrows_drawn > 2000} {
4593 # make the lines join to already-drawn rows either side
4594 set r [expr {$row - 1}]
4595 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4598 set er [expr {$endrow + 1}]
4599 if {$er >= $numcommits ||
4600 ![info exists iddrawn([lindex $displayorder $er])]} {
4603 for {} {$r <= $er} {incr r} {
4604 set id [lindex $displayorder $r]
4605 set wasdrawn [info exists iddrawn($id)]
4607 if {$r == $er} break
4608 set nextid [lindex $displayorder [expr {$r + 1}]]
4609 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4610 drawparentlinks $id $r
4612 set rowids [lindex $rowidlist $r]
4613 foreach lid $rowids {
4614 if {$lid eq {}} continue
4615 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4617 # see if this is the first child of any of its parents
4618 foreach p [lindex $parentlist $r] {
4619 if {[lsearch -exact $rowids $p] < 0} {
4620 # make this line extend up to the child
4621 set lineend($p) [drawlineseg $p $r $er 0]
4625 set lineend($lid) [drawlineseg $lid $r $er 1]
4631 proc undolayout {row} {
4632 global uparrowlen mingaplen downarrowlen
4633 global rowidlist rowisopt rowfinal need_redisplay
4635 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4639 if {[llength $rowidlist] > $r} {
4641 set rowidlist [lrange $rowidlist 0 $r]
4642 set rowfinal [lrange $rowfinal 0 $r]
4643 set rowisopt [lrange $rowisopt 0 $r]
4644 set need_redisplay 1
4649 proc drawvisible {} {
4650 global canv linespc curview vrowmod selectedline targetrow targetid
4651 global need_redisplay cscroll numcommits
4653 set fs [$canv yview]
4654 set ymax [lindex [$canv cget -scrollregion] 3]
4655 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
4656 set f0 [lindex $fs 0]
4657 set f1 [lindex $fs 1]
4658 set y0 [expr {int($f0 * $ymax)}]
4659 set y1 [expr {int($f1 * $ymax)}]
4661 if {[info exists targetid]} {
4662 if {[commitinview $targetid $curview]} {
4663 set r [rowofcommit $targetid]
4664 if {$r != $targetrow} {
4665 # Fix up the scrollregion and change the scrolling position
4666 # now that our target row has moved.
4667 set diff [expr {($r - $targetrow) * $linespc}]
4670 set ymax [lindex [$canv cget -scrollregion] 3]
4673 set f0 [expr {$y0 / $ymax}]
4674 set f1 [expr {$y1 / $ymax}]
4675 allcanvs yview moveto $f0
4676 $cscroll set $f0 $f1
4677 set need_redisplay 1
4684 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4685 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4686 if {$endrow >= $vrowmod($curview)} {
4687 update_arcrows $curview
4689 if {[info exists selectedline] &&
4690 $row <= $selectedline && $selectedline <= $endrow} {
4691 set targetrow $selectedline
4692 } elseif {[info exists targetid]} {
4693 set targetrow [expr {int(($row + $endrow) / 2)}]
4695 if {[info exists targetrow]} {
4696 if {$targetrow >= $numcommits} {
4697 set targetrow [expr {$numcommits - 1}]
4699 set targetid [commitonrow $targetrow]
4701 drawcommits $row $endrow
4704 proc clear_display {} {
4705 global iddrawn linesegs need_redisplay nrows_drawn
4706 global vhighlights fhighlights nhighlights rhighlights
4709 catch {unset iddrawn}
4710 catch {unset linesegs}
4711 catch {unset vhighlights}
4712 catch {unset fhighlights}
4713 catch {unset nhighlights}
4714 catch {unset rhighlights}
4715 set need_redisplay 0
4719 proc findcrossings {id} {
4720 global rowidlist parentlist numcommits displayorder
4724 foreach {s e} [rowranges $id] {
4725 if {$e >= $numcommits} {
4726 set e [expr {$numcommits - 1}]
4728 if {$e <= $s} continue
4729 for {set row $e} {[incr row -1] >= $s} {} {
4730 set x [lsearch -exact [lindex $rowidlist $row] $id]
4732 set olds [lindex $parentlist $row]
4733 set kid [lindex $displayorder $row]
4734 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4735 if {$kidx < 0} continue
4736 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4738 set px [lsearch -exact $nextrow $p]
4739 if {$px < 0} continue
4740 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4741 if {[lsearch -exact $ccross $p] >= 0} continue
4742 if {$x == $px + ($kidx < $px? -1: 1)} {
4744 } elseif {[lsearch -exact $cross $p] < 0} {
4751 return [concat $ccross {{}} $cross]
4754 proc assigncolor {id} {
4755 global colormap colors nextcolor
4756 global parents children children curview
4758 if {[info exists colormap($id)]} return
4759 set ncolors [llength $colors]
4760 if {[info exists children($curview,$id)]} {
4761 set kids $children($curview,$id)
4765 if {[llength $kids] == 1} {
4766 set child [lindex $kids 0]
4767 if {[info exists colormap($child)]
4768 && [llength $parents($curview,$child)] == 1} {
4769 set colormap($id) $colormap($child)
4775 foreach x [findcrossings $id] {
4777 # delimiter between corner crossings and other crossings
4778 if {[llength $badcolors] >= $ncolors - 1} break
4779 set origbad $badcolors
4781 if {[info exists colormap($x)]
4782 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4783 lappend badcolors $colormap($x)
4786 if {[llength $badcolors] >= $ncolors} {
4787 set badcolors $origbad
4789 set origbad $badcolors
4790 if {[llength $badcolors] < $ncolors - 1} {
4791 foreach child $kids {
4792 if {[info exists colormap($child)]
4793 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4794 lappend badcolors $colormap($child)
4796 foreach p $parents($curview,$child) {
4797 if {[info exists colormap($p)]
4798 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4799 lappend badcolors $colormap($p)
4803 if {[llength $badcolors] >= $ncolors} {
4804 set badcolors $origbad
4807 for {set i 0} {$i <= $ncolors} {incr i} {
4808 set c [lindex $colors $nextcolor]
4809 if {[incr nextcolor] >= $ncolors} {
4812 if {[lsearch -exact $badcolors $c]} break
4814 set colormap($id) $c
4817 proc bindline {t id} {
4820 $canv bind $t <Enter> "lineenter %x %y $id"
4821 $canv bind $t <Motion> "linemotion %x %y $id"
4822 $canv bind $t <Leave> "lineleave $id"
4823 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4826 proc drawtags {id x xt y1} {
4827 global idtags idheads idotherrefs mainhead
4828 global linespc lthickness
4829 global canv rowtextx curview fgcolor bgcolor
4834 if {[info exists idtags($id)]} {
4835 set marks $idtags($id)
4836 set ntags [llength $marks]
4838 if {[info exists idheads($id)]} {
4839 set marks [concat $marks $idheads($id)]
4840 set nheads [llength $idheads($id)]
4842 if {[info exists idotherrefs($id)]} {
4843 set marks [concat $marks $idotherrefs($id)]
4849 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4850 set yt [expr {$y1 - 0.5 * $linespc}]
4851 set yb [expr {$yt + $linespc - 1}]
4855 foreach tag $marks {
4857 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4858 set wid [font measure mainfontbold $tag]
4860 set wid [font measure mainfont $tag]
4864 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4866 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4867 -width $lthickness -fill black -tags tag.$id]
4869 foreach tag $marks x $xvals wid $wvals {
4870 set xl [expr {$x + $delta}]
4871 set xr [expr {$x + $delta + $wid + $lthickness}]
4873 if {[incr ntags -1] >= 0} {
4875 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4876 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4877 -width 1 -outline black -fill yellow -tags tag.$id]
4878 $canv bind $t <1> [list showtag $tag 1]
4879 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4881 # draw a head or other ref
4882 if {[incr nheads -1] >= 0} {
4884 if {$tag eq $mainhead} {
4885 set font mainfontbold
4890 set xl [expr {$xl - $delta/2}]
4891 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4892 -width 1 -outline black -fill $col -tags tag.$id
4893 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4894 set rwid [font measure mainfont $remoteprefix]
4895 set xi [expr {$x + 1}]
4896 set yti [expr {$yt + 1}]
4897 set xri [expr {$x + $rwid}]
4898 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4899 -width 0 -fill "#ffddaa" -tags tag.$id
4902 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4903 -font $font -tags [list tag.$id text]]
4905 $canv bind $t <1> [list showtag $tag 1]
4906 } elseif {$nheads >= 0} {
4907 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4913 proc xcoord {i level ln} {
4914 global canvx0 xspc1 xspc2
4916 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4917 if {$i > 0 && $i == $level} {
4918 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4919 } elseif {$i > $level} {
4920 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4925 proc show_status {msg} {
4929 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4930 -tags text -fill $fgcolor
4933 # Don't change the text pane cursor if it is currently the hand cursor,
4934 # showing that we are over a sha1 ID link.
4935 proc settextcursor {c} {
4936 global ctext curtextcursor
4938 if {[$ctext cget -cursor] == $curtextcursor} {
4939 $ctext config -cursor $c
4941 set curtextcursor $c
4944 proc nowbusy {what {name {}}} {
4945 global isbusy busyname statusw
4947 if {[array names isbusy] eq {}} {
4948 . config -cursor watch
4952 set busyname($what) $name
4954 $statusw conf -text $name
4958 proc notbusy {what} {
4959 global isbusy maincursor textcursor busyname statusw
4963 if {$busyname($what) ne {} &&
4964 [$statusw cget -text] eq $busyname($what)} {
4965 $statusw conf -text {}
4968 if {[array names isbusy] eq {}} {
4969 . config -cursor $maincursor
4970 settextcursor $textcursor
4974 proc findmatches {f} {
4975 global findtype findstring
4976 if {$findtype == [mc "Regexp"]} {
4977 set matches [regexp -indices -all -inline $findstring $f]
4980 if {$findtype == [mc "IgnCase"]} {
4981 set f [string tolower $f]
4982 set fs [string tolower $fs]
4986 set l [string length $fs]
4987 while {[set j [string first $fs $f $i]] >= 0} {
4988 lappend matches [list $j [expr {$j+$l-1}]]
4989 set i [expr {$j + $l}]
4995 proc dofind {{dirn 1} {wrap 1}} {
4996 global findstring findstartline findcurline selectedline numcommits
4997 global gdttype filehighlight fh_serial find_dirn findallowwrap
4999 if {[info exists find_dirn]} {
5000 if {$find_dirn == $dirn} return
5004 if {$findstring eq {} || $numcommits == 0} return
5005 if {![info exists selectedline]} {
5006 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5008 set findstartline $selectedline
5010 set findcurline $findstartline
5011 nowbusy finding [mc "Searching"]
5012 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5013 after cancel do_file_hl $fh_serial
5014 do_file_hl $fh_serial
5017 set findallowwrap $wrap
5021 proc stopfinding {} {
5022 global find_dirn findcurline fprogcoord
5024 if {[info exists find_dirn]} {
5034 global commitdata commitinfo numcommits findpattern findloc
5035 global findstartline findcurline findallowwrap
5036 global find_dirn gdttype fhighlights fprogcoord
5037 global curview varcorder vrownum varccommits vrowmod
5039 if {![info exists find_dirn]} {
5042 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5045 if {$find_dirn > 0} {
5047 if {$l >= $numcommits} {
5050 if {$l <= $findstartline} {
5051 set lim [expr {$findstartline + 1}]
5054 set moretodo $findallowwrap
5061 if {$l >= $findstartline} {
5062 set lim [expr {$findstartline - 1}]
5065 set moretodo $findallowwrap
5068 set n [expr {($lim - $l) * $find_dirn}]
5073 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5074 update_arcrows $curview
5078 set ai [bsearch $vrownum($curview) $l]
5079 set a [lindex $varcorder($curview) $ai]
5080 set arow [lindex $vrownum($curview) $ai]
5081 set ids [lindex $varccommits($curview,$a)]
5082 set arowend [expr {$arow + [llength $ids]}]
5083 if {$gdttype eq [mc "containing:"]} {
5084 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5085 if {$l < $arow || $l >= $arowend} {
5087 set a [lindex $varcorder($curview) $ai]
5088 set arow [lindex $vrownum($curview) $ai]
5089 set ids [lindex $varccommits($curview,$a)]
5090 set arowend [expr {$arow + [llength $ids]}]
5092 set id [lindex $ids [expr {$l - $arow}]]
5093 # shouldn't happen unless git log doesn't give all the commits...
5094 if {![info exists commitdata($id)] ||
5095 ![doesmatch $commitdata($id)]} {
5098 if {![info exists commitinfo($id)]} {
5101 set info $commitinfo($id)
5102 foreach f $info ty $fldtypes {
5103 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5112 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5113 if {$l < $arow || $l >= $arowend} {
5115 set a [lindex $varcorder($curview) $ai]
5116 set arow [lindex $vrownum($curview) $ai]
5117 set ids [lindex $varccommits($curview,$a)]
5118 set arowend [expr {$arow + [llength $ids]}]
5120 set id [lindex $ids [expr {$l - $arow}]]
5121 if {![info exists fhighlights($id)]} {
5122 # this sets fhighlights($id) to -1
5123 askfilehighlight $l $id
5125 if {$fhighlights($id) > 0} {
5129 if {$fhighlights($id) < 0} {
5132 set findcurline [expr {$l - $find_dirn}]
5137 if {$found || ($domore && !$moretodo)} {
5153 set findcurline [expr {$l - $find_dirn}]
5155 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5159 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5164 proc findselectline {l} {
5165 global findloc commentend ctext findcurline markingmatches gdttype
5167 set markingmatches 1
5170 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5171 # highlight the matches in the comments
5172 set f [$ctext get 1.0 $commentend]
5173 set matches [findmatches $f]
5174 foreach match $matches {
5175 set start [lindex $match 0]
5176 set end [expr {[lindex $match 1] + 1}]
5177 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5183 # mark the bits of a headline or author that match a find string
5184 proc markmatches {canv l str tag matches font row} {
5187 set bbox [$canv bbox $tag]
5188 set x0 [lindex $bbox 0]
5189 set y0 [lindex $bbox 1]
5190 set y1 [lindex $bbox 3]
5191 foreach match $matches {
5192 set start [lindex $match 0]
5193 set end [lindex $match 1]
5194 if {$start > $end} continue
5195 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5196 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5197 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5198 [expr {$x0+$xlen+2}] $y1 \
5199 -outline {} -tags [list match$l matches] -fill yellow]
5201 if {[info exists selectedline] && $row == $selectedline} {
5202 $canv raise $t secsel
5207 proc unmarkmatches {} {
5208 global markingmatches
5210 allcanvs delete matches
5211 set markingmatches 0
5215 proc selcanvline {w x y} {
5216 global canv canvy0 ctext linespc
5218 set ymax [lindex [$canv cget -scrollregion] 3]
5219 if {$ymax == {}} return
5220 set yfrac [lindex [$canv yview] 0]
5221 set y [expr {$y + $yfrac * $ymax}]
5222 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5227 set xmax [lindex [$canv cget -scrollregion] 2]
5228 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5229 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5235 proc commit_descriptor {p} {
5237 if {![info exists commitinfo($p)]} {
5241 if {[llength $commitinfo($p)] > 1} {
5242 set l [lindex $commitinfo($p) 0]
5247 # append some text to the ctext widget, and make any SHA1 ID
5248 # that we know about be a clickable link.
5249 proc appendwithlinks {text tags} {
5250 global ctext linknum curview pendinglinks
5252 set start [$ctext index "end - 1c"]
5253 $ctext insert end $text $tags
5254 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5258 set linkid [string range $text $s $e]
5260 $ctext tag delete link$linknum
5261 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5262 setlink $linkid link$linknum
5267 proc setlink {id lk} {
5268 global curview ctext pendinglinks commitinterest
5270 if {[commitinview $id $curview]} {
5271 $ctext tag conf $lk -foreground blue -underline 1
5272 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5273 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5274 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5276 lappend pendinglinks($id) $lk
5277 lappend commitinterest($id) {makelink %I}
5281 proc makelink {id} {
5284 if {![info exists pendinglinks($id)]} return
5285 foreach lk $pendinglinks($id) {
5288 unset pendinglinks($id)
5291 proc linkcursor {w inc} {
5292 global linkentercount curtextcursor
5294 if {[incr linkentercount $inc] > 0} {
5295 $w configure -cursor hand2
5297 $w configure -cursor $curtextcursor
5298 if {$linkentercount < 0} {
5299 set linkentercount 0
5304 proc viewnextline {dir} {
5308 set ymax [lindex [$canv cget -scrollregion] 3]
5309 set wnow [$canv yview]
5310 set wtop [expr {[lindex $wnow 0] * $ymax}]
5311 set newtop [expr {$wtop + $dir * $linespc}]
5314 } elseif {$newtop > $ymax} {
5317 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5320 # add a list of tag or branch names at position pos
5321 # returns the number of names inserted
5322 proc appendrefs {pos ids var} {
5323 global ctext linknum curview $var maxrefs
5325 if {[catch {$ctext index $pos}]} {
5328 $ctext conf -state normal
5329 $ctext delete $pos "$pos lineend"
5332 foreach tag [set $var\($id\)] {
5333 lappend tags [list $tag $id]
5336 if {[llength $tags] > $maxrefs} {
5337 $ctext insert $pos "many ([llength $tags])"
5339 set tags [lsort -index 0 -decreasing $tags]
5342 set id [lindex $ti 1]
5345 $ctext tag delete $lk
5346 $ctext insert $pos $sep
5347 $ctext insert $pos [lindex $ti 0] $lk
5352 $ctext conf -state disabled
5353 return [llength $tags]
5356 # called when we have finished computing the nearby tags
5357 proc dispneartags {delay} {
5358 global selectedline currentid showneartags tagphase
5360 if {![info exists selectedline] || !$showneartags} return
5361 after cancel dispnexttag
5363 after 200 dispnexttag
5366 after idle dispnexttag
5371 proc dispnexttag {} {
5372 global selectedline currentid showneartags tagphase ctext
5374 if {![info exists selectedline] || !$showneartags} return
5375 switch -- $tagphase {
5377 set dtags [desctags $currentid]
5379 appendrefs precedes $dtags idtags
5383 set atags [anctags $currentid]
5385 appendrefs follows $atags idtags
5389 set dheads [descheads $currentid]
5390 if {$dheads ne {}} {
5391 if {[appendrefs branch $dheads idheads] > 1
5392 && [$ctext get "branch -3c"] eq "h"} {
5393 # turn "Branch" into "Branches"
5394 $ctext conf -state normal
5395 $ctext insert "branch -2c" "es"
5396 $ctext conf -state disabled
5401 if {[incr tagphase] <= 2} {
5402 after idle dispnexttag
5406 proc make_secsel {l} {
5407 global linehtag linentag linedtag canv canv2 canv3
5409 if {![info exists linehtag($l)]} return
5411 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5412 -tags secsel -fill [$canv cget -selectbackground]]
5414 $canv2 delete secsel
5415 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5416 -tags secsel -fill [$canv2 cget -selectbackground]]
5418 $canv3 delete secsel
5419 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5420 -tags secsel -fill [$canv3 cget -selectbackground]]
5424 proc selectline {l isnew} {
5425 global canv ctext commitinfo selectedline
5426 global canvy0 linespc parents children curview
5427 global currentid sha1entry
5428 global commentend idtags linknum
5429 global mergemax numcommits pending_select
5430 global cmitmode showneartags allcommits
5431 global targetrow targetid
5433 catch {unset pending_select}
5438 if {$l < 0 || $l >= $numcommits} return
5439 set id [commitonrow $l]
5443 set y [expr {$canvy0 + $l * $linespc}]
5444 set ymax [lindex [$canv cget -scrollregion] 3]
5445 set ytop [expr {$y - $linespc - 1}]
5446 set ybot [expr {$y + $linespc + 1}]
5447 set wnow [$canv yview]
5448 set wtop [expr {[lindex $wnow 0] * $ymax}]
5449 set wbot [expr {[lindex $wnow 1] * $ymax}]
5450 set wh [expr {$wbot - $wtop}]
5452 if {$ytop < $wtop} {
5453 if {$ybot < $wtop} {
5454 set newtop [expr {$y - $wh / 2.0}]
5457 if {$newtop > $wtop - $linespc} {
5458 set newtop [expr {$wtop - $linespc}]
5461 } elseif {$ybot > $wbot} {
5462 if {$ytop > $wbot} {
5463 set newtop [expr {$y - $wh / 2.0}]
5465 set newtop [expr {$ybot - $wh}]
5466 if {$newtop < $wtop + $linespc} {
5467 set newtop [expr {$wtop + $linespc}]
5471 if {$newtop != $wtop} {
5475 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5482 addtohistory [list selbyid $id]
5487 $sha1entry delete 0 end
5488 $sha1entry insert 0 $id
5489 $sha1entry selection from 0
5490 $sha1entry selection to end
5493 $ctext conf -state normal
5496 set info $commitinfo($id)
5497 set date [formatdate [lindex $info 2]]
5498 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5499 set date [formatdate [lindex $info 4]]
5500 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5501 if {[info exists idtags($id)]} {
5502 $ctext insert end [mc "Tags:"]
5503 foreach tag $idtags($id) {
5504 $ctext insert end " $tag"
5506 $ctext insert end "\n"
5510 set olds $parents($curview,$id)
5511 if {[llength $olds] > 1} {
5514 if {$np >= $mergemax} {
5519 $ctext insert end "[mc "Parent"]: " $tag
5520 appendwithlinks [commit_descriptor $p] {}
5525 append headers "[mc "Parent"]: [commit_descriptor $p]"
5529 foreach c $children($curview,$id) {
5530 append headers "[mc "Child"]: [commit_descriptor $c]"
5533 # make anything that looks like a SHA1 ID be a clickable link
5534 appendwithlinks $headers {}
5535 if {$showneartags} {
5536 if {![info exists allcommits]} {
5539 $ctext insert end "[mc "Branch"]: "
5540 $ctext mark set branch "end -1c"
5541 $ctext mark gravity branch left
5542 $ctext insert end "\n[mc "Follows"]: "
5543 $ctext mark set follows "end -1c"
5544 $ctext mark gravity follows left
5545 $ctext insert end "\n[mc "Precedes"]: "
5546 $ctext mark set precedes "end -1c"
5547 $ctext mark gravity precedes left
5548 $ctext insert end "\n"
5551 $ctext insert end "\n"
5552 set comment [lindex $info 5]
5553 if {[string first "\r" $comment] >= 0} {
5554 set comment [string map {"\r" "\n "} $comment]
5556 appendwithlinks $comment {comment}
5558 $ctext tag remove found 1.0 end
5559 $ctext conf -state disabled
5560 set commentend [$ctext index "end - 1c"]
5562 init_flist [mc "Comments"]
5563 if {$cmitmode eq "tree"} {
5565 } elseif {[llength $olds] <= 1} {
5572 proc selfirstline {} {
5577 proc sellastline {} {
5580 set l [expr {$numcommits - 1}]
5584 proc selnextline {dir} {
5587 if {![info exists selectedline]} return
5588 set l [expr {$selectedline + $dir}]
5593 proc selnextpage {dir} {
5594 global canv linespc selectedline numcommits
5596 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5600 allcanvs yview scroll [expr {$dir * $lpp}] units
5602 if {![info exists selectedline]} return
5603 set l [expr {$selectedline + $dir * $lpp}]
5606 } elseif {$l >= $numcommits} {
5607 set l [expr $numcommits - 1]
5613 proc unselectline {} {
5614 global selectedline currentid
5616 catch {unset selectedline}
5617 catch {unset currentid}
5618 allcanvs delete secsel
5622 proc reselectline {} {
5625 if {[info exists selectedline]} {
5626 selectline $selectedline 0
5630 proc addtohistory {cmd} {
5631 global history historyindex curview
5633 set elt [list $curview $cmd]
5634 if {$historyindex > 0
5635 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5639 if {$historyindex < [llength $history]} {
5640 set history [lreplace $history $historyindex end $elt]
5642 lappend history $elt
5645 if {$historyindex > 1} {
5646 .tf.bar.leftbut conf -state normal
5648 .tf.bar.leftbut conf -state disabled
5650 .tf.bar.rightbut conf -state disabled
5656 set view [lindex $elt 0]
5657 set cmd [lindex $elt 1]
5658 if {$curview != $view} {
5665 global history historyindex
5668 if {$historyindex > 1} {
5669 incr historyindex -1
5670 godo [lindex $history [expr {$historyindex - 1}]]
5671 .tf.bar.rightbut conf -state normal
5673 if {$historyindex <= 1} {
5674 .tf.bar.leftbut conf -state disabled
5679 global history historyindex
5682 if {$historyindex < [llength $history]} {
5683 set cmd [lindex $history $historyindex]
5686 .tf.bar.leftbut conf -state normal
5688 if {$historyindex >= [llength $history]} {
5689 .tf.bar.rightbut conf -state disabled
5694 global treefilelist treeidlist diffids diffmergeid treepending
5695 global nullid nullid2
5698 catch {unset diffmergeid}
5699 if {![info exists treefilelist($id)]} {
5700 if {![info exists treepending]} {
5701 if {$id eq $nullid} {
5702 set cmd [list | git ls-files]
5703 } elseif {$id eq $nullid2} {
5704 set cmd [list | git ls-files --stage -t]
5706 set cmd [list | git ls-tree -r $id]
5708 if {[catch {set gtf [open $cmd r]}]} {
5712 set treefilelist($id) {}
5713 set treeidlist($id) {}
5714 fconfigure $gtf -blocking 0
5715 filerun $gtf [list gettreeline $gtf $id]
5722 proc gettreeline {gtf id} {
5723 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5726 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5727 if {$diffids eq $nullid} {
5730 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5731 set i [string first "\t" $line]
5732 if {$i < 0} continue
5733 set sha1 [lindex $line 2]
5734 set fname [string range $line [expr {$i+1}] end]
5735 if {[string index $fname 0] eq "\""} {
5736 set fname [lindex $fname 0]
5738 lappend treeidlist($id) $sha1
5740 lappend treefilelist($id) $fname
5743 return [expr {$nl >= 1000? 2: 1}]
5747 if {$cmitmode ne "tree"} {
5748 if {![info exists diffmergeid]} {
5749 gettreediffs $diffids
5751 } elseif {$id ne $diffids} {
5760 global treefilelist treeidlist diffids nullid nullid2
5761 global ctext commentend
5763 set i [lsearch -exact $treefilelist($diffids) $f]
5765 puts "oops, $f not in list for id $diffids"
5768 if {$diffids eq $nullid} {
5769 if {[catch {set bf [open $f r]} err]} {
5770 puts "oops, can't read $f: $err"
5774 set blob [lindex $treeidlist($diffids) $i]
5775 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5776 puts "oops, error reading blob $blob: $err"
5780 fconfigure $bf -blocking 0
5781 filerun $bf [list getblobline $bf $diffids]
5782 $ctext config -state normal
5783 clear_ctext $commentend
5784 $ctext insert end "\n"
5785 $ctext insert end "$f\n" filesep
5786 $ctext config -state disabled
5787 $ctext yview $commentend
5791 proc getblobline {bf id} {
5792 global diffids cmitmode ctext
5794 if {$id ne $diffids || $cmitmode ne "tree"} {
5798 $ctext config -state normal
5800 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5801 $ctext insert end "$line\n"
5804 # delete last newline
5805 $ctext delete "end - 2c" "end - 1c"
5809 $ctext config -state disabled
5810 return [expr {$nl >= 1000? 2: 1}]
5813 proc mergediff {id} {
5814 global diffmergeid mdifffd
5818 global limitdiffs viewfiles curview
5822 # this doesn't seem to actually affect anything...
5823 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5824 if {$limitdiffs && $viewfiles($curview) ne {}} {
5825 set cmd [concat $cmd -- $viewfiles($curview)]
5827 if {[catch {set mdf [open $cmd r]} err]} {
5828 error_popup "[mc "Error getting merge diffs:"] $err"
5831 fconfigure $mdf -blocking 0
5832 set mdifffd($id) $mdf
5833 set np [llength $parents($curview,$id)]
5835 filerun $mdf [list getmergediffline $mdf $id $np]
5838 proc getmergediffline {mdf id np} {
5839 global diffmergeid ctext cflist mergemax
5840 global difffilestart mdifffd
5842 $ctext conf -state normal
5844 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5845 if {![info exists diffmergeid] || $id != $diffmergeid
5846 || $mdf != $mdifffd($id)} {
5850 if {[regexp {^diff --cc (.*)} $line match fname]} {
5851 # start of a new file
5852 $ctext insert end "\n"
5853 set here [$ctext index "end - 1c"]
5854 lappend difffilestart $here
5855 add_flist [list $fname]
5856 set l [expr {(78 - [string length $fname]) / 2}]
5857 set pad [string range "----------------------------------------" 1 $l]
5858 $ctext insert end "$pad $fname $pad\n" filesep
5859 } elseif {[regexp {^@@} $line]} {
5860 $ctext insert end "$line\n" hunksep
5861 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5864 # parse the prefix - one ' ', '-' or '+' for each parent
5869 for {set j 0} {$j < $np} {incr j} {
5870 set c [string range $line $j $j]
5873 } elseif {$c == "-"} {
5875 } elseif {$c == "+"} {
5884 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5885 # line doesn't appear in result, parents in $minuses have the line
5886 set num [lindex $minuses 0]
5887 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5888 # line appears in result, parents in $pluses don't have the line
5889 lappend tags mresult
5890 set num [lindex $spaces 0]
5893 if {$num >= $mergemax} {
5898 $ctext insert end "$line\n" $tags
5901 $ctext conf -state disabled
5906 return [expr {$nr >= 1000? 2: 1}]
5909 proc startdiff {ids} {
5910 global treediffs diffids treepending diffmergeid nullid nullid2
5914 catch {unset diffmergeid}
5915 if {![info exists treediffs($ids)] ||
5916 [lsearch -exact $ids $nullid] >= 0 ||
5917 [lsearch -exact $ids $nullid2] >= 0} {
5918 if {![info exists treepending]} {
5926 proc path_filter {filter name} {
5928 set l [string length $p]
5929 if {[string index $p end] eq "/"} {
5930 if {[string compare -length $l $p $name] == 0} {
5934 if {[string compare -length $l $p $name] == 0 &&
5935 ([string length $name] == $l ||
5936 [string index $name $l] eq "/")} {
5944 proc addtocflist {ids} {
5947 add_flist $treediffs($ids)
5951 proc diffcmd {ids flags} {
5952 global nullid nullid2
5954 set i [lsearch -exact $ids $nullid]
5955 set j [lsearch -exact $ids $nullid2]
5957 if {[llength $ids] > 1 && $j < 0} {
5958 # comparing working directory with some specific revision
5959 set cmd [concat | git diff-index $flags]
5961 lappend cmd -R [lindex $ids 1]
5963 lappend cmd [lindex $ids 0]
5966 # comparing working directory with index
5967 set cmd [concat | git diff-files $flags]
5972 } elseif {$j >= 0} {
5973 set cmd [concat | git diff-index --cached $flags]
5974 if {[llength $ids] > 1} {
5975 # comparing index with specific revision
5977 lappend cmd -R [lindex $ids 1]
5979 lappend cmd [lindex $ids 0]
5982 # comparing index with HEAD
5986 set cmd [concat | git diff-tree -r $flags $ids]
5991 proc gettreediffs {ids} {
5992 global treediff treepending
5994 set treepending $ids
5996 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5997 fconfigure $gdtf -blocking 0
5998 filerun $gdtf [list gettreediffline $gdtf $ids]
6001 proc gettreediffline {gdtf ids} {
6002 global treediff treediffs treepending diffids diffmergeid
6003 global cmitmode viewfiles curview limitdiffs
6006 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6007 set i [string first "\t" $line]
6009 set file [string range $line [expr {$i+1}] end]
6010 if {[string index $file 0] eq "\""} {
6011 set file [lindex $file 0]
6013 lappend treediff $file
6017 return [expr {$nr >= 1000? 2: 1}]
6020 if {$limitdiffs && $viewfiles($curview) ne {}} {
6022 foreach f $treediff {
6023 if {[path_filter $viewfiles($curview) $f]} {
6027 set treediffs($ids) $flist
6029 set treediffs($ids) $treediff
6032 if {$cmitmode eq "tree"} {
6034 } elseif {$ids != $diffids} {
6035 if {![info exists diffmergeid]} {
6036 gettreediffs $diffids
6044 # empty string or positive integer
6045 proc diffcontextvalidate {v} {
6046 return [regexp {^(|[1-9][0-9]*)$} $v]
6049 proc diffcontextchange {n1 n2 op} {
6050 global diffcontextstring diffcontext
6052 if {[string is integer -strict $diffcontextstring]} {
6053 if {$diffcontextstring > 0} {
6054 set diffcontext $diffcontextstring
6060 proc changeignorespace {} {
6064 proc getblobdiffs {ids} {
6065 global blobdifffd diffids env
6066 global diffinhdr treediffs
6069 global limitdiffs viewfiles curview
6071 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6075 if {$limitdiffs && $viewfiles($curview) ne {}} {
6076 set cmd [concat $cmd -- $viewfiles($curview)]
6078 if {[catch {set bdf [open $cmd r]} err]} {
6079 puts "error getting diffs: $err"
6083 fconfigure $bdf -blocking 0
6084 set blobdifffd($ids) $bdf
6085 filerun $bdf [list getblobdiffline $bdf $diffids]
6088 proc setinlist {var i val} {
6091 while {[llength [set $var]] < $i} {
6094 if {[llength [set $var]] == $i} {
6101 proc makediffhdr {fname ids} {
6102 global ctext curdiffstart treediffs
6104 set i [lsearch -exact $treediffs($ids) $fname]
6106 setinlist difffilestart $i $curdiffstart
6108 set l [expr {(78 - [string length $fname]) / 2}]
6109 set pad [string range "----------------------------------------" 1 $l]
6110 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6113 proc getblobdiffline {bdf ids} {
6114 global diffids blobdifffd ctext curdiffstart
6115 global diffnexthead diffnextnote difffilestart
6116 global diffinhdr treediffs
6119 $ctext conf -state normal
6120 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6121 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6125 if {![string compare -length 11 "diff --git " $line]} {
6126 # trim off "diff --git "
6127 set line [string range $line 11 end]
6129 # start of a new file
6130 $ctext insert end "\n"
6131 set curdiffstart [$ctext index "end - 1c"]
6132 $ctext insert end "\n" filesep
6133 # If the name hasn't changed the length will be odd,
6134 # the middle char will be a space, and the two bits either
6135 # side will be a/name and b/name, or "a/name" and "b/name".
6136 # If the name has changed we'll get "rename from" and
6137 # "rename to" or "copy from" and "copy to" lines following this,
6138 # and we'll use them to get the filenames.
6139 # This complexity is necessary because spaces in the filename(s)
6140 # don't get escaped.
6141 set l [string length $line]
6142 set i [expr {$l / 2}]
6143 if {!(($l & 1) && [string index $line $i] eq " " &&
6144 [string range $line 2 [expr {$i - 1}]] eq \
6145 [string range $line [expr {$i + 3}] end])} {
6148 # unescape if quoted and chop off the a/ from the front
6149 if {[string index $line 0] eq "\""} {
6150 set fname [string range [lindex $line 0] 2 end]
6152 set fname [string range $line 2 [expr {$i - 1}]]
6154 makediffhdr $fname $ids
6156 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6157 $line match f1l f1c f2l f2c rest]} {
6158 $ctext insert end "$line\n" hunksep
6161 } elseif {$diffinhdr} {
6162 if {![string compare -length 12 "rename from " $line]} {
6163 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6164 if {[string index $fname 0] eq "\""} {
6165 set fname [lindex $fname 0]
6167 set i [lsearch -exact $treediffs($ids) $fname]
6169 setinlist difffilestart $i $curdiffstart
6171 } elseif {![string compare -length 10 $line "rename to "] ||
6172 ![string compare -length 8 $line "copy to "]} {
6173 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6174 if {[string index $fname 0] eq "\""} {
6175 set fname [lindex $fname 0]
6177 makediffhdr $fname $ids
6178 } elseif {[string compare -length 3 $line "---"] == 0} {
6181 } elseif {[string compare -length 3 $line "+++"] == 0} {
6185 $ctext insert end "$line\n" filesep
6188 set x [string range $line 0 0]
6189 if {$x == "-" || $x == "+"} {
6190 set tag [expr {$x == "+"}]
6191 $ctext insert end "$line\n" d$tag
6192 } elseif {$x == " "} {
6193 $ctext insert end "$line\n"
6195 # "\ No newline at end of file",
6196 # or something else we don't recognize
6197 $ctext insert end "$line\n" hunksep
6201 $ctext conf -state disabled
6206 return [expr {$nr >= 1000? 2: 1}]
6209 proc changediffdisp {} {
6210 global ctext diffelide
6212 $ctext tag conf d0 -elide [lindex $diffelide 0]
6213 $ctext tag conf d1 -elide [lindex $diffelide 1]
6217 global difffilestart ctext
6218 set prev [lindex $difffilestart 0]
6219 set here [$ctext index @0,0]
6220 foreach loc $difffilestart {
6221 if {[$ctext compare $loc >= $here]} {
6231 global difffilestart ctext
6232 set here [$ctext index @0,0]
6233 foreach loc $difffilestart {
6234 if {[$ctext compare $loc > $here]} {
6241 proc clear_ctext {{first 1.0}} {
6242 global ctext smarktop smarkbot
6245 set l [lindex [split $first .] 0]
6246 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6249 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6252 $ctext delete $first end
6253 if {$first eq "1.0"} {
6254 catch {unset pendinglinks}
6258 proc settabs {{firstab {}}} {
6259 global firsttabstop tabstop ctext have_tk85
6261 if {$firstab ne {} && $have_tk85} {
6262 set firsttabstop $firstab
6264 set w [font measure textfont "0"]
6265 if {$firsttabstop != 0} {
6266 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6267 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6268 } elseif {$have_tk85 || $tabstop != 8} {
6269 $ctext conf -tabs [expr {$tabstop * $w}]
6271 $ctext conf -tabs {}
6275 proc incrsearch {name ix op} {
6276 global ctext searchstring searchdirn
6278 $ctext tag remove found 1.0 end
6279 if {[catch {$ctext index anchor}]} {
6280 # no anchor set, use start of selection, or of visible area
6281 set sel [$ctext tag ranges sel]
6283 $ctext mark set anchor [lindex $sel 0]
6284 } elseif {$searchdirn eq "-forwards"} {
6285 $ctext mark set anchor @0,0
6287 $ctext mark set anchor @0,[winfo height $ctext]
6290 if {$searchstring ne {}} {
6291 set here [$ctext search $searchdirn -- $searchstring anchor]
6300 global sstring ctext searchstring searchdirn
6303 $sstring icursor end
6304 set searchdirn -forwards
6305 if {$searchstring ne {}} {
6306 set sel [$ctext tag ranges sel]
6308 set start "[lindex $sel 0] + 1c"
6309 } elseif {[catch {set start [$ctext index anchor]}]} {
6312 set match [$ctext search -count mlen -- $searchstring $start]
6313 $ctext tag remove sel 1.0 end
6319 set mend "$match + $mlen c"
6320 $ctext tag add sel $match $mend
6321 $ctext mark unset anchor
6325 proc dosearchback {} {
6326 global sstring ctext searchstring searchdirn
6329 $sstring icursor end
6330 set searchdirn -backwards
6331 if {$searchstring ne {}} {
6332 set sel [$ctext tag ranges sel]
6334 set start [lindex $sel 0]
6335 } elseif {[catch {set start [$ctext index anchor]}]} {
6336 set start @0,[winfo height $ctext]
6338 set match [$ctext search -backwards -count ml -- $searchstring $start]
6339 $ctext tag remove sel 1.0 end
6345 set mend "$match + $ml c"
6346 $ctext tag add sel $match $mend
6347 $ctext mark unset anchor
6351 proc searchmark {first last} {
6352 global ctext searchstring
6356 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6357 if {$match eq {}} break
6358 set mend "$match + $mlen c"
6359 $ctext tag add found $match $mend
6363 proc searchmarkvisible {doall} {
6364 global ctext smarktop smarkbot
6366 set topline [lindex [split [$ctext index @0,0] .] 0]
6367 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6368 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6369 # no overlap with previous
6370 searchmark $topline $botline
6371 set smarktop $topline
6372 set smarkbot $botline
6374 if {$topline < $smarktop} {
6375 searchmark $topline [expr {$smarktop-1}]
6376 set smarktop $topline
6378 if {$botline > $smarkbot} {
6379 searchmark [expr {$smarkbot+1}] $botline
6380 set smarkbot $botline
6385 proc scrolltext {f0 f1} {
6388 .bleft.sb set $f0 $f1
6389 if {$searchstring ne {}} {
6395 global linespc charspc canvx0 canvy0
6396 global xspc1 xspc2 lthickness
6398 set linespc [font metrics mainfont -linespace]
6399 set charspc [font measure mainfont "m"]
6400 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6401 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6402 set lthickness [expr {int($linespc / 9) + 1}]
6403 set xspc1(0) $linespc
6411 set ymax [lindex [$canv cget -scrollregion] 3]
6412 if {$ymax eq {} || $ymax == 0} return
6413 set span [$canv yview]
6416 allcanvs yview moveto [lindex $span 0]
6418 if {[info exists selectedline]} {
6419 selectline $selectedline 0
6420 allcanvs yview moveto [lindex $span 0]
6424 proc parsefont {f n} {
6427 set fontattr($f,family) [lindex $n 0]
6429 if {$s eq {} || $s == 0} {
6432 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6434 set fontattr($f,size) $s
6435 set fontattr($f,weight) normal
6436 set fontattr($f,slant) roman
6437 foreach style [lrange $n 2 end] {
6440 "bold" {set fontattr($f,weight) $style}
6442 "italic" {set fontattr($f,slant) $style}
6447 proc fontflags {f {isbold 0}} {
6450 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6451 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6452 -slant $fontattr($f,slant)]
6458 set n [list $fontattr($f,family) $fontattr($f,size)]
6459 if {$fontattr($f,weight) eq "bold"} {
6462 if {$fontattr($f,slant) eq "italic"} {
6468 proc incrfont {inc} {
6469 global mainfont textfont ctext canv cflist showrefstop
6470 global stopped entries fontattr
6473 set s $fontattr(mainfont,size)
6478 set fontattr(mainfont,size) $s
6479 font config mainfont -size $s
6480 font config mainfontbold -size $s
6481 set mainfont [fontname mainfont]
6482 set s $fontattr(textfont,size)
6487 set fontattr(textfont,size) $s
6488 font config textfont -size $s
6489 font config textfontbold -size $s
6490 set textfont [fontname textfont]
6497 global sha1entry sha1string
6498 if {[string length $sha1string] == 40} {
6499 $sha1entry delete 0 end
6503 proc sha1change {n1 n2 op} {
6504 global sha1string currentid sha1but
6505 if {$sha1string == {}
6506 || ([info exists currentid] && $sha1string == $currentid)} {
6511 if {[$sha1but cget -state] == $state} return
6512 if {$state == "normal"} {
6513 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6515 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6519 proc gotocommit {} {
6520 global sha1string tagids headids curview varcid
6522 if {$sha1string == {}
6523 || ([info exists currentid] && $sha1string == $currentid)} return
6524 if {[info exists tagids($sha1string)]} {
6525 set id $tagids($sha1string)
6526 } elseif {[info exists headids($sha1string)]} {
6527 set id $headids($sha1string)
6529 set id [string tolower $sha1string]
6530 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6531 set matches [array names varcid "$curview,$id*"]
6532 if {$matches ne {}} {
6533 if {[llength $matches] > 1} {
6534 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6537 set id [lindex [split [lindex $matches 0] ","] 1]
6541 if {[commitinview $id $curview]} {
6542 selectline [rowofcommit $id] 1
6545 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6546 set msg [mc "SHA1 id %s is not known" $sha1string]
6548 set msg [mc "Tag/Head %s is not known" $sha1string]
6553 proc lineenter {x y id} {
6554 global hoverx hovery hoverid hovertimer
6555 global commitinfo canv
6557 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6561 if {[info exists hovertimer]} {
6562 after cancel $hovertimer
6564 set hovertimer [after 500 linehover]
6568 proc linemotion {x y id} {
6569 global hoverx hovery hoverid hovertimer
6571 if {[info exists hoverid] && $id == $hoverid} {
6574 if {[info exists hovertimer]} {
6575 after cancel $hovertimer
6577 set hovertimer [after 500 linehover]
6581 proc lineleave {id} {
6582 global hoverid hovertimer canv
6584 if {[info exists hoverid] && $id == $hoverid} {
6586 if {[info exists hovertimer]} {
6587 after cancel $hovertimer
6595 global hoverx hovery hoverid hovertimer
6596 global canv linespc lthickness
6599 set text [lindex $commitinfo($hoverid) 0]
6600 set ymax [lindex [$canv cget -scrollregion] 3]
6601 if {$ymax == {}} return
6602 set yfrac [lindex [$canv yview] 0]
6603 set x [expr {$hoverx + 2 * $linespc}]
6604 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6605 set x0 [expr {$x - 2 * $lthickness}]
6606 set y0 [expr {$y - 2 * $lthickness}]
6607 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6608 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6609 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6610 -fill \#ffff80 -outline black -width 1 -tags hover]
6612 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6617 proc clickisonarrow {id y} {
6620 set ranges [rowranges $id]
6621 set thresh [expr {2 * $lthickness + 6}]
6622 set n [expr {[llength $ranges] - 1}]
6623 for {set i 1} {$i < $n} {incr i} {
6624 set row [lindex $ranges $i]
6625 if {abs([yc $row] - $y) < $thresh} {
6632 proc arrowjump {id n y} {
6635 # 1 <-> 2, 3 <-> 4, etc...
6636 set n [expr {(($n - 1) ^ 1) + 1}]
6637 set row [lindex [rowranges $id] $n]
6639 set ymax [lindex [$canv cget -scrollregion] 3]
6640 if {$ymax eq {} || $ymax <= 0} return
6641 set view [$canv yview]
6642 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6643 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6647 allcanvs yview moveto $yfrac
6650 proc lineclick {x y id isnew} {
6651 global ctext commitinfo children canv thickerline curview
6653 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6658 # draw this line thicker than normal
6662 set ymax [lindex [$canv cget -scrollregion] 3]
6663 if {$ymax eq {}} return
6664 set yfrac [lindex [$canv yview] 0]
6665 set y [expr {$y + $yfrac * $ymax}]
6667 set dirn [clickisonarrow $id $y]
6669 arrowjump $id $dirn $y
6674 addtohistory [list lineclick $x $y $id 0]
6676 # fill the details pane with info about this line
6677 $ctext conf -state normal
6680 $ctext insert end "[mc "Parent"]:\t"
6681 $ctext insert end $id link0
6683 set info $commitinfo($id)
6684 $ctext insert end "\n\t[lindex $info 0]\n"
6685 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6686 set date [formatdate [lindex $info 2]]
6687 $ctext insert end "\t[mc "Date"]:\t$date\n"
6688 set kids $children($curview,$id)
6690 $ctext insert end "\n[mc "Children"]:"
6692 foreach child $kids {
6694 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6695 set info $commitinfo($child)
6696 $ctext insert end "\n\t"
6697 $ctext insert end $child link$i
6698 setlink $child link$i
6699 $ctext insert end "\n\t[lindex $info 0]"
6700 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6701 set date [formatdate [lindex $info 2]]
6702 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6705 $ctext conf -state disabled
6709 proc normalline {} {
6711 if {[info exists thickerline]} {
6720 if {[commitinview $id $curview]} {
6721 selectline [rowofcommit $id] 1
6727 if {![info exists startmstime]} {
6728 set startmstime [clock clicks -milliseconds]
6730 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6733 proc rowmenu {x y id} {
6734 global rowctxmenu selectedline rowmenuid curview
6735 global nullid nullid2 fakerowmenu mainhead
6739 if {![info exists selectedline]
6740 || [rowofcommit $id] eq $selectedline} {
6745 if {$id ne $nullid && $id ne $nullid2} {
6746 set menu $rowctxmenu
6747 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6749 set menu $fakerowmenu
6751 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6752 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6753 $menu entryconfigure [mc "Make patch"] -state $state
6754 tk_popup $menu $x $y
6757 proc diffvssel {dirn} {
6758 global rowmenuid selectedline
6760 if {![info exists selectedline]} return
6762 set oldid [commitonrow $selectedline]
6763 set newid $rowmenuid
6765 set oldid $rowmenuid
6766 set newid [commitonrow $selectedline]
6768 addtohistory [list doseldiff $oldid $newid]
6769 doseldiff $oldid $newid
6772 proc doseldiff {oldid newid} {
6776 $ctext conf -state normal
6778 init_flist [mc "Top"]
6779 $ctext insert end "[mc "From"] "
6780 $ctext insert end $oldid link0
6781 setlink $oldid link0
6782 $ctext insert end "\n "
6783 $ctext insert end [lindex $commitinfo($oldid) 0]
6784 $ctext insert end "\n\n[mc "To"] "
6785 $ctext insert end $newid link1
6786 setlink $newid link1
6787 $ctext insert end "\n "
6788 $ctext insert end [lindex $commitinfo($newid) 0]
6789 $ctext insert end "\n"
6790 $ctext conf -state disabled
6791 $ctext tag remove found 1.0 end
6792 startdiff [list $oldid $newid]
6796 global rowmenuid currentid commitinfo patchtop patchnum
6798 if {![info exists currentid]} return
6799 set oldid $currentid
6800 set oldhead [lindex $commitinfo($oldid) 0]
6801 set newid $rowmenuid
6802 set newhead [lindex $commitinfo($newid) 0]
6805 catch {destroy $top}
6807 label $top.title -text [mc "Generate patch"]
6808 grid $top.title - -pady 10
6809 label $top.from -text [mc "From:"]
6810 entry $top.fromsha1 -width 40 -relief flat
6811 $top.fromsha1 insert 0 $oldid
6812 $top.fromsha1 conf -state readonly
6813 grid $top.from $top.fromsha1 -sticky w
6814 entry $top.fromhead -width 60 -relief flat
6815 $top.fromhead insert 0 $oldhead
6816 $top.fromhead conf -state readonly
6817 grid x $top.fromhead -sticky w
6818 label $top.to -text [mc "To:"]
6819 entry $top.tosha1 -width 40 -relief flat
6820 $top.tosha1 insert 0 $newid
6821 $top.tosha1 conf -state readonly
6822 grid $top.to $top.tosha1 -sticky w
6823 entry $top.tohead -width 60 -relief flat
6824 $top.tohead insert 0 $newhead
6825 $top.tohead conf -state readonly
6826 grid x $top.tohead -sticky w
6827 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6828 grid $top.rev x -pady 10
6829 label $top.flab -text [mc "Output file:"]
6830 entry $top.fname -width 60
6831 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6833 grid $top.flab $top.fname -sticky w
6835 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6836 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6837 grid $top.buts.gen $top.buts.can
6838 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6839 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6840 grid $top.buts - -pady 10 -sticky ew
6844 proc mkpatchrev {} {
6847 set oldid [$patchtop.fromsha1 get]
6848 set oldhead [$patchtop.fromhead get]
6849 set newid [$patchtop.tosha1 get]
6850 set newhead [$patchtop.tohead get]
6851 foreach e [list fromsha1 fromhead tosha1 tohead] \
6852 v [list $newid $newhead $oldid $oldhead] {
6853 $patchtop.$e conf -state normal
6854 $patchtop.$e delete 0 end
6855 $patchtop.$e insert 0 $v
6856 $patchtop.$e conf -state readonly
6861 global patchtop nullid nullid2
6863 set oldid [$patchtop.fromsha1 get]
6864 set newid [$patchtop.tosha1 get]
6865 set fname [$patchtop.fname get]
6866 set cmd [diffcmd [list $oldid $newid] -p]
6867 # trim off the initial "|"
6868 set cmd [lrange $cmd 1 end]
6869 lappend cmd >$fname &
6870 if {[catch {eval exec $cmd} err]} {
6871 error_popup "[mc "Error creating patch:"] $err"
6873 catch {destroy $patchtop}
6877 proc mkpatchcan {} {
6880 catch {destroy $patchtop}
6885 global rowmenuid mktagtop commitinfo
6889 catch {destroy $top}
6891 label $top.title -text [mc "Create tag"]
6892 grid $top.title - -pady 10
6893 label $top.id -text [mc "ID:"]
6894 entry $top.sha1 -width 40 -relief flat
6895 $top.sha1 insert 0 $rowmenuid
6896 $top.sha1 conf -state readonly
6897 grid $top.id $top.sha1 -sticky w
6898 entry $top.head -width 60 -relief flat
6899 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6900 $top.head conf -state readonly
6901 grid x $top.head -sticky w
6902 label $top.tlab -text [mc "Tag name:"]
6903 entry $top.tag -width 60
6904 grid $top.tlab $top.tag -sticky w
6906 button $top.buts.gen -text [mc "Create"] -command mktaggo
6907 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6908 grid $top.buts.gen $top.buts.can
6909 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6910 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6911 grid $top.buts - -pady 10 -sticky ew
6916 global mktagtop env tagids idtags
6918 set id [$mktagtop.sha1 get]
6919 set tag [$mktagtop.tag get]
6921 error_popup [mc "No tag name specified"]
6924 if {[info exists tagids($tag)]} {
6925 error_popup [mc "Tag \"%s\" already exists" $tag]
6929 exec git tag $tag $id
6931 error_popup "[mc "Error creating tag:"] $err"
6935 set tagids($tag) $id
6936 lappend idtags($id) $tag
6943 proc redrawtags {id} {
6944 global canv linehtag idpos currentid curview
6945 global canvxmax iddrawn
6947 if {![commitinview $id $curview]} return
6948 if {![info exists iddrawn($id)]} return
6949 set row [rowofcommit $id]
6950 $canv delete tag.$id
6951 set xt [eval drawtags $id $idpos($id)]
6952 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6953 set text [$canv itemcget $linehtag($row) -text]
6954 set font [$canv itemcget $linehtag($row) -font]
6955 set xr [expr {$xt + [font measure $font $text]}]
6956 if {$xr > $canvxmax} {
6960 if {[info exists currentid] && $currentid == $id} {
6968 catch {destroy $mktagtop}
6977 proc writecommit {} {
6978 global rowmenuid wrcomtop commitinfo wrcomcmd
6980 set top .writecommit
6982 catch {destroy $top}
6984 label $top.title -text [mc "Write commit to file"]
6985 grid $top.title - -pady 10
6986 label $top.id -text [mc "ID:"]
6987 entry $top.sha1 -width 40 -relief flat
6988 $top.sha1 insert 0 $rowmenuid
6989 $top.sha1 conf -state readonly
6990 grid $top.id $top.sha1 -sticky w
6991 entry $top.head -width 60 -relief flat
6992 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6993 $top.head conf -state readonly
6994 grid x $top.head -sticky w
6995 label $top.clab -text [mc "Command:"]
6996 entry $top.cmd -width 60 -textvariable wrcomcmd
6997 grid $top.clab $top.cmd -sticky w -pady 10
6998 label $top.flab -text [mc "Output file:"]
6999 entry $top.fname -width 60
7000 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7001 grid $top.flab $top.fname -sticky w
7003 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7004 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7005 grid $top.buts.gen $top.buts.can
7006 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7007 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7008 grid $top.buts - -pady 10 -sticky ew
7015 set id [$wrcomtop.sha1 get]
7016 set cmd "echo $id | [$wrcomtop.cmd get]"
7017 set fname [$wrcomtop.fname get]
7018 if {[catch {exec sh -c $cmd >$fname &} err]} {
7019 error_popup "[mc "Error writing commit:"] $err"
7021 catch {destroy $wrcomtop}
7028 catch {destroy $wrcomtop}
7033 global rowmenuid mkbrtop
7036 catch {destroy $top}
7038 label $top.title -text [mc "Create new branch"]
7039 grid $top.title - -pady 10
7040 label $top.id -text [mc "ID:"]
7041 entry $top.sha1 -width 40 -relief flat
7042 $top.sha1 insert 0 $rowmenuid
7043 $top.sha1 conf -state readonly
7044 grid $top.id $top.sha1 -sticky w
7045 label $top.nlab -text [mc "Name:"]
7046 entry $top.name -width 40
7047 grid $top.nlab $top.name -sticky w
7049 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7050 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7051 grid $top.buts.go $top.buts.can
7052 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7053 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7054 grid $top.buts - -pady 10 -sticky ew
7059 global headids idheads
7061 set name [$top.name get]
7062 set id [$top.sha1 get]
7064 error_popup [mc "Please specify a name for the new branch"]
7067 catch {destroy $top}
7071 exec git branch $name $id
7076 set headids($name) $id
7077 lappend idheads($id) $name
7086 proc cherrypick {} {
7087 global rowmenuid curview
7088 global mainhead mainheadid
7090 set oldhead [exec git rev-parse HEAD]
7091 set dheads [descheads $rowmenuid]
7092 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7093 set ok [confirm_popup [mc "Commit %s is already\
7094 included in branch %s -- really re-apply it?" \
7095 [string range $rowmenuid 0 7] $mainhead]]
7098 nowbusy cherrypick [mc "Cherry-picking"]
7100 # Unfortunately git-cherry-pick writes stuff to stderr even when
7101 # no error occurs, and exec takes that as an indication of error...
7102 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7107 set newhead [exec git rev-parse HEAD]
7108 if {$newhead eq $oldhead} {
7110 error_popup [mc "No changes committed"]
7113 addnewchild $newhead $oldhead
7114 if {[commitinview $oldhead $curview]} {
7115 insertrow $newhead $oldhead $curview
7116 if {$mainhead ne {}} {
7117 movehead $newhead $mainhead
7118 movedhead $newhead $mainhead
7119 set mainheadid $newhead
7129 global mainhead rowmenuid confirm_ok resettype
7132 set w ".confirmreset"
7135 wm title $w [mc "Confirm reset"]
7136 message $w.m -text \
7137 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7138 -justify center -aspect 1000
7139 pack $w.m -side top -fill x -padx 20 -pady 20
7140 frame $w.f -relief sunken -border 2
7141 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7142 grid $w.f.rt -sticky w
7144 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7145 -text [mc "Soft: Leave working tree and index untouched"]
7146 grid $w.f.soft -sticky w
7147 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7148 -text [mc "Mixed: Leave working tree untouched, reset index"]
7149 grid $w.f.mixed -sticky w
7150 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7151 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7152 grid $w.f.hard -sticky w
7153 pack $w.f -side top -fill x
7154 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7155 pack $w.ok -side left -fill x -padx 20 -pady 20
7156 button $w.cancel -text [mc Cancel] -command "destroy $w"
7157 pack $w.cancel -side right -fill x -padx 20 -pady 20
7158 bind $w <Visibility> "grab $w; focus $w"
7160 if {!$confirm_ok} return
7161 if {[catch {set fd [open \
7162 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7166 filerun $fd [list readresetstat $fd]
7167 nowbusy reset [mc "Resetting"]
7172 proc readresetstat {fd} {
7173 global mainhead mainheadid showlocalchanges rprogcoord
7175 if {[gets $fd line] >= 0} {
7176 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7177 set rprogcoord [expr {1.0 * $m / $n}]
7185 if {[catch {close $fd} err]} {
7188 set oldhead $mainheadid
7189 set newhead [exec git rev-parse HEAD]
7190 if {$newhead ne $oldhead} {
7191 movehead $newhead $mainhead
7192 movedhead $newhead $mainhead
7193 set mainheadid $newhead
7197 if {$showlocalchanges} {
7203 # context menu for a head
7204 proc headmenu {x y id head} {
7205 global headmenuid headmenuhead headctxmenu mainhead
7209 set headmenuhead $head
7211 if {$head eq $mainhead} {
7214 $headctxmenu entryconfigure 0 -state $state
7215 $headctxmenu entryconfigure 1 -state $state
7216 tk_popup $headctxmenu $x $y
7220 global headmenuid headmenuhead mainhead headids
7221 global showlocalchanges mainheadid
7223 # check the tree is clean first??
7224 set oldmainhead $mainhead
7225 nowbusy checkout [mc "Checking out"]
7229 exec git checkout -q $headmenuhead
7235 set mainhead $headmenuhead
7236 set mainheadid $headmenuid
7237 if {[info exists headids($oldmainhead)]} {
7238 redrawtags $headids($oldmainhead)
7240 redrawtags $headmenuid
7243 if {$showlocalchanges} {
7249 global headmenuid headmenuhead mainhead
7252 set head $headmenuhead
7254 # this check shouldn't be needed any more...
7255 if {$head eq $mainhead} {
7256 error_popup [mc "Cannot delete the currently checked-out branch"]
7259 set dheads [descheads $id]
7260 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7261 # the stuff on this branch isn't on any other branch
7262 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7263 branch.\nReally delete branch %s?" $head $head]]} return
7267 if {[catch {exec git branch -D $head} err]} {
7272 removehead $id $head
7273 removedhead $id $head
7280 # Display a list of tags and heads
7282 global showrefstop bgcolor fgcolor selectbgcolor
7283 global bglist fglist reflistfilter reflist maincursor
7286 set showrefstop $top
7287 if {[winfo exists $top]} {
7293 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7294 text $top.list -background $bgcolor -foreground $fgcolor \
7295 -selectbackground $selectbgcolor -font mainfont \
7296 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7297 -width 30 -height 20 -cursor $maincursor \
7298 -spacing1 1 -spacing3 1 -state disabled
7299 $top.list tag configure highlight -background $selectbgcolor
7300 lappend bglist $top.list
7301 lappend fglist $top.list
7302 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7303 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7304 grid $top.list $top.ysb -sticky nsew
7305 grid $top.xsb x -sticky ew
7307 label $top.f.l -text "[mc "Filter"]: "
7308 entry $top.f.e -width 20 -textvariable reflistfilter
7309 set reflistfilter "*"
7310 trace add variable reflistfilter write reflistfilter_change
7311 pack $top.f.e -side right -fill x -expand 1
7312 pack $top.f.l -side left
7313 grid $top.f - -sticky ew -pady 2
7314 button $top.close -command [list destroy $top] -text [mc "Close"]
7316 grid columnconfigure $top 0 -weight 1
7317 grid rowconfigure $top 0 -weight 1
7318 bind $top.list <1> {break}
7319 bind $top.list <B1-Motion> {break}
7320 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7325 proc sel_reflist {w x y} {
7326 global showrefstop reflist headids tagids otherrefids
7328 if {![winfo exists $showrefstop]} return
7329 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7330 set ref [lindex $reflist [expr {$l-1}]]
7331 set n [lindex $ref 0]
7332 switch -- [lindex $ref 1] {
7333 "H" {selbyid $headids($n)}
7334 "T" {selbyid $tagids($n)}
7335 "o" {selbyid $otherrefids($n)}
7337 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7340 proc unsel_reflist {} {
7343 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7344 $showrefstop.list tag remove highlight 0.0 end
7347 proc reflistfilter_change {n1 n2 op} {
7348 global reflistfilter
7350 after cancel refill_reflist
7351 after 200 refill_reflist
7354 proc refill_reflist {} {
7355 global reflist reflistfilter showrefstop headids tagids otherrefids
7356 global curview commitinterest
7358 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7360 foreach n [array names headids] {
7361 if {[string match $reflistfilter $n]} {
7362 if {[commitinview $headids($n) $curview]} {
7363 lappend refs [list $n H]
7365 set commitinterest($headids($n)) {run refill_reflist}
7369 foreach n [array names tagids] {
7370 if {[string match $reflistfilter $n]} {
7371 if {[commitinview $tagids($n) $curview]} {
7372 lappend refs [list $n T]
7374 set commitinterest($tagids($n)) {run refill_reflist}
7378 foreach n [array names otherrefids] {
7379 if {[string match $reflistfilter $n]} {
7380 if {[commitinview $otherrefids($n) $curview]} {
7381 lappend refs [list $n o]
7383 set commitinterest($otherrefids($n)) {run refill_reflist}
7387 set refs [lsort -index 0 $refs]
7388 if {$refs eq $reflist} return
7390 # Update the contents of $showrefstop.list according to the
7391 # differences between $reflist (old) and $refs (new)
7392 $showrefstop.list conf -state normal
7393 $showrefstop.list insert end "\n"
7396 while {$i < [llength $reflist] || $j < [llength $refs]} {
7397 if {$i < [llength $reflist]} {
7398 if {$j < [llength $refs]} {
7399 set cmp [string compare [lindex $reflist $i 0] \
7400 [lindex $refs $j 0]]
7402 set cmp [string compare [lindex $reflist $i 1] \
7403 [lindex $refs $j 1]]
7413 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7421 set l [expr {$j + 1}]
7422 $showrefstop.list image create $l.0 -align baseline \
7423 -image reficon-[lindex $refs $j 1] -padx 2
7424 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7430 # delete last newline
7431 $showrefstop.list delete end-2c end-1c
7432 $showrefstop.list conf -state disabled
7435 # Stuff for finding nearby tags
7436 proc getallcommits {} {
7437 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7438 global idheads idtags idotherrefs allparents tagobjid
7440 if {![info exists allcommits]} {
7446 set allccache [file join [gitdir] "gitk.cache"]
7448 set f [open $allccache r]
7457 set cmd [list | git rev-list --parents]
7458 set allcupdate [expr {$seeds ne {}}]
7462 set refs [concat [array names idheads] [array names idtags] \
7463 [array names idotherrefs]]
7466 foreach name [array names tagobjid] {
7467 lappend tagobjs $tagobjid($name)
7469 foreach id [lsort -unique $refs] {
7470 if {![info exists allparents($id)] &&
7471 [lsearch -exact $tagobjs $id] < 0} {
7482 set fd [open [concat $cmd $ids] r]
7483 fconfigure $fd -blocking 0
7486 filerun $fd [list getallclines $fd]
7492 # Since most commits have 1 parent and 1 child, we group strings of
7493 # such commits into "arcs" joining branch/merge points (BMPs), which
7494 # are commits that either don't have 1 parent or don't have 1 child.
7496 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7497 # arcout(id) - outgoing arcs for BMP
7498 # arcids(a) - list of IDs on arc including end but not start
7499 # arcstart(a) - BMP ID at start of arc
7500 # arcend(a) - BMP ID at end of arc
7501 # growing(a) - arc a is still growing
7502 # arctags(a) - IDs out of arcids (excluding end) that have tags
7503 # archeads(a) - IDs out of arcids (excluding end) that have heads
7504 # The start of an arc is at the descendent end, so "incoming" means
7505 # coming from descendents, and "outgoing" means going towards ancestors.
7507 proc getallclines {fd} {
7508 global allparents allchildren idtags idheads nextarc
7509 global arcnos arcids arctags arcout arcend arcstart archeads growing
7510 global seeds allcommits cachedarcs allcupdate
7513 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7514 set id [lindex $line 0]
7515 if {[info exists allparents($id)]} {
7520 set olds [lrange $line 1 end]
7521 set allparents($id) $olds
7522 if {![info exists allchildren($id)]} {
7523 set allchildren($id) {}
7528 if {[llength $olds] == 1 && [llength $a] == 1} {
7529 lappend arcids($a) $id
7530 if {[info exists idtags($id)]} {
7531 lappend arctags($a) $id
7533 if {[info exists idheads($id)]} {
7534 lappend archeads($a) $id
7536 if {[info exists allparents($olds)]} {
7537 # seen parent already
7538 if {![info exists arcout($olds)]} {
7541 lappend arcids($a) $olds
7542 set arcend($a) $olds
7545 lappend allchildren($olds) $id
7546 lappend arcnos($olds) $a
7550 foreach a $arcnos($id) {
7551 lappend arcids($a) $id
7558 lappend allchildren($p) $id
7559 set a [incr nextarc]
7560 set arcstart($a) $id
7567 if {[info exists allparents($p)]} {
7568 # seen it already, may need to make a new branch
7569 if {![info exists arcout($p)]} {
7572 lappend arcids($a) $p
7576 lappend arcnos($p) $a
7581 global cached_dheads cached_dtags cached_atags
7582 catch {unset cached_dheads}
7583 catch {unset cached_dtags}
7584 catch {unset cached_atags}
7587 return [expr {$nid >= 1000? 2: 1}]
7591 fconfigure $fd -blocking 1
7594 # got an error reading the list of commits
7595 # if we were updating, try rereading the whole thing again
7601 error_popup "[mc "Error reading commit topology information;\
7602 branch and preceding/following tag information\
7603 will be incomplete."]\n($err)"
7606 if {[incr allcommits -1] == 0} {
7616 proc recalcarc {a} {
7617 global arctags archeads arcids idtags idheads
7621 foreach id [lrange $arcids($a) 0 end-1] {
7622 if {[info exists idtags($id)]} {
7625 if {[info exists idheads($id)]} {
7630 set archeads($a) $ah
7634 global arcnos arcids nextarc arctags archeads idtags idheads
7635 global arcstart arcend arcout allparents growing
7638 if {[llength $a] != 1} {
7639 puts "oops splitarc called but [llength $a] arcs already"
7643 set i [lsearch -exact $arcids($a) $p]
7645 puts "oops splitarc $p not in arc $a"
7648 set na [incr nextarc]
7649 if {[info exists arcend($a)]} {
7650 set arcend($na) $arcend($a)
7652 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7653 set j [lsearch -exact $arcnos($l) $a]
7654 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7656 set tail [lrange $arcids($a) [expr {$i+1}] end]
7657 set arcids($a) [lrange $arcids($a) 0 $i]
7659 set arcstart($na) $p
7661 set arcids($na) $tail
7662 if {[info exists growing($a)]} {
7668 if {[llength $arcnos($id)] == 1} {
7671 set j [lsearch -exact $arcnos($id) $a]
7672 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7676 # reconstruct tags and heads lists
7677 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7682 set archeads($na) {}
7686 # Update things for a new commit added that is a child of one
7687 # existing commit. Used when cherry-picking.
7688 proc addnewchild {id p} {
7689 global allparents allchildren idtags nextarc
7690 global arcnos arcids arctags arcout arcend arcstart archeads growing
7691 global seeds allcommits
7693 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7694 set allparents($id) [list $p]
7695 set allchildren($id) {}
7698 lappend allchildren($p) $id
7699 set a [incr nextarc]
7700 set arcstart($a) $id
7703 set arcids($a) [list $p]
7705 if {![info exists arcout($p)]} {
7708 lappend arcnos($p) $a
7709 set arcout($id) [list $a]
7712 # This implements a cache for the topology information.
7713 # The cache saves, for each arc, the start and end of the arc,
7714 # the ids on the arc, and the outgoing arcs from the end.
7715 proc readcache {f} {
7716 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7717 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7722 if {$lim - $a > 500} {
7723 set lim [expr {$a + 500}]
7727 # finish reading the cache and setting up arctags, etc.
7729 if {$line ne "1"} {error "bad final version"}
7731 foreach id [array names idtags] {
7732 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7733 [llength $allparents($id)] == 1} {
7734 set a [lindex $arcnos($id) 0]
7735 if {$arctags($a) eq {}} {
7740 foreach id [array names idheads] {
7741 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7742 [llength $allparents($id)] == 1} {
7743 set a [lindex $arcnos($id) 0]
7744 if {$archeads($a) eq {}} {
7749 foreach id [lsort -unique $possible_seeds] {
7750 if {$arcnos($id) eq {}} {
7756 while {[incr a] <= $lim} {
7758 if {[llength $line] != 3} {error "bad line"}
7759 set s [lindex $line 0]
7761 lappend arcout($s) $a
7762 if {![info exists arcnos($s)]} {
7763 lappend possible_seeds $s
7766 set e [lindex $line 1]
7771 if {![info exists arcout($e)]} {
7775 set arcids($a) [lindex $line 2]
7776 foreach id $arcids($a) {
7777 lappend allparents($s) $id
7779 lappend arcnos($id) $a
7781 if {![info exists allparents($s)]} {
7782 set allparents($s) {}
7787 set nextarc [expr {$a - 1}]
7800 global nextarc cachedarcs possible_seeds
7804 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7805 # make sure it's an integer
7806 set cachedarcs [expr {int([lindex $line 1])}]
7807 if {$cachedarcs < 0} {error "bad number of arcs"}
7809 set possible_seeds {}
7817 proc dropcache {err} {
7818 global allcwait nextarc cachedarcs seeds
7820 #puts "dropping cache ($err)"
7821 foreach v {arcnos arcout arcids arcstart arcend growing \
7822 arctags archeads allparents allchildren} {
7833 proc writecache {f} {
7834 global cachearc cachedarcs allccache
7835 global arcstart arcend arcnos arcids arcout
7839 if {$lim - $a > 1000} {
7840 set lim [expr {$a + 1000}]
7843 while {[incr a] <= $lim} {
7844 if {[info exists arcend($a)]} {
7845 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7847 puts $f [list $arcstart($a) {} $arcids($a)]
7852 catch {file delete $allccache}
7853 #puts "writing cache failed ($err)"
7856 set cachearc [expr {$a - 1}]
7857 if {$a > $cachedarcs} {
7866 global nextarc cachedarcs cachearc allccache
7868 if {$nextarc == $cachedarcs} return
7870 set cachedarcs $nextarc
7872 set f [open $allccache w]
7873 puts $f [list 1 $cachedarcs]
7878 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7879 # or 0 if neither is true.
7880 proc anc_or_desc {a b} {
7881 global arcout arcstart arcend arcnos cached_isanc
7883 if {$arcnos($a) eq $arcnos($b)} {
7884 # Both are on the same arc(s); either both are the same BMP,
7885 # or if one is not a BMP, the other is also not a BMP or is
7886 # the BMP at end of the arc (and it only has 1 incoming arc).
7887 # Or both can be BMPs with no incoming arcs.
7888 if {$a eq $b || $arcnos($a) eq {}} {
7891 # assert {[llength $arcnos($a)] == 1}
7892 set arc [lindex $arcnos($a) 0]
7893 set i [lsearch -exact $arcids($arc) $a]
7894 set j [lsearch -exact $arcids($arc) $b]
7895 if {$i < 0 || $i > $j} {
7902 if {![info exists arcout($a)]} {
7903 set arc [lindex $arcnos($a) 0]
7904 if {[info exists arcend($arc)]} {
7905 set aend $arcend($arc)
7909 set a $arcstart($arc)
7913 if {![info exists arcout($b)]} {
7914 set arc [lindex $arcnos($b) 0]
7915 if {[info exists arcend($arc)]} {
7916 set bend $arcend($arc)
7920 set b $arcstart($arc)
7930 if {[info exists cached_isanc($a,$bend)]} {
7931 if {$cached_isanc($a,$bend)} {
7935 if {[info exists cached_isanc($b,$aend)]} {
7936 if {$cached_isanc($b,$aend)} {
7939 if {[info exists cached_isanc($a,$bend)]} {
7944 set todo [list $a $b]
7947 for {set i 0} {$i < [llength $todo]} {incr i} {
7948 set x [lindex $todo $i]
7949 if {$anc($x) eq {}} {
7952 foreach arc $arcnos($x) {
7953 set xd $arcstart($arc)
7955 set cached_isanc($a,$bend) 1
7956 set cached_isanc($b,$aend) 0
7958 } elseif {$xd eq $aend} {
7959 set cached_isanc($b,$aend) 1
7960 set cached_isanc($a,$bend) 0
7963 if {![info exists anc($xd)]} {
7964 set anc($xd) $anc($x)
7966 } elseif {$anc($xd) ne $anc($x)} {
7971 set cached_isanc($a,$bend) 0
7972 set cached_isanc($b,$aend) 0
7976 # This identifies whether $desc has an ancestor that is
7977 # a growing tip of the graph and which is not an ancestor of $anc
7978 # and returns 0 if so and 1 if not.
7979 # If we subsequently discover a tag on such a growing tip, and that
7980 # turns out to be a descendent of $anc (which it could, since we
7981 # don't necessarily see children before parents), then $desc
7982 # isn't a good choice to display as a descendent tag of
7983 # $anc (since it is the descendent of another tag which is
7984 # a descendent of $anc). Similarly, $anc isn't a good choice to
7985 # display as a ancestor tag of $desc.
7987 proc is_certain {desc anc} {
7988 global arcnos arcout arcstart arcend growing problems
7991 if {[llength $arcnos($anc)] == 1} {
7992 # tags on the same arc are certain
7993 if {$arcnos($desc) eq $arcnos($anc)} {
7996 if {![info exists arcout($anc)]} {
7997 # if $anc is partway along an arc, use the start of the arc instead
7998 set a [lindex $arcnos($anc) 0]
7999 set anc $arcstart($a)
8002 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8005 set a [lindex $arcnos($desc) 0]
8011 set anclist [list $x]
8015 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8016 set x [lindex $anclist $i]
8021 foreach a $arcout($x) {
8022 if {[info exists growing($a)]} {
8023 if {![info exists growanc($x)] && $dl($x)} {
8029 if {[info exists dl($y)]} {
8033 if {![info exists done($y)]} {
8036 if {[info exists growanc($x)]} {
8040 for {set k 0} {$k < [llength $xl]} {incr k} {
8041 set z [lindex $xl $k]
8042 foreach c $arcout($z) {
8043 if {[info exists arcend($c)]} {
8045 if {[info exists dl($v)] && $dl($v)} {
8047 if {![info exists done($v)]} {
8050 if {[info exists growanc($v)]} {
8060 } elseif {$y eq $anc || !$dl($x)} {
8071 foreach x [array names growanc] {
8080 proc validate_arctags {a} {
8081 global arctags idtags
8085 foreach id $arctags($a) {
8087 if {![info exists idtags($id)]} {
8088 set na [lreplace $na $i $i]
8095 proc validate_archeads {a} {
8096 global archeads idheads
8099 set na $archeads($a)
8100 foreach id $archeads($a) {
8102 if {![info exists idheads($id)]} {
8103 set na [lreplace $na $i $i]
8107 set archeads($a) $na
8110 # Return the list of IDs that have tags that are descendents of id,
8111 # ignoring IDs that are descendents of IDs already reported.
8112 proc desctags {id} {
8113 global arcnos arcstart arcids arctags idtags allparents
8114 global growing cached_dtags
8116 if {![info exists allparents($id)]} {
8119 set t1 [clock clicks -milliseconds]
8121 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8122 # part-way along an arc; check that arc first
8123 set a [lindex $arcnos($id) 0]
8124 if {$arctags($a) ne {}} {
8126 set i [lsearch -exact $arcids($a) $id]
8128 foreach t $arctags($a) {
8129 set j [lsearch -exact $arcids($a) $t]
8137 set id $arcstart($a)
8138 if {[info exists idtags($id)]} {
8142 if {[info exists cached_dtags($id)]} {
8143 return $cached_dtags($id)
8150 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8151 set id [lindex $todo $i]
8153 set ta [info exists hastaggedancestor($id)]
8157 # ignore tags on starting node
8158 if {!$ta && $i > 0} {
8159 if {[info exists idtags($id)]} {
8162 } elseif {[info exists cached_dtags($id)]} {
8163 set tagloc($id) $cached_dtags($id)
8167 foreach a $arcnos($id) {
8169 if {!$ta && $arctags($a) ne {}} {
8171 if {$arctags($a) ne {}} {
8172 lappend tagloc($id) [lindex $arctags($a) end]
8175 if {$ta || $arctags($a) ne {}} {
8176 set tomark [list $d]
8177 for {set j 0} {$j < [llength $tomark]} {incr j} {
8178 set dd [lindex $tomark $j]
8179 if {![info exists hastaggedancestor($dd)]} {
8180 if {[info exists done($dd)]} {
8181 foreach b $arcnos($dd) {
8182 lappend tomark $arcstart($b)
8184 if {[info exists tagloc($dd)]} {
8187 } elseif {[info exists queued($dd)]} {
8190 set hastaggedancestor($dd) 1
8194 if {![info exists queued($d)]} {
8197 if {![info exists hastaggedancestor($d)]} {
8204 foreach id [array names tagloc] {
8205 if {![info exists hastaggedancestor($id)]} {
8206 foreach t $tagloc($id) {
8207 if {[lsearch -exact $tags $t] < 0} {
8213 set t2 [clock clicks -milliseconds]
8216 # remove tags that are descendents of other tags
8217 for {set i 0} {$i < [llength $tags]} {incr i} {
8218 set a [lindex $tags $i]
8219 for {set j 0} {$j < $i} {incr j} {
8220 set b [lindex $tags $j]
8221 set r [anc_or_desc $a $b]
8223 set tags [lreplace $tags $j $j]
8226 } elseif {$r == -1} {
8227 set tags [lreplace $tags $i $i]
8234 if {[array names growing] ne {}} {
8235 # graph isn't finished, need to check if any tag could get
8236 # eclipsed by another tag coming later. Simply ignore any
8237 # tags that could later get eclipsed.
8240 if {[is_certain $t $origid]} {
8244 if {$tags eq $ctags} {
8245 set cached_dtags($origid) $tags
8250 set cached_dtags($origid) $tags
8252 set t3 [clock clicks -milliseconds]
8253 if {0 && $t3 - $t1 >= 100} {
8254 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8255 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8261 global arcnos arcids arcout arcend arctags idtags allparents
8262 global growing cached_atags
8264 if {![info exists allparents($id)]} {
8267 set t1 [clock clicks -milliseconds]
8269 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8270 # part-way along an arc; check that arc first
8271 set a [lindex $arcnos($id) 0]
8272 if {$arctags($a) ne {}} {
8274 set i [lsearch -exact $arcids($a) $id]
8275 foreach t $arctags($a) {
8276 set j [lsearch -exact $arcids($a) $t]
8282 if {![info exists arcend($a)]} {
8286 if {[info exists idtags($id)]} {
8290 if {[info exists cached_atags($id)]} {
8291 return $cached_atags($id)
8299 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8300 set id [lindex $todo $i]
8302 set td [info exists hastaggeddescendent($id)]
8306 # ignore tags on starting node
8307 if {!$td && $i > 0} {
8308 if {[info exists idtags($id)]} {
8311 } elseif {[info exists cached_atags($id)]} {
8312 set tagloc($id) $cached_atags($id)
8316 foreach a $arcout($id) {
8317 if {!$td && $arctags($a) ne {}} {
8319 if {$arctags($a) ne {}} {
8320 lappend tagloc($id) [lindex $arctags($a) 0]
8323 if {![info exists arcend($a)]} continue
8325 if {$td || $arctags($a) ne {}} {
8326 set tomark [list $d]
8327 for {set j 0} {$j < [llength $tomark]} {incr j} {
8328 set dd [lindex $tomark $j]
8329 if {![info exists hastaggeddescendent($dd)]} {
8330 if {[info exists done($dd)]} {
8331 foreach b $arcout($dd) {
8332 if {[info exists arcend($b)]} {
8333 lappend tomark $arcend($b)
8336 if {[info exists tagloc($dd)]} {
8339 } elseif {[info exists queued($dd)]} {
8342 set hastaggeddescendent($dd) 1
8346 if {![info exists queued($d)]} {
8349 if {![info exists hastaggeddescendent($d)]} {
8355 set t2 [clock clicks -milliseconds]
8358 foreach id [array names tagloc] {
8359 if {![info exists hastaggeddescendent($id)]} {
8360 foreach t $tagloc($id) {
8361 if {[lsearch -exact $tags $t] < 0} {
8368 # remove tags that are ancestors of other tags
8369 for {set i 0} {$i < [llength $tags]} {incr i} {
8370 set a [lindex $tags $i]
8371 for {set j 0} {$j < $i} {incr j} {
8372 set b [lindex $tags $j]
8373 set r [anc_or_desc $a $b]
8375 set tags [lreplace $tags $j $j]
8378 } elseif {$r == 1} {
8379 set tags [lreplace $tags $i $i]
8386 if {[array names growing] ne {}} {
8387 # graph isn't finished, need to check if any tag could get
8388 # eclipsed by another tag coming later. Simply ignore any
8389 # tags that could later get eclipsed.
8392 if {[is_certain $origid $t]} {
8396 if {$tags eq $ctags} {
8397 set cached_atags($origid) $tags
8402 set cached_atags($origid) $tags
8404 set t3 [clock clicks -milliseconds]
8405 if {0 && $t3 - $t1 >= 100} {
8406 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8407 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8412 # Return the list of IDs that have heads that are descendents of id,
8413 # including id itself if it has a head.
8414 proc descheads {id} {
8415 global arcnos arcstart arcids archeads idheads cached_dheads
8418 if {![info exists allparents($id)]} {
8422 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8423 # part-way along an arc; check it first
8424 set a [lindex $arcnos($id) 0]
8425 if {$archeads($a) ne {}} {
8426 validate_archeads $a
8427 set i [lsearch -exact $arcids($a) $id]
8428 foreach t $archeads($a) {
8429 set j [lsearch -exact $arcids($a) $t]
8434 set id $arcstart($a)
8440 for {set i 0} {$i < [llength $todo]} {incr i} {
8441 set id [lindex $todo $i]
8442 if {[info exists cached_dheads($id)]} {
8443 set ret [concat $ret $cached_dheads($id)]
8445 if {[info exists idheads($id)]} {
8448 foreach a $arcnos($id) {
8449 if {$archeads($a) ne {}} {
8450 validate_archeads $a
8451 if {$archeads($a) ne {}} {
8452 set ret [concat $ret $archeads($a)]
8456 if {![info exists seen($d)]} {
8463 set ret [lsort -unique $ret]
8464 set cached_dheads($origid) $ret
8465 return [concat $ret $aret]
8468 proc addedtag {id} {
8469 global arcnos arcout cached_dtags cached_atags
8471 if {![info exists arcnos($id)]} return
8472 if {![info exists arcout($id)]} {
8473 recalcarc [lindex $arcnos($id) 0]
8475 catch {unset cached_dtags}
8476 catch {unset cached_atags}
8479 proc addedhead {hid head} {
8480 global arcnos arcout cached_dheads
8482 if {![info exists arcnos($hid)]} return
8483 if {![info exists arcout($hid)]} {
8484 recalcarc [lindex $arcnos($hid) 0]
8486 catch {unset cached_dheads}
8489 proc removedhead {hid head} {
8490 global cached_dheads
8492 catch {unset cached_dheads}
8495 proc movedhead {hid head} {
8496 global arcnos arcout cached_dheads
8498 if {![info exists arcnos($hid)]} return
8499 if {![info exists arcout($hid)]} {
8500 recalcarc [lindex $arcnos($hid) 0]
8502 catch {unset cached_dheads}
8505 proc changedrefs {} {
8506 global cached_dheads cached_dtags cached_atags
8507 global arctags archeads arcnos arcout idheads idtags
8509 foreach id [concat [array names idheads] [array names idtags]] {
8510 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8511 set a [lindex $arcnos($id) 0]
8512 if {![info exists donearc($a)]} {
8518 catch {unset cached_dtags}
8519 catch {unset cached_atags}
8520 catch {unset cached_dheads}
8523 proc rereadrefs {} {
8524 global idtags idheads idotherrefs mainheadid
8526 set refids [concat [array names idtags] \
8527 [array names idheads] [array names idotherrefs]]
8528 foreach id $refids {
8529 if {![info exists ref($id)]} {
8530 set ref($id) [listrefs $id]
8533 set oldmainhead $mainheadid
8536 set refids [lsort -unique [concat $refids [array names idtags] \
8537 [array names idheads] [array names idotherrefs]]]
8538 foreach id $refids {
8539 set v [listrefs $id]
8540 if {![info exists ref($id)] || $ref($id) != $v ||
8541 ($id eq $oldmainhead && $id ne $mainheadid) ||
8542 ($id eq $mainheadid && $id ne $oldmainhead)} {
8549 proc listrefs {id} {
8550 global idtags idheads idotherrefs
8553 if {[info exists idtags($id)]} {
8557 if {[info exists idheads($id)]} {
8561 if {[info exists idotherrefs($id)]} {
8562 set z $idotherrefs($id)
8564 return [list $x $y $z]
8567 proc showtag {tag isnew} {
8568 global ctext tagcontents tagids linknum tagobjid
8571 addtohistory [list showtag $tag 0]
8573 $ctext conf -state normal
8577 if {![info exists tagcontents($tag)]} {
8579 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8582 if {[info exists tagcontents($tag)]} {
8583 set text $tagcontents($tag)
8585 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8587 appendwithlinks $text {}
8588 $ctext conf -state disabled
8599 proc mkfontdisp {font top which} {
8600 global fontattr fontpref $font
8602 set fontpref($font) [set $font]
8603 button $top.${font}but -text $which -font optionfont \
8604 -command [list choosefont $font $which]
8605 label $top.$font -relief flat -font $font \
8606 -text $fontattr($font,family) -justify left
8607 grid x $top.${font}but $top.$font -sticky w
8610 proc choosefont {font which} {
8611 global fontparam fontlist fonttop fontattr
8613 set fontparam(which) $which
8614 set fontparam(font) $font
8615 set fontparam(family) [font actual $font -family]
8616 set fontparam(size) $fontattr($font,size)
8617 set fontparam(weight) $fontattr($font,weight)
8618 set fontparam(slant) $fontattr($font,slant)
8621 if {![winfo exists $top]} {
8623 eval font config sample [font actual $font]
8625 wm title $top [mc "Gitk font chooser"]
8626 label $top.l -textvariable fontparam(which)
8627 pack $top.l -side top
8628 set fontlist [lsort [font families]]
8630 listbox $top.f.fam -listvariable fontlist \
8631 -yscrollcommand [list $top.f.sb set]
8632 bind $top.f.fam <<ListboxSelect>> selfontfam
8633 scrollbar $top.f.sb -command [list $top.f.fam yview]
8634 pack $top.f.sb -side right -fill y
8635 pack $top.f.fam -side left -fill both -expand 1
8636 pack $top.f -side top -fill both -expand 1
8638 spinbox $top.g.size -from 4 -to 40 -width 4 \
8639 -textvariable fontparam(size) \
8640 -validatecommand {string is integer -strict %s}
8641 checkbutton $top.g.bold -padx 5 \
8642 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8643 -variable fontparam(weight) -onvalue bold -offvalue normal
8644 checkbutton $top.g.ital -padx 5 \
8645 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8646 -variable fontparam(slant) -onvalue italic -offvalue roman
8647 pack $top.g.size $top.g.bold $top.g.ital -side left
8648 pack $top.g -side top
8649 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8651 $top.c create text 100 25 -anchor center -text $which -font sample \
8652 -fill black -tags text
8653 bind $top.c <Configure> [list centertext $top.c]
8654 pack $top.c -side top -fill x
8656 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8657 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8658 grid $top.buts.ok $top.buts.can
8659 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8660 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8661 pack $top.buts -side bottom -fill x
8662 trace add variable fontparam write chg_fontparam
8665 $top.c itemconf text -text $which
8667 set i [lsearch -exact $fontlist $fontparam(family)]
8669 $top.f.fam selection set $i
8674 proc centertext {w} {
8675 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8679 global fontparam fontpref prefstop
8681 set f $fontparam(font)
8682 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8683 if {$fontparam(weight) eq "bold"} {
8684 lappend fontpref($f) "bold"
8686 if {$fontparam(slant) eq "italic"} {
8687 lappend fontpref($f) "italic"
8690 $w conf -text $fontparam(family) -font $fontpref($f)
8696 global fonttop fontparam
8698 if {[info exists fonttop]} {
8699 catch {destroy $fonttop}
8700 catch {font delete sample}
8706 proc selfontfam {} {
8707 global fonttop fontparam
8709 set i [$fonttop.f.fam curselection]
8711 set fontparam(family) [$fonttop.f.fam get $i]
8715 proc chg_fontparam {v sub op} {
8718 font config sample -$sub $fontparam($sub)
8722 global maxwidth maxgraphpct
8723 global oldprefs prefstop showneartags showlocalchanges
8724 global bgcolor fgcolor ctext diffcolors selectbgcolor
8725 global tabstop limitdiffs
8729 if {[winfo exists $top]} {
8733 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8734 limitdiffs tabstop} {
8735 set oldprefs($v) [set $v]
8738 wm title $top [mc "Gitk preferences"]
8739 label $top.ldisp -text [mc "Commit list display options"]
8740 grid $top.ldisp - -sticky w -pady 10
8741 label $top.spacer -text " "
8742 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8744 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8745 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8746 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8748 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8749 grid x $top.maxpctl $top.maxpct -sticky w
8750 frame $top.showlocal
8751 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8752 checkbutton $top.showlocal.b -variable showlocalchanges
8753 pack $top.showlocal.b $top.showlocal.l -side left
8754 grid x $top.showlocal -sticky w
8756 label $top.ddisp -text [mc "Diff display options"]
8757 grid $top.ddisp - -sticky w -pady 10
8758 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8759 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8760 grid x $top.tabstopl $top.tabstop -sticky w
8762 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8763 checkbutton $top.ntag.b -variable showneartags
8764 pack $top.ntag.b $top.ntag.l -side left
8765 grid x $top.ntag -sticky w
8767 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8768 checkbutton $top.ldiff.b -variable limitdiffs
8769 pack $top.ldiff.b $top.ldiff.l -side left
8770 grid x $top.ldiff -sticky w
8772 label $top.cdisp -text [mc "Colors: press to choose"]
8773 grid $top.cdisp - -sticky w -pady 10
8774 label $top.bg -padx 40 -relief sunk -background $bgcolor
8775 button $top.bgbut -text [mc "Background"] -font optionfont \
8776 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8777 grid x $top.bgbut $top.bg -sticky w
8778 label $top.fg -padx 40 -relief sunk -background $fgcolor
8779 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8780 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8781 grid x $top.fgbut $top.fg -sticky w
8782 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8783 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8784 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8785 [list $ctext tag conf d0 -foreground]]
8786 grid x $top.diffoldbut $top.diffold -sticky w
8787 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8788 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8789 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8790 [list $ctext tag conf d1 -foreground]]
8791 grid x $top.diffnewbut $top.diffnew -sticky w
8792 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8793 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8794 -command [list choosecolor diffcolors 2 $top.hunksep \
8795 "diff hunk header" \
8796 [list $ctext tag conf hunksep -foreground]]
8797 grid x $top.hunksepbut $top.hunksep -sticky w
8798 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8799 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8800 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8801 grid x $top.selbgbut $top.selbgsep -sticky w
8803 label $top.cfont -text [mc "Fonts: press to choose"]
8804 grid $top.cfont - -sticky w -pady 10
8805 mkfontdisp mainfont $top [mc "Main font"]
8806 mkfontdisp textfont $top [mc "Diff display font"]
8807 mkfontdisp uifont $top [mc "User interface font"]
8810 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8811 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8812 grid $top.buts.ok $top.buts.can
8813 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8814 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8815 grid $top.buts - - -pady 10 -sticky ew
8816 bind $top <Visibility> "focus $top.buts.ok"
8819 proc choosecolor {v vi w x cmd} {
8822 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8823 -title [mc "Gitk: choose color for %s" $x]]
8824 if {$c eq {}} return
8825 $w conf -background $c
8831 global bglist cflist
8833 $w configure -selectbackground $c
8835 $cflist tag configure highlight \
8836 -background [$cflist cget -selectbackground]
8837 allcanvs itemconf secsel -fill $c
8844 $w conf -background $c
8852 $w conf -foreground $c
8854 allcanvs itemconf text -fill $c
8855 $canv itemconf circle -outline $c
8859 global oldprefs prefstop
8861 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8862 limitdiffs tabstop} {
8864 set $v $oldprefs($v)
8866 catch {destroy $prefstop}
8872 global maxwidth maxgraphpct
8873 global oldprefs prefstop showneartags showlocalchanges
8874 global fontpref mainfont textfont uifont
8875 global limitdiffs treediffs
8877 catch {destroy $prefstop}
8881 if {$mainfont ne $fontpref(mainfont)} {
8882 set mainfont $fontpref(mainfont)
8883 parsefont mainfont $mainfont
8884 eval font configure mainfont [fontflags mainfont]
8885 eval font configure mainfontbold [fontflags mainfont 1]
8889 if {$textfont ne $fontpref(textfont)} {
8890 set textfont $fontpref(textfont)
8891 parsefont textfont $textfont
8892 eval font configure textfont [fontflags textfont]
8893 eval font configure textfontbold [fontflags textfont 1]
8895 if {$uifont ne $fontpref(uifont)} {
8896 set uifont $fontpref(uifont)
8897 parsefont uifont $uifont
8898 eval font configure uifont [fontflags uifont]
8901 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8902 if {$showlocalchanges} {
8908 if {$limitdiffs != $oldprefs(limitdiffs)} {
8909 # treediffs elements are limited by path
8910 catch {unset treediffs}
8912 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8913 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8915 } elseif {$showneartags != $oldprefs(showneartags) ||
8916 $limitdiffs != $oldprefs(limitdiffs)} {
8921 proc formatdate {d} {
8922 global datetimeformat
8924 set d [clock format $d -format $datetimeformat]
8929 # This list of encoding names and aliases is distilled from
8930 # http://www.iana.org/assignments/character-sets.
8931 # Not all of them are supported by Tcl.
8932 set encoding_aliases {
8933 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8934 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8935 { ISO-10646-UTF-1 csISO10646UTF1 }
8936 { ISO_646.basic:1983 ref csISO646basic1983 }
8937 { INVARIANT csINVARIANT }
8938 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8939 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8940 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8941 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8942 { NATS-DANO iso-ir-9-1 csNATSDANO }
8943 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8944 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8945 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8946 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8947 { ISO-2022-KR csISO2022KR }
8949 { ISO-2022-JP csISO2022JP }
8950 { ISO-2022-JP-2 csISO2022JP2 }
8951 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8953 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8954 { IT iso-ir-15 ISO646-IT csISO15Italian }
8955 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8956 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8957 { greek7-old iso-ir-18 csISO18Greek7Old }
8958 { latin-greek iso-ir-19 csISO19LatinGreek }
8959 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8960 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8961 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8962 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8963 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8964 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8965 { INIS iso-ir-49 csISO49INIS }
8966 { INIS-8 iso-ir-50 csISO50INIS8 }
8967 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8968 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8969 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8970 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8971 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8972 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8974 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8975 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8976 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8977 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8978 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8979 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8980 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8981 { greek7 iso-ir-88 csISO88Greek7 }
8982 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8983 { iso-ir-90 csISO90 }
8984 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8985 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8986 csISO92JISC62991984b }
8987 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8988 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8989 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8990 csISO95JIS62291984handadd }
8991 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8992 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8993 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8994 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8996 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8997 { T.61-7bit iso-ir-102 csISO102T617bit }
8998 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8999 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9000 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9001 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9002 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9003 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9004 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9005 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9006 arabic csISOLatinArabic }
9007 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9008 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9009 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9010 greek greek8 csISOLatinGreek }
9011 { T.101-G2 iso-ir-128 csISO128T101G2 }
9012 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9014 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9015 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9016 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9017 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9018 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9019 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9020 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9021 csISOLatinCyrillic }
9022 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9023 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9024 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9025 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9026 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9027 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9028 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9029 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9030 { ISO_10367-box iso-ir-155 csISO10367Box }
9031 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9032 { latin-lap lap iso-ir-158 csISO158Lap }
9033 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9034 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9037 { JIS_X0201 X0201 csHalfWidthKatakana }
9038 { KSC5636 ISO646-KR csKSC5636 }
9039 { ISO-10646-UCS-2 csUnicode }
9040 { ISO-10646-UCS-4 csUCS4 }
9041 { DEC-MCS dec csDECMCS }
9042 { hp-roman8 roman8 r8 csHPRoman8 }
9043 { macintosh mac csMacintosh }
9044 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9046 { IBM038 EBCDIC-INT cp038 csIBM038 }
9047 { IBM273 CP273 csIBM273 }
9048 { IBM274 EBCDIC-BE CP274 csIBM274 }
9049 { IBM275 EBCDIC-BR cp275 csIBM275 }
9050 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9051 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9052 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9053 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9054 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9055 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9056 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9057 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9058 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9059 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9060 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9061 { IBM437 cp437 437 csPC8CodePage437 }
9062 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9063 { IBM775 cp775 csPC775Baltic }
9064 { IBM850 cp850 850 csPC850Multilingual }
9065 { IBM851 cp851 851 csIBM851 }
9066 { IBM852 cp852 852 csPCp852 }
9067 { IBM855 cp855 855 csIBM855 }
9068 { IBM857 cp857 857 csIBM857 }
9069 { IBM860 cp860 860 csIBM860 }
9070 { IBM861 cp861 861 cp-is csIBM861 }
9071 { IBM862 cp862 862 csPC862LatinHebrew }
9072 { IBM863 cp863 863 csIBM863 }
9073 { IBM864 cp864 csIBM864 }
9074 { IBM865 cp865 865 csIBM865 }
9075 { IBM866 cp866 866 csIBM866 }
9076 { IBM868 CP868 cp-ar csIBM868 }
9077 { IBM869 cp869 869 cp-gr csIBM869 }
9078 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9079 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9080 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9081 { IBM891 cp891 csIBM891 }
9082 { IBM903 cp903 csIBM903 }
9083 { IBM904 cp904 904 csIBBM904 }
9084 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9085 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9086 { IBM1026 CP1026 csIBM1026 }
9087 { EBCDIC-AT-DE csIBMEBCDICATDE }
9088 { EBCDIC-AT-DE-A csEBCDICATDEA }
9089 { EBCDIC-CA-FR csEBCDICCAFR }
9090 { EBCDIC-DK-NO csEBCDICDKNO }
9091 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9092 { EBCDIC-FI-SE csEBCDICFISE }
9093 { EBCDIC-FI-SE-A csEBCDICFISEA }
9094 { EBCDIC-FR csEBCDICFR }
9095 { EBCDIC-IT csEBCDICIT }
9096 { EBCDIC-PT csEBCDICPT }
9097 { EBCDIC-ES csEBCDICES }
9098 { EBCDIC-ES-A csEBCDICESA }
9099 { EBCDIC-ES-S csEBCDICESS }
9100 { EBCDIC-UK csEBCDICUK }
9101 { EBCDIC-US csEBCDICUS }
9102 { UNKNOWN-8BIT csUnknown8BiT }
9103 { MNEMONIC csMnemonic }
9108 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9109 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9110 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9111 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9112 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9113 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9114 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9115 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9116 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9117 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9118 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9119 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9120 { IBM1047 IBM-1047 }
9121 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9122 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9123 { UNICODE-1-1 csUnicode11 }
9126 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9127 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9129 { ISO-8859-15 ISO_8859-15 Latin-9 }
9130 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9131 { GBK CP936 MS936 windows-936 }
9132 { JIS_Encoding csJISEncoding }
9133 { Shift_JIS MS_Kanji csShiftJIS }
9134 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9136 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9137 { ISO-10646-UCS-Basic csUnicodeASCII }
9138 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9139 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9140 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9141 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9142 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9143 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9144 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9145 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9146 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9147 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9148 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9149 { Ventura-US csVenturaUS }
9150 { Ventura-International csVenturaInternational }
9151 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9152 { PC8-Turkish csPC8Turkish }
9153 { IBM-Symbols csIBMSymbols }
9154 { IBM-Thai csIBMThai }
9155 { HP-Legal csHPLegal }
9156 { HP-Pi-font csHPPiFont }
9157 { HP-Math8 csHPMath8 }
9158 { Adobe-Symbol-Encoding csHPPSMath }
9159 { HP-DeskTop csHPDesktop }
9160 { Ventura-Math csVenturaMath }
9161 { Microsoft-Publishing csMicrosoftPublishing }
9162 { Windows-31J csWindows31J }
9167 proc tcl_encoding {enc} {
9168 global encoding_aliases
9169 set names [encoding names]
9170 set lcnames [string tolower $names]
9171 set enc [string tolower $enc]
9172 set i [lsearch -exact $lcnames $enc]
9174 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9175 if {[regsub {^iso[-_]} $enc iso encx]} {
9176 set i [lsearch -exact $lcnames $encx]
9180 foreach l $encoding_aliases {
9181 set ll [string tolower $l]
9182 if {[lsearch -exact $ll $enc] < 0} continue
9183 # look through the aliases for one that tcl knows about
9185 set i [lsearch -exact $lcnames $e]
9187 if {[regsub {^iso[-_]} $e iso ex]} {
9188 set i [lsearch -exact $lcnames $ex]
9197 return [lindex $names $i]
9202 # First check that Tcl/Tk is recent enough
9203 if {[catch {package require Tk 8.4} err]} {
9204 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9205 Gitk requires at least Tcl/Tk 8.4."]
9211 set wrcomcmd "git diff-tree --stdin -p --pretty"
9215 set gitencoding [exec git config --get i18n.commitencoding]
9217 if {$gitencoding == ""} {
9218 set gitencoding "utf-8"
9220 set tclencoding [tcl_encoding $gitencoding]
9221 if {$tclencoding == {}} {
9222 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9225 set mainfont {Helvetica 9}
9226 set textfont {Courier 9}
9227 set uifont {Helvetica 9 bold}
9229 set findmergefiles 0
9237 set cmitmode "patch"
9238 set wrapcomment "none"
9242 set showlocalchanges 1
9244 set datetimeformat "%Y-%m-%d %H:%M:%S"
9246 set colors {green red blue magenta darkgrey brown orange}
9249 set diffcolors {red "#00a000" blue}
9252 set selectbgcolor gray85
9254 ## For msgcat loading, first locate the installation location.
9255 if { [info exists ::env(GITK_MSGSDIR)] } {
9256 ## Msgsdir was manually set in the environment.
9257 set gitk_msgsdir $::env(GITK_MSGSDIR)
9259 ## Let's guess the prefix from argv0.
9260 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9261 set gitk_libdir [file join $gitk_prefix share gitk lib]
9262 set gitk_msgsdir [file join $gitk_libdir msgs]
9266 ## Internationalization (i18n) through msgcat and gettext. See
9267 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9268 package require msgcat
9269 namespace import ::msgcat::mc
9270 ## And eventually load the actual message catalog
9271 ::msgcat::mcload $gitk_msgsdir
9273 catch {source ~/.gitk}
9275 font create optionfont -family sans-serif -size -12
9277 parsefont mainfont $mainfont
9278 eval font create mainfont [fontflags mainfont]
9279 eval font create mainfontbold [fontflags mainfont 1]
9281 parsefont textfont $textfont
9282 eval font create textfont [fontflags textfont]
9283 eval font create textfontbold [fontflags textfont 1]
9285 parsefont uifont $uifont
9286 eval font create uifont [fontflags uifont]
9290 # check that we can find a .git directory somewhere...
9291 if {[catch {set gitdir [gitdir]}]} {
9292 show_error {} . [mc "Cannot find a git repository here."]
9295 if {![file isdirectory $gitdir]} {
9296 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9302 set cmdline_files {}
9307 "-d" { set datemode 1 }
9310 lappend revtreeargs $arg
9313 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9317 lappend revtreeargs $arg
9323 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9324 # no -- on command line, but some arguments (other than -d)
9326 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9327 set cmdline_files [split $f "\n"]
9328 set n [llength $cmdline_files]
9329 set revtreeargs [lrange $revtreeargs 0 end-$n]
9330 # Unfortunately git rev-parse doesn't produce an error when
9331 # something is both a revision and a filename. To be consistent
9332 # with git log and git rev-list, check revtreeargs for filenames.
9333 foreach arg $revtreeargs {
9334 if {[file exists $arg]} {
9335 show_error {} . [mc "Ambiguous argument '%s': both revision\
9341 # unfortunately we get both stdout and stderr in $err,
9342 # so look for "fatal:".
9343 set i [string first "fatal:" $err]
9345 set err [string range $err [expr {$i + 6}] end]
9347 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9353 # find the list of unmerged files
9357 set fd [open "| git ls-files -u" r]
9359 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9362 while {[gets $fd line] >= 0} {
9363 set i [string first "\t" $line]
9364 if {$i < 0} continue
9365 set fname [string range $line [expr {$i+1}] end]
9366 if {[lsearch -exact $mlist $fname] >= 0} continue
9368 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9369 lappend mlist $fname
9374 if {$nr_unmerged == 0} {
9375 show_error {} . [mc "No files selected: --merge specified but\
9376 no files are unmerged."]
9378 show_error {} . [mc "No files selected: --merge specified but\
9379 no unmerged files are within file limit."]
9383 set cmdline_files $mlist
9386 set nullid "0000000000000000000000000000000000000000"
9387 set nullid2 "0000000000000000000000000000000000000001"
9389 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9396 set highlight_paths {}
9398 set searchdirn -forwards
9402 set markingmatches 0
9403 set linkentercount 0
9404 set need_redisplay 0
9411 set selectedhlview [mc "None"]
9412 set highlight_related [mc "None"]
9413 set highlight_files {}
9426 # wait for the window to become visible
9428 wm title . "[file tail $argv0]: [file tail [pwd]]"
9431 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9432 # create a view for the files/dirs specified on the command line
9436 set viewname(1) [mc "Command line"]
9437 set viewfiles(1) $cmdline_files
9438 set viewargs(1) $revtreeargs
9441 .bar.view entryconf [mc "Edit view..."] -state normal
9442 .bar.view entryconf [mc "Delete view"] -state normal
9445 if {[info exists permviews]} {
9446 foreach v $permviews {
9449 set viewname($n) [lindex $v 0]
9450 set viewfiles($n) [lindex $v 1]
9451 set viewargs($n) [lindex $v 2]