gitk: Select head of current branch by default
[git.git] / gitk
blob8b4c61c56320eb15086c948d1a86c836b5648846
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
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.
24 proc run args {
25 global isonrunq runq
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {}} {
30 after idle dorunq
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} {
41 global runq
43 fileevent $fd readable {}
44 if {$runq eq {}} {
45 after idle dorunq
47 lappend runq [list $fd $script]
50 proc nukefile {fd} {
51 global runq
53 for {set i 0} {$i < [llength $runq]} {} {
54 if {[lindex $runq $i 0] eq $fd} {
55 set runq [lreplace $runq $i $i]
56 } else {
57 incr i
62 proc dorunq {} {
63 global isonrunq runq
65 set tstart [clock clicks -milliseconds]
66 set t0 $tstart
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]
79 } else {
80 fileevent $fd readable [list filereadable $fd $script]
82 } elseif {$fd eq {}} {
83 unset isonrunq($script)
85 set t0 $t1
86 if {$t1 - $tstart >= 80} break
88 if {$runq ne {}} {
89 after idle dorunq
93 # Start off a git rev-list process and arrange to read its output
94 proc start_rev_list {view} {
95 global startmsecs
96 global commfd leftover tclencoding datemode
97 global viewargs viewfiles commitidx viewcomplete vnextroot
98 global showlocalchanges commitinterest mainheadid
99 global progressdirn progresscoords proglastnc curview
100 global viewincl viewactive loginstance viewinstances
101 global pending_select mainheadid
103 set startmsecs [clock clicks -milliseconds]
104 set commitidx($view) 0
105 set viewcomplete($view) 0
106 set viewactive($view) 1
107 set vnextroot($view) 0
108 varcinit $view
110 set commits [eval exec git rev-parse --default HEAD --revs-only \
111 $viewargs($view)]
112 set viewincl($view) {}
113 foreach c $commits {
114 if {[regexp {^[0-9a-fA-F]{40}$} $c]} {
115 lappend viewincl($view) $c
118 if {[catch {
119 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
120 --boundary $commits "--" $viewfiles($view)] r]
121 } err]} {
122 error_popup "[mc "Error executing git log:"] $err"
123 exit 1
125 set i [incr loginstance]
126 set viewinstances($view) [list $i]
127 set commfd($i) $fd
128 set leftover($i) {}
129 if {$showlocalchanges} {
130 lappend commitinterest($mainheadid) {dodiffindex}
132 fconfigure $fd -blocking 0 -translation lf -eofchar {}
133 if {$tclencoding != {}} {
134 fconfigure $fd -encoding $tclencoding
136 filerun $fd [list getcommitlines $fd $i $view]
137 nowbusy $view [mc "Reading"]
138 if {$view == $curview} {
139 set progressdirn 1
140 set progresscoords {0 0}
141 set proglastnc 0
142 set pending_select $mainheadid
146 proc stop_rev_list {view} {
147 global commfd viewinstances leftover
149 foreach inst $viewinstances($view) {
150 set fd $commfd($inst)
151 catch {
152 set pid [pid $fd]
153 exec kill $pid
155 catch {close $fd}
156 nukefile $fd
157 unset commfd($inst)
158 unset leftover($inst)
160 set viewinstances($view) {}
163 proc getcommits {} {
164 global canv curview
166 initlayout
167 start_rev_list $curview
168 show_status [mc "Reading commits..."]
171 proc updatecommits {} {
172 global curview viewargs viewfiles viewincl viewinstances
173 global viewactive viewcomplete loginstance tclencoding mainheadid
174 global varcid startmsecs commfd showneartags showlocalchanges leftover
175 global mainheadid pending_select
177 set oldmainid $mainheadid
178 rereadrefs
179 if {$showlocalchanges} {
180 if {$mainheadid ne $oldmainid} {
181 dohidelocalchanges
183 if {[commitinview $mainheadid $curview]} {
184 dodiffindex
187 set view $curview
188 set commits [exec git rev-parse --default HEAD --revs-only \
189 $viewargs($view)]
190 set pos {}
191 set neg {}
192 set flags {}
193 foreach c $commits {
194 if {[string match "^*" $c]} {
195 lappend neg $c
196 } elseif {[regexp {^[0-9a-fA-F]{40}$} $c]} {
197 if {!([info exists varcid($view,$c)] ||
198 [lsearch -exact $viewincl($view) $c] >= 0)} {
199 lappend pos $c
201 } else {
202 lappend flags $c
205 if {$pos eq {}} {
206 return
208 foreach id $viewincl($view) {
209 lappend neg "^$id"
211 set viewincl($view) [concat $viewincl($view) $pos]
212 if {[catch {
213 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
214 --boundary $pos $neg $flags "--" $viewfiles($view)] r]
215 } err]} {
216 error_popup "Error executing git log: $err"
217 exit 1
219 if {$viewactive($view) == 0} {
220 set startmsecs [clock clicks -milliseconds]
222 set i [incr loginstance]
223 lappend viewinstances($view) $i
224 set commfd($i) $fd
225 set leftover($i) {}
226 fconfigure $fd -blocking 0 -translation lf -eofchar {}
227 if {$tclencoding != {}} {
228 fconfigure $fd -encoding $tclencoding
230 filerun $fd [list getcommitlines $fd $i $view]
231 incr viewactive($view)
232 set viewcomplete($view) 0
233 set pending_select $mainheadid
234 nowbusy $view "Reading"
235 if {$showneartags} {
236 getallcommits
240 proc reloadcommits {} {
241 global curview viewcomplete selectedline currentid thickerline
242 global showneartags treediffs commitinterest cached_commitrow
243 global progresscoords targetid
245 if {!$viewcomplete($curview)} {
246 stop_rev_list $curview
247 set progresscoords {0 0}
248 adjustprogress
250 resetvarcs $curview
251 catch {unset selectedline}
252 catch {unset currentid}
253 catch {unset thickerline}
254 catch {unset treediffs}
255 readrefs
256 changedrefs
257 if {$showneartags} {
258 getallcommits
260 clear_display
261 catch {unset commitinterest}
262 catch {unset cached_commitrow}
263 catch {unset targetid}
264 setcanvscroll
265 getcommits
268 # This makes a string representation of a positive integer which
269 # sorts as a string in numerical order
270 proc strrep {n} {
271 if {$n < 16} {
272 return [format "%x" $n]
273 } elseif {$n < 256} {
274 return [format "x%.2x" $n]
275 } elseif {$n < 65536} {
276 return [format "y%.4x" $n]
278 return [format "z%.8x" $n]
281 # Procedures used in reordering commits from git log (without
282 # --topo-order) into the order for display.
284 proc varcinit {view} {
285 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
286 global vtokmod varcmod vrowmod varcix vlastins
288 set varcstart($view) {{}}
289 set vupptr($view) {0}
290 set vdownptr($view) {0}
291 set vleftptr($view) {0}
292 set vbackptr($view) {0}
293 set varctok($view) {{}}
294 set varcrow($view) {{}}
295 set vtokmod($view) {}
296 set varcmod($view) 0
297 set vrowmod($view) 0
298 set varcix($view) {{}}
299 set vlastins($view) {0}
302 proc resetvarcs {view} {
303 global varcid varccommits parents children vseedcount ordertok
305 foreach vid [array names varcid $view,*] {
306 unset varcid($vid)
307 unset children($vid)
308 unset parents($vid)
310 # some commits might have children but haven't been seen yet
311 foreach vid [array names children $view,*] {
312 unset children($vid)
314 foreach va [array names varccommits $view,*] {
315 unset varccommits($va)
317 foreach vd [array names vseedcount $view,*] {
318 unset vseedcount($vd)
320 catch {unset ordertok}
323 proc newvarc {view id} {
324 global varcid varctok parents children datemode
325 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
326 global commitdata commitinfo vseedcount varccommits vlastins
328 set a [llength $varctok($view)]
329 set vid $view,$id
330 if {[llength $children($vid)] == 0 || $datemode} {
331 if {![info exists commitinfo($id)]} {
332 parsecommit $id $commitdata($id) 1
334 set cdate [lindex $commitinfo($id) 4]
335 if {![string is integer -strict $cdate]} {
336 set cdate 0
338 if {![info exists vseedcount($view,$cdate)]} {
339 set vseedcount($view,$cdate) -1
341 set c [incr vseedcount($view,$cdate)]
342 set cdate [expr {$cdate ^ 0xffffffff}]
343 set tok "s[strrep $cdate][strrep $c]"
344 } else {
345 set tok {}
347 set ka 0
348 if {[llength $children($vid)] > 0} {
349 set kid [lindex $children($vid) end]
350 set k $varcid($view,$kid)
351 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
352 set ki $kid
353 set ka $k
354 set tok [lindex $varctok($view) $k]
357 if {$ka != 0} {
358 set i [lsearch -exact $parents($view,$ki) $id]
359 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
360 append tok [strrep $j]
362 set c [lindex $vlastins($view) $ka]
363 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
364 set c $ka
365 set b [lindex $vdownptr($view) $ka]
366 } else {
367 set b [lindex $vleftptr($view) $c]
369 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
370 set c $b
371 set b [lindex $vleftptr($view) $c]
373 if {$c == $ka} {
374 lset vdownptr($view) $ka $a
375 lappend vbackptr($view) 0
376 } else {
377 lset vleftptr($view) $c $a
378 lappend vbackptr($view) $c
380 lset vlastins($view) $ka $a
381 lappend vupptr($view) $ka
382 lappend vleftptr($view) $b
383 if {$b != 0} {
384 lset vbackptr($view) $b $a
386 lappend varctok($view) $tok
387 lappend varcstart($view) $id
388 lappend vdownptr($view) 0
389 lappend varcrow($view) {}
390 lappend varcix($view) {}
391 set varccommits($view,$a) {}
392 lappend vlastins($view) 0
393 return $a
396 proc splitvarc {p v} {
397 global varcid varcstart varccommits varctok
398 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
400 set oa $varcid($v,$p)
401 set ac $varccommits($v,$oa)
402 set i [lsearch -exact $varccommits($v,$oa) $p]
403 if {$i <= 0} return
404 set na [llength $varctok($v)]
405 # "%" sorts before "0"...
406 set tok "[lindex $varctok($v) $oa]%[strrep $i]"
407 lappend varctok($v) $tok
408 lappend varcrow($v) {}
409 lappend varcix($v) {}
410 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
411 set varccommits($v,$na) [lrange $ac $i end]
412 lappend varcstart($v) $p
413 foreach id $varccommits($v,$na) {
414 set varcid($v,$id) $na
416 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
417 lset vdownptr($v) $oa $na
418 lappend vupptr($v) $oa
419 lappend vleftptr($v) 0
420 lappend vbackptr($v) 0
421 lappend vlastins($v) 0
422 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
423 lset vupptr($v) $b $na
427 proc renumbervarc {a v} {
428 global parents children varctok varcstart varccommits
429 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
431 set t1 [clock clicks -milliseconds]
432 set todo {}
433 set isrelated($a) 1
434 set kidchanged($a) 1
435 set ntot 0
436 while {$a != 0} {
437 if {[info exists isrelated($a)]} {
438 lappend todo $a
439 set id [lindex $varccommits($v,$a) end]
440 foreach p $parents($v,$id) {
441 if {[info exists varcid($v,$p)]} {
442 set isrelated($varcid($v,$p)) 1
446 incr ntot
447 set b [lindex $vdownptr($v) $a]
448 if {$b == 0} {
449 while {$a != 0} {
450 set b [lindex $vleftptr($v) $a]
451 if {$b != 0} break
452 set a [lindex $vupptr($v) $a]
455 set a $b
457 foreach a $todo {
458 if {![info exists kidchanged($a)]} continue
459 set id [lindex $varcstart($v) $a]
460 if {[llength $children($v,$id)] > 1} {
461 set children($v,$id) [lsort -command [list vtokcmp $v] \
462 $children($v,$id)]
464 set oldtok [lindex $varctok($v) $a]
465 if {!$datemode} {
466 set tok {}
467 } else {
468 set tok $oldtok
470 set ka 0
471 set kid [last_real_child $v,$id]
472 if {$kid ne {}} {
473 set k $varcid($v,$kid)
474 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
475 set ki $kid
476 set ka $k
477 set tok [lindex $varctok($v) $k]
480 if {$ka != 0} {
481 set i [lsearch -exact $parents($v,$ki) $id]
482 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
483 append tok [strrep $j]
485 if {$tok eq $oldtok} {
486 continue
488 set id [lindex $varccommits($v,$a) end]
489 foreach p $parents($v,$id) {
490 if {[info exists varcid($v,$p)]} {
491 set kidchanged($varcid($v,$p)) 1
492 } else {
493 set sortkids($p) 1
496 lset varctok($v) $a $tok
497 set b [lindex $vupptr($v) $a]
498 if {$b != $ka} {
499 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
500 modify_arc $v $ka
502 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
503 modify_arc $v $b
505 set c [lindex $vbackptr($v) $a]
506 set d [lindex $vleftptr($v) $a]
507 if {$c == 0} {
508 lset vdownptr($v) $b $d
509 } else {
510 lset vleftptr($v) $c $d
512 if {$d != 0} {
513 lset vbackptr($v) $d $c
515 lset vupptr($v) $a $ka
516 set c [lindex $vlastins($v) $ka]
517 if {$c == 0 || \
518 [string compare $tok [lindex $varctok($v) $c]] < 0} {
519 set c $ka
520 set b [lindex $vdownptr($v) $ka]
521 } else {
522 set b [lindex $vleftptr($v) $c]
524 while {$b != 0 && \
525 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
526 set c $b
527 set b [lindex $vleftptr($v) $c]
529 if {$c == $ka} {
530 lset vdownptr($v) $ka $a
531 lset vbackptr($v) $a 0
532 } else {
533 lset vleftptr($v) $c $a
534 lset vbackptr($v) $a $c
536 lset vleftptr($v) $a $b
537 if {$b != 0} {
538 lset vbackptr($v) $b $a
540 lset vlastins($v) $ka $a
543 foreach id [array names sortkids] {
544 if {[llength $children($v,$id)] > 1} {
545 set children($v,$id) [lsort -command [list vtokcmp $v] \
546 $children($v,$id)]
549 set t2 [clock clicks -milliseconds]
550 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
553 proc fix_reversal {p a v} {
554 global varcid varcstart varctok vupptr
556 set pa $varcid($v,$p)
557 if {$p ne [lindex $varcstart($v) $pa]} {
558 splitvarc $p $v
559 set pa $varcid($v,$p)
561 # seeds always need to be renumbered
562 if {[lindex $vupptr($v) $pa] == 0 ||
563 [string compare [lindex $varctok($v) $a] \
564 [lindex $varctok($v) $pa]] > 0} {
565 renumbervarc $pa $v
569 proc insertrow {id p v} {
570 global varcid varccommits parents children cmitlisted
571 global commitidx varctok vtokmod targetid targetrow
573 set a $varcid($v,$p)
574 set i [lsearch -exact $varccommits($v,$a) $p]
575 if {$i < 0} {
576 puts "oops: insertrow can't find [shortids $p] on arc $a"
577 return
579 set children($v,$id) {}
580 set parents($v,$id) [list $p]
581 set varcid($v,$id) $a
582 lappend children($v,$p) $id
583 set cmitlisted($v,$id) 1
584 incr commitidx($v)
585 # note we deliberately don't update varcstart($v) even if $i == 0
586 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
587 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
588 modify_arc $v $a $i
590 if {[info exists targetid]} {
591 if {![comes_before $targetid $p]} {
592 incr targetrow
595 drawvisible
598 proc removerow {id v} {
599 global varcid varccommits parents children commitidx
600 global varctok vtokmod cmitlisted currentid selectedline
601 global targetid
603 if {[llength $parents($v,$id)] != 1} {
604 puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
605 return
607 set p [lindex $parents($v,$id) 0]
608 set a $varcid($v,$id)
609 set i [lsearch -exact $varccommits($v,$a) $id]
610 if {$i < 0} {
611 puts "oops: removerow can't find [shortids $id] on arc $a"
612 return
614 unset varcid($v,$id)
615 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
616 unset parents($v,$id)
617 unset children($v,$id)
618 unset cmitlisted($v,$id)
619 incr commitidx($v) -1
620 set j [lsearch -exact $children($v,$p) $id]
621 if {$j >= 0} {
622 set children($v,$p) [lreplace $children($v,$p) $j $j]
624 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
625 modify_arc $v $a $i
627 if {[info exist currentid] && $id eq $currentid} {
628 unset currentid
629 unset selectedline
631 if {[info exists targetid] && $targetid eq $id} {
632 set targetid $p
634 drawvisible
637 proc first_real_child {vp} {
638 global children nullid nullid2
640 foreach id $children($vp) {
641 if {$id ne $nullid && $id ne $nullid2} {
642 return $id
645 return {}
648 proc last_real_child {vp} {
649 global children nullid nullid2
651 set kids $children($vp)
652 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
653 set id [lindex $kids $i]
654 if {$id ne $nullid && $id ne $nullid2} {
655 return $id
658 return {}
661 proc vtokcmp {v a b} {
662 global varctok varcid
664 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
665 [lindex $varctok($v) $varcid($v,$b)]]
668 proc modify_arc {v a {lim {}}} {
669 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
671 set vtokmod($v) [lindex $varctok($v) $a]
672 set varcmod($v) $a
673 if {$v == $curview} {
674 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
675 set a [lindex $vupptr($v) $a]
676 set lim {}
678 set r 0
679 if {$a != 0} {
680 if {$lim eq {}} {
681 set lim [llength $varccommits($v,$a)]
683 set r [expr {[lindex $varcrow($v) $a] + $lim}]
685 set vrowmod($v) $r
686 undolayout $r
690 proc update_arcrows {v} {
691 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
692 global varcid vrownum varcorder varcix varccommits
693 global vupptr vdownptr vleftptr varctok
694 global displayorder parentlist curview cached_commitrow
696 set narctot [expr {[llength $varctok($v)] - 1}]
697 set a $varcmod($v)
698 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
699 # go up the tree until we find something that has a row number,
700 # or we get to a seed
701 set a [lindex $vupptr($v) $a]
703 if {$a == 0} {
704 set a [lindex $vdownptr($v) 0]
705 if {$a == 0} return
706 set vrownum($v) {0}
707 set varcorder($v) [list $a]
708 lset varcix($v) $a 0
709 lset varcrow($v) $a 0
710 set arcn 0
711 set row 0
712 } else {
713 set arcn [lindex $varcix($v) $a]
714 # see if a is the last arc; if so, nothing to do
715 if {$arcn == $narctot - 1} {
716 return
718 if {[llength $vrownum($v)] > $arcn + 1} {
719 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
720 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
722 set row [lindex $varcrow($v) $a]
724 if {$v == $curview} {
725 if {[llength $displayorder] > $vrowmod($v)} {
726 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
727 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
729 catch {unset cached_commitrow}
731 while {1} {
732 set p $a
733 incr row [llength $varccommits($v,$a)]
734 # go down if possible
735 set b [lindex $vdownptr($v) $a]
736 if {$b == 0} {
737 # if not, go left, or go up until we can go left
738 while {$a != 0} {
739 set b [lindex $vleftptr($v) $a]
740 if {$b != 0} break
741 set a [lindex $vupptr($v) $a]
743 if {$a == 0} break
745 set a $b
746 incr arcn
747 lappend vrownum($v) $row
748 lappend varcorder($v) $a
749 lset varcix($v) $a $arcn
750 lset varcrow($v) $a $row
752 set vtokmod($v) [lindex $varctok($v) $p]
753 set varcmod($v) $p
754 set vrowmod($v) $row
755 if {[info exists currentid]} {
756 set selectedline [rowofcommit $currentid]
760 # Test whether view $v contains commit $id
761 proc commitinview {id v} {
762 global varcid
764 return [info exists varcid($v,$id)]
767 # Return the row number for commit $id in the current view
768 proc rowofcommit {id} {
769 global varcid varccommits varcrow curview cached_commitrow
770 global varctok vtokmod
772 set v $curview
773 if {![info exists varcid($v,$id)]} {
774 puts "oops rowofcommit no arc for [shortids $id]"
775 return {}
777 set a $varcid($v,$id)
778 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
779 update_arcrows $v
781 if {[info exists cached_commitrow($id)]} {
782 return $cached_commitrow($id)
784 set i [lsearch -exact $varccommits($v,$a) $id]
785 if {$i < 0} {
786 puts "oops didn't find commit [shortids $id] in arc $a"
787 return {}
789 incr i [lindex $varcrow($v) $a]
790 set cached_commitrow($id) $i
791 return $i
794 # Returns 1 if a is on an earlier row than b, otherwise 0
795 proc comes_before {a b} {
796 global varcid varctok curview
798 set v $curview
799 if {$a eq $b || ![info exists varcid($v,$a)] || \
800 ![info exists varcid($v,$b)]} {
801 return 0
803 if {$varcid($v,$a) != $varcid($v,$b)} {
804 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
805 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
807 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
810 proc bsearch {l elt} {
811 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
812 return 0
814 set lo 0
815 set hi [llength $l]
816 while {$hi - $lo > 1} {
817 set mid [expr {int(($lo + $hi) / 2)}]
818 set t [lindex $l $mid]
819 if {$elt < $t} {
820 set hi $mid
821 } elseif {$elt > $t} {
822 set lo $mid
823 } else {
824 return $mid
827 return $lo
830 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
831 proc make_disporder {start end} {
832 global vrownum curview commitidx displayorder parentlist
833 global varccommits varcorder parents vrowmod varcrow
834 global d_valid_start d_valid_end
836 if {$end > $vrowmod($curview)} {
837 update_arcrows $curview
839 set ai [bsearch $vrownum($curview) $start]
840 set start [lindex $vrownum($curview) $ai]
841 set narc [llength $vrownum($curview)]
842 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
843 set a [lindex $varcorder($curview) $ai]
844 set l [llength $displayorder]
845 set al [llength $varccommits($curview,$a)]
846 if {$l < $r + $al} {
847 if {$l < $r} {
848 set pad [ntimes [expr {$r - $l}] {}]
849 set displayorder [concat $displayorder $pad]
850 set parentlist [concat $parentlist $pad]
851 } elseif {$l > $r} {
852 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
853 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
855 foreach id $varccommits($curview,$a) {
856 lappend displayorder $id
857 lappend parentlist $parents($curview,$id)
859 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
860 set i $r
861 foreach id $varccommits($curview,$a) {
862 lset displayorder $i $id
863 lset parentlist $i $parents($curview,$id)
864 incr i
867 incr r $al
871 proc commitonrow {row} {
872 global displayorder
874 set id [lindex $displayorder $row]
875 if {$id eq {}} {
876 make_disporder $row [expr {$row + 1}]
877 set id [lindex $displayorder $row]
879 return $id
882 proc closevarcs {v} {
883 global varctok varccommits varcid parents children
884 global cmitlisted commitidx commitinterest vtokmod
886 set missing_parents 0
887 set scripts {}
888 set narcs [llength $varctok($v)]
889 for {set a 1} {$a < $narcs} {incr a} {
890 set id [lindex $varccommits($v,$a) end]
891 foreach p $parents($v,$id) {
892 if {[info exists varcid($v,$p)]} continue
893 # add p as a new commit
894 incr missing_parents
895 set cmitlisted($v,$p) 0
896 set parents($v,$p) {}
897 if {[llength $children($v,$p)] == 1 &&
898 [llength $parents($v,$id)] == 1} {
899 set b $a
900 } else {
901 set b [newvarc $v $p]
903 set varcid($v,$p) $b
904 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
905 modify_arc $v $b
907 lappend varccommits($v,$b) $p
908 incr commitidx($v)
909 if {[info exists commitinterest($p)]} {
910 foreach script $commitinterest($p) {
911 lappend scripts [string map [list "%I" $p] $script]
913 unset commitinterest($id)
917 if {$missing_parents > 0} {
918 foreach s $scripts {
919 eval $s
924 proc getcommitlines {fd inst view} {
925 global cmitlisted commitinterest leftover
926 global commitidx commitdata datemode
927 global parents children curview hlview
928 global vnextroot idpending ordertok
929 global varccommits varcid varctok vtokmod
931 set stuff [read $fd 500000]
932 # git log doesn't terminate the last commit with a null...
933 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
934 set stuff "\0"
936 if {$stuff == {}} {
937 if {![eof $fd]} {
938 return 1
940 global commfd viewcomplete viewactive viewname progresscoords
941 global viewinstances
942 unset commfd($inst)
943 set i [lsearch -exact $viewinstances($view) $inst]
944 if {$i >= 0} {
945 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
947 # set it blocking so we wait for the process to terminate
948 fconfigure $fd -blocking 1
949 if {[catch {close $fd} err]} {
950 set fv {}
951 if {$view != $curview} {
952 set fv " for the \"$viewname($view)\" view"
954 if {[string range $err 0 4] == "usage"} {
955 set err "Gitk: error reading commits$fv:\
956 bad arguments to git rev-list."
957 if {$viewname($view) eq "Command line"} {
958 append err \
959 " (Note: arguments to gitk are passed to git rev-list\
960 to allow selection of commits to be displayed.)"
962 } else {
963 set err "Error reading commits$fv: $err"
965 error_popup $err
967 if {[incr viewactive($view) -1] <= 0} {
968 set viewcomplete($view) 1
969 # Check if we have seen any ids listed as parents that haven't
970 # appeared in the list
971 closevarcs $view
972 notbusy $view
973 set progresscoords {0 0}
974 adjustprogress
976 if {$view == $curview} {
977 run chewcommits $view
979 return 0
981 set start 0
982 set gotsome 0
983 set scripts {}
984 while 1 {
985 set i [string first "\0" $stuff $start]
986 if {$i < 0} {
987 append leftover($inst) [string range $stuff $start end]
988 break
990 if {$start == 0} {
991 set cmit $leftover($inst)
992 append cmit [string range $stuff 0 [expr {$i - 1}]]
993 set leftover($inst) {}
994 } else {
995 set cmit [string range $stuff $start [expr {$i - 1}]]
997 set start [expr {$i + 1}]
998 set j [string first "\n" $cmit]
999 set ok 0
1000 set listed 1
1001 if {$j >= 0 && [string match "commit *" $cmit]} {
1002 set ids [string range $cmit 7 [expr {$j - 1}]]
1003 if {[string match {[-<>]*} $ids]} {
1004 switch -- [string index $ids 0] {
1005 "-" {set listed 0}
1006 "<" {set listed 2}
1007 ">" {set listed 3}
1009 set ids [string range $ids 1 end]
1011 set ok 1
1012 foreach id $ids {
1013 if {[string length $id] != 40} {
1014 set ok 0
1015 break
1019 if {!$ok} {
1020 set shortcmit $cmit
1021 if {[string length $shortcmit] > 80} {
1022 set shortcmit "[string range $shortcmit 0 80]..."
1024 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1025 exit 1
1027 set id [lindex $ids 0]
1028 set vid $view,$id
1029 if {!$listed && [info exists parents($vid)]} continue
1030 if {$listed} {
1031 set olds [lrange $ids 1 end]
1032 } else {
1033 set olds {}
1035 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1036 set cmitlisted($vid) $listed
1037 set parents($vid) $olds
1038 set a 0
1039 if {![info exists children($vid)]} {
1040 set children($vid) {}
1041 } elseif {[llength $children($vid)] == 1} {
1042 set k [lindex $children($vid) 0]
1043 if {[llength $parents($view,$k)] == 1 &&
1044 (!$datemode ||
1045 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1046 set a $varcid($view,$k)
1049 if {$a == 0} {
1050 # new arc
1051 set a [newvarc $view $id]
1053 set varcid($vid) $a
1054 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1055 modify_arc $view $a
1057 lappend varccommits($view,$a) $id
1059 set i 0
1060 foreach p $olds {
1061 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1062 set vp $view,$p
1063 if {[llength [lappend children($vp) $id]] > 1 &&
1064 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1065 set children($vp) [lsort -command [list vtokcmp $view] \
1066 $children($vp)]
1067 catch {unset ordertok}
1069 if {[info exists varcid($view,$p)]} {
1070 fix_reversal $p $a $view
1073 incr i
1076 incr commitidx($view)
1077 if {[info exists commitinterest($id)]} {
1078 foreach script $commitinterest($id) {
1079 lappend scripts [string map [list "%I" $id] $script]
1081 unset commitinterest($id)
1083 set gotsome 1
1085 if {$gotsome} {
1086 run chewcommits $view
1087 foreach s $scripts {
1088 eval $s
1090 if {$view == $curview} {
1091 # update progress bar
1092 global progressdirn progresscoords proglastnc
1093 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1094 set proglastnc $commitidx($view)
1095 set l [lindex $progresscoords 0]
1096 set r [lindex $progresscoords 1]
1097 if {$progressdirn} {
1098 set r [expr {$r + $inc}]
1099 if {$r >= 1.0} {
1100 set r 1.0
1101 set progressdirn 0
1103 if {$r > 0.2} {
1104 set l [expr {$r - 0.2}]
1106 } else {
1107 set l [expr {$l - $inc}]
1108 if {$l <= 0.0} {
1109 set l 0.0
1110 set progressdirn 1
1112 set r [expr {$l + 0.2}]
1114 set progresscoords [list $l $r]
1115 adjustprogress
1118 return 2
1121 proc chewcommits {view} {
1122 global curview hlview viewcomplete
1123 global pending_select
1125 if {$view == $curview} {
1126 layoutmore
1127 if {$viewcomplete($view)} {
1128 global commitidx varctok
1129 global numcommits startmsecs
1130 global mainheadid commitinfo nullid
1132 if {[info exists pending_select]} {
1133 set row [first_real_row]
1134 selectline $row 1
1136 if {$commitidx($curview) > 0} {
1137 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1138 #puts "overall $ms ms for $numcommits commits"
1139 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1140 } else {
1141 show_status [mc "No commits selected"]
1143 notbusy layout
1146 if {[info exists hlview] && $view == $hlview} {
1147 vhighlightmore
1149 return 0
1152 proc readcommit {id} {
1153 if {[catch {set contents [exec git cat-file commit $id]}]} return
1154 parsecommit $id $contents 0
1157 proc parsecommit {id contents listed} {
1158 global commitinfo cdate
1160 set inhdr 1
1161 set comment {}
1162 set headline {}
1163 set auname {}
1164 set audate {}
1165 set comname {}
1166 set comdate {}
1167 set hdrend [string first "\n\n" $contents]
1168 if {$hdrend < 0} {
1169 # should never happen...
1170 set hdrend [string length $contents]
1172 set header [string range $contents 0 [expr {$hdrend - 1}]]
1173 set comment [string range $contents [expr {$hdrend + 2}] end]
1174 foreach line [split $header "\n"] {
1175 set tag [lindex $line 0]
1176 if {$tag == "author"} {
1177 set audate [lindex $line end-1]
1178 set auname [lrange $line 1 end-2]
1179 } elseif {$tag == "committer"} {
1180 set comdate [lindex $line end-1]
1181 set comname [lrange $line 1 end-2]
1184 set headline {}
1185 # take the first non-blank line of the comment as the headline
1186 set headline [string trimleft $comment]
1187 set i [string first "\n" $headline]
1188 if {$i >= 0} {
1189 set headline [string range $headline 0 $i]
1191 set headline [string trimright $headline]
1192 set i [string first "\r" $headline]
1193 if {$i >= 0} {
1194 set headline [string trimright [string range $headline 0 $i]]
1196 if {!$listed} {
1197 # git rev-list indents the comment by 4 spaces;
1198 # if we got this via git cat-file, add the indentation
1199 set newcomment {}
1200 foreach line [split $comment "\n"] {
1201 append newcomment " "
1202 append newcomment $line
1203 append newcomment "\n"
1205 set comment $newcomment
1207 if {$comdate != {}} {
1208 set cdate($id) $comdate
1210 set commitinfo($id) [list $headline $auname $audate \
1211 $comname $comdate $comment]
1214 proc getcommit {id} {
1215 global commitdata commitinfo
1217 if {[info exists commitdata($id)]} {
1218 parsecommit $id $commitdata($id) 1
1219 } else {
1220 readcommit $id
1221 if {![info exists commitinfo($id)]} {
1222 set commitinfo($id) [list [mc "No commit information available"]]
1225 return 1
1228 proc readrefs {} {
1229 global tagids idtags headids idheads tagobjid
1230 global otherrefids idotherrefs mainhead mainheadid
1232 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1233 catch {unset $v}
1235 set refd [open [list | git show-ref -d] r]
1236 while {[gets $refd line] >= 0} {
1237 if {[string index $line 40] ne " "} continue
1238 set id [string range $line 0 39]
1239 set ref [string range $line 41 end]
1240 if {![string match "refs/*" $ref]} continue
1241 set name [string range $ref 5 end]
1242 if {[string match "remotes/*" $name]} {
1243 if {![string match "*/HEAD" $name]} {
1244 set headids($name) $id
1245 lappend idheads($id) $name
1247 } elseif {[string match "heads/*" $name]} {
1248 set name [string range $name 6 end]
1249 set headids($name) $id
1250 lappend idheads($id) $name
1251 } elseif {[string match "tags/*" $name]} {
1252 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1253 # which is what we want since the former is the commit ID
1254 set name [string range $name 5 end]
1255 if {[string match "*^{}" $name]} {
1256 set name [string range $name 0 end-3]
1257 } else {
1258 set tagobjid($name) $id
1260 set tagids($name) $id
1261 lappend idtags($id) $name
1262 } else {
1263 set otherrefids($name) $id
1264 lappend idotherrefs($id) $name
1267 catch {close $refd}
1268 set mainhead {}
1269 set mainheadid {}
1270 catch {
1271 set thehead [exec git symbolic-ref HEAD]
1272 if {[string match "refs/heads/*" $thehead]} {
1273 set mainhead [string range $thehead 11 end]
1274 if {[info exists headids($mainhead)]} {
1275 set mainheadid $headids($mainhead)
1281 # skip over fake commits
1282 proc first_real_row {} {
1283 global nullid nullid2 numcommits
1285 for {set row 0} {$row < $numcommits} {incr row} {
1286 set id [commitonrow $row]
1287 if {$id ne $nullid && $id ne $nullid2} {
1288 break
1291 return $row
1294 # update things for a head moved to a child of its previous location
1295 proc movehead {id name} {
1296 global headids idheads
1298 removehead $headids($name) $name
1299 set headids($name) $id
1300 lappend idheads($id) $name
1303 # update things when a head has been removed
1304 proc removehead {id name} {
1305 global headids idheads
1307 if {$idheads($id) eq $name} {
1308 unset idheads($id)
1309 } else {
1310 set i [lsearch -exact $idheads($id) $name]
1311 if {$i >= 0} {
1312 set idheads($id) [lreplace $idheads($id) $i $i]
1315 unset headids($name)
1318 proc show_error {w top msg} {
1319 message $w.m -text $msg -justify center -aspect 400
1320 pack $w.m -side top -fill x -padx 20 -pady 20
1321 button $w.ok -text [mc OK] -command "destroy $top"
1322 pack $w.ok -side bottom -fill x
1323 bind $top <Visibility> "grab $top; focus $top"
1324 bind $top <Key-Return> "destroy $top"
1325 tkwait window $top
1328 proc error_popup msg {
1329 set w .error
1330 toplevel $w
1331 wm transient $w .
1332 show_error $w $w $msg
1335 proc confirm_popup msg {
1336 global confirm_ok
1337 set confirm_ok 0
1338 set w .confirm
1339 toplevel $w
1340 wm transient $w .
1341 message $w.m -text $msg -justify center -aspect 400
1342 pack $w.m -side top -fill x -padx 20 -pady 20
1343 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1344 pack $w.ok -side left -fill x
1345 button $w.cancel -text [mc Cancel] -command "destroy $w"
1346 pack $w.cancel -side right -fill x
1347 bind $w <Visibility> "grab $w; focus $w"
1348 tkwait window $w
1349 return $confirm_ok
1352 proc setoptions {} {
1353 option add *Panedwindow.showHandle 1 startupFile
1354 option add *Panedwindow.sashRelief raised startupFile
1355 option add *Button.font uifont startupFile
1356 option add *Checkbutton.font uifont startupFile
1357 option add *Radiobutton.font uifont startupFile
1358 option add *Menu.font uifont startupFile
1359 option add *Menubutton.font uifont startupFile
1360 option add *Label.font uifont startupFile
1361 option add *Message.font uifont startupFile
1362 option add *Entry.font uifont startupFile
1365 proc makewindow {} {
1366 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1367 global tabstop
1368 global findtype findtypemenu findloc findstring fstring geometry
1369 global entries sha1entry sha1string sha1but
1370 global diffcontextstring diffcontext
1371 global maincursor textcursor curtextcursor
1372 global rowctxmenu fakerowmenu mergemax wrapcomment
1373 global highlight_files gdttype
1374 global searchstring sstring
1375 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1376 global headctxmenu progresscanv progressitem progresscoords statusw
1377 global fprogitem fprogcoord lastprogupdate progupdatepending
1378 global rprogitem rprogcoord
1379 global have_tk85
1381 menu .bar
1382 .bar add cascade -label [mc "File"] -menu .bar.file
1383 menu .bar.file
1384 .bar.file add command -label [mc "Update"] -command updatecommits
1385 .bar.file add command -label [mc "Reload"] -command reloadcommits
1386 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1387 .bar.file add command -label [mc "List references"] -command showrefs
1388 .bar.file add command -label [mc "Quit"] -command doquit
1389 menu .bar.edit
1390 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1391 .bar.edit add command -label [mc "Preferences"] -command doprefs
1393 menu .bar.view
1394 .bar add cascade -label [mc "View"] -menu .bar.view
1395 .bar.view add command -label [mc "New view..."] -command {newview 0}
1396 .bar.view add command -label [mc "Edit view..."] -command editview \
1397 -state disabled
1398 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
1399 .bar.view add separator
1400 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
1401 -variable selectedview -value 0
1403 menu .bar.help
1404 .bar add cascade -label [mc "Help"] -menu .bar.help
1405 .bar.help add command -label [mc "About gitk"] -command about
1406 .bar.help add command -label [mc "Key bindings"] -command keys
1407 .bar.help configure
1408 . configure -menu .bar
1410 # the gui has upper and lower half, parts of a paned window.
1411 panedwindow .ctop -orient vertical
1413 # possibly use assumed geometry
1414 if {![info exists geometry(pwsash0)]} {
1415 set geometry(topheight) [expr {15 * $linespc}]
1416 set geometry(topwidth) [expr {80 * $charspc}]
1417 set geometry(botheight) [expr {15 * $linespc}]
1418 set geometry(botwidth) [expr {50 * $charspc}]
1419 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1420 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1423 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1424 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1425 frame .tf.histframe
1426 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1428 # create three canvases
1429 set cscroll .tf.histframe.csb
1430 set canv .tf.histframe.pwclist.canv
1431 canvas $canv \
1432 -selectbackground $selectbgcolor \
1433 -background $bgcolor -bd 0 \
1434 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1435 .tf.histframe.pwclist add $canv
1436 set canv2 .tf.histframe.pwclist.canv2
1437 canvas $canv2 \
1438 -selectbackground $selectbgcolor \
1439 -background $bgcolor -bd 0 -yscrollincr $linespc
1440 .tf.histframe.pwclist add $canv2
1441 set canv3 .tf.histframe.pwclist.canv3
1442 canvas $canv3 \
1443 -selectbackground $selectbgcolor \
1444 -background $bgcolor -bd 0 -yscrollincr $linespc
1445 .tf.histframe.pwclist add $canv3
1446 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1447 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1449 # a scroll bar to rule them
1450 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1451 pack $cscroll -side right -fill y
1452 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1453 lappend bglist $canv $canv2 $canv3
1454 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1456 # we have two button bars at bottom of top frame. Bar 1
1457 frame .tf.bar
1458 frame .tf.lbar -height 15
1460 set sha1entry .tf.bar.sha1
1461 set entries $sha1entry
1462 set sha1but .tf.bar.sha1label
1463 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1464 -command gotocommit -width 8
1465 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1466 pack .tf.bar.sha1label -side left
1467 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1468 trace add variable sha1string write sha1change
1469 pack $sha1entry -side left -pady 2
1471 image create bitmap bm-left -data {
1472 #define left_width 16
1473 #define left_height 16
1474 static unsigned char left_bits[] = {
1475 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1476 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1477 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1479 image create bitmap bm-right -data {
1480 #define right_width 16
1481 #define right_height 16
1482 static unsigned char right_bits[] = {
1483 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1484 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1485 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1487 button .tf.bar.leftbut -image bm-left -command goback \
1488 -state disabled -width 26
1489 pack .tf.bar.leftbut -side left -fill y
1490 button .tf.bar.rightbut -image bm-right -command goforw \
1491 -state disabled -width 26
1492 pack .tf.bar.rightbut -side left -fill y
1494 # Status label and progress bar
1495 set statusw .tf.bar.status
1496 label $statusw -width 15 -relief sunken
1497 pack $statusw -side left -padx 5
1498 set h [expr {[font metrics uifont -linespace] + 2}]
1499 set progresscanv .tf.bar.progress
1500 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1501 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1502 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1503 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1504 pack $progresscanv -side right -expand 1 -fill x
1505 set progresscoords {0 0}
1506 set fprogcoord 0
1507 set rprogcoord 0
1508 bind $progresscanv <Configure> adjustprogress
1509 set lastprogupdate [clock clicks -milliseconds]
1510 set progupdatepending 0
1512 # build up the bottom bar of upper window
1513 label .tf.lbar.flabel -text "[mc "Find"] "
1514 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1515 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1516 label .tf.lbar.flab2 -text " [mc "commit"] "
1517 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1518 -side left -fill y
1519 set gdttype [mc "containing:"]
1520 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1521 [mc "containing:"] \
1522 [mc "touching paths:"] \
1523 [mc "adding/removing string:"]]
1524 trace add variable gdttype write gdttype_change
1525 pack .tf.lbar.gdttype -side left -fill y
1527 set findstring {}
1528 set fstring .tf.lbar.findstring
1529 lappend entries $fstring
1530 entry $fstring -width 30 -font textfont -textvariable findstring
1531 trace add variable findstring write find_change
1532 set findtype [mc "Exact"]
1533 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1534 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
1535 trace add variable findtype write findcom_change
1536 set findloc [mc "All fields"]
1537 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1538 [mc "Comments"] [mc "Author"] [mc "Committer"]
1539 trace add variable findloc write find_change
1540 pack .tf.lbar.findloc -side right
1541 pack .tf.lbar.findtype -side right
1542 pack $fstring -side left -expand 1 -fill x
1544 # Finish putting the upper half of the viewer together
1545 pack .tf.lbar -in .tf -side bottom -fill x
1546 pack .tf.bar -in .tf -side bottom -fill x
1547 pack .tf.histframe -fill both -side top -expand 1
1548 .ctop add .tf
1549 .ctop paneconfigure .tf -height $geometry(topheight)
1550 .ctop paneconfigure .tf -width $geometry(topwidth)
1552 # now build up the bottom
1553 panedwindow .pwbottom -orient horizontal
1555 # lower left, a text box over search bar, scroll bar to the right
1556 # if we know window height, then that will set the lower text height, otherwise
1557 # we set lower text height which will drive window height
1558 if {[info exists geometry(main)]} {
1559 frame .bleft -width $geometry(botwidth)
1560 } else {
1561 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1563 frame .bleft.top
1564 frame .bleft.mid
1566 button .bleft.top.search -text [mc "Search"] -command dosearch
1567 pack .bleft.top.search -side left -padx 5
1568 set sstring .bleft.top.sstring
1569 entry $sstring -width 20 -font textfont -textvariable searchstring
1570 lappend entries $sstring
1571 trace add variable searchstring write incrsearch
1572 pack $sstring -side left -expand 1 -fill x
1573 radiobutton .bleft.mid.diff -text [mc "Diff"] \
1574 -command changediffdisp -variable diffelide -value {0 0}
1575 radiobutton .bleft.mid.old -text [mc "Old version"] \
1576 -command changediffdisp -variable diffelide -value {0 1}
1577 radiobutton .bleft.mid.new -text [mc "New version"] \
1578 -command changediffdisp -variable diffelide -value {1 0}
1579 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
1580 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1581 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1582 -from 1 -increment 1 -to 10000000 \
1583 -validate all -validatecommand "diffcontextvalidate %P" \
1584 -textvariable diffcontextstring
1585 .bleft.mid.diffcontext set $diffcontext
1586 trace add variable diffcontextstring write diffcontextchange
1587 lappend entries .bleft.mid.diffcontext
1588 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1589 set ctext .bleft.ctext
1590 text $ctext -background $bgcolor -foreground $fgcolor \
1591 -state disabled -font textfont \
1592 -yscrollcommand scrolltext -wrap none
1593 if {$have_tk85} {
1594 $ctext conf -tabstyle wordprocessor
1596 scrollbar .bleft.sb -command "$ctext yview"
1597 pack .bleft.top -side top -fill x
1598 pack .bleft.mid -side top -fill x
1599 pack .bleft.sb -side right -fill y
1600 pack $ctext -side left -fill both -expand 1
1601 lappend bglist $ctext
1602 lappend fglist $ctext
1604 $ctext tag conf comment -wrap $wrapcomment
1605 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
1606 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1607 $ctext tag conf d0 -fore [lindex $diffcolors 0]
1608 $ctext tag conf d1 -fore [lindex $diffcolors 1]
1609 $ctext tag conf m0 -fore red
1610 $ctext tag conf m1 -fore blue
1611 $ctext tag conf m2 -fore green
1612 $ctext tag conf m3 -fore purple
1613 $ctext tag conf m4 -fore brown
1614 $ctext tag conf m5 -fore "#009090"
1615 $ctext tag conf m6 -fore magenta
1616 $ctext tag conf m7 -fore "#808000"
1617 $ctext tag conf m8 -fore "#009000"
1618 $ctext tag conf m9 -fore "#ff0080"
1619 $ctext tag conf m10 -fore cyan
1620 $ctext tag conf m11 -fore "#b07070"
1621 $ctext tag conf m12 -fore "#70b0f0"
1622 $ctext tag conf m13 -fore "#70f0b0"
1623 $ctext tag conf m14 -fore "#f0b070"
1624 $ctext tag conf m15 -fore "#ff70b0"
1625 $ctext tag conf mmax -fore darkgrey
1626 set mergemax 16
1627 $ctext tag conf mresult -font textfontbold
1628 $ctext tag conf msep -font textfontbold
1629 $ctext tag conf found -back yellow
1631 .pwbottom add .bleft
1632 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
1634 # lower right
1635 frame .bright
1636 frame .bright.mode
1637 radiobutton .bright.mode.patch -text [mc "Patch"] \
1638 -command reselectline -variable cmitmode -value "patch"
1639 radiobutton .bright.mode.tree -text [mc "Tree"] \
1640 -command reselectline -variable cmitmode -value "tree"
1641 grid .bright.mode.patch .bright.mode.tree -sticky ew
1642 pack .bright.mode -side top -fill x
1643 set cflist .bright.cfiles
1644 set indent [font measure mainfont "nn"]
1645 text $cflist \
1646 -selectbackground $selectbgcolor \
1647 -background $bgcolor -foreground $fgcolor \
1648 -font mainfont \
1649 -tabs [list $indent [expr {2 * $indent}]] \
1650 -yscrollcommand ".bright.sb set" \
1651 -cursor [. cget -cursor] \
1652 -spacing1 1 -spacing3 1
1653 lappend bglist $cflist
1654 lappend fglist $cflist
1655 scrollbar .bright.sb -command "$cflist yview"
1656 pack .bright.sb -side right -fill y
1657 pack $cflist -side left -fill both -expand 1
1658 $cflist tag configure highlight \
1659 -background [$cflist cget -selectbackground]
1660 $cflist tag configure bold -font mainfontbold
1662 .pwbottom add .bright
1663 .ctop add .pwbottom
1665 # restore window position if known
1666 if {[info exists geometry(main)]} {
1667 wm geometry . "$geometry(main)"
1670 if {[tk windowingsystem] eq {aqua}} {
1671 set M1B M1
1672 } else {
1673 set M1B Control
1676 bind .pwbottom <Configure> {resizecdetpanes %W %w}
1677 pack .ctop -fill both -expand 1
1678 bindall <1> {selcanvline %W %x %y}
1679 #bindall <B1-Motion> {selcanvline %W %x %y}
1680 if {[tk windowingsystem] == "win32"} {
1681 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1682 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1683 } else {
1684 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1685 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
1686 if {[tk windowingsystem] eq "aqua"} {
1687 bindall <MouseWheel> {
1688 set delta [expr {- (%D)}]
1689 allcanvs yview scroll $delta units
1693 bindall <2> "canvscan mark %W %x %y"
1694 bindall <B2-Motion> "canvscan dragto %W %x %y"
1695 bindkey <Home> selfirstline
1696 bindkey <End> sellastline
1697 bind . <Key-Up> "selnextline -1"
1698 bind . <Key-Down> "selnextline 1"
1699 bind . <Shift-Key-Up> "dofind -1 0"
1700 bind . <Shift-Key-Down> "dofind 1 0"
1701 bindkey <Key-Right> "goforw"
1702 bindkey <Key-Left> "goback"
1703 bind . <Key-Prior> "selnextpage -1"
1704 bind . <Key-Next> "selnextpage 1"
1705 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1706 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1707 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1708 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1709 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1710 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1711 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1712 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1713 bindkey <Key-space> "$ctext yview scroll 1 pages"
1714 bindkey p "selnextline -1"
1715 bindkey n "selnextline 1"
1716 bindkey z "goback"
1717 bindkey x "goforw"
1718 bindkey i "selnextline -1"
1719 bindkey k "selnextline 1"
1720 bindkey j "goback"
1721 bindkey l "goforw"
1722 bindkey b "$ctext yview scroll -1 pages"
1723 bindkey d "$ctext yview scroll 18 units"
1724 bindkey u "$ctext yview scroll -18 units"
1725 bindkey / {dofind 1 1}
1726 bindkey <Key-Return> {dofind 1 1}
1727 bindkey ? {dofind -1 1}
1728 bindkey f nextfile
1729 bindkey <F5> updatecommits
1730 bind . <$M1B-q> doquit
1731 bind . <$M1B-f> {dofind 1 1}
1732 bind . <$M1B-g> {dofind 1 0}
1733 bind . <$M1B-r> dosearchback
1734 bind . <$M1B-s> dosearch
1735 bind . <$M1B-equal> {incrfont 1}
1736 bind . <$M1B-KP_Add> {incrfont 1}
1737 bind . <$M1B-minus> {incrfont -1}
1738 bind . <$M1B-KP_Subtract> {incrfont -1}
1739 wm protocol . WM_DELETE_WINDOW doquit
1740 bind . <Button-1> "click %W"
1741 bind $fstring <Key-Return> {dofind 1 1}
1742 bind $sha1entry <Key-Return> gotocommit
1743 bind $sha1entry <<PasteSelection>> clearsha1
1744 bind $cflist <1> {sel_flist %W %x %y; break}
1745 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1746 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1747 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1749 set maincursor [. cget -cursor]
1750 set textcursor [$ctext cget -cursor]
1751 set curtextcursor $textcursor
1753 set rowctxmenu .rowctxmenu
1754 menu $rowctxmenu -tearoff 0
1755 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1756 -command {diffvssel 0}
1757 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1758 -command {diffvssel 1}
1759 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1760 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1761 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1762 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1763 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1764 -command cherrypick
1765 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1766 -command resethead
1768 set fakerowmenu .fakerowmenu
1769 menu $fakerowmenu -tearoff 0
1770 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1771 -command {diffvssel 0}
1772 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1773 -command {diffvssel 1}
1774 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1775 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1776 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1777 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1779 set headctxmenu .headctxmenu
1780 menu $headctxmenu -tearoff 0
1781 $headctxmenu add command -label [mc "Check out this branch"] \
1782 -command cobranch
1783 $headctxmenu add command -label [mc "Remove this branch"] \
1784 -command rmbranch
1786 global flist_menu
1787 set flist_menu .flistctxmenu
1788 menu $flist_menu -tearoff 0
1789 $flist_menu add command -label [mc "Highlight this too"] \
1790 -command {flist_hl 0}
1791 $flist_menu add command -label [mc "Highlight this only"] \
1792 -command {flist_hl 1}
1795 # Windows sends all mouse wheel events to the current focused window, not
1796 # the one where the mouse hovers, so bind those events here and redirect
1797 # to the correct window
1798 proc windows_mousewheel_redirector {W X Y D} {
1799 global canv canv2 canv3
1800 set w [winfo containing -displayof $W $X $Y]
1801 if {$w ne ""} {
1802 set u [expr {$D < 0 ? 5 : -5}]
1803 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1804 allcanvs yview scroll $u units
1805 } else {
1806 catch {
1807 $w yview scroll $u units
1813 # mouse-2 makes all windows scan vertically, but only the one
1814 # the cursor is in scans horizontally
1815 proc canvscan {op w x y} {
1816 global canv canv2 canv3
1817 foreach c [list $canv $canv2 $canv3] {
1818 if {$c == $w} {
1819 $c scan $op $x $y
1820 } else {
1821 $c scan $op 0 $y
1826 proc scrollcanv {cscroll f0 f1} {
1827 $cscroll set $f0 $f1
1828 drawvisible
1829 flushhighlights
1832 # when we make a key binding for the toplevel, make sure
1833 # it doesn't get triggered when that key is pressed in the
1834 # find string entry widget.
1835 proc bindkey {ev script} {
1836 global entries
1837 bind . $ev $script
1838 set escript [bind Entry $ev]
1839 if {$escript == {}} {
1840 set escript [bind Entry <Key>]
1842 foreach e $entries {
1843 bind $e $ev "$escript; break"
1847 # set the focus back to the toplevel for any click outside
1848 # the entry widgets
1849 proc click {w} {
1850 global ctext entries
1851 foreach e [concat $entries $ctext] {
1852 if {$w == $e} return
1854 focus .
1857 # Adjust the progress bar for a change in requested extent or canvas size
1858 proc adjustprogress {} {
1859 global progresscanv progressitem progresscoords
1860 global fprogitem fprogcoord lastprogupdate progupdatepending
1861 global rprogitem rprogcoord
1863 set w [expr {[winfo width $progresscanv] - 4}]
1864 set x0 [expr {$w * [lindex $progresscoords 0]}]
1865 set x1 [expr {$w * [lindex $progresscoords 1]}]
1866 set h [winfo height $progresscanv]
1867 $progresscanv coords $progressitem $x0 0 $x1 $h
1868 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1869 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1870 set now [clock clicks -milliseconds]
1871 if {$now >= $lastprogupdate + 100} {
1872 set progupdatepending 0
1873 update
1874 } elseif {!$progupdatepending} {
1875 set progupdatepending 1
1876 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1880 proc doprogupdate {} {
1881 global lastprogupdate progupdatepending
1883 if {$progupdatepending} {
1884 set progupdatepending 0
1885 set lastprogupdate [clock clicks -milliseconds]
1886 update
1890 proc savestuff {w} {
1891 global canv canv2 canv3 mainfont textfont uifont tabstop
1892 global stuffsaved findmergefiles maxgraphpct
1893 global maxwidth showneartags showlocalchanges
1894 global viewname viewfiles viewargs viewperm nextviewnum
1895 global cmitmode wrapcomment datetimeformat limitdiffs
1896 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1898 if {$stuffsaved} return
1899 if {![winfo viewable .]} return
1900 catch {
1901 set f [open "~/.gitk-new" w]
1902 puts $f [list set mainfont $mainfont]
1903 puts $f [list set textfont $textfont]
1904 puts $f [list set uifont $uifont]
1905 puts $f [list set tabstop $tabstop]
1906 puts $f [list set findmergefiles $findmergefiles]
1907 puts $f [list set maxgraphpct $maxgraphpct]
1908 puts $f [list set maxwidth $maxwidth]
1909 puts $f [list set cmitmode $cmitmode]
1910 puts $f [list set wrapcomment $wrapcomment]
1911 puts $f [list set showneartags $showneartags]
1912 puts $f [list set showlocalchanges $showlocalchanges]
1913 puts $f [list set datetimeformat $datetimeformat]
1914 puts $f [list set limitdiffs $limitdiffs]
1915 puts $f [list set bgcolor $bgcolor]
1916 puts $f [list set fgcolor $fgcolor]
1917 puts $f [list set colors $colors]
1918 puts $f [list set diffcolors $diffcolors]
1919 puts $f [list set diffcontext $diffcontext]
1920 puts $f [list set selectbgcolor $selectbgcolor]
1922 puts $f "set geometry(main) [wm geometry .]"
1923 puts $f "set geometry(topwidth) [winfo width .tf]"
1924 puts $f "set geometry(topheight) [winfo height .tf]"
1925 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1926 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1927 puts $f "set geometry(botwidth) [winfo width .bleft]"
1928 puts $f "set geometry(botheight) [winfo height .bleft]"
1930 puts -nonewline $f "set permviews {"
1931 for {set v 0} {$v < $nextviewnum} {incr v} {
1932 if {$viewperm($v)} {
1933 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1936 puts $f "}"
1937 close $f
1938 file rename -force "~/.gitk-new" "~/.gitk"
1940 set stuffsaved 1
1943 proc resizeclistpanes {win w} {
1944 global oldwidth
1945 if {[info exists oldwidth($win)]} {
1946 set s0 [$win sash coord 0]
1947 set s1 [$win sash coord 1]
1948 if {$w < 60} {
1949 set sash0 [expr {int($w/2 - 2)}]
1950 set sash1 [expr {int($w*5/6 - 2)}]
1951 } else {
1952 set factor [expr {1.0 * $w / $oldwidth($win)}]
1953 set sash0 [expr {int($factor * [lindex $s0 0])}]
1954 set sash1 [expr {int($factor * [lindex $s1 0])}]
1955 if {$sash0 < 30} {
1956 set sash0 30
1958 if {$sash1 < $sash0 + 20} {
1959 set sash1 [expr {$sash0 + 20}]
1961 if {$sash1 > $w - 10} {
1962 set sash1 [expr {$w - 10}]
1963 if {$sash0 > $sash1 - 20} {
1964 set sash0 [expr {$sash1 - 20}]
1968 $win sash place 0 $sash0 [lindex $s0 1]
1969 $win sash place 1 $sash1 [lindex $s1 1]
1971 set oldwidth($win) $w
1974 proc resizecdetpanes {win w} {
1975 global oldwidth
1976 if {[info exists oldwidth($win)]} {
1977 set s0 [$win sash coord 0]
1978 if {$w < 60} {
1979 set sash0 [expr {int($w*3/4 - 2)}]
1980 } else {
1981 set factor [expr {1.0 * $w / $oldwidth($win)}]
1982 set sash0 [expr {int($factor * [lindex $s0 0])}]
1983 if {$sash0 < 45} {
1984 set sash0 45
1986 if {$sash0 > $w - 15} {
1987 set sash0 [expr {$w - 15}]
1990 $win sash place 0 $sash0 [lindex $s0 1]
1992 set oldwidth($win) $w
1995 proc allcanvs args {
1996 global canv canv2 canv3
1997 eval $canv $args
1998 eval $canv2 $args
1999 eval $canv3 $args
2002 proc bindall {event action} {
2003 global canv canv2 canv3
2004 bind $canv $event $action
2005 bind $canv2 $event $action
2006 bind $canv3 $event $action
2009 proc about {} {
2010 global uifont
2011 set w .about
2012 if {[winfo exists $w]} {
2013 raise $w
2014 return
2016 toplevel $w
2017 wm title $w [mc "About gitk"]
2018 message $w.m -text [mc "
2019 Gitk - a commit viewer for git
2021 Copyright © 2005-2006 Paul Mackerras
2023 Use and redistribute under the terms of the GNU General Public License"] \
2024 -justify center -aspect 400 -border 2 -bg white -relief groove
2025 pack $w.m -side top -fill x -padx 2 -pady 2
2026 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2027 pack $w.ok -side bottom
2028 bind $w <Visibility> "focus $w.ok"
2029 bind $w <Key-Escape> "destroy $w"
2030 bind $w <Key-Return> "destroy $w"
2033 proc keys {} {
2034 set w .keys
2035 if {[winfo exists $w]} {
2036 raise $w
2037 return
2039 if {[tk windowingsystem] eq {aqua}} {
2040 set M1T Cmd
2041 } else {
2042 set M1T Ctrl
2044 toplevel $w
2045 wm title $w [mc "Gitk key bindings"]
2046 message $w.m -text [mc "
2047 Gitk key bindings:
2049 <$M1T-Q> Quit
2050 <Home> Move to first commit
2051 <End> Move to last commit
2052 <Up>, p, i Move up one commit
2053 <Down>, n, k Move down one commit
2054 <Left>, z, j Go back in history list
2055 <Right>, x, l Go forward in history list
2056 <PageUp> Move up one page in commit list
2057 <PageDown> Move down one page in commit list
2058 <$M1T-Home> Scroll to top of commit list
2059 <$M1T-End> Scroll to bottom of commit list
2060 <$M1T-Up> Scroll commit list up one line
2061 <$M1T-Down> Scroll commit list down one line
2062 <$M1T-PageUp> Scroll commit list up one page
2063 <$M1T-PageDown> Scroll commit list down one page
2064 <Shift-Up> Find backwards (upwards, later commits)
2065 <Shift-Down> Find forwards (downwards, earlier commits)
2066 <Delete>, b Scroll diff view up one page
2067 <Backspace> Scroll diff view up one page
2068 <Space> Scroll diff view down one page
2069 u Scroll diff view up 18 lines
2070 d Scroll diff view down 18 lines
2071 <$M1T-F> Find
2072 <$M1T-G> Move to next find hit
2073 <Return> Move to next find hit
2074 / Move to next find hit, or redo find
2075 ? Move to previous find hit
2076 f Scroll diff view to next file
2077 <$M1T-S> Search for next hit in diff view
2078 <$M1T-R> Search for previous hit in diff view
2079 <$M1T-KP+> Increase font size
2080 <$M1T-plus> Increase font size
2081 <$M1T-KP-> Decrease font size
2082 <$M1T-minus> Decrease font size
2083 <F5> Update
2084 "] \
2085 -justify left -bg white -border 2 -relief groove
2086 pack $w.m -side top -fill both -padx 2 -pady 2
2087 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2088 pack $w.ok -side bottom
2089 bind $w <Visibility> "focus $w.ok"
2090 bind $w <Key-Escape> "destroy $w"
2091 bind $w <Key-Return> "destroy $w"
2094 # Procedures for manipulating the file list window at the
2095 # bottom right of the overall window.
2097 proc treeview {w l openlevs} {
2098 global treecontents treediropen treeheight treeparent treeindex
2100 set ix 0
2101 set treeindex() 0
2102 set lev 0
2103 set prefix {}
2104 set prefixend -1
2105 set prefendstack {}
2106 set htstack {}
2107 set ht 0
2108 set treecontents() {}
2109 $w conf -state normal
2110 foreach f $l {
2111 while {[string range $f 0 $prefixend] ne $prefix} {
2112 if {$lev <= $openlevs} {
2113 $w mark set e:$treeindex($prefix) "end -1c"
2114 $w mark gravity e:$treeindex($prefix) left
2116 set treeheight($prefix) $ht
2117 incr ht [lindex $htstack end]
2118 set htstack [lreplace $htstack end end]
2119 set prefixend [lindex $prefendstack end]
2120 set prefendstack [lreplace $prefendstack end end]
2121 set prefix [string range $prefix 0 $prefixend]
2122 incr lev -1
2124 set tail [string range $f [expr {$prefixend+1}] end]
2125 while {[set slash [string first "/" $tail]] >= 0} {
2126 lappend htstack $ht
2127 set ht 0
2128 lappend prefendstack $prefixend
2129 incr prefixend [expr {$slash + 1}]
2130 set d [string range $tail 0 $slash]
2131 lappend treecontents($prefix) $d
2132 set oldprefix $prefix
2133 append prefix $d
2134 set treecontents($prefix) {}
2135 set treeindex($prefix) [incr ix]
2136 set treeparent($prefix) $oldprefix
2137 set tail [string range $tail [expr {$slash+1}] end]
2138 if {$lev <= $openlevs} {
2139 set ht 1
2140 set treediropen($prefix) [expr {$lev < $openlevs}]
2141 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2142 $w mark set d:$ix "end -1c"
2143 $w mark gravity d:$ix left
2144 set str "\n"
2145 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2146 $w insert end $str
2147 $w image create end -align center -image $bm -padx 1 \
2148 -name a:$ix
2149 $w insert end $d [highlight_tag $prefix]
2150 $w mark set s:$ix "end -1c"
2151 $w mark gravity s:$ix left
2153 incr lev
2155 if {$tail ne {}} {
2156 if {$lev <= $openlevs} {
2157 incr ht
2158 set str "\n"
2159 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2160 $w insert end $str
2161 $w insert end $tail [highlight_tag $f]
2163 lappend treecontents($prefix) $tail
2166 while {$htstack ne {}} {
2167 set treeheight($prefix) $ht
2168 incr ht [lindex $htstack end]
2169 set htstack [lreplace $htstack end end]
2170 set prefixend [lindex $prefendstack end]
2171 set prefendstack [lreplace $prefendstack end end]
2172 set prefix [string range $prefix 0 $prefixend]
2174 $w conf -state disabled
2177 proc linetoelt {l} {
2178 global treeheight treecontents
2180 set y 2
2181 set prefix {}
2182 while {1} {
2183 foreach e $treecontents($prefix) {
2184 if {$y == $l} {
2185 return "$prefix$e"
2187 set n 1
2188 if {[string index $e end] eq "/"} {
2189 set n $treeheight($prefix$e)
2190 if {$y + $n > $l} {
2191 append prefix $e
2192 incr y
2193 break
2196 incr y $n
2201 proc highlight_tree {y prefix} {
2202 global treeheight treecontents cflist
2204 foreach e $treecontents($prefix) {
2205 set path $prefix$e
2206 if {[highlight_tag $path] ne {}} {
2207 $cflist tag add bold $y.0 "$y.0 lineend"
2209 incr y
2210 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2211 set y [highlight_tree $y $path]
2214 return $y
2217 proc treeclosedir {w dir} {
2218 global treediropen treeheight treeparent treeindex
2220 set ix $treeindex($dir)
2221 $w conf -state normal
2222 $w delete s:$ix e:$ix
2223 set treediropen($dir) 0
2224 $w image configure a:$ix -image tri-rt
2225 $w conf -state disabled
2226 set n [expr {1 - $treeheight($dir)}]
2227 while {$dir ne {}} {
2228 incr treeheight($dir) $n
2229 set dir $treeparent($dir)
2233 proc treeopendir {w dir} {
2234 global treediropen treeheight treeparent treecontents treeindex
2236 set ix $treeindex($dir)
2237 $w conf -state normal
2238 $w image configure a:$ix -image tri-dn
2239 $w mark set e:$ix s:$ix
2240 $w mark gravity e:$ix right
2241 set lev 0
2242 set str "\n"
2243 set n [llength $treecontents($dir)]
2244 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2245 incr lev
2246 append str "\t"
2247 incr treeheight($x) $n
2249 foreach e $treecontents($dir) {
2250 set de $dir$e
2251 if {[string index $e end] eq "/"} {
2252 set iy $treeindex($de)
2253 $w mark set d:$iy e:$ix
2254 $w mark gravity d:$iy left
2255 $w insert e:$ix $str
2256 set treediropen($de) 0
2257 $w image create e:$ix -align center -image tri-rt -padx 1 \
2258 -name a:$iy
2259 $w insert e:$ix $e [highlight_tag $de]
2260 $w mark set s:$iy e:$ix
2261 $w mark gravity s:$iy left
2262 set treeheight($de) 1
2263 } else {
2264 $w insert e:$ix $str
2265 $w insert e:$ix $e [highlight_tag $de]
2268 $w mark gravity e:$ix left
2269 $w conf -state disabled
2270 set treediropen($dir) 1
2271 set top [lindex [split [$w index @0,0] .] 0]
2272 set ht [$w cget -height]
2273 set l [lindex [split [$w index s:$ix] .] 0]
2274 if {$l < $top} {
2275 $w yview $l.0
2276 } elseif {$l + $n + 1 > $top + $ht} {
2277 set top [expr {$l + $n + 2 - $ht}]
2278 if {$l < $top} {
2279 set top $l
2281 $w yview $top.0
2285 proc treeclick {w x y} {
2286 global treediropen cmitmode ctext cflist cflist_top
2288 if {$cmitmode ne "tree"} return
2289 if {![info exists cflist_top]} return
2290 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2291 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2292 $cflist tag add highlight $l.0 "$l.0 lineend"
2293 set cflist_top $l
2294 if {$l == 1} {
2295 $ctext yview 1.0
2296 return
2298 set e [linetoelt $l]
2299 if {[string index $e end] ne "/"} {
2300 showfile $e
2301 } elseif {$treediropen($e)} {
2302 treeclosedir $w $e
2303 } else {
2304 treeopendir $w $e
2308 proc setfilelist {id} {
2309 global treefilelist cflist
2311 treeview $cflist $treefilelist($id) 0
2314 image create bitmap tri-rt -background black -foreground blue -data {
2315 #define tri-rt_width 13
2316 #define tri-rt_height 13
2317 static unsigned char tri-rt_bits[] = {
2318 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2319 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2320 0x00, 0x00};
2321 } -maskdata {
2322 #define tri-rt-mask_width 13
2323 #define tri-rt-mask_height 13
2324 static unsigned char tri-rt-mask_bits[] = {
2325 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2326 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2327 0x08, 0x00};
2329 image create bitmap tri-dn -background black -foreground blue -data {
2330 #define tri-dn_width 13
2331 #define tri-dn_height 13
2332 static unsigned char tri-dn_bits[] = {
2333 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2334 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2335 0x00, 0x00};
2336 } -maskdata {
2337 #define tri-dn-mask_width 13
2338 #define tri-dn-mask_height 13
2339 static unsigned char tri-dn-mask_bits[] = {
2340 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2341 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2342 0x00, 0x00};
2345 image create bitmap reficon-T -background black -foreground yellow -data {
2346 #define tagicon_width 13
2347 #define tagicon_height 9
2348 static unsigned char tagicon_bits[] = {
2349 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2350 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2351 } -maskdata {
2352 #define tagicon-mask_width 13
2353 #define tagicon-mask_height 9
2354 static unsigned char tagicon-mask_bits[] = {
2355 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2356 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2358 set rectdata {
2359 #define headicon_width 13
2360 #define headicon_height 9
2361 static unsigned char headicon_bits[] = {
2362 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2363 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2365 set rectmask {
2366 #define headicon-mask_width 13
2367 #define headicon-mask_height 9
2368 static unsigned char headicon-mask_bits[] = {
2369 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2370 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2372 image create bitmap reficon-H -background black -foreground green \
2373 -data $rectdata -maskdata $rectmask
2374 image create bitmap reficon-o -background black -foreground "#ddddff" \
2375 -data $rectdata -maskdata $rectmask
2377 proc init_flist {first} {
2378 global cflist cflist_top difffilestart
2380 $cflist conf -state normal
2381 $cflist delete 0.0 end
2382 if {$first ne {}} {
2383 $cflist insert end $first
2384 set cflist_top 1
2385 $cflist tag add highlight 1.0 "1.0 lineend"
2386 } else {
2387 catch {unset cflist_top}
2389 $cflist conf -state disabled
2390 set difffilestart {}
2393 proc highlight_tag {f} {
2394 global highlight_paths
2396 foreach p $highlight_paths {
2397 if {[string match $p $f]} {
2398 return "bold"
2401 return {}
2404 proc highlight_filelist {} {
2405 global cmitmode cflist
2407 $cflist conf -state normal
2408 if {$cmitmode ne "tree"} {
2409 set end [lindex [split [$cflist index end] .] 0]
2410 for {set l 2} {$l < $end} {incr l} {
2411 set line [$cflist get $l.0 "$l.0 lineend"]
2412 if {[highlight_tag $line] ne {}} {
2413 $cflist tag add bold $l.0 "$l.0 lineend"
2416 } else {
2417 highlight_tree 2 {}
2419 $cflist conf -state disabled
2422 proc unhighlight_filelist {} {
2423 global cflist
2425 $cflist conf -state normal
2426 $cflist tag remove bold 1.0 end
2427 $cflist conf -state disabled
2430 proc add_flist {fl} {
2431 global cflist
2433 $cflist conf -state normal
2434 foreach f $fl {
2435 $cflist insert end "\n"
2436 $cflist insert end $f [highlight_tag $f]
2438 $cflist conf -state disabled
2441 proc sel_flist {w x y} {
2442 global ctext difffilestart cflist cflist_top cmitmode
2444 if {$cmitmode eq "tree"} return
2445 if {![info exists cflist_top]} return
2446 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2447 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2448 $cflist tag add highlight $l.0 "$l.0 lineend"
2449 set cflist_top $l
2450 if {$l == 1} {
2451 $ctext yview 1.0
2452 } else {
2453 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2457 proc pop_flist_menu {w X Y x y} {
2458 global ctext cflist cmitmode flist_menu flist_menu_file
2459 global treediffs diffids
2461 stopfinding
2462 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2463 if {$l <= 1} return
2464 if {$cmitmode eq "tree"} {
2465 set e [linetoelt $l]
2466 if {[string index $e end] eq "/"} return
2467 } else {
2468 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2470 set flist_menu_file $e
2471 tk_popup $flist_menu $X $Y
2474 proc flist_hl {only} {
2475 global flist_menu_file findstring gdttype
2477 set x [shellquote $flist_menu_file]
2478 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2479 set findstring $x
2480 } else {
2481 append findstring " " $x
2483 set gdttype [mc "touching paths:"]
2486 # Functions for adding and removing shell-type quoting
2488 proc shellquote {str} {
2489 if {![string match "*\['\"\\ \t]*" $str]} {
2490 return $str
2492 if {![string match "*\['\"\\]*" $str]} {
2493 return "\"$str\""
2495 if {![string match "*'*" $str]} {
2496 return "'$str'"
2498 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2501 proc shellarglist {l} {
2502 set str {}
2503 foreach a $l {
2504 if {$str ne {}} {
2505 append str " "
2507 append str [shellquote $a]
2509 return $str
2512 proc shelldequote {str} {
2513 set ret {}
2514 set used -1
2515 while {1} {
2516 incr used
2517 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2518 append ret [string range $str $used end]
2519 set used [string length $str]
2520 break
2522 set first [lindex $first 0]
2523 set ch [string index $str $first]
2524 if {$first > $used} {
2525 append ret [string range $str $used [expr {$first - 1}]]
2526 set used $first
2528 if {$ch eq " " || $ch eq "\t"} break
2529 incr used
2530 if {$ch eq "'"} {
2531 set first [string first "'" $str $used]
2532 if {$first < 0} {
2533 error "unmatched single-quote"
2535 append ret [string range $str $used [expr {$first - 1}]]
2536 set used $first
2537 continue
2539 if {$ch eq "\\"} {
2540 if {$used >= [string length $str]} {
2541 error "trailing backslash"
2543 append ret [string index $str $used]
2544 continue
2546 # here ch == "\""
2547 while {1} {
2548 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2549 error "unmatched double-quote"
2551 set first [lindex $first 0]
2552 set ch [string index $str $first]
2553 if {$first > $used} {
2554 append ret [string range $str $used [expr {$first - 1}]]
2555 set used $first
2557 if {$ch eq "\""} break
2558 incr used
2559 append ret [string index $str $used]
2560 incr used
2563 return [list $used $ret]
2566 proc shellsplit {str} {
2567 set l {}
2568 while {1} {
2569 set str [string trimleft $str]
2570 if {$str eq {}} break
2571 set dq [shelldequote $str]
2572 set n [lindex $dq 0]
2573 set word [lindex $dq 1]
2574 set str [string range $str $n end]
2575 lappend l $word
2577 return $l
2580 # Code to implement multiple views
2582 proc newview {ishighlight} {
2583 global nextviewnum newviewname newviewperm newishighlight
2584 global newviewargs revtreeargs
2586 set newishighlight $ishighlight
2587 set top .gitkview
2588 if {[winfo exists $top]} {
2589 raise $top
2590 return
2592 set newviewname($nextviewnum) "View $nextviewnum"
2593 set newviewperm($nextviewnum) 0
2594 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2595 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2598 proc editview {} {
2599 global curview
2600 global viewname viewperm newviewname newviewperm
2601 global viewargs newviewargs
2603 set top .gitkvedit-$curview
2604 if {[winfo exists $top]} {
2605 raise $top
2606 return
2608 set newviewname($curview) $viewname($curview)
2609 set newviewperm($curview) $viewperm($curview)
2610 set newviewargs($curview) [shellarglist $viewargs($curview)]
2611 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2614 proc vieweditor {top n title} {
2615 global newviewname newviewperm viewfiles bgcolor
2617 toplevel $top
2618 wm title $top $title
2619 label $top.nl -text [mc "Name"]
2620 entry $top.name -width 20 -textvariable newviewname($n)
2621 grid $top.nl $top.name -sticky w -pady 5
2622 checkbutton $top.perm -text [mc "Remember this view"] \
2623 -variable newviewperm($n)
2624 grid $top.perm - -pady 5 -sticky w
2625 message $top.al -aspect 1000 \
2626 -text [mc "Commits to include (arguments to git rev-list):"]
2627 grid $top.al - -sticky w -pady 5
2628 entry $top.args -width 50 -textvariable newviewargs($n) \
2629 -background $bgcolor
2630 grid $top.args - -sticky ew -padx 5
2631 message $top.l -aspect 1000 \
2632 -text [mc "Enter files and directories to include, one per line:"]
2633 grid $top.l - -sticky w
2634 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2635 if {[info exists viewfiles($n)]} {
2636 foreach f $viewfiles($n) {
2637 $top.t insert end $f
2638 $top.t insert end "\n"
2640 $top.t delete {end - 1c} end
2641 $top.t mark set insert 0.0
2643 grid $top.t - -sticky ew -padx 5
2644 frame $top.buts
2645 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2646 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2647 grid $top.buts.ok $top.buts.can
2648 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2649 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2650 grid $top.buts - -pady 10 -sticky ew
2651 focus $top.t
2654 proc doviewmenu {m first cmd op argv} {
2655 set nmenu [$m index end]
2656 for {set i $first} {$i <= $nmenu} {incr i} {
2657 if {[$m entrycget $i -command] eq $cmd} {
2658 eval $m $op $i $argv
2659 break
2664 proc allviewmenus {n op args} {
2665 # global viewhlmenu
2667 doviewmenu .bar.view 5 [list showview $n] $op $args
2668 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2671 proc newviewok {top n} {
2672 global nextviewnum newviewperm newviewname newishighlight
2673 global viewname viewfiles viewperm selectedview curview
2674 global viewargs newviewargs viewhlmenu
2676 if {[catch {
2677 set newargs [shellsplit $newviewargs($n)]
2678 } err]} {
2679 error_popup "[mc "Error in commit selection arguments:"] $err"
2680 wm raise $top
2681 focus $top
2682 return
2684 set files {}
2685 foreach f [split [$top.t get 0.0 end] "\n"] {
2686 set ft [string trim $f]
2687 if {$ft ne {}} {
2688 lappend files $ft
2691 if {![info exists viewfiles($n)]} {
2692 # creating a new view
2693 incr nextviewnum
2694 set viewname($n) $newviewname($n)
2695 set viewperm($n) $newviewperm($n)
2696 set viewfiles($n) $files
2697 set viewargs($n) $newargs
2698 addviewmenu $n
2699 if {!$newishighlight} {
2700 run showview $n
2701 } else {
2702 run addvhighlight $n
2704 } else {
2705 # editing an existing view
2706 set viewperm($n) $newviewperm($n)
2707 if {$newviewname($n) ne $viewname($n)} {
2708 set viewname($n) $newviewname($n)
2709 doviewmenu .bar.view 5 [list showview $n] \
2710 entryconf [list -label $viewname($n)]
2711 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2712 # entryconf [list -label $viewname($n) -value $viewname($n)]
2714 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2715 set viewfiles($n) $files
2716 set viewargs($n) $newargs
2717 if {$curview == $n} {
2718 run reloadcommits
2722 catch {destroy $top}
2725 proc delview {} {
2726 global curview viewperm hlview selectedhlview
2728 if {$curview == 0} return
2729 if {[info exists hlview] && $hlview == $curview} {
2730 set selectedhlview [mc "None"]
2731 unset hlview
2733 allviewmenus $curview delete
2734 set viewperm($curview) 0
2735 showview 0
2738 proc addviewmenu {n} {
2739 global viewname viewhlmenu
2741 .bar.view add radiobutton -label $viewname($n) \
2742 -command [list showview $n] -variable selectedview -value $n
2743 #$viewhlmenu add radiobutton -label $viewname($n) \
2744 # -command [list addvhighlight $n] -variable selectedhlview
2747 proc showview {n} {
2748 global curview viewfiles cached_commitrow ordertok
2749 global displayorder parentlist rowidlist rowisopt rowfinal
2750 global colormap rowtextx nextcolor canvxmax
2751 global numcommits viewcomplete
2752 global selectedline currentid canv canvy0
2753 global treediffs
2754 global pending_select mainheadid
2755 global commitidx
2756 global selectedview
2757 global hlview selectedhlview commitinterest
2759 if {$n == $curview} return
2760 set selid {}
2761 set ymax [lindex [$canv cget -scrollregion] 3]
2762 set span [$canv yview]
2763 set ytop [expr {[lindex $span 0] * $ymax}]
2764 set ybot [expr {[lindex $span 1] * $ymax}]
2765 set yscreen [expr {($ybot - $ytop) / 2}]
2766 if {[info exists selectedline]} {
2767 set selid $currentid
2768 set y [yc $selectedline]
2769 if {$ytop < $y && $y < $ybot} {
2770 set yscreen [expr {$y - $ytop}]
2772 } elseif {[info exists pending_select]} {
2773 set selid $pending_select
2774 unset pending_select
2776 unselectline
2777 normalline
2778 catch {unset treediffs}
2779 clear_display
2780 if {[info exists hlview] && $hlview == $n} {
2781 unset hlview
2782 set selectedhlview [mc "None"]
2784 catch {unset commitinterest}
2785 catch {unset cached_commitrow}
2786 catch {unset ordertok}
2788 set curview $n
2789 set selectedview $n
2790 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2791 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2793 run refill_reflist
2794 if {![info exists viewcomplete($n)]} {
2795 if {$selid ne {}} {
2796 set pending_select $selid
2798 getcommits
2799 return
2802 set displayorder {}
2803 set parentlist {}
2804 set rowidlist {}
2805 set rowisopt {}
2806 set rowfinal {}
2807 set numcommits $commitidx($n)
2809 catch {unset colormap}
2810 catch {unset rowtextx}
2811 set nextcolor 0
2812 set canvxmax [$canv cget -width]
2813 set curview $n
2814 set row 0
2815 setcanvscroll
2816 set yf 0
2817 set row {}
2818 if {$selid ne {} && [commitinview $selid $n]} {
2819 set row [rowofcommit $selid]
2820 # try to get the selected row in the same position on the screen
2821 set ymax [lindex [$canv cget -scrollregion] 3]
2822 set ytop [expr {[yc $row] - $yscreen}]
2823 if {$ytop < 0} {
2824 set ytop 0
2826 set yf [expr {$ytop * 1.0 / $ymax}]
2828 allcanvs yview moveto $yf
2829 drawvisible
2830 if {$row ne {}} {
2831 selectline $row 0
2832 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
2833 selectline [rowofcommit $mainheadid] 1
2834 } elseif {!$viewcomplete($n)} {
2835 if {$selid ne {}} {
2836 set pending_select $selid
2837 } else {
2838 set pending_select $mainheadid
2840 } else {
2841 set row [first_real_row]
2842 if {$row < $numcommits} {
2843 selectline $row 0
2846 if {!$viewcomplete($n)} {
2847 if {$numcommits == 0} {
2848 show_status [mc "Reading commits..."]
2850 } elseif {$numcommits == 0} {
2851 show_status [mc "No commits selected"]
2855 # Stuff relating to the highlighting facility
2857 proc ishighlighted {id} {
2858 global vhighlights fhighlights nhighlights rhighlights
2860 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
2861 return $nhighlights($id)
2863 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
2864 return $vhighlights($id)
2866 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
2867 return $fhighlights($id)
2869 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
2870 return $rhighlights($id)
2872 return 0
2875 proc bolden {row font} {
2876 global canv linehtag selectedline boldrows
2878 lappend boldrows $row
2879 $canv itemconf $linehtag($row) -font $font
2880 if {[info exists selectedline] && $row == $selectedline} {
2881 $canv delete secsel
2882 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2883 -outline {{}} -tags secsel \
2884 -fill [$canv cget -selectbackground]]
2885 $canv lower $t
2889 proc bolden_name {row font} {
2890 global canv2 linentag selectedline boldnamerows
2892 lappend boldnamerows $row
2893 $canv2 itemconf $linentag($row) -font $font
2894 if {[info exists selectedline] && $row == $selectedline} {
2895 $canv2 delete secsel
2896 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2897 -outline {{}} -tags secsel \
2898 -fill [$canv2 cget -selectbackground]]
2899 $canv2 lower $t
2903 proc unbolden {} {
2904 global boldrows
2906 set stillbold {}
2907 foreach row $boldrows {
2908 if {![ishighlighted [commitonrow $row]]} {
2909 bolden $row mainfont
2910 } else {
2911 lappend stillbold $row
2914 set boldrows $stillbold
2917 proc addvhighlight {n} {
2918 global hlview viewcomplete curview vhl_done commitidx
2920 if {[info exists hlview]} {
2921 delvhighlight
2923 set hlview $n
2924 if {$n != $curview && ![info exists viewcomplete($n)]} {
2925 start_rev_list $n
2927 set vhl_done $commitidx($hlview)
2928 if {$vhl_done > 0} {
2929 drawvisible
2933 proc delvhighlight {} {
2934 global hlview vhighlights
2936 if {![info exists hlview]} return
2937 unset hlview
2938 catch {unset vhighlights}
2939 unbolden
2942 proc vhighlightmore {} {
2943 global hlview vhl_done commitidx vhighlights curview
2945 set max $commitidx($hlview)
2946 set vr [visiblerows]
2947 set r0 [lindex $vr 0]
2948 set r1 [lindex $vr 1]
2949 for {set i $vhl_done} {$i < $max} {incr i} {
2950 set id [commitonrow $i $hlview]
2951 if {[commitinview $id $curview]} {
2952 set row [rowofcommit $id]
2953 if {$r0 <= $row && $row <= $r1} {
2954 if {![highlighted $row]} {
2955 bolden $row mainfontbold
2957 set vhighlights($id) 1
2961 set vhl_done $max
2964 proc askvhighlight {row id} {
2965 global hlview vhighlights iddrawn
2967 if {[commitinview $id $hlview]} {
2968 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
2969 bolden $row mainfontbold
2971 set vhighlights($id) 1
2972 } else {
2973 set vhighlights($id) 0
2977 proc hfiles_change {} {
2978 global highlight_files filehighlight fhighlights fh_serial
2979 global highlight_paths gdttype
2981 if {[info exists filehighlight]} {
2982 # delete previous highlights
2983 catch {close $filehighlight}
2984 unset filehighlight
2985 catch {unset fhighlights}
2986 unbolden
2987 unhighlight_filelist
2989 set highlight_paths {}
2990 after cancel do_file_hl $fh_serial
2991 incr fh_serial
2992 if {$highlight_files ne {}} {
2993 after 300 do_file_hl $fh_serial
2997 proc gdttype_change {name ix op} {
2998 global gdttype highlight_files findstring findpattern
3000 stopfinding
3001 if {$findstring ne {}} {
3002 if {$gdttype eq [mc "containing:"]} {
3003 if {$highlight_files ne {}} {
3004 set highlight_files {}
3005 hfiles_change
3007 findcom_change
3008 } else {
3009 if {$findpattern ne {}} {
3010 set findpattern {}
3011 findcom_change
3013 set highlight_files $findstring
3014 hfiles_change
3016 drawvisible
3018 # enable/disable findtype/findloc menus too
3021 proc find_change {name ix op} {
3022 global gdttype findstring highlight_files
3024 stopfinding
3025 if {$gdttype eq [mc "containing:"]} {
3026 findcom_change
3027 } else {
3028 if {$highlight_files ne $findstring} {
3029 set highlight_files $findstring
3030 hfiles_change
3033 drawvisible
3036 proc findcom_change args {
3037 global nhighlights boldnamerows
3038 global findpattern findtype findstring gdttype
3040 stopfinding
3041 # delete previous highlights, if any
3042 foreach row $boldnamerows {
3043 bolden_name $row mainfont
3045 set boldnamerows {}
3046 catch {unset nhighlights}
3047 unbolden
3048 unmarkmatches
3049 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3050 set findpattern {}
3051 } elseif {$findtype eq [mc "Regexp"]} {
3052 set findpattern $findstring
3053 } else {
3054 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3055 $findstring]
3056 set findpattern "*$e*"
3060 proc makepatterns {l} {
3061 set ret {}
3062 foreach e $l {
3063 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3064 if {[string index $ee end] eq "/"} {
3065 lappend ret "$ee*"
3066 } else {
3067 lappend ret $ee
3068 lappend ret "$ee/*"
3071 return $ret
3074 proc do_file_hl {serial} {
3075 global highlight_files filehighlight highlight_paths gdttype fhl_list
3077 if {$gdttype eq [mc "touching paths:"]} {
3078 if {[catch {set paths [shellsplit $highlight_files]}]} return
3079 set highlight_paths [makepatterns $paths]
3080 highlight_filelist
3081 set gdtargs [concat -- $paths]
3082 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3083 set gdtargs [list "-S$highlight_files"]
3084 } else {
3085 # must be "containing:", i.e. we're searching commit info
3086 return
3088 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3089 set filehighlight [open $cmd r+]
3090 fconfigure $filehighlight -blocking 0
3091 filerun $filehighlight readfhighlight
3092 set fhl_list {}
3093 drawvisible
3094 flushhighlights
3097 proc flushhighlights {} {
3098 global filehighlight fhl_list
3100 if {[info exists filehighlight]} {
3101 lappend fhl_list {}
3102 puts $filehighlight ""
3103 flush $filehighlight
3107 proc askfilehighlight {row id} {
3108 global filehighlight fhighlights fhl_list
3110 lappend fhl_list $id
3111 set fhighlights($id) -1
3112 puts $filehighlight $id
3115 proc readfhighlight {} {
3116 global filehighlight fhighlights curview iddrawn
3117 global fhl_list find_dirn
3119 if {![info exists filehighlight]} {
3120 return 0
3122 set nr 0
3123 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3124 set line [string trim $line]
3125 set i [lsearch -exact $fhl_list $line]
3126 if {$i < 0} continue
3127 for {set j 0} {$j < $i} {incr j} {
3128 set id [lindex $fhl_list $j]
3129 set fhighlights($id) 0
3131 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3132 if {$line eq {}} continue
3133 if {![commitinview $line $curview]} continue
3134 set row [rowofcommit $line]
3135 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3136 bolden $row mainfontbold
3138 set fhighlights($line) 1
3140 if {[eof $filehighlight]} {
3141 # strange...
3142 puts "oops, git diff-tree died"
3143 catch {close $filehighlight}
3144 unset filehighlight
3145 return 0
3147 if {[info exists find_dirn]} {
3148 run findmore
3150 return 1
3153 proc doesmatch {f} {
3154 global findtype findpattern
3156 if {$findtype eq [mc "Regexp"]} {
3157 return [regexp $findpattern $f]
3158 } elseif {$findtype eq [mc "IgnCase"]} {
3159 return [string match -nocase $findpattern $f]
3160 } else {
3161 return [string match $findpattern $f]
3165 proc askfindhighlight {row id} {
3166 global nhighlights commitinfo iddrawn
3167 global findloc
3168 global markingmatches
3170 if {![info exists commitinfo($id)]} {
3171 getcommit $id
3173 set info $commitinfo($id)
3174 set isbold 0
3175 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3176 foreach f $info ty $fldtypes {
3177 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3178 [doesmatch $f]} {
3179 if {$ty eq [mc "Author"]} {
3180 set isbold 2
3181 break
3183 set isbold 1
3186 if {$isbold && [info exists iddrawn($id)]} {
3187 if {![ishighlighted $id]} {
3188 bolden $row mainfontbold
3189 if {$isbold > 1} {
3190 bolden_name $row mainfontbold
3193 if {$markingmatches} {
3194 markrowmatches $row $id
3197 set nhighlights($id) $isbold
3200 proc markrowmatches {row id} {
3201 global canv canv2 linehtag linentag commitinfo findloc
3203 set headline [lindex $commitinfo($id) 0]
3204 set author [lindex $commitinfo($id) 1]
3205 $canv delete match$row
3206 $canv2 delete match$row
3207 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3208 set m [findmatches $headline]
3209 if {$m ne {}} {
3210 markmatches $canv $row $headline $linehtag($row) $m \
3211 [$canv itemcget $linehtag($row) -font] $row
3214 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3215 set m [findmatches $author]
3216 if {$m ne {}} {
3217 markmatches $canv2 $row $author $linentag($row) $m \
3218 [$canv2 itemcget $linentag($row) -font] $row
3223 proc vrel_change {name ix op} {
3224 global highlight_related
3226 rhighlight_none
3227 if {$highlight_related ne [mc "None"]} {
3228 run drawvisible
3232 # prepare for testing whether commits are descendents or ancestors of a
3233 proc rhighlight_sel {a} {
3234 global descendent desc_todo ancestor anc_todo
3235 global highlight_related
3237 catch {unset descendent}
3238 set desc_todo [list $a]
3239 catch {unset ancestor}
3240 set anc_todo [list $a]
3241 if {$highlight_related ne [mc "None"]} {
3242 rhighlight_none
3243 run drawvisible
3247 proc rhighlight_none {} {
3248 global rhighlights
3250 catch {unset rhighlights}
3251 unbolden
3254 proc is_descendent {a} {
3255 global curview children descendent desc_todo
3257 set v $curview
3258 set la [rowofcommit $a]
3259 set todo $desc_todo
3260 set leftover {}
3261 set done 0
3262 for {set i 0} {$i < [llength $todo]} {incr i} {
3263 set do [lindex $todo $i]
3264 if {[rowofcommit $do] < $la} {
3265 lappend leftover $do
3266 continue
3268 foreach nk $children($v,$do) {
3269 if {![info exists descendent($nk)]} {
3270 set descendent($nk) 1
3271 lappend todo $nk
3272 if {$nk eq $a} {
3273 set done 1
3277 if {$done} {
3278 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3279 return
3282 set descendent($a) 0
3283 set desc_todo $leftover
3286 proc is_ancestor {a} {
3287 global curview parents ancestor anc_todo
3289 set v $curview
3290 set la [rowofcommit $a]
3291 set todo $anc_todo
3292 set leftover {}
3293 set done 0
3294 for {set i 0} {$i < [llength $todo]} {incr i} {
3295 set do [lindex $todo $i]
3296 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3297 lappend leftover $do
3298 continue
3300 foreach np $parents($v,$do) {
3301 if {![info exists ancestor($np)]} {
3302 set ancestor($np) 1
3303 lappend todo $np
3304 if {$np eq $a} {
3305 set done 1
3309 if {$done} {
3310 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3311 return
3314 set ancestor($a) 0
3315 set anc_todo $leftover
3318 proc askrelhighlight {row id} {
3319 global descendent highlight_related iddrawn rhighlights
3320 global selectedline ancestor
3322 if {![info exists selectedline]} return
3323 set isbold 0
3324 if {$highlight_related eq [mc "Descendent"] ||
3325 $highlight_related eq [mc "Not descendent"]} {
3326 if {![info exists descendent($id)]} {
3327 is_descendent $id
3329 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
3330 set isbold 1
3332 } elseif {$highlight_related eq [mc "Ancestor"] ||
3333 $highlight_related eq [mc "Not ancestor"]} {
3334 if {![info exists ancestor($id)]} {
3335 is_ancestor $id
3337 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3338 set isbold 1
3341 if {[info exists iddrawn($id)]} {
3342 if {$isbold && ![ishighlighted $id]} {
3343 bolden $row mainfontbold
3346 set rhighlights($id) $isbold
3349 # Graph layout functions
3351 proc shortids {ids} {
3352 set res {}
3353 foreach id $ids {
3354 if {[llength $id] > 1} {
3355 lappend res [shortids $id]
3356 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3357 lappend res [string range $id 0 7]
3358 } else {
3359 lappend res $id
3362 return $res
3365 proc ntimes {n o} {
3366 set ret {}
3367 set o [list $o]
3368 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3369 if {($n & $mask) != 0} {
3370 set ret [concat $ret $o]
3372 set o [concat $o $o]
3374 return $ret
3377 proc ordertoken {id} {
3378 global ordertok curview varcid varcstart varctok curview parents children
3379 global nullid nullid2
3381 if {[info exists ordertok($id)]} {
3382 return $ordertok($id)
3384 set origid $id
3385 set todo {}
3386 while {1} {
3387 if {[info exists varcid($curview,$id)]} {
3388 set a $varcid($curview,$id)
3389 set p [lindex $varcstart($curview) $a]
3390 } else {
3391 set p [lindex $children($curview,$id) 0]
3393 if {[info exists ordertok($p)]} {
3394 set tok $ordertok($p)
3395 break
3397 set id [first_real_child $curview,$p]
3398 if {$id eq {}} {
3399 # it's a root
3400 set tok [lindex $varctok($curview) $a]
3401 break
3403 if {[llength $parents($curview,$id)] == 1} {
3404 lappend todo [list $p {}]
3405 } else {
3406 set j [lsearch -exact $parents($curview,$id) $p]
3407 if {$j < 0} {
3408 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3410 lappend todo [list $p [strrep $j]]
3413 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3414 set p [lindex $todo $i 0]
3415 append tok [lindex $todo $i 1]
3416 set ordertok($p) $tok
3418 set ordertok($origid) $tok
3419 return $tok
3422 # Work out where id should go in idlist so that order-token
3423 # values increase from left to right
3424 proc idcol {idlist id {i 0}} {
3425 set t [ordertoken $id]
3426 if {$i < 0} {
3427 set i 0
3429 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3430 if {$i > [llength $idlist]} {
3431 set i [llength $idlist]
3433 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3434 incr i
3435 } else {
3436 if {$t > [ordertoken [lindex $idlist $i]]} {
3437 while {[incr i] < [llength $idlist] &&
3438 $t >= [ordertoken [lindex $idlist $i]]} {}
3441 return $i
3444 proc initlayout {} {
3445 global rowidlist rowisopt rowfinal displayorder parentlist
3446 global numcommits canvxmax canv
3447 global nextcolor
3448 global colormap rowtextx
3450 set numcommits 0
3451 set displayorder {}
3452 set parentlist {}
3453 set nextcolor 0
3454 set rowidlist {}
3455 set rowisopt {}
3456 set rowfinal {}
3457 set canvxmax [$canv cget -width]
3458 catch {unset colormap}
3459 catch {unset rowtextx}
3462 proc setcanvscroll {} {
3463 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3465 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3466 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3467 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3468 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3471 proc visiblerows {} {
3472 global canv numcommits linespc
3474 set ymax [lindex [$canv cget -scrollregion] 3]
3475 if {$ymax eq {} || $ymax == 0} return
3476 set f [$canv yview]
3477 set y0 [expr {int([lindex $f 0] * $ymax)}]
3478 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3479 if {$r0 < 0} {
3480 set r0 0
3482 set y1 [expr {int([lindex $f 1] * $ymax)}]
3483 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3484 if {$r1 >= $numcommits} {
3485 set r1 [expr {$numcommits - 1}]
3487 return [list $r0 $r1]
3490 proc layoutmore {} {
3491 global commitidx viewcomplete curview
3492 global numcommits pending_select selectedline curview
3493 global lastscrollset commitinterest
3495 set canshow $commitidx($curview)
3496 if {$canshow <= $numcommits && !$viewcomplete($curview)} return
3497 if {$numcommits == 0} {
3498 allcanvs delete all
3500 set r0 $numcommits
3501 set prev $numcommits
3502 set numcommits $canshow
3503 set t [clock clicks -milliseconds]
3504 if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
3505 set lastscrollset $t
3506 setcanvscroll
3508 set rows [visiblerows]
3509 set r1 [lindex $rows 1]
3510 if {$r1 >= $canshow} {
3511 set r1 [expr {$canshow - 1}]
3513 if {$r0 <= $r1} {
3514 drawcommits $r0 $r1
3516 if {[info exists pending_select] &&
3517 [commitinview $pending_select $curview]} {
3518 selectline [rowofcommit $pending_select] 1
3522 proc doshowlocalchanges {} {
3523 global curview mainheadid
3525 if {[commitinview $mainheadid $curview]} {
3526 dodiffindex
3527 } else {
3528 lappend commitinterest($mainheadid) {dodiffindex}
3532 proc dohidelocalchanges {} {
3533 global nullid nullid2 lserial curview
3535 if {[commitinview $nullid $curview]} {
3536 removerow $nullid $curview
3538 if {[commitinview $nullid2 $curview]} {
3539 removerow $nullid2 $curview
3541 incr lserial
3544 # spawn off a process to do git diff-index --cached HEAD
3545 proc dodiffindex {} {
3546 global lserial showlocalchanges
3548 if {!$showlocalchanges} return
3549 incr lserial
3550 set fd [open "|git diff-index --cached HEAD" r]
3551 fconfigure $fd -blocking 0
3552 filerun $fd [list readdiffindex $fd $lserial]
3555 proc readdiffindex {fd serial} {
3556 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3558 set isdiff 1
3559 if {[gets $fd line] < 0} {
3560 if {![eof $fd]} {
3561 return 1
3563 set isdiff 0
3565 # we only need to see one line and we don't really care what it says...
3566 close $fd
3568 if {$serial != $lserial} {
3569 return 0
3572 # now see if there are any local changes not checked in to the index
3573 set fd [open "|git diff-files" r]
3574 fconfigure $fd -blocking 0
3575 filerun $fd [list readdifffiles $fd $serial]
3577 if {$isdiff && ![commitinview $nullid2 $curview]} {
3578 # add the line for the changes in the index to the graph
3579 set hl [mc "Local changes checked in to index but not committed"]
3580 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3581 set commitdata($nullid2) "\n $hl\n"
3582 if {[commitinview $nullid $curview]} {
3583 removerow $nullid $curview
3585 insertrow $nullid2 $mainheadid $curview
3586 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3587 removerow $nullid2 $curview
3589 return 0
3592 proc readdifffiles {fd serial} {
3593 global mainheadid nullid nullid2 curview
3594 global commitinfo commitdata lserial
3596 set isdiff 1
3597 if {[gets $fd line] < 0} {
3598 if {![eof $fd]} {
3599 return 1
3601 set isdiff 0
3603 # we only need to see one line and we don't really care what it says...
3604 close $fd
3606 if {$serial != $lserial} {
3607 return 0
3610 if {$isdiff && ![commitinview $nullid $curview]} {
3611 # add the line for the local diff to the graph
3612 set hl [mc "Local uncommitted changes, not checked in to index"]
3613 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3614 set commitdata($nullid) "\n $hl\n"
3615 if {[commitinview $nullid2 $curview]} {
3616 set p $nullid2
3617 } else {
3618 set p $mainheadid
3620 insertrow $nullid $p $curview
3621 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3622 removerow $nullid $curview
3624 return 0
3627 proc nextuse {id row} {
3628 global curview children
3630 if {[info exists children($curview,$id)]} {
3631 foreach kid $children($curview,$id) {
3632 if {![commitinview $kid $curview]} {
3633 return -1
3635 if {[rowofcommit $kid] > $row} {
3636 return [rowofcommit $kid]
3640 if {[commitinview $id $curview]} {
3641 return [rowofcommit $id]
3643 return -1
3646 proc prevuse {id row} {
3647 global curview children
3649 set ret -1
3650 if {[info exists children($curview,$id)]} {
3651 foreach kid $children($curview,$id) {
3652 if {![commitinview $kid $curview]} break
3653 if {[rowofcommit $kid] < $row} {
3654 set ret [rowofcommit $kid]
3658 return $ret
3661 proc make_idlist {row} {
3662 global displayorder parentlist uparrowlen downarrowlen mingaplen
3663 global commitidx curview children
3665 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3666 if {$r < 0} {
3667 set r 0
3669 set ra [expr {$row - $downarrowlen}]
3670 if {$ra < 0} {
3671 set ra 0
3673 set rb [expr {$row + $uparrowlen}]
3674 if {$rb > $commitidx($curview)} {
3675 set rb $commitidx($curview)
3677 make_disporder $r [expr {$rb + 1}]
3678 set ids {}
3679 for {} {$r < $ra} {incr r} {
3680 set nextid [lindex $displayorder [expr {$r + 1}]]
3681 foreach p [lindex $parentlist $r] {
3682 if {$p eq $nextid} continue
3683 set rn [nextuse $p $r]
3684 if {$rn >= $row &&
3685 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3686 lappend ids [list [ordertoken $p] $p]
3690 for {} {$r < $row} {incr r} {
3691 set nextid [lindex $displayorder [expr {$r + 1}]]
3692 foreach p [lindex $parentlist $r] {
3693 if {$p eq $nextid} continue
3694 set rn [nextuse $p $r]
3695 if {$rn < 0 || $rn >= $row} {
3696 lappend ids [list [ordertoken $p] $p]
3700 set id [lindex $displayorder $row]
3701 lappend ids [list [ordertoken $id] $id]
3702 while {$r < $rb} {
3703 foreach p [lindex $parentlist $r] {
3704 set firstkid [lindex $children($curview,$p) 0]
3705 if {[rowofcommit $firstkid] < $row} {
3706 lappend ids [list [ordertoken $p] $p]
3709 incr r
3710 set id [lindex $displayorder $r]
3711 if {$id ne {}} {
3712 set firstkid [lindex $children($curview,$id) 0]
3713 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3714 lappend ids [list [ordertoken $id] $id]
3718 set idlist {}
3719 foreach idx [lsort -unique $ids] {
3720 lappend idlist [lindex $idx 1]
3722 return $idlist
3725 proc rowsequal {a b} {
3726 while {[set i [lsearch -exact $a {}]] >= 0} {
3727 set a [lreplace $a $i $i]
3729 while {[set i [lsearch -exact $b {}]] >= 0} {
3730 set b [lreplace $b $i $i]
3732 return [expr {$a eq $b}]
3735 proc makeupline {id row rend col} {
3736 global rowidlist uparrowlen downarrowlen mingaplen
3738 for {set r $rend} {1} {set r $rstart} {
3739 set rstart [prevuse $id $r]
3740 if {$rstart < 0} return
3741 if {$rstart < $row} break
3743 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3744 set rstart [expr {$rend - $uparrowlen - 1}]
3746 for {set r $rstart} {[incr r] <= $row} {} {
3747 set idlist [lindex $rowidlist $r]
3748 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3749 set col [idcol $idlist $id $col]
3750 lset rowidlist $r [linsert $idlist $col $id]
3751 changedrow $r
3756 proc layoutrows {row endrow} {
3757 global rowidlist rowisopt rowfinal displayorder
3758 global uparrowlen downarrowlen maxwidth mingaplen
3759 global children parentlist
3760 global commitidx viewcomplete curview
3762 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3763 set idlist {}
3764 if {$row > 0} {
3765 set rm1 [expr {$row - 1}]
3766 foreach id [lindex $rowidlist $rm1] {
3767 if {$id ne {}} {
3768 lappend idlist $id
3771 set final [lindex $rowfinal $rm1]
3773 for {} {$row < $endrow} {incr row} {
3774 set rm1 [expr {$row - 1}]
3775 if {$rm1 < 0 || $idlist eq {}} {
3776 set idlist [make_idlist $row]
3777 set final 1
3778 } else {
3779 set id [lindex $displayorder $rm1]
3780 set col [lsearch -exact $idlist $id]
3781 set idlist [lreplace $idlist $col $col]
3782 foreach p [lindex $parentlist $rm1] {
3783 if {[lsearch -exact $idlist $p] < 0} {
3784 set col [idcol $idlist $p $col]
3785 set idlist [linsert $idlist $col $p]
3786 # if not the first child, we have to insert a line going up
3787 if {$id ne [lindex $children($curview,$p) 0]} {
3788 makeupline $p $rm1 $row $col
3792 set id [lindex $displayorder $row]
3793 if {$row > $downarrowlen} {
3794 set termrow [expr {$row - $downarrowlen - 1}]
3795 foreach p [lindex $parentlist $termrow] {
3796 set i [lsearch -exact $idlist $p]
3797 if {$i < 0} continue
3798 set nr [nextuse $p $termrow]
3799 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3800 set idlist [lreplace $idlist $i $i]
3804 set col [lsearch -exact $idlist $id]
3805 if {$col < 0} {
3806 set col [idcol $idlist $id]
3807 set idlist [linsert $idlist $col $id]
3808 if {$children($curview,$id) ne {}} {
3809 makeupline $id $rm1 $row $col
3812 set r [expr {$row + $uparrowlen - 1}]
3813 if {$r < $commitidx($curview)} {
3814 set x $col
3815 foreach p [lindex $parentlist $r] {
3816 if {[lsearch -exact $idlist $p] >= 0} continue
3817 set fk [lindex $children($curview,$p) 0]
3818 if {[rowofcommit $fk] < $row} {
3819 set x [idcol $idlist $p $x]
3820 set idlist [linsert $idlist $x $p]
3823 if {[incr r] < $commitidx($curview)} {
3824 set p [lindex $displayorder $r]
3825 if {[lsearch -exact $idlist $p] < 0} {
3826 set fk [lindex $children($curview,$p) 0]
3827 if {$fk ne {} && [rowofcommit $fk] < $row} {
3828 set x [idcol $idlist $p $x]
3829 set idlist [linsert $idlist $x $p]
3835 if {$final && !$viewcomplete($curview) &&
3836 $row + $uparrowlen + $mingaplen + $downarrowlen
3837 >= $commitidx($curview)} {
3838 set final 0
3840 set l [llength $rowidlist]
3841 if {$row == $l} {
3842 lappend rowidlist $idlist
3843 lappend rowisopt 0
3844 lappend rowfinal $final
3845 } elseif {$row < $l} {
3846 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3847 lset rowidlist $row $idlist
3848 changedrow $row
3850 lset rowfinal $row $final
3851 } else {
3852 set pad [ntimes [expr {$row - $l}] {}]
3853 set rowidlist [concat $rowidlist $pad]
3854 lappend rowidlist $idlist
3855 set rowfinal [concat $rowfinal $pad]
3856 lappend rowfinal $final
3857 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3860 return $row
3863 proc changedrow {row} {
3864 global displayorder iddrawn rowisopt need_redisplay
3866 set l [llength $rowisopt]
3867 if {$row < $l} {
3868 lset rowisopt $row 0
3869 if {$row + 1 < $l} {
3870 lset rowisopt [expr {$row + 1}] 0
3871 if {$row + 2 < $l} {
3872 lset rowisopt [expr {$row + 2}] 0
3876 set id [lindex $displayorder $row]
3877 if {[info exists iddrawn($id)]} {
3878 set need_redisplay 1
3882 proc insert_pad {row col npad} {
3883 global rowidlist
3885 set pad [ntimes $npad {}]
3886 set idlist [lindex $rowidlist $row]
3887 set bef [lrange $idlist 0 [expr {$col - 1}]]
3888 set aft [lrange $idlist $col end]
3889 set i [lsearch -exact $aft {}]
3890 if {$i > 0} {
3891 set aft [lreplace $aft $i $i]
3893 lset rowidlist $row [concat $bef $pad $aft]
3894 changedrow $row
3897 proc optimize_rows {row col endrow} {
3898 global rowidlist rowisopt displayorder curview children
3900 if {$row < 1} {
3901 set row 1
3903 for {} {$row < $endrow} {incr row; set col 0} {
3904 if {[lindex $rowisopt $row]} continue
3905 set haspad 0
3906 set y0 [expr {$row - 1}]
3907 set ym [expr {$row - 2}]
3908 set idlist [lindex $rowidlist $row]
3909 set previdlist [lindex $rowidlist $y0]
3910 if {$idlist eq {} || $previdlist eq {}} continue
3911 if {$ym >= 0} {
3912 set pprevidlist [lindex $rowidlist $ym]
3913 if {$pprevidlist eq {}} continue
3914 } else {
3915 set pprevidlist {}
3917 set x0 -1
3918 set xm -1
3919 for {} {$col < [llength $idlist]} {incr col} {
3920 set id [lindex $idlist $col]
3921 if {[lindex $previdlist $col] eq $id} continue
3922 if {$id eq {}} {
3923 set haspad 1
3924 continue
3926 set x0 [lsearch -exact $previdlist $id]
3927 if {$x0 < 0} continue
3928 set z [expr {$x0 - $col}]
3929 set isarrow 0
3930 set z0 {}
3931 if {$ym >= 0} {
3932 set xm [lsearch -exact $pprevidlist $id]
3933 if {$xm >= 0} {
3934 set z0 [expr {$xm - $x0}]
3937 if {$z0 eq {}} {
3938 # if row y0 is the first child of $id then it's not an arrow
3939 if {[lindex $children($curview,$id) 0] ne
3940 [lindex $displayorder $y0]} {
3941 set isarrow 1
3944 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3945 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3946 set isarrow 1
3948 # Looking at lines from this row to the previous row,
3949 # make them go straight up if they end in an arrow on
3950 # the previous row; otherwise make them go straight up
3951 # or at 45 degrees.
3952 if {$z < -1 || ($z < 0 && $isarrow)} {
3953 # Line currently goes left too much;
3954 # insert pads in the previous row, then optimize it
3955 set npad [expr {-1 - $z + $isarrow}]
3956 insert_pad $y0 $x0 $npad
3957 if {$y0 > 0} {
3958 optimize_rows $y0 $x0 $row
3960 set previdlist [lindex $rowidlist $y0]
3961 set x0 [lsearch -exact $previdlist $id]
3962 set z [expr {$x0 - $col}]
3963 if {$z0 ne {}} {
3964 set pprevidlist [lindex $rowidlist $ym]
3965 set xm [lsearch -exact $pprevidlist $id]
3966 set z0 [expr {$xm - $x0}]
3968 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3969 # Line currently goes right too much;
3970 # insert pads in this line
3971 set npad [expr {$z - 1 + $isarrow}]
3972 insert_pad $row $col $npad
3973 set idlist [lindex $rowidlist $row]
3974 incr col $npad
3975 set z [expr {$x0 - $col}]
3976 set haspad 1
3978 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3979 # this line links to its first child on row $row-2
3980 set id [lindex $displayorder $ym]
3981 set xc [lsearch -exact $pprevidlist $id]
3982 if {$xc >= 0} {
3983 set z0 [expr {$xc - $x0}]
3986 # avoid lines jigging left then immediately right
3987 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3988 insert_pad $y0 $x0 1
3989 incr x0
3990 optimize_rows $y0 $x0 $row
3991 set previdlist [lindex $rowidlist $y0]
3994 if {!$haspad} {
3995 # Find the first column that doesn't have a line going right
3996 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3997 set id [lindex $idlist $col]
3998 if {$id eq {}} break
3999 set x0 [lsearch -exact $previdlist $id]
4000 if {$x0 < 0} {
4001 # check if this is the link to the first child
4002 set kid [lindex $displayorder $y0]
4003 if {[lindex $children($curview,$id) 0] eq $kid} {
4004 # it is, work out offset to child
4005 set x0 [lsearch -exact $previdlist $kid]
4008 if {$x0 <= $col} break
4010 # Insert a pad at that column as long as it has a line and
4011 # isn't the last column
4012 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4013 set idlist [linsert $idlist $col {}]
4014 lset rowidlist $row $idlist
4015 changedrow $row
4021 proc xc {row col} {
4022 global canvx0 linespc
4023 return [expr {$canvx0 + $col * $linespc}]
4026 proc yc {row} {
4027 global canvy0 linespc
4028 return [expr {$canvy0 + $row * $linespc}]
4031 proc linewidth {id} {
4032 global thickerline lthickness
4034 set wid $lthickness
4035 if {[info exists thickerline] && $id eq $thickerline} {
4036 set wid [expr {2 * $lthickness}]
4038 return $wid
4041 proc rowranges {id} {
4042 global curview children uparrowlen downarrowlen
4043 global rowidlist
4045 set kids $children($curview,$id)
4046 if {$kids eq {}} {
4047 return {}
4049 set ret {}
4050 lappend kids $id
4051 foreach child $kids {
4052 if {![commitinview $child $curview]} break
4053 set row [rowofcommit $child]
4054 if {![info exists prev]} {
4055 lappend ret [expr {$row + 1}]
4056 } else {
4057 if {$row <= $prevrow} {
4058 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4060 # see if the line extends the whole way from prevrow to row
4061 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4062 [lsearch -exact [lindex $rowidlist \
4063 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4064 # it doesn't, see where it ends
4065 set r [expr {$prevrow + $downarrowlen}]
4066 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4067 while {[incr r -1] > $prevrow &&
4068 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4069 } else {
4070 while {[incr r] <= $row &&
4071 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4072 incr r -1
4074 lappend ret $r
4075 # see where it starts up again
4076 set r [expr {$row - $uparrowlen}]
4077 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4078 while {[incr r] < $row &&
4079 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4080 } else {
4081 while {[incr r -1] >= $prevrow &&
4082 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4083 incr r
4085 lappend ret $r
4088 if {$child eq $id} {
4089 lappend ret $row
4091 set prev $child
4092 set prevrow $row
4094 return $ret
4097 proc drawlineseg {id row endrow arrowlow} {
4098 global rowidlist displayorder iddrawn linesegs
4099 global canv colormap linespc curview maxlinelen parentlist
4101 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4102 set le [expr {$row + 1}]
4103 set arrowhigh 1
4104 while {1} {
4105 set c [lsearch -exact [lindex $rowidlist $le] $id]
4106 if {$c < 0} {
4107 incr le -1
4108 break
4110 lappend cols $c
4111 set x [lindex $displayorder $le]
4112 if {$x eq $id} {
4113 set arrowhigh 0
4114 break
4116 if {[info exists iddrawn($x)] || $le == $endrow} {
4117 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4118 if {$c >= 0} {
4119 lappend cols $c
4120 set arrowhigh 0
4122 break
4124 incr le
4126 if {$le <= $row} {
4127 return $row
4130 set lines {}
4131 set i 0
4132 set joinhigh 0
4133 if {[info exists linesegs($id)]} {
4134 set lines $linesegs($id)
4135 foreach li $lines {
4136 set r0 [lindex $li 0]
4137 if {$r0 > $row} {
4138 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4139 set joinhigh 1
4141 break
4143 incr i
4146 set joinlow 0
4147 if {$i > 0} {
4148 set li [lindex $lines [expr {$i-1}]]
4149 set r1 [lindex $li 1]
4150 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4151 set joinlow 1
4155 set x [lindex $cols [expr {$le - $row}]]
4156 set xp [lindex $cols [expr {$le - 1 - $row}]]
4157 set dir [expr {$xp - $x}]
4158 if {$joinhigh} {
4159 set ith [lindex $lines $i 2]
4160 set coords [$canv coords $ith]
4161 set ah [$canv itemcget $ith -arrow]
4162 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4163 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4164 if {$x2 ne {} && $x - $x2 == $dir} {
4165 set coords [lrange $coords 0 end-2]
4167 } else {
4168 set coords [list [xc $le $x] [yc $le]]
4170 if {$joinlow} {
4171 set itl [lindex $lines [expr {$i-1}] 2]
4172 set al [$canv itemcget $itl -arrow]
4173 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4174 } elseif {$arrowlow} {
4175 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4176 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4177 set arrowlow 0
4180 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4181 for {set y $le} {[incr y -1] > $row} {} {
4182 set x $xp
4183 set xp [lindex $cols [expr {$y - 1 - $row}]]
4184 set ndir [expr {$xp - $x}]
4185 if {$dir != $ndir || $xp < 0} {
4186 lappend coords [xc $y $x] [yc $y]
4188 set dir $ndir
4190 if {!$joinlow} {
4191 if {$xp < 0} {
4192 # join parent line to first child
4193 set ch [lindex $displayorder $row]
4194 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4195 if {$xc < 0} {
4196 puts "oops: drawlineseg: child $ch not on row $row"
4197 } elseif {$xc != $x} {
4198 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4199 set d [expr {int(0.5 * $linespc)}]
4200 set x1 [xc $row $x]
4201 if {$xc < $x} {
4202 set x2 [expr {$x1 - $d}]
4203 } else {
4204 set x2 [expr {$x1 + $d}]
4206 set y2 [yc $row]
4207 set y1 [expr {$y2 + $d}]
4208 lappend coords $x1 $y1 $x2 $y2
4209 } elseif {$xc < $x - 1} {
4210 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4211 } elseif {$xc > $x + 1} {
4212 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4214 set x $xc
4216 lappend coords [xc $row $x] [yc $row]
4217 } else {
4218 set xn [xc $row $xp]
4219 set yn [yc $row]
4220 lappend coords $xn $yn
4222 if {!$joinhigh} {
4223 assigncolor $id
4224 set t [$canv create line $coords -width [linewidth $id] \
4225 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4226 $canv lower $t
4227 bindline $t $id
4228 set lines [linsert $lines $i [list $row $le $t]]
4229 } else {
4230 $canv coords $ith $coords
4231 if {$arrow ne $ah} {
4232 $canv itemconf $ith -arrow $arrow
4234 lset lines $i 0 $row
4236 } else {
4237 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4238 set ndir [expr {$xo - $xp}]
4239 set clow [$canv coords $itl]
4240 if {$dir == $ndir} {
4241 set clow [lrange $clow 2 end]
4243 set coords [concat $coords $clow]
4244 if {!$joinhigh} {
4245 lset lines [expr {$i-1}] 1 $le
4246 } else {
4247 # coalesce two pieces
4248 $canv delete $ith
4249 set b [lindex $lines [expr {$i-1}] 0]
4250 set e [lindex $lines $i 1]
4251 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4253 $canv coords $itl $coords
4254 if {$arrow ne $al} {
4255 $canv itemconf $itl -arrow $arrow
4259 set linesegs($id) $lines
4260 return $le
4263 proc drawparentlinks {id row} {
4264 global rowidlist canv colormap curview parentlist
4265 global idpos linespc
4267 set rowids [lindex $rowidlist $row]
4268 set col [lsearch -exact $rowids $id]
4269 if {$col < 0} return
4270 set olds [lindex $parentlist $row]
4271 set row2 [expr {$row + 1}]
4272 set x [xc $row $col]
4273 set y [yc $row]
4274 set y2 [yc $row2]
4275 set d [expr {int(0.5 * $linespc)}]
4276 set ymid [expr {$y + $d}]
4277 set ids [lindex $rowidlist $row2]
4278 # rmx = right-most X coord used
4279 set rmx 0
4280 foreach p $olds {
4281 set i [lsearch -exact $ids $p]
4282 if {$i < 0} {
4283 puts "oops, parent $p of $id not in list"
4284 continue
4286 set x2 [xc $row2 $i]
4287 if {$x2 > $rmx} {
4288 set rmx $x2
4290 set j [lsearch -exact $rowids $p]
4291 if {$j < 0} {
4292 # drawlineseg will do this one for us
4293 continue
4295 assigncolor $p
4296 # should handle duplicated parents here...
4297 set coords [list $x $y]
4298 if {$i != $col} {
4299 # if attaching to a vertical segment, draw a smaller
4300 # slant for visual distinctness
4301 if {$i == $j} {
4302 if {$i < $col} {
4303 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4304 } else {
4305 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4307 } elseif {$i < $col && $i < $j} {
4308 # segment slants towards us already
4309 lappend coords [xc $row $j] $y
4310 } else {
4311 if {$i < $col - 1} {
4312 lappend coords [expr {$x2 + $linespc}] $y
4313 } elseif {$i > $col + 1} {
4314 lappend coords [expr {$x2 - $linespc}] $y
4316 lappend coords $x2 $y2
4318 } else {
4319 lappend coords $x2 $y2
4321 set t [$canv create line $coords -width [linewidth $p] \
4322 -fill $colormap($p) -tags lines.$p]
4323 $canv lower $t
4324 bindline $t $p
4326 if {$rmx > [lindex $idpos($id) 1]} {
4327 lset idpos($id) 1 $rmx
4328 redrawtags $id
4332 proc drawlines {id} {
4333 global canv
4335 $canv itemconf lines.$id -width [linewidth $id]
4338 proc drawcmittext {id row col} {
4339 global linespc canv canv2 canv3 fgcolor curview
4340 global cmitlisted commitinfo rowidlist parentlist
4341 global rowtextx idpos idtags idheads idotherrefs
4342 global linehtag linentag linedtag selectedline
4343 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4345 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
4346 set listed $cmitlisted($curview,$id)
4347 if {$id eq $nullid} {
4348 set ofill red
4349 } elseif {$id eq $nullid2} {
4350 set ofill green
4351 } else {
4352 set ofill [expr {$listed != 0? "blue": "white"}]
4354 set x [xc $row $col]
4355 set y [yc $row]
4356 set orad [expr {$linespc / 3}]
4357 if {$listed <= 1} {
4358 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4359 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4360 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4361 } elseif {$listed == 2} {
4362 # triangle pointing left for left-side commits
4363 set t [$canv create polygon \
4364 [expr {$x - $orad}] $y \
4365 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4366 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4367 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4368 } else {
4369 # triangle pointing right for right-side commits
4370 set t [$canv create polygon \
4371 [expr {$x + $orad - 1}] $y \
4372 [expr {$x - $orad}] [expr {$y - $orad}] \
4373 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4374 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4376 $canv raise $t
4377 $canv bind $t <1> {selcanvline {} %x %y}
4378 set rmx [llength [lindex $rowidlist $row]]
4379 set olds [lindex $parentlist $row]
4380 if {$olds ne {}} {
4381 set nextids [lindex $rowidlist [expr {$row + 1}]]
4382 foreach p $olds {
4383 set i [lsearch -exact $nextids $p]
4384 if {$i > $rmx} {
4385 set rmx $i
4389 set xt [xc $row $rmx]
4390 set rowtextx($row) $xt
4391 set idpos($id) [list $x $xt $y]
4392 if {[info exists idtags($id)] || [info exists idheads($id)]
4393 || [info exists idotherrefs($id)]} {
4394 set xt [drawtags $id $x $xt $y]
4396 set headline [lindex $commitinfo($id) 0]
4397 set name [lindex $commitinfo($id) 1]
4398 set date [lindex $commitinfo($id) 2]
4399 set date [formatdate $date]
4400 set font mainfont
4401 set nfont mainfont
4402 set isbold [ishighlighted $id]
4403 if {$isbold > 0} {
4404 lappend boldrows $row
4405 set font mainfontbold
4406 if {$isbold > 1} {
4407 lappend boldnamerows $row
4408 set nfont mainfontbold
4411 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4412 -text $headline -font $font -tags text]
4413 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4414 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4415 -text $name -font $nfont -tags text]
4416 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4417 -text $date -font mainfont -tags text]
4418 if {[info exists selectedline] && $selectedline == $row} {
4419 make_secsel $row
4421 set xr [expr {$xt + [font measure $font $headline]}]
4422 if {$xr > $canvxmax} {
4423 set canvxmax $xr
4424 setcanvscroll
4428 proc drawcmitrow {row} {
4429 global displayorder rowidlist nrows_drawn
4430 global iddrawn markingmatches
4431 global commitinfo numcommits
4432 global filehighlight fhighlights findpattern nhighlights
4433 global hlview vhighlights
4434 global highlight_related rhighlights
4436 if {$row >= $numcommits} return
4438 set id [lindex $displayorder $row]
4439 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4440 askvhighlight $row $id
4442 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4443 askfilehighlight $row $id
4445 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4446 askfindhighlight $row $id
4448 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4449 askrelhighlight $row $id
4451 if {![info exists iddrawn($id)]} {
4452 set col [lsearch -exact [lindex $rowidlist $row] $id]
4453 if {$col < 0} {
4454 puts "oops, row $row id $id not in list"
4455 return
4457 if {![info exists commitinfo($id)]} {
4458 getcommit $id
4460 assigncolor $id
4461 drawcmittext $id $row $col
4462 set iddrawn($id) 1
4463 incr nrows_drawn
4465 if {$markingmatches} {
4466 markrowmatches $row $id
4470 proc drawcommits {row {endrow {}}} {
4471 global numcommits iddrawn displayorder curview need_redisplay
4472 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4474 if {$row < 0} {
4475 set row 0
4477 if {$endrow eq {}} {
4478 set endrow $row
4480 if {$endrow >= $numcommits} {
4481 set endrow [expr {$numcommits - 1}]
4484 set rl1 [expr {$row - $downarrowlen - 3}]
4485 if {$rl1 < 0} {
4486 set rl1 0
4488 set ro1 [expr {$row - 3}]
4489 if {$ro1 < 0} {
4490 set ro1 0
4492 set r2 [expr {$endrow + $uparrowlen + 3}]
4493 if {$r2 > $numcommits} {
4494 set r2 $numcommits
4496 for {set r $rl1} {$r < $r2} {incr r} {
4497 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4498 if {$rl1 < $r} {
4499 layoutrows $rl1 $r
4501 set rl1 [expr {$r + 1}]
4504 if {$rl1 < $r} {
4505 layoutrows $rl1 $r
4507 optimize_rows $ro1 0 $r2
4508 if {$need_redisplay || $nrows_drawn > 2000} {
4509 clear_display
4510 drawvisible
4513 # make the lines join to already-drawn rows either side
4514 set r [expr {$row - 1}]
4515 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4516 set r $row
4518 set er [expr {$endrow + 1}]
4519 if {$er >= $numcommits ||
4520 ![info exists iddrawn([lindex $displayorder $er])]} {
4521 set er $endrow
4523 for {} {$r <= $er} {incr r} {
4524 set id [lindex $displayorder $r]
4525 set wasdrawn [info exists iddrawn($id)]
4526 drawcmitrow $r
4527 if {$r == $er} break
4528 set nextid [lindex $displayorder [expr {$r + 1}]]
4529 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4530 drawparentlinks $id $r
4532 set rowids [lindex $rowidlist $r]
4533 foreach lid $rowids {
4534 if {$lid eq {}} continue
4535 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4536 if {$lid eq $id} {
4537 # see if this is the first child of any of its parents
4538 foreach p [lindex $parentlist $r] {
4539 if {[lsearch -exact $rowids $p] < 0} {
4540 # make this line extend up to the child
4541 set lineend($p) [drawlineseg $p $r $er 0]
4544 } else {
4545 set lineend($lid) [drawlineseg $lid $r $er 1]
4551 proc undolayout {row} {
4552 global uparrowlen mingaplen downarrowlen
4553 global rowidlist rowisopt rowfinal need_redisplay
4555 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4556 if {$r < 0} {
4557 set r 0
4559 if {[llength $rowidlist] > $r} {
4560 incr r -1
4561 set rowidlist [lrange $rowidlist 0 $r]
4562 set rowfinal [lrange $rowfinal 0 $r]
4563 set rowisopt [lrange $rowisopt 0 $r]
4564 set need_redisplay 1
4565 run drawvisible
4569 proc drawvisible {} {
4570 global canv linespc curview vrowmod selectedline targetrow targetid
4571 global need_redisplay cscroll numcommits
4573 set fs [$canv yview]
4574 set ymax [lindex [$canv cget -scrollregion] 3]
4575 if {$ymax eq {} || $ymax == 0} return
4576 set f0 [lindex $fs 0]
4577 set f1 [lindex $fs 1]
4578 set y0 [expr {int($f0 * $ymax)}]
4579 set y1 [expr {int($f1 * $ymax)}]
4581 if {[info exists targetid]} {
4582 if {[commitinview $targetid $curview]} {
4583 set r [rowofcommit $targetid]
4584 if {$r != $targetrow} {
4585 # Fix up the scrollregion and change the scrolling position
4586 # now that our target row has moved.
4587 set diff [expr {($r - $targetrow) * $linespc}]
4588 set targetrow $r
4589 setcanvscroll
4590 set ymax [lindex [$canv cget -scrollregion] 3]
4591 incr y0 $diff
4592 incr y1 $diff
4593 set f0 [expr {$y0 / $ymax}]
4594 set f1 [expr {$y1 / $ymax}]
4595 allcanvs yview moveto $f0
4596 $cscroll set $f0 $f1
4597 set need_redisplay 1
4599 } else {
4600 unset targetid
4604 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4605 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4606 if {$endrow >= $vrowmod($curview)} {
4607 update_arcrows $curview
4609 if {[info exists selectedline] &&
4610 $row <= $selectedline && $selectedline <= $endrow} {
4611 set targetrow $selectedline
4612 } else {
4613 set targetrow [expr {int(($row + $endrow) / 2)}]
4615 if {$targetrow >= $numcommits} {
4616 set targetrow [expr {$numcommits - 1}]
4618 set targetid [commitonrow $targetrow]
4619 drawcommits $row $endrow
4622 proc clear_display {} {
4623 global iddrawn linesegs need_redisplay nrows_drawn
4624 global vhighlights fhighlights nhighlights rhighlights
4626 allcanvs delete all
4627 catch {unset iddrawn}
4628 catch {unset linesegs}
4629 catch {unset vhighlights}
4630 catch {unset fhighlights}
4631 catch {unset nhighlights}
4632 catch {unset rhighlights}
4633 set need_redisplay 0
4634 set nrows_drawn 0
4637 proc findcrossings {id} {
4638 global rowidlist parentlist numcommits displayorder
4640 set cross {}
4641 set ccross {}
4642 foreach {s e} [rowranges $id] {
4643 if {$e >= $numcommits} {
4644 set e [expr {$numcommits - 1}]
4646 if {$e <= $s} continue
4647 for {set row $e} {[incr row -1] >= $s} {} {
4648 set x [lsearch -exact [lindex $rowidlist $row] $id]
4649 if {$x < 0} break
4650 set olds [lindex $parentlist $row]
4651 set kid [lindex $displayorder $row]
4652 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4653 if {$kidx < 0} continue
4654 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4655 foreach p $olds {
4656 set px [lsearch -exact $nextrow $p]
4657 if {$px < 0} continue
4658 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4659 if {[lsearch -exact $ccross $p] >= 0} continue
4660 if {$x == $px + ($kidx < $px? -1: 1)} {
4661 lappend ccross $p
4662 } elseif {[lsearch -exact $cross $p] < 0} {
4663 lappend cross $p
4669 return [concat $ccross {{}} $cross]
4672 proc assigncolor {id} {
4673 global colormap colors nextcolor
4674 global parents children children curview
4676 if {[info exists colormap($id)]} return
4677 set ncolors [llength $colors]
4678 if {[info exists children($curview,$id)]} {
4679 set kids $children($curview,$id)
4680 } else {
4681 set kids {}
4683 if {[llength $kids] == 1} {
4684 set child [lindex $kids 0]
4685 if {[info exists colormap($child)]
4686 && [llength $parents($curview,$child)] == 1} {
4687 set colormap($id) $colormap($child)
4688 return
4691 set badcolors {}
4692 set origbad {}
4693 foreach x [findcrossings $id] {
4694 if {$x eq {}} {
4695 # delimiter between corner crossings and other crossings
4696 if {[llength $badcolors] >= $ncolors - 1} break
4697 set origbad $badcolors
4699 if {[info exists colormap($x)]
4700 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4701 lappend badcolors $colormap($x)
4704 if {[llength $badcolors] >= $ncolors} {
4705 set badcolors $origbad
4707 set origbad $badcolors
4708 if {[llength $badcolors] < $ncolors - 1} {
4709 foreach child $kids {
4710 if {[info exists colormap($child)]
4711 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4712 lappend badcolors $colormap($child)
4714 foreach p $parents($curview,$child) {
4715 if {[info exists colormap($p)]
4716 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4717 lappend badcolors $colormap($p)
4721 if {[llength $badcolors] >= $ncolors} {
4722 set badcolors $origbad
4725 for {set i 0} {$i <= $ncolors} {incr i} {
4726 set c [lindex $colors $nextcolor]
4727 if {[incr nextcolor] >= $ncolors} {
4728 set nextcolor 0
4730 if {[lsearch -exact $badcolors $c]} break
4732 set colormap($id) $c
4735 proc bindline {t id} {
4736 global canv
4738 $canv bind $t <Enter> "lineenter %x %y $id"
4739 $canv bind $t <Motion> "linemotion %x %y $id"
4740 $canv bind $t <Leave> "lineleave $id"
4741 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4744 proc drawtags {id x xt y1} {
4745 global idtags idheads idotherrefs mainhead
4746 global linespc lthickness
4747 global canv rowtextx curview fgcolor bgcolor
4749 set marks {}
4750 set ntags 0
4751 set nheads 0
4752 if {[info exists idtags($id)]} {
4753 set marks $idtags($id)
4754 set ntags [llength $marks]
4756 if {[info exists idheads($id)]} {
4757 set marks [concat $marks $idheads($id)]
4758 set nheads [llength $idheads($id)]
4760 if {[info exists idotherrefs($id)]} {
4761 set marks [concat $marks $idotherrefs($id)]
4763 if {$marks eq {}} {
4764 return $xt
4767 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4768 set yt [expr {$y1 - 0.5 * $linespc}]
4769 set yb [expr {$yt + $linespc - 1}]
4770 set xvals {}
4771 set wvals {}
4772 set i -1
4773 foreach tag $marks {
4774 incr i
4775 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4776 set wid [font measure mainfontbold $tag]
4777 } else {
4778 set wid [font measure mainfont $tag]
4780 lappend xvals $xt
4781 lappend wvals $wid
4782 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4784 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4785 -width $lthickness -fill black -tags tag.$id]
4786 $canv lower $t
4787 foreach tag $marks x $xvals wid $wvals {
4788 set xl [expr {$x + $delta}]
4789 set xr [expr {$x + $delta + $wid + $lthickness}]
4790 set font mainfont
4791 if {[incr ntags -1] >= 0} {
4792 # draw a tag
4793 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4794 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4795 -width 1 -outline black -fill yellow -tags tag.$id]
4796 $canv bind $t <1> [list showtag $tag 1]
4797 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4798 } else {
4799 # draw a head or other ref
4800 if {[incr nheads -1] >= 0} {
4801 set col green
4802 if {$tag eq $mainhead} {
4803 set font mainfontbold
4805 } else {
4806 set col "#ddddff"
4808 set xl [expr {$xl - $delta/2}]
4809 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4810 -width 1 -outline black -fill $col -tags tag.$id
4811 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4812 set rwid [font measure mainfont $remoteprefix]
4813 set xi [expr {$x + 1}]
4814 set yti [expr {$yt + 1}]
4815 set xri [expr {$x + $rwid}]
4816 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4817 -width 0 -fill "#ffddaa" -tags tag.$id
4820 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4821 -font $font -tags [list tag.$id text]]
4822 if {$ntags >= 0} {
4823 $canv bind $t <1> [list showtag $tag 1]
4824 } elseif {$nheads >= 0} {
4825 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4828 return $xt
4831 proc xcoord {i level ln} {
4832 global canvx0 xspc1 xspc2
4834 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4835 if {$i > 0 && $i == $level} {
4836 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4837 } elseif {$i > $level} {
4838 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4840 return $x
4843 proc show_status {msg} {
4844 global canv fgcolor
4846 clear_display
4847 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4848 -tags text -fill $fgcolor
4851 # Don't change the text pane cursor if it is currently the hand cursor,
4852 # showing that we are over a sha1 ID link.
4853 proc settextcursor {c} {
4854 global ctext curtextcursor
4856 if {[$ctext cget -cursor] == $curtextcursor} {
4857 $ctext config -cursor $c
4859 set curtextcursor $c
4862 proc nowbusy {what {name {}}} {
4863 global isbusy busyname statusw
4865 if {[array names isbusy] eq {}} {
4866 . config -cursor watch
4867 settextcursor watch
4869 set isbusy($what) 1
4870 set busyname($what) $name
4871 if {$name ne {}} {
4872 $statusw conf -text $name
4876 proc notbusy {what} {
4877 global isbusy maincursor textcursor busyname statusw
4879 catch {
4880 unset isbusy($what)
4881 if {$busyname($what) ne {} &&
4882 [$statusw cget -text] eq $busyname($what)} {
4883 $statusw conf -text {}
4886 if {[array names isbusy] eq {}} {
4887 . config -cursor $maincursor
4888 settextcursor $textcursor
4892 proc findmatches {f} {
4893 global findtype findstring
4894 if {$findtype == [mc "Regexp"]} {
4895 set matches [regexp -indices -all -inline $findstring $f]
4896 } else {
4897 set fs $findstring
4898 if {$findtype == [mc "IgnCase"]} {
4899 set f [string tolower $f]
4900 set fs [string tolower $fs]
4902 set matches {}
4903 set i 0
4904 set l [string length $fs]
4905 while {[set j [string first $fs $f $i]] >= 0} {
4906 lappend matches [list $j [expr {$j+$l-1}]]
4907 set i [expr {$j + $l}]
4910 return $matches
4913 proc dofind {{dirn 1} {wrap 1}} {
4914 global findstring findstartline findcurline selectedline numcommits
4915 global gdttype filehighlight fh_serial find_dirn findallowwrap
4917 if {[info exists find_dirn]} {
4918 if {$find_dirn == $dirn} return
4919 stopfinding
4921 focus .
4922 if {$findstring eq {} || $numcommits == 0} return
4923 if {![info exists selectedline]} {
4924 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4925 } else {
4926 set findstartline $selectedline
4928 set findcurline $findstartline
4929 nowbusy finding [mc "Searching"]
4930 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4931 after cancel do_file_hl $fh_serial
4932 do_file_hl $fh_serial
4934 set find_dirn $dirn
4935 set findallowwrap $wrap
4936 run findmore
4939 proc stopfinding {} {
4940 global find_dirn findcurline fprogcoord
4942 if {[info exists find_dirn]} {
4943 unset find_dirn
4944 unset findcurline
4945 notbusy finding
4946 set fprogcoord 0
4947 adjustprogress
4951 proc findmore {} {
4952 global commitdata commitinfo numcommits findpattern findloc
4953 global findstartline findcurline findallowwrap
4954 global find_dirn gdttype fhighlights fprogcoord
4955 global curview varcorder vrownum varccommits vrowmod
4957 if {![info exists find_dirn]} {
4958 return 0
4960 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4961 set l $findcurline
4962 set moretodo 0
4963 if {$find_dirn > 0} {
4964 incr l
4965 if {$l >= $numcommits} {
4966 set l 0
4968 if {$l <= $findstartline} {
4969 set lim [expr {$findstartline + 1}]
4970 } else {
4971 set lim $numcommits
4972 set moretodo $findallowwrap
4974 } else {
4975 if {$l == 0} {
4976 set l $numcommits
4978 incr l -1
4979 if {$l >= $findstartline} {
4980 set lim [expr {$findstartline - 1}]
4981 } else {
4982 set lim -1
4983 set moretodo $findallowwrap
4986 set n [expr {($lim - $l) * $find_dirn}]
4987 if {$n > 500} {
4988 set n 500
4989 set moretodo 1
4991 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
4992 update_arcrows $curview
4994 set found 0
4995 set domore 1
4996 set ai [bsearch $vrownum($curview) $l]
4997 set a [lindex $varcorder($curview) $ai]
4998 set arow [lindex $vrownum($curview) $ai]
4999 set ids [lindex $varccommits($curview,$a)]
5000 set arowend [expr {$arow + [llength $ids]}]
5001 if {$gdttype eq [mc "containing:"]} {
5002 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5003 if {$l < $arow || $l >= $arowend} {
5004 incr ai $find_dirn
5005 set a [lindex $varcorder($curview) $ai]
5006 set arow [lindex $vrownum($curview) $ai]
5007 set ids [lindex $varccommits($curview,$a)]
5008 set arowend [expr {$arow + [llength $ids]}]
5010 set id [lindex $ids [expr {$l - $arow}]]
5011 # shouldn't happen unless git log doesn't give all the commits...
5012 if {![info exists commitdata($id)] ||
5013 ![doesmatch $commitdata($id)]} {
5014 continue
5016 if {![info exists commitinfo($id)]} {
5017 getcommit $id
5019 set info $commitinfo($id)
5020 foreach f $info ty $fldtypes {
5021 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5022 [doesmatch $f]} {
5023 set found 1
5024 break
5027 if {$found} break
5029 } else {
5030 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5031 if {$l < $arow || $l >= $arowend} {
5032 incr ai $find_dirn
5033 set a [lindex $varcorder($curview) $ai]
5034 set arow [lindex $vrownum($curview) $ai]
5035 set ids [lindex $varccommits($curview,$a)]
5036 set arowend [expr {$arow + [llength $ids]}]
5038 set id [lindex $ids [expr {$l - $arow}]]
5039 if {![info exists fhighlights($id)]} {
5040 # this sets fhighlights($id) to -1
5041 askfilehighlight $l $id
5043 if {$fhighlights($id) > 0} {
5044 set found $domore
5045 break
5047 if {$fhighlights($id) < 0} {
5048 if {$domore} {
5049 set domore 0
5050 set findcurline [expr {$l - $find_dirn}]
5055 if {$found || ($domore && !$moretodo)} {
5056 unset findcurline
5057 unset find_dirn
5058 notbusy finding
5059 set fprogcoord 0
5060 adjustprogress
5061 if {$found} {
5062 findselectline $l
5063 } else {
5064 bell
5066 return 0
5068 if {!$domore} {
5069 flushhighlights
5070 } else {
5071 set findcurline [expr {$l - $find_dirn}]
5073 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5074 if {$n < 0} {
5075 incr n $numcommits
5077 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5078 adjustprogress
5079 return $domore
5082 proc findselectline {l} {
5083 global findloc commentend ctext findcurline markingmatches gdttype
5085 set markingmatches 1
5086 set findcurline $l
5087 selectline $l 1
5088 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5089 # highlight the matches in the comments
5090 set f [$ctext get 1.0 $commentend]
5091 set matches [findmatches $f]
5092 foreach match $matches {
5093 set start [lindex $match 0]
5094 set end [expr {[lindex $match 1] + 1}]
5095 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5098 drawvisible
5101 # mark the bits of a headline or author that match a find string
5102 proc markmatches {canv l str tag matches font row} {
5103 global selectedline
5105 set bbox [$canv bbox $tag]
5106 set x0 [lindex $bbox 0]
5107 set y0 [lindex $bbox 1]
5108 set y1 [lindex $bbox 3]
5109 foreach match $matches {
5110 set start [lindex $match 0]
5111 set end [lindex $match 1]
5112 if {$start > $end} continue
5113 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5114 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5115 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5116 [expr {$x0+$xlen+2}] $y1 \
5117 -outline {} -tags [list match$l matches] -fill yellow]
5118 $canv lower $t
5119 if {[info exists selectedline] && $row == $selectedline} {
5120 $canv raise $t secsel
5125 proc unmarkmatches {} {
5126 global markingmatches
5128 allcanvs delete matches
5129 set markingmatches 0
5130 stopfinding
5133 proc selcanvline {w x y} {
5134 global canv canvy0 ctext linespc
5135 global rowtextx
5136 set ymax [lindex [$canv cget -scrollregion] 3]
5137 if {$ymax == {}} return
5138 set yfrac [lindex [$canv yview] 0]
5139 set y [expr {$y + $yfrac * $ymax}]
5140 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5141 if {$l < 0} {
5142 set l 0
5144 if {$w eq $canv} {
5145 set xmax [lindex [$canv cget -scrollregion] 2]
5146 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5147 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5149 unmarkmatches
5150 selectline $l 1
5153 proc commit_descriptor {p} {
5154 global commitinfo
5155 if {![info exists commitinfo($p)]} {
5156 getcommit $p
5158 set l "..."
5159 if {[llength $commitinfo($p)] > 1} {
5160 set l [lindex $commitinfo($p) 0]
5162 return "$p ($l)\n"
5165 # append some text to the ctext widget, and make any SHA1 ID
5166 # that we know about be a clickable link.
5167 proc appendwithlinks {text tags} {
5168 global ctext linknum curview pendinglinks
5170 set start [$ctext index "end - 1c"]
5171 $ctext insert end $text $tags
5172 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5173 foreach l $links {
5174 set s [lindex $l 0]
5175 set e [lindex $l 1]
5176 set linkid [string range $text $s $e]
5177 incr e
5178 $ctext tag delete link$linknum
5179 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5180 setlink $linkid link$linknum
5181 incr linknum
5185 proc setlink {id lk} {
5186 global curview ctext pendinglinks commitinterest
5188 if {[commitinview $id $curview]} {
5189 $ctext tag conf $lk -foreground blue -underline 1
5190 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5191 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5192 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5193 } else {
5194 lappend pendinglinks($id) $lk
5195 lappend commitinterest($id) {makelink %I}
5199 proc makelink {id} {
5200 global pendinglinks
5202 if {![info exists pendinglinks($id)]} return
5203 foreach lk $pendinglinks($id) {
5204 setlink $id $lk
5206 unset pendinglinks($id)
5209 proc linkcursor {w inc} {
5210 global linkentercount curtextcursor
5212 if {[incr linkentercount $inc] > 0} {
5213 $w configure -cursor hand2
5214 } else {
5215 $w configure -cursor $curtextcursor
5216 if {$linkentercount < 0} {
5217 set linkentercount 0
5222 proc viewnextline {dir} {
5223 global canv linespc
5225 $canv delete hover
5226 set ymax [lindex [$canv cget -scrollregion] 3]
5227 set wnow [$canv yview]
5228 set wtop [expr {[lindex $wnow 0] * $ymax}]
5229 set newtop [expr {$wtop + $dir * $linespc}]
5230 if {$newtop < 0} {
5231 set newtop 0
5232 } elseif {$newtop > $ymax} {
5233 set newtop $ymax
5235 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5238 # add a list of tag or branch names at position pos
5239 # returns the number of names inserted
5240 proc appendrefs {pos ids var} {
5241 global ctext linknum curview $var maxrefs
5243 if {[catch {$ctext index $pos}]} {
5244 return 0
5246 $ctext conf -state normal
5247 $ctext delete $pos "$pos lineend"
5248 set tags {}
5249 foreach id $ids {
5250 foreach tag [set $var\($id\)] {
5251 lappend tags [list $tag $id]
5254 if {[llength $tags] > $maxrefs} {
5255 $ctext insert $pos "many ([llength $tags])"
5256 } else {
5257 set tags [lsort -index 0 -decreasing $tags]
5258 set sep {}
5259 foreach ti $tags {
5260 set id [lindex $ti 1]
5261 set lk link$linknum
5262 incr linknum
5263 $ctext tag delete $lk
5264 $ctext insert $pos $sep
5265 $ctext insert $pos [lindex $ti 0] $lk
5266 setlink $id $lk
5267 set sep ", "
5270 $ctext conf -state disabled
5271 return [llength $tags]
5274 # called when we have finished computing the nearby tags
5275 proc dispneartags {delay} {
5276 global selectedline currentid showneartags tagphase
5278 if {![info exists selectedline] || !$showneartags} return
5279 after cancel dispnexttag
5280 if {$delay} {
5281 after 200 dispnexttag
5282 set tagphase -1
5283 } else {
5284 after idle dispnexttag
5285 set tagphase 0
5289 proc dispnexttag {} {
5290 global selectedline currentid showneartags tagphase ctext
5292 if {![info exists selectedline] || !$showneartags} return
5293 switch -- $tagphase {
5295 set dtags [desctags $currentid]
5296 if {$dtags ne {}} {
5297 appendrefs precedes $dtags idtags
5301 set atags [anctags $currentid]
5302 if {$atags ne {}} {
5303 appendrefs follows $atags idtags
5307 set dheads [descheads $currentid]
5308 if {$dheads ne {}} {
5309 if {[appendrefs branch $dheads idheads] > 1
5310 && [$ctext get "branch -3c"] eq "h"} {
5311 # turn "Branch" into "Branches"
5312 $ctext conf -state normal
5313 $ctext insert "branch -2c" "es"
5314 $ctext conf -state disabled
5319 if {[incr tagphase] <= 2} {
5320 after idle dispnexttag
5324 proc make_secsel {l} {
5325 global linehtag linentag linedtag canv canv2 canv3
5327 if {![info exists linehtag($l)]} return
5328 $canv delete secsel
5329 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5330 -tags secsel -fill [$canv cget -selectbackground]]
5331 $canv lower $t
5332 $canv2 delete secsel
5333 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5334 -tags secsel -fill [$canv2 cget -selectbackground]]
5335 $canv2 lower $t
5336 $canv3 delete secsel
5337 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5338 -tags secsel -fill [$canv3 cget -selectbackground]]
5339 $canv3 lower $t
5342 proc selectline {l isnew} {
5343 global canv ctext commitinfo selectedline
5344 global canvy0 linespc parents children curview
5345 global currentid sha1entry
5346 global commentend idtags linknum
5347 global mergemax numcommits pending_select
5348 global cmitmode showneartags allcommits
5350 catch {unset pending_select}
5351 $canv delete hover
5352 normalline
5353 unsel_reflist
5354 stopfinding
5355 if {$l < 0 || $l >= $numcommits} return
5356 set y [expr {$canvy0 + $l * $linespc}]
5357 set ymax [lindex [$canv cget -scrollregion] 3]
5358 set ytop [expr {$y - $linespc - 1}]
5359 set ybot [expr {$y + $linespc + 1}]
5360 set wnow [$canv yview]
5361 set wtop [expr {[lindex $wnow 0] * $ymax}]
5362 set wbot [expr {[lindex $wnow 1] * $ymax}]
5363 set wh [expr {$wbot - $wtop}]
5364 set newtop $wtop
5365 if {$ytop < $wtop} {
5366 if {$ybot < $wtop} {
5367 set newtop [expr {$y - $wh / 2.0}]
5368 } else {
5369 set newtop $ytop
5370 if {$newtop > $wtop - $linespc} {
5371 set newtop [expr {$wtop - $linespc}]
5374 } elseif {$ybot > $wbot} {
5375 if {$ytop > $wbot} {
5376 set newtop [expr {$y - $wh / 2.0}]
5377 } else {
5378 set newtop [expr {$ybot - $wh}]
5379 if {$newtop < $wtop + $linespc} {
5380 set newtop [expr {$wtop + $linespc}]
5384 if {$newtop != $wtop} {
5385 if {$newtop < 0} {
5386 set newtop 0
5388 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5389 drawvisible
5392 make_secsel $l
5394 set id [commitonrow $l]
5395 if {$isnew} {
5396 addtohistory [list selbyid $id]
5399 set selectedline $l
5400 set currentid $id
5401 $sha1entry delete 0 end
5402 $sha1entry insert 0 $id
5403 $sha1entry selection from 0
5404 $sha1entry selection to end
5405 rhighlight_sel $id
5407 $ctext conf -state normal
5408 clear_ctext
5409 set linknum 0
5410 set info $commitinfo($id)
5411 set date [formatdate [lindex $info 2]]
5412 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5413 set date [formatdate [lindex $info 4]]
5414 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5415 if {[info exists idtags($id)]} {
5416 $ctext insert end [mc "Tags:"]
5417 foreach tag $idtags($id) {
5418 $ctext insert end " $tag"
5420 $ctext insert end "\n"
5423 set headers {}
5424 set olds $parents($curview,$id)
5425 if {[llength $olds] > 1} {
5426 set np 0
5427 foreach p $olds {
5428 if {$np >= $mergemax} {
5429 set tag mmax
5430 } else {
5431 set tag m$np
5433 $ctext insert end "[mc "Parent"]: " $tag
5434 appendwithlinks [commit_descriptor $p] {}
5435 incr np
5437 } else {
5438 foreach p $olds {
5439 append headers "[mc "Parent"]: [commit_descriptor $p]"
5443 foreach c $children($curview,$id) {
5444 append headers "[mc "Child"]: [commit_descriptor $c]"
5447 # make anything that looks like a SHA1 ID be a clickable link
5448 appendwithlinks $headers {}
5449 if {$showneartags} {
5450 if {![info exists allcommits]} {
5451 getallcommits
5453 $ctext insert end "[mc "Branch"]: "
5454 $ctext mark set branch "end -1c"
5455 $ctext mark gravity branch left
5456 $ctext insert end "\n[mc "Follows"]: "
5457 $ctext mark set follows "end -1c"
5458 $ctext mark gravity follows left
5459 $ctext insert end "\n[mc "Precedes"]: "
5460 $ctext mark set precedes "end -1c"
5461 $ctext mark gravity precedes left
5462 $ctext insert end "\n"
5463 dispneartags 1
5465 $ctext insert end "\n"
5466 set comment [lindex $info 5]
5467 if {[string first "\r" $comment] >= 0} {
5468 set comment [string map {"\r" "\n "} $comment]
5470 appendwithlinks $comment {comment}
5472 $ctext tag remove found 1.0 end
5473 $ctext conf -state disabled
5474 set commentend [$ctext index "end - 1c"]
5476 init_flist [mc "Comments"]
5477 if {$cmitmode eq "tree"} {
5478 gettree $id
5479 } elseif {[llength $olds] <= 1} {
5480 startdiff $id
5481 } else {
5482 mergediff $id
5486 proc selfirstline {} {
5487 unmarkmatches
5488 selectline 0 1
5491 proc sellastline {} {
5492 global numcommits
5493 unmarkmatches
5494 set l [expr {$numcommits - 1}]
5495 selectline $l 1
5498 proc selnextline {dir} {
5499 global selectedline
5500 focus .
5501 if {![info exists selectedline]} return
5502 set l [expr {$selectedline + $dir}]
5503 unmarkmatches
5504 selectline $l 1
5507 proc selnextpage {dir} {
5508 global canv linespc selectedline numcommits
5510 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5511 if {$lpp < 1} {
5512 set lpp 1
5514 allcanvs yview scroll [expr {$dir * $lpp}] units
5515 drawvisible
5516 if {![info exists selectedline]} return
5517 set l [expr {$selectedline + $dir * $lpp}]
5518 if {$l < 0} {
5519 set l 0
5520 } elseif {$l >= $numcommits} {
5521 set l [expr $numcommits - 1]
5523 unmarkmatches
5524 selectline $l 1
5527 proc unselectline {} {
5528 global selectedline currentid
5530 catch {unset selectedline}
5531 catch {unset currentid}
5532 allcanvs delete secsel
5533 rhighlight_none
5536 proc reselectline {} {
5537 global selectedline
5539 if {[info exists selectedline]} {
5540 selectline $selectedline 0
5544 proc addtohistory {cmd} {
5545 global history historyindex curview
5547 set elt [list $curview $cmd]
5548 if {$historyindex > 0
5549 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5550 return
5553 if {$historyindex < [llength $history]} {
5554 set history [lreplace $history $historyindex end $elt]
5555 } else {
5556 lappend history $elt
5558 incr historyindex
5559 if {$historyindex > 1} {
5560 .tf.bar.leftbut conf -state normal
5561 } else {
5562 .tf.bar.leftbut conf -state disabled
5564 .tf.bar.rightbut conf -state disabled
5567 proc godo {elt} {
5568 global curview
5570 set view [lindex $elt 0]
5571 set cmd [lindex $elt 1]
5572 if {$curview != $view} {
5573 showview $view
5575 eval $cmd
5578 proc goback {} {
5579 global history historyindex
5580 focus .
5582 if {$historyindex > 1} {
5583 incr historyindex -1
5584 godo [lindex $history [expr {$historyindex - 1}]]
5585 .tf.bar.rightbut conf -state normal
5587 if {$historyindex <= 1} {
5588 .tf.bar.leftbut conf -state disabled
5592 proc goforw {} {
5593 global history historyindex
5594 focus .
5596 if {$historyindex < [llength $history]} {
5597 set cmd [lindex $history $historyindex]
5598 incr historyindex
5599 godo $cmd
5600 .tf.bar.leftbut conf -state normal
5602 if {$historyindex >= [llength $history]} {
5603 .tf.bar.rightbut conf -state disabled
5607 proc gettree {id} {
5608 global treefilelist treeidlist diffids diffmergeid treepending
5609 global nullid nullid2
5611 set diffids $id
5612 catch {unset diffmergeid}
5613 if {![info exists treefilelist($id)]} {
5614 if {![info exists treepending]} {
5615 if {$id eq $nullid} {
5616 set cmd [list | git ls-files]
5617 } elseif {$id eq $nullid2} {
5618 set cmd [list | git ls-files --stage -t]
5619 } else {
5620 set cmd [list | git ls-tree -r $id]
5622 if {[catch {set gtf [open $cmd r]}]} {
5623 return
5625 set treepending $id
5626 set treefilelist($id) {}
5627 set treeidlist($id) {}
5628 fconfigure $gtf -blocking 0
5629 filerun $gtf [list gettreeline $gtf $id]
5631 } else {
5632 setfilelist $id
5636 proc gettreeline {gtf id} {
5637 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5639 set nl 0
5640 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5641 if {$diffids eq $nullid} {
5642 set fname $line
5643 } else {
5644 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5645 set i [string first "\t" $line]
5646 if {$i < 0} continue
5647 set sha1 [lindex $line 2]
5648 set fname [string range $line [expr {$i+1}] end]
5649 if {[string index $fname 0] eq "\""} {
5650 set fname [lindex $fname 0]
5652 lappend treeidlist($id) $sha1
5654 lappend treefilelist($id) $fname
5656 if {![eof $gtf]} {
5657 return [expr {$nl >= 1000? 2: 1}]
5659 close $gtf
5660 unset treepending
5661 if {$cmitmode ne "tree"} {
5662 if {![info exists diffmergeid]} {
5663 gettreediffs $diffids
5665 } elseif {$id ne $diffids} {
5666 gettree $diffids
5667 } else {
5668 setfilelist $id
5670 return 0
5673 proc showfile {f} {
5674 global treefilelist treeidlist diffids nullid nullid2
5675 global ctext commentend
5677 set i [lsearch -exact $treefilelist($diffids) $f]
5678 if {$i < 0} {
5679 puts "oops, $f not in list for id $diffids"
5680 return
5682 if {$diffids eq $nullid} {
5683 if {[catch {set bf [open $f r]} err]} {
5684 puts "oops, can't read $f: $err"
5685 return
5687 } else {
5688 set blob [lindex $treeidlist($diffids) $i]
5689 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5690 puts "oops, error reading blob $blob: $err"
5691 return
5694 fconfigure $bf -blocking 0
5695 filerun $bf [list getblobline $bf $diffids]
5696 $ctext config -state normal
5697 clear_ctext $commentend
5698 $ctext insert end "\n"
5699 $ctext insert end "$f\n" filesep
5700 $ctext config -state disabled
5701 $ctext yview $commentend
5702 settabs 0
5705 proc getblobline {bf id} {
5706 global diffids cmitmode ctext
5708 if {$id ne $diffids || $cmitmode ne "tree"} {
5709 catch {close $bf}
5710 return 0
5712 $ctext config -state normal
5713 set nl 0
5714 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5715 $ctext insert end "$line\n"
5717 if {[eof $bf]} {
5718 # delete last newline
5719 $ctext delete "end - 2c" "end - 1c"
5720 close $bf
5721 return 0
5723 $ctext config -state disabled
5724 return [expr {$nl >= 1000? 2: 1}]
5727 proc mergediff {id} {
5728 global diffmergeid mdifffd
5729 global diffids
5730 global parents
5731 global limitdiffs viewfiles curview
5733 set diffmergeid $id
5734 set diffids $id
5735 # this doesn't seem to actually affect anything...
5736 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5737 if {$limitdiffs && $viewfiles($curview) ne {}} {
5738 set cmd [concat $cmd -- $viewfiles($curview)]
5740 if {[catch {set mdf [open $cmd r]} err]} {
5741 error_popup "[mc "Error getting merge diffs:"] $err"
5742 return
5744 fconfigure $mdf -blocking 0
5745 set mdifffd($id) $mdf
5746 set np [llength $parents($curview,$id)]
5747 settabs $np
5748 filerun $mdf [list getmergediffline $mdf $id $np]
5751 proc getmergediffline {mdf id np} {
5752 global diffmergeid ctext cflist mergemax
5753 global difffilestart mdifffd
5755 $ctext conf -state normal
5756 set nr 0
5757 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5758 if {![info exists diffmergeid] || $id != $diffmergeid
5759 || $mdf != $mdifffd($id)} {
5760 close $mdf
5761 return 0
5763 if {[regexp {^diff --cc (.*)} $line match fname]} {
5764 # start of a new file
5765 $ctext insert end "\n"
5766 set here [$ctext index "end - 1c"]
5767 lappend difffilestart $here
5768 add_flist [list $fname]
5769 set l [expr {(78 - [string length $fname]) / 2}]
5770 set pad [string range "----------------------------------------" 1 $l]
5771 $ctext insert end "$pad $fname $pad\n" filesep
5772 } elseif {[regexp {^@@} $line]} {
5773 $ctext insert end "$line\n" hunksep
5774 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5775 # do nothing
5776 } else {
5777 # parse the prefix - one ' ', '-' or '+' for each parent
5778 set spaces {}
5779 set minuses {}
5780 set pluses {}
5781 set isbad 0
5782 for {set j 0} {$j < $np} {incr j} {
5783 set c [string range $line $j $j]
5784 if {$c == " "} {
5785 lappend spaces $j
5786 } elseif {$c == "-"} {
5787 lappend minuses $j
5788 } elseif {$c == "+"} {
5789 lappend pluses $j
5790 } else {
5791 set isbad 1
5792 break
5795 set tags {}
5796 set num {}
5797 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5798 # line doesn't appear in result, parents in $minuses have the line
5799 set num [lindex $minuses 0]
5800 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5801 # line appears in result, parents in $pluses don't have the line
5802 lappend tags mresult
5803 set num [lindex $spaces 0]
5805 if {$num ne {}} {
5806 if {$num >= $mergemax} {
5807 set num "max"
5809 lappend tags m$num
5811 $ctext insert end "$line\n" $tags
5814 $ctext conf -state disabled
5815 if {[eof $mdf]} {
5816 close $mdf
5817 return 0
5819 return [expr {$nr >= 1000? 2: 1}]
5822 proc startdiff {ids} {
5823 global treediffs diffids treepending diffmergeid nullid nullid2
5825 settabs 1
5826 set diffids $ids
5827 catch {unset diffmergeid}
5828 if {![info exists treediffs($ids)] ||
5829 [lsearch -exact $ids $nullid] >= 0 ||
5830 [lsearch -exact $ids $nullid2] >= 0} {
5831 if {![info exists treepending]} {
5832 gettreediffs $ids
5834 } else {
5835 addtocflist $ids
5839 proc path_filter {filter name} {
5840 foreach p $filter {
5841 set l [string length $p]
5842 if {[string index $p end] eq "/"} {
5843 if {[string compare -length $l $p $name] == 0} {
5844 return 1
5846 } else {
5847 if {[string compare -length $l $p $name] == 0 &&
5848 ([string length $name] == $l ||
5849 [string index $name $l] eq "/")} {
5850 return 1
5854 return 0
5857 proc addtocflist {ids} {
5858 global treediffs
5860 add_flist $treediffs($ids)
5861 getblobdiffs $ids
5864 proc diffcmd {ids flags} {
5865 global nullid nullid2
5867 set i [lsearch -exact $ids $nullid]
5868 set j [lsearch -exact $ids $nullid2]
5869 if {$i >= 0} {
5870 if {[llength $ids] > 1 && $j < 0} {
5871 # comparing working directory with some specific revision
5872 set cmd [concat | git diff-index $flags]
5873 if {$i == 0} {
5874 lappend cmd -R [lindex $ids 1]
5875 } else {
5876 lappend cmd [lindex $ids 0]
5878 } else {
5879 # comparing working directory with index
5880 set cmd [concat | git diff-files $flags]
5881 if {$j == 1} {
5882 lappend cmd -R
5885 } elseif {$j >= 0} {
5886 set cmd [concat | git diff-index --cached $flags]
5887 if {[llength $ids] > 1} {
5888 # comparing index with specific revision
5889 if {$i == 0} {
5890 lappend cmd -R [lindex $ids 1]
5891 } else {
5892 lappend cmd [lindex $ids 0]
5894 } else {
5895 # comparing index with HEAD
5896 lappend cmd HEAD
5898 } else {
5899 set cmd [concat | git diff-tree -r $flags $ids]
5901 return $cmd
5904 proc gettreediffs {ids} {
5905 global treediff treepending
5907 set treepending $ids
5908 set treediff {}
5909 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5910 fconfigure $gdtf -blocking 0
5911 filerun $gdtf [list gettreediffline $gdtf $ids]
5914 proc gettreediffline {gdtf ids} {
5915 global treediff treediffs treepending diffids diffmergeid
5916 global cmitmode viewfiles curview limitdiffs
5918 set nr 0
5919 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5920 set i [string first "\t" $line]
5921 if {$i >= 0} {
5922 set file [string range $line [expr {$i+1}] end]
5923 if {[string index $file 0] eq "\""} {
5924 set file [lindex $file 0]
5926 lappend treediff $file
5929 if {![eof $gdtf]} {
5930 return [expr {$nr >= 1000? 2: 1}]
5932 close $gdtf
5933 if {$limitdiffs && $viewfiles($curview) ne {}} {
5934 set flist {}
5935 foreach f $treediff {
5936 if {[path_filter $viewfiles($curview) $f]} {
5937 lappend flist $f
5940 set treediffs($ids) $flist
5941 } else {
5942 set treediffs($ids) $treediff
5944 unset treepending
5945 if {$cmitmode eq "tree"} {
5946 gettree $diffids
5947 } elseif {$ids != $diffids} {
5948 if {![info exists diffmergeid]} {
5949 gettreediffs $diffids
5951 } else {
5952 addtocflist $ids
5954 return 0
5957 # empty string or positive integer
5958 proc diffcontextvalidate {v} {
5959 return [regexp {^(|[1-9][0-9]*)$} $v]
5962 proc diffcontextchange {n1 n2 op} {
5963 global diffcontextstring diffcontext
5965 if {[string is integer -strict $diffcontextstring]} {
5966 if {$diffcontextstring > 0} {
5967 set diffcontext $diffcontextstring
5968 reselectline
5973 proc getblobdiffs {ids} {
5974 global blobdifffd diffids env
5975 global diffinhdr treediffs
5976 global diffcontext
5977 global limitdiffs viewfiles curview
5979 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5980 if {$limitdiffs && $viewfiles($curview) ne {}} {
5981 set cmd [concat $cmd -- $viewfiles($curview)]
5983 if {[catch {set bdf [open $cmd r]} err]} {
5984 puts "error getting diffs: $err"
5985 return
5987 set diffinhdr 0
5988 fconfigure $bdf -blocking 0
5989 set blobdifffd($ids) $bdf
5990 filerun $bdf [list getblobdiffline $bdf $diffids]
5993 proc setinlist {var i val} {
5994 global $var
5996 while {[llength [set $var]] < $i} {
5997 lappend $var {}
5999 if {[llength [set $var]] == $i} {
6000 lappend $var $val
6001 } else {
6002 lset $var $i $val
6006 proc makediffhdr {fname ids} {
6007 global ctext curdiffstart treediffs
6009 set i [lsearch -exact $treediffs($ids) $fname]
6010 if {$i >= 0} {
6011 setinlist difffilestart $i $curdiffstart
6013 set l [expr {(78 - [string length $fname]) / 2}]
6014 set pad [string range "----------------------------------------" 1 $l]
6015 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6018 proc getblobdiffline {bdf ids} {
6019 global diffids blobdifffd ctext curdiffstart
6020 global diffnexthead diffnextnote difffilestart
6021 global diffinhdr treediffs
6023 set nr 0
6024 $ctext conf -state normal
6025 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6026 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6027 close $bdf
6028 return 0
6030 if {![string compare -length 11 "diff --git " $line]} {
6031 # trim off "diff --git "
6032 set line [string range $line 11 end]
6033 set diffinhdr 1
6034 # start of a new file
6035 $ctext insert end "\n"
6036 set curdiffstart [$ctext index "end - 1c"]
6037 $ctext insert end "\n" filesep
6038 # If the name hasn't changed the length will be odd,
6039 # the middle char will be a space, and the two bits either
6040 # side will be a/name and b/name, or "a/name" and "b/name".
6041 # If the name has changed we'll get "rename from" and
6042 # "rename to" or "copy from" and "copy to" lines following this,
6043 # and we'll use them to get the filenames.
6044 # This complexity is necessary because spaces in the filename(s)
6045 # don't get escaped.
6046 set l [string length $line]
6047 set i [expr {$l / 2}]
6048 if {!(($l & 1) && [string index $line $i] eq " " &&
6049 [string range $line 2 [expr {$i - 1}]] eq \
6050 [string range $line [expr {$i + 3}] end])} {
6051 continue
6053 # unescape if quoted and chop off the a/ from the front
6054 if {[string index $line 0] eq "\""} {
6055 set fname [string range [lindex $line 0] 2 end]
6056 } else {
6057 set fname [string range $line 2 [expr {$i - 1}]]
6059 makediffhdr $fname $ids
6061 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6062 $line match f1l f1c f2l f2c rest]} {
6063 $ctext insert end "$line\n" hunksep
6064 set diffinhdr 0
6066 } elseif {$diffinhdr} {
6067 if {![string compare -length 12 "rename from " $line]} {
6068 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6069 if {[string index $fname 0] eq "\""} {
6070 set fname [lindex $fname 0]
6072 set i [lsearch -exact $treediffs($ids) $fname]
6073 if {$i >= 0} {
6074 setinlist difffilestart $i $curdiffstart
6076 } elseif {![string compare -length 10 $line "rename to "] ||
6077 ![string compare -length 8 $line "copy to "]} {
6078 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6079 if {[string index $fname 0] eq "\""} {
6080 set fname [lindex $fname 0]
6082 makediffhdr $fname $ids
6083 } elseif {[string compare -length 3 $line "---"] == 0} {
6084 # do nothing
6085 continue
6086 } elseif {[string compare -length 3 $line "+++"] == 0} {
6087 set diffinhdr 0
6088 continue
6090 $ctext insert end "$line\n" filesep
6092 } else {
6093 set x [string range $line 0 0]
6094 if {$x == "-" || $x == "+"} {
6095 set tag [expr {$x == "+"}]
6096 $ctext insert end "$line\n" d$tag
6097 } elseif {$x == " "} {
6098 $ctext insert end "$line\n"
6099 } else {
6100 # "\ No newline at end of file",
6101 # or something else we don't recognize
6102 $ctext insert end "$line\n" hunksep
6106 $ctext conf -state disabled
6107 if {[eof $bdf]} {
6108 close $bdf
6109 return 0
6111 return [expr {$nr >= 1000? 2: 1}]
6114 proc changediffdisp {} {
6115 global ctext diffelide
6117 $ctext tag conf d0 -elide [lindex $diffelide 0]
6118 $ctext tag conf d1 -elide [lindex $diffelide 1]
6121 proc prevfile {} {
6122 global difffilestart ctext
6123 set prev [lindex $difffilestart 0]
6124 set here [$ctext index @0,0]
6125 foreach loc $difffilestart {
6126 if {[$ctext compare $loc >= $here]} {
6127 $ctext yview $prev
6128 return
6130 set prev $loc
6132 $ctext yview $prev
6135 proc nextfile {} {
6136 global difffilestart ctext
6137 set here [$ctext index @0,0]
6138 foreach loc $difffilestart {
6139 if {[$ctext compare $loc > $here]} {
6140 $ctext yview $loc
6141 return
6146 proc clear_ctext {{first 1.0}} {
6147 global ctext smarktop smarkbot
6148 global pendinglinks
6150 set l [lindex [split $first .] 0]
6151 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6152 set smarktop $l
6154 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6155 set smarkbot $l
6157 $ctext delete $first end
6158 if {$first eq "1.0"} {
6159 catch {unset pendinglinks}
6163 proc settabs {{firstab {}}} {
6164 global firsttabstop tabstop ctext have_tk85
6166 if {$firstab ne {} && $have_tk85} {
6167 set firsttabstop $firstab
6169 set w [font measure textfont "0"]
6170 if {$firsttabstop != 0} {
6171 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6172 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6173 } elseif {$have_tk85 || $tabstop != 8} {
6174 $ctext conf -tabs [expr {$tabstop * $w}]
6175 } else {
6176 $ctext conf -tabs {}
6180 proc incrsearch {name ix op} {
6181 global ctext searchstring searchdirn
6183 $ctext tag remove found 1.0 end
6184 if {[catch {$ctext index anchor}]} {
6185 # no anchor set, use start of selection, or of visible area
6186 set sel [$ctext tag ranges sel]
6187 if {$sel ne {}} {
6188 $ctext mark set anchor [lindex $sel 0]
6189 } elseif {$searchdirn eq "-forwards"} {
6190 $ctext mark set anchor @0,0
6191 } else {
6192 $ctext mark set anchor @0,[winfo height $ctext]
6195 if {$searchstring ne {}} {
6196 set here [$ctext search $searchdirn -- $searchstring anchor]
6197 if {$here ne {}} {
6198 $ctext see $here
6200 searchmarkvisible 1
6204 proc dosearch {} {
6205 global sstring ctext searchstring searchdirn
6207 focus $sstring
6208 $sstring icursor end
6209 set searchdirn -forwards
6210 if {$searchstring ne {}} {
6211 set sel [$ctext tag ranges sel]
6212 if {$sel ne {}} {
6213 set start "[lindex $sel 0] + 1c"
6214 } elseif {[catch {set start [$ctext index anchor]}]} {
6215 set start "@0,0"
6217 set match [$ctext search -count mlen -- $searchstring $start]
6218 $ctext tag remove sel 1.0 end
6219 if {$match eq {}} {
6220 bell
6221 return
6223 $ctext see $match
6224 set mend "$match + $mlen c"
6225 $ctext tag add sel $match $mend
6226 $ctext mark unset anchor
6230 proc dosearchback {} {
6231 global sstring ctext searchstring searchdirn
6233 focus $sstring
6234 $sstring icursor end
6235 set searchdirn -backwards
6236 if {$searchstring ne {}} {
6237 set sel [$ctext tag ranges sel]
6238 if {$sel ne {}} {
6239 set start [lindex $sel 0]
6240 } elseif {[catch {set start [$ctext index anchor]}]} {
6241 set start @0,[winfo height $ctext]
6243 set match [$ctext search -backwards -count ml -- $searchstring $start]
6244 $ctext tag remove sel 1.0 end
6245 if {$match eq {}} {
6246 bell
6247 return
6249 $ctext see $match
6250 set mend "$match + $ml c"
6251 $ctext tag add sel $match $mend
6252 $ctext mark unset anchor
6256 proc searchmark {first last} {
6257 global ctext searchstring
6259 set mend $first.0
6260 while {1} {
6261 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6262 if {$match eq {}} break
6263 set mend "$match + $mlen c"
6264 $ctext tag add found $match $mend
6268 proc searchmarkvisible {doall} {
6269 global ctext smarktop smarkbot
6271 set topline [lindex [split [$ctext index @0,0] .] 0]
6272 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6273 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6274 # no overlap with previous
6275 searchmark $topline $botline
6276 set smarktop $topline
6277 set smarkbot $botline
6278 } else {
6279 if {$topline < $smarktop} {
6280 searchmark $topline [expr {$smarktop-1}]
6281 set smarktop $topline
6283 if {$botline > $smarkbot} {
6284 searchmark [expr {$smarkbot+1}] $botline
6285 set smarkbot $botline
6290 proc scrolltext {f0 f1} {
6291 global searchstring
6293 .bleft.sb set $f0 $f1
6294 if {$searchstring ne {}} {
6295 searchmarkvisible 0
6299 proc setcoords {} {
6300 global linespc charspc canvx0 canvy0
6301 global xspc1 xspc2 lthickness
6303 set linespc [font metrics mainfont -linespace]
6304 set charspc [font measure mainfont "m"]
6305 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6306 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6307 set lthickness [expr {int($linespc / 9) + 1}]
6308 set xspc1(0) $linespc
6309 set xspc2 $linespc
6312 proc redisplay {} {
6313 global canv
6314 global selectedline
6316 set ymax [lindex [$canv cget -scrollregion] 3]
6317 if {$ymax eq {} || $ymax == 0} return
6318 set span [$canv yview]
6319 clear_display
6320 setcanvscroll
6321 allcanvs yview moveto [lindex $span 0]
6322 drawvisible
6323 if {[info exists selectedline]} {
6324 selectline $selectedline 0
6325 allcanvs yview moveto [lindex $span 0]
6329 proc parsefont {f n} {
6330 global fontattr
6332 set fontattr($f,family) [lindex $n 0]
6333 set s [lindex $n 1]
6334 if {$s eq {} || $s == 0} {
6335 set s 10
6336 } elseif {$s < 0} {
6337 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6339 set fontattr($f,size) $s
6340 set fontattr($f,weight) normal
6341 set fontattr($f,slant) roman
6342 foreach style [lrange $n 2 end] {
6343 switch -- $style {
6344 "normal" -
6345 "bold" {set fontattr($f,weight) $style}
6346 "roman" -
6347 "italic" {set fontattr($f,slant) $style}
6352 proc fontflags {f {isbold 0}} {
6353 global fontattr
6355 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6356 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6357 -slant $fontattr($f,slant)]
6360 proc fontname {f} {
6361 global fontattr
6363 set n [list $fontattr($f,family) $fontattr($f,size)]
6364 if {$fontattr($f,weight) eq "bold"} {
6365 lappend n "bold"
6367 if {$fontattr($f,slant) eq "italic"} {
6368 lappend n "italic"
6370 return $n
6373 proc incrfont {inc} {
6374 global mainfont textfont ctext canv cflist showrefstop
6375 global stopped entries fontattr
6377 unmarkmatches
6378 set s $fontattr(mainfont,size)
6379 incr s $inc
6380 if {$s < 1} {
6381 set s 1
6383 set fontattr(mainfont,size) $s
6384 font config mainfont -size $s
6385 font config mainfontbold -size $s
6386 set mainfont [fontname mainfont]
6387 set s $fontattr(textfont,size)
6388 incr s $inc
6389 if {$s < 1} {
6390 set s 1
6392 set fontattr(textfont,size) $s
6393 font config textfont -size $s
6394 font config textfontbold -size $s
6395 set textfont [fontname textfont]
6396 setcoords
6397 settabs
6398 redisplay
6401 proc clearsha1 {} {
6402 global sha1entry sha1string
6403 if {[string length $sha1string] == 40} {
6404 $sha1entry delete 0 end
6408 proc sha1change {n1 n2 op} {
6409 global sha1string currentid sha1but
6410 if {$sha1string == {}
6411 || ([info exists currentid] && $sha1string == $currentid)} {
6412 set state disabled
6413 } else {
6414 set state normal
6416 if {[$sha1but cget -state] == $state} return
6417 if {$state == "normal"} {
6418 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6419 } else {
6420 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6424 proc gotocommit {} {
6425 global sha1string tagids headids curview varcid
6427 if {$sha1string == {}
6428 || ([info exists currentid] && $sha1string == $currentid)} return
6429 if {[info exists tagids($sha1string)]} {
6430 set id $tagids($sha1string)
6431 } elseif {[info exists headids($sha1string)]} {
6432 set id $headids($sha1string)
6433 } else {
6434 set id [string tolower $sha1string]
6435 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6436 set matches [array names varcid "$curview,$id*"]
6437 if {$matches ne {}} {
6438 if {[llength $matches] > 1} {
6439 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6440 return
6442 set id [lindex [split [lindex $matches 0] ","] 1]
6446 if {[commitinview $id $curview]} {
6447 selectline [rowofcommit $id] 1
6448 return
6450 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6451 set msg [mc "SHA1 id %s is not known" $sha1string]
6452 } else {
6453 set msg [mc "Tag/Head %s is not known" $sha1string]
6455 error_popup $msg
6458 proc lineenter {x y id} {
6459 global hoverx hovery hoverid hovertimer
6460 global commitinfo canv
6462 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6463 set hoverx $x
6464 set hovery $y
6465 set hoverid $id
6466 if {[info exists hovertimer]} {
6467 after cancel $hovertimer
6469 set hovertimer [after 500 linehover]
6470 $canv delete hover
6473 proc linemotion {x y id} {
6474 global hoverx hovery hoverid hovertimer
6476 if {[info exists hoverid] && $id == $hoverid} {
6477 set hoverx $x
6478 set hovery $y
6479 if {[info exists hovertimer]} {
6480 after cancel $hovertimer
6482 set hovertimer [after 500 linehover]
6486 proc lineleave {id} {
6487 global hoverid hovertimer canv
6489 if {[info exists hoverid] && $id == $hoverid} {
6490 $canv delete hover
6491 if {[info exists hovertimer]} {
6492 after cancel $hovertimer
6493 unset hovertimer
6495 unset hoverid
6499 proc linehover {} {
6500 global hoverx hovery hoverid hovertimer
6501 global canv linespc lthickness
6502 global commitinfo
6504 set text [lindex $commitinfo($hoverid) 0]
6505 set ymax [lindex [$canv cget -scrollregion] 3]
6506 if {$ymax == {}} return
6507 set yfrac [lindex [$canv yview] 0]
6508 set x [expr {$hoverx + 2 * $linespc}]
6509 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6510 set x0 [expr {$x - 2 * $lthickness}]
6511 set y0 [expr {$y - 2 * $lthickness}]
6512 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6513 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6514 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6515 -fill \#ffff80 -outline black -width 1 -tags hover]
6516 $canv raise $t
6517 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6518 -font mainfont]
6519 $canv raise $t
6522 proc clickisonarrow {id y} {
6523 global lthickness
6525 set ranges [rowranges $id]
6526 set thresh [expr {2 * $lthickness + 6}]
6527 set n [expr {[llength $ranges] - 1}]
6528 for {set i 1} {$i < $n} {incr i} {
6529 set row [lindex $ranges $i]
6530 if {abs([yc $row] - $y) < $thresh} {
6531 return $i
6534 return {}
6537 proc arrowjump {id n y} {
6538 global canv
6540 # 1 <-> 2, 3 <-> 4, etc...
6541 set n [expr {(($n - 1) ^ 1) + 1}]
6542 set row [lindex [rowranges $id] $n]
6543 set yt [yc $row]
6544 set ymax [lindex [$canv cget -scrollregion] 3]
6545 if {$ymax eq {} || $ymax <= 0} return
6546 set view [$canv yview]
6547 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6548 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6549 if {$yfrac < 0} {
6550 set yfrac 0
6552 allcanvs yview moveto $yfrac
6555 proc lineclick {x y id isnew} {
6556 global ctext commitinfo children canv thickerline curview
6558 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6559 unmarkmatches
6560 unselectline
6561 normalline
6562 $canv delete hover
6563 # draw this line thicker than normal
6564 set thickerline $id
6565 drawlines $id
6566 if {$isnew} {
6567 set ymax [lindex [$canv cget -scrollregion] 3]
6568 if {$ymax eq {}} return
6569 set yfrac [lindex [$canv yview] 0]
6570 set y [expr {$y + $yfrac * $ymax}]
6572 set dirn [clickisonarrow $id $y]
6573 if {$dirn ne {}} {
6574 arrowjump $id $dirn $y
6575 return
6578 if {$isnew} {
6579 addtohistory [list lineclick $x $y $id 0]
6581 # fill the details pane with info about this line
6582 $ctext conf -state normal
6583 clear_ctext
6584 settabs 0
6585 $ctext insert end "[mc "Parent"]:\t"
6586 $ctext insert end $id link0
6587 setlink $id link0
6588 set info $commitinfo($id)
6589 $ctext insert end "\n\t[lindex $info 0]\n"
6590 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6591 set date [formatdate [lindex $info 2]]
6592 $ctext insert end "\t[mc "Date"]:\t$date\n"
6593 set kids $children($curview,$id)
6594 if {$kids ne {}} {
6595 $ctext insert end "\n[mc "Children"]:"
6596 set i 0
6597 foreach child $kids {
6598 incr i
6599 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6600 set info $commitinfo($child)
6601 $ctext insert end "\n\t"
6602 $ctext insert end $child link$i
6603 setlink $child link$i
6604 $ctext insert end "\n\t[lindex $info 0]"
6605 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6606 set date [formatdate [lindex $info 2]]
6607 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6610 $ctext conf -state disabled
6611 init_flist {}
6614 proc normalline {} {
6615 global thickerline
6616 if {[info exists thickerline]} {
6617 set id $thickerline
6618 unset thickerline
6619 drawlines $id
6623 proc selbyid {id} {
6624 global curview
6625 if {[commitinview $id $curview]} {
6626 selectline [rowofcommit $id] 1
6630 proc mstime {} {
6631 global startmstime
6632 if {![info exists startmstime]} {
6633 set startmstime [clock clicks -milliseconds]
6635 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6638 proc rowmenu {x y id} {
6639 global rowctxmenu selectedline rowmenuid curview
6640 global nullid nullid2 fakerowmenu mainhead
6642 stopfinding
6643 set rowmenuid $id
6644 if {![info exists selectedline]
6645 || [rowofcommit $id] eq $selectedline} {
6646 set state disabled
6647 } else {
6648 set state normal
6650 if {$id ne $nullid && $id ne $nullid2} {
6651 set menu $rowctxmenu
6652 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6653 } else {
6654 set menu $fakerowmenu
6656 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6657 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6658 $menu entryconfigure [mc "Make patch"] -state $state
6659 tk_popup $menu $x $y
6662 proc diffvssel {dirn} {
6663 global rowmenuid selectedline
6665 if {![info exists selectedline]} return
6666 if {$dirn} {
6667 set oldid [commitonrow $selectedline]
6668 set newid $rowmenuid
6669 } else {
6670 set oldid $rowmenuid
6671 set newid [commitonrow $selectedline]
6673 addtohistory [list doseldiff $oldid $newid]
6674 doseldiff $oldid $newid
6677 proc doseldiff {oldid newid} {
6678 global ctext
6679 global commitinfo
6681 $ctext conf -state normal
6682 clear_ctext
6683 init_flist [mc "Top"]
6684 $ctext insert end "[mc "From"] "
6685 $ctext insert end $oldid link0
6686 setlink $oldid link0
6687 $ctext insert end "\n "
6688 $ctext insert end [lindex $commitinfo($oldid) 0]
6689 $ctext insert end "\n\n[mc "To"] "
6690 $ctext insert end $newid link1
6691 setlink $newid link1
6692 $ctext insert end "\n "
6693 $ctext insert end [lindex $commitinfo($newid) 0]
6694 $ctext insert end "\n"
6695 $ctext conf -state disabled
6696 $ctext tag remove found 1.0 end
6697 startdiff [list $oldid $newid]
6700 proc mkpatch {} {
6701 global rowmenuid currentid commitinfo patchtop patchnum
6703 if {![info exists currentid]} return
6704 set oldid $currentid
6705 set oldhead [lindex $commitinfo($oldid) 0]
6706 set newid $rowmenuid
6707 set newhead [lindex $commitinfo($newid) 0]
6708 set top .patch
6709 set patchtop $top
6710 catch {destroy $top}
6711 toplevel $top
6712 label $top.title -text [mc "Generate patch"]
6713 grid $top.title - -pady 10
6714 label $top.from -text [mc "From:"]
6715 entry $top.fromsha1 -width 40 -relief flat
6716 $top.fromsha1 insert 0 $oldid
6717 $top.fromsha1 conf -state readonly
6718 grid $top.from $top.fromsha1 -sticky w
6719 entry $top.fromhead -width 60 -relief flat
6720 $top.fromhead insert 0 $oldhead
6721 $top.fromhead conf -state readonly
6722 grid x $top.fromhead -sticky w
6723 label $top.to -text [mc "To:"]
6724 entry $top.tosha1 -width 40 -relief flat
6725 $top.tosha1 insert 0 $newid
6726 $top.tosha1 conf -state readonly
6727 grid $top.to $top.tosha1 -sticky w
6728 entry $top.tohead -width 60 -relief flat
6729 $top.tohead insert 0 $newhead
6730 $top.tohead conf -state readonly
6731 grid x $top.tohead -sticky w
6732 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6733 grid $top.rev x -pady 10
6734 label $top.flab -text [mc "Output file:"]
6735 entry $top.fname -width 60
6736 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6737 incr patchnum
6738 grid $top.flab $top.fname -sticky w
6739 frame $top.buts
6740 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6741 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6742 grid $top.buts.gen $top.buts.can
6743 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6744 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6745 grid $top.buts - -pady 10 -sticky ew
6746 focus $top.fname
6749 proc mkpatchrev {} {
6750 global patchtop
6752 set oldid [$patchtop.fromsha1 get]
6753 set oldhead [$patchtop.fromhead get]
6754 set newid [$patchtop.tosha1 get]
6755 set newhead [$patchtop.tohead get]
6756 foreach e [list fromsha1 fromhead tosha1 tohead] \
6757 v [list $newid $newhead $oldid $oldhead] {
6758 $patchtop.$e conf -state normal
6759 $patchtop.$e delete 0 end
6760 $patchtop.$e insert 0 $v
6761 $patchtop.$e conf -state readonly
6765 proc mkpatchgo {} {
6766 global patchtop nullid nullid2
6768 set oldid [$patchtop.fromsha1 get]
6769 set newid [$patchtop.tosha1 get]
6770 set fname [$patchtop.fname get]
6771 set cmd [diffcmd [list $oldid $newid] -p]
6772 # trim off the initial "|"
6773 set cmd [lrange $cmd 1 end]
6774 lappend cmd >$fname &
6775 if {[catch {eval exec $cmd} err]} {
6776 error_popup "[mc "Error creating patch:"] $err"
6778 catch {destroy $patchtop}
6779 unset patchtop
6782 proc mkpatchcan {} {
6783 global patchtop
6785 catch {destroy $patchtop}
6786 unset patchtop
6789 proc mktag {} {
6790 global rowmenuid mktagtop commitinfo
6792 set top .maketag
6793 set mktagtop $top
6794 catch {destroy $top}
6795 toplevel $top
6796 label $top.title -text [mc "Create tag"]
6797 grid $top.title - -pady 10
6798 label $top.id -text [mc "ID:"]
6799 entry $top.sha1 -width 40 -relief flat
6800 $top.sha1 insert 0 $rowmenuid
6801 $top.sha1 conf -state readonly
6802 grid $top.id $top.sha1 -sticky w
6803 entry $top.head -width 60 -relief flat
6804 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6805 $top.head conf -state readonly
6806 grid x $top.head -sticky w
6807 label $top.tlab -text [mc "Tag name:"]
6808 entry $top.tag -width 60
6809 grid $top.tlab $top.tag -sticky w
6810 frame $top.buts
6811 button $top.buts.gen -text [mc "Create"] -command mktaggo
6812 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6813 grid $top.buts.gen $top.buts.can
6814 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6815 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6816 grid $top.buts - -pady 10 -sticky ew
6817 focus $top.tag
6820 proc domktag {} {
6821 global mktagtop env tagids idtags
6823 set id [$mktagtop.sha1 get]
6824 set tag [$mktagtop.tag get]
6825 if {$tag == {}} {
6826 error_popup [mc "No tag name specified"]
6827 return
6829 if {[info exists tagids($tag)]} {
6830 error_popup [mc "Tag \"%s\" already exists" $tag]
6831 return
6833 if {[catch {
6834 set dir [gitdir]
6835 set fname [file join $dir "refs/tags" $tag]
6836 set f [open $fname w]
6837 puts $f $id
6838 close $f
6839 } err]} {
6840 error_popup "[mc "Error creating tag:"] $err"
6841 return
6844 set tagids($tag) $id
6845 lappend idtags($id) $tag
6846 redrawtags $id
6847 addedtag $id
6848 dispneartags 0
6849 run refill_reflist
6852 proc redrawtags {id} {
6853 global canv linehtag idpos currentid curview
6854 global canvxmax iddrawn
6856 if {![commitinview $id $curview]} return
6857 if {![info exists iddrawn($id)]} return
6858 set row [rowofcommit $id]
6859 $canv delete tag.$id
6860 set xt [eval drawtags $id $idpos($id)]
6861 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6862 set text [$canv itemcget $linehtag($row) -text]
6863 set font [$canv itemcget $linehtag($row) -font]
6864 set xr [expr {$xt + [font measure $font $text]}]
6865 if {$xr > $canvxmax} {
6866 set canvxmax $xr
6867 setcanvscroll
6869 if {[info exists currentid] && $currentid == $id} {
6870 make_secsel $row
6874 proc mktagcan {} {
6875 global mktagtop
6877 catch {destroy $mktagtop}
6878 unset mktagtop
6881 proc mktaggo {} {
6882 domktag
6883 mktagcan
6886 proc writecommit {} {
6887 global rowmenuid wrcomtop commitinfo wrcomcmd
6889 set top .writecommit
6890 set wrcomtop $top
6891 catch {destroy $top}
6892 toplevel $top
6893 label $top.title -text [mc "Write commit to file"]
6894 grid $top.title - -pady 10
6895 label $top.id -text [mc "ID:"]
6896 entry $top.sha1 -width 40 -relief flat
6897 $top.sha1 insert 0 $rowmenuid
6898 $top.sha1 conf -state readonly
6899 grid $top.id $top.sha1 -sticky w
6900 entry $top.head -width 60 -relief flat
6901 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6902 $top.head conf -state readonly
6903 grid x $top.head -sticky w
6904 label $top.clab -text [mc "Command:"]
6905 entry $top.cmd -width 60 -textvariable wrcomcmd
6906 grid $top.clab $top.cmd -sticky w -pady 10
6907 label $top.flab -text [mc "Output file:"]
6908 entry $top.fname -width 60
6909 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6910 grid $top.flab $top.fname -sticky w
6911 frame $top.buts
6912 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6913 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6914 grid $top.buts.gen $top.buts.can
6915 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6916 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6917 grid $top.buts - -pady 10 -sticky ew
6918 focus $top.fname
6921 proc wrcomgo {} {
6922 global wrcomtop
6924 set id [$wrcomtop.sha1 get]
6925 set cmd "echo $id | [$wrcomtop.cmd get]"
6926 set fname [$wrcomtop.fname get]
6927 if {[catch {exec sh -c $cmd >$fname &} err]} {
6928 error_popup "[mc "Error writing commit:"] $err"
6930 catch {destroy $wrcomtop}
6931 unset wrcomtop
6934 proc wrcomcan {} {
6935 global wrcomtop
6937 catch {destroy $wrcomtop}
6938 unset wrcomtop
6941 proc mkbranch {} {
6942 global rowmenuid mkbrtop
6944 set top .makebranch
6945 catch {destroy $top}
6946 toplevel $top
6947 label $top.title -text [mc "Create new branch"]
6948 grid $top.title - -pady 10
6949 label $top.id -text [mc "ID:"]
6950 entry $top.sha1 -width 40 -relief flat
6951 $top.sha1 insert 0 $rowmenuid
6952 $top.sha1 conf -state readonly
6953 grid $top.id $top.sha1 -sticky w
6954 label $top.nlab -text [mc "Name:"]
6955 entry $top.name -width 40
6956 grid $top.nlab $top.name -sticky w
6957 frame $top.buts
6958 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6959 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6960 grid $top.buts.go $top.buts.can
6961 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6962 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6963 grid $top.buts - -pady 10 -sticky ew
6964 focus $top.name
6967 proc mkbrgo {top} {
6968 global headids idheads
6970 set name [$top.name get]
6971 set id [$top.sha1 get]
6972 if {$name eq {}} {
6973 error_popup [mc "Please specify a name for the new branch"]
6974 return
6976 catch {destroy $top}
6977 nowbusy newbranch
6978 update
6979 if {[catch {
6980 exec git branch $name $id
6981 } err]} {
6982 notbusy newbranch
6983 error_popup $err
6984 } else {
6985 set headids($name) $id
6986 lappend idheads($id) $name
6987 addedhead $id $name
6988 notbusy newbranch
6989 redrawtags $id
6990 dispneartags 0
6991 run refill_reflist
6995 proc cherrypick {} {
6996 global rowmenuid curview
6997 global mainhead
6999 set oldhead [exec git rev-parse HEAD]
7000 set dheads [descheads $rowmenuid]
7001 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7002 set ok [confirm_popup [mc "Commit %s is already\
7003 included in branch %s -- really re-apply it?" \
7004 [string range $rowmenuid 0 7] $mainhead]]
7005 if {!$ok} return
7007 nowbusy cherrypick [mc "Cherry-picking"]
7008 update
7009 # Unfortunately git-cherry-pick writes stuff to stderr even when
7010 # no error occurs, and exec takes that as an indication of error...
7011 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7012 notbusy cherrypick
7013 error_popup $err
7014 return
7016 set newhead [exec git rev-parse HEAD]
7017 if {$newhead eq $oldhead} {
7018 notbusy cherrypick
7019 error_popup [mc "No changes committed"]
7020 return
7022 addnewchild $newhead $oldhead
7023 if {[commitinview $oldhead $curview]} {
7024 insertrow $newhead $oldhead $curview
7025 if {$mainhead ne {}} {
7026 movehead $newhead $mainhead
7027 movedhead $newhead $mainhead
7029 redrawtags $oldhead
7030 redrawtags $newhead
7032 notbusy cherrypick
7035 proc resethead {} {
7036 global mainheadid mainhead rowmenuid confirm_ok resettype
7038 set confirm_ok 0
7039 set w ".confirmreset"
7040 toplevel $w
7041 wm transient $w .
7042 wm title $w [mc "Confirm reset"]
7043 message $w.m -text \
7044 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7045 -justify center -aspect 1000
7046 pack $w.m -side top -fill x -padx 20 -pady 20
7047 frame $w.f -relief sunken -border 2
7048 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7049 grid $w.f.rt -sticky w
7050 set resettype mixed
7051 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7052 -text [mc "Soft: Leave working tree and index untouched"]
7053 grid $w.f.soft -sticky w
7054 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7055 -text [mc "Mixed: Leave working tree untouched, reset index"]
7056 grid $w.f.mixed -sticky w
7057 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7058 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7059 grid $w.f.hard -sticky w
7060 pack $w.f -side top -fill x
7061 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7062 pack $w.ok -side left -fill x -padx 20 -pady 20
7063 button $w.cancel -text [mc Cancel] -command "destroy $w"
7064 pack $w.cancel -side right -fill x -padx 20 -pady 20
7065 bind $w <Visibility> "grab $w; focus $w"
7066 tkwait window $w
7067 if {!$confirm_ok} return
7068 if {[catch {set fd [open \
7069 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7070 error_popup $err
7071 } else {
7072 dohidelocalchanges
7073 filerun $fd [list readresetstat $fd]
7074 nowbusy reset [mc "Resetting"]
7078 proc readresetstat {fd} {
7079 global mainhead mainheadid showlocalchanges rprogcoord
7081 if {[gets $fd line] >= 0} {
7082 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7083 set rprogcoord [expr {1.0 * $m / $n}]
7084 adjustprogress
7086 return 1
7088 set rprogcoord 0
7089 adjustprogress
7090 notbusy reset
7091 if {[catch {close $fd} err]} {
7092 error_popup $err
7094 set oldhead $mainheadid
7095 set newhead [exec git rev-parse HEAD]
7096 if {$newhead ne $oldhead} {
7097 movehead $newhead $mainhead
7098 movedhead $newhead $mainhead
7099 set mainheadid $newhead
7100 redrawtags $oldhead
7101 redrawtags $newhead
7103 if {$showlocalchanges} {
7104 doshowlocalchanges
7106 return 0
7109 # context menu for a head
7110 proc headmenu {x y id head} {
7111 global headmenuid headmenuhead headctxmenu mainhead
7113 stopfinding
7114 set headmenuid $id
7115 set headmenuhead $head
7116 set state normal
7117 if {$head eq $mainhead} {
7118 set state disabled
7120 $headctxmenu entryconfigure 0 -state $state
7121 $headctxmenu entryconfigure 1 -state $state
7122 tk_popup $headctxmenu $x $y
7125 proc cobranch {} {
7126 global headmenuid headmenuhead mainhead headids
7127 global showlocalchanges mainheadid
7129 # check the tree is clean first??
7130 set oldmainhead $mainhead
7131 nowbusy checkout [mc "Checking out"]
7132 update
7133 dohidelocalchanges
7134 if {[catch {
7135 exec git checkout -q $headmenuhead
7136 } err]} {
7137 notbusy checkout
7138 error_popup $err
7139 } else {
7140 notbusy checkout
7141 set mainhead $headmenuhead
7142 set mainheadid $headmenuid
7143 if {[info exists headids($oldmainhead)]} {
7144 redrawtags $headids($oldmainhead)
7146 redrawtags $headmenuid
7148 if {$showlocalchanges} {
7149 dodiffindex
7153 proc rmbranch {} {
7154 global headmenuid headmenuhead mainhead
7155 global idheads
7157 set head $headmenuhead
7158 set id $headmenuid
7159 # this check shouldn't be needed any more...
7160 if {$head eq $mainhead} {
7161 error_popup [mc "Cannot delete the currently checked-out branch"]
7162 return
7164 set dheads [descheads $id]
7165 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7166 # the stuff on this branch isn't on any other branch
7167 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7168 branch.\nReally delete branch %s?" $head $head]]} return
7170 nowbusy rmbranch
7171 update
7172 if {[catch {exec git branch -D $head} err]} {
7173 notbusy rmbranch
7174 error_popup $err
7175 return
7177 removehead $id $head
7178 removedhead $id $head
7179 redrawtags $id
7180 notbusy rmbranch
7181 dispneartags 0
7182 run refill_reflist
7185 # Display a list of tags and heads
7186 proc showrefs {} {
7187 global showrefstop bgcolor fgcolor selectbgcolor
7188 global bglist fglist reflistfilter reflist maincursor
7190 set top .showrefs
7191 set showrefstop $top
7192 if {[winfo exists $top]} {
7193 raise $top
7194 refill_reflist
7195 return
7197 toplevel $top
7198 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7199 text $top.list -background $bgcolor -foreground $fgcolor \
7200 -selectbackground $selectbgcolor -font mainfont \
7201 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7202 -width 30 -height 20 -cursor $maincursor \
7203 -spacing1 1 -spacing3 1 -state disabled
7204 $top.list tag configure highlight -background $selectbgcolor
7205 lappend bglist $top.list
7206 lappend fglist $top.list
7207 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7208 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7209 grid $top.list $top.ysb -sticky nsew
7210 grid $top.xsb x -sticky ew
7211 frame $top.f
7212 label $top.f.l -text "[mc "Filter"]: "
7213 entry $top.f.e -width 20 -textvariable reflistfilter
7214 set reflistfilter "*"
7215 trace add variable reflistfilter write reflistfilter_change
7216 pack $top.f.e -side right -fill x -expand 1
7217 pack $top.f.l -side left
7218 grid $top.f - -sticky ew -pady 2
7219 button $top.close -command [list destroy $top] -text [mc "Close"]
7220 grid $top.close -
7221 grid columnconfigure $top 0 -weight 1
7222 grid rowconfigure $top 0 -weight 1
7223 bind $top.list <1> {break}
7224 bind $top.list <B1-Motion> {break}
7225 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7226 set reflist {}
7227 refill_reflist
7230 proc sel_reflist {w x y} {
7231 global showrefstop reflist headids tagids otherrefids
7233 if {![winfo exists $showrefstop]} return
7234 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7235 set ref [lindex $reflist [expr {$l-1}]]
7236 set n [lindex $ref 0]
7237 switch -- [lindex $ref 1] {
7238 "H" {selbyid $headids($n)}
7239 "T" {selbyid $tagids($n)}
7240 "o" {selbyid $otherrefids($n)}
7242 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7245 proc unsel_reflist {} {
7246 global showrefstop
7248 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7249 $showrefstop.list tag remove highlight 0.0 end
7252 proc reflistfilter_change {n1 n2 op} {
7253 global reflistfilter
7255 after cancel refill_reflist
7256 after 200 refill_reflist
7259 proc refill_reflist {} {
7260 global reflist reflistfilter showrefstop headids tagids otherrefids
7261 global curview commitinterest
7263 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7264 set refs {}
7265 foreach n [array names headids] {
7266 if {[string match $reflistfilter $n]} {
7267 if {[commitinview $headids($n) $curview]} {
7268 lappend refs [list $n H]
7269 } else {
7270 set commitinterest($headids($n)) {run refill_reflist}
7274 foreach n [array names tagids] {
7275 if {[string match $reflistfilter $n]} {
7276 if {[commitinview $tagids($n) $curview]} {
7277 lappend refs [list $n T]
7278 } else {
7279 set commitinterest($tagids($n)) {run refill_reflist}
7283 foreach n [array names otherrefids] {
7284 if {[string match $reflistfilter $n]} {
7285 if {[commitinview $otherrefids($n) $curview]} {
7286 lappend refs [list $n o]
7287 } else {
7288 set commitinterest($otherrefids($n)) {run refill_reflist}
7292 set refs [lsort -index 0 $refs]
7293 if {$refs eq $reflist} return
7295 # Update the contents of $showrefstop.list according to the
7296 # differences between $reflist (old) and $refs (new)
7297 $showrefstop.list conf -state normal
7298 $showrefstop.list insert end "\n"
7299 set i 0
7300 set j 0
7301 while {$i < [llength $reflist] || $j < [llength $refs]} {
7302 if {$i < [llength $reflist]} {
7303 if {$j < [llength $refs]} {
7304 set cmp [string compare [lindex $reflist $i 0] \
7305 [lindex $refs $j 0]]
7306 if {$cmp == 0} {
7307 set cmp [string compare [lindex $reflist $i 1] \
7308 [lindex $refs $j 1]]
7310 } else {
7311 set cmp -1
7313 } else {
7314 set cmp 1
7316 switch -- $cmp {
7317 -1 {
7318 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7319 incr i
7322 incr i
7323 incr j
7326 set l [expr {$j + 1}]
7327 $showrefstop.list image create $l.0 -align baseline \
7328 -image reficon-[lindex $refs $j 1] -padx 2
7329 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7330 incr j
7334 set reflist $refs
7335 # delete last newline
7336 $showrefstop.list delete end-2c end-1c
7337 $showrefstop.list conf -state disabled
7340 # Stuff for finding nearby tags
7341 proc getallcommits {} {
7342 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7343 global idheads idtags idotherrefs allparents tagobjid
7345 if {![info exists allcommits]} {
7346 set nextarc 0
7347 set allcommits 0
7348 set seeds {}
7349 set allcwait 0
7350 set cachedarcs 0
7351 set allccache [file join [gitdir] "gitk.cache"]
7352 if {![catch {
7353 set f [open $allccache r]
7354 set allcwait 1
7355 getcache $f
7356 }]} return
7359 if {$allcwait} {
7360 return
7362 set cmd [list | git rev-list --parents]
7363 set allcupdate [expr {$seeds ne {}}]
7364 if {!$allcupdate} {
7365 set ids "--all"
7366 } else {
7367 set refs [concat [array names idheads] [array names idtags] \
7368 [array names idotherrefs]]
7369 set ids {}
7370 set tagobjs {}
7371 foreach name [array names tagobjid] {
7372 lappend tagobjs $tagobjid($name)
7374 foreach id [lsort -unique $refs] {
7375 if {![info exists allparents($id)] &&
7376 [lsearch -exact $tagobjs $id] < 0} {
7377 lappend ids $id
7380 if {$ids ne {}} {
7381 foreach id $seeds {
7382 lappend ids "^$id"
7386 if {$ids ne {}} {
7387 set fd [open [concat $cmd $ids] r]
7388 fconfigure $fd -blocking 0
7389 incr allcommits
7390 nowbusy allcommits
7391 filerun $fd [list getallclines $fd]
7392 } else {
7393 dispneartags 0
7397 # Since most commits have 1 parent and 1 child, we group strings of
7398 # such commits into "arcs" joining branch/merge points (BMPs), which
7399 # are commits that either don't have 1 parent or don't have 1 child.
7401 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7402 # arcout(id) - outgoing arcs for BMP
7403 # arcids(a) - list of IDs on arc including end but not start
7404 # arcstart(a) - BMP ID at start of arc
7405 # arcend(a) - BMP ID at end of arc
7406 # growing(a) - arc a is still growing
7407 # arctags(a) - IDs out of arcids (excluding end) that have tags
7408 # archeads(a) - IDs out of arcids (excluding end) that have heads
7409 # The start of an arc is at the descendent end, so "incoming" means
7410 # coming from descendents, and "outgoing" means going towards ancestors.
7412 proc getallclines {fd} {
7413 global allparents allchildren idtags idheads nextarc
7414 global arcnos arcids arctags arcout arcend arcstart archeads growing
7415 global seeds allcommits cachedarcs allcupdate
7417 set nid 0
7418 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7419 set id [lindex $line 0]
7420 if {[info exists allparents($id)]} {
7421 # seen it already
7422 continue
7424 set cachedarcs 0
7425 set olds [lrange $line 1 end]
7426 set allparents($id) $olds
7427 if {![info exists allchildren($id)]} {
7428 set allchildren($id) {}
7429 set arcnos($id) {}
7430 lappend seeds $id
7431 } else {
7432 set a $arcnos($id)
7433 if {[llength $olds] == 1 && [llength $a] == 1} {
7434 lappend arcids($a) $id
7435 if {[info exists idtags($id)]} {
7436 lappend arctags($a) $id
7438 if {[info exists idheads($id)]} {
7439 lappend archeads($a) $id
7441 if {[info exists allparents($olds)]} {
7442 # seen parent already
7443 if {![info exists arcout($olds)]} {
7444 splitarc $olds
7446 lappend arcids($a) $olds
7447 set arcend($a) $olds
7448 unset growing($a)
7450 lappend allchildren($olds) $id
7451 lappend arcnos($olds) $a
7452 continue
7455 foreach a $arcnos($id) {
7456 lappend arcids($a) $id
7457 set arcend($a) $id
7458 unset growing($a)
7461 set ao {}
7462 foreach p $olds {
7463 lappend allchildren($p) $id
7464 set a [incr nextarc]
7465 set arcstart($a) $id
7466 set archeads($a) {}
7467 set arctags($a) {}
7468 set archeads($a) {}
7469 set arcids($a) {}
7470 lappend ao $a
7471 set growing($a) 1
7472 if {[info exists allparents($p)]} {
7473 # seen it already, may need to make a new branch
7474 if {![info exists arcout($p)]} {
7475 splitarc $p
7477 lappend arcids($a) $p
7478 set arcend($a) $p
7479 unset growing($a)
7481 lappend arcnos($p) $a
7483 set arcout($id) $ao
7485 if {$nid > 0} {
7486 global cached_dheads cached_dtags cached_atags
7487 catch {unset cached_dheads}
7488 catch {unset cached_dtags}
7489 catch {unset cached_atags}
7491 if {![eof $fd]} {
7492 return [expr {$nid >= 1000? 2: 1}]
7494 set cacheok 1
7495 if {[catch {
7496 fconfigure $fd -blocking 1
7497 close $fd
7498 } err]} {
7499 # got an error reading the list of commits
7500 # if we were updating, try rereading the whole thing again
7501 if {$allcupdate} {
7502 incr allcommits -1
7503 dropcache $err
7504 return
7506 error_popup "[mc "Error reading commit topology information;\
7507 branch and preceding/following tag information\
7508 will be incomplete."]\n($err)"
7509 set cacheok 0
7511 if {[incr allcommits -1] == 0} {
7512 notbusy allcommits
7513 if {$cacheok} {
7514 run savecache
7517 dispneartags 0
7518 return 0
7521 proc recalcarc {a} {
7522 global arctags archeads arcids idtags idheads
7524 set at {}
7525 set ah {}
7526 foreach id [lrange $arcids($a) 0 end-1] {
7527 if {[info exists idtags($id)]} {
7528 lappend at $id
7530 if {[info exists idheads($id)]} {
7531 lappend ah $id
7534 set arctags($a) $at
7535 set archeads($a) $ah
7538 proc splitarc {p} {
7539 global arcnos arcids nextarc arctags archeads idtags idheads
7540 global arcstart arcend arcout allparents growing
7542 set a $arcnos($p)
7543 if {[llength $a] != 1} {
7544 puts "oops splitarc called but [llength $a] arcs already"
7545 return
7547 set a [lindex $a 0]
7548 set i [lsearch -exact $arcids($a) $p]
7549 if {$i < 0} {
7550 puts "oops splitarc $p not in arc $a"
7551 return
7553 set na [incr nextarc]
7554 if {[info exists arcend($a)]} {
7555 set arcend($na) $arcend($a)
7556 } else {
7557 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7558 set j [lsearch -exact $arcnos($l) $a]
7559 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7561 set tail [lrange $arcids($a) [expr {$i+1}] end]
7562 set arcids($a) [lrange $arcids($a) 0 $i]
7563 set arcend($a) $p
7564 set arcstart($na) $p
7565 set arcout($p) $na
7566 set arcids($na) $tail
7567 if {[info exists growing($a)]} {
7568 set growing($na) 1
7569 unset growing($a)
7572 foreach id $tail {
7573 if {[llength $arcnos($id)] == 1} {
7574 set arcnos($id) $na
7575 } else {
7576 set j [lsearch -exact $arcnos($id) $a]
7577 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7581 # reconstruct tags and heads lists
7582 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7583 recalcarc $a
7584 recalcarc $na
7585 } else {
7586 set arctags($na) {}
7587 set archeads($na) {}
7591 # Update things for a new commit added that is a child of one
7592 # existing commit. Used when cherry-picking.
7593 proc addnewchild {id p} {
7594 global allparents allchildren idtags nextarc
7595 global arcnos arcids arctags arcout arcend arcstart archeads growing
7596 global seeds allcommits
7598 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7599 set allparents($id) [list $p]
7600 set allchildren($id) {}
7601 set arcnos($id) {}
7602 lappend seeds $id
7603 lappend allchildren($p) $id
7604 set a [incr nextarc]
7605 set arcstart($a) $id
7606 set archeads($a) {}
7607 set arctags($a) {}
7608 set arcids($a) [list $p]
7609 set arcend($a) $p
7610 if {![info exists arcout($p)]} {
7611 splitarc $p
7613 lappend arcnos($p) $a
7614 set arcout($id) [list $a]
7617 # This implements a cache for the topology information.
7618 # The cache saves, for each arc, the start and end of the arc,
7619 # the ids on the arc, and the outgoing arcs from the end.
7620 proc readcache {f} {
7621 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7622 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7623 global allcwait
7625 set a $nextarc
7626 set lim $cachedarcs
7627 if {$lim - $a > 500} {
7628 set lim [expr {$a + 500}]
7630 if {[catch {
7631 if {$a == $lim} {
7632 # finish reading the cache and setting up arctags, etc.
7633 set line [gets $f]
7634 if {$line ne "1"} {error "bad final version"}
7635 close $f
7636 foreach id [array names idtags] {
7637 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7638 [llength $allparents($id)] == 1} {
7639 set a [lindex $arcnos($id) 0]
7640 if {$arctags($a) eq {}} {
7641 recalcarc $a
7645 foreach id [array names idheads] {
7646 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7647 [llength $allparents($id)] == 1} {
7648 set a [lindex $arcnos($id) 0]
7649 if {$archeads($a) eq {}} {
7650 recalcarc $a
7654 foreach id [lsort -unique $possible_seeds] {
7655 if {$arcnos($id) eq {}} {
7656 lappend seeds $id
7659 set allcwait 0
7660 } else {
7661 while {[incr a] <= $lim} {
7662 set line [gets $f]
7663 if {[llength $line] != 3} {error "bad line"}
7664 set s [lindex $line 0]
7665 set arcstart($a) $s
7666 lappend arcout($s) $a
7667 if {![info exists arcnos($s)]} {
7668 lappend possible_seeds $s
7669 set arcnos($s) {}
7671 set e [lindex $line 1]
7672 if {$e eq {}} {
7673 set growing($a) 1
7674 } else {
7675 set arcend($a) $e
7676 if {![info exists arcout($e)]} {
7677 set arcout($e) {}
7680 set arcids($a) [lindex $line 2]
7681 foreach id $arcids($a) {
7682 lappend allparents($s) $id
7683 set s $id
7684 lappend arcnos($id) $a
7686 if {![info exists allparents($s)]} {
7687 set allparents($s) {}
7689 set arctags($a) {}
7690 set archeads($a) {}
7692 set nextarc [expr {$a - 1}]
7694 } err]} {
7695 dropcache $err
7696 return 0
7698 if {!$allcwait} {
7699 getallcommits
7701 return $allcwait
7704 proc getcache {f} {
7705 global nextarc cachedarcs possible_seeds
7707 if {[catch {
7708 set line [gets $f]
7709 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7710 # make sure it's an integer
7711 set cachedarcs [expr {int([lindex $line 1])}]
7712 if {$cachedarcs < 0} {error "bad number of arcs"}
7713 set nextarc 0
7714 set possible_seeds {}
7715 run readcache $f
7716 } err]} {
7717 dropcache $err
7719 return 0
7722 proc dropcache {err} {
7723 global allcwait nextarc cachedarcs seeds
7725 #puts "dropping cache ($err)"
7726 foreach v {arcnos arcout arcids arcstart arcend growing \
7727 arctags archeads allparents allchildren} {
7728 global $v
7729 catch {unset $v}
7731 set allcwait 0
7732 set nextarc 0
7733 set cachedarcs 0
7734 set seeds {}
7735 getallcommits
7738 proc writecache {f} {
7739 global cachearc cachedarcs allccache
7740 global arcstart arcend arcnos arcids arcout
7742 set a $cachearc
7743 set lim $cachedarcs
7744 if {$lim - $a > 1000} {
7745 set lim [expr {$a + 1000}]
7747 if {[catch {
7748 while {[incr a] <= $lim} {
7749 if {[info exists arcend($a)]} {
7750 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7751 } else {
7752 puts $f [list $arcstart($a) {} $arcids($a)]
7755 } err]} {
7756 catch {close $f}
7757 catch {file delete $allccache}
7758 #puts "writing cache failed ($err)"
7759 return 0
7761 set cachearc [expr {$a - 1}]
7762 if {$a > $cachedarcs} {
7763 puts $f "1"
7764 close $f
7765 return 0
7767 return 1
7770 proc savecache {} {
7771 global nextarc cachedarcs cachearc allccache
7773 if {$nextarc == $cachedarcs} return
7774 set cachearc 0
7775 set cachedarcs $nextarc
7776 catch {
7777 set f [open $allccache w]
7778 puts $f [list 1 $cachedarcs]
7779 run writecache $f
7783 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7784 # or 0 if neither is true.
7785 proc anc_or_desc {a b} {
7786 global arcout arcstart arcend arcnos cached_isanc
7788 if {$arcnos($a) eq $arcnos($b)} {
7789 # Both are on the same arc(s); either both are the same BMP,
7790 # or if one is not a BMP, the other is also not a BMP or is
7791 # the BMP at end of the arc (and it only has 1 incoming arc).
7792 # Or both can be BMPs with no incoming arcs.
7793 if {$a eq $b || $arcnos($a) eq {}} {
7794 return 0
7796 # assert {[llength $arcnos($a)] == 1}
7797 set arc [lindex $arcnos($a) 0]
7798 set i [lsearch -exact $arcids($arc) $a]
7799 set j [lsearch -exact $arcids($arc) $b]
7800 if {$i < 0 || $i > $j} {
7801 return 1
7802 } else {
7803 return -1
7807 if {![info exists arcout($a)]} {
7808 set arc [lindex $arcnos($a) 0]
7809 if {[info exists arcend($arc)]} {
7810 set aend $arcend($arc)
7811 } else {
7812 set aend {}
7814 set a $arcstart($arc)
7815 } else {
7816 set aend $a
7818 if {![info exists arcout($b)]} {
7819 set arc [lindex $arcnos($b) 0]
7820 if {[info exists arcend($arc)]} {
7821 set bend $arcend($arc)
7822 } else {
7823 set bend {}
7825 set b $arcstart($arc)
7826 } else {
7827 set bend $b
7829 if {$a eq $bend} {
7830 return 1
7832 if {$b eq $aend} {
7833 return -1
7835 if {[info exists cached_isanc($a,$bend)]} {
7836 if {$cached_isanc($a,$bend)} {
7837 return 1
7840 if {[info exists cached_isanc($b,$aend)]} {
7841 if {$cached_isanc($b,$aend)} {
7842 return -1
7844 if {[info exists cached_isanc($a,$bend)]} {
7845 return 0
7849 set todo [list $a $b]
7850 set anc($a) a
7851 set anc($b) b
7852 for {set i 0} {$i < [llength $todo]} {incr i} {
7853 set x [lindex $todo $i]
7854 if {$anc($x) eq {}} {
7855 continue
7857 foreach arc $arcnos($x) {
7858 set xd $arcstart($arc)
7859 if {$xd eq $bend} {
7860 set cached_isanc($a,$bend) 1
7861 set cached_isanc($b,$aend) 0
7862 return 1
7863 } elseif {$xd eq $aend} {
7864 set cached_isanc($b,$aend) 1
7865 set cached_isanc($a,$bend) 0
7866 return -1
7868 if {![info exists anc($xd)]} {
7869 set anc($xd) $anc($x)
7870 lappend todo $xd
7871 } elseif {$anc($xd) ne $anc($x)} {
7872 set anc($xd) {}
7876 set cached_isanc($a,$bend) 0
7877 set cached_isanc($b,$aend) 0
7878 return 0
7881 # This identifies whether $desc has an ancestor that is
7882 # a growing tip of the graph and which is not an ancestor of $anc
7883 # and returns 0 if so and 1 if not.
7884 # If we subsequently discover a tag on such a growing tip, and that
7885 # turns out to be a descendent of $anc (which it could, since we
7886 # don't necessarily see children before parents), then $desc
7887 # isn't a good choice to display as a descendent tag of
7888 # $anc (since it is the descendent of another tag which is
7889 # a descendent of $anc). Similarly, $anc isn't a good choice to
7890 # display as a ancestor tag of $desc.
7892 proc is_certain {desc anc} {
7893 global arcnos arcout arcstart arcend growing problems
7895 set certain {}
7896 if {[llength $arcnos($anc)] == 1} {
7897 # tags on the same arc are certain
7898 if {$arcnos($desc) eq $arcnos($anc)} {
7899 return 1
7901 if {![info exists arcout($anc)]} {
7902 # if $anc is partway along an arc, use the start of the arc instead
7903 set a [lindex $arcnos($anc) 0]
7904 set anc $arcstart($a)
7907 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7908 set x $desc
7909 } else {
7910 set a [lindex $arcnos($desc) 0]
7911 set x $arcend($a)
7913 if {$x == $anc} {
7914 return 1
7916 set anclist [list $x]
7917 set dl($x) 1
7918 set nnh 1
7919 set ngrowanc 0
7920 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7921 set x [lindex $anclist $i]
7922 if {$dl($x)} {
7923 incr nnh -1
7925 set done($x) 1
7926 foreach a $arcout($x) {
7927 if {[info exists growing($a)]} {
7928 if {![info exists growanc($x)] && $dl($x)} {
7929 set growanc($x) 1
7930 incr ngrowanc
7932 } else {
7933 set y $arcend($a)
7934 if {[info exists dl($y)]} {
7935 if {$dl($y)} {
7936 if {!$dl($x)} {
7937 set dl($y) 0
7938 if {![info exists done($y)]} {
7939 incr nnh -1
7941 if {[info exists growanc($x)]} {
7942 incr ngrowanc -1
7944 set xl [list $y]
7945 for {set k 0} {$k < [llength $xl]} {incr k} {
7946 set z [lindex $xl $k]
7947 foreach c $arcout($z) {
7948 if {[info exists arcend($c)]} {
7949 set v $arcend($c)
7950 if {[info exists dl($v)] && $dl($v)} {
7951 set dl($v) 0
7952 if {![info exists done($v)]} {
7953 incr nnh -1
7955 if {[info exists growanc($v)]} {
7956 incr ngrowanc -1
7958 lappend xl $v
7965 } elseif {$y eq $anc || !$dl($x)} {
7966 set dl($y) 0
7967 lappend anclist $y
7968 } else {
7969 set dl($y) 1
7970 lappend anclist $y
7971 incr nnh
7976 foreach x [array names growanc] {
7977 if {$dl($x)} {
7978 return 0
7980 return 0
7982 return 1
7985 proc validate_arctags {a} {
7986 global arctags idtags
7988 set i -1
7989 set na $arctags($a)
7990 foreach id $arctags($a) {
7991 incr i
7992 if {![info exists idtags($id)]} {
7993 set na [lreplace $na $i $i]
7994 incr i -1
7997 set arctags($a) $na
8000 proc validate_archeads {a} {
8001 global archeads idheads
8003 set i -1
8004 set na $archeads($a)
8005 foreach id $archeads($a) {
8006 incr i
8007 if {![info exists idheads($id)]} {
8008 set na [lreplace $na $i $i]
8009 incr i -1
8012 set archeads($a) $na
8015 # Return the list of IDs that have tags that are descendents of id,
8016 # ignoring IDs that are descendents of IDs already reported.
8017 proc desctags {id} {
8018 global arcnos arcstart arcids arctags idtags allparents
8019 global growing cached_dtags
8021 if {![info exists allparents($id)]} {
8022 return {}
8024 set t1 [clock clicks -milliseconds]
8025 set argid $id
8026 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8027 # part-way along an arc; check that arc first
8028 set a [lindex $arcnos($id) 0]
8029 if {$arctags($a) ne {}} {
8030 validate_arctags $a
8031 set i [lsearch -exact $arcids($a) $id]
8032 set tid {}
8033 foreach t $arctags($a) {
8034 set j [lsearch -exact $arcids($a) $t]
8035 if {$j >= $i} break
8036 set tid $t
8038 if {$tid ne {}} {
8039 return $tid
8042 set id $arcstart($a)
8043 if {[info exists idtags($id)]} {
8044 return $id
8047 if {[info exists cached_dtags($id)]} {
8048 return $cached_dtags($id)
8051 set origid $id
8052 set todo [list $id]
8053 set queued($id) 1
8054 set nc 1
8055 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8056 set id [lindex $todo $i]
8057 set done($id) 1
8058 set ta [info exists hastaggedancestor($id)]
8059 if {!$ta} {
8060 incr nc -1
8062 # ignore tags on starting node
8063 if {!$ta && $i > 0} {
8064 if {[info exists idtags($id)]} {
8065 set tagloc($id) $id
8066 set ta 1
8067 } elseif {[info exists cached_dtags($id)]} {
8068 set tagloc($id) $cached_dtags($id)
8069 set ta 1
8072 foreach a $arcnos($id) {
8073 set d $arcstart($a)
8074 if {!$ta && $arctags($a) ne {}} {
8075 validate_arctags $a
8076 if {$arctags($a) ne {}} {
8077 lappend tagloc($id) [lindex $arctags($a) end]
8080 if {$ta || $arctags($a) ne {}} {
8081 set tomark [list $d]
8082 for {set j 0} {$j < [llength $tomark]} {incr j} {
8083 set dd [lindex $tomark $j]
8084 if {![info exists hastaggedancestor($dd)]} {
8085 if {[info exists done($dd)]} {
8086 foreach b $arcnos($dd) {
8087 lappend tomark $arcstart($b)
8089 if {[info exists tagloc($dd)]} {
8090 unset tagloc($dd)
8092 } elseif {[info exists queued($dd)]} {
8093 incr nc -1
8095 set hastaggedancestor($dd) 1
8099 if {![info exists queued($d)]} {
8100 lappend todo $d
8101 set queued($d) 1
8102 if {![info exists hastaggedancestor($d)]} {
8103 incr nc
8108 set tags {}
8109 foreach id [array names tagloc] {
8110 if {![info exists hastaggedancestor($id)]} {
8111 foreach t $tagloc($id) {
8112 if {[lsearch -exact $tags $t] < 0} {
8113 lappend tags $t
8118 set t2 [clock clicks -milliseconds]
8119 set loopix $i
8121 # remove tags that are descendents of other tags
8122 for {set i 0} {$i < [llength $tags]} {incr i} {
8123 set a [lindex $tags $i]
8124 for {set j 0} {$j < $i} {incr j} {
8125 set b [lindex $tags $j]
8126 set r [anc_or_desc $a $b]
8127 if {$r == 1} {
8128 set tags [lreplace $tags $j $j]
8129 incr j -1
8130 incr i -1
8131 } elseif {$r == -1} {
8132 set tags [lreplace $tags $i $i]
8133 incr i -1
8134 break
8139 if {[array names growing] ne {}} {
8140 # graph isn't finished, need to check if any tag could get
8141 # eclipsed by another tag coming later. Simply ignore any
8142 # tags that could later get eclipsed.
8143 set ctags {}
8144 foreach t $tags {
8145 if {[is_certain $t $origid]} {
8146 lappend ctags $t
8149 if {$tags eq $ctags} {
8150 set cached_dtags($origid) $tags
8151 } else {
8152 set tags $ctags
8154 } else {
8155 set cached_dtags($origid) $tags
8157 set t3 [clock clicks -milliseconds]
8158 if {0 && $t3 - $t1 >= 100} {
8159 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8160 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8162 return $tags
8165 proc anctags {id} {
8166 global arcnos arcids arcout arcend arctags idtags allparents
8167 global growing cached_atags
8169 if {![info exists allparents($id)]} {
8170 return {}
8172 set t1 [clock clicks -milliseconds]
8173 set argid $id
8174 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8175 # part-way along an arc; check that arc first
8176 set a [lindex $arcnos($id) 0]
8177 if {$arctags($a) ne {}} {
8178 validate_arctags $a
8179 set i [lsearch -exact $arcids($a) $id]
8180 foreach t $arctags($a) {
8181 set j [lsearch -exact $arcids($a) $t]
8182 if {$j > $i} {
8183 return $t
8187 if {![info exists arcend($a)]} {
8188 return {}
8190 set id $arcend($a)
8191 if {[info exists idtags($id)]} {
8192 return $id
8195 if {[info exists cached_atags($id)]} {
8196 return $cached_atags($id)
8199 set origid $id
8200 set todo [list $id]
8201 set queued($id) 1
8202 set taglist {}
8203 set nc 1
8204 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8205 set id [lindex $todo $i]
8206 set done($id) 1
8207 set td [info exists hastaggeddescendent($id)]
8208 if {!$td} {
8209 incr nc -1
8211 # ignore tags on starting node
8212 if {!$td && $i > 0} {
8213 if {[info exists idtags($id)]} {
8214 set tagloc($id) $id
8215 set td 1
8216 } elseif {[info exists cached_atags($id)]} {
8217 set tagloc($id) $cached_atags($id)
8218 set td 1
8221 foreach a $arcout($id) {
8222 if {!$td && $arctags($a) ne {}} {
8223 validate_arctags $a
8224 if {$arctags($a) ne {}} {
8225 lappend tagloc($id) [lindex $arctags($a) 0]
8228 if {![info exists arcend($a)]} continue
8229 set d $arcend($a)
8230 if {$td || $arctags($a) ne {}} {
8231 set tomark [list $d]
8232 for {set j 0} {$j < [llength $tomark]} {incr j} {
8233 set dd [lindex $tomark $j]
8234 if {![info exists hastaggeddescendent($dd)]} {
8235 if {[info exists done($dd)]} {
8236 foreach b $arcout($dd) {
8237 if {[info exists arcend($b)]} {
8238 lappend tomark $arcend($b)
8241 if {[info exists tagloc($dd)]} {
8242 unset tagloc($dd)
8244 } elseif {[info exists queued($dd)]} {
8245 incr nc -1
8247 set hastaggeddescendent($dd) 1
8251 if {![info exists queued($d)]} {
8252 lappend todo $d
8253 set queued($d) 1
8254 if {![info exists hastaggeddescendent($d)]} {
8255 incr nc
8260 set t2 [clock clicks -milliseconds]
8261 set loopix $i
8262 set tags {}
8263 foreach id [array names tagloc] {
8264 if {![info exists hastaggeddescendent($id)]} {
8265 foreach t $tagloc($id) {
8266 if {[lsearch -exact $tags $t] < 0} {
8267 lappend tags $t
8273 # remove tags that are ancestors of other tags
8274 for {set i 0} {$i < [llength $tags]} {incr i} {
8275 set a [lindex $tags $i]
8276 for {set j 0} {$j < $i} {incr j} {
8277 set b [lindex $tags $j]
8278 set r [anc_or_desc $a $b]
8279 if {$r == -1} {
8280 set tags [lreplace $tags $j $j]
8281 incr j -1
8282 incr i -1
8283 } elseif {$r == 1} {
8284 set tags [lreplace $tags $i $i]
8285 incr i -1
8286 break
8291 if {[array names growing] ne {}} {
8292 # graph isn't finished, need to check if any tag could get
8293 # eclipsed by another tag coming later. Simply ignore any
8294 # tags that could later get eclipsed.
8295 set ctags {}
8296 foreach t $tags {
8297 if {[is_certain $origid $t]} {
8298 lappend ctags $t
8301 if {$tags eq $ctags} {
8302 set cached_atags($origid) $tags
8303 } else {
8304 set tags $ctags
8306 } else {
8307 set cached_atags($origid) $tags
8309 set t3 [clock clicks -milliseconds]
8310 if {0 && $t3 - $t1 >= 100} {
8311 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8312 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8314 return $tags
8317 # Return the list of IDs that have heads that are descendents of id,
8318 # including id itself if it has a head.
8319 proc descheads {id} {
8320 global arcnos arcstart arcids archeads idheads cached_dheads
8321 global allparents
8323 if {![info exists allparents($id)]} {
8324 return {}
8326 set aret {}
8327 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8328 # part-way along an arc; check it first
8329 set a [lindex $arcnos($id) 0]
8330 if {$archeads($a) ne {}} {
8331 validate_archeads $a
8332 set i [lsearch -exact $arcids($a) $id]
8333 foreach t $archeads($a) {
8334 set j [lsearch -exact $arcids($a) $t]
8335 if {$j > $i} break
8336 lappend aret $t
8339 set id $arcstart($a)
8341 set origid $id
8342 set todo [list $id]
8343 set seen($id) 1
8344 set ret {}
8345 for {set i 0} {$i < [llength $todo]} {incr i} {
8346 set id [lindex $todo $i]
8347 if {[info exists cached_dheads($id)]} {
8348 set ret [concat $ret $cached_dheads($id)]
8349 } else {
8350 if {[info exists idheads($id)]} {
8351 lappend ret $id
8353 foreach a $arcnos($id) {
8354 if {$archeads($a) ne {}} {
8355 validate_archeads $a
8356 if {$archeads($a) ne {}} {
8357 set ret [concat $ret $archeads($a)]
8360 set d $arcstart($a)
8361 if {![info exists seen($d)]} {
8362 lappend todo $d
8363 set seen($d) 1
8368 set ret [lsort -unique $ret]
8369 set cached_dheads($origid) $ret
8370 return [concat $ret $aret]
8373 proc addedtag {id} {
8374 global arcnos arcout cached_dtags cached_atags
8376 if {![info exists arcnos($id)]} return
8377 if {![info exists arcout($id)]} {
8378 recalcarc [lindex $arcnos($id) 0]
8380 catch {unset cached_dtags}
8381 catch {unset cached_atags}
8384 proc addedhead {hid head} {
8385 global arcnos arcout cached_dheads
8387 if {![info exists arcnos($hid)]} return
8388 if {![info exists arcout($hid)]} {
8389 recalcarc [lindex $arcnos($hid) 0]
8391 catch {unset cached_dheads}
8394 proc removedhead {hid head} {
8395 global cached_dheads
8397 catch {unset cached_dheads}
8400 proc movedhead {hid head} {
8401 global arcnos arcout cached_dheads
8403 if {![info exists arcnos($hid)]} return
8404 if {![info exists arcout($hid)]} {
8405 recalcarc [lindex $arcnos($hid) 0]
8407 catch {unset cached_dheads}
8410 proc changedrefs {} {
8411 global cached_dheads cached_dtags cached_atags
8412 global arctags archeads arcnos arcout idheads idtags
8414 foreach id [concat [array names idheads] [array names idtags]] {
8415 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8416 set a [lindex $arcnos($id) 0]
8417 if {![info exists donearc($a)]} {
8418 recalcarc $a
8419 set donearc($a) 1
8423 catch {unset cached_dtags}
8424 catch {unset cached_atags}
8425 catch {unset cached_dheads}
8428 proc rereadrefs {} {
8429 global idtags idheads idotherrefs mainheadid
8431 set refids [concat [array names idtags] \
8432 [array names idheads] [array names idotherrefs]]
8433 foreach id $refids {
8434 if {![info exists ref($id)]} {
8435 set ref($id) [listrefs $id]
8438 set oldmainhead $mainheadid
8439 readrefs
8440 changedrefs
8441 set refids [lsort -unique [concat $refids [array names idtags] \
8442 [array names idheads] [array names idotherrefs]]]
8443 foreach id $refids {
8444 set v [listrefs $id]
8445 if {![info exists ref($id)] || $ref($id) != $v ||
8446 ($id eq $oldmainhead && $id ne $mainheadid) ||
8447 ($id eq $mainheadid && $id ne $oldmainhead)} {
8448 redrawtags $id
8451 run refill_reflist
8454 proc listrefs {id} {
8455 global idtags idheads idotherrefs
8457 set x {}
8458 if {[info exists idtags($id)]} {
8459 set x $idtags($id)
8461 set y {}
8462 if {[info exists idheads($id)]} {
8463 set y $idheads($id)
8465 set z {}
8466 if {[info exists idotherrefs($id)]} {
8467 set z $idotherrefs($id)
8469 return [list $x $y $z]
8472 proc showtag {tag isnew} {
8473 global ctext tagcontents tagids linknum tagobjid
8475 if {$isnew} {
8476 addtohistory [list showtag $tag 0]
8478 $ctext conf -state normal
8479 clear_ctext
8480 settabs 0
8481 set linknum 0
8482 if {![info exists tagcontents($tag)]} {
8483 catch {
8484 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8487 if {[info exists tagcontents($tag)]} {
8488 set text $tagcontents($tag)
8489 } else {
8490 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8492 appendwithlinks $text {}
8493 $ctext conf -state disabled
8494 init_flist {}
8497 proc doquit {} {
8498 global stopped
8499 set stopped 100
8500 savestuff .
8501 destroy .
8504 proc mkfontdisp {font top which} {
8505 global fontattr fontpref $font
8507 set fontpref($font) [set $font]
8508 button $top.${font}but -text $which -font optionfont \
8509 -command [list choosefont $font $which]
8510 label $top.$font -relief flat -font $font \
8511 -text $fontattr($font,family) -justify left
8512 grid x $top.${font}but $top.$font -sticky w
8515 proc choosefont {font which} {
8516 global fontparam fontlist fonttop fontattr
8518 set fontparam(which) $which
8519 set fontparam(font) $font
8520 set fontparam(family) [font actual $font -family]
8521 set fontparam(size) $fontattr($font,size)
8522 set fontparam(weight) $fontattr($font,weight)
8523 set fontparam(slant) $fontattr($font,slant)
8524 set top .gitkfont
8525 set fonttop $top
8526 if {![winfo exists $top]} {
8527 font create sample
8528 eval font config sample [font actual $font]
8529 toplevel $top
8530 wm title $top [mc "Gitk font chooser"]
8531 label $top.l -textvariable fontparam(which)
8532 pack $top.l -side top
8533 set fontlist [lsort [font families]]
8534 frame $top.f
8535 listbox $top.f.fam -listvariable fontlist \
8536 -yscrollcommand [list $top.f.sb set]
8537 bind $top.f.fam <<ListboxSelect>> selfontfam
8538 scrollbar $top.f.sb -command [list $top.f.fam yview]
8539 pack $top.f.sb -side right -fill y
8540 pack $top.f.fam -side left -fill both -expand 1
8541 pack $top.f -side top -fill both -expand 1
8542 frame $top.g
8543 spinbox $top.g.size -from 4 -to 40 -width 4 \
8544 -textvariable fontparam(size) \
8545 -validatecommand {string is integer -strict %s}
8546 checkbutton $top.g.bold -padx 5 \
8547 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8548 -variable fontparam(weight) -onvalue bold -offvalue normal
8549 checkbutton $top.g.ital -padx 5 \
8550 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8551 -variable fontparam(slant) -onvalue italic -offvalue roman
8552 pack $top.g.size $top.g.bold $top.g.ital -side left
8553 pack $top.g -side top
8554 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8555 -background white
8556 $top.c create text 100 25 -anchor center -text $which -font sample \
8557 -fill black -tags text
8558 bind $top.c <Configure> [list centertext $top.c]
8559 pack $top.c -side top -fill x
8560 frame $top.buts
8561 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8562 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8563 grid $top.buts.ok $top.buts.can
8564 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8565 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8566 pack $top.buts -side bottom -fill x
8567 trace add variable fontparam write chg_fontparam
8568 } else {
8569 raise $top
8570 $top.c itemconf text -text $which
8572 set i [lsearch -exact $fontlist $fontparam(family)]
8573 if {$i >= 0} {
8574 $top.f.fam selection set $i
8575 $top.f.fam see $i
8579 proc centertext {w} {
8580 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8583 proc fontok {} {
8584 global fontparam fontpref prefstop
8586 set f $fontparam(font)
8587 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8588 if {$fontparam(weight) eq "bold"} {
8589 lappend fontpref($f) "bold"
8591 if {$fontparam(slant) eq "italic"} {
8592 lappend fontpref($f) "italic"
8594 set w $prefstop.$f
8595 $w conf -text $fontparam(family) -font $fontpref($f)
8597 fontcan
8600 proc fontcan {} {
8601 global fonttop fontparam
8603 if {[info exists fonttop]} {
8604 catch {destroy $fonttop}
8605 catch {font delete sample}
8606 unset fonttop
8607 unset fontparam
8611 proc selfontfam {} {
8612 global fonttop fontparam
8614 set i [$fonttop.f.fam curselection]
8615 if {$i ne {}} {
8616 set fontparam(family) [$fonttop.f.fam get $i]
8620 proc chg_fontparam {v sub op} {
8621 global fontparam
8623 font config sample -$sub $fontparam($sub)
8626 proc doprefs {} {
8627 global maxwidth maxgraphpct
8628 global oldprefs prefstop showneartags showlocalchanges
8629 global bgcolor fgcolor ctext diffcolors selectbgcolor
8630 global tabstop limitdiffs
8632 set top .gitkprefs
8633 set prefstop $top
8634 if {[winfo exists $top]} {
8635 raise $top
8636 return
8638 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8639 limitdiffs tabstop} {
8640 set oldprefs($v) [set $v]
8642 toplevel $top
8643 wm title $top [mc "Gitk preferences"]
8644 label $top.ldisp -text [mc "Commit list display options"]
8645 grid $top.ldisp - -sticky w -pady 10
8646 label $top.spacer -text " "
8647 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8648 -font optionfont
8649 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8650 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8651 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8652 -font optionfont
8653 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8654 grid x $top.maxpctl $top.maxpct -sticky w
8655 frame $top.showlocal
8656 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8657 checkbutton $top.showlocal.b -variable showlocalchanges
8658 pack $top.showlocal.b $top.showlocal.l -side left
8659 grid x $top.showlocal -sticky w
8661 label $top.ddisp -text [mc "Diff display options"]
8662 grid $top.ddisp - -sticky w -pady 10
8663 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8664 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8665 grid x $top.tabstopl $top.tabstop -sticky w
8666 frame $top.ntag
8667 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8668 checkbutton $top.ntag.b -variable showneartags
8669 pack $top.ntag.b $top.ntag.l -side left
8670 grid x $top.ntag -sticky w
8671 frame $top.ldiff
8672 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8673 checkbutton $top.ldiff.b -variable limitdiffs
8674 pack $top.ldiff.b $top.ldiff.l -side left
8675 grid x $top.ldiff -sticky w
8677 label $top.cdisp -text [mc "Colors: press to choose"]
8678 grid $top.cdisp - -sticky w -pady 10
8679 label $top.bg -padx 40 -relief sunk -background $bgcolor
8680 button $top.bgbut -text [mc "Background"] -font optionfont \
8681 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8682 grid x $top.bgbut $top.bg -sticky w
8683 label $top.fg -padx 40 -relief sunk -background $fgcolor
8684 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8685 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8686 grid x $top.fgbut $top.fg -sticky w
8687 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8688 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8689 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8690 [list $ctext tag conf d0 -foreground]]
8691 grid x $top.diffoldbut $top.diffold -sticky w
8692 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8693 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8694 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8695 [list $ctext tag conf d1 -foreground]]
8696 grid x $top.diffnewbut $top.diffnew -sticky w
8697 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8698 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8699 -command [list choosecolor diffcolors 2 $top.hunksep \
8700 "diff hunk header" \
8701 [list $ctext tag conf hunksep -foreground]]
8702 grid x $top.hunksepbut $top.hunksep -sticky w
8703 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8704 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8705 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8706 grid x $top.selbgbut $top.selbgsep -sticky w
8708 label $top.cfont -text [mc "Fonts: press to choose"]
8709 grid $top.cfont - -sticky w -pady 10
8710 mkfontdisp mainfont $top [mc "Main font"]
8711 mkfontdisp textfont $top [mc "Diff display font"]
8712 mkfontdisp uifont $top [mc "User interface font"]
8714 frame $top.buts
8715 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8716 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8717 grid $top.buts.ok $top.buts.can
8718 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8719 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8720 grid $top.buts - - -pady 10 -sticky ew
8721 bind $top <Visibility> "focus $top.buts.ok"
8724 proc choosecolor {v vi w x cmd} {
8725 global $v
8727 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8728 -title [mc "Gitk: choose color for %s" $x]]
8729 if {$c eq {}} return
8730 $w conf -background $c
8731 lset $v $vi $c
8732 eval $cmd $c
8735 proc setselbg {c} {
8736 global bglist cflist
8737 foreach w $bglist {
8738 $w configure -selectbackground $c
8740 $cflist tag configure highlight \
8741 -background [$cflist cget -selectbackground]
8742 allcanvs itemconf secsel -fill $c
8745 proc setbg {c} {
8746 global bglist
8748 foreach w $bglist {
8749 $w conf -background $c
8753 proc setfg {c} {
8754 global fglist canv
8756 foreach w $fglist {
8757 $w conf -foreground $c
8759 allcanvs itemconf text -fill $c
8760 $canv itemconf circle -outline $c
8763 proc prefscan {} {
8764 global oldprefs prefstop
8766 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8767 limitdiffs tabstop} {
8768 global $v
8769 set $v $oldprefs($v)
8771 catch {destroy $prefstop}
8772 unset prefstop
8773 fontcan
8776 proc prefsok {} {
8777 global maxwidth maxgraphpct
8778 global oldprefs prefstop showneartags showlocalchanges
8779 global fontpref mainfont textfont uifont
8780 global limitdiffs treediffs
8782 catch {destroy $prefstop}
8783 unset prefstop
8784 fontcan
8785 set fontchanged 0
8786 if {$mainfont ne $fontpref(mainfont)} {
8787 set mainfont $fontpref(mainfont)
8788 parsefont mainfont $mainfont
8789 eval font configure mainfont [fontflags mainfont]
8790 eval font configure mainfontbold [fontflags mainfont 1]
8791 setcoords
8792 set fontchanged 1
8794 if {$textfont ne $fontpref(textfont)} {
8795 set textfont $fontpref(textfont)
8796 parsefont textfont $textfont
8797 eval font configure textfont [fontflags textfont]
8798 eval font configure textfontbold [fontflags textfont 1]
8800 if {$uifont ne $fontpref(uifont)} {
8801 set uifont $fontpref(uifont)
8802 parsefont uifont $uifont
8803 eval font configure uifont [fontflags uifont]
8805 settabs
8806 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8807 if {$showlocalchanges} {
8808 doshowlocalchanges
8809 } else {
8810 dohidelocalchanges
8813 if {$limitdiffs != $oldprefs(limitdiffs)} {
8814 # treediffs elements are limited by path
8815 catch {unset treediffs}
8817 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8818 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8819 redisplay
8820 } elseif {$showneartags != $oldprefs(showneartags) ||
8821 $limitdiffs != $oldprefs(limitdiffs)} {
8822 reselectline
8826 proc formatdate {d} {
8827 global datetimeformat
8828 if {$d ne {}} {
8829 set d [clock format $d -format $datetimeformat]
8831 return $d
8834 # This list of encoding names and aliases is distilled from
8835 # http://www.iana.org/assignments/character-sets.
8836 # Not all of them are supported by Tcl.
8837 set encoding_aliases {
8838 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8839 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8840 { ISO-10646-UTF-1 csISO10646UTF1 }
8841 { ISO_646.basic:1983 ref csISO646basic1983 }
8842 { INVARIANT csINVARIANT }
8843 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8844 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8845 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8846 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8847 { NATS-DANO iso-ir-9-1 csNATSDANO }
8848 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8849 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8850 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8851 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8852 { ISO-2022-KR csISO2022KR }
8853 { EUC-KR csEUCKR }
8854 { ISO-2022-JP csISO2022JP }
8855 { ISO-2022-JP-2 csISO2022JP2 }
8856 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8857 csISO13JISC6220jp }
8858 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8859 { IT iso-ir-15 ISO646-IT csISO15Italian }
8860 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8861 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8862 { greek7-old iso-ir-18 csISO18Greek7Old }
8863 { latin-greek iso-ir-19 csISO19LatinGreek }
8864 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8865 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8866 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8867 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8868 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8869 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8870 { INIS iso-ir-49 csISO49INIS }
8871 { INIS-8 iso-ir-50 csISO50INIS8 }
8872 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8873 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8874 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8875 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8876 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8877 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8878 csISO60Norwegian1 }
8879 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8880 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8881 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8882 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8883 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8884 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8885 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8886 { greek7 iso-ir-88 csISO88Greek7 }
8887 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8888 { iso-ir-90 csISO90 }
8889 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8890 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8891 csISO92JISC62991984b }
8892 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8893 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8894 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8895 csISO95JIS62291984handadd }
8896 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8897 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8898 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8899 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8900 CP819 csISOLatin1 }
8901 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8902 { T.61-7bit iso-ir-102 csISO102T617bit }
8903 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8904 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8905 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8906 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8907 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8908 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8909 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8910 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8911 arabic csISOLatinArabic }
8912 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8913 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8914 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8915 greek greek8 csISOLatinGreek }
8916 { T.101-G2 iso-ir-128 csISO128T101G2 }
8917 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8918 csISOLatinHebrew }
8919 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8920 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8921 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8922 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8923 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8924 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8925 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8926 csISOLatinCyrillic }
8927 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8928 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8929 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8930 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8931 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8932 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8933 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8934 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8935 { ISO_10367-box iso-ir-155 csISO10367Box }
8936 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8937 { latin-lap lap iso-ir-158 csISO158Lap }
8938 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8939 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8940 { us-dk csUSDK }
8941 { dk-us csDKUS }
8942 { JIS_X0201 X0201 csHalfWidthKatakana }
8943 { KSC5636 ISO646-KR csKSC5636 }
8944 { ISO-10646-UCS-2 csUnicode }
8945 { ISO-10646-UCS-4 csUCS4 }
8946 { DEC-MCS dec csDECMCS }
8947 { hp-roman8 roman8 r8 csHPRoman8 }
8948 { macintosh mac csMacintosh }
8949 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8950 csIBM037 }
8951 { IBM038 EBCDIC-INT cp038 csIBM038 }
8952 { IBM273 CP273 csIBM273 }
8953 { IBM274 EBCDIC-BE CP274 csIBM274 }
8954 { IBM275 EBCDIC-BR cp275 csIBM275 }
8955 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8956 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8957 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8958 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8959 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8960 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8961 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8962 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8963 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8964 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8965 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8966 { IBM437 cp437 437 csPC8CodePage437 }
8967 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8968 { IBM775 cp775 csPC775Baltic }
8969 { IBM850 cp850 850 csPC850Multilingual }
8970 { IBM851 cp851 851 csIBM851 }
8971 { IBM852 cp852 852 csPCp852 }
8972 { IBM855 cp855 855 csIBM855 }
8973 { IBM857 cp857 857 csIBM857 }
8974 { IBM860 cp860 860 csIBM860 }
8975 { IBM861 cp861 861 cp-is csIBM861 }
8976 { IBM862 cp862 862 csPC862LatinHebrew }
8977 { IBM863 cp863 863 csIBM863 }
8978 { IBM864 cp864 csIBM864 }
8979 { IBM865 cp865 865 csIBM865 }
8980 { IBM866 cp866 866 csIBM866 }
8981 { IBM868 CP868 cp-ar csIBM868 }
8982 { IBM869 cp869 869 cp-gr csIBM869 }
8983 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8984 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8985 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8986 { IBM891 cp891 csIBM891 }
8987 { IBM903 cp903 csIBM903 }
8988 { IBM904 cp904 904 csIBBM904 }
8989 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8990 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8991 { IBM1026 CP1026 csIBM1026 }
8992 { EBCDIC-AT-DE csIBMEBCDICATDE }
8993 { EBCDIC-AT-DE-A csEBCDICATDEA }
8994 { EBCDIC-CA-FR csEBCDICCAFR }
8995 { EBCDIC-DK-NO csEBCDICDKNO }
8996 { EBCDIC-DK-NO-A csEBCDICDKNOA }
8997 { EBCDIC-FI-SE csEBCDICFISE }
8998 { EBCDIC-FI-SE-A csEBCDICFISEA }
8999 { EBCDIC-FR csEBCDICFR }
9000 { EBCDIC-IT csEBCDICIT }
9001 { EBCDIC-PT csEBCDICPT }
9002 { EBCDIC-ES csEBCDICES }
9003 { EBCDIC-ES-A csEBCDICESA }
9004 { EBCDIC-ES-S csEBCDICESS }
9005 { EBCDIC-UK csEBCDICUK }
9006 { EBCDIC-US csEBCDICUS }
9007 { UNKNOWN-8BIT csUnknown8BiT }
9008 { MNEMONIC csMnemonic }
9009 { MNEM csMnem }
9010 { VISCII csVISCII }
9011 { VIQR csVIQR }
9012 { KOI8-R csKOI8R }
9013 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9014 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9015 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9016 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9017 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9018 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9019 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9020 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9021 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9022 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9023 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9024 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9025 { IBM1047 IBM-1047 }
9026 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9027 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9028 { UNICODE-1-1 csUnicode11 }
9029 { CESU-8 csCESU-8 }
9030 { BOCU-1 csBOCU-1 }
9031 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9032 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9033 l8 }
9034 { ISO-8859-15 ISO_8859-15 Latin-9 }
9035 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9036 { GBK CP936 MS936 windows-936 }
9037 { JIS_Encoding csJISEncoding }
9038 { Shift_JIS MS_Kanji csShiftJIS }
9039 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9040 EUC-JP }
9041 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9042 { ISO-10646-UCS-Basic csUnicodeASCII }
9043 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9044 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9045 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9046 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9047 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9048 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9049 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9050 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9051 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9052 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9053 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9054 { Ventura-US csVenturaUS }
9055 { Ventura-International csVenturaInternational }
9056 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9057 { PC8-Turkish csPC8Turkish }
9058 { IBM-Symbols csIBMSymbols }
9059 { IBM-Thai csIBMThai }
9060 { HP-Legal csHPLegal }
9061 { HP-Pi-font csHPPiFont }
9062 { HP-Math8 csHPMath8 }
9063 { Adobe-Symbol-Encoding csHPPSMath }
9064 { HP-DeskTop csHPDesktop }
9065 { Ventura-Math csVenturaMath }
9066 { Microsoft-Publishing csMicrosoftPublishing }
9067 { Windows-31J csWindows31J }
9068 { GB2312 csGB2312 }
9069 { Big5 csBig5 }
9072 proc tcl_encoding {enc} {
9073 global encoding_aliases
9074 set names [encoding names]
9075 set lcnames [string tolower $names]
9076 set enc [string tolower $enc]
9077 set i [lsearch -exact $lcnames $enc]
9078 if {$i < 0} {
9079 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9080 if {[regsub {^iso[-_]} $enc iso encx]} {
9081 set i [lsearch -exact $lcnames $encx]
9084 if {$i < 0} {
9085 foreach l $encoding_aliases {
9086 set ll [string tolower $l]
9087 if {[lsearch -exact $ll $enc] < 0} continue
9088 # look through the aliases for one that tcl knows about
9089 foreach e $ll {
9090 set i [lsearch -exact $lcnames $e]
9091 if {$i < 0} {
9092 if {[regsub {^iso[-_]} $e iso ex]} {
9093 set i [lsearch -exact $lcnames $ex]
9096 if {$i >= 0} break
9098 break
9101 if {$i >= 0} {
9102 return [lindex $names $i]
9104 return {}
9107 # First check that Tcl/Tk is recent enough
9108 if {[catch {package require Tk 8.4} err]} {
9109 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9110 Gitk requires at least Tcl/Tk 8.4."]
9111 exit 1
9114 # defaults...
9115 set datemode 0
9116 set wrcomcmd "git diff-tree --stdin -p --pretty"
9118 set gitencoding {}
9119 catch {
9120 set gitencoding [exec git config --get i18n.commitencoding]
9122 if {$gitencoding == ""} {
9123 set gitencoding "utf-8"
9125 set tclencoding [tcl_encoding $gitencoding]
9126 if {$tclencoding == {}} {
9127 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9130 set mainfont {Helvetica 9}
9131 set textfont {Courier 9}
9132 set uifont {Helvetica 9 bold}
9133 set tabstop 8
9134 set findmergefiles 0
9135 set maxgraphpct 50
9136 set maxwidth 16
9137 set revlistorder 0
9138 set fastdate 0
9139 set uparrowlen 5
9140 set downarrowlen 5
9141 set mingaplen 100
9142 set cmitmode "patch"
9143 set wrapcomment "none"
9144 set showneartags 1
9145 set maxrefs 20
9146 set maxlinelen 200
9147 set showlocalchanges 1
9148 set limitdiffs 1
9149 set datetimeformat "%Y-%m-%d %H:%M:%S"
9151 set colors {green red blue magenta darkgrey brown orange}
9152 set bgcolor white
9153 set fgcolor black
9154 set diffcolors {red "#00a000" blue}
9155 set diffcontext 3
9156 set selectbgcolor gray85
9158 ## For msgcat loading, first locate the installation location.
9159 if { [info exists ::env(GITK_MSGSDIR)] } {
9160 ## Msgsdir was manually set in the environment.
9161 set gitk_msgsdir $::env(GITK_MSGSDIR)
9162 } else {
9163 ## Let's guess the prefix from argv0.
9164 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9165 set gitk_libdir [file join $gitk_prefix share gitk lib]
9166 set gitk_msgsdir [file join $gitk_libdir msgs]
9167 unset gitk_prefix
9170 ## Internationalization (i18n) through msgcat and gettext. See
9171 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9172 package require msgcat
9173 namespace import ::msgcat::mc
9174 ## And eventually load the actual message catalog
9175 ::msgcat::mcload $gitk_msgsdir
9177 catch {source ~/.gitk}
9179 font create optionfont -family sans-serif -size -12
9181 parsefont mainfont $mainfont
9182 eval font create mainfont [fontflags mainfont]
9183 eval font create mainfontbold [fontflags mainfont 1]
9185 parsefont textfont $textfont
9186 eval font create textfont [fontflags textfont]
9187 eval font create textfontbold [fontflags textfont 1]
9189 parsefont uifont $uifont
9190 eval font create uifont [fontflags uifont]
9192 setoptions
9194 # check that we can find a .git directory somewhere...
9195 if {[catch {set gitdir [gitdir]}]} {
9196 show_error {} . [mc "Cannot find a git repository here."]
9197 exit 1
9199 if {![file isdirectory $gitdir]} {
9200 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9201 exit 1
9204 set mergeonly 0
9205 set revtreeargs {}
9206 set cmdline_files {}
9207 set i 0
9208 foreach arg $argv {
9209 switch -- $arg {
9210 "" { }
9211 "-d" { set datemode 1 }
9212 "--merge" {
9213 set mergeonly 1
9214 lappend revtreeargs $arg
9216 "--" {
9217 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9218 break
9220 default {
9221 lappend revtreeargs $arg
9224 incr i
9227 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9228 # no -- on command line, but some arguments (other than -d)
9229 if {[catch {
9230 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9231 set cmdline_files [split $f "\n"]
9232 set n [llength $cmdline_files]
9233 set revtreeargs [lrange $revtreeargs 0 end-$n]
9234 # Unfortunately git rev-parse doesn't produce an error when
9235 # something is both a revision and a filename. To be consistent
9236 # with git log and git rev-list, check revtreeargs for filenames.
9237 foreach arg $revtreeargs {
9238 if {[file exists $arg]} {
9239 show_error {} . [mc "Ambiguous argument '%s': both revision\
9240 and filename" $arg]
9241 exit 1
9244 } err]} {
9245 # unfortunately we get both stdout and stderr in $err,
9246 # so look for "fatal:".
9247 set i [string first "fatal:" $err]
9248 if {$i > 0} {
9249 set err [string range $err [expr {$i + 6}] end]
9251 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9252 exit 1
9256 if {$mergeonly} {
9257 # find the list of unmerged files
9258 set mlist {}
9259 set nr_unmerged 0
9260 if {[catch {
9261 set fd [open "| git ls-files -u" r]
9262 } err]} {
9263 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9264 exit 1
9266 while {[gets $fd line] >= 0} {
9267 set i [string first "\t" $line]
9268 if {$i < 0} continue
9269 set fname [string range $line [expr {$i+1}] end]
9270 if {[lsearch -exact $mlist $fname] >= 0} continue
9271 incr nr_unmerged
9272 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9273 lappend mlist $fname
9276 catch {close $fd}
9277 if {$mlist eq {}} {
9278 if {$nr_unmerged == 0} {
9279 show_error {} . [mc "No files selected: --merge specified but\
9280 no files are unmerged."]
9281 } else {
9282 show_error {} . [mc "No files selected: --merge specified but\
9283 no unmerged files are within file limit."]
9285 exit 1
9287 set cmdline_files $mlist
9290 set nullid "0000000000000000000000000000000000000000"
9291 set nullid2 "0000000000000000000000000000000000000001"
9293 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9295 set runq {}
9296 set history {}
9297 set historyindex 0
9298 set fh_serial 0
9299 set nhl_names {}
9300 set highlight_paths {}
9301 set findpattern {}
9302 set searchdirn -forwards
9303 set boldrows {}
9304 set boldnamerows {}
9305 set diffelide {0 0}
9306 set markingmatches 0
9307 set linkentercount 0
9308 set need_redisplay 0
9309 set nrows_drawn 0
9310 set firsttabstop 0
9312 set nextviewnum 1
9313 set curview 0
9314 set selectedview 0
9315 set selectedhlview [mc "None"]
9316 set highlight_related [mc "None"]
9317 set highlight_files {}
9318 set viewfiles(0) {}
9319 set viewperm(0) 0
9320 set viewargs(0) {}
9322 set loginstance 0
9323 set cmdlineok 0
9324 set stopped 0
9325 set stuffsaved 0
9326 set patchnum 0
9327 set lserial 0
9328 setcoords
9329 makewindow
9330 # wait for the window to become visible
9331 tkwait visibility .
9332 wm title . "[file tail $argv0]: [file tail [pwd]]"
9333 readrefs
9335 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9336 # create a view for the files/dirs specified on the command line
9337 set curview 1
9338 set selectedview 1
9339 set nextviewnum 2
9340 set viewname(1) [mc "Command line"]
9341 set viewfiles(1) $cmdline_files
9342 set viewargs(1) $revtreeargs
9343 set viewperm(1) 0
9344 addviewmenu 1
9345 .bar.view entryconf [mc "Edit view..."] -state normal
9346 .bar.view entryconf [mc "Delete view"] -state normal
9349 if {[info exists permviews]} {
9350 foreach v $permviews {
9351 set n $nextviewnum
9352 incr nextviewnum
9353 set viewname($n) [lindex $v 0]
9354 set viewfiles($n) [lindex $v 1]
9355 set viewargs($n) [lindex $v 2]
9356 set viewperm($n) 1
9357 addviewmenu $n
9360 getcommits