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 proc unmerged_files
{files
} {
96 # find the list of unmerged files
100 set fd
[open
"| git ls-files -u" r
]
102 show_error
{} .
"[mc "Couldn
't get list of unmerged files:"] $err"
105 while {[gets $fd line] >= 0} {
106 set i [string first "\t" $line]
108 set fname [string range $line [expr {$i+1}] end]
109 if {[lsearch -exact $mlist $fname] >= 0} continue
111 if {$files eq {} || [path_filter $files $fname]} {
119 proc parseviewargs {n arglist} {
120 global viewargs vdatemode vmergeonly
125 foreach arg $viewargs($n) {
126 switch -glob -- $arg {
143 # Start off a git log process and arrange to read its output
144 proc start_rev_list {view} {
145 global startmsecs commitidx viewcomplete
146 global commfd leftover tclencoding
147 global viewargs viewargscmd vactualargs viewfiles vfilelimit
148 global showlocalchanges commitinterest mainheadid
149 global progressdirn progresscoords proglastnc curview
150 global viewactive loginstance viewinstances vmergeonly
151 global pending_select mainheadid
153 set startmsecs [clock clicks -milliseconds]
154 set commitidx($view) 0
155 # these are set this way for the error exits
156 set viewcomplete($view) 1
157 set viewactive($view) 0
160 set args $viewargs($view)
161 if {$viewargscmd($view) ne {}} {
163 set str [exec sh -c $viewargscmd($view)]
165 error_popup "Error executing --argscmd command: $err"
168 set args [concat $args [split $str "\n"]]
170 set args [parseviewargs $view $args]
171 set vactualargs($view) $args
173 set files $viewfiles($view)
174 if {$vmergeonly($view)} {
175 set files [unmerged_files $files]
178 if {$nr_unmerged == 0} {
179 error_popup [mc "No files selected: --merge specified but\
180 no files are unmerged."]
182 error_popup [mc "No files selected: --merge specified but\
183 no unmerged files are within file limit."]
188 set vfilelimit($view) $files
191 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
192 --boundary $args "--" $files] r]
194 error_popup "[mc "Error executing git log:"] $err"
197 set i [incr loginstance]
198 set viewinstances($view) [list $i]
201 if {$showlocalchanges} {
202 lappend commitinterest($mainheadid) {dodiffindex}
204 fconfigure $fd -blocking 0 -translation lf -eofchar {}
205 if {$tclencoding != {}} {
206 fconfigure $fd -encoding $tclencoding
208 filerun $fd [list getcommitlines $fd $i $view 0]
209 nowbusy $view [mc "Reading"]
210 if {$view == $curview} {
212 set progresscoords {0 0}
214 set pending_select $mainheadid
216 set viewcomplete($view) 0
217 set viewactive($view) 1
221 proc stop_rev_list {view} {
222 global commfd viewinstances leftover
224 foreach inst $viewinstances($view) {
225 set fd $commfd($inst)
233 unset leftover($inst)
235 set viewinstances($view) {}
239 global canv curview need_redisplay viewactive
242 if {[start_rev_list $curview]} {
243 show_status [mc "Reading commits..."]
246 show_status [mc "No commits selected"]
250 proc updatecommits {} {
251 global curview vactualargs vfilelimit viewinstances
252 global viewactive viewcomplete loginstance tclencoding mainheadid
253 global startmsecs commfd showneartags showlocalchanges leftover
254 global mainheadid pending_select
257 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
258 set oldmainid $mainheadid
260 if {$showlocalchanges} {
261 if {$mainheadid ne $oldmainid} {
264 if {[commitinview $mainheadid $curview]} {
270 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
271 --boundary $vactualargs($view) --not [seeds $view] \
272 "--" $vfilelimit($view)] r]
274 error_popup "Error executing git log: $err"
277 if {$viewactive($view) == 0} {
278 set startmsecs [clock clicks -milliseconds]
280 set i [incr loginstance]
281 lappend viewinstances($view) $i
284 fconfigure $fd -blocking 0 -translation lf -eofchar {}
285 if {$tclencoding != {}} {
286 fconfigure $fd -encoding $tclencoding
288 filerun $fd [list getcommitlines $fd $i $view 1]
289 incr viewactive($view)
290 set viewcomplete($view) 0
291 set pending_select $mainheadid
292 nowbusy $view "Reading"
298 proc reloadcommits {} {
299 global curview viewcomplete selectedline currentid thickerline
300 global showneartags treediffs commitinterest cached_commitrow
301 global progresscoords targetid
303 if {!$viewcomplete($curview)} {
304 stop_rev_list $curview
305 set progresscoords {0 0}
309 catch {unset selectedline}
310 catch {unset currentid}
311 catch {unset thickerline}
312 catch {unset treediffs}
319 catch {unset commitinterest}
320 catch {unset cached_commitrow}
321 catch {unset targetid}
327 # This makes a string representation of a positive integer which
328 # sorts as a string in numerical order
331 return [format "%x" $n]
332 } elseif {$n < 256} {
333 return [format "x%.2x" $n]
334 } elseif {$n < 65536} {
335 return [format "y%.4x" $n]
337 return [format "z%.8x" $n]
340 # Procedures used in reordering commits from git log (without
341 # --topo-order) into the order for display.
343 proc varcinit {view} {
344 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
345 global vtokmod varcmod vrowmod varcix vlastins
347 set varcstart($view) {{}}
348 set vupptr($view) {0}
349 set vdownptr($view) {0}
350 set vleftptr($view) {0}
351 set vbackptr($view) {0}
352 set varctok($view) {{}}
353 set varcrow($view) {{}}
354 set vtokmod($view) {}
357 set varcix($view) {{}}
358 set vlastins($view) {0}
361 proc resetvarcs {view} {
362 global varcid varccommits parents children vseedcount ordertok
364 foreach vid [array names varcid $view,*] {
369 # some commits might have children but haven't been seen yet
370 foreach vid
[array names children
$view,*] {
373 foreach va
[array names varccommits
$view,*] {
374 unset varccommits
($va)
376 foreach vd
[array names vseedcount
$view,*] {
377 unset vseedcount
($vd)
379 catch
{unset ordertok
}
382 # returns a list of the commits with no children
384 global vdownptr vleftptr varcstart
387 set a
[lindex
$vdownptr($v) 0]
389 lappend ret
[lindex
$varcstart($v) $a]
390 set a
[lindex
$vleftptr($v) $a]
395 proc newvarc
{view id
} {
396 global varcid varctok parents children vdatemode
397 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
398 global commitdata commitinfo vseedcount varccommits vlastins
400 set a
[llength
$varctok($view)]
402 if {[llength
$children($vid)] == 0 ||
$vdatemode($view)} {
403 if {![info exists commitinfo
($id)]} {
404 parsecommit
$id $commitdata($id) 1
406 set cdate
[lindex
$commitinfo($id) 4]
407 if {![string is integer
-strict $cdate]} {
410 if {![info exists vseedcount
($view,$cdate)]} {
411 set vseedcount
($view,$cdate) -1
413 set c
[incr vseedcount
($view,$cdate)]
414 set cdate
[expr {$cdate ^
0xffffffff}]
415 set tok
"s[strrep $cdate][strrep $c]"
420 if {[llength
$children($vid)] > 0} {
421 set kid
[lindex
$children($vid) end
]
422 set k
$varcid($view,$kid)
423 if {[string compare
[lindex
$varctok($view) $k] $tok] > 0} {
426 set tok
[lindex
$varctok($view) $k]
430 set i
[lsearch
-exact $parents($view,$ki) $id]
431 set j
[expr {[llength
$parents($view,$ki)] - 1 - $i}]
432 append tok
[strrep
$j]
434 set c
[lindex
$vlastins($view) $ka]
435 if {$c == 0 ||
[string compare
$tok [lindex
$varctok($view) $c]] < 0} {
437 set b
[lindex
$vdownptr($view) $ka]
439 set b
[lindex
$vleftptr($view) $c]
441 while {$b != 0 && [string compare
$tok [lindex
$varctok($view) $b]] >= 0} {
443 set b
[lindex
$vleftptr($view) $c]
446 lset vdownptr
($view) $ka $a
447 lappend vbackptr
($view) 0
449 lset vleftptr
($view) $c $a
450 lappend vbackptr
($view) $c
452 lset vlastins
($view) $ka $a
453 lappend vupptr
($view) $ka
454 lappend vleftptr
($view) $b
456 lset vbackptr
($view) $b $a
458 lappend varctok
($view) $tok
459 lappend varcstart
($view) $id
460 lappend vdownptr
($view) 0
461 lappend varcrow
($view) {}
462 lappend varcix
($view) {}
463 set varccommits
($view,$a) {}
464 lappend vlastins
($view) 0
468 proc splitvarc
{p v
} {
469 global varcid varcstart varccommits varctok
470 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
472 set oa
$varcid($v,$p)
473 set ac
$varccommits($v,$oa)
474 set i
[lsearch
-exact $varccommits($v,$oa) $p]
476 set na
[llength
$varctok($v)]
477 # "%" sorts before "0"...
478 set tok
"[lindex $varctok($v) $oa]%[strrep $i]"
479 lappend varctok
($v) $tok
480 lappend varcrow
($v) {}
481 lappend varcix
($v) {}
482 set varccommits
($v,$oa) [lrange
$ac 0 [expr {$i - 1}]]
483 set varccommits
($v,$na) [lrange
$ac $i end
]
484 lappend varcstart
($v) $p
485 foreach id
$varccommits($v,$na) {
486 set varcid
($v,$id) $na
488 lappend vdownptr
($v) [lindex
$vdownptr($v) $oa]
489 lappend vlastins
($v) [lindex
$vlastins($v) $oa]
490 lset vdownptr
($v) $oa $na
491 lset vlastins
($v) $oa 0
492 lappend vupptr
($v) $oa
493 lappend vleftptr
($v) 0
494 lappend vbackptr
($v) 0
495 for {set b
[lindex
$vdownptr($v) $na]} {$b != 0} {set b
[lindex
$vleftptr($v) $b]} {
496 lset vupptr
($v) $b $na
500 proc renumbervarc
{a v
} {
501 global parents children varctok varcstart varccommits
502 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
504 set t1
[clock clicks
-milliseconds]
510 if {[info exists isrelated
($a)]} {
512 set id
[lindex
$varccommits($v,$a) end
]
513 foreach p
$parents($v,$id) {
514 if {[info exists varcid
($v,$p)]} {
515 set isrelated
($varcid($v,$p)) 1
520 set b
[lindex
$vdownptr($v) $a]
523 set b
[lindex
$vleftptr($v) $a]
525 set a
[lindex
$vupptr($v) $a]
531 if {![info exists kidchanged
($a)]} continue
532 set id
[lindex
$varcstart($v) $a]
533 if {[llength
$children($v,$id)] > 1} {
534 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
537 set oldtok
[lindex
$varctok($v) $a]
538 if {!$vdatemode($v)} {
544 set kid
[last_real_child
$v,$id]
546 set k
$varcid($v,$kid)
547 if {[string compare
[lindex
$varctok($v) $k] $tok] > 0} {
550 set tok
[lindex
$varctok($v) $k]
554 set i
[lsearch
-exact $parents($v,$ki) $id]
555 set j
[expr {[llength
$parents($v,$ki)] - 1 - $i}]
556 append tok
[strrep
$j]
558 if {$tok eq
$oldtok} {
561 set id
[lindex
$varccommits($v,$a) end
]
562 foreach p
$parents($v,$id) {
563 if {[info exists varcid
($v,$p)]} {
564 set kidchanged
($varcid($v,$p)) 1
569 lset varctok
($v) $a $tok
570 set b
[lindex
$vupptr($v) $a]
572 if {[string compare
[lindex
$varctok($v) $ka] $vtokmod($v)] < 0} {
575 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
578 set c
[lindex
$vbackptr($v) $a]
579 set d
[lindex
$vleftptr($v) $a]
581 lset vdownptr
($v) $b $d
583 lset vleftptr
($v) $c $d
586 lset vbackptr
($v) $d $c
588 if {[lindex
$vlastins($v) $b] == $a} {
589 lset vlastins
($v) $b $c
591 lset vupptr
($v) $a $ka
592 set c
[lindex
$vlastins($v) $ka]
594 [string compare
$tok [lindex
$varctok($v) $c]] < 0} {
596 set b
[lindex
$vdownptr($v) $ka]
598 set b
[lindex
$vleftptr($v) $c]
601 [string compare
$tok [lindex
$varctok($v) $b]] >= 0} {
603 set b
[lindex
$vleftptr($v) $c]
606 lset vdownptr
($v) $ka $a
607 lset vbackptr
($v) $a 0
609 lset vleftptr
($v) $c $a
610 lset vbackptr
($v) $a $c
612 lset vleftptr
($v) $a $b
614 lset vbackptr
($v) $b $a
616 lset vlastins
($v) $ka $a
619 foreach id
[array names sortkids
] {
620 if {[llength
$children($v,$id)] > 1} {
621 set children
($v,$id) [lsort
-command [list vtokcmp
$v] \
625 set t2
[clock clicks
-milliseconds]
626 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
629 # Fix up the graph after we have found out that in view $v,
630 # $p (a commit that we have already seen) is actually the parent
631 # of the last commit in arc $a.
632 proc fix_reversal
{p a v
} {
633 global varcid varcstart varctok vupptr
635 set pa
$varcid($v,$p)
636 if {$p ne
[lindex
$varcstart($v) $pa]} {
638 set pa
$varcid($v,$p)
640 # seeds always need to be renumbered
641 if {[lindex
$vupptr($v) $pa] == 0 ||
642 [string compare
[lindex
$varctok($v) $a] \
643 [lindex
$varctok($v) $pa]] > 0} {
648 proc insertrow
{id p v
} {
649 global cmitlisted children parents varcid varctok vtokmod
650 global varccommits ordertok commitidx numcommits curview
651 global targetid targetrow
655 set cmitlisted
($vid) 1
656 set children
($vid) {}
657 set parents
($vid) [list
$p]
658 set a
[newvarc
$v $id]
660 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] < 0} {
663 lappend varccommits
($v,$a) $id
665 if {[llength
[lappend children
($vp) $id]] > 1} {
666 set children
($vp) [lsort
-command [list vtokcmp
$v] $children($vp)]
667 catch
{unset ordertok
}
669 fix_reversal
$p $a $v
671 if {$v == $curview} {
672 set numcommits
$commitidx($v)
674 if {[info exists targetid
]} {
675 if {![comes_before
$targetid $p]} {
682 proc insertfakerow
{id p
} {
683 global varcid varccommits parents children cmitlisted
684 global commitidx varctok vtokmod targetid targetrow curview numcommits
688 set i
[lsearch
-exact $varccommits($v,$a) $p]
690 puts
"oops: insertfakerow can't find [shortids $p] on arc $a"
693 set children
($v,$id) {}
694 set parents
($v,$id) [list
$p]
695 set varcid
($v,$id) $a
696 lappend children
($v,$p) $id
697 set cmitlisted
($v,$id) 1
698 set numcommits
[incr commitidx
($v)]
699 # note we deliberately don't update varcstart($v) even if $i == 0
700 set varccommits
($v,$a) [linsert
$varccommits($v,$a) $i $id]
702 if {[info exists targetid
]} {
703 if {![comes_before
$targetid $p]} {
711 proc removefakerow
{id
} {
712 global varcid varccommits parents children commitidx
713 global varctok vtokmod cmitlisted currentid selectedline
714 global targetid curview numcommits
717 if {[llength
$parents($v,$id)] != 1} {
718 puts
"oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
721 set p
[lindex
$parents($v,$id) 0]
722 set a
$varcid($v,$id)
723 set i
[lsearch
-exact $varccommits($v,$a) $id]
725 puts
"oops: removefakerow can't find [shortids $id] on arc $a"
729 set varccommits
($v,$a) [lreplace
$varccommits($v,$a) $i $i]
730 unset parents
($v,$id)
731 unset children
($v,$id)
732 unset cmitlisted
($v,$id)
733 set numcommits
[incr commitidx
($v) -1]
734 set j
[lsearch
-exact $children($v,$p) $id]
736 set children
($v,$p) [lreplace
$children($v,$p) $j $j]
739 if {[info exist currentid
] && $id eq
$currentid} {
743 if {[info exists targetid
] && $targetid eq
$id} {
750 proc first_real_child
{vp
} {
751 global children nullid nullid2
753 foreach id
$children($vp) {
754 if {$id ne
$nullid && $id ne
$nullid2} {
761 proc last_real_child
{vp
} {
762 global children nullid nullid2
764 set kids
$children($vp)
765 for {set i
[llength
$kids]} {[incr i
-1] >= 0} {} {
766 set id
[lindex
$kids $i]
767 if {$id ne
$nullid && $id ne
$nullid2} {
774 proc vtokcmp
{v a b
} {
775 global varctok varcid
777 return [string compare
[lindex
$varctok($v) $varcid($v,$a)] \
778 [lindex
$varctok($v) $varcid($v,$b)]]
781 # This assumes that if lim is not given, the caller has checked that
782 # arc a's token is less than $vtokmod($v)
783 proc modify_arc
{v a
{lim
{}}} {
784 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
787 set c
[string compare
[lindex
$varctok($v) $a] $vtokmod($v)]
790 set r
[lindex
$varcrow($v) $a]
791 if {$r ne
{} && $vrowmod($v) <= $r + $lim} return
794 set vtokmod
($v) [lindex
$varctok($v) $a]
796 if {$v == $curview} {
797 while {$a != 0 && [lindex
$varcrow($v) $a] eq
{}} {
798 set a
[lindex
$vupptr($v) $a]
804 set lim
[llength
$varccommits($v,$a)]
806 set r
[expr {[lindex
$varcrow($v) $a] + $lim}]
813 proc update_arcrows
{v
} {
814 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
815 global varcid vrownum varcorder varcix varccommits
816 global vupptr vdownptr vleftptr varctok
817 global displayorder parentlist curview cached_commitrow
819 if {$vrowmod($v) == $commitidx($v)} return
820 if {$v == $curview} {
821 if {[llength
$displayorder] > $vrowmod($v)} {
822 set displayorder
[lrange
$displayorder 0 [expr {$vrowmod($v) - 1}]]
823 set parentlist
[lrange
$parentlist 0 [expr {$vrowmod($v) - 1}]]
825 catch
{unset cached_commitrow
}
827 set narctot
[expr {[llength
$varctok($v)] - 1}]
829 while {$a != 0 && [lindex
$varcix($v) $a] eq
{}} {
830 # go up the tree until we find something that has a row number,
831 # or we get to a seed
832 set a
[lindex
$vupptr($v) $a]
835 set a
[lindex
$vdownptr($v) 0]
838 set varcorder
($v) [list
$a]
840 lset varcrow
($v) $a 0
844 set arcn
[lindex
$varcix($v) $a]
845 if {[llength
$vrownum($v)] > $arcn + 1} {
846 set vrownum
($v) [lrange
$vrownum($v) 0 $arcn]
847 set varcorder
($v) [lrange
$varcorder($v) 0 $arcn]
849 set row
[lindex
$varcrow($v) $a]
853 incr row
[llength
$varccommits($v,$a)]
854 # go down if possible
855 set b
[lindex
$vdownptr($v) $a]
857 # if not, go left, or go up until we can go left
859 set b
[lindex
$vleftptr($v) $a]
861 set a
[lindex
$vupptr($v) $a]
867 lappend vrownum
($v) $row
868 lappend varcorder
($v) $a
869 lset varcix
($v) $a $arcn
870 lset varcrow
($v) $a $row
872 set vtokmod
($v) [lindex
$varctok($v) $p]
875 if {[info exists currentid
]} {
876 set selectedline
[rowofcommit
$currentid]
880 # Test whether view $v contains commit $id
881 proc commitinview
{id v
} {
884 return [info exists varcid
($v,$id)]
887 # Return the row number for commit $id in the current view
888 proc rowofcommit
{id
} {
889 global varcid varccommits varcrow curview cached_commitrow
890 global varctok vtokmod
893 if {![info exists varcid
($v,$id)]} {
894 puts
"oops rowofcommit no arc for [shortids $id]"
897 set a
$varcid($v,$id)
898 if {[string compare
[lindex
$varctok($v) $a] $vtokmod($v)] >= 0} {
901 if {[info exists cached_commitrow
($id)]} {
902 return $cached_commitrow($id)
904 set i
[lsearch
-exact $varccommits($v,$a) $id]
906 puts
"oops didn't find commit [shortids $id] in arc $a"
909 incr i
[lindex
$varcrow($v) $a]
910 set cached_commitrow
($id) $i
914 # Returns 1 if a is on an earlier row than b, otherwise 0
915 proc comes_before
{a b
} {
916 global varcid varctok curview
919 if {$a eq
$b ||
![info exists varcid
($v,$a)] || \
920 ![info exists varcid
($v,$b)]} {
923 if {$varcid($v,$a) != $varcid($v,$b)} {
924 return [expr {[string compare
[lindex
$varctok($v) $varcid($v,$a)] \
925 [lindex
$varctok($v) $varcid($v,$b)]] < 0}]
927 return [expr {[rowofcommit
$a] < [rowofcommit
$b]}]
930 proc bsearch
{l elt
} {
931 if {[llength
$l] == 0 ||
$elt <= [lindex
$l 0]} {
936 while {$hi - $lo > 1} {
937 set mid
[expr {int
(($lo + $hi) / 2)}]
938 set t
[lindex
$l $mid]
941 } elseif
{$elt > $t} {
950 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
951 proc make_disporder
{start end
} {
952 global vrownum curview commitidx displayorder parentlist
953 global varccommits varcorder parents vrowmod varcrow
954 global d_valid_start d_valid_end
956 if {$end > $vrowmod($curview)} {
957 update_arcrows
$curview
959 set ai
[bsearch
$vrownum($curview) $start]
960 set start
[lindex
$vrownum($curview) $ai]
961 set narc
[llength
$vrownum($curview)]
962 for {set r
$start} {$ai < $narc && $r < $end} {incr ai
} {
963 set a
[lindex
$varcorder($curview) $ai]
964 set l
[llength
$displayorder]
965 set al
[llength
$varccommits($curview,$a)]
968 set pad
[ntimes
[expr {$r - $l}] {}]
969 set displayorder
[concat
$displayorder $pad]
970 set parentlist
[concat
$parentlist $pad]
972 set displayorder
[lrange
$displayorder 0 [expr {$r - 1}]]
973 set parentlist
[lrange
$parentlist 0 [expr {$r - 1}]]
975 foreach id
$varccommits($curview,$a) {
976 lappend displayorder
$id
977 lappend parentlist
$parents($curview,$id)
979 } elseif
{[lindex
$displayorder [expr {$r + $al - 1}]] eq
{}} {
981 foreach id
$varccommits($curview,$a) {
982 lset displayorder
$i $id
983 lset parentlist
$i $parents($curview,$id)
991 proc commitonrow
{row
} {
994 set id
[lindex
$displayorder $row]
996 make_disporder
$row [expr {$row + 1}]
997 set id
[lindex
$displayorder $row]
1002 proc closevarcs
{v
} {
1003 global varctok varccommits varcid parents children
1004 global cmitlisted commitidx commitinterest vtokmod
1006 set missing_parents
0
1008 set narcs
[llength
$varctok($v)]
1009 for {set a
1} {$a < $narcs} {incr a
} {
1010 set id
[lindex
$varccommits($v,$a) end
]
1011 foreach p
$parents($v,$id) {
1012 if {[info exists varcid
($v,$p)]} continue
1013 # add p as a new commit
1014 incr missing_parents
1015 set cmitlisted
($v,$p) 0
1016 set parents
($v,$p) {}
1017 if {[llength
$children($v,$p)] == 1 &&
1018 [llength
$parents($v,$id)] == 1} {
1021 set b
[newvarc
$v $p]
1023 set varcid
($v,$p) $b
1024 if {[string compare
[lindex
$varctok($v) $b] $vtokmod($v)] < 0} {
1027 lappend varccommits
($v,$b) $p
1029 if {[info exists commitinterest
($p)]} {
1030 foreach
script $commitinterest($p) {
1031 lappend scripts
[string map
[list
"%I" $p] $script]
1033 unset commitinterest
($id)
1037 if {$missing_parents > 0} {
1038 foreach s
$scripts {
1044 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1045 # Assumes we already have an arc for $rwid.
1046 proc rewrite_commit
{v id rwid
} {
1047 global children parents varcid varctok vtokmod varccommits
1049 foreach ch
$children($v,$id) {
1050 # make $rwid be $ch's parent in place of $id
1051 set i
[lsearch
-exact $parents($v,$ch) $id]
1053 puts
"oops rewrite_commit didn't find $id in parent list for $ch"
1055 set parents
($v,$ch) [lreplace
$parents($v,$ch) $i $i $rwid]
1056 # add $ch to $rwid's children and sort the list if necessary
1057 if {[llength
[lappend children
($v,$rwid) $ch]] > 1} {
1058 set children
($v,$rwid) [lsort
-command [list vtokcmp
$v] \
1059 $children($v,$rwid)]
1061 # fix the graph after joining $id to $rwid
1062 set a
$varcid($v,$ch)
1063 fix_reversal
$rwid $a $v
1064 # parentlist is wrong for the last element of arc $a
1065 # even if displayorder is right, hence the 3rd arg here
1066 modify_arc
$v $a [expr {[llength
$varccommits($v,$a)] - 1}]
1070 proc getcommitlines
{fd inst view updating
} {
1071 global cmitlisted commitinterest leftover
1072 global commitidx commitdata vdatemode
1073 global parents children curview hlview
1074 global idpending ordertok
1075 global varccommits varcid varctok vtokmod vfilelimit
1077 set stuff
[read $fd 500000]
1078 # git log doesn't terminate the last commit with a null...
1079 if {$stuff == {} && $leftover($inst) ne
{} && [eof
$fd]} {
1086 global commfd viewcomplete viewactive viewname progresscoords
1087 global viewinstances
1089 set i
[lsearch
-exact $viewinstances($view) $inst]
1091 set viewinstances
($view) [lreplace
$viewinstances($view) $i $i]
1093 # set it blocking so we wait for the process to terminate
1094 fconfigure
$fd -blocking 1
1095 if {[catch
{close
$fd} err
]} {
1097 if {$view != $curview} {
1098 set fv
" for the \"$viewname($view)\" view"
1100 if {[string range
$err 0 4] == "usage"} {
1101 set err
"Gitk: error reading commits$fv:\
1102 bad arguments to git log."
1103 if {$viewname($view) eq
"Command line"} {
1105 " (Note: arguments to gitk are passed to git log\
1106 to allow selection of commits to be displayed.)"
1109 set err
"Error reading commits$fv: $err"
1113 if {[incr viewactive
($view) -1] <= 0} {
1114 set viewcomplete
($view) 1
1115 # Check if we have seen any ids listed as parents that haven't
1116 # appeared in the list
1119 set progresscoords
{0 0}
1122 if {$view == $curview} {
1131 set i
[string first
"\0" $stuff $start]
1133 append leftover
($inst) [string range
$stuff $start end
]
1137 set cmit
$leftover($inst)
1138 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
1139 set leftover
($inst) {}
1141 set cmit
[string range
$stuff $start [expr {$i - 1}]]
1143 set start
[expr {$i + 1}]
1144 set j
[string first
"\n" $cmit]
1147 if {$j >= 0 && [string match
"commit *" $cmit]} {
1148 set ids
[string range
$cmit 7 [expr {$j - 1}]]
1149 if {[string match
{[-^
<>]*} $ids]} {
1150 switch
-- [string index
$ids 0] {
1156 set ids
[string range
$ids 1 end
]
1160 if {[string length
$id] != 40} {
1168 if {[string length
$shortcmit] > 80} {
1169 set shortcmit
"[string range $shortcmit 0 80]..."
1171 error_popup
"[mc "Can
't parse git log output:"] {$shortcmit}"
1174 set id [lindex $ids 0]
1177 if {!$listed && $updating && ![info exists varcid($vid)] &&
1178 $vfilelimit($view) ne {}} {
1179 # git log doesn't rewrite parents
for unlisted commits
1180 # when doing path limiting, so work around that here
1181 # by working out the rewritten parent with git rev-list
1182 # and if we already know about it, using the rewritten
1183 # parent as a substitute parent for $id's children.
1185 set rwid
[exec git rev-list
--first-parent --max-count=1 \
1186 $id -- $vfilelimit($view)]
1188 if {$rwid ne
{} && [info exists varcid
($view,$rwid)]} {
1189 # use $rwid in place of $id
1190 rewrite_commit
$view $id $rwid
1197 if {[info exists varcid
($vid)]} {
1198 if {$cmitlisted($vid) ||
!$listed} continue
1202 set olds
[lrange
$ids 1 end
]
1206 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
1207 set cmitlisted
($vid) $listed
1208 set parents
($vid) $olds
1209 if {![info exists children
($vid)]} {
1210 set children
($vid) {}
1211 } elseif
{$a == 0 && [llength
$children($vid)] == 1} {
1212 set k
[lindex
$children($vid) 0]
1213 if {[llength
$parents($view,$k)] == 1 &&
1214 (!$vdatemode($view) ||
1215 $varcid($view,$k) == [llength
$varctok($view)] - 1)} {
1216 set a
$varcid($view,$k)
1221 set a
[newvarc
$view $id]
1223 if {[string compare
[lindex
$varctok($view) $a] $vtokmod($view)] < 0} {
1226 if {![info exists varcid
($vid)]} {
1228 lappend varccommits
($view,$a) $id
1229 incr commitidx
($view)
1234 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
1236 if {[llength
[lappend children
($vp) $id]] > 1 &&
1237 [vtokcmp
$view [lindex
$children($vp) end-1
] $id] > 0} {
1238 set children
($vp) [lsort
-command [list vtokcmp
$view] \
1240 catch
{unset ordertok
}
1242 if {[info exists varcid
($view,$p)]} {
1243 fix_reversal
$p $a $view
1249 if {[info exists commitinterest
($id)]} {
1250 foreach
script $commitinterest($id) {
1251 lappend scripts
[string map
[list
"%I" $id] $script]
1253 unset commitinterest
($id)
1258 global numcommits hlview
1260 if {$view == $curview} {
1261 set numcommits
$commitidx($view)
1264 if {[info exists hlview
] && $view == $hlview} {
1265 # we never actually get here...
1268 foreach s
$scripts {
1271 if {$view == $curview} {
1272 # update progress bar
1273 global progressdirn progresscoords proglastnc
1274 set inc
[expr {($commitidx($view) - $proglastnc) * 0.0002}]
1275 set proglastnc
$commitidx($view)
1276 set l
[lindex
$progresscoords 0]
1277 set r
[lindex
$progresscoords 1]
1278 if {$progressdirn} {
1279 set r
[expr {$r + $inc}]
1285 set l
[expr {$r - 0.2}]
1288 set l
[expr {$l - $inc}]
1293 set r
[expr {$l + 0.2}]
1295 set progresscoords
[list
$l $r]
1302 proc chewcommits
{} {
1303 global curview hlview viewcomplete
1304 global pending_select
1307 if {$viewcomplete($curview)} {
1308 global commitidx varctok
1309 global numcommits startmsecs
1310 global mainheadid nullid
1312 if {[info exists pending_select
]} {
1313 set row
[first_real_row
]
1316 if {$commitidx($curview) > 0} {
1317 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1318 #puts "overall $ms ms for $numcommits commits"
1319 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1321 show_status
[mc
"No commits selected"]
1328 proc readcommit
{id
} {
1329 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
1330 parsecommit
$id $contents 0
1333 proc parsecommit
{id contents listed
} {
1334 global commitinfo cdate
1343 set hdrend
[string first
"\n\n" $contents]
1345 # should never happen...
1346 set hdrend
[string length
$contents]
1348 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
1349 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
1350 foreach line
[split $header "\n"] {
1351 set tag
[lindex
$line 0]
1352 if {$tag == "author"} {
1353 set audate
[lindex
$line end-1
]
1354 set auname
[lrange
$line 1 end-2
]
1355 } elseif
{$tag == "committer"} {
1356 set comdate
[lindex
$line end-1
]
1357 set comname
[lrange
$line 1 end-2
]
1361 # take the first non-blank line of the comment as the headline
1362 set headline
[string trimleft
$comment]
1363 set i
[string first
"\n" $headline]
1365 set headline
[string range
$headline 0 $i]
1367 set headline
[string trimright
$headline]
1368 set i
[string first
"\r" $headline]
1370 set headline
[string trimright
[string range
$headline 0 $i]]
1373 # git log indents the comment by 4 spaces;
1374 # if we got this via git cat-file, add the indentation
1376 foreach line
[split $comment "\n"] {
1377 append newcomment
" "
1378 append newcomment
$line
1379 append newcomment
"\n"
1381 set comment
$newcomment
1383 if {$comdate != {}} {
1384 set cdate
($id) $comdate
1386 set commitinfo
($id) [list
$headline $auname $audate \
1387 $comname $comdate $comment]
1390 proc getcommit
{id
} {
1391 global commitdata commitinfo
1393 if {[info exists commitdata
($id)]} {
1394 parsecommit
$id $commitdata($id) 1
1397 if {![info exists commitinfo
($id)]} {
1398 set commitinfo
($id) [list
[mc
"No commit information available"]]
1405 global tagids idtags headids idheads tagobjid
1406 global otherrefids idotherrefs mainhead mainheadid
1408 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
1411 set refd
[open
[list | git show-ref
-d] r
]
1412 while {[gets
$refd line
] >= 0} {
1413 if {[string index
$line 40] ne
" "} continue
1414 set id
[string range
$line 0 39]
1415 set ref
[string range
$line 41 end
]
1416 if {![string match
"refs/*" $ref]} continue
1417 set name
[string range
$ref 5 end
]
1418 if {[string match
"remotes/*" $name]} {
1419 if {![string match
"*/HEAD" $name]} {
1420 set headids
($name) $id
1421 lappend idheads
($id) $name
1423 } elseif
{[string match
"heads/*" $name]} {
1424 set name
[string range
$name 6 end
]
1425 set headids
($name) $id
1426 lappend idheads
($id) $name
1427 } elseif
{[string match
"tags/*" $name]} {
1428 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1429 # which is what we want since the former is the commit ID
1430 set name
[string range
$name 5 end
]
1431 if {[string match
"*^{}" $name]} {
1432 set name
[string range
$name 0 end-3
]
1434 set tagobjid
($name) $id
1436 set tagids
($name) $id
1437 lappend idtags
($id) $name
1439 set otherrefids
($name) $id
1440 lappend idotherrefs
($id) $name
1447 set thehead
[exec git symbolic-ref HEAD
]
1448 if {[string match
"refs/heads/*" $thehead]} {
1449 set mainhead
[string range
$thehead 11 end
]
1450 if {[info exists headids
($mainhead)]} {
1451 set mainheadid
$headids($mainhead)
1457 # skip over fake commits
1458 proc first_real_row
{} {
1459 global nullid nullid2 numcommits
1461 for {set row
0} {$row < $numcommits} {incr row
} {
1462 set id
[commitonrow
$row]
1463 if {$id ne
$nullid && $id ne
$nullid2} {
1470 # update things for a head moved to a child of its previous location
1471 proc movehead
{id name
} {
1472 global headids idheads
1474 removehead
$headids($name) $name
1475 set headids
($name) $id
1476 lappend idheads
($id) $name
1479 # update things when a head has been removed
1480 proc removehead
{id name
} {
1481 global headids idheads
1483 if {$idheads($id) eq
$name} {
1486 set i
[lsearch
-exact $idheads($id) $name]
1488 set idheads
($id) [lreplace
$idheads($id) $i $i]
1491 unset headids
($name)
1494 proc show_error
{w top msg
} {
1495 message
$w.m
-text $msg -justify center
-aspect 400
1496 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1497 button
$w.ok
-text [mc OK
] -command "destroy $top"
1498 pack
$w.ok
-side bottom
-fill x
1499 bind $top <Visibility
> "grab $top; focus $top"
1500 bind $top <Key-Return
> "destroy $top"
1504 proc error_popup msg
{
1508 show_error
$w $w $msg
1511 proc confirm_popup msg
{
1517 message
$w.m
-text $msg -justify center
-aspect 400
1518 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
1519 button
$w.ok
-text [mc OK
] -command "set confirm_ok 1; destroy $w"
1520 pack
$w.ok
-side left
-fill x
1521 button
$w.cancel
-text [mc Cancel
] -command "destroy $w"
1522 pack
$w.cancel
-side right
-fill x
1523 bind $w <Visibility
> "grab $w; focus $w"
1528 proc setoptions
{} {
1529 option add
*Panedwindow.showHandle
1 startupFile
1530 option add
*Panedwindow.sashRelief raised startupFile
1531 option add
*Button.font uifont startupFile
1532 option add
*Checkbutton.font uifont startupFile
1533 option add
*Radiobutton.font uifont startupFile
1534 option add
*Menu.font uifont startupFile
1535 option add
*Menubutton.font uifont startupFile
1536 option add
*Label.font uifont startupFile
1537 option add
*Message.font uifont startupFile
1538 option add
*Entry.font uifont startupFile
1541 proc makewindow
{} {
1542 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1544 global findtype findtypemenu findloc findstring fstring geometry
1545 global entries sha1entry sha1string sha1but
1546 global diffcontextstring diffcontext
1548 global maincursor textcursor curtextcursor
1549 global rowctxmenu fakerowmenu mergemax wrapcomment
1550 global highlight_files gdttype
1551 global searchstring sstring
1552 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1553 global headctxmenu progresscanv progressitem progresscoords statusw
1554 global fprogitem fprogcoord lastprogupdate progupdatepending
1555 global rprogitem rprogcoord
1559 .bar add cascade
-label [mc
"File"] -menu .bar.
file
1561 .bar.
file add
command -label [mc
"Update"] -command updatecommits
1562 .bar.
file add
command -label [mc
"Reload"] -command reloadcommits
1563 .bar.
file add
command -label [mc
"Reread references"] -command rereadrefs
1564 .bar.
file add
command -label [mc
"List references"] -command showrefs
1565 .bar.
file add
command -label [mc
"Quit"] -command doquit
1567 .bar add cascade
-label [mc
"Edit"] -menu .bar.edit
1568 .bar.edit add
command -label [mc
"Preferences"] -command doprefs
1571 .bar add cascade
-label [mc
"View"] -menu .bar.view
1572 .bar.view add
command -label [mc
"New view..."] -command {newview
0}
1573 .bar.view add
command -label [mc
"Edit view..."] -command editview \
1575 .bar.view add
command -label [mc
"Delete view"] -command delview
-state disabled
1576 .bar.view add separator
1577 .bar.view add radiobutton
-label [mc
"All files"] -command {showview
0} \
1578 -variable selectedview
-value 0
1581 .bar add cascade
-label [mc
"Help"] -menu .bar.
help
1582 .bar.
help add
command -label [mc
"About gitk"] -command about
1583 .bar.
help add
command -label [mc
"Key bindings"] -command keys
1585 . configure
-menu .bar
1587 # the gui has upper and lower half, parts of a paned window.
1588 panedwindow .ctop
-orient vertical
1590 # possibly use assumed geometry
1591 if {![info exists geometry
(pwsash0
)]} {
1592 set geometry
(topheight
) [expr {15 * $linespc}]
1593 set geometry
(topwidth
) [expr {80 * $charspc}]
1594 set geometry
(botheight
) [expr {15 * $linespc}]
1595 set geometry
(botwidth
) [expr {50 * $charspc}]
1596 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
1597 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
1600 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1601 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
1603 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
1605 # create three canvases
1606 set cscroll .tf.histframe.csb
1607 set canv .tf.histframe.pwclist.canv
1609 -selectbackground $selectbgcolor \
1610 -background $bgcolor -bd 0 \
1611 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1612 .tf.histframe.pwclist add
$canv
1613 set canv2 .tf.histframe.pwclist.canv2
1615 -selectbackground $selectbgcolor \
1616 -background $bgcolor -bd 0 -yscrollincr $linespc
1617 .tf.histframe.pwclist add
$canv2
1618 set canv3 .tf.histframe.pwclist.canv3
1620 -selectbackground $selectbgcolor \
1621 -background $bgcolor -bd 0 -yscrollincr $linespc
1622 .tf.histframe.pwclist add
$canv3
1623 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
1624 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
1626 # a scroll bar to rule them
1627 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
1628 pack
$cscroll -side right
-fill y
1629 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
1630 lappend bglist
$canv $canv2 $canv3
1631 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
1633 # we have two button bars at bottom of top frame. Bar 1
1635 frame .tf.lbar
-height 15
1637 set sha1entry .tf.bar.sha1
1638 set entries
$sha1entry
1639 set sha1but .tf.bar.sha1label
1640 button
$sha1but -text [mc
"SHA1 ID: "] -state disabled
-relief flat \
1641 -command gotocommit
-width 8
1642 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
1643 pack .tf.bar.sha1label
-side left
1644 entry
$sha1entry -width 40 -font textfont
-textvariable sha1string
1645 trace add variable sha1string
write sha1change
1646 pack
$sha1entry -side left
-pady 2
1648 image create bitmap bm-left
-data {
1649 #define left_width 16
1650 #define left_height 16
1651 static unsigned char left_bits
[] = {
1652 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1653 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1654 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1656 image create bitmap bm-right
-data {
1657 #define right_width 16
1658 #define right_height 16
1659 static unsigned char right_bits
[] = {
1660 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1661 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1662 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1664 button .tf.bar.leftbut
-image bm-left
-command goback \
1665 -state disabled
-width 26
1666 pack .tf.bar.leftbut
-side left
-fill y
1667 button .tf.bar.rightbut
-image bm-right
-command goforw \
1668 -state disabled
-width 26
1669 pack .tf.bar.rightbut
-side left
-fill y
1671 # Status label and progress bar
1672 set statusw .tf.bar.status
1673 label
$statusw -width 15 -relief sunken
1674 pack
$statusw -side left
-padx 5
1675 set h
[expr {[font metrics uifont
-linespace] + 2}]
1676 set progresscanv .tf.bar.progress
1677 canvas
$progresscanv -relief sunken
-height $h -borderwidth 2
1678 set progressitem
[$progresscanv create rect
-1 0 0 $h -fill green
]
1679 set fprogitem
[$progresscanv create rect
-1 0 0 $h -fill yellow
]
1680 set rprogitem
[$progresscanv create rect
-1 0 0 $h -fill red
]
1681 pack
$progresscanv -side right
-expand 1 -fill x
1682 set progresscoords
{0 0}
1685 bind $progresscanv <Configure
> adjustprogress
1686 set lastprogupdate
[clock clicks
-milliseconds]
1687 set progupdatepending
0
1689 # build up the bottom bar of upper window
1690 label .tf.lbar.flabel
-text "[mc "Find
"] "
1691 button .tf.lbar.fnext
-text [mc
"next"] -command {dofind
1 1}
1692 button .tf.lbar.fprev
-text [mc
"prev"] -command {dofind
-1 1}
1693 label .tf.lbar.flab2
-text " [mc "commit
"] "
1694 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1696 set gdttype
[mc
"containing:"]
1697 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype \
1698 [mc
"containing:"] \
1699 [mc
"touching paths:"] \
1700 [mc
"adding/removing string:"]]
1701 trace add variable gdttype
write gdttype_change
1702 pack .tf.lbar.gdttype
-side left
-fill y
1705 set fstring .tf.lbar.findstring
1706 lappend entries
$fstring
1707 entry
$fstring -width 30 -font textfont
-textvariable findstring
1708 trace add variable findstring
write find_change
1709 set findtype
[mc
"Exact"]
1710 set findtypemenu
[tk_optionMenu .tf.lbar.findtype \
1711 findtype
[mc
"Exact"] [mc
"IgnCase"] [mc
"Regexp"]]
1712 trace add variable findtype
write findcom_change
1713 set findloc
[mc
"All fields"]
1714 tk_optionMenu .tf.lbar.findloc findloc
[mc
"All fields"] [mc
"Headline"] \
1715 [mc
"Comments"] [mc
"Author"] [mc
"Committer"]
1716 trace add variable findloc
write find_change
1717 pack .tf.lbar.findloc
-side right
1718 pack .tf.lbar.findtype
-side right
1719 pack
$fstring -side left
-expand 1 -fill x
1721 # Finish putting the upper half of the viewer together
1722 pack .tf.lbar
-in .tf
-side bottom
-fill x
1723 pack .tf.bar
-in .tf
-side bottom
-fill x
1724 pack .tf.histframe
-fill both
-side top
-expand 1
1726 .ctop paneconfigure .tf
-height $geometry(topheight
)
1727 .ctop paneconfigure .tf
-width $geometry(topwidth
)
1729 # now build up the bottom
1730 panedwindow .pwbottom
-orient horizontal
1732 # lower left, a text box over search bar, scroll bar to the right
1733 # if we know window height, then that will set the lower text height, otherwise
1734 # we set lower text height which will drive window height
1735 if {[info exists geometry
(main
)]} {
1736 frame .bleft
-width $geometry(botwidth
)
1738 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
1744 button .bleft.top.search
-text [mc
"Search"] -command dosearch
1745 pack .bleft.top.search
-side left
-padx 5
1746 set sstring .bleft.top.sstring
1747 entry
$sstring -width 20 -font textfont
-textvariable searchstring
1748 lappend entries
$sstring
1749 trace add variable searchstring
write incrsearch
1750 pack
$sstring -side left
-expand 1 -fill x
1751 radiobutton .bleft.mid.
diff -text [mc
"Diff"] \
1752 -command changediffdisp
-variable diffelide
-value {0 0}
1753 radiobutton .bleft.mid.old
-text [mc
"Old version"] \
1754 -command changediffdisp
-variable diffelide
-value {0 1}
1755 radiobutton .bleft.mid.new
-text [mc
"New version"] \
1756 -command changediffdisp
-variable diffelide
-value {1 0}
1757 label .bleft.mid.labeldiffcontext
-text " [mc "Lines of context
"]: "
1758 pack .bleft.mid.
diff .bleft.mid.old .bleft.mid.new
-side left
1759 spinbox .bleft.mid.diffcontext
-width 5 -font textfont \
1760 -from 1 -increment 1 -to 10000000 \
1761 -validate all
-validatecommand "diffcontextvalidate %P" \
1762 -textvariable diffcontextstring
1763 .bleft.mid.diffcontext
set $diffcontext
1764 trace add variable diffcontextstring
write diffcontextchange
1765 lappend entries .bleft.mid.diffcontext
1766 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext
-side left
1767 checkbutton .bleft.mid.ignspace
-text [mc
"Ignore space change"] \
1768 -command changeignorespace
-variable ignorespace
1769 pack .bleft.mid.ignspace
-side left
-padx 5
1770 set ctext .bleft.bottom.ctext
1771 text
$ctext -background $bgcolor -foreground $fgcolor \
1772 -state disabled
-font textfont \
1773 -yscrollcommand scrolltext
-wrap none \
1774 -xscrollcommand ".bleft.bottom.sbhorizontal set"
1776 $ctext conf
-tabstyle wordprocessor
1778 scrollbar .bleft.bottom.sb
-command "$ctext yview"
1779 scrollbar .bleft.bottom.sbhorizontal
-command "$ctext xview" -orient h \
1781 pack .bleft.top
-side top
-fill x
1782 pack .bleft.mid
-side top
-fill x
1783 grid
$ctext .bleft.bottom.sb
-sticky nsew
1784 grid .bleft.bottom.sbhorizontal
-sticky ew
1785 grid columnconfigure .bleft.bottom
0 -weight 1
1786 grid rowconfigure .bleft.bottom
0 -weight 1
1787 grid rowconfigure .bleft.bottom
1 -weight 0
1788 pack .bleft.bottom
-side top
-fill both
-expand 1
1789 lappend bglist
$ctext
1790 lappend fglist
$ctext
1792 $ctext tag conf comment
-wrap $wrapcomment
1793 $ctext tag conf filesep
-font textfontbold
-back "#aaaaaa"
1794 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
1795 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
1796 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
1797 $ctext tag conf m0
-fore red
1798 $ctext tag conf m1
-fore blue
1799 $ctext tag conf m2
-fore green
1800 $ctext tag conf m3
-fore purple
1801 $ctext tag conf
m4 -fore brown
1802 $ctext tag conf m5
-fore "#009090"
1803 $ctext tag conf m6
-fore magenta
1804 $ctext tag conf m7
-fore "#808000"
1805 $ctext tag conf m8
-fore "#009000"
1806 $ctext tag conf m9
-fore "#ff0080"
1807 $ctext tag conf m10
-fore cyan
1808 $ctext tag conf m11
-fore "#b07070"
1809 $ctext tag conf m12
-fore "#70b0f0"
1810 $ctext tag conf m13
-fore "#70f0b0"
1811 $ctext tag conf m14
-fore "#f0b070"
1812 $ctext tag conf m15
-fore "#ff70b0"
1813 $ctext tag conf mmax
-fore darkgrey
1815 $ctext tag conf mresult
-font textfontbold
1816 $ctext tag conf msep
-font textfontbold
1817 $ctext tag conf found
-back yellow
1819 .pwbottom add .bleft
1820 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
1825 radiobutton .bright.mode.
patch -text [mc
"Patch"] \
1826 -command reselectline
-variable cmitmode
-value "patch"
1827 radiobutton .bright.mode.tree
-text [mc
"Tree"] \
1828 -command reselectline
-variable cmitmode
-value "tree"
1829 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
1830 pack .bright.mode
-side top
-fill x
1831 set cflist .bright.cfiles
1832 set indent
[font measure mainfont
"nn"]
1834 -selectbackground $selectbgcolor \
1835 -background $bgcolor -foreground $fgcolor \
1837 -tabs [list
$indent [expr {2 * $indent}]] \
1838 -yscrollcommand ".bright.sb set" \
1839 -cursor [. cget
-cursor] \
1840 -spacing1 1 -spacing3 1
1841 lappend bglist
$cflist
1842 lappend fglist
$cflist
1843 scrollbar .bright.sb
-command "$cflist yview"
1844 pack .bright.sb
-side right
-fill y
1845 pack
$cflist -side left
-fill both
-expand 1
1846 $cflist tag configure highlight \
1847 -background [$cflist cget
-selectbackground]
1848 $cflist tag configure bold
-font mainfontbold
1850 .pwbottom add .bright
1853 # restore window width & height if known
1854 if {[info exists geometry
(main
)]} {
1855 if {[scan
$geometry(main
) "%dx%d" w h
] >= 2} {
1856 if {$w > [winfo screenwidth .
]} {
1857 set w
[winfo screenwidth .
]
1859 if {$h > [winfo screenheight .
]} {
1860 set h
[winfo screenheight .
]
1862 wm geometry .
"${w}x$h"
1866 if {[tk windowingsystem
] eq
{aqua
}} {
1872 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
1873 pack .ctop
-fill both
-expand 1
1874 bindall
<1> {selcanvline
%W
%x
%y
}
1875 #bindall <B1-Motion> {selcanvline %W %x %y}
1876 if {[tk windowingsystem
] == "win32"} {
1877 bind .
<MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
}
1878 bind $ctext <MouseWheel
> { windows_mousewheel_redirector
%W
%X
%Y
%D
; break }
1880 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
1881 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
1882 if {[tk windowingsystem
] eq
"aqua"} {
1883 bindall
<MouseWheel
> {
1884 set delta
[expr {- (%D
)}]
1885 allcanvs yview scroll
$delta units
1889 bindall
<2> "canvscan mark %W %x %y"
1890 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
1891 bindkey
<Home
> selfirstline
1892 bindkey
<End
> sellastline
1893 bind .
<Key-Up
> "selnextline -1"
1894 bind .
<Key-Down
> "selnextline 1"
1895 bind .
<Shift-Key-Up
> "dofind -1 0"
1896 bind .
<Shift-Key-Down
> "dofind 1 0"
1897 bindkey
<Key-Right
> "goforw"
1898 bindkey
<Key-Left
> "goback"
1899 bind .
<Key-Prior
> "selnextpage -1"
1900 bind .
<Key-Next
> "selnextpage 1"
1901 bind .
<$M1B-Home> "allcanvs yview moveto 0.0"
1902 bind .
<$M1B-End> "allcanvs yview moveto 1.0"
1903 bind .
<$M1B-Key-Up> "allcanvs yview scroll -1 units"
1904 bind .
<$M1B-Key-Down> "allcanvs yview scroll 1 units"
1905 bind .
<$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1906 bind .
<$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1907 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
1908 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
1909 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
1910 bindkey p
"selnextline -1"
1911 bindkey n
"selnextline 1"
1914 bindkey i
"selnextline -1"
1915 bindkey k
"selnextline 1"
1918 bindkey b
"$ctext yview scroll -1 pages"
1919 bindkey d
"$ctext yview scroll 18 units"
1920 bindkey u
"$ctext yview scroll -18 units"
1921 bindkey
/ {dofind
1 1}
1922 bindkey
<Key-Return
> {dofind
1 1}
1923 bindkey ?
{dofind
-1 1}
1925 bindkey
<F5
> updatecommits
1926 bind .
<$M1B-q> doquit
1927 bind .
<$M1B-f> {dofind
1 1}
1928 bind .
<$M1B-g> {dofind
1 0}
1929 bind .
<$M1B-r> dosearchback
1930 bind .
<$M1B-s> dosearch
1931 bind .
<$M1B-equal> {incrfont
1}
1932 bind .
<$M1B-plus> {incrfont
1}
1933 bind .
<$M1B-KP_Add> {incrfont
1}
1934 bind .
<$M1B-minus> {incrfont
-1}
1935 bind .
<$M1B-KP_Subtract> {incrfont
-1}
1936 wm protocol . WM_DELETE_WINDOW doquit
1937 bind .
<Button-1
> "click %W"
1938 bind $fstring <Key-Return
> {dofind
1 1}
1939 bind $sha1entry <Key-Return
> gotocommit
1940 bind $sha1entry <<PasteSelection>> clearsha1
1941 bind $cflist <1> {sel_flist %W %x %y; break}
1942 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1943 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1944 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1946 set maincursor [. cget -cursor]
1947 set textcursor [$ctext cget -cursor]
1948 set curtextcursor $textcursor
1950 set rowctxmenu .rowctxmenu
1951 menu $rowctxmenu -tearoff 0
1952 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1953 -command {diffvssel 0}
1954 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1955 -command {diffvssel 1}
1956 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1957 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1958 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1959 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1960 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1962 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1965 set fakerowmenu .fakerowmenu
1966 menu $fakerowmenu -tearoff 0
1967 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1968 -command {diffvssel 0}
1969 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1970 -command {diffvssel 1}
1971 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1972 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1973 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1974 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1976 set headctxmenu .headctxmenu
1977 menu $headctxmenu -tearoff 0
1978 $headctxmenu add command -label [mc "Check out this branch"] \
1980 $headctxmenu add command -label [mc "Remove this branch"] \
1984 set flist_menu .flistctxmenu
1985 menu $flist_menu -tearoff 0
1986 $flist_menu add command -label [mc "Highlight this too"] \
1987 -command {flist_hl 0}
1988 $flist_menu add command -label [mc "Highlight this only"] \
1989 -command {flist_hl 1}
1992 # Windows sends all mouse wheel events to the current focused window, not
1993 # the one where the mouse hovers, so bind those events here and redirect
1994 # to the correct window
1995 proc windows_mousewheel_redirector {W X Y D} {
1996 global canv canv2 canv3
1997 set w [winfo containing -displayof $W $X $Y]
1999 set u [expr {$D < 0 ? 5 : -5}]
2000 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2001 allcanvs yview scroll $u units
2004 $w yview scroll $u units
2010 # mouse-2 makes all windows scan vertically, but only the one
2011 # the cursor is in scans horizontally
2012 proc canvscan {op w x y} {
2013 global canv canv2 canv3
2014 foreach c [list $canv $canv2 $canv3] {
2023 proc scrollcanv {cscroll f0 f1} {
2024 $cscroll set $f0 $f1
2029 # when we make a key binding for the toplevel, make sure
2030 # it doesn't get triggered when that key is pressed in the
2031 # find string entry widget.
2032 proc bindkey {ev script} {
2035 set escript [bind Entry $ev]
2036 if {$escript == {}} {
2037 set escript [bind Entry <Key>]
2039 foreach e $entries {
2040 bind $e $ev "$escript; break"
2044 # set the focus back to the toplevel for any click outside
2047 global ctext entries
2048 foreach e [concat $entries $ctext] {
2049 if {$w == $e} return
2054 # Adjust the progress bar for a change in requested extent or canvas size
2055 proc adjustprogress {} {
2056 global progresscanv progressitem progresscoords
2057 global fprogitem fprogcoord lastprogupdate progupdatepending
2058 global rprogitem rprogcoord
2060 set w [expr {[winfo width $progresscanv] - 4}]
2061 set x0 [expr {$w * [lindex $progresscoords 0]}]
2062 set x1 [expr {$w * [lindex $progresscoords 1]}]
2063 set h [winfo height $progresscanv]
2064 $progresscanv coords $progressitem $x0 0 $x1 $h
2065 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2066 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2067 set now [clock clicks -milliseconds]
2068 if {$now >= $lastprogupdate + 100} {
2069 set progupdatepending 0
2071 } elseif {!$progupdatepending} {
2072 set progupdatepending 1
2073 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2077 proc doprogupdate {} {
2078 global lastprogupdate progupdatepending
2080 if {$progupdatepending} {
2081 set progupdatepending 0
2082 set lastprogupdate [clock clicks -milliseconds]
2087 proc savestuff {w} {
2088 global canv canv2 canv3 mainfont textfont uifont tabstop
2089 global stuffsaved findmergefiles maxgraphpct
2090 global maxwidth showneartags showlocalchanges
2091 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2092 global cmitmode wrapcomment datetimeformat limitdiffs
2093 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2096 if {$stuffsaved} return
2097 if {![winfo viewable .]} return
2099 set f [open "~/.gitk-new" w]
2100 puts $f [list set mainfont $mainfont]
2101 puts $f [list set textfont $textfont]
2102 puts $f [list set uifont $uifont]
2103 puts $f [list set tabstop $tabstop]
2104 puts $f [list set findmergefiles $findmergefiles]
2105 puts $f [list set maxgraphpct $maxgraphpct]
2106 puts $f [list set maxwidth $maxwidth]
2107 puts $f [list set cmitmode $cmitmode]
2108 puts $f [list set wrapcomment $wrapcomment]
2109 puts $f [list set autoselect $autoselect]
2110 puts $f [list set showneartags $showneartags]
2111 puts $f [list set showlocalchanges $showlocalchanges]
2112 puts $f [list set datetimeformat $datetimeformat]
2113 puts $f [list set limitdiffs $limitdiffs]
2114 puts $f [list set bgcolor $bgcolor]
2115 puts $f [list set fgcolor $fgcolor]
2116 puts $f [list set colors $colors]
2117 puts $f [list set diffcolors $diffcolors]
2118 puts $f [list set diffcontext $diffcontext]
2119 puts $f [list set selectbgcolor $selectbgcolor]
2121 puts $f "set geometry(main) [wm geometry .]"
2122 puts $f "set geometry(topwidth) [winfo width .tf]"
2123 puts $f "set geometry(topheight) [winfo height .tf]"
2124 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2125 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2126 puts $f "set geometry(botwidth) [winfo width .bleft]"
2127 puts $f "set geometry(botheight) [winfo height .bleft]"
2129 puts -nonewline $f "set permviews {"
2130 for {set v 0} {$v < $nextviewnum} {incr v} {
2131 if {$viewperm($v)} {
2132 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2137 file rename -force "~/.gitk-new" "~/.gitk"
2142 proc resizeclistpanes {win w} {
2144 if {[info exists oldwidth($win)]} {
2145 set s0 [$win sash coord 0]
2146 set s1 [$win sash coord 1]
2148 set sash0 [expr {int($w/2 - 2)}]
2149 set sash1 [expr {int($w*5/6 - 2)}]
2151 set factor [expr {1.0 * $w / $oldwidth($win)}]
2152 set sash0 [expr {int($factor * [lindex $s0 0])}]
2153 set sash1 [expr {int($factor * [lindex $s1 0])}]
2157 if {$sash1 < $sash0 + 20} {
2158 set sash1 [expr {$sash0 + 20}]
2160 if {$sash1 > $w - 10} {
2161 set sash1 [expr {$w - 10}]
2162 if {$sash0 > $sash1 - 20} {
2163 set sash0 [expr {$sash1 - 20}]
2167 $win sash place 0 $sash0 [lindex $s0 1]
2168 $win sash place 1 $sash1 [lindex $s1 1]
2170 set oldwidth($win) $w
2173 proc resizecdetpanes {win w} {
2175 if {[info exists oldwidth($win)]} {
2176 set s0 [$win sash coord 0]
2178 set sash0 [expr {int($w*3/4 - 2)}]
2180 set factor [expr {1.0 * $w / $oldwidth($win)}]
2181 set sash0 [expr {int($factor * [lindex $s0 0])}]
2185 if {$sash0 > $w - 15} {
2186 set sash0 [expr {$w - 15}]
2189 $win sash place 0 $sash0 [lindex $s0 1]
2191 set oldwidth($win) $w
2194 proc allcanvs args {
2195 global canv canv2 canv3
2201 proc bindall {event action} {
2202 global canv canv2 canv3
2203 bind $canv $event $action
2204 bind $canv2 $event $action
2205 bind $canv3 $event $action
2211 if {[winfo exists $w]} {
2216 wm title $w [mc "About gitk"]
2217 message $w.m -text [mc "
2218 Gitk - a commit viewer for git
2220 Copyright © 2005-2006 Paul Mackerras
2222 Use and redistribute under the terms of the GNU General Public License"] \
2223 -justify center -aspect 400 -border 2 -bg white -relief groove
2224 pack $w.m -side top -fill x -padx 2 -pady 2
2225 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2226 pack $w.ok -side bottom
2227 bind $w <Visibility> "focus $w.ok"
2228 bind $w <Key-Escape> "destroy $w"
2229 bind $w <Key-Return> "destroy $w"
2234 if {[winfo exists $w]} {
2238 if {[tk windowingsystem] eq {aqua}} {
2244 wm title $w [mc "Gitk key bindings"]
2245 message $w.m -text "
2246 [mc "Gitk key bindings:"]
2248 [mc "<%s-Q> Quit" $M1T]
2249 [mc "<Home> Move to first commit"]
2250 [mc "<End> Move to last commit"]
2251 [mc "<Up>, p, i Move up one commit"]
2252 [mc "<Down>, n, k Move down one commit"]
2253 [mc "<Left>, z, j Go back in history list"]
2254 [mc "<Right>, x, l Go forward in history list"]
2255 [mc "<PageUp> Move up one page in commit list"]
2256 [mc "<PageDown> Move down one page in commit list"]
2257 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2258 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2259 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2260 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2261 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2262 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2263 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2264 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2265 [mc "<Delete>, b Scroll diff view up one page"]
2266 [mc "<Backspace> Scroll diff view up one page"]
2267 [mc "<Space> Scroll diff view down one page"]
2268 [mc "u Scroll diff view up 18 lines"]
2269 [mc "d Scroll diff view down 18 lines"]
2270 [mc "<%s-F> Find" $M1T]
2271 [mc "<%s-G> Move to next find hit" $M1T]
2272 [mc "<Return> Move to next find hit"]
2273 [mc "/ Move to next find hit, or redo find"]
2274 [mc "? Move to previous find hit"]
2275 [mc "f Scroll diff view to next file"]
2276 [mc "<%s-S> Search for next hit in diff view" $M1T]
2277 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2278 [mc "<%s-KP+> Increase font size" $M1T]
2279 [mc "<%s-plus> Increase font size" $M1T]
2280 [mc "<%s-KP-> Decrease font size" $M1T]
2281 [mc "<%s-minus> Decrease font size" $M1T]
2284 -justify left -bg white -border 2 -relief groove
2285 pack $w.m -side top -fill both -padx 2 -pady 2
2286 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2287 pack $w.ok -side bottom
2288 bind $w <Visibility> "focus $w.ok"
2289 bind $w <Key-Escape> "destroy $w"
2290 bind $w <Key-Return> "destroy $w"
2293 # Procedures for manipulating the file list window at the
2294 # bottom right of the overall window.
2296 proc treeview {w l openlevs} {
2297 global treecontents treediropen treeheight treeparent treeindex
2307 set treecontents() {}
2308 $w conf -state normal
2310 while {[string range $f 0 $prefixend] ne $prefix} {
2311 if {$lev <= $openlevs} {
2312 $w mark set e:$treeindex($prefix) "end -1c"
2313 $w mark gravity e:$treeindex($prefix) left
2315 set treeheight($prefix) $ht
2316 incr ht [lindex $htstack end]
2317 set htstack [lreplace $htstack end end]
2318 set prefixend [lindex $prefendstack end]
2319 set prefendstack [lreplace $prefendstack end end]
2320 set prefix [string range $prefix 0 $prefixend]
2323 set tail [string range $f [expr {$prefixend+1}] end]
2324 while {[set slash [string first "/" $tail]] >= 0} {
2327 lappend prefendstack $prefixend
2328 incr prefixend [expr {$slash + 1}]
2329 set d [string range $tail 0 $slash]
2330 lappend treecontents($prefix) $d
2331 set oldprefix $prefix
2333 set treecontents($prefix) {}
2334 set treeindex($prefix) [incr ix]
2335 set treeparent($prefix) $oldprefix
2336 set tail [string range $tail [expr {$slash+1}] end]
2337 if {$lev <= $openlevs} {
2339 set treediropen($prefix) [expr {$lev < $openlevs}]
2340 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2341 $w mark set d:$ix "end -1c"
2342 $w mark gravity d:$ix left
2344 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2346 $w image create end -align center -image $bm -padx 1 \
2348 $w insert end $d [highlight_tag $prefix]
2349 $w mark set s:$ix "end -1c"
2350 $w mark gravity s:$ix left
2355 if {$lev <= $openlevs} {
2358 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2360 $w insert end $tail [highlight_tag $f]
2362 lappend treecontents($prefix) $tail
2365 while {$htstack ne {}} {
2366 set treeheight($prefix) $ht
2367 incr ht [lindex $htstack end]
2368 set htstack [lreplace $htstack end end]
2369 set prefixend [lindex $prefendstack end]
2370 set prefendstack [lreplace $prefendstack end end]
2371 set prefix [string range $prefix 0 $prefixend]
2373 $w conf -state disabled
2376 proc linetoelt {l} {
2377 global treeheight treecontents
2382 foreach e $treecontents($prefix) {
2387 if {[string index $e end] eq "/"} {
2388 set n $treeheight($prefix$e)
2400 proc highlight_tree {y prefix} {
2401 global treeheight treecontents cflist
2403 foreach e $treecontents($prefix) {
2405 if {[highlight_tag $path] ne {}} {
2406 $cflist tag add bold $y.0 "$y.0 lineend"
2409 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2410 set y [highlight_tree $y $path]
2416 proc treeclosedir {w dir} {
2417 global treediropen treeheight treeparent treeindex
2419 set ix $treeindex($dir)
2420 $w conf -state normal
2421 $w delete s:$ix e:$ix
2422 set treediropen($dir) 0
2423 $w image configure a:$ix -image tri-rt
2424 $w conf -state disabled
2425 set n [expr {1 - $treeheight($dir)}]
2426 while {$dir ne {}} {
2427 incr treeheight($dir) $n
2428 set dir $treeparent($dir)
2432 proc treeopendir {w dir} {
2433 global treediropen treeheight treeparent treecontents treeindex
2435 set ix $treeindex($dir)
2436 $w conf -state normal
2437 $w image configure a:$ix -image tri-dn
2438 $w mark set e:$ix s:$ix
2439 $w mark gravity e:$ix right
2442 set n [llength $treecontents($dir)]
2443 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2446 incr treeheight($x) $n
2448 foreach e $treecontents($dir) {
2450 if {[string index $e end] eq "/"} {
2451 set iy $treeindex($de)
2452 $w mark set d:$iy e:$ix
2453 $w mark gravity d:$iy left
2454 $w insert e:$ix $str
2455 set treediropen($de) 0
2456 $w image create e:$ix -align center -image tri-rt -padx 1 \
2458 $w insert e:$ix $e [highlight_tag $de]
2459 $w mark set s:$iy e:$ix
2460 $w mark gravity s:$iy left
2461 set treeheight($de) 1
2463 $w insert e:$ix $str
2464 $w insert e:$ix $e [highlight_tag $de]
2467 $w mark gravity e:$ix left
2468 $w conf -state disabled
2469 set treediropen($dir) 1
2470 set top [lindex [split [$w index @0,0] .] 0]
2471 set ht [$w cget -height]
2472 set l [lindex [split [$w index s:$ix] .] 0]
2475 } elseif {$l + $n + 1 > $top + $ht} {
2476 set top [expr {$l + $n + 2 - $ht}]
2484 proc treeclick {w x y} {
2485 global treediropen cmitmode ctext cflist cflist_top
2487 if {$cmitmode ne "tree"} return
2488 if {![info exists cflist_top]} return
2489 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2490 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2491 $cflist tag add highlight $l.0 "$l.0 lineend"
2497 set e [linetoelt $l]
2498 if {[string index $e end] ne "/"} {
2500 } elseif {$treediropen($e)} {
2507 proc setfilelist {id} {
2508 global treefilelist cflist
2510 treeview $cflist $treefilelist($id) 0
2513 image create bitmap tri-rt -background black -foreground blue -data {
2514 #define tri-rt_width 13
2515 #define tri-rt_height 13
2516 static unsigned char tri-rt_bits[] = {
2517 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2518 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2521 #define tri-rt-mask_width 13
2522 #define tri-rt-mask_height 13
2523 static unsigned char tri-rt-mask_bits[] = {
2524 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2525 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2528 image create bitmap tri-dn -background black -foreground blue -data {
2529 #define tri-dn_width 13
2530 #define tri-dn_height 13
2531 static unsigned char tri-dn_bits[] = {
2532 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2533 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2536 #define tri-dn-mask_width 13
2537 #define tri-dn-mask_height 13
2538 static unsigned char tri-dn-mask_bits[] = {
2539 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2540 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2544 image create bitmap reficon-T -background black -foreground yellow -data {
2545 #define tagicon_width 13
2546 #define tagicon_height 9
2547 static unsigned char tagicon_bits[] = {
2548 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2549 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2551 #define tagicon-mask_width 13
2552 #define tagicon-mask_height 9
2553 static unsigned char tagicon-mask_bits[] = {
2554 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2555 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2558 #define headicon_width 13
2559 #define headicon_height 9
2560 static unsigned char headicon_bits[] = {
2561 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2562 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2565 #define headicon-mask_width 13
2566 #define headicon-mask_height 9
2567 static unsigned char headicon-mask_bits[] = {
2568 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2569 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2571 image create bitmap reficon-H -background black -foreground green \
2572 -data $rectdata -maskdata $rectmask
2573 image create bitmap reficon-o -background black -foreground "#ddddff" \
2574 -data $rectdata -maskdata $rectmask
2576 proc init_flist {first} {
2577 global cflist cflist_top difffilestart
2579 $cflist conf -state normal
2580 $cflist delete 0.0 end
2582 $cflist insert end $first
2584 $cflist tag add highlight 1.0 "1.0 lineend"
2586 catch {unset cflist_top}
2588 $cflist conf -state disabled
2589 set difffilestart {}
2592 proc highlight_tag {f} {
2593 global highlight_paths
2595 foreach p $highlight_paths {
2596 if {[string match $p $f]} {
2603 proc highlight_filelist {} {
2604 global cmitmode cflist
2606 $cflist conf -state normal
2607 if {$cmitmode ne "tree"} {
2608 set end [lindex [split [$cflist index end] .] 0]
2609 for {set l 2} {$l < $end} {incr l} {
2610 set line [$cflist get $l.0 "$l.0 lineend"]
2611 if {[highlight_tag $line] ne {}} {
2612 $cflist tag add bold $l.0 "$l.0 lineend"
2618 $cflist conf -state disabled
2621 proc unhighlight_filelist {} {
2624 $cflist conf -state normal
2625 $cflist tag remove bold 1.0 end
2626 $cflist conf -state disabled
2629 proc add_flist {fl} {
2632 $cflist conf -state normal
2634 $cflist insert end "\n"
2635 $cflist insert end $f [highlight_tag $f]
2637 $cflist conf -state disabled
2640 proc sel_flist {w x y} {
2641 global ctext difffilestart cflist cflist_top cmitmode
2643 if {$cmitmode eq "tree"} return
2644 if {![info exists cflist_top]} return
2645 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2646 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2647 $cflist tag add highlight $l.0 "$l.0 lineend"
2652 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2656 proc pop_flist_menu {w X Y x y} {
2657 global ctext cflist cmitmode flist_menu flist_menu_file
2658 global treediffs diffids
2661 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2663 if {$cmitmode eq "tree"} {
2664 set e [linetoelt $l]
2665 if {[string index $e end] eq "/"} return
2667 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2669 set flist_menu_file $e
2670 tk_popup $flist_menu $X $Y
2673 proc flist_hl {only} {
2674 global flist_menu_file findstring gdttype
2676 set x [shellquote $flist_menu_file]
2677 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2680 append findstring " " $x
2682 set gdttype [mc "touching paths:"]
2685 # Functions for adding and removing shell-type quoting
2687 proc shellquote {str} {
2688 if {![string match "*\['\"\\ \t]*" $str]} {
2691 if {![string match "*\['\"\\]*" $str]} {
2694 if {![string match "*'*" $str]} {
2697 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2700 proc shellarglist {l} {
2706 append str [shellquote $a]
2711 proc shelldequote {str} {
2716 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2717 append ret [string range $str $used end]
2718 set used [string length $str]
2721 set first [lindex $first 0]
2722 set ch [string index $str $first]
2723 if {$first > $used} {
2724 append ret [string range $str $used [expr {$first - 1}]]
2727 if {$ch eq " " || $ch eq "\t"} break
2730 set first [string first "'" $str $used]
2732 error "unmatched single-quote"
2734 append ret [string range $str $used [expr {$first - 1}]]
2739 if {$used >= [string length $str]} {
2740 error "trailing backslash"
2742 append ret [string index $str $used]
2747 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2748 error "unmatched double-quote"
2750 set first [lindex $first 0]
2751 set ch [string index $str $first]
2752 if {$first > $used} {
2753 append ret [string range $str $used [expr {$first - 1}]]
2756 if {$ch eq "\""} break
2758 append ret [string index $str $used]
2762 return [list $used $ret]
2765 proc shellsplit {str} {
2768 set str [string trimleft $str]
2769 if {$str eq {}} break
2770 set dq [shelldequote $str]
2771 set n [lindex $dq 0]
2772 set word [lindex $dq 1]
2773 set str [string range $str $n end]
2779 # Code to implement multiple views
2781 proc newview {ishighlight} {
2782 global nextviewnum newviewname newviewperm newishighlight
2783 global newviewargs revtreeargs viewargscmd newviewargscmd curview
2785 set newishighlight $ishighlight
2787 if {[winfo exists $top]} {
2791 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
2792 set newviewperm($nextviewnum) 0
2793 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2794 set newviewargscmd($nextviewnum) $viewargscmd($curview)
2795 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2800 global viewname viewperm newviewname newviewperm
2801 global viewargs newviewargs viewargscmd newviewargscmd
2803 set top .gitkvedit-$curview
2804 if {[winfo exists $top]} {
2808 set newviewname($curview) $viewname($curview)
2809 set newviewperm($curview) $viewperm($curview)
2810 set newviewargs($curview) [shellarglist $viewargs($curview)]
2811 set newviewargscmd($curview) $viewargscmd($curview)
2812 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2815 proc vieweditor {top n title} {
2816 global newviewname newviewperm viewfiles bgcolor
2819 wm title $top $title
2820 label $top.nl -text [mc "Name"]
2821 entry $top.name -width 20 -textvariable newviewname($n)
2822 grid $top.nl $top.name -sticky w -pady 5
2823 checkbutton $top.perm -text [mc "Remember this view"] \
2824 -variable newviewperm($n)
2825 grid $top.perm - -pady 5 -sticky w
2826 message $top.al -aspect 1000 \
2827 -text [mc "Commits to include (arguments to git log):"]
2828 grid $top.al - -sticky w -pady 5
2829 entry $top.args -width 50 -textvariable newviewargs($n) \
2830 -background $bgcolor
2831 grid $top.args - -sticky ew -padx 5
2833 message $top.ac -aspect 1000 \
2834 -text [mc "Command to generate more commits to include:"]
2835 grid $top.ac - -sticky w -pady 5
2836 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
2838 grid $top.argscmd - -sticky ew -padx 5
2840 message $top.l -aspect 1000 \
2841 -text [mc "Enter files and directories to include, one per line:"]
2842 grid $top.l - -sticky w
2843 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2844 if {[info exists viewfiles($n)]} {
2845 foreach f $viewfiles($n) {
2846 $top.t insert end $f
2847 $top.t insert end "\n"
2849 $top.t delete {end - 1c} end
2850 $top.t mark set insert 0.0
2852 grid $top.t - -sticky ew -padx 5
2854 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2855 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2856 grid $top.buts.ok $top.buts.can
2857 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2858 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2859 grid $top.buts - -pady 10 -sticky ew
2863 proc doviewmenu {m first cmd op argv} {
2864 set nmenu [$m index end]
2865 for {set i $first} {$i <= $nmenu} {incr i} {
2866 if {[$m entrycget $i -command] eq $cmd} {
2867 eval $m $op $i $argv
2873 proc allviewmenus {n op args} {
2876 doviewmenu .bar.view 5 [list showview $n] $op $args
2877 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2880 proc newviewok {top n} {
2881 global nextviewnum newviewperm newviewname newishighlight
2882 global viewname viewfiles viewperm selectedview curview
2883 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
2886 set newargs [shellsplit $newviewargs($n)]
2888 error_popup "[mc "Error in commit selection arguments:"] $err"
2894 foreach f [split [$top.t get 0.0 end] "\n"] {
2895 set ft [string trim $f]
2900 if {![info exists viewfiles($n)]} {
2901 # creating a new view
2903 set viewname($n) $newviewname($n)
2904 set viewperm($n) $newviewperm($n)
2905 set viewfiles($n) $files
2906 set viewargs($n) $newargs
2907 set viewargscmd($n) $newviewargscmd($n)
2909 if {!$newishighlight} {
2912 run addvhighlight $n
2915 # editing an existing view
2916 set viewperm($n) $newviewperm($n)
2917 if {$newviewname($n) ne $viewname($n)} {
2918 set viewname($n) $newviewname($n)
2919 doviewmenu .bar.view 5 [list showview $n] \
2920 entryconf [list -label $viewname($n)]
2921 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2922 # entryconf [list -label $viewname($n) -value $viewname($n)]
2924 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
2925 $newviewargscmd($n) ne $viewargscmd($n)} {
2926 set viewfiles($n) $files
2927 set viewargs($n) $newargs
2928 set viewargscmd($n) $newviewargscmd($n)
2929 if {$curview == $n} {
2934 catch {destroy $top}
2938 global curview viewperm hlview selectedhlview
2940 if {$curview == 0} return
2941 if {[info exists hlview] && $hlview == $curview} {
2942 set selectedhlview [mc "None"]
2945 allviewmenus $curview delete
2946 set viewperm($curview) 0
2950 proc addviewmenu {n} {
2951 global viewname viewhlmenu
2953 .bar.view add radiobutton -label $viewname($n) \
2954 -command [list showview $n] -variable selectedview -value $n
2955 #$viewhlmenu add radiobutton -label $viewname($n) \
2956 # -command [list addvhighlight $n] -variable selectedhlview
2960 global curview cached_commitrow ordertok
2961 global displayorder parentlist rowidlist rowisopt rowfinal
2962 global colormap rowtextx nextcolor canvxmax
2963 global numcommits viewcomplete
2964 global selectedline currentid canv canvy0
2966 global pending_select mainheadid
2969 global hlview selectedhlview commitinterest
2971 if {$n == $curview} return
2973 set ymax [lindex [$canv cget -scrollregion] 3]
2974 set span [$canv yview]
2975 set ytop [expr {[lindex $span 0] * $ymax}]
2976 set ybot [expr {[lindex $span 1] * $ymax}]
2977 set yscreen [expr {($ybot - $ytop) / 2}]
2978 if {[info exists selectedline]} {
2979 set selid $currentid
2980 set y [yc $selectedline]
2981 if {$ytop < $y && $y < $ybot} {
2982 set yscreen [expr {$y - $ytop}]
2984 } elseif {[info exists pending_select]} {
2985 set selid $pending_select
2986 unset pending_select
2990 catch {unset treediffs}
2992 if {[info exists hlview] && $hlview == $n} {
2994 set selectedhlview [mc "None"]
2996 catch {unset commitinterest}
2997 catch {unset cached_commitrow}
2998 catch {unset ordertok}
3002 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3003 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3006 if {![info exists viewcomplete($n)]} {
3008 set pending_select $selid
3019 set numcommits $commitidx($n)
3021 catch {unset colormap}
3022 catch {unset rowtextx}
3024 set canvxmax [$canv cget -width]
3030 if {$selid ne {} && [commitinview $selid $n]} {
3031 set row [rowofcommit $selid]
3032 # try to get the selected row in the same position on the screen
3033 set ymax [lindex [$canv cget -scrollregion] 3]
3034 set ytop [expr {[yc $row] - $yscreen}]
3038 set yf [expr {$ytop * 1.0 / $ymax}]
3040 allcanvs yview moveto $yf
3044 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
3045 selectline [rowofcommit $mainheadid] 1
3046 } elseif {!$viewcomplete($n)} {
3048 set pending_select $selid
3050 set pending_select $mainheadid
3053 set row [first_real_row]
3054 if {$row < $numcommits} {
3058 if {!$viewcomplete($n)} {
3059 if {$numcommits == 0} {
3060 show_status [mc "Reading commits..."]
3062 } elseif {$numcommits == 0} {
3063 show_status [mc "No commits selected"]
3067 # Stuff relating to the highlighting facility
3069 proc ishighlighted {id} {
3070 global vhighlights fhighlights nhighlights rhighlights
3072 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3073 return $nhighlights($id)
3075 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3076 return $vhighlights($id)
3078 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3079 return $fhighlights($id)
3081 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3082 return $rhighlights($id)
3087 proc bolden {row font} {
3088 global canv linehtag selectedline boldrows
3090 lappend boldrows $row
3091 $canv itemconf $linehtag($row) -font $font
3092 if {[info exists selectedline] && $row == $selectedline} {
3094 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3095 -outline {{}} -tags secsel \
3096 -fill [$canv cget -selectbackground]]
3101 proc bolden_name {row font} {
3102 global canv2 linentag selectedline boldnamerows
3104 lappend boldnamerows $row
3105 $canv2 itemconf $linentag($row) -font $font
3106 if {[info exists selectedline] && $row == $selectedline} {
3107 $canv2 delete secsel
3108 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3109 -outline {{}} -tags secsel \
3110 -fill [$canv2 cget -selectbackground]]
3119 foreach row $boldrows {
3120 if {![ishighlighted [commitonrow $row]]} {
3121 bolden $row mainfont
3123 lappend stillbold $row
3126 set boldrows $stillbold
3129 proc addvhighlight {n} {
3130 global hlview viewcomplete curview vhl_done commitidx
3132 if {[info exists hlview]} {
3136 if {$n != $curview && ![info exists viewcomplete($n)]} {
3139 set vhl_done $commitidx($hlview)
3140 if {$vhl_done > 0} {
3145 proc delvhighlight {} {
3146 global hlview vhighlights
3148 if {![info exists hlview]} return
3150 catch {unset vhighlights}
3154 proc vhighlightmore {} {
3155 global hlview vhl_done commitidx vhighlights curview
3157 set max $commitidx($hlview)
3158 set vr [visiblerows]
3159 set r0 [lindex $vr 0]
3160 set r1 [lindex $vr 1]
3161 for {set i $vhl_done} {$i < $max} {incr i} {
3162 set id [commitonrow $i $hlview]
3163 if {[commitinview $id $curview]} {
3164 set row [rowofcommit $id]
3165 if {$r0 <= $row && $row <= $r1} {
3166 if {![highlighted $row]} {
3167 bolden $row mainfontbold
3169 set vhighlights($id) 1
3177 proc askvhighlight {row id} {
3178 global hlview vhighlights iddrawn
3180 if {[commitinview $id $hlview]} {
3181 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3182 bolden $row mainfontbold
3184 set vhighlights($id) 1
3186 set vhighlights($id) 0
3190 proc hfiles_change {} {
3191 global highlight_files filehighlight fhighlights fh_serial
3192 global highlight_paths gdttype
3194 if {[info exists filehighlight]} {
3195 # delete previous highlights
3196 catch {close $filehighlight}
3198 catch {unset fhighlights}
3200 unhighlight_filelist
3202 set highlight_paths {}
3203 after cancel do_file_hl $fh_serial
3205 if {$highlight_files ne {}} {
3206 after 300 do_file_hl $fh_serial
3210 proc gdttype_change {name ix op} {
3211 global gdttype highlight_files findstring findpattern
3214 if {$findstring ne {}} {
3215 if {$gdttype eq [mc "containing:"]} {
3216 if {$highlight_files ne {}} {
3217 set highlight_files {}
3222 if {$findpattern ne {}} {
3226 set highlight_files $findstring
3231 # enable/disable findtype/findloc menus too
3234 proc find_change {name ix op} {
3235 global gdttype findstring highlight_files
3238 if {$gdttype eq [mc "containing:"]} {
3241 if {$highlight_files ne $findstring} {
3242 set highlight_files $findstring
3249 proc findcom_change args {
3250 global nhighlights boldnamerows
3251 global findpattern findtype findstring gdttype
3254 # delete previous highlights, if any
3255 foreach row $boldnamerows {
3256 bolden_name $row mainfont
3259 catch {unset nhighlights}
3262 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3264 } elseif {$findtype eq [mc "Regexp"]} {
3265 set findpattern $findstring
3267 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3269 set findpattern "*$e*"
3273 proc makepatterns {l} {
3276 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3277 if {[string index $ee end] eq "/"} {
3287 proc do_file_hl {serial} {
3288 global highlight_files filehighlight highlight_paths gdttype fhl_list
3290 if {$gdttype eq [mc "touching paths:"]} {
3291 if {[catch {set paths [shellsplit $highlight_files]}]} return
3292 set highlight_paths [makepatterns $paths]
3294 set gdtargs [concat -- $paths]
3295 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3296 set gdtargs [list "-S$highlight_files"]
3298 # must be "containing:", i.e. we're searching commit info
3301 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3302 set filehighlight [open $cmd r+]
3303 fconfigure $filehighlight -blocking 0
3304 filerun $filehighlight readfhighlight
3310 proc flushhighlights {} {
3311 global filehighlight fhl_list
3313 if {[info exists filehighlight]} {
3315 puts $filehighlight ""
3316 flush $filehighlight
3320 proc askfilehighlight {row id} {
3321 global filehighlight fhighlights fhl_list
3323 lappend fhl_list $id
3324 set fhighlights($id) -1
3325 puts $filehighlight $id
3328 proc readfhighlight {} {
3329 global filehighlight fhighlights curview iddrawn
3330 global fhl_list find_dirn
3332 if {![info exists filehighlight]} {
3336 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3337 set line [string trim $line]
3338 set i [lsearch -exact $fhl_list $line]
3339 if {$i < 0} continue
3340 for {set j 0} {$j < $i} {incr j} {
3341 set id [lindex $fhl_list $j]
3342 set fhighlights($id) 0
3344 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3345 if {$line eq {}} continue
3346 if {![commitinview $line $curview]} continue
3347 set row [rowofcommit $line]
3348 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3349 bolden $row mainfontbold
3351 set fhighlights($line) 1
3353 if {[eof $filehighlight]} {
3355 puts "oops, git diff-tree died"
3356 catch {close $filehighlight}
3360 if {[info exists find_dirn]} {
3366 proc doesmatch {f} {
3367 global findtype findpattern
3369 if {$findtype eq [mc "Regexp"]} {
3370 return [regexp $findpattern $f]
3371 } elseif {$findtype eq [mc "IgnCase"]} {
3372 return [string match -nocase $findpattern $f]
3374 return [string match $findpattern $f]
3378 proc askfindhighlight {row id} {
3379 global nhighlights commitinfo iddrawn
3381 global markingmatches
3383 if {![info exists commitinfo($id)]} {
3386 set info $commitinfo($id)
3388 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3389 foreach f $info ty $fldtypes {
3390 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3392 if {$ty eq [mc "Author"]} {
3399 if {$isbold && [info exists iddrawn($id)]} {
3400 if {![ishighlighted $id]} {
3401 bolden $row mainfontbold
3403 bolden_name $row mainfontbold
3406 if {$markingmatches} {
3407 markrowmatches $row $id
3410 set nhighlights($id) $isbold
3413 proc markrowmatches {row id} {
3414 global canv canv2 linehtag linentag commitinfo findloc
3416 set headline [lindex $commitinfo($id) 0]
3417 set author [lindex $commitinfo($id) 1]
3418 $canv delete match$row
3419 $canv2 delete match$row
3420 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3421 set m [findmatches $headline]
3423 markmatches $canv $row $headline $linehtag($row) $m \
3424 [$canv itemcget $linehtag($row) -font] $row
3427 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3428 set m [findmatches $author]
3430 markmatches $canv2 $row $author $linentag($row) $m \
3431 [$canv2 itemcget $linentag($row) -font] $row
3436 proc vrel_change {name ix op} {
3437 global highlight_related
3440 if {$highlight_related ne [mc "None"]} {
3445 # prepare for testing whether commits are descendents or ancestors of a
3446 proc rhighlight_sel {a} {
3447 global descendent desc_todo ancestor anc_todo
3448 global highlight_related
3450 catch {unset descendent}
3451 set desc_todo [list $a]
3452 catch {unset ancestor}
3453 set anc_todo [list $a]
3454 if {$highlight_related ne [mc "None"]} {
3460 proc rhighlight_none {} {
3463 catch {unset rhighlights}
3467 proc is_descendent {a} {
3468 global curview children descendent desc_todo
3471 set la [rowofcommit $a]
3475 for {set i 0} {$i < [llength $todo]} {incr i} {
3476 set do [lindex $todo $i]
3477 if {[rowofcommit $do] < $la} {
3478 lappend leftover $do
3481 foreach nk $children($v,$do) {
3482 if {![info exists descendent($nk)]} {
3483 set descendent($nk) 1
3491 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3495 set descendent($a) 0
3496 set desc_todo $leftover
3499 proc is_ancestor {a} {
3500 global curview parents ancestor anc_todo
3503 set la [rowofcommit $a]
3507 for {set i 0} {$i < [llength $todo]} {incr i} {
3508 set do [lindex $todo $i]
3509 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3510 lappend leftover $do
3513 foreach np $parents($v,$do) {
3514 if {![info exists ancestor($np)]} {
3523 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3528 set anc_todo $leftover
3531 proc askrelhighlight {row id} {
3532 global descendent highlight_related iddrawn rhighlights
3533 global selectedline ancestor
3535 if {![info exists selectedline]} return
3537 if {$highlight_related eq [mc "Descendant"] ||
3538 $highlight_related eq [mc "Not descendant"]} {
3539 if {![info exists descendent($id)]} {
3542 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3545 } elseif {$highlight_related eq [mc "Ancestor"] ||
3546 $highlight_related eq [mc "Not ancestor"]} {
3547 if {![info exists ancestor($id)]} {
3550 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3554 if {[info exists iddrawn($id)]} {
3555 if {$isbold && ![ishighlighted $id]} {
3556 bolden $row mainfontbold
3559 set rhighlights($id) $isbold
3562 # Graph layout functions
3564 proc shortids {ids} {
3567 if {[llength $id] > 1} {
3568 lappend res [shortids $id]
3569 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3570 lappend res [string range $id 0 7]
3581 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3582 if {($n & $mask) != 0} {
3583 set ret [concat $ret $o]
3585 set o [concat $o $o]
3590 proc ordertoken {id} {
3591 global ordertok curview varcid varcstart varctok curview parents children
3592 global nullid nullid2
3594 if {[info exists ordertok($id)]} {
3595 return $ordertok($id)
3600 if {[info exists varcid($curview,$id)]} {
3601 set a $varcid($curview,$id)
3602 set p [lindex $varcstart($curview) $a]
3604 set p [lindex $children($curview,$id) 0]
3606 if {[info exists ordertok($p)]} {
3607 set tok $ordertok($p)
3610 set id [first_real_child $curview,$p]
3613 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3616 if {[llength $parents($curview,$id)] == 1} {
3617 lappend todo [list $p {}]
3619 set j [lsearch -exact $parents($curview,$id) $p]
3621 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3623 lappend todo [list $p [strrep $j]]
3626 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3627 set p [lindex $todo $i 0]
3628 append tok [lindex $todo $i 1]
3629 set ordertok($p) $tok
3631 set ordertok($origid) $tok
3635 # Work out where id should go in idlist so that order-token
3636 # values increase from left to right
3637 proc idcol {idlist id {i 0}} {
3638 set t [ordertoken $id]
3642 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3643 if {$i > [llength $idlist]} {
3644 set i [llength $idlist]
3646 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3649 if {$t > [ordertoken [lindex $idlist $i]]} {
3650 while {[incr i] < [llength $idlist] &&
3651 $t >= [ordertoken [lindex $idlist $i]]} {}
3657 proc initlayout {} {
3658 global rowidlist rowisopt rowfinal displayorder parentlist
3659 global numcommits canvxmax canv
3661 global colormap rowtextx
3670 set canvxmax [$canv cget -width]
3671 catch {unset colormap}
3672 catch {unset rowtextx}
3676 proc setcanvscroll {} {
3677 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3678 global lastscrollset lastscrollrows
3680 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3681 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3682 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3683 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3684 set lastscrollset [clock clicks -milliseconds]
3685 set lastscrollrows $numcommits
3688 proc visiblerows {} {
3689 global canv numcommits linespc
3691 set ymax [lindex [$canv cget -scrollregion] 3]
3692 if {$ymax eq {} || $ymax == 0} return
3694 set y0 [expr {int([lindex $f 0] * $ymax)}]
3695 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3699 set y1 [expr {int([lindex $f 1] * $ymax)}]
3700 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3701 if {$r1 >= $numcommits} {
3702 set r1 [expr {$numcommits - 1}]
3704 return [list $r0 $r1]
3707 proc layoutmore {} {
3708 global commitidx viewcomplete curview
3709 global numcommits pending_select selectedline curview
3710 global lastscrollset lastscrollrows commitinterest
3712 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
3713 [clock clicks -milliseconds] - $lastscrollset > 500} {
3716 if {[info exists pending_select] &&
3717 [commitinview $pending_select $curview]} {
3718 selectline [rowofcommit $pending_select] 1
3723 proc doshowlocalchanges {} {
3724 global curview mainheadid
3726 if {[commitinview $mainheadid $curview]} {
3729 lappend commitinterest($mainheadid) {dodiffindex}
3733 proc dohidelocalchanges {} {
3734 global nullid nullid2 lserial curview
3736 if {[commitinview $nullid $curview]} {
3737 removefakerow $nullid
3739 if {[commitinview $nullid2 $curview]} {
3740 removefakerow $nullid2
3745 # spawn off a process to do git diff-index --cached HEAD
3746 proc dodiffindex {} {
3747 global lserial showlocalchanges
3750 if {!$showlocalchanges || !$isworktree} return
3752 set fd [open "|git diff-index --cached HEAD" r]
3753 fconfigure $fd -blocking 0
3754 filerun $fd [list readdiffindex $fd $lserial]
3757 proc readdiffindex {fd serial} {
3758 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3761 if {[gets $fd line] < 0} {
3767 # we only need to see one line and we don't really care what it says...
3770 if {$serial != $lserial} {
3774 # now see if there are any local changes not checked in to the index
3775 set fd [open "|git diff-files" r]
3776 fconfigure $fd -blocking 0
3777 filerun $fd [list readdifffiles $fd $serial]
3779 if {$isdiff && ![commitinview $nullid2 $curview]} {
3780 # add the line for the changes in the index to the graph
3781 set hl [mc "Local changes checked in to index but not committed"]
3782 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3783 set commitdata($nullid2) "\n $hl\n"
3784 if {[commitinview $nullid $curview]} {
3785 removefakerow $nullid
3787 insertfakerow $nullid2 $mainheadid
3788 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3789 removefakerow $nullid2
3794 proc readdifffiles {fd serial} {
3795 global mainheadid nullid nullid2 curview
3796 global commitinfo commitdata lserial
3799 if {[gets $fd line] < 0} {
3805 # we only need to see one line and we don't really care what it says...
3808 if {$serial != $lserial} {
3812 if {$isdiff && ![commitinview $nullid $curview]} {
3813 # add the line for the local diff to the graph
3814 set hl [mc "Local uncommitted changes, not checked in to index"]
3815 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3816 set commitdata($nullid) "\n $hl\n"
3817 if {[commitinview $nullid2 $curview]} {
3822 insertfakerow $nullid $p
3823 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3824 removefakerow $nullid
3829 proc nextuse {id row} {
3830 global curview children
3832 if {[info exists children($curview,$id)]} {
3833 foreach kid $children($curview,$id) {
3834 if {![commitinview $kid $curview]} {
3837 if {[rowofcommit $kid] > $row} {
3838 return [rowofcommit $kid]
3842 if {[commitinview $id $curview]} {
3843 return [rowofcommit $id]
3848 proc prevuse {id row} {
3849 global curview children
3852 if {[info exists children($curview,$id)]} {
3853 foreach kid $children($curview,$id) {
3854 if {![commitinview $kid $curview]} break
3855 if {[rowofcommit $kid] < $row} {
3856 set ret [rowofcommit $kid]
3863 proc make_idlist {row} {
3864 global displayorder parentlist uparrowlen downarrowlen mingaplen
3865 global commitidx curview children
3867 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3871 set ra [expr {$row - $downarrowlen}]
3875 set rb [expr {$row + $uparrowlen}]
3876 if {$rb > $commitidx($curview)} {
3877 set rb $commitidx($curview)
3879 make_disporder $r [expr {$rb + 1}]
3881 for {} {$r < $ra} {incr r} {
3882 set nextid [lindex $displayorder [expr {$r + 1}]]
3883 foreach p [lindex $parentlist $r] {
3884 if {$p eq $nextid} continue
3885 set rn [nextuse $p $r]
3887 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3888 lappend ids [list [ordertoken $p] $p]
3892 for {} {$r < $row} {incr r} {
3893 set nextid [lindex $displayorder [expr {$r + 1}]]
3894 foreach p [lindex $parentlist $r] {
3895 if {$p eq $nextid} continue
3896 set rn [nextuse $p $r]
3897 if {$rn < 0 || $rn >= $row} {
3898 lappend ids [list [ordertoken $p] $p]
3902 set id [lindex $displayorder $row]
3903 lappend ids [list [ordertoken $id] $id]
3905 foreach p [lindex $parentlist $r] {
3906 set firstkid [lindex $children($curview,$p) 0]
3907 if {[rowofcommit $firstkid] < $row} {
3908 lappend ids [list [ordertoken $p] $p]
3912 set id [lindex $displayorder $r]
3914 set firstkid [lindex $children($curview,$id) 0]
3915 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3916 lappend ids [list [ordertoken $id] $id]
3921 foreach idx [lsort -unique $ids] {
3922 lappend idlist [lindex $idx 1]
3927 proc rowsequal {a b} {
3928 while {[set i [lsearch -exact $a {}]] >= 0} {
3929 set a [lreplace $a $i $i]
3931 while {[set i [lsearch -exact $b {}]] >= 0} {
3932 set b [lreplace $b $i $i]
3934 return [expr {$a eq $b}]
3937 proc makeupline {id row rend col} {
3938 global rowidlist uparrowlen downarrowlen mingaplen
3940 for {set r $rend} {1} {set r $rstart} {
3941 set rstart [prevuse $id $r]
3942 if {$rstart < 0} return
3943 if {$rstart < $row} break
3945 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3946 set rstart [expr {$rend - $uparrowlen - 1}]
3948 for {set r $rstart} {[incr r] <= $row} {} {
3949 set idlist [lindex $rowidlist $r]
3950 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3951 set col [idcol $idlist $id $col]
3952 lset rowidlist $r [linsert $idlist $col $id]
3958 proc layoutrows {row endrow} {
3959 global rowidlist rowisopt rowfinal displayorder
3960 global uparrowlen downarrowlen maxwidth mingaplen
3961 global children parentlist
3962 global commitidx viewcomplete curview
3964 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3967 set rm1 [expr {$row - 1}]
3968 foreach id [lindex $rowidlist $rm1] {
3973 set final [lindex $rowfinal $rm1]
3975 for {} {$row < $endrow} {incr row} {
3976 set rm1 [expr {$row - 1}]
3977 if {$rm1 < 0 || $idlist eq {}} {
3978 set idlist [make_idlist $row]
3981 set id [lindex $displayorder $rm1]
3982 set col [lsearch -exact $idlist $id]
3983 set idlist [lreplace $idlist $col $col]
3984 foreach p [lindex $parentlist $rm1] {
3985 if {[lsearch -exact $idlist $p] < 0} {
3986 set col [idcol $idlist $p $col]
3987 set idlist [linsert $idlist $col $p]
3988 # if not the first child, we have to insert a line going up
3989 if {$id ne [lindex $children($curview,$p) 0]} {
3990 makeupline $p $rm1 $row $col
3994 set id [lindex $displayorder $row]
3995 if {$row > $downarrowlen} {
3996 set termrow [expr {$row - $downarrowlen - 1}]
3997 foreach p [lindex $parentlist $termrow] {
3998 set i [lsearch -exact $idlist $p]
3999 if {$i < 0} continue
4000 set nr [nextuse $p $termrow]
4001 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4002 set idlist [lreplace $idlist $i $i]
4006 set col [lsearch -exact $idlist $id]
4008 set col [idcol $idlist $id]
4009 set idlist [linsert $idlist $col $id]
4010 if {$children($curview,$id) ne {}} {
4011 makeupline $id $rm1 $row $col
4014 set r [expr {$row + $uparrowlen - 1}]
4015 if {$r < $commitidx($curview)} {
4017 foreach p [lindex $parentlist $r] {
4018 if {[lsearch -exact $idlist $p] >= 0} continue
4019 set fk [lindex $children($curview,$p) 0]
4020 if {[rowofcommit $fk] < $row} {
4021 set x [idcol $idlist $p $x]
4022 set idlist [linsert $idlist $x $p]
4025 if {[incr r] < $commitidx($curview)} {
4026 set p [lindex $displayorder $r]
4027 if {[lsearch -exact $idlist $p] < 0} {
4028 set fk [lindex $children($curview,$p) 0]
4029 if {$fk ne {} && [rowofcommit $fk] < $row} {
4030 set x [idcol $idlist $p $x]
4031 set idlist [linsert $idlist $x $p]
4037 if {$final && !$viewcomplete($curview) &&
4038 $row + $uparrowlen + $mingaplen + $downarrowlen
4039 >= $commitidx($curview)} {
4042 set l [llength $rowidlist]
4044 lappend rowidlist $idlist
4046 lappend rowfinal $final
4047 } elseif {$row < $l} {
4048 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4049 lset rowidlist $row $idlist
4052 lset rowfinal $row $final
4054 set pad [ntimes [expr {$row - $l}] {}]
4055 set rowidlist [concat $rowidlist $pad]
4056 lappend rowidlist $idlist
4057 set rowfinal [concat $rowfinal $pad]
4058 lappend rowfinal $final
4059 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4065 proc changedrow {row} {
4066 global displayorder iddrawn rowisopt need_redisplay
4068 set l [llength $rowisopt]
4070 lset rowisopt $row 0
4071 if {$row + 1 < $l} {
4072 lset rowisopt [expr {$row + 1}] 0
4073 if {$row + 2 < $l} {
4074 lset rowisopt [expr {$row + 2}] 0
4078 set id [lindex $displayorder $row]
4079 if {[info exists iddrawn($id)]} {
4080 set need_redisplay 1
4084 proc insert_pad {row col npad} {
4087 set pad [ntimes $npad {}]
4088 set idlist [lindex $rowidlist $row]
4089 set bef [lrange $idlist 0 [expr {$col - 1}]]
4090 set aft [lrange $idlist $col end]
4091 set i [lsearch -exact $aft {}]
4093 set aft [lreplace $aft $i $i]
4095 lset rowidlist $row [concat $bef $pad $aft]
4099 proc optimize_rows {row col endrow} {
4100 global rowidlist rowisopt displayorder curview children
4105 for {} {$row < $endrow} {incr row; set col 0} {
4106 if {[lindex $rowisopt $row]} continue
4108 set y0 [expr {$row - 1}]
4109 set ym [expr {$row - 2}]
4110 set idlist [lindex $rowidlist $row]
4111 set previdlist [lindex $rowidlist $y0]
4112 if {$idlist eq {} || $previdlist eq {}} continue
4114 set pprevidlist [lindex $rowidlist $ym]
4115 if {$pprevidlist eq {}} continue
4121 for {} {$col < [llength $idlist]} {incr col} {
4122 set id [lindex $idlist $col]
4123 if {[lindex $previdlist $col] eq $id} continue
4128 set x0 [lsearch -exact $previdlist $id]
4129 if {$x0 < 0} continue
4130 set z [expr {$x0 - $col}]
4134 set xm [lsearch -exact $pprevidlist $id]
4136 set z0 [expr {$xm - $x0}]
4140 # if row y0 is the first child of $id then it's not an arrow
4141 if {[lindex $children($curview,$id) 0] ne
4142 [lindex $displayorder $y0]} {
4146 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4147 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4150 # Looking at lines from this row to the previous row,
4151 # make them go straight up if they end in an arrow on
4152 # the previous row; otherwise make them go straight up
4154 if {$z < -1 || ($z < 0 && $isarrow)} {
4155 # Line currently goes left too much;
4156 # insert pads in the previous row, then optimize it
4157 set npad [expr {-1 - $z + $isarrow}]
4158 insert_pad $y0 $x0 $npad
4160 optimize_rows $y0 $x0 $row
4162 set previdlist [lindex $rowidlist $y0]
4163 set x0 [lsearch -exact $previdlist $id]
4164 set z [expr {$x0 - $col}]
4166 set pprevidlist [lindex $rowidlist $ym]
4167 set xm [lsearch -exact $pprevidlist $id]
4168 set z0 [expr {$xm - $x0}]
4170 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4171 # Line currently goes right too much;
4172 # insert pads in this line
4173 set npad [expr {$z - 1 + $isarrow}]
4174 insert_pad $row $col $npad
4175 set idlist [lindex $rowidlist $row]
4177 set z [expr {$x0 - $col}]
4180 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4181 # this line links to its first child on row $row-2
4182 set id [lindex $displayorder $ym]
4183 set xc [lsearch -exact $pprevidlist $id]
4185 set z0 [expr {$xc - $x0}]
4188 # avoid lines jigging left then immediately right
4189 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4190 insert_pad $y0 $x0 1
4192 optimize_rows $y0 $x0 $row
4193 set previdlist [lindex $rowidlist $y0]
4197 # Find the first column that doesn't have a line going right
4198 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4199 set id [lindex $idlist $col]
4200 if {$id eq {}} break
4201 set x0 [lsearch -exact $previdlist $id]
4203 # check if this is the link to the first child
4204 set kid [lindex $displayorder $y0]
4205 if {[lindex $children($curview,$id) 0] eq $kid} {
4206 # it is, work out offset to child
4207 set x0 [lsearch -exact $previdlist $kid]
4210 if {$x0 <= $col} break
4212 # Insert a pad at that column as long as it has a line and
4213 # isn't the last column
4214 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4215 set idlist [linsert $idlist $col {}]
4216 lset rowidlist $row $idlist
4224 global canvx0 linespc
4225 return [expr {$canvx0 + $col * $linespc}]
4229 global canvy0 linespc
4230 return [expr {$canvy0 + $row * $linespc}]
4233 proc linewidth {id} {
4234 global thickerline lthickness
4237 if {[info exists thickerline] && $id eq $thickerline} {
4238 set wid [expr {2 * $lthickness}]
4243 proc rowranges {id} {
4244 global curview children uparrowlen downarrowlen
4247 set kids $children($curview,$id)
4253 foreach child $kids {
4254 if {![commitinview $child $curview]} break
4255 set row [rowofcommit $child]
4256 if {![info exists prev]} {
4257 lappend ret [expr {$row + 1}]
4259 if {$row <= $prevrow} {
4260 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4262 # see if the line extends the whole way from prevrow to row
4263 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4264 [lsearch -exact [lindex $rowidlist \
4265 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4266 # it doesn't, see where it ends
4267 set r [expr {$prevrow + $downarrowlen}]
4268 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4269 while {[incr r -1] > $prevrow &&
4270 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4272 while {[incr r] <= $row &&
4273 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4277 # see where it starts up again
4278 set r [expr {$row - $uparrowlen}]
4279 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4280 while {[incr r] < $row &&
4281 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4283 while {[incr r -1] >= $prevrow &&
4284 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4290 if {$child eq $id} {
4299 proc drawlineseg {id row endrow arrowlow} {
4300 global rowidlist displayorder iddrawn linesegs
4301 global canv colormap linespc curview maxlinelen parentlist
4303 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4304 set le [expr {$row + 1}]
4307 set c [lsearch -exact [lindex $rowidlist $le] $id]
4313 set x [lindex $displayorder $le]
4318 if {[info exists iddrawn($x)] || $le == $endrow} {
4319 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4335 if {[info exists linesegs($id)]} {
4336 set lines $linesegs($id)
4338 set r0 [lindex $li 0]
4340 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4350 set li [lindex $lines [expr {$i-1}]]
4351 set r1 [lindex $li 1]
4352 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4357 set x [lindex $cols [expr {$le - $row}]]
4358 set xp [lindex $cols [expr {$le - 1 - $row}]]
4359 set dir [expr {$xp - $x}]
4361 set ith [lindex $lines $i 2]
4362 set coords [$canv coords $ith]
4363 set ah [$canv itemcget $ith -arrow]
4364 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4365 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4366 if {$x2 ne {} && $x - $x2 == $dir} {
4367 set coords [lrange $coords 0 end-2]
4370 set coords [list [xc $le $x] [yc $le]]
4373 set itl [lindex $lines [expr {$i-1}] 2]
4374 set al [$canv itemcget $itl -arrow]
4375 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4376 } elseif {$arrowlow} {
4377 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4378 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4382 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4383 for {set y $le} {[incr y -1] > $row} {} {
4385 set xp [lindex $cols [expr {$y - 1 - $row}]]
4386 set ndir [expr {$xp - $x}]
4387 if {$dir != $ndir || $xp < 0} {
4388 lappend coords [xc $y $x] [yc $y]
4394 # join parent line to first child
4395 set ch [lindex $displayorder $row]
4396 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4398 puts "oops: drawlineseg: child $ch not on row $row"
4399 } elseif {$xc != $x} {
4400 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4401 set d [expr {int(0.5 * $linespc)}]
4404 set x2 [expr {$x1 - $d}]
4406 set x2 [expr {$x1 + $d}]
4409 set y1 [expr {$y2 + $d}]
4410 lappend coords $x1 $y1 $x2 $y2
4411 } elseif {$xc < $x - 1} {
4412 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4413 } elseif {$xc > $x + 1} {
4414 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4418 lappend coords [xc $row $x] [yc $row]
4420 set xn [xc $row $xp]
4422 lappend coords $xn $yn
4426 set t [$canv create line $coords -width [linewidth $id] \
4427 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4430 set lines [linsert $lines $i [list $row $le $t]]
4432 $canv coords $ith $coords
4433 if {$arrow ne $ah} {
4434 $canv itemconf $ith -arrow $arrow
4436 lset lines $i 0 $row
4439 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4440 set ndir [expr {$xo - $xp}]
4441 set clow [$canv coords $itl]
4442 if {$dir == $ndir} {
4443 set clow [lrange $clow 2 end]
4445 set coords [concat $coords $clow]
4447 lset lines [expr {$i-1}] 1 $le
4449 # coalesce two pieces
4451 set b [lindex $lines [expr {$i-1}] 0]
4452 set e [lindex $lines $i 1]
4453 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4455 $canv coords $itl $coords
4456 if {$arrow ne $al} {
4457 $canv itemconf $itl -arrow $arrow
4461 set linesegs($id) $lines
4465 proc drawparentlinks {id row} {
4466 global rowidlist canv colormap curview parentlist
4467 global idpos linespc
4469 set rowids [lindex $rowidlist $row]
4470 set col [lsearch -exact $rowids $id]
4471 if {$col < 0} return
4472 set olds [lindex $parentlist $row]
4473 set row2 [expr {$row + 1}]
4474 set x [xc $row $col]
4477 set d [expr {int(0.5 * $linespc)}]
4478 set ymid [expr {$y + $d}]
4479 set ids [lindex $rowidlist $row2]
4480 # rmx = right-most X coord used
4483 set i [lsearch -exact $ids $p]
4485 puts "oops, parent $p of $id not in list"
4488 set x2 [xc $row2 $i]
4492 set j [lsearch -exact $rowids $p]
4494 # drawlineseg will do this one for us
4498 # should handle duplicated parents here...
4499 set coords [list $x $y]
4501 # if attaching to a vertical segment, draw a smaller
4502 # slant for visual distinctness
4505 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4507 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4509 } elseif {$i < $col && $i < $j} {
4510 # segment slants towards us already
4511 lappend coords [xc $row $j] $y
4513 if {$i < $col - 1} {
4514 lappend coords [expr {$x2 + $linespc}] $y
4515 } elseif {$i > $col + 1} {
4516 lappend coords [expr {$x2 - $linespc}] $y
4518 lappend coords $x2 $y2
4521 lappend coords $x2 $y2
4523 set t [$canv create line $coords -width [linewidth $p] \
4524 -fill $colormap($p) -tags lines.$p]
4528 if {$rmx > [lindex $idpos($id) 1]} {
4529 lset idpos($id) 1 $rmx
4534 proc drawlines {id} {
4537 $canv itemconf lines.$id -width [linewidth $id]
4540 proc drawcmittext {id row col} {
4541 global linespc canv canv2 canv3 fgcolor curview
4542 global cmitlisted commitinfo rowidlist parentlist
4543 global rowtextx idpos idtags idheads idotherrefs
4544 global linehtag linentag linedtag selectedline
4545 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4547 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4548 set listed $cmitlisted($curview,$id)
4549 if {$id eq $nullid} {
4551 } elseif {$id eq $nullid2} {
4554 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
4556 set x [xc $row $col]
4558 set orad [expr {$linespc / 3}]
4560 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4561 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4562 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4563 } elseif {$listed == 3} {
4564 # triangle pointing left for left-side commits
4565 set t [$canv create polygon \
4566 [expr {$x - $orad}] $y \
4567 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4568 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4569 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4571 # triangle pointing right for right-side commits
4572 set t [$canv create polygon \
4573 [expr {$x + $orad - 1}] $y \
4574 [expr {$x - $orad}] [expr {$y - $orad}] \
4575 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4576 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4579 $canv bind $t <1> {selcanvline {} %x %y}
4580 set rmx [llength [lindex $rowidlist $row]]
4581 set olds [lindex $parentlist $row]
4583 set nextids [lindex $rowidlist [expr {$row + 1}]]
4585 set i [lsearch -exact $nextids $p]
4591 set xt [xc $row $rmx]
4592 set rowtextx($row) $xt
4593 set idpos($id) [list $x $xt $y]
4594 if {[info exists idtags($id)] || [info exists idheads($id)]
4595 || [info exists idotherrefs($id)]} {
4596 set xt [drawtags $id $x $xt $y]
4598 set headline [lindex $commitinfo($id) 0]
4599 set name [lindex $commitinfo($id) 1]
4600 set date [lindex $commitinfo($id) 2]
4601 set date [formatdate $date]
4604 set isbold [ishighlighted $id]
4606 lappend boldrows $row
4607 set font mainfontbold
4609 lappend boldnamerows $row
4610 set nfont mainfontbold
4613 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4614 -text $headline -font $font -tags text]
4615 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4616 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4617 -text $name -font $nfont -tags text]
4618 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4619 -text $date -font mainfont -tags text]
4620 if {[info exists selectedline] && $selectedline == $row} {
4623 set xr [expr {$xt + [font measure $font $headline]}]
4624 if {$xr > $canvxmax} {
4630 proc drawcmitrow {row} {
4631 global displayorder rowidlist nrows_drawn
4632 global iddrawn markingmatches
4633 global commitinfo numcommits
4634 global filehighlight fhighlights findpattern nhighlights
4635 global hlview vhighlights
4636 global highlight_related rhighlights
4638 if {$row >= $numcommits} return
4640 set id [lindex $displayorder $row]
4641 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4642 askvhighlight $row $id
4644 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4645 askfilehighlight $row $id
4647 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4648 askfindhighlight $row $id
4650 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4651 askrelhighlight $row $id
4653 if {![info exists iddrawn($id)]} {
4654 set col [lsearch -exact [lindex $rowidlist $row] $id]
4656 puts "oops, row $row id $id not in list"
4659 if {![info exists commitinfo($id)]} {
4663 drawcmittext $id $row $col
4667 if {$markingmatches} {
4668 markrowmatches $row $id
4672 proc drawcommits {row {endrow {}}} {
4673 global numcommits iddrawn displayorder curview need_redisplay
4674 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4679 if {$endrow eq {}} {
4682 if {$endrow >= $numcommits} {
4683 set endrow [expr {$numcommits - 1}]
4686 set rl1 [expr {$row - $downarrowlen - 3}]
4690 set ro1 [expr {$row - 3}]
4694 set r2 [expr {$endrow + $uparrowlen + 3}]
4695 if {$r2 > $numcommits} {
4698 for {set r $rl1} {$r < $r2} {incr r} {
4699 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4703 set rl1 [expr {$r + 1}]
4709 optimize_rows $ro1 0 $r2
4710 if {$need_redisplay || $nrows_drawn > 2000} {
4715 # make the lines join to already-drawn rows either side
4716 set r [expr {$row - 1}]
4717 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4720 set er [expr {$endrow + 1}]
4721 if {$er >= $numcommits ||
4722 ![info exists iddrawn([lindex $displayorder $er])]} {
4725 for {} {$r <= $er} {incr r} {
4726 set id [lindex $displayorder $r]
4727 set wasdrawn [info exists iddrawn($id)]
4729 if {$r == $er} break
4730 set nextid [lindex $displayorder [expr {$r + 1}]]
4731 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4732 drawparentlinks $id $r
4734 set rowids [lindex $rowidlist $r]
4735 foreach lid $rowids {
4736 if {$lid eq {}} continue
4737 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4739 # see if this is the first child of any of its parents
4740 foreach p [lindex $parentlist $r] {
4741 if {[lsearch -exact $rowids $p] < 0} {
4742 # make this line extend up to the child
4743 set lineend($p) [drawlineseg $p $r $er 0]
4747 set lineend($lid) [drawlineseg $lid $r $er 1]
4753 proc undolayout {row} {
4754 global uparrowlen mingaplen downarrowlen
4755 global rowidlist rowisopt rowfinal need_redisplay
4757 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4761 if {[llength $rowidlist] > $r} {
4763 set rowidlist [lrange $rowidlist 0 $r]
4764 set rowfinal [lrange $rowfinal 0 $r]
4765 set rowisopt [lrange $rowisopt 0 $r]
4766 set need_redisplay 1
4771 proc drawvisible {} {
4772 global canv linespc curview vrowmod selectedline targetrow targetid
4773 global need_redisplay cscroll numcommits
4775 set fs [$canv yview]
4776 set ymax [lindex [$canv cget -scrollregion] 3]
4777 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
4778 set f0 [lindex $fs 0]
4779 set f1 [lindex $fs 1]
4780 set y0 [expr {int($f0 * $ymax)}]
4781 set y1 [expr {int($f1 * $ymax)}]
4783 if {[info exists targetid]} {
4784 if {[commitinview $targetid $curview]} {
4785 set r [rowofcommit $targetid]
4786 if {$r != $targetrow} {
4787 # Fix up the scrollregion and change the scrolling position
4788 # now that our target row has moved.
4789 set diff [expr {($r - $targetrow) * $linespc}]
4792 set ymax [lindex [$canv cget -scrollregion] 3]
4795 set f0 [expr {$y0 / $ymax}]
4796 set f1 [expr {$y1 / $ymax}]
4797 allcanvs yview moveto $f0
4798 $cscroll set $f0 $f1
4799 set need_redisplay 1
4806 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4807 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4808 if {$endrow >= $vrowmod($curview)} {
4809 update_arcrows $curview
4811 if {[info exists selectedline] &&
4812 $row <= $selectedline && $selectedline <= $endrow} {
4813 set targetrow $selectedline
4814 } elseif {[info exists targetid]} {
4815 set targetrow [expr {int(($row + $endrow) / 2)}]
4817 if {[info exists targetrow]} {
4818 if {$targetrow >= $numcommits} {
4819 set targetrow [expr {$numcommits - 1}]
4821 set targetid [commitonrow $targetrow]
4823 drawcommits $row $endrow
4826 proc clear_display {} {
4827 global iddrawn linesegs need_redisplay nrows_drawn
4828 global vhighlights fhighlights nhighlights rhighlights
4831 catch {unset iddrawn}
4832 catch {unset linesegs}
4833 catch {unset vhighlights}
4834 catch {unset fhighlights}
4835 catch {unset nhighlights}
4836 catch {unset rhighlights}
4837 set need_redisplay 0
4841 proc findcrossings {id} {
4842 global rowidlist parentlist numcommits displayorder
4846 foreach {s e} [rowranges $id] {
4847 if {$e >= $numcommits} {
4848 set e [expr {$numcommits - 1}]
4850 if {$e <= $s} continue
4851 for {set row $e} {[incr row -1] >= $s} {} {
4852 set x [lsearch -exact [lindex $rowidlist $row] $id]
4854 set olds [lindex $parentlist $row]
4855 set kid [lindex $displayorder $row]
4856 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4857 if {$kidx < 0} continue
4858 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4860 set px [lsearch -exact $nextrow $p]
4861 if {$px < 0} continue
4862 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4863 if {[lsearch -exact $ccross $p] >= 0} continue
4864 if {$x == $px + ($kidx < $px? -1: 1)} {
4866 } elseif {[lsearch -exact $cross $p] < 0} {
4873 return [concat $ccross {{}} $cross]
4876 proc assigncolor {id} {
4877 global colormap colors nextcolor
4878 global parents children children curview
4880 if {[info exists colormap($id)]} return
4881 set ncolors [llength $colors]
4882 if {[info exists children($curview,$id)]} {
4883 set kids $children($curview,$id)
4887 if {[llength $kids] == 1} {
4888 set child [lindex $kids 0]
4889 if {[info exists colormap($child)]
4890 && [llength $parents($curview,$child)] == 1} {
4891 set colormap($id) $colormap($child)
4897 foreach x [findcrossings $id] {
4899 # delimiter between corner crossings and other crossings
4900 if {[llength $badcolors] >= $ncolors - 1} break
4901 set origbad $badcolors
4903 if {[info exists colormap($x)]
4904 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4905 lappend badcolors $colormap($x)
4908 if {[llength $badcolors] >= $ncolors} {
4909 set badcolors $origbad
4911 set origbad $badcolors
4912 if {[llength $badcolors] < $ncolors - 1} {
4913 foreach child $kids {
4914 if {[info exists colormap($child)]
4915 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4916 lappend badcolors $colormap($child)
4918 foreach p $parents($curview,$child) {
4919 if {[info exists colormap($p)]
4920 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4921 lappend badcolors $colormap($p)
4925 if {[llength $badcolors] >= $ncolors} {
4926 set badcolors $origbad
4929 for {set i 0} {$i <= $ncolors} {incr i} {
4930 set c [lindex $colors $nextcolor]
4931 if {[incr nextcolor] >= $ncolors} {
4934 if {[lsearch -exact $badcolors $c]} break
4936 set colormap($id) $c
4939 proc bindline {t id} {
4942 $canv bind $t <Enter> "lineenter %x %y $id"
4943 $canv bind $t <Motion> "linemotion %x %y $id"
4944 $canv bind $t <Leave> "lineleave $id"
4945 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4948 proc drawtags {id x xt y1} {
4949 global idtags idheads idotherrefs mainhead
4950 global linespc lthickness
4951 global canv rowtextx curview fgcolor bgcolor
4956 if {[info exists idtags($id)]} {
4957 set marks $idtags($id)
4958 set ntags [llength $marks]
4960 if {[info exists idheads($id)]} {
4961 set marks [concat $marks $idheads($id)]
4962 set nheads [llength $idheads($id)]
4964 if {[info exists idotherrefs($id)]} {
4965 set marks [concat $marks $idotherrefs($id)]
4971 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4972 set yt [expr {$y1 - 0.5 * $linespc}]
4973 set yb [expr {$yt + $linespc - 1}]
4977 foreach tag $marks {
4979 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4980 set wid [font measure mainfontbold $tag]
4982 set wid [font measure mainfont $tag]
4986 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4988 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4989 -width $lthickness -fill black -tags tag.$id]
4991 foreach tag $marks x $xvals wid $wvals {
4992 set xl [expr {$x + $delta}]
4993 set xr [expr {$x + $delta + $wid + $lthickness}]
4995 if {[incr ntags -1] >= 0} {
4997 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4998 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4999 -width 1 -outline black -fill yellow -tags tag.$id]
5000 $canv bind $t <1> [list showtag $tag 1]
5001 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5003 # draw a head or other ref
5004 if {[incr nheads -1] >= 0} {
5006 if {$tag eq $mainhead} {
5007 set font mainfontbold
5012 set xl [expr {$xl - $delta/2}]
5013 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5014 -width 1 -outline black -fill $col -tags tag.$id
5015 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5016 set rwid [font measure mainfont $remoteprefix]
5017 set xi [expr {$x + 1}]
5018 set yti [expr {$yt + 1}]
5019 set xri [expr {$x + $rwid}]
5020 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5021 -width 0 -fill "#ffddaa" -tags tag.$id
5024 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5025 -font $font -tags [list tag.$id text]]
5027 $canv bind $t <1> [list showtag $tag 1]
5028 } elseif {$nheads >= 0} {
5029 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
5035 proc xcoord {i level ln} {
5036 global canvx0 xspc1 xspc2
5038 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5039 if {$i > 0 && $i == $level} {
5040 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5041 } elseif {$i > $level} {
5042 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5047 proc show_status {msg} {
5051 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5052 -tags text -fill $fgcolor
5055 # Don't change the text pane cursor if it is currently the hand cursor,
5056 # showing that we are over a sha1 ID link.
5057 proc settextcursor {c} {
5058 global ctext curtextcursor
5060 if {[$ctext cget -cursor] == $curtextcursor} {
5061 $ctext config -cursor $c
5063 set curtextcursor $c
5066 proc nowbusy {what {name {}}} {
5067 global isbusy busyname statusw
5069 if {[array names isbusy] eq {}} {
5070 . config -cursor watch
5074 set busyname($what) $name
5076 $statusw conf -text $name
5080 proc notbusy {what} {
5081 global isbusy maincursor textcursor busyname statusw
5085 if {$busyname($what) ne {} &&
5086 [$statusw cget -text] eq $busyname($what)} {
5087 $statusw conf -text {}
5090 if {[array names isbusy] eq {}} {
5091 . config -cursor $maincursor
5092 settextcursor $textcursor
5096 proc findmatches {f} {
5097 global findtype findstring
5098 if {$findtype == [mc "Regexp"]} {
5099 set matches [regexp -indices -all -inline $findstring $f]
5102 if {$findtype == [mc "IgnCase"]} {
5103 set f [string tolower $f]
5104 set fs [string tolower $fs]
5108 set l [string length $fs]
5109 while {[set j [string first $fs $f $i]] >= 0} {
5110 lappend matches [list $j [expr {$j+$l-1}]]
5111 set i [expr {$j + $l}]
5117 proc dofind {{dirn 1} {wrap 1}} {
5118 global findstring findstartline findcurline selectedline numcommits
5119 global gdttype filehighlight fh_serial find_dirn findallowwrap
5121 if {[info exists find_dirn]} {
5122 if {$find_dirn == $dirn} return
5126 if {$findstring eq {} || $numcommits == 0} return
5127 if {![info exists selectedline]} {
5128 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5130 set findstartline $selectedline
5132 set findcurline $findstartline
5133 nowbusy finding [mc "Searching"]
5134 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5135 after cancel do_file_hl $fh_serial
5136 do_file_hl $fh_serial
5139 set findallowwrap $wrap
5143 proc stopfinding {} {
5144 global find_dirn findcurline fprogcoord
5146 if {[info exists find_dirn]} {
5156 global commitdata commitinfo numcommits findpattern findloc
5157 global findstartline findcurline findallowwrap
5158 global find_dirn gdttype fhighlights fprogcoord
5159 global curview varcorder vrownum varccommits vrowmod
5161 if {![info exists find_dirn]} {
5164 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5167 if {$find_dirn > 0} {
5169 if {$l >= $numcommits} {
5172 if {$l <= $findstartline} {
5173 set lim [expr {$findstartline + 1}]
5176 set moretodo $findallowwrap
5183 if {$l >= $findstartline} {
5184 set lim [expr {$findstartline - 1}]
5187 set moretodo $findallowwrap
5190 set n [expr {($lim - $l) * $find_dirn}]
5195 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5196 update_arcrows $curview
5200 set ai [bsearch $vrownum($curview) $l]
5201 set a [lindex $varcorder($curview) $ai]
5202 set arow [lindex $vrownum($curview) $ai]
5203 set ids [lindex $varccommits($curview,$a)]
5204 set arowend [expr {$arow + [llength $ids]}]
5205 if {$gdttype eq [mc "containing:"]} {
5206 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5207 if {$l < $arow || $l >= $arowend} {
5209 set a [lindex $varcorder($curview) $ai]
5210 set arow [lindex $vrownum($curview) $ai]
5211 set ids [lindex $varccommits($curview,$a)]
5212 set arowend [expr {$arow + [llength $ids]}]
5214 set id [lindex $ids [expr {$l - $arow}]]
5215 # shouldn't happen unless git log doesn't give all the commits...
5216 if {![info exists commitdata($id)] ||
5217 ![doesmatch $commitdata($id)]} {
5220 if {![info exists commitinfo($id)]} {
5223 set info $commitinfo($id)
5224 foreach f $info ty $fldtypes {
5225 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5234 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5235 if {$l < $arow || $l >= $arowend} {
5237 set a [lindex $varcorder($curview) $ai]
5238 set arow [lindex $vrownum($curview) $ai]
5239 set ids [lindex $varccommits($curview,$a)]
5240 set arowend [expr {$arow + [llength $ids]}]
5242 set id [lindex $ids [expr {$l - $arow}]]
5243 if {![info exists fhighlights($id)]} {
5244 # this sets fhighlights($id) to -1
5245 askfilehighlight $l $id
5247 if {$fhighlights($id) > 0} {
5251 if {$fhighlights($id) < 0} {
5254 set findcurline [expr {$l - $find_dirn}]
5259 if {$found || ($domore && !$moretodo)} {
5275 set findcurline [expr {$l - $find_dirn}]
5277 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5281 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5286 proc findselectline {l} {
5287 global findloc commentend ctext findcurline markingmatches gdttype
5289 set markingmatches 1
5292 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5293 # highlight the matches in the comments
5294 set f [$ctext get 1.0 $commentend]
5295 set matches [findmatches $f]
5296 foreach match $matches {
5297 set start [lindex $match 0]
5298 set end [expr {[lindex $match 1] + 1}]
5299 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5305 # mark the bits of a headline or author that match a find string
5306 proc markmatches {canv l str tag matches font row} {
5309 set bbox [$canv bbox $tag]
5310 set x0 [lindex $bbox 0]
5311 set y0 [lindex $bbox 1]
5312 set y1 [lindex $bbox 3]
5313 foreach match $matches {
5314 set start [lindex $match 0]
5315 set end [lindex $match 1]
5316 if {$start > $end} continue
5317 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5318 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5319 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5320 [expr {$x0+$xlen+2}] $y1 \
5321 -outline {} -tags [list match$l matches] -fill yellow]
5323 if {[info exists selectedline] && $row == $selectedline} {
5324 $canv raise $t secsel
5329 proc unmarkmatches {} {
5330 global markingmatches
5332 allcanvs delete matches
5333 set markingmatches 0
5337 proc selcanvline {w x y} {
5338 global canv canvy0 ctext linespc
5340 set ymax [lindex [$canv cget -scrollregion] 3]
5341 if {$ymax == {}} return
5342 set yfrac [lindex [$canv yview] 0]
5343 set y [expr {$y + $yfrac * $ymax}]
5344 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5349 set xmax [lindex [$canv cget -scrollregion] 2]
5350 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5351 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5357 proc commit_descriptor {p} {
5359 if {![info exists commitinfo($p)]} {
5363 if {[llength $commitinfo($p)] > 1} {
5364 set l [lindex $commitinfo($p) 0]
5369 # append some text to the ctext widget, and make any SHA1 ID
5370 # that we know about be a clickable link.
5371 proc appendwithlinks {text tags} {
5372 global ctext linknum curview pendinglinks
5374 set start [$ctext index "end - 1c"]
5375 $ctext insert end $text $tags
5376 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5380 set linkid [string range $text $s $e]
5382 $ctext tag delete link$linknum
5383 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5384 setlink $linkid link$linknum
5389 proc setlink {id lk} {
5390 global curview ctext pendinglinks commitinterest
5392 if {[commitinview $id $curview]} {
5393 $ctext tag conf $lk -foreground blue -underline 1
5394 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5395 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5396 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5398 lappend pendinglinks($id) $lk
5399 lappend commitinterest($id) {makelink %I}
5403 proc makelink {id} {
5406 if {![info exists pendinglinks($id)]} return
5407 foreach lk $pendinglinks($id) {
5410 unset pendinglinks($id)
5413 proc linkcursor {w inc} {
5414 global linkentercount curtextcursor
5416 if {[incr linkentercount $inc] > 0} {
5417 $w configure -cursor hand2
5419 $w configure -cursor $curtextcursor
5420 if {$linkentercount < 0} {
5421 set linkentercount 0
5426 proc viewnextline {dir} {
5430 set ymax [lindex [$canv cget -scrollregion] 3]
5431 set wnow [$canv yview]
5432 set wtop [expr {[lindex $wnow 0] * $ymax}]
5433 set newtop [expr {$wtop + $dir * $linespc}]
5436 } elseif {$newtop > $ymax} {
5439 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5442 # add a list of tag or branch names at position pos
5443 # returns the number of names inserted
5444 proc appendrefs {pos ids var} {
5445 global ctext linknum curview $var maxrefs
5447 if {[catch {$ctext index $pos}]} {
5450 $ctext conf -state normal
5451 $ctext delete $pos "$pos lineend"
5454 foreach tag [set $var\($id\)] {
5455 lappend tags [list $tag $id]
5458 if {[llength $tags] > $maxrefs} {
5459 $ctext insert $pos "many ([llength $tags])"
5461 set tags [lsort -index 0 -decreasing $tags]
5464 set id [lindex $ti 1]
5467 $ctext tag delete $lk
5468 $ctext insert $pos $sep
5469 $ctext insert $pos [lindex $ti 0] $lk
5474 $ctext conf -state disabled
5475 return [llength $tags]
5478 # called when we have finished computing the nearby tags
5479 proc dispneartags {delay} {
5480 global selectedline currentid showneartags tagphase
5482 if {![info exists selectedline] || !$showneartags} return
5483 after cancel dispnexttag
5485 after 200 dispnexttag
5488 after idle dispnexttag
5493 proc dispnexttag {} {
5494 global selectedline currentid showneartags tagphase ctext
5496 if {![info exists selectedline] || !$showneartags} return
5497 switch -- $tagphase {
5499 set dtags [desctags $currentid]
5501 appendrefs precedes $dtags idtags
5505 set atags [anctags $currentid]
5507 appendrefs follows $atags idtags
5511 set dheads [descheads $currentid]
5512 if {$dheads ne {}} {
5513 if {[appendrefs branch $dheads idheads] > 1
5514 && [$ctext get "branch -3c"] eq "h"} {
5515 # turn "Branch" into "Branches"
5516 $ctext conf -state normal
5517 $ctext insert "branch -2c" "es"
5518 $ctext conf -state disabled
5523 if {[incr tagphase] <= 2} {
5524 after idle dispnexttag
5528 proc make_secsel {l} {
5529 global linehtag linentag linedtag canv canv2 canv3
5531 if {![info exists linehtag($l)]} return
5533 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5534 -tags secsel -fill [$canv cget -selectbackground]]
5536 $canv2 delete secsel
5537 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5538 -tags secsel -fill [$canv2 cget -selectbackground]]
5540 $canv3 delete secsel
5541 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5542 -tags secsel -fill [$canv3 cget -selectbackground]]
5546 proc selectline {l isnew} {
5547 global canv ctext commitinfo selectedline
5548 global canvy0 linespc parents children curview
5549 global currentid sha1entry
5550 global commentend idtags linknum
5551 global mergemax numcommits pending_select
5552 global cmitmode showneartags allcommits
5553 global targetrow targetid lastscrollrows
5556 catch {unset pending_select}
5561 if {$l < 0 || $l >= $numcommits} return
5562 set id [commitonrow $l]
5567 if {$lastscrollrows < $numcommits} {
5571 set y [expr {$canvy0 + $l * $linespc}]
5572 set ymax [lindex [$canv cget -scrollregion] 3]
5573 set ytop [expr {$y - $linespc - 1}]
5574 set ybot [expr {$y + $linespc + 1}]
5575 set wnow [$canv yview]
5576 set wtop [expr {[lindex $wnow 0] * $ymax}]
5577 set wbot [expr {[lindex $wnow 1] * $ymax}]
5578 set wh [expr {$wbot - $wtop}]
5580 if {$ytop < $wtop} {
5581 if {$ybot < $wtop} {
5582 set newtop [expr {$y - $wh / 2.0}]
5585 if {$newtop > $wtop - $linespc} {
5586 set newtop [expr {$wtop - $linespc}]
5589 } elseif {$ybot > $wbot} {
5590 if {$ytop > $wbot} {
5591 set newtop [expr {$y - $wh / 2.0}]
5593 set newtop [expr {$ybot - $wh}]
5594 if {$newtop < $wtop + $linespc} {
5595 set newtop [expr {$wtop + $linespc}]
5599 if {$newtop != $wtop} {
5603 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5610 addtohistory [list selbyid $id]
5613 $sha1entry delete 0 end
5614 $sha1entry insert 0 $id
5616 $sha1entry selection from 0
5617 $sha1entry selection to end
5621 $ctext conf -state normal
5624 if {![info exists commitinfo($id)]} {
5627 set info $commitinfo($id)
5628 set date [formatdate [lindex $info 2]]
5629 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5630 set date [formatdate [lindex $info 4]]
5631 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5632 if {[info exists idtags($id)]} {
5633 $ctext insert end [mc "Tags:"]
5634 foreach tag $idtags($id) {
5635 $ctext insert end " $tag"
5637 $ctext insert end "\n"
5641 set olds $parents($curview,$id)
5642 if {[llength $olds] > 1} {
5645 if {$np >= $mergemax} {
5650 $ctext insert end "[mc "Parent"]: " $tag
5651 appendwithlinks [commit_descriptor $p] {}
5656 append headers "[mc "Parent"]: [commit_descriptor $p]"
5660 foreach c $children($curview,$id) {
5661 append headers "[mc "Child"]: [commit_descriptor $c]"
5664 # make anything that looks like a SHA1 ID be a clickable link
5665 appendwithlinks $headers {}
5666 if {$showneartags} {
5667 if {![info exists allcommits]} {
5670 $ctext insert end "[mc "Branch"]: "
5671 $ctext mark set branch "end -1c"
5672 $ctext mark gravity branch left
5673 $ctext insert end "\n[mc "Follows"]: "
5674 $ctext mark set follows "end -1c"
5675 $ctext mark gravity follows left
5676 $ctext insert end "\n[mc "Precedes"]: "
5677 $ctext mark set precedes "end -1c"
5678 $ctext mark gravity precedes left
5679 $ctext insert end "\n"
5682 $ctext insert end "\n"
5683 set comment [lindex $info 5]
5684 if {[string first "\r" $comment] >= 0} {
5685 set comment [string map {"\r" "\n "} $comment]
5687 appendwithlinks $comment {comment}
5689 $ctext tag remove found 1.0 end
5690 $ctext conf -state disabled
5691 set commentend [$ctext index "end - 1c"]
5693 init_flist [mc "Comments"]
5694 if {$cmitmode eq "tree"} {
5696 } elseif {[llength $olds] <= 1} {
5703 proc selfirstline {} {
5708 proc sellastline {} {
5711 set l [expr {$numcommits - 1}]
5715 proc selnextline {dir} {
5718 if {![info exists selectedline]} return
5719 set l [expr {$selectedline + $dir}]
5724 proc selnextpage {dir} {
5725 global canv linespc selectedline numcommits
5727 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5731 allcanvs yview scroll [expr {$dir * $lpp}] units
5733 if {![info exists selectedline]} return
5734 set l [expr {$selectedline + $dir * $lpp}]
5737 } elseif {$l >= $numcommits} {
5738 set l [expr $numcommits - 1]
5744 proc unselectline {} {
5745 global selectedline currentid
5747 catch {unset selectedline}
5748 catch {unset currentid}
5749 allcanvs delete secsel
5753 proc reselectline {} {
5756 if {[info exists selectedline]} {
5757 selectline $selectedline 0
5761 proc addtohistory {cmd} {
5762 global history historyindex curview
5764 set elt [list $curview $cmd]
5765 if {$historyindex > 0
5766 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5770 if {$historyindex < [llength $history]} {
5771 set history [lreplace $history $historyindex end $elt]
5773 lappend history $elt
5776 if {$historyindex > 1} {
5777 .tf.bar.leftbut conf -state normal
5779 .tf.bar.leftbut conf -state disabled
5781 .tf.bar.rightbut conf -state disabled
5787 set view [lindex $elt 0]
5788 set cmd [lindex $elt 1]
5789 if {$curview != $view} {
5796 global history historyindex
5799 if {$historyindex > 1} {
5800 incr historyindex -1
5801 godo [lindex $history [expr {$historyindex - 1}]]
5802 .tf.bar.rightbut conf -state normal
5804 if {$historyindex <= 1} {
5805 .tf.bar.leftbut conf -state disabled
5810 global history historyindex
5813 if {$historyindex < [llength $history]} {
5814 set cmd [lindex $history $historyindex]
5817 .tf.bar.leftbut conf -state normal
5819 if {$historyindex >= [llength $history]} {
5820 .tf.bar.rightbut conf -state disabled
5825 global treefilelist treeidlist diffids diffmergeid treepending
5826 global nullid nullid2
5829 catch {unset diffmergeid}
5830 if {![info exists treefilelist($id)]} {
5831 if {![info exists treepending]} {
5832 if {$id eq $nullid} {
5833 set cmd [list | git ls-files]
5834 } elseif {$id eq $nullid2} {
5835 set cmd [list | git ls-files --stage -t]
5837 set cmd [list | git ls-tree -r $id]
5839 if {[catch {set gtf [open $cmd r]}]} {
5843 set treefilelist($id) {}
5844 set treeidlist($id) {}
5845 fconfigure $gtf -blocking 0
5846 filerun $gtf [list gettreeline $gtf $id]
5853 proc gettreeline {gtf id} {
5854 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5857 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5858 if {$diffids eq $nullid} {
5861 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5862 set i [string first "\t" $line]
5863 if {$i < 0} continue
5864 set sha1 [lindex $line 2]
5865 set fname [string range $line [expr {$i+1}] end]
5866 if {[string index $fname 0] eq "\""} {
5867 set fname [lindex $fname 0]
5869 lappend treeidlist($id) $sha1
5871 lappend treefilelist($id) $fname
5874 return [expr {$nl >= 1000? 2: 1}]
5878 if {$cmitmode ne "tree"} {
5879 if {![info exists diffmergeid]} {
5880 gettreediffs $diffids
5882 } elseif {$id ne $diffids} {
5891 global treefilelist treeidlist diffids nullid nullid2
5892 global ctext commentend
5894 set i [lsearch -exact $treefilelist($diffids) $f]
5896 puts "oops, $f not in list for id $diffids"
5899 if {$diffids eq $nullid} {
5900 if {[catch {set bf [open $f r]} err]} {
5901 puts "oops, can't read $f: $err"
5905 set blob [lindex $treeidlist($diffids) $i]
5906 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5907 puts "oops, error reading blob $blob: $err"
5911 fconfigure $bf -blocking 0
5912 filerun $bf [list getblobline $bf $diffids]
5913 $ctext config -state normal
5914 clear_ctext $commentend
5915 $ctext insert end "\n"
5916 $ctext insert end "$f\n" filesep
5917 $ctext config -state disabled
5918 $ctext yview $commentend
5922 proc getblobline {bf id} {
5923 global diffids cmitmode ctext
5925 if {$id ne $diffids || $cmitmode ne "tree"} {
5929 $ctext config -state normal
5931 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5932 $ctext insert end "$line\n"
5935 # delete last newline
5936 $ctext delete "end - 2c" "end - 1c"
5940 $ctext config -state disabled
5941 return [expr {$nl >= 1000? 2: 1}]
5944 proc mergediff {id} {
5945 global diffmergeid mdifffd
5949 global limitdiffs vfilelimit curview
5953 # this doesn't seem to actually affect anything...
5954 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5955 if {$limitdiffs && $vfilelimit($curview) ne {}} {
5956 set cmd [concat $cmd -- $vfilelimit($curview)]
5958 if {[catch {set mdf [open $cmd r]} err]} {
5959 error_popup "[mc "Error getting merge diffs:"] $err"
5962 fconfigure $mdf -blocking 0
5963 set mdifffd($id) $mdf
5964 set np [llength $parents($curview,$id)]
5966 filerun $mdf [list getmergediffline $mdf $id $np]
5969 proc getmergediffline {mdf id np} {
5970 global diffmergeid ctext cflist mergemax
5971 global difffilestart mdifffd
5973 $ctext conf -state normal
5975 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5976 if {![info exists diffmergeid] || $id != $diffmergeid
5977 || $mdf != $mdifffd($id)} {
5981 if {[regexp {^diff --cc (.*)} $line match fname]} {
5982 # start of a new file
5983 $ctext insert end "\n"
5984 set here [$ctext index "end - 1c"]
5985 lappend difffilestart $here
5986 add_flist [list $fname]
5987 set l [expr {(78 - [string length $fname]) / 2}]
5988 set pad [string range "----------------------------------------" 1 $l]
5989 $ctext insert end "$pad $fname $pad\n" filesep
5990 } elseif {[regexp {^@@} $line]} {
5991 $ctext insert end "$line\n" hunksep
5992 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5995 # parse the prefix - one ' ', '-' or '+' for each parent
6000 for {set j 0} {$j < $np} {incr j} {
6001 set c [string range $line $j $j]
6004 } elseif {$c == "-"} {
6006 } elseif {$c == "+"} {
6015 if {!$isbad && $minuses ne {} && $pluses eq {}} {
6016 # line doesn't appear in result, parents in $minuses have the line
6017 set num [lindex $minuses 0]
6018 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6019 # line appears in result, parents in $pluses don't have the line
6020 lappend tags mresult
6021 set num [lindex $spaces 0]
6024 if {$num >= $mergemax} {
6029 $ctext insert end "$line\n" $tags
6032 $ctext conf -state disabled
6037 return [expr {$nr >= 1000? 2: 1}]
6040 proc startdiff {ids} {
6041 global treediffs diffids treepending diffmergeid nullid nullid2
6045 catch {unset diffmergeid}
6046 if {![info exists treediffs($ids)] ||
6047 [lsearch -exact $ids $nullid] >= 0 ||
6048 [lsearch -exact $ids $nullid2] >= 0} {
6049 if {![info exists treepending]} {
6057 proc path_filter {filter name} {
6059 set l [string length $p]
6060 if {[string index $p end] eq "/"} {
6061 if {[string compare -length $l $p $name] == 0} {
6065 if {[string compare -length $l $p $name] == 0 &&
6066 ([string length $name] == $l ||
6067 [string index $name $l] eq "/")} {
6075 proc addtocflist {ids} {
6078 add_flist $treediffs($ids)
6082 proc diffcmd {ids flags} {
6083 global nullid nullid2
6085 set i [lsearch -exact $ids $nullid]
6086 set j [lsearch -exact $ids $nullid2]
6088 if {[llength $ids] > 1 && $j < 0} {
6089 # comparing working directory with some specific revision
6090 set cmd [concat | git diff-index $flags]
6092 lappend cmd -R [lindex $ids 1]
6094 lappend cmd [lindex $ids 0]
6097 # comparing working directory with index
6098 set cmd [concat | git diff-files $flags]
6103 } elseif {$j >= 0} {
6104 set cmd [concat | git diff-index --cached $flags]
6105 if {[llength $ids] > 1} {
6106 # comparing index with specific revision
6108 lappend cmd -R [lindex $ids 1]
6110 lappend cmd [lindex $ids 0]
6113 # comparing index with HEAD
6117 set cmd [concat | git diff-tree -r $flags $ids]
6122 proc gettreediffs {ids} {
6123 global treediff treepending
6125 set treepending $ids
6127 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6128 fconfigure $gdtf -blocking 0
6129 filerun $gdtf [list gettreediffline $gdtf $ids]
6132 proc gettreediffline {gdtf ids} {
6133 global treediff treediffs treepending diffids diffmergeid
6134 global cmitmode vfilelimit curview limitdiffs
6137 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6138 set i [string first "\t" $line]
6140 set file [string range $line [expr {$i+1}] end]
6141 if {[string index $file 0] eq "\""} {
6142 set file [lindex $file 0]
6144 lappend treediff $file
6148 return [expr {$nr >= 1000? 2: 1}]
6151 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6153 foreach f $treediff {
6154 if {[path_filter $vfilelimit($curview) $f]} {
6158 set treediffs($ids) $flist
6160 set treediffs($ids) $treediff
6163 if {$cmitmode eq "tree"} {
6165 } elseif {$ids != $diffids} {
6166 if {![info exists diffmergeid]} {
6167 gettreediffs $diffids
6175 # empty string or positive integer
6176 proc diffcontextvalidate {v} {
6177 return [regexp {^(|[1-9][0-9]*)$} $v]
6180 proc diffcontextchange {n1 n2 op} {
6181 global diffcontextstring diffcontext
6183 if {[string is integer -strict $diffcontextstring]} {
6184 if {$diffcontextstring > 0} {
6185 set diffcontext $diffcontextstring
6191 proc changeignorespace {} {
6195 proc getblobdiffs {ids} {
6196 global blobdifffd diffids env
6197 global diffinhdr treediffs
6200 global limitdiffs vfilelimit curview
6202 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6206 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6207 set cmd [concat $cmd -- $vfilelimit($curview)]
6209 if {[catch {set bdf [open $cmd r]} err]} {
6210 puts "error getting diffs: $err"
6214 fconfigure $bdf -blocking 0
6215 set blobdifffd($ids) $bdf
6216 filerun $bdf [list getblobdiffline $bdf $diffids]
6219 proc setinlist {var i val} {
6222 while {[llength [set $var]] < $i} {
6225 if {[llength [set $var]] == $i} {
6232 proc makediffhdr {fname ids} {
6233 global ctext curdiffstart treediffs
6235 set i [lsearch -exact $treediffs($ids) $fname]
6237 setinlist difffilestart $i $curdiffstart
6239 set l [expr {(78 - [string length $fname]) / 2}]
6240 set pad [string range "----------------------------------------" 1 $l]
6241 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6244 proc getblobdiffline {bdf ids} {
6245 global diffids blobdifffd ctext curdiffstart
6246 global diffnexthead diffnextnote difffilestart
6247 global diffinhdr treediffs
6250 $ctext conf -state normal
6251 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6252 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6256 if {![string compare -length 11 "diff --git " $line]} {
6257 # trim off "diff --git "
6258 set line [string range $line 11 end]
6260 # start of a new file
6261 $ctext insert end "\n"
6262 set curdiffstart [$ctext index "end - 1c"]
6263 $ctext insert end "\n" filesep
6264 # If the name hasn't changed the length will be odd,
6265 # the middle char will be a space, and the two bits either
6266 # side will be a/name and b/name, or "a/name" and "b/name".
6267 # If the name has changed we'll get "rename from" and
6268 # "rename to" or "copy from" and "copy to" lines following this,
6269 # and we'll use them to get the filenames.
6270 # This complexity is necessary because spaces in the filename(s)
6271 # don't get escaped.
6272 set l [string length $line]
6273 set i [expr {$l / 2}]
6274 if {!(($l & 1) && [string index $line $i] eq " " &&
6275 [string range $line 2 [expr {$i - 1}]] eq \
6276 [string range $line [expr {$i + 3}] end])} {
6279 # unescape if quoted and chop off the a/ from the front
6280 if {[string index $line 0] eq "\""} {
6281 set fname [string range [lindex $line 0] 2 end]
6283 set fname [string range $line 2 [expr {$i - 1}]]
6285 makediffhdr $fname $ids
6287 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6288 $line match f1l f1c f2l f2c rest]} {
6289 $ctext insert end "$line\n" hunksep
6292 } elseif {$diffinhdr} {
6293 if {![string compare -length 12 "rename from " $line]} {
6294 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6295 if {[string index $fname 0] eq "\""} {
6296 set fname [lindex $fname 0]
6298 set i [lsearch -exact $treediffs($ids) $fname]
6300 setinlist difffilestart $i $curdiffstart
6302 } elseif {![string compare -length 10 $line "rename to "] ||
6303 ![string compare -length 8 $line "copy to "]} {
6304 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6305 if {[string index $fname 0] eq "\""} {
6306 set fname [lindex $fname 0]
6308 makediffhdr $fname $ids
6309 } elseif {[string compare -length 3 $line "---"] == 0} {
6312 } elseif {[string compare -length 3 $line "+++"] == 0} {
6316 $ctext insert end "$line\n" filesep
6319 set x [string range $line 0 0]
6320 if {$x == "-" || $x == "+"} {
6321 set tag [expr {$x == "+"}]
6322 $ctext insert end "$line\n" d$tag
6323 } elseif {$x == " "} {
6324 $ctext insert end "$line\n"
6326 # "\ No newline at end of file",
6327 # or something else we don't recognize
6328 $ctext insert end "$line\n" hunksep
6332 $ctext conf -state disabled
6337 return [expr {$nr >= 1000? 2: 1}]
6340 proc changediffdisp {} {
6341 global ctext diffelide
6343 $ctext tag conf d0 -elide [lindex $diffelide 0]
6344 $ctext tag conf d1 -elide [lindex $diffelide 1]
6348 global difffilestart ctext
6349 set prev [lindex $difffilestart 0]
6350 set here [$ctext index @0,0]
6351 foreach loc $difffilestart {
6352 if {[$ctext compare $loc >= $here]} {
6362 global difffilestart ctext
6363 set here [$ctext index @0,0]
6364 foreach loc $difffilestart {
6365 if {[$ctext compare $loc > $here]} {
6372 proc clear_ctext {{first 1.0}} {
6373 global ctext smarktop smarkbot
6376 set l [lindex [split $first .] 0]
6377 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6380 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6383 $ctext delete $first end
6384 if {$first eq "1.0"} {
6385 catch {unset pendinglinks}
6389 proc settabs {{firstab {}}} {
6390 global firsttabstop tabstop ctext have_tk85
6392 if {$firstab ne {} && $have_tk85} {
6393 set firsttabstop $firstab
6395 set w [font measure textfont "0"]
6396 if {$firsttabstop != 0} {
6397 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6398 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6399 } elseif {$have_tk85 || $tabstop != 8} {
6400 $ctext conf -tabs [expr {$tabstop * $w}]
6402 $ctext conf -tabs {}
6406 proc incrsearch {name ix op} {
6407 global ctext searchstring searchdirn
6409 $ctext tag remove found 1.0 end
6410 if {[catch {$ctext index anchor}]} {
6411 # no anchor set, use start of selection, or of visible area
6412 set sel [$ctext tag ranges sel]
6414 $ctext mark set anchor [lindex $sel 0]
6415 } elseif {$searchdirn eq "-forwards"} {
6416 $ctext mark set anchor @0,0
6418 $ctext mark set anchor @0,[winfo height $ctext]
6421 if {$searchstring ne {}} {
6422 set here [$ctext search $searchdirn -- $searchstring anchor]
6431 global sstring ctext searchstring searchdirn
6434 $sstring icursor end
6435 set searchdirn -forwards
6436 if {$searchstring ne {}} {
6437 set sel [$ctext tag ranges sel]
6439 set start "[lindex $sel 0] + 1c"
6440 } elseif {[catch {set start [$ctext index anchor]}]} {
6443 set match [$ctext search -count mlen -- $searchstring $start]
6444 $ctext tag remove sel 1.0 end
6450 set mend "$match + $mlen c"
6451 $ctext tag add sel $match $mend
6452 $ctext mark unset anchor
6456 proc dosearchback {} {
6457 global sstring ctext searchstring searchdirn
6460 $sstring icursor end
6461 set searchdirn -backwards
6462 if {$searchstring ne {}} {
6463 set sel [$ctext tag ranges sel]
6465 set start [lindex $sel 0]
6466 } elseif {[catch {set start [$ctext index anchor]}]} {
6467 set start @0,[winfo height $ctext]
6469 set match [$ctext search -backwards -count ml -- $searchstring $start]
6470 $ctext tag remove sel 1.0 end
6476 set mend "$match + $ml c"
6477 $ctext tag add sel $match $mend
6478 $ctext mark unset anchor
6482 proc searchmark {first last} {
6483 global ctext searchstring
6487 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6488 if {$match eq {}} break
6489 set mend "$match + $mlen c"
6490 $ctext tag add found $match $mend
6494 proc searchmarkvisible {doall} {
6495 global ctext smarktop smarkbot
6497 set topline [lindex [split [$ctext index @0,0] .] 0]
6498 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6499 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6500 # no overlap with previous
6501 searchmark $topline $botline
6502 set smarktop $topline
6503 set smarkbot $botline
6505 if {$topline < $smarktop} {
6506 searchmark $topline [expr {$smarktop-1}]
6507 set smarktop $topline
6509 if {$botline > $smarkbot} {
6510 searchmark [expr {$smarkbot+1}] $botline
6511 set smarkbot $botline
6516 proc scrolltext {f0 f1} {
6519 .bleft.bottom.sb set $f0 $f1
6520 if {$searchstring ne {}} {
6526 global linespc charspc canvx0 canvy0
6527 global xspc1 xspc2 lthickness
6529 set linespc [font metrics mainfont -linespace]
6530 set charspc [font measure mainfont "m"]
6531 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6532 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6533 set lthickness [expr {int($linespc / 9) + 1}]
6534 set xspc1(0) $linespc
6542 set ymax [lindex [$canv cget -scrollregion] 3]
6543 if {$ymax eq {} || $ymax == 0} return
6544 set span [$canv yview]
6547 allcanvs yview moveto [lindex $span 0]
6549 if {[info exists selectedline]} {
6550 selectline $selectedline 0
6551 allcanvs yview moveto [lindex $span 0]
6555 proc parsefont {f n} {
6558 set fontattr($f,family) [lindex $n 0]
6560 if {$s eq {} || $s == 0} {
6563 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6565 set fontattr($f,size) $s
6566 set fontattr($f,weight) normal
6567 set fontattr($f,slant) roman
6568 foreach style [lrange $n 2 end] {
6571 "bold" {set fontattr($f,weight) $style}
6573 "italic" {set fontattr($f,slant) $style}
6578 proc fontflags {f {isbold 0}} {
6581 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6582 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6583 -slant $fontattr($f,slant)]
6589 set n [list $fontattr($f,family) $fontattr($f,size)]
6590 if {$fontattr($f,weight) eq "bold"} {
6593 if {$fontattr($f,slant) eq "italic"} {
6599 proc incrfont {inc} {
6600 global mainfont textfont ctext canv cflist showrefstop
6601 global stopped entries fontattr
6604 set s $fontattr(mainfont,size)
6609 set fontattr(mainfont,size) $s
6610 font config mainfont -size $s
6611 font config mainfontbold -size $s
6612 set mainfont [fontname mainfont]
6613 set s $fontattr(textfont,size)
6618 set fontattr(textfont,size) $s
6619 font config textfont -size $s
6620 font config textfontbold -size $s
6621 set textfont [fontname textfont]
6628 global sha1entry sha1string
6629 if {[string length $sha1string] == 40} {
6630 $sha1entry delete 0 end
6634 proc sha1change {n1 n2 op} {
6635 global sha1string currentid sha1but
6636 if {$sha1string == {}
6637 || ([info exists currentid] && $sha1string == $currentid)} {
6642 if {[$sha1but cget -state] == $state} return
6643 if {$state == "normal"} {
6644 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6646 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6650 proc gotocommit {} {
6651 global sha1string tagids headids curview varcid
6653 if {$sha1string == {}
6654 || ([info exists currentid] && $sha1string == $currentid)} return
6655 if {[info exists tagids($sha1string)]} {
6656 set id $tagids($sha1string)
6657 } elseif {[info exists headids($sha1string)]} {
6658 set id $headids($sha1string)
6660 set id [string tolower $sha1string]
6661 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6662 set matches [array names varcid "$curview,$id*"]
6663 if {$matches ne {}} {
6664 if {[llength $matches] > 1} {
6665 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6668 set id [lindex [split [lindex $matches 0] ","] 1]
6672 if {[commitinview $id $curview]} {
6673 selectline [rowofcommit $id] 1
6676 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6677 set msg [mc "SHA1 id %s is not known" $sha1string]
6679 set msg [mc "Tag/Head %s is not known" $sha1string]
6684 proc lineenter {x y id} {
6685 global hoverx hovery hoverid hovertimer
6686 global commitinfo canv
6688 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6692 if {[info exists hovertimer]} {
6693 after cancel $hovertimer
6695 set hovertimer [after 500 linehover]
6699 proc linemotion {x y id} {
6700 global hoverx hovery hoverid hovertimer
6702 if {[info exists hoverid] && $id == $hoverid} {
6705 if {[info exists hovertimer]} {
6706 after cancel $hovertimer
6708 set hovertimer [after 500 linehover]
6712 proc lineleave {id} {
6713 global hoverid hovertimer canv
6715 if {[info exists hoverid] && $id == $hoverid} {
6717 if {[info exists hovertimer]} {
6718 after cancel $hovertimer
6726 global hoverx hovery hoverid hovertimer
6727 global canv linespc lthickness
6730 set text [lindex $commitinfo($hoverid) 0]
6731 set ymax [lindex [$canv cget -scrollregion] 3]
6732 if {$ymax == {}} return
6733 set yfrac [lindex [$canv yview] 0]
6734 set x [expr {$hoverx + 2 * $linespc}]
6735 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6736 set x0 [expr {$x - 2 * $lthickness}]
6737 set y0 [expr {$y - 2 * $lthickness}]
6738 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6739 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6740 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6741 -fill \#ffff80 -outline black -width 1 -tags hover]
6743 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6748 proc clickisonarrow {id y} {
6751 set ranges [rowranges $id]
6752 set thresh [expr {2 * $lthickness + 6}]
6753 set n [expr {[llength $ranges] - 1}]
6754 for {set i 1} {$i < $n} {incr i} {
6755 set row [lindex $ranges $i]
6756 if {abs([yc $row] - $y) < $thresh} {
6763 proc arrowjump {id n y} {
6766 # 1 <-> 2, 3 <-> 4, etc...
6767 set n [expr {(($n - 1) ^ 1) + 1}]
6768 set row [lindex [rowranges $id] $n]
6770 set ymax [lindex [$canv cget -scrollregion] 3]
6771 if {$ymax eq {} || $ymax <= 0} return
6772 set view [$canv yview]
6773 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6774 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6778 allcanvs yview moveto $yfrac
6781 proc lineclick {x y id isnew} {
6782 global ctext commitinfo children canv thickerline curview
6784 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6789 # draw this line thicker than normal
6793 set ymax [lindex [$canv cget -scrollregion] 3]
6794 if {$ymax eq {}} return
6795 set yfrac [lindex [$canv yview] 0]
6796 set y [expr {$y + $yfrac * $ymax}]
6798 set dirn [clickisonarrow $id $y]
6800 arrowjump $id $dirn $y
6805 addtohistory [list lineclick $x $y $id 0]
6807 # fill the details pane with info about this line
6808 $ctext conf -state normal
6811 $ctext insert end "[mc "Parent"]:\t"
6812 $ctext insert end $id link0
6814 set info $commitinfo($id)
6815 $ctext insert end "\n\t[lindex $info 0]\n"
6816 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6817 set date [formatdate [lindex $info 2]]
6818 $ctext insert end "\t[mc "Date"]:\t$date\n"
6819 set kids $children($curview,$id)
6821 $ctext insert end "\n[mc "Children"]:"
6823 foreach child $kids {
6825 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6826 set info $commitinfo($child)
6827 $ctext insert end "\n\t"
6828 $ctext insert end $child link$i
6829 setlink $child link$i
6830 $ctext insert end "\n\t[lindex $info 0]"
6831 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6832 set date [formatdate [lindex $info 2]]
6833 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6836 $ctext conf -state disabled
6840 proc normalline {} {
6842 if {[info exists thickerline]} {
6851 if {[commitinview $id $curview]} {
6852 selectline [rowofcommit $id] 1
6858 if {![info exists startmstime]} {
6859 set startmstime [clock clicks -milliseconds]
6861 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6864 proc rowmenu {x y id} {
6865 global rowctxmenu selectedline rowmenuid curview
6866 global nullid nullid2 fakerowmenu mainhead
6870 if {![info exists selectedline]
6871 || [rowofcommit $id] eq $selectedline} {
6876 if {$id ne $nullid && $id ne $nullid2} {
6877 set menu $rowctxmenu
6878 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6880 set menu $fakerowmenu
6882 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6883 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6884 $menu entryconfigure [mc "Make patch"] -state $state
6885 tk_popup $menu $x $y
6888 proc diffvssel {dirn} {
6889 global rowmenuid selectedline
6891 if {![info exists selectedline]} return
6893 set oldid [commitonrow $selectedline]
6894 set newid $rowmenuid
6896 set oldid $rowmenuid
6897 set newid [commitonrow $selectedline]
6899 addtohistory [list doseldiff $oldid $newid]
6900 doseldiff $oldid $newid
6903 proc doseldiff {oldid newid} {
6907 $ctext conf -state normal
6909 init_flist [mc "Top"]
6910 $ctext insert end "[mc "From"] "
6911 $ctext insert end $oldid link0
6912 setlink $oldid link0
6913 $ctext insert end "\n "
6914 $ctext insert end [lindex $commitinfo($oldid) 0]
6915 $ctext insert end "\n\n[mc "To"] "
6916 $ctext insert end $newid link1
6917 setlink $newid link1
6918 $ctext insert end "\n "
6919 $ctext insert end [lindex $commitinfo($newid) 0]
6920 $ctext insert end "\n"
6921 $ctext conf -state disabled
6922 $ctext tag remove found 1.0 end
6923 startdiff [list $oldid $newid]
6927 global rowmenuid currentid commitinfo patchtop patchnum
6929 if {![info exists currentid]} return
6930 set oldid $currentid
6931 set oldhead [lindex $commitinfo($oldid) 0]
6932 set newid $rowmenuid
6933 set newhead [lindex $commitinfo($newid) 0]
6936 catch {destroy $top}
6938 label $top.title -text [mc "Generate patch"]
6939 grid $top.title - -pady 10
6940 label $top.from -text [mc "From:"]
6941 entry $top.fromsha1 -width 40 -relief flat
6942 $top.fromsha1 insert 0 $oldid
6943 $top.fromsha1 conf -state readonly
6944 grid $top.from $top.fromsha1 -sticky w
6945 entry $top.fromhead -width 60 -relief flat
6946 $top.fromhead insert 0 $oldhead
6947 $top.fromhead conf -state readonly
6948 grid x $top.fromhead -sticky w
6949 label $top.to -text [mc "To:"]
6950 entry $top.tosha1 -width 40 -relief flat
6951 $top.tosha1 insert 0 $newid
6952 $top.tosha1 conf -state readonly
6953 grid $top.to $top.tosha1 -sticky w
6954 entry $top.tohead -width 60 -relief flat
6955 $top.tohead insert 0 $newhead
6956 $top.tohead conf -state readonly
6957 grid x $top.tohead -sticky w
6958 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6959 grid $top.rev x -pady 10
6960 label $top.flab -text [mc "Output file:"]
6961 entry $top.fname -width 60
6962 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6964 grid $top.flab $top.fname -sticky w
6966 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6967 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6968 grid $top.buts.gen $top.buts.can
6969 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6970 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6971 grid $top.buts - -pady 10 -sticky ew
6975 proc mkpatchrev {} {
6978 set oldid [$patchtop.fromsha1 get]
6979 set oldhead [$patchtop.fromhead get]
6980 set newid [$patchtop.tosha1 get]
6981 set newhead [$patchtop.tohead get]
6982 foreach e [list fromsha1 fromhead tosha1 tohead] \
6983 v [list $newid $newhead $oldid $oldhead] {
6984 $patchtop.$e conf -state normal
6985 $patchtop.$e delete 0 end
6986 $patchtop.$e insert 0 $v
6987 $patchtop.$e conf -state readonly
6992 global patchtop nullid nullid2
6994 set oldid [$patchtop.fromsha1 get]
6995 set newid [$patchtop.tosha1 get]
6996 set fname [$patchtop.fname get]
6997 set cmd [diffcmd [list $oldid $newid] -p]
6998 # trim off the initial "|"
6999 set cmd [lrange $cmd 1 end]
7000 lappend cmd >$fname &
7001 if {[catch {eval exec $cmd} err]} {
7002 error_popup "[mc "Error creating patch:"] $err"
7004 catch {destroy $patchtop}
7008 proc mkpatchcan {} {
7011 catch {destroy $patchtop}
7016 global rowmenuid mktagtop commitinfo
7020 catch {destroy $top}
7022 label $top.title -text [mc "Create tag"]
7023 grid $top.title - -pady 10
7024 label $top.id -text [mc "ID:"]
7025 entry $top.sha1 -width 40 -relief flat
7026 $top.sha1 insert 0 $rowmenuid
7027 $top.sha1 conf -state readonly
7028 grid $top.id $top.sha1 -sticky w
7029 entry $top.head -width 60 -relief flat
7030 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7031 $top.head conf -state readonly
7032 grid x $top.head -sticky w
7033 label $top.tlab -text [mc "Tag name:"]
7034 entry $top.tag -width 60
7035 grid $top.tlab $top.tag -sticky w
7037 button $top.buts.gen -text [mc "Create"] -command mktaggo
7038 button $top.buts.can -text [mc "Cancel"] -command mktagcan
7039 grid $top.buts.gen $top.buts.can
7040 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7041 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7042 grid $top.buts - -pady 10 -sticky ew
7047 global mktagtop env tagids idtags
7049 set id [$mktagtop.sha1 get]
7050 set tag [$mktagtop.tag get]
7052 error_popup [mc "No tag name specified"]
7055 if {[info exists tagids($tag)]} {
7056 error_popup [mc "Tag \"%s\" already exists" $tag]
7060 exec git tag $tag $id
7062 error_popup "[mc "Error creating tag:"] $err"
7066 set tagids($tag) $id
7067 lappend idtags($id) $tag
7074 proc redrawtags {id} {
7075 global canv linehtag idpos currentid curview
7076 global canvxmax iddrawn
7078 if {![commitinview $id $curview]} return
7079 if {![info exists iddrawn($id)]} return
7080 set row [rowofcommit $id]
7081 $canv delete tag.$id
7082 set xt [eval drawtags $id $idpos($id)]
7083 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7084 set text [$canv itemcget $linehtag($row) -text]
7085 set font [$canv itemcget $linehtag($row) -font]
7086 set xr [expr {$xt + [font measure $font $text]}]
7087 if {$xr > $canvxmax} {
7091 if {[info exists currentid] && $currentid == $id} {
7099 catch {destroy $mktagtop}
7108 proc writecommit {} {
7109 global rowmenuid wrcomtop commitinfo wrcomcmd
7111 set top .writecommit
7113 catch {destroy $top}
7115 label $top.title -text [mc "Write commit to file"]
7116 grid $top.title - -pady 10
7117 label $top.id -text [mc "ID:"]
7118 entry $top.sha1 -width 40 -relief flat
7119 $top.sha1 insert 0 $rowmenuid
7120 $top.sha1 conf -state readonly
7121 grid $top.id $top.sha1 -sticky w
7122 entry $top.head -width 60 -relief flat
7123 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7124 $top.head conf -state readonly
7125 grid x $top.head -sticky w
7126 label $top.clab -text [mc "Command:"]
7127 entry $top.cmd -width 60 -textvariable wrcomcmd
7128 grid $top.clab $top.cmd -sticky w -pady 10
7129 label $top.flab -text [mc "Output file:"]
7130 entry $top.fname -width 60
7131 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7132 grid $top.flab $top.fname -sticky w
7134 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7135 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7136 grid $top.buts.gen $top.buts.can
7137 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7138 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7139 grid $top.buts - -pady 10 -sticky ew
7146 set id [$wrcomtop.sha1 get]
7147 set cmd "echo $id | [$wrcomtop.cmd get]"
7148 set fname [$wrcomtop.fname get]
7149 if {[catch {exec sh -c $cmd >$fname &} err]} {
7150 error_popup "[mc "Error writing commit:"] $err"
7152 catch {destroy $wrcomtop}
7159 catch {destroy $wrcomtop}
7164 global rowmenuid mkbrtop
7167 catch {destroy $top}
7169 label $top.title -text [mc "Create new branch"]
7170 grid $top.title - -pady 10
7171 label $top.id -text [mc "ID:"]
7172 entry $top.sha1 -width 40 -relief flat
7173 $top.sha1 insert 0 $rowmenuid
7174 $top.sha1 conf -state readonly
7175 grid $top.id $top.sha1 -sticky w
7176 label $top.nlab -text [mc "Name:"]
7177 entry $top.name -width 40
7178 grid $top.nlab $top.name -sticky w
7180 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7181 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7182 grid $top.buts.go $top.buts.can
7183 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7184 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7185 grid $top.buts - -pady 10 -sticky ew
7190 global headids idheads
7192 set name [$top.name get]
7193 set id [$top.sha1 get]
7195 error_popup [mc "Please specify a name for the new branch"]
7198 catch {destroy $top}
7202 exec git branch $name $id
7207 set headids($name) $id
7208 lappend idheads($id) $name
7217 proc cherrypick {} {
7218 global rowmenuid curview
7219 global mainhead mainheadid
7221 set oldhead [exec git rev-parse HEAD]
7222 set dheads [descheads $rowmenuid]
7223 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7224 set ok [confirm_popup [mc "Commit %s is already\
7225 included in branch %s -- really re-apply it?" \
7226 [string range $rowmenuid 0 7] $mainhead]]
7229 nowbusy cherrypick [mc "Cherry-picking"]
7231 # Unfortunately git-cherry-pick writes stuff to stderr even when
7232 # no error occurs, and exec takes that as an indication of error...
7233 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7238 set newhead [exec git rev-parse HEAD]
7239 if {$newhead eq $oldhead} {
7241 error_popup [mc "No changes committed"]
7244 addnewchild $newhead $oldhead
7245 if {[commitinview $oldhead $curview]} {
7246 insertrow $newhead $oldhead $curview
7247 if {$mainhead ne {}} {
7248 movehead $newhead $mainhead
7249 movedhead $newhead $mainhead
7250 set mainheadid $newhead
7260 global mainhead rowmenuid confirm_ok resettype
7263 set w ".confirmreset"
7266 wm title $w [mc "Confirm reset"]
7267 message $w.m -text \
7268 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7269 -justify center -aspect 1000
7270 pack $w.m -side top -fill x -padx 20 -pady 20
7271 frame $w.f -relief sunken -border 2
7272 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7273 grid $w.f.rt -sticky w
7275 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7276 -text [mc "Soft: Leave working tree and index untouched"]
7277 grid $w.f.soft -sticky w
7278 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7279 -text [mc "Mixed: Leave working tree untouched, reset index"]
7280 grid $w.f.mixed -sticky w
7281 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7282 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7283 grid $w.f.hard -sticky w
7284 pack $w.f -side top -fill x
7285 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7286 pack $w.ok -side left -fill x -padx 20 -pady 20
7287 button $w.cancel -text [mc Cancel] -command "destroy $w"
7288 pack $w.cancel -side right -fill x -padx 20 -pady 20
7289 bind $w <Visibility> "grab $w; focus $w"
7291 if {!$confirm_ok} return
7292 if {[catch {set fd [open \
7293 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7297 filerun $fd [list readresetstat $fd]
7298 nowbusy reset [mc "Resetting"]
7303 proc readresetstat {fd} {
7304 global mainhead mainheadid showlocalchanges rprogcoord
7306 if {[gets $fd line] >= 0} {
7307 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7308 set rprogcoord [expr {1.0 * $m / $n}]
7316 if {[catch {close $fd} err]} {
7319 set oldhead $mainheadid
7320 set newhead [exec git rev-parse HEAD]
7321 if {$newhead ne $oldhead} {
7322 movehead $newhead $mainhead
7323 movedhead $newhead $mainhead
7324 set mainheadid $newhead
7328 if {$showlocalchanges} {
7334 # context menu for a head
7335 proc headmenu {x y id head} {
7336 global headmenuid headmenuhead headctxmenu mainhead
7340 set headmenuhead $head
7342 if {$head eq $mainhead} {
7345 $headctxmenu entryconfigure 0 -state $state
7346 $headctxmenu entryconfigure 1 -state $state
7347 tk_popup $headctxmenu $x $y
7351 global headmenuid headmenuhead mainhead headids
7352 global showlocalchanges mainheadid
7354 # check the tree is clean first??
7355 set oldmainhead $mainhead
7356 nowbusy checkout [mc "Checking out"]
7360 exec git checkout -q $headmenuhead
7366 set mainhead $headmenuhead
7367 set mainheadid $headmenuid
7368 if {[info exists headids($oldmainhead)]} {
7369 redrawtags $headids($oldmainhead)
7371 redrawtags $headmenuid
7374 if {$showlocalchanges} {
7380 global headmenuid headmenuhead mainhead
7383 set head $headmenuhead
7385 # this check shouldn't be needed any more...
7386 if {$head eq $mainhead} {
7387 error_popup [mc "Cannot delete the currently checked-out branch"]
7390 set dheads [descheads $id]
7391 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7392 # the stuff on this branch isn't on any other branch
7393 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7394 branch.\nReally delete branch %s?" $head $head]]} return
7398 if {[catch {exec git branch -D $head} err]} {
7403 removehead $id $head
7404 removedhead $id $head
7411 # Display a list of tags and heads
7413 global showrefstop bgcolor fgcolor selectbgcolor
7414 global bglist fglist reflistfilter reflist maincursor
7417 set showrefstop $top
7418 if {[winfo exists $top]} {
7424 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7425 text $top.list -background $bgcolor -foreground $fgcolor \
7426 -selectbackground $selectbgcolor -font mainfont \
7427 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7428 -width 30 -height 20 -cursor $maincursor \
7429 -spacing1 1 -spacing3 1 -state disabled
7430 $top.list tag configure highlight -background $selectbgcolor
7431 lappend bglist $top.list
7432 lappend fglist $top.list
7433 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7434 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7435 grid $top.list $top.ysb -sticky nsew
7436 grid $top.xsb x -sticky ew
7438 label $top.f.l -text "[mc "Filter"]: "
7439 entry $top.f.e -width 20 -textvariable reflistfilter
7440 set reflistfilter "*"
7441 trace add variable reflistfilter write reflistfilter_change
7442 pack $top.f.e -side right -fill x -expand 1
7443 pack $top.f.l -side left
7444 grid $top.f - -sticky ew -pady 2
7445 button $top.close -command [list destroy $top] -text [mc "Close"]
7447 grid columnconfigure $top 0 -weight 1
7448 grid rowconfigure $top 0 -weight 1
7449 bind $top.list <1> {break}
7450 bind $top.list <B1-Motion> {break}
7451 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7456 proc sel_reflist {w x y} {
7457 global showrefstop reflist headids tagids otherrefids
7459 if {![winfo exists $showrefstop]} return
7460 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7461 set ref [lindex $reflist [expr {$l-1}]]
7462 set n [lindex $ref 0]
7463 switch -- [lindex $ref 1] {
7464 "H" {selbyid $headids($n)}
7465 "T" {selbyid $tagids($n)}
7466 "o" {selbyid $otherrefids($n)}
7468 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7471 proc unsel_reflist {} {
7474 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7475 $showrefstop.list tag remove highlight 0.0 end
7478 proc reflistfilter_change {n1 n2 op} {
7479 global reflistfilter
7481 after cancel refill_reflist
7482 after 200 refill_reflist
7485 proc refill_reflist {} {
7486 global reflist reflistfilter showrefstop headids tagids otherrefids
7487 global curview commitinterest
7489 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7491 foreach n [array names headids] {
7492 if {[string match $reflistfilter $n]} {
7493 if {[commitinview $headids($n) $curview]} {
7494 lappend refs [list $n H]
7496 set commitinterest($headids($n)) {run refill_reflist}
7500 foreach n [array names tagids] {
7501 if {[string match $reflistfilter $n]} {
7502 if {[commitinview $tagids($n) $curview]} {
7503 lappend refs [list $n T]
7505 set commitinterest($tagids($n)) {run refill_reflist}
7509 foreach n [array names otherrefids] {
7510 if {[string match $reflistfilter $n]} {
7511 if {[commitinview $otherrefids($n) $curview]} {
7512 lappend refs [list $n o]
7514 set commitinterest($otherrefids($n)) {run refill_reflist}
7518 set refs [lsort -index 0 $refs]
7519 if {$refs eq $reflist} return
7521 # Update the contents of $showrefstop.list according to the
7522 # differences between $reflist (old) and $refs (new)
7523 $showrefstop.list conf -state normal
7524 $showrefstop.list insert end "\n"
7527 while {$i < [llength $reflist] || $j < [llength $refs]} {
7528 if {$i < [llength $reflist]} {
7529 if {$j < [llength $refs]} {
7530 set cmp [string compare [lindex $reflist $i 0] \
7531 [lindex $refs $j 0]]
7533 set cmp [string compare [lindex $reflist $i 1] \
7534 [lindex $refs $j 1]]
7544 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7552 set l [expr {$j + 1}]
7553 $showrefstop.list image create $l.0 -align baseline \
7554 -image reficon-[lindex $refs $j 1] -padx 2
7555 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7561 # delete last newline
7562 $showrefstop.list delete end-2c end-1c
7563 $showrefstop.list conf -state disabled
7566 # Stuff for finding nearby tags
7567 proc getallcommits {} {
7568 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7569 global idheads idtags idotherrefs allparents tagobjid
7571 if {![info exists allcommits]} {
7577 set allccache [file join [gitdir] "gitk.cache"]
7579 set f [open $allccache r]
7588 set cmd [list | git rev-list --parents]
7589 set allcupdate [expr {$seeds ne {}}]
7593 set refs [concat [array names idheads] [array names idtags] \
7594 [array names idotherrefs]]
7597 foreach name [array names tagobjid] {
7598 lappend tagobjs $tagobjid($name)
7600 foreach id [lsort -unique $refs] {
7601 if {![info exists allparents($id)] &&
7602 [lsearch -exact $tagobjs $id] < 0} {
7613 set fd [open [concat $cmd $ids] r]
7614 fconfigure $fd -blocking 0
7617 filerun $fd [list getallclines $fd]
7623 # Since most commits have 1 parent and 1 child, we group strings of
7624 # such commits into "arcs" joining branch/merge points (BMPs), which
7625 # are commits that either don't have 1 parent or don't have 1 child.
7627 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7628 # arcout(id) - outgoing arcs for BMP
7629 # arcids(a) - list of IDs on arc including end but not start
7630 # arcstart(a) - BMP ID at start of arc
7631 # arcend(a) - BMP ID at end of arc
7632 # growing(a) - arc a is still growing
7633 # arctags(a) - IDs out of arcids (excluding end) that have tags
7634 # archeads(a) - IDs out of arcids (excluding end) that have heads
7635 # The start of an arc is at the descendent end, so "incoming" means
7636 # coming from descendents, and "outgoing" means going towards ancestors.
7638 proc getallclines {fd} {
7639 global allparents allchildren idtags idheads nextarc
7640 global arcnos arcids arctags arcout arcend arcstart archeads growing
7641 global seeds allcommits cachedarcs allcupdate
7644 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7645 set id [lindex $line 0]
7646 if {[info exists allparents($id)]} {
7651 set olds [lrange $line 1 end]
7652 set allparents($id) $olds
7653 if {![info exists allchildren($id)]} {
7654 set allchildren($id) {}
7659 if {[llength $olds] == 1 && [llength $a] == 1} {
7660 lappend arcids($a) $id
7661 if {[info exists idtags($id)]} {
7662 lappend arctags($a) $id
7664 if {[info exists idheads($id)]} {
7665 lappend archeads($a) $id
7667 if {[info exists allparents($olds)]} {
7668 # seen parent already
7669 if {![info exists arcout($olds)]} {
7672 lappend arcids($a) $olds
7673 set arcend($a) $olds
7676 lappend allchildren($olds) $id
7677 lappend arcnos($olds) $a
7681 foreach a $arcnos($id) {
7682 lappend arcids($a) $id
7689 lappend allchildren($p) $id
7690 set a [incr nextarc]
7691 set arcstart($a) $id
7698 if {[info exists allparents($p)]} {
7699 # seen it already, may need to make a new branch
7700 if {![info exists arcout($p)]} {
7703 lappend arcids($a) $p
7707 lappend arcnos($p) $a
7712 global cached_dheads cached_dtags cached_atags
7713 catch {unset cached_dheads}
7714 catch {unset cached_dtags}
7715 catch {unset cached_atags}
7718 return [expr {$nid >= 1000? 2: 1}]
7722 fconfigure $fd -blocking 1
7725 # got an error reading the list of commits
7726 # if we were updating, try rereading the whole thing again
7732 error_popup "[mc "Error reading commit topology information;\
7733 branch and preceding/following tag information\
7734 will be incomplete."]\n($err)"
7737 if {[incr allcommits -1] == 0} {
7747 proc recalcarc {a} {
7748 global arctags archeads arcids idtags idheads
7752 foreach id [lrange $arcids($a) 0 end-1] {
7753 if {[info exists idtags($id)]} {
7756 if {[info exists idheads($id)]} {
7761 set archeads($a) $ah
7765 global arcnos arcids nextarc arctags archeads idtags idheads
7766 global arcstart arcend arcout allparents growing
7769 if {[llength $a] != 1} {
7770 puts "oops splitarc called but [llength $a] arcs already"
7774 set i [lsearch -exact $arcids($a) $p]
7776 puts "oops splitarc $p not in arc $a"
7779 set na [incr nextarc]
7780 if {[info exists arcend($a)]} {
7781 set arcend($na) $arcend($a)
7783 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7784 set j [lsearch -exact $arcnos($l) $a]
7785 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7787 set tail [lrange $arcids($a) [expr {$i+1}] end]
7788 set arcids($a) [lrange $arcids($a) 0 $i]
7790 set arcstart($na) $p
7792 set arcids($na) $tail
7793 if {[info exists growing($a)]} {
7799 if {[llength $arcnos($id)] == 1} {
7802 set j [lsearch -exact $arcnos($id) $a]
7803 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7807 # reconstruct tags and heads lists
7808 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7813 set archeads($na) {}
7817 # Update things for a new commit added that is a child of one
7818 # existing commit. Used when cherry-picking.
7819 proc addnewchild {id p} {
7820 global allparents allchildren idtags nextarc
7821 global arcnos arcids arctags arcout arcend arcstart archeads growing
7822 global seeds allcommits
7824 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7825 set allparents($id) [list $p]
7826 set allchildren($id) {}
7829 lappend allchildren($p) $id
7830 set a [incr nextarc]
7831 set arcstart($a) $id
7834 set arcids($a) [list $p]
7836 if {![info exists arcout($p)]} {
7839 lappend arcnos($p) $a
7840 set arcout($id) [list $a]
7843 # This implements a cache for the topology information.
7844 # The cache saves, for each arc, the start and end of the arc,
7845 # the ids on the arc, and the outgoing arcs from the end.
7846 proc readcache {f} {
7847 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7848 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7853 if {$lim - $a > 500} {
7854 set lim [expr {$a + 500}]
7858 # finish reading the cache and setting up arctags, etc.
7860 if {$line ne "1"} {error "bad final version"}
7862 foreach id [array names idtags] {
7863 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7864 [llength $allparents($id)] == 1} {
7865 set a [lindex $arcnos($id) 0]
7866 if {$arctags($a) eq {}} {
7871 foreach id [array names idheads] {
7872 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7873 [llength $allparents($id)] == 1} {
7874 set a [lindex $arcnos($id) 0]
7875 if {$archeads($a) eq {}} {
7880 foreach id [lsort -unique $possible_seeds] {
7881 if {$arcnos($id) eq {}} {
7887 while {[incr a] <= $lim} {
7889 if {[llength $line] != 3} {error "bad line"}
7890 set s [lindex $line 0]
7892 lappend arcout($s) $a
7893 if {![info exists arcnos($s)]} {
7894 lappend possible_seeds $s
7897 set e [lindex $line 1]
7902 if {![info exists arcout($e)]} {
7906 set arcids($a) [lindex $line 2]
7907 foreach id $arcids($a) {
7908 lappend allparents($s) $id
7910 lappend arcnos($id) $a
7912 if {![info exists allparents($s)]} {
7913 set allparents($s) {}
7918 set nextarc [expr {$a - 1}]
7931 global nextarc cachedarcs possible_seeds
7935 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7936 # make sure it's an integer
7937 set cachedarcs [expr {int([lindex $line 1])}]
7938 if {$cachedarcs < 0} {error "bad number of arcs"}
7940 set possible_seeds {}
7948 proc dropcache {err} {
7949 global allcwait nextarc cachedarcs seeds
7951 #puts "dropping cache ($err)"
7952 foreach v {arcnos arcout arcids arcstart arcend growing \
7953 arctags archeads allparents allchildren} {
7964 proc writecache {f} {
7965 global cachearc cachedarcs allccache
7966 global arcstart arcend arcnos arcids arcout
7970 if {$lim - $a > 1000} {
7971 set lim [expr {$a + 1000}]
7974 while {[incr a] <= $lim} {
7975 if {[info exists arcend($a)]} {
7976 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7978 puts $f [list $arcstart($a) {} $arcids($a)]
7983 catch {file delete $allccache}
7984 #puts "writing cache failed ($err)"
7987 set cachearc [expr {$a - 1}]
7988 if {$a > $cachedarcs} {
7997 global nextarc cachedarcs cachearc allccache
7999 if {$nextarc == $cachedarcs} return
8001 set cachedarcs $nextarc
8003 set f [open $allccache w]
8004 puts $f [list 1 $cachedarcs]
8009 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8010 # or 0 if neither is true.
8011 proc anc_or_desc {a b} {
8012 global arcout arcstart arcend arcnos cached_isanc
8014 if {$arcnos($a) eq $arcnos($b)} {
8015 # Both are on the same arc(s); either both are the same BMP,
8016 # or if one is not a BMP, the other is also not a BMP or is
8017 # the BMP at end of the arc (and it only has 1 incoming arc).
8018 # Or both can be BMPs with no incoming arcs.
8019 if {$a eq $b || $arcnos($a) eq {}} {
8022 # assert {[llength $arcnos($a)] == 1}
8023 set arc [lindex $arcnos($a) 0]
8024 set i [lsearch -exact $arcids($arc) $a]
8025 set j [lsearch -exact $arcids($arc) $b]
8026 if {$i < 0 || $i > $j} {
8033 if {![info exists arcout($a)]} {
8034 set arc [lindex $arcnos($a) 0]
8035 if {[info exists arcend($arc)]} {
8036 set aend $arcend($arc)
8040 set a $arcstart($arc)
8044 if {![info exists arcout($b)]} {
8045 set arc [lindex $arcnos($b) 0]
8046 if {[info exists arcend($arc)]} {
8047 set bend $arcend($arc)
8051 set b $arcstart($arc)
8061 if {[info exists cached_isanc($a,$bend)]} {
8062 if {$cached_isanc($a,$bend)} {
8066 if {[info exists cached_isanc($b,$aend)]} {
8067 if {$cached_isanc($b,$aend)} {
8070 if {[info exists cached_isanc($a,$bend)]} {
8075 set todo [list $a $b]
8078 for {set i 0} {$i < [llength $todo]} {incr i} {
8079 set x [lindex $todo $i]
8080 if {$anc($x) eq {}} {
8083 foreach arc $arcnos($x) {
8084 set xd $arcstart($arc)
8086 set cached_isanc($a,$bend) 1
8087 set cached_isanc($b,$aend) 0
8089 } elseif {$xd eq $aend} {
8090 set cached_isanc($b,$aend) 1
8091 set cached_isanc($a,$bend) 0
8094 if {![info exists anc($xd)]} {
8095 set anc($xd) $anc($x)
8097 } elseif {$anc($xd) ne $anc($x)} {
8102 set cached_isanc($a,$bend) 0
8103 set cached_isanc($b,$aend) 0
8107 # This identifies whether $desc has an ancestor that is
8108 # a growing tip of the graph and which is not an ancestor of $anc
8109 # and returns 0 if so and 1 if not.
8110 # If we subsequently discover a tag on such a growing tip, and that
8111 # turns out to be a descendent of $anc (which it could, since we
8112 # don't necessarily see children before parents), then $desc
8113 # isn't a good choice to display as a descendent tag of
8114 # $anc (since it is the descendent of another tag which is
8115 # a descendent of $anc). Similarly, $anc isn't a good choice to
8116 # display as a ancestor tag of $desc.
8118 proc is_certain {desc anc} {
8119 global arcnos arcout arcstart arcend growing problems
8122 if {[llength $arcnos($anc)] == 1} {
8123 # tags on the same arc are certain
8124 if {$arcnos($desc) eq $arcnos($anc)} {
8127 if {![info exists arcout($anc)]} {
8128 # if $anc is partway along an arc, use the start of the arc instead
8129 set a [lindex $arcnos($anc) 0]
8130 set anc $arcstart($a)
8133 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8136 set a [lindex $arcnos($desc) 0]
8142 set anclist [list $x]
8146 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8147 set x [lindex $anclist $i]
8152 foreach a $arcout($x) {
8153 if {[info exists growing($a)]} {
8154 if {![info exists growanc($x)] && $dl($x)} {
8160 if {[info exists dl($y)]} {
8164 if {![info exists done($y)]} {
8167 if {[info exists growanc($x)]} {
8171 for {set k 0} {$k < [llength $xl]} {incr k} {
8172 set z [lindex $xl $k]
8173 foreach c $arcout($z) {
8174 if {[info exists arcend($c)]} {
8176 if {[info exists dl($v)] && $dl($v)} {
8178 if {![info exists done($v)]} {
8181 if {[info exists growanc($v)]} {
8191 } elseif {$y eq $anc || !$dl($x)} {
8202 foreach x [array names growanc] {
8211 proc validate_arctags {a} {
8212 global arctags idtags
8216 foreach id $arctags($a) {
8218 if {![info exists idtags($id)]} {
8219 set na [lreplace $na $i $i]
8226 proc validate_archeads {a} {
8227 global archeads idheads
8230 set na $archeads($a)
8231 foreach id $archeads($a) {
8233 if {![info exists idheads($id)]} {
8234 set na [lreplace $na $i $i]
8238 set archeads($a) $na
8241 # Return the list of IDs that have tags that are descendents of id,
8242 # ignoring IDs that are descendents of IDs already reported.
8243 proc desctags {id} {
8244 global arcnos arcstart arcids arctags idtags allparents
8245 global growing cached_dtags
8247 if {![info exists allparents($id)]} {
8250 set t1 [clock clicks -milliseconds]
8252 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8253 # part-way along an arc; check that arc first
8254 set a [lindex $arcnos($id) 0]
8255 if {$arctags($a) ne {}} {
8257 set i [lsearch -exact $arcids($a) $id]
8259 foreach t $arctags($a) {
8260 set j [lsearch -exact $arcids($a) $t]
8268 set id $arcstart($a)
8269 if {[info exists idtags($id)]} {
8273 if {[info exists cached_dtags($id)]} {
8274 return $cached_dtags($id)
8281 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8282 set id [lindex $todo $i]
8284 set ta [info exists hastaggedancestor($id)]
8288 # ignore tags on starting node
8289 if {!$ta && $i > 0} {
8290 if {[info exists idtags($id)]} {
8293 } elseif {[info exists cached_dtags($id)]} {
8294 set tagloc($id) $cached_dtags($id)
8298 foreach a $arcnos($id) {
8300 if {!$ta && $arctags($a) ne {}} {
8302 if {$arctags($a) ne {}} {
8303 lappend tagloc($id) [lindex $arctags($a) end]
8306 if {$ta || $arctags($a) ne {}} {
8307 set tomark [list $d]
8308 for {set j 0} {$j < [llength $tomark]} {incr j} {
8309 set dd [lindex $tomark $j]
8310 if {![info exists hastaggedancestor($dd)]} {
8311 if {[info exists done($dd)]} {
8312 foreach b $arcnos($dd) {
8313 lappend tomark $arcstart($b)
8315 if {[info exists tagloc($dd)]} {
8318 } elseif {[info exists queued($dd)]} {
8321 set hastaggedancestor($dd) 1
8325 if {![info exists queued($d)]} {
8328 if {![info exists hastaggedancestor($d)]} {
8335 foreach id [array names tagloc] {
8336 if {![info exists hastaggedancestor($id)]} {
8337 foreach t $tagloc($id) {
8338 if {[lsearch -exact $tags $t] < 0} {
8344 set t2 [clock clicks -milliseconds]
8347 # remove tags that are descendents of other tags
8348 for {set i 0} {$i < [llength $tags]} {incr i} {
8349 set a [lindex $tags $i]
8350 for {set j 0} {$j < $i} {incr j} {
8351 set b [lindex $tags $j]
8352 set r [anc_or_desc $a $b]
8354 set tags [lreplace $tags $j $j]
8357 } elseif {$r == -1} {
8358 set tags [lreplace $tags $i $i]
8365 if {[array names growing] ne {}} {
8366 # graph isn't finished, need to check if any tag could get
8367 # eclipsed by another tag coming later. Simply ignore any
8368 # tags that could later get eclipsed.
8371 if {[is_certain $t $origid]} {
8375 if {$tags eq $ctags} {
8376 set cached_dtags($origid) $tags
8381 set cached_dtags($origid) $tags
8383 set t3 [clock clicks -milliseconds]
8384 if {0 && $t3 - $t1 >= 100} {
8385 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8386 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8392 global arcnos arcids arcout arcend arctags idtags allparents
8393 global growing cached_atags
8395 if {![info exists allparents($id)]} {
8398 set t1 [clock clicks -milliseconds]
8400 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8401 # part-way along an arc; check that arc first
8402 set a [lindex $arcnos($id) 0]
8403 if {$arctags($a) ne {}} {
8405 set i [lsearch -exact $arcids($a) $id]
8406 foreach t $arctags($a) {
8407 set j [lsearch -exact $arcids($a) $t]
8413 if {![info exists arcend($a)]} {
8417 if {[info exists idtags($id)]} {
8421 if {[info exists cached_atags($id)]} {
8422 return $cached_atags($id)
8430 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8431 set id [lindex $todo $i]
8433 set td [info exists hastaggeddescendent($id)]
8437 # ignore tags on starting node
8438 if {!$td && $i > 0} {
8439 if {[info exists idtags($id)]} {
8442 } elseif {[info exists cached_atags($id)]} {
8443 set tagloc($id) $cached_atags($id)
8447 foreach a $arcout($id) {
8448 if {!$td && $arctags($a) ne {}} {
8450 if {$arctags($a) ne {}} {
8451 lappend tagloc($id) [lindex $arctags($a) 0]
8454 if {![info exists arcend($a)]} continue
8456 if {$td || $arctags($a) ne {}} {
8457 set tomark [list $d]
8458 for {set j 0} {$j < [llength $tomark]} {incr j} {
8459 set dd [lindex $tomark $j]
8460 if {![info exists hastaggeddescendent($dd)]} {
8461 if {[info exists done($dd)]} {
8462 foreach b $arcout($dd) {
8463 if {[info exists arcend($b)]} {
8464 lappend tomark $arcend($b)
8467 if {[info exists tagloc($dd)]} {
8470 } elseif {[info exists queued($dd)]} {
8473 set hastaggeddescendent($dd) 1
8477 if {![info exists queued($d)]} {
8480 if {![info exists hastaggeddescendent($d)]} {
8486 set t2 [clock clicks -milliseconds]
8489 foreach id [array names tagloc] {
8490 if {![info exists hastaggeddescendent($id)]} {
8491 foreach t $tagloc($id) {
8492 if {[lsearch -exact $tags $t] < 0} {
8499 # remove tags that are ancestors of other tags
8500 for {set i 0} {$i < [llength $tags]} {incr i} {
8501 set a [lindex $tags $i]
8502 for {set j 0} {$j < $i} {incr j} {
8503 set b [lindex $tags $j]
8504 set r [anc_or_desc $a $b]
8506 set tags [lreplace $tags $j $j]
8509 } elseif {$r == 1} {
8510 set tags [lreplace $tags $i $i]
8517 if {[array names growing] ne {}} {
8518 # graph isn't finished, need to check if any tag could get
8519 # eclipsed by another tag coming later. Simply ignore any
8520 # tags that could later get eclipsed.
8523 if {[is_certain $origid $t]} {
8527 if {$tags eq $ctags} {
8528 set cached_atags($origid) $tags
8533 set cached_atags($origid) $tags
8535 set t3 [clock clicks -milliseconds]
8536 if {0 && $t3 - $t1 >= 100} {
8537 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8538 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8543 # Return the list of IDs that have heads that are descendents of id,
8544 # including id itself if it has a head.
8545 proc descheads {id} {
8546 global arcnos arcstart arcids archeads idheads cached_dheads
8549 if {![info exists allparents($id)]} {
8553 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8554 # part-way along an arc; check it first
8555 set a [lindex $arcnos($id) 0]
8556 if {$archeads($a) ne {}} {
8557 validate_archeads $a
8558 set i [lsearch -exact $arcids($a) $id]
8559 foreach t $archeads($a) {
8560 set j [lsearch -exact $arcids($a) $t]
8565 set id $arcstart($a)
8571 for {set i 0} {$i < [llength $todo]} {incr i} {
8572 set id [lindex $todo $i]
8573 if {[info exists cached_dheads($id)]} {
8574 set ret [concat $ret $cached_dheads($id)]
8576 if {[info exists idheads($id)]} {
8579 foreach a $arcnos($id) {
8580 if {$archeads($a) ne {}} {
8581 validate_archeads $a
8582 if {$archeads($a) ne {}} {
8583 set ret [concat $ret $archeads($a)]
8587 if {![info exists seen($d)]} {
8594 set ret [lsort -unique $ret]
8595 set cached_dheads($origid) $ret
8596 return [concat $ret $aret]
8599 proc addedtag {id} {
8600 global arcnos arcout cached_dtags cached_atags
8602 if {![info exists arcnos($id)]} return
8603 if {![info exists arcout($id)]} {
8604 recalcarc [lindex $arcnos($id) 0]
8606 catch {unset cached_dtags}
8607 catch {unset cached_atags}
8610 proc addedhead {hid head} {
8611 global arcnos arcout cached_dheads
8613 if {![info exists arcnos($hid)]} return
8614 if {![info exists arcout($hid)]} {
8615 recalcarc [lindex $arcnos($hid) 0]
8617 catch {unset cached_dheads}
8620 proc removedhead {hid head} {
8621 global cached_dheads
8623 catch {unset cached_dheads}
8626 proc movedhead {hid head} {
8627 global arcnos arcout cached_dheads
8629 if {![info exists arcnos($hid)]} return
8630 if {![info exists arcout($hid)]} {
8631 recalcarc [lindex $arcnos($hid) 0]
8633 catch {unset cached_dheads}
8636 proc changedrefs {} {
8637 global cached_dheads cached_dtags cached_atags
8638 global arctags archeads arcnos arcout idheads idtags
8640 foreach id [concat [array names idheads] [array names idtags]] {
8641 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8642 set a [lindex $arcnos($id) 0]
8643 if {![info exists donearc($a)]} {
8649 catch {unset cached_dtags}
8650 catch {unset cached_atags}
8651 catch {unset cached_dheads}
8654 proc rereadrefs {} {
8655 global idtags idheads idotherrefs mainheadid
8657 set refids [concat [array names idtags] \
8658 [array names idheads] [array names idotherrefs]]
8659 foreach id $refids {
8660 if {![info exists ref($id)]} {
8661 set ref($id) [listrefs $id]
8664 set oldmainhead $mainheadid
8667 set refids [lsort -unique [concat $refids [array names idtags] \
8668 [array names idheads] [array names idotherrefs]]]
8669 foreach id $refids {
8670 set v [listrefs $id]
8671 if {![info exists ref($id)] || $ref($id) != $v ||
8672 ($id eq $oldmainhead && $id ne $mainheadid) ||
8673 ($id eq $mainheadid && $id ne $oldmainhead)} {
8680 proc listrefs {id} {
8681 global idtags idheads idotherrefs
8684 if {[info exists idtags($id)]} {
8688 if {[info exists idheads($id)]} {
8692 if {[info exists idotherrefs($id)]} {
8693 set z $idotherrefs($id)
8695 return [list $x $y $z]
8698 proc showtag {tag isnew} {
8699 global ctext tagcontents tagids linknum tagobjid
8702 addtohistory [list showtag $tag 0]
8704 $ctext conf -state normal
8708 if {![info exists tagcontents($tag)]} {
8710 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8713 if {[info exists tagcontents($tag)]} {
8714 set text $tagcontents($tag)
8716 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8718 appendwithlinks $text {}
8719 $ctext conf -state disabled
8730 proc mkfontdisp {font top which} {
8731 global fontattr fontpref $font
8733 set fontpref($font) [set $font]
8734 button $top.${font}but -text $which -font optionfont \
8735 -command [list choosefont $font $which]
8736 label $top.$font -relief flat -font $font \
8737 -text $fontattr($font,family) -justify left
8738 grid x $top.${font}but $top.$font -sticky w
8741 proc choosefont {font which} {
8742 global fontparam fontlist fonttop fontattr
8744 set fontparam(which) $which
8745 set fontparam(font) $font
8746 set fontparam(family) [font actual $font -family]
8747 set fontparam(size) $fontattr($font,size)
8748 set fontparam(weight) $fontattr($font,weight)
8749 set fontparam(slant) $fontattr($font,slant)
8752 if {![winfo exists $top]} {
8754 eval font config sample [font actual $font]
8756 wm title $top [mc "Gitk font chooser"]
8757 label $top.l -textvariable fontparam(which)
8758 pack $top.l -side top
8759 set fontlist [lsort [font families]]
8761 listbox $top.f.fam -listvariable fontlist \
8762 -yscrollcommand [list $top.f.sb set]
8763 bind $top.f.fam <<ListboxSelect>> selfontfam
8764 scrollbar $top.f.sb -command [list $top.f.fam yview]
8765 pack $top.f.sb -side right -fill y
8766 pack $top.f.fam -side left -fill both -expand 1
8767 pack $top.f -side top -fill both -expand 1
8769 spinbox $top.g.size -from 4 -to 40 -width 4 \
8770 -textvariable fontparam(size) \
8771 -validatecommand {string is integer -strict %s}
8772 checkbutton $top.g.bold -padx 5 \
8773 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8774 -variable fontparam(weight) -onvalue bold -offvalue normal
8775 checkbutton $top.g.ital -padx 5 \
8776 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8777 -variable fontparam(slant) -onvalue italic -offvalue roman
8778 pack $top.g.size $top.g.bold $top.g.ital -side left
8779 pack $top.g -side top
8780 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8782 $top.c create text 100 25 -anchor center -text $which -font sample \
8783 -fill black -tags text
8784 bind $top.c <Configure> [list centertext $top.c]
8785 pack $top.c -side top -fill x
8787 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8788 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8789 grid $top.buts.ok $top.buts.can
8790 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8791 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8792 pack $top.buts -side bottom -fill x
8793 trace add variable fontparam write chg_fontparam
8796 $top.c itemconf text -text $which
8798 set i [lsearch -exact $fontlist $fontparam(family)]
8800 $top.f.fam selection set $i
8805 proc centertext {w} {
8806 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8810 global fontparam fontpref prefstop
8812 set f $fontparam(font)
8813 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8814 if {$fontparam(weight) eq "bold"} {
8815 lappend fontpref($f) "bold"
8817 if {$fontparam(slant) eq "italic"} {
8818 lappend fontpref($f) "italic"
8821 $w conf -text $fontparam(family) -font $fontpref($f)
8827 global fonttop fontparam
8829 if {[info exists fonttop]} {
8830 catch {destroy $fonttop}
8831 catch {font delete sample}
8837 proc selfontfam {} {
8838 global fonttop fontparam
8840 set i [$fonttop.f.fam curselection]
8842 set fontparam(family) [$fonttop.f.fam get $i]
8846 proc chg_fontparam {v sub op} {
8849 font config sample -$sub $fontparam($sub)
8853 global maxwidth maxgraphpct
8854 global oldprefs prefstop showneartags showlocalchanges
8855 global bgcolor fgcolor ctext diffcolors selectbgcolor
8856 global tabstop limitdiffs autoselect
8860 if {[winfo exists $top]} {
8864 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8865 limitdiffs tabstop} {
8866 set oldprefs($v) [set $v]
8869 wm title $top [mc "Gitk preferences"]
8870 label $top.ldisp -text [mc "Commit list display options"]
8871 grid $top.ldisp - -sticky w -pady 10
8872 label $top.spacer -text " "
8873 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8875 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8876 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8877 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8879 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8880 grid x $top.maxpctl $top.maxpct -sticky w
8881 frame $top.showlocal
8882 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8883 checkbutton $top.showlocal.b -variable showlocalchanges
8884 pack $top.showlocal.b $top.showlocal.l -side left
8885 grid x $top.showlocal -sticky w
8886 frame $top.autoselect
8887 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
8888 checkbutton $top.autoselect.b -variable autoselect
8889 pack $top.autoselect.b $top.autoselect.l -side left
8890 grid x $top.autoselect -sticky w
8892 label $top.ddisp -text [mc "Diff display options"]
8893 grid $top.ddisp - -sticky w -pady 10
8894 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8895 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8896 grid x $top.tabstopl $top.tabstop -sticky w
8898 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8899 checkbutton $top.ntag.b -variable showneartags
8900 pack $top.ntag.b $top.ntag.l -side left
8901 grid x $top.ntag -sticky w
8903 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8904 checkbutton $top.ldiff.b -variable limitdiffs
8905 pack $top.ldiff.b $top.ldiff.l -side left
8906 grid x $top.ldiff -sticky w
8908 label $top.cdisp -text [mc "Colors: press to choose"]
8909 grid $top.cdisp - -sticky w -pady 10
8910 label $top.bg -padx 40 -relief sunk -background $bgcolor
8911 button $top.bgbut -text [mc "Background"] -font optionfont \
8912 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8913 grid x $top.bgbut $top.bg -sticky w
8914 label $top.fg -padx 40 -relief sunk -background $fgcolor
8915 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8916 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8917 grid x $top.fgbut $top.fg -sticky w
8918 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8919 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8920 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8921 [list $ctext tag conf d0 -foreground]]
8922 grid x $top.diffoldbut $top.diffold -sticky w
8923 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8924 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8925 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8926 [list $ctext tag conf d1 -foreground]]
8927 grid x $top.diffnewbut $top.diffnew -sticky w
8928 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8929 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8930 -command [list choosecolor diffcolors 2 $top.hunksep \
8931 "diff hunk header" \
8932 [list $ctext tag conf hunksep -foreground]]
8933 grid x $top.hunksepbut $top.hunksep -sticky w
8934 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8935 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8936 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8937 grid x $top.selbgbut $top.selbgsep -sticky w
8939 label $top.cfont -text [mc "Fonts: press to choose"]
8940 grid $top.cfont - -sticky w -pady 10
8941 mkfontdisp mainfont $top [mc "Main font"]
8942 mkfontdisp textfont $top [mc "Diff display font"]
8943 mkfontdisp uifont $top [mc "User interface font"]
8946 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8947 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8948 grid $top.buts.ok $top.buts.can
8949 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8950 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8951 grid $top.buts - - -pady 10 -sticky ew
8952 bind $top <Visibility> "focus $top.buts.ok"
8955 proc choosecolor {v vi w x cmd} {
8958 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8959 -title [mc "Gitk: choose color for %s" $x]]
8960 if {$c eq {}} return
8961 $w conf -background $c
8967 global bglist cflist
8969 $w configure -selectbackground $c
8971 $cflist tag configure highlight \
8972 -background [$cflist cget -selectbackground]
8973 allcanvs itemconf secsel -fill $c
8980 $w conf -background $c
8988 $w conf -foreground $c
8990 allcanvs itemconf text -fill $c
8991 $canv itemconf circle -outline $c
8995 global oldprefs prefstop
8997 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8998 limitdiffs tabstop} {
9000 set $v $oldprefs($v)
9002 catch {destroy $prefstop}
9008 global maxwidth maxgraphpct
9009 global oldprefs prefstop showneartags showlocalchanges
9010 global fontpref mainfont textfont uifont
9011 global limitdiffs treediffs
9013 catch {destroy $prefstop}
9017 if {$mainfont ne $fontpref(mainfont)} {
9018 set mainfont $fontpref(mainfont)
9019 parsefont mainfont $mainfont
9020 eval font configure mainfont [fontflags mainfont]
9021 eval font configure mainfontbold [fontflags mainfont 1]
9025 if {$textfont ne $fontpref(textfont)} {
9026 set textfont $fontpref(textfont)
9027 parsefont textfont $textfont
9028 eval font configure textfont [fontflags textfont]
9029 eval font configure textfontbold [fontflags textfont 1]
9031 if {$uifont ne $fontpref(uifont)} {
9032 set uifont $fontpref(uifont)
9033 parsefont uifont $uifont
9034 eval font configure uifont [fontflags uifont]
9037 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9038 if {$showlocalchanges} {
9044 if {$limitdiffs != $oldprefs(limitdiffs)} {
9045 # treediffs elements are limited by path
9046 catch {unset treediffs}
9048 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9049 || $maxgraphpct != $oldprefs(maxgraphpct)} {
9051 } elseif {$showneartags != $oldprefs(showneartags) ||
9052 $limitdiffs != $oldprefs(limitdiffs)} {
9057 proc formatdate {d} {
9058 global datetimeformat
9060 set d [clock format $d -format $datetimeformat]
9065 # This list of encoding names and aliases is distilled from
9066 # http://www.iana.org/assignments/character-sets.
9067 # Not all of them are supported by Tcl.
9068 set encoding_aliases {
9069 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9070 ISO646-US US-ASCII us IBM367 cp367 csASCII }
9071 { ISO-10646-UTF-1 csISO10646UTF1 }
9072 { ISO_646.basic:1983 ref csISO646basic1983 }
9073 { INVARIANT csINVARIANT }
9074 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9075 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9076 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9077 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9078 { NATS-DANO iso-ir-9-1 csNATSDANO }
9079 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9080 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9081 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9082 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9083 { ISO-2022-KR csISO2022KR }
9085 { ISO-2022-JP csISO2022JP }
9086 { ISO-2022-JP-2 csISO2022JP2 }
9087 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9089 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9090 { IT iso-ir-15 ISO646-IT csISO15Italian }
9091 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9092 { ES iso-ir-17 ISO646-ES csISO17Spanish }
9093 { greek7-old iso-ir-18 csISO18Greek7Old }
9094 { latin-greek iso-ir-19 csISO19LatinGreek }
9095 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9096 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9097 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9098 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9099 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9100 { BS_viewdata iso-ir-47 csISO47BSViewdata }
9101 { INIS iso-ir-49 csISO49INIS }
9102 { INIS-8 iso-ir-50 csISO50INIS8 }
9103 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9104 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9105 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9106 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9107 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9108 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9110 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9111 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9112 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9113 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9114 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9115 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9116 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9117 { greek7 iso-ir-88 csISO88Greek7 }
9118 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9119 { iso-ir-90 csISO90 }
9120 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9121 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9122 csISO92JISC62991984b }
9123 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9124 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9125 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9126 csISO95JIS62291984handadd }
9127 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9128 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9129 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9130 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9132 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9133 { T.61-7bit iso-ir-102 csISO102T617bit }
9134 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9135 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9136 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9137 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9138 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9139 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9140 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9141 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9142 arabic csISOLatinArabic }
9143 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9144 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9145 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9146 greek greek8 csISOLatinGreek }
9147 { T.101-G2 iso-ir-128 csISO128T101G2 }
9148 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9150 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9151 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9152 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9153 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9154 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9155 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9156 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9157 csISOLatinCyrillic }
9158 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9159 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9160 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9161 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9162 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9163 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9164 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9165 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9166 { ISO_10367-box iso-ir-155 csISO10367Box }
9167 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9168 { latin-lap lap iso-ir-158 csISO158Lap }
9169 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9170 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9173 { JIS_X0201 X0201 csHalfWidthKatakana }
9174 { KSC5636 ISO646-KR csKSC5636 }
9175 { ISO-10646-UCS-2 csUnicode }
9176 { ISO-10646-UCS-4 csUCS4 }
9177 { DEC-MCS dec csDECMCS }
9178 { hp-roman8 roman8 r8 csHPRoman8 }
9179 { macintosh mac csMacintosh }
9180 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9182 { IBM038 EBCDIC-INT cp038 csIBM038 }
9183 { IBM273 CP273 csIBM273 }
9184 { IBM274 EBCDIC-BE CP274 csIBM274 }
9185 { IBM275 EBCDIC-BR cp275 csIBM275 }
9186 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9187 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9188 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9189 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9190 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9191 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9192 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9193 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9194 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9195 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9196 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9197 { IBM437 cp437 437 csPC8CodePage437 }
9198 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9199 { IBM775 cp775 csPC775Baltic }
9200 { IBM850 cp850 850 csPC850Multilingual }
9201 { IBM851 cp851 851 csIBM851 }
9202 { IBM852 cp852 852 csPCp852 }
9203 { IBM855 cp855 855 csIBM855 }
9204 { IBM857 cp857 857 csIBM857 }
9205 { IBM860 cp860 860 csIBM860 }
9206 { IBM861 cp861 861 cp-is csIBM861 }
9207 { IBM862 cp862 862 csPC862LatinHebrew }
9208 { IBM863 cp863 863 csIBM863 }
9209 { IBM864 cp864 csIBM864 }
9210 { IBM865 cp865 865 csIBM865 }
9211 { IBM866 cp866 866 csIBM866 }
9212 { IBM868 CP868 cp-ar csIBM868 }
9213 { IBM869 cp869 869 cp-gr csIBM869 }
9214 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9215 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9216 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9217 { IBM891 cp891 csIBM891 }
9218 { IBM903 cp903 csIBM903 }
9219 { IBM904 cp904 904 csIBBM904 }
9220 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9221 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9222 { IBM1026 CP1026 csIBM1026 }
9223 { EBCDIC-AT-DE csIBMEBCDICATDE }
9224 { EBCDIC-AT-DE-A csEBCDICATDEA }
9225 { EBCDIC-CA-FR csEBCDICCAFR }
9226 { EBCDIC-DK-NO csEBCDICDKNO }
9227 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9228 { EBCDIC-FI-SE csEBCDICFISE }
9229 { EBCDIC-FI-SE-A csEBCDICFISEA }
9230 { EBCDIC-FR csEBCDICFR }
9231 { EBCDIC-IT csEBCDICIT }
9232 { EBCDIC-PT csEBCDICPT }
9233 { EBCDIC-ES csEBCDICES }
9234 { EBCDIC-ES-A csEBCDICESA }
9235 { EBCDIC-ES-S csEBCDICESS }
9236 { EBCDIC-UK csEBCDICUK }
9237 { EBCDIC-US csEBCDICUS }
9238 { UNKNOWN-8BIT csUnknown8BiT }
9239 { MNEMONIC csMnemonic }
9244 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9245 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9246 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9247 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9248 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9249 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9250 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9251 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9252 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9253 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9254 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9255 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9256 { IBM1047 IBM-1047 }
9257 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9258 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9259 { UNICODE-1-1 csUnicode11 }
9262 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9263 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9265 { ISO-8859-15 ISO_8859-15 Latin-9 }
9266 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9267 { GBK CP936 MS936 windows-936 }
9268 { JIS_Encoding csJISEncoding }
9269 { Shift_JIS MS_Kanji csShiftJIS }
9270 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9272 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9273 { ISO-10646-UCS-Basic csUnicodeASCII }
9274 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9275 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9276 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9277 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9278 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9279 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9280 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9281 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9282 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9283 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9284 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9285 { Ventura-US csVenturaUS }
9286 { Ventura-International csVenturaInternational }
9287 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9288 { PC8-Turkish csPC8Turkish }
9289 { IBM-Symbols csIBMSymbols }
9290 { IBM-Thai csIBMThai }
9291 { HP-Legal csHPLegal }
9292 { HP-Pi-font csHPPiFont }
9293 { HP-Math8 csHPMath8 }
9294 { Adobe-Symbol-Encoding csHPPSMath }
9295 { HP-DeskTop csHPDesktop }
9296 { Ventura-Math csVenturaMath }
9297 { Microsoft-Publishing csMicrosoftPublishing }
9298 { Windows-31J csWindows31J }
9303 proc tcl_encoding {enc} {
9304 global encoding_aliases
9305 set names [encoding names]
9306 set lcnames [string tolower $names]
9307 set enc [string tolower $enc]
9308 set i [lsearch -exact $lcnames $enc]
9310 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9311 if {[regsub {^iso[-_]} $enc iso encx]} {
9312 set i [lsearch -exact $lcnames $encx]
9316 foreach l $encoding_aliases {
9317 set ll [string tolower $l]
9318 if {[lsearch -exact $ll $enc] < 0} continue
9319 # look through the aliases for one that tcl knows about
9321 set i [lsearch -exact $lcnames $e]
9323 if {[regsub {^iso[-_]} $e iso ex]} {
9324 set i [lsearch -exact $lcnames $ex]
9333 return [lindex $names $i]
9338 # First check that Tcl/Tk is recent enough
9339 if {[catch {package require Tk 8.4} err]} {
9340 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9341 Gitk requires at least Tcl/Tk 8.4."]
9346 set wrcomcmd "git diff-tree --stdin -p --pretty"
9350 set gitencoding [exec git config --get i18n.commitencoding]
9352 if {$gitencoding == ""} {
9353 set gitencoding "utf-8"
9355 set tclencoding [tcl_encoding $gitencoding]
9356 if {$tclencoding == {}} {
9357 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9360 set mainfont {Helvetica 9}
9361 set textfont {Courier 9}
9362 set uifont {Helvetica 9 bold}
9364 set findmergefiles 0
9372 set cmitmode "patch"
9373 set wrapcomment "none"
9377 set showlocalchanges 1
9379 set datetimeformat "%Y-%m-%d %H:%M:%S"
9382 set colors {green red blue magenta darkgrey brown orange}
9385 set diffcolors {red "#00a000" blue}
9388 set selectbgcolor gray85
9390 ## For msgcat loading, first locate the installation location.
9391 if { [info exists ::env(GITK_MSGSDIR)] } {
9392 ## Msgsdir was manually set in the environment.
9393 set gitk_msgsdir $::env(GITK_MSGSDIR)
9395 ## Let's guess the prefix from argv0.
9396 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9397 set gitk_libdir [file join $gitk_prefix share gitk lib]
9398 set gitk_msgsdir [file join $gitk_libdir msgs]
9402 ## Internationalization (i18n) through msgcat and gettext. See
9403 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9404 package require msgcat
9405 namespace import ::msgcat::mc
9406 ## And eventually load the actual message catalog
9407 ::msgcat::mcload $gitk_msgsdir
9409 catch {source ~/.gitk}
9411 font create optionfont -family sans-serif -size -12
9413 parsefont mainfont $mainfont
9414 eval font create mainfont [fontflags mainfont]
9415 eval font create mainfontbold [fontflags mainfont 1]
9417 parsefont textfont $textfont
9418 eval font create textfont [fontflags textfont]
9419 eval font create textfontbold [fontflags textfont 1]
9421 parsefont uifont $uifont
9422 eval font create uifont [fontflags uifont]
9426 # check that we can find a .git directory somewhere...
9427 if {[catch {set gitdir [gitdir]}]} {
9428 show_error {} . [mc "Cannot find a git repository here."]
9431 if {![file isdirectory $gitdir]} {
9432 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9437 set cmdline_files {}
9439 set revtreeargscmd {}
9441 switch -glob -- $arg {
9444 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9448 set revtreeargscmd [string range $arg 10 end]
9451 lappend revtreeargs $arg
9457 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9458 # no -- on command line, but some arguments (other than --argscmd)
9460 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9461 set cmdline_files [split $f "\n"]
9462 set n [llength $cmdline_files]
9463 set revtreeargs [lrange $revtreeargs 0 end-$n]
9464 # Unfortunately git rev-parse doesn't produce an error when
9465 # something is both a revision and a filename. To be consistent
9466 # with git log and git rev-list, check revtreeargs for filenames.
9467 foreach arg $revtreeargs {
9468 if {[file exists $arg]} {
9469 show_error {} . [mc "Ambiguous argument '%s': both revision\
9475 # unfortunately we get both stdout and stderr in $err,
9476 # so look for "fatal:".
9477 set i [string first "fatal:" $err]
9479 set err [string range $err [expr {$i + 6}] end]
9481 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9486 set nullid "0000000000000000000000000000000000000000"
9487 set nullid2 "0000000000000000000000000000000000000001"
9489 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9496 set highlight_paths {}
9498 set searchdirn -forwards
9502 set markingmatches 0
9503 set linkentercount 0
9504 set need_redisplay 0
9511 set selectedhlview [mc "None"]
9512 set highlight_related [mc "None"]
9513 set highlight_files {}
9517 set viewargscmd(0) {}
9525 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
9528 # wait for the window to become visible
9530 wm title . "[file tail $argv0]: [file tail [pwd]]"
9533 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
9534 # create a view for the files/dirs specified on the command line
9538 set viewname(1) [mc "Command line"]
9539 set viewfiles(1) $cmdline_files
9540 set viewargs(1) $revtreeargs
9541 set viewargscmd(1) $revtreeargscmd
9545 .bar.view entryconf [mc "Edit view..."] -state normal
9546 .bar.view entryconf [mc "Delete view"] -state normal
9549 if {[info exists permviews]} {
9550 foreach v $permviews {
9553 set viewname($n) [lindex $v 0]
9554 set viewfiles($n) [lindex $v 1]
9555 set viewargs($n) [lindex $v 2]
9556 set viewargscmd($n) [lindex $v 3]