gitk: Fix handling of flag arguments
[git/mingw.git] / gitk
blob97d1be092aa41fb3dafe4a79dd4699c91bf23142
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
102 set startmsecs [clock clicks -milliseconds]
103 set commitidx($view) 0
104 set viewcomplete($view) 0
105 set viewactive($view) 1
106 set vnextroot($view) 0
107 varcinit $view
109 set commits [eval exec git rev-parse --default HEAD --revs-only \
110 $viewargs($view)]
111 set viewincl($view) {}
112 foreach c $commits {
113 if {[regexp {^[0-9a-fA-F]{40}$} $c]} {
114 lappend viewincl($view) $c
117 if {[catch {
118 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
119 --boundary $commits "--" $viewfiles($view)] r]
120 } err]} {
121 error_popup "[mc "Error executing git log:"] $err"
122 exit 1
124 set i [incr loginstance]
125 set viewinstances($view) [list $i]
126 set commfd($i) $fd
127 set leftover($i) {}
128 if {$showlocalchanges} {
129 lappend commitinterest($mainheadid) {dodiffindex}
131 fconfigure $fd -blocking 0 -translation lf -eofchar {}
132 if {$tclencoding != {}} {
133 fconfigure $fd -encoding $tclencoding
135 filerun $fd [list getcommitlines $fd $i $view]
136 nowbusy $view [mc "Reading"]
137 if {$view == $curview} {
138 set progressdirn 1
139 set progresscoords {0 0}
140 set proglastnc 0
144 proc stop_rev_list {view} {
145 global commfd viewinstances leftover
147 foreach inst $viewinstances($view) {
148 set fd $commfd($inst)
149 catch {
150 set pid [pid $fd]
151 exec kill $pid
153 catch {close $fd}
154 nukefile $fd
155 unset commfd($inst)
156 unset leftover($inst)
158 set viewinstances($view) {}
161 proc getcommits {} {
162 global canv curview
164 initlayout
165 start_rev_list $curview
166 show_status [mc "Reading commits..."]
169 proc updatecommits {} {
170 global curview viewargs viewfiles viewincl viewinstances
171 global viewactive viewcomplete loginstance tclencoding mainheadid
172 global varcid startmsecs commfd showneartags showlocalchanges leftover
173 global mainheadid
175 set oldmainid $mainheadid
176 rereadrefs
177 if {$showlocalchanges} {
178 if {$mainheadid ne $oldmainid} {
179 dohidelocalchanges
181 if {[commitinview $mainheadid $curview]} {
182 dodiffindex
185 set view $curview
186 set commits [exec git rev-parse --default HEAD --revs-only \
187 $viewargs($view)]
188 set pos {}
189 set neg {}
190 set flags {}
191 foreach c $commits {
192 if {[string match "^*" $c]} {
193 lappend neg $c
194 } elseif {[regexp {^[0-9a-fA-F]{40}$} $c]} {
195 if {!([info exists varcid($view,$c)] ||
196 [lsearch -exact $viewincl($view) $c] >= 0)} {
197 lappend pos $c
199 } else {
200 lappend flags $c
203 if {$pos eq {}} {
204 return
206 foreach id $viewincl($view) {
207 lappend neg "^$id"
209 set viewincl($view) [concat $viewincl($view) $pos]
210 if {[catch {
211 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
212 --boundary $pos $neg $flags "--" $viewfiles($view)] r]
213 } err]} {
214 error_popup "Error executing git log: $err"
215 exit 1
217 if {$viewactive($view) == 0} {
218 set startmsecs [clock clicks -milliseconds]
220 set i [incr loginstance]
221 lappend viewinstances($view) $i
222 set commfd($i) $fd
223 set leftover($i) {}
224 fconfigure $fd -blocking 0 -translation lf -eofchar {}
225 if {$tclencoding != {}} {
226 fconfigure $fd -encoding $tclencoding
228 filerun $fd [list getcommitlines $fd $i $view]
229 incr viewactive($view)
230 set viewcomplete($view) 0
231 nowbusy $view "Reading"
232 if {$showneartags} {
233 getallcommits
237 proc reloadcommits {} {
238 global curview viewcomplete selectedline currentid thickerline
239 global showneartags treediffs commitinterest cached_commitrow
240 global progresscoords targetid
242 if {!$viewcomplete($curview)} {
243 stop_rev_list $curview
244 set progresscoords {0 0}
245 adjustprogress
247 resetvarcs $curview
248 catch {unset selectedline}
249 catch {unset currentid}
250 catch {unset thickerline}
251 catch {unset treediffs}
252 readrefs
253 changedrefs
254 if {$showneartags} {
255 getallcommits
257 clear_display
258 catch {unset commitinterest}
259 catch {unset cached_commitrow}
260 catch {unset targetid}
261 setcanvscroll
262 getcommits
265 # This makes a string representation of a positive integer which
266 # sorts as a string in numerical order
267 proc strrep {n} {
268 if {$n < 16} {
269 return [format "%x" $n]
270 } elseif {$n < 256} {
271 return [format "x%.2x" $n]
272 } elseif {$n < 65536} {
273 return [format "y%.4x" $n]
275 return [format "z%.8x" $n]
278 # Procedures used in reordering commits from git log (without
279 # --topo-order) into the order for display.
281 proc varcinit {view} {
282 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
283 global vtokmod varcmod vrowmod varcix vlastins
285 set varcstart($view) {{}}
286 set vupptr($view) {0}
287 set vdownptr($view) {0}
288 set vleftptr($view) {0}
289 set vbackptr($view) {0}
290 set varctok($view) {{}}
291 set varcrow($view) {{}}
292 set vtokmod($view) {}
293 set varcmod($view) 0
294 set vrowmod($view) 0
295 set varcix($view) {{}}
296 set vlastins($view) {0}
299 proc resetvarcs {view} {
300 global varcid varccommits parents children vseedcount ordertok
302 foreach vid [array names varcid $view,*] {
303 unset varcid($vid)
304 unset children($vid)
305 unset parents($vid)
307 # some commits might have children but haven't been seen yet
308 foreach vid [array names children $view,*] {
309 unset children($vid)
311 foreach va [array names varccommits $view,*] {
312 unset varccommits($va)
314 foreach vd [array names vseedcount $view,*] {
315 unset vseedcount($vd)
317 catch {unset ordertok}
320 proc newvarc {view id} {
321 global varcid varctok parents children datemode
322 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
323 global commitdata commitinfo vseedcount varccommits vlastins
325 set a [llength $varctok($view)]
326 set vid $view,$id
327 if {[llength $children($vid)] == 0 || $datemode} {
328 if {![info exists commitinfo($id)]} {
329 parsecommit $id $commitdata($id) 1
331 set cdate [lindex $commitinfo($id) 4]
332 if {![string is integer -strict $cdate]} {
333 set cdate 0
335 if {![info exists vseedcount($view,$cdate)]} {
336 set vseedcount($view,$cdate) -1
338 set c [incr vseedcount($view,$cdate)]
339 set cdate [expr {$cdate ^ 0xffffffff}]
340 set tok "s[strrep $cdate][strrep $c]"
341 } else {
342 set tok {}
344 set ka 0
345 if {[llength $children($vid)] > 0} {
346 set kid [lindex $children($vid) end]
347 set k $varcid($view,$kid)
348 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
349 set ki $kid
350 set ka $k
351 set tok [lindex $varctok($view) $k]
354 if {$ka != 0} {
355 set i [lsearch -exact $parents($view,$ki) $id]
356 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
357 append tok [strrep $j]
359 set c [lindex $vlastins($view) $ka]
360 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
361 set c $ka
362 set b [lindex $vdownptr($view) $ka]
363 } else {
364 set b [lindex $vleftptr($view) $c]
366 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
367 set c $b
368 set b [lindex $vleftptr($view) $c]
370 if {$c == $ka} {
371 lset vdownptr($view) $ka $a
372 lappend vbackptr($view) 0
373 } else {
374 lset vleftptr($view) $c $a
375 lappend vbackptr($view) $c
377 lset vlastins($view) $ka $a
378 lappend vupptr($view) $ka
379 lappend vleftptr($view) $b
380 if {$b != 0} {
381 lset vbackptr($view) $b $a
383 lappend varctok($view) $tok
384 lappend varcstart($view) $id
385 lappend vdownptr($view) 0
386 lappend varcrow($view) {}
387 lappend varcix($view) {}
388 set varccommits($view,$a) {}
389 lappend vlastins($view) 0
390 return $a
393 proc splitvarc {p v} {
394 global varcid varcstart varccommits varctok
395 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
397 set oa $varcid($v,$p)
398 set ac $varccommits($v,$oa)
399 set i [lsearch -exact $varccommits($v,$oa) $p]
400 if {$i <= 0} return
401 set na [llength $varctok($v)]
402 # "%" sorts before "0"...
403 set tok "[lindex $varctok($v) $oa]%[strrep $i]"
404 lappend varctok($v) $tok
405 lappend varcrow($v) {}
406 lappend varcix($v) {}
407 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
408 set varccommits($v,$na) [lrange $ac $i end]
409 lappend varcstart($v) $p
410 foreach id $varccommits($v,$na) {
411 set varcid($v,$id) $na
413 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
414 lset vdownptr($v) $oa $na
415 lappend vupptr($v) $oa
416 lappend vleftptr($v) 0
417 lappend vbackptr($v) 0
418 lappend vlastins($v) 0
419 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
420 lset vupptr($v) $b $na
424 proc renumbervarc {a v} {
425 global parents children varctok varcstart varccommits
426 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
428 set t1 [clock clicks -milliseconds]
429 set todo {}
430 set isrelated($a) 1
431 set kidchanged($a) 1
432 set ntot 0
433 while {$a != 0} {
434 if {[info exists isrelated($a)]} {
435 lappend todo $a
436 set id [lindex $varccommits($v,$a) end]
437 foreach p $parents($v,$id) {
438 if {[info exists varcid($v,$p)]} {
439 set isrelated($varcid($v,$p)) 1
443 incr ntot
444 set b [lindex $vdownptr($v) $a]
445 if {$b == 0} {
446 while {$a != 0} {
447 set b [lindex $vleftptr($v) $a]
448 if {$b != 0} break
449 set a [lindex $vupptr($v) $a]
452 set a $b
454 foreach a $todo {
455 if {![info exists kidchanged($a)]} continue
456 set id [lindex $varcstart($v) $a]
457 if {[llength $children($v,$id)] > 1} {
458 set children($v,$id) [lsort -command [list vtokcmp $v] \
459 $children($v,$id)]
461 set oldtok [lindex $varctok($v) $a]
462 if {!$datemode} {
463 set tok {}
464 } else {
465 set tok $oldtok
467 set ka 0
468 set kid [last_real_child $v,$id]
469 if {$kid ne {}} {
470 set k $varcid($v,$kid)
471 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
472 set ki $kid
473 set ka $k
474 set tok [lindex $varctok($v) $k]
477 if {$ka != 0} {
478 set i [lsearch -exact $parents($v,$ki) $id]
479 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
480 append tok [strrep $j]
482 if {$tok eq $oldtok} {
483 continue
485 set id [lindex $varccommits($v,$a) end]
486 foreach p $parents($v,$id) {
487 if {[info exists varcid($v,$p)]} {
488 set kidchanged($varcid($v,$p)) 1
489 } else {
490 set sortkids($p) 1
493 lset varctok($v) $a $tok
494 set b [lindex $vupptr($v) $a]
495 if {$b != $ka} {
496 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
497 modify_arc $v $ka
499 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
500 modify_arc $v $b
502 set c [lindex $vbackptr($v) $a]
503 set d [lindex $vleftptr($v) $a]
504 if {$c == 0} {
505 lset vdownptr($v) $b $d
506 } else {
507 lset vleftptr($v) $c $d
509 if {$d != 0} {
510 lset vbackptr($v) $d $c
512 lset vupptr($v) $a $ka
513 set c [lindex $vlastins($v) $ka]
514 if {$c == 0 || \
515 [string compare $tok [lindex $varctok($v) $c]] < 0} {
516 set c $ka
517 set b [lindex $vdownptr($v) $ka]
518 } else {
519 set b [lindex $vleftptr($v) $c]
521 while {$b != 0 && \
522 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
523 set c $b
524 set b [lindex $vleftptr($v) $c]
526 if {$c == $ka} {
527 lset vdownptr($v) $ka $a
528 lset vbackptr($v) $a 0
529 } else {
530 lset vleftptr($v) $c $a
531 lset vbackptr($v) $a $c
533 lset vleftptr($v) $a $b
534 if {$b != 0} {
535 lset vbackptr($v) $b $a
537 lset vlastins($v) $ka $a
540 foreach id [array names sortkids] {
541 if {[llength $children($v,$id)] > 1} {
542 set children($v,$id) [lsort -command [list vtokcmp $v] \
543 $children($v,$id)]
546 set t2 [clock clicks -milliseconds]
547 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
550 proc fix_reversal {p a v} {
551 global varcid varcstart varctok vupptr
553 set pa $varcid($v,$p)
554 if {$p ne [lindex $varcstart($v) $pa]} {
555 splitvarc $p $v
556 set pa $varcid($v,$p)
558 # seeds always need to be renumbered
559 if {[lindex $vupptr($v) $pa] == 0 ||
560 [string compare [lindex $varctok($v) $a] \
561 [lindex $varctok($v) $pa]] > 0} {
562 renumbervarc $pa $v
566 proc insertrow {id p v} {
567 global varcid varccommits parents children cmitlisted
568 global commitidx varctok vtokmod targetid targetrow
570 set a $varcid($v,$p)
571 set i [lsearch -exact $varccommits($v,$a) $p]
572 if {$i < 0} {
573 puts "oops: insertrow can't find [shortids $p] on arc $a"
574 return
576 set children($v,$id) {}
577 set parents($v,$id) [list $p]
578 set varcid($v,$id) $a
579 lappend children($v,$p) $id
580 set cmitlisted($v,$id) 1
581 incr commitidx($v)
582 # note we deliberately don't update varcstart($v) even if $i == 0
583 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
584 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
585 modify_arc $v $a $i
587 if {[info exists targetid]} {
588 if {![comes_before $targetid $p]} {
589 incr targetrow
592 drawvisible
595 proc removerow {id v} {
596 global varcid varccommits parents children commitidx
597 global varctok vtokmod cmitlisted currentid selectedline
598 global targetid
600 if {[llength $parents($v,$id)] != 1} {
601 puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
602 return
604 set p [lindex $parents($v,$id) 0]
605 set a $varcid($v,$id)
606 set i [lsearch -exact $varccommits($v,$a) $id]
607 if {$i < 0} {
608 puts "oops: removerow can't find [shortids $id] on arc $a"
609 return
611 unset varcid($v,$id)
612 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
613 unset parents($v,$id)
614 unset children($v,$id)
615 unset cmitlisted($v,$id)
616 incr commitidx($v) -1
617 set j [lsearch -exact $children($v,$p) $id]
618 if {$j >= 0} {
619 set children($v,$p) [lreplace $children($v,$p) $j $j]
621 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
622 modify_arc $v $a $i
624 if {[info exist currentid] && $id eq $currentid} {
625 unset currentid
626 unset selectedline
628 if {[info exists targetid] && $targetid eq $id} {
629 set targetid $p
631 drawvisible
634 proc first_real_child {vp} {
635 global children nullid nullid2
637 foreach id $children($vp) {
638 if {$id ne $nullid && $id ne $nullid2} {
639 return $id
642 return {}
645 proc last_real_child {vp} {
646 global children nullid nullid2
648 set kids $children($vp)
649 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
650 set id [lindex $kids $i]
651 if {$id ne $nullid && $id ne $nullid2} {
652 return $id
655 return {}
658 proc vtokcmp {v a b} {
659 global varctok varcid
661 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
662 [lindex $varctok($v) $varcid($v,$b)]]
665 proc modify_arc {v a {lim {}}} {
666 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
668 set vtokmod($v) [lindex $varctok($v) $a]
669 set varcmod($v) $a
670 if {$v == $curview} {
671 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
672 set a [lindex $vupptr($v) $a]
673 set lim {}
675 set r 0
676 if {$a != 0} {
677 if {$lim eq {}} {
678 set lim [llength $varccommits($v,$a)]
680 set r [expr {[lindex $varcrow($v) $a] + $lim}]
682 set vrowmod($v) $r
683 undolayout $r
687 proc update_arcrows {v} {
688 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
689 global varcid vrownum varcorder varcix varccommits
690 global vupptr vdownptr vleftptr varctok
691 global displayorder parentlist curview cached_commitrow
693 set narctot [expr {[llength $varctok($v)] - 1}]
694 set a $varcmod($v)
695 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
696 # go up the tree until we find something that has a row number,
697 # or we get to a seed
698 set a [lindex $vupptr($v) $a]
700 if {$a == 0} {
701 set a [lindex $vdownptr($v) 0]
702 if {$a == 0} return
703 set vrownum($v) {0}
704 set varcorder($v) [list $a]
705 lset varcix($v) $a 0
706 lset varcrow($v) $a 0
707 set arcn 0
708 set row 0
709 } else {
710 set arcn [lindex $varcix($v) $a]
711 # see if a is the last arc; if so, nothing to do
712 if {$arcn == $narctot - 1} {
713 return
715 if {[llength $vrownum($v)] > $arcn + 1} {
716 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
717 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
719 set row [lindex $varcrow($v) $a]
721 if {$v == $curview} {
722 if {[llength $displayorder] > $vrowmod($v)} {
723 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
724 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
726 catch {unset cached_commitrow}
728 while {1} {
729 set p $a
730 incr row [llength $varccommits($v,$a)]
731 # go down if possible
732 set b [lindex $vdownptr($v) $a]
733 if {$b == 0} {
734 # if not, go left, or go up until we can go left
735 while {$a != 0} {
736 set b [lindex $vleftptr($v) $a]
737 if {$b != 0} break
738 set a [lindex $vupptr($v) $a]
740 if {$a == 0} break
742 set a $b
743 incr arcn
744 lappend vrownum($v) $row
745 lappend varcorder($v) $a
746 lset varcix($v) $a $arcn
747 lset varcrow($v) $a $row
749 set vtokmod($v) [lindex $varctok($v) $p]
750 set varcmod($v) $p
751 set vrowmod($v) $row
752 if {[info exists currentid]} {
753 set selectedline [rowofcommit $currentid]
757 # Test whether view $v contains commit $id
758 proc commitinview {id v} {
759 global varcid
761 return [info exists varcid($v,$id)]
764 # Return the row number for commit $id in the current view
765 proc rowofcommit {id} {
766 global varcid varccommits varcrow curview cached_commitrow
767 global varctok vtokmod
769 set v $curview
770 if {![info exists varcid($v,$id)]} {
771 puts "oops rowofcommit no arc for [shortids $id]"
772 return {}
774 set a $varcid($v,$id)
775 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
776 update_arcrows $v
778 if {[info exists cached_commitrow($id)]} {
779 return $cached_commitrow($id)
781 set i [lsearch -exact $varccommits($v,$a) $id]
782 if {$i < 0} {
783 puts "oops didn't find commit [shortids $id] in arc $a"
784 return {}
786 incr i [lindex $varcrow($v) $a]
787 set cached_commitrow($id) $i
788 return $i
791 # Returns 1 if a is on an earlier row than b, otherwise 0
792 proc comes_before {a b} {
793 global varcid varctok curview
795 set v $curview
796 if {$a eq $b || ![info exists varcid($v,$a)] || \
797 ![info exists varcid($v,$b)]} {
798 return 0
800 if {$varcid($v,$a) != $varcid($v,$b)} {
801 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
802 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
804 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
807 proc bsearch {l elt} {
808 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
809 return 0
811 set lo 0
812 set hi [llength $l]
813 while {$hi - $lo > 1} {
814 set mid [expr {int(($lo + $hi) / 2)}]
815 set t [lindex $l $mid]
816 if {$elt < $t} {
817 set hi $mid
818 } elseif {$elt > $t} {
819 set lo $mid
820 } else {
821 return $mid
824 return $lo
827 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
828 proc make_disporder {start end} {
829 global vrownum curview commitidx displayorder parentlist
830 global varccommits varcorder parents vrowmod varcrow
831 global d_valid_start d_valid_end
833 if {$end > $vrowmod($curview)} {
834 update_arcrows $curview
836 set ai [bsearch $vrownum($curview) $start]
837 set start [lindex $vrownum($curview) $ai]
838 set narc [llength $vrownum($curview)]
839 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
840 set a [lindex $varcorder($curview) $ai]
841 set l [llength $displayorder]
842 set al [llength $varccommits($curview,$a)]
843 if {$l < $r + $al} {
844 if {$l < $r} {
845 set pad [ntimes [expr {$r - $l}] {}]
846 set displayorder [concat $displayorder $pad]
847 set parentlist [concat $parentlist $pad]
848 } elseif {$l > $r} {
849 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
850 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
852 foreach id $varccommits($curview,$a) {
853 lappend displayorder $id
854 lappend parentlist $parents($curview,$id)
856 } elseif {[lindex $displayorder $r] eq {}} {
857 set i $r
858 foreach id $varccommits($curview,$a) {
859 lset displayorder $i $id
860 lset parentlist $i $parents($curview,$id)
861 incr i
864 incr r $al
868 proc commitonrow {row} {
869 global displayorder
871 set id [lindex $displayorder $row]
872 if {$id eq {}} {
873 make_disporder $row [expr {$row + 1}]
874 set id [lindex $displayorder $row]
876 return $id
879 proc closevarcs {v} {
880 global varctok varccommits varcid parents children
881 global cmitlisted commitidx commitinterest vtokmod
883 set missing_parents 0
884 set scripts {}
885 set narcs [llength $varctok($v)]
886 for {set a 1} {$a < $narcs} {incr a} {
887 set id [lindex $varccommits($v,$a) end]
888 foreach p $parents($v,$id) {
889 if {[info exists varcid($v,$p)]} continue
890 # add p as a new commit
891 incr missing_parents
892 set cmitlisted($v,$p) 0
893 set parents($v,$p) {}
894 if {[llength $children($v,$p)] == 1 &&
895 [llength $parents($v,$id)] == 1} {
896 set b $a
897 } else {
898 set b [newvarc $v $p]
900 set varcid($v,$p) $b
901 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
902 modify_arc $v $b
904 lappend varccommits($v,$b) $p
905 incr commitidx($v)
906 if {[info exists commitinterest($p)]} {
907 foreach script $commitinterest($p) {
908 lappend scripts [string map [list "%I" $p] $script]
910 unset commitinterest($id)
914 if {$missing_parents > 0} {
915 foreach s $scripts {
916 eval $s
921 proc getcommitlines {fd inst view} {
922 global cmitlisted commitinterest leftover
923 global commitidx commitdata datemode
924 global parents children curview hlview
925 global vnextroot idpending ordertok
926 global varccommits varcid varctok vtokmod
928 set stuff [read $fd 500000]
929 # git log doesn't terminate the last commit with a null...
930 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
931 set stuff "\0"
933 if {$stuff == {}} {
934 if {![eof $fd]} {
935 return 1
937 global commfd viewcomplete viewactive viewname progresscoords
938 global viewinstances
939 unset commfd($inst)
940 set i [lsearch -exact $viewinstances($view) $inst]
941 if {$i >= 0} {
942 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
944 # set it blocking so we wait for the process to terminate
945 fconfigure $fd -blocking 1
946 if {[catch {close $fd} err]} {
947 set fv {}
948 if {$view != $curview} {
949 set fv " for the \"$viewname($view)\" view"
951 if {[string range $err 0 4] == "usage"} {
952 set err "Gitk: error reading commits$fv:\
953 bad arguments to git rev-list."
954 if {$viewname($view) eq "Command line"} {
955 append err \
956 " (Note: arguments to gitk are passed to git rev-list\
957 to allow selection of commits to be displayed.)"
959 } else {
960 set err "Error reading commits$fv: $err"
962 error_popup $err
964 if {[incr viewactive($view) -1] <= 0} {
965 set viewcomplete($view) 1
966 # Check if we have seen any ids listed as parents that haven't
967 # appeared in the list
968 closevarcs $view
969 notbusy $view
970 set progresscoords {0 0}
971 adjustprogress
973 if {$view == $curview} {
974 run chewcommits $view
976 return 0
978 set start 0
979 set gotsome 0
980 set scripts {}
981 while 1 {
982 set i [string first "\0" $stuff $start]
983 if {$i < 0} {
984 append leftover($inst) [string range $stuff $start end]
985 break
987 if {$start == 0} {
988 set cmit $leftover($inst)
989 append cmit [string range $stuff 0 [expr {$i - 1}]]
990 set leftover($inst) {}
991 } else {
992 set cmit [string range $stuff $start [expr {$i - 1}]]
994 set start [expr {$i + 1}]
995 set j [string first "\n" $cmit]
996 set ok 0
997 set listed 1
998 if {$j >= 0 && [string match "commit *" $cmit]} {
999 set ids [string range $cmit 7 [expr {$j - 1}]]
1000 if {[string match {[-<>]*} $ids]} {
1001 switch -- [string index $ids 0] {
1002 "-" {set listed 0}
1003 "<" {set listed 2}
1004 ">" {set listed 3}
1006 set ids [string range $ids 1 end]
1008 set ok 1
1009 foreach id $ids {
1010 if {[string length $id] != 40} {
1011 set ok 0
1012 break
1016 if {!$ok} {
1017 set shortcmit $cmit
1018 if {[string length $shortcmit] > 80} {
1019 set shortcmit "[string range $shortcmit 0 80]..."
1021 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1022 exit 1
1024 set id [lindex $ids 0]
1025 set vid $view,$id
1026 if {!$listed && [info exists parents($vid)]} continue
1027 if {$listed} {
1028 set olds [lrange $ids 1 end]
1029 } else {
1030 set olds {}
1032 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1033 set cmitlisted($vid) $listed
1034 set parents($vid) $olds
1035 set a 0
1036 if {![info exists children($vid)]} {
1037 set children($vid) {}
1038 } elseif {[llength $children($vid)] == 1} {
1039 set k [lindex $children($vid) 0]
1040 if {[llength $parents($view,$k)] == 1 &&
1041 (!$datemode ||
1042 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1043 set a $varcid($view,$k)
1046 if {$a == 0} {
1047 # new arc
1048 set a [newvarc $view $id]
1050 set varcid($vid) $a
1051 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1052 modify_arc $view $a
1054 lappend varccommits($view,$a) $id
1056 set i 0
1057 foreach p $olds {
1058 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1059 set vp $view,$p
1060 if {[llength [lappend children($vp) $id]] > 1 &&
1061 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1062 set children($vp) [lsort -command [list vtokcmp $view] \
1063 $children($vp)]
1064 catch {unset ordertok}
1066 if {[info exists varcid($view,$p)]} {
1067 fix_reversal $p $a $view
1070 incr i
1073 incr commitidx($view)
1074 if {[info exists commitinterest($id)]} {
1075 foreach script $commitinterest($id) {
1076 lappend scripts [string map [list "%I" $id] $script]
1078 unset commitinterest($id)
1080 set gotsome 1
1082 if {$gotsome} {
1083 run chewcommits $view
1084 foreach s $scripts {
1085 eval $s
1087 if {$view == $curview} {
1088 # update progress bar
1089 global progressdirn progresscoords proglastnc
1090 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1091 set proglastnc $commitidx($view)
1092 set l [lindex $progresscoords 0]
1093 set r [lindex $progresscoords 1]
1094 if {$progressdirn} {
1095 set r [expr {$r + $inc}]
1096 if {$r >= 1.0} {
1097 set r 1.0
1098 set progressdirn 0
1100 if {$r > 0.2} {
1101 set l [expr {$r - 0.2}]
1103 } else {
1104 set l [expr {$l - $inc}]
1105 if {$l <= 0.0} {
1106 set l 0.0
1107 set progressdirn 1
1109 set r [expr {$l + 0.2}]
1111 set progresscoords [list $l $r]
1112 adjustprogress
1115 return 2
1118 proc chewcommits {view} {
1119 global curview hlview viewcomplete
1120 global pending_select
1122 if {$view == $curview} {
1123 layoutmore
1124 if {$viewcomplete($view)} {
1125 global commitidx varctok
1126 global numcommits startmsecs
1127 global mainheadid commitinfo nullid
1129 if {[info exists pending_select]} {
1130 set row [first_real_row]
1131 selectline $row 1
1133 if {$commitidx($curview) > 0} {
1134 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1135 #puts "overall $ms ms for $numcommits commits"
1136 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1137 } else {
1138 show_status [mc "No commits selected"]
1140 notbusy layout
1143 if {[info exists hlview] && $view == $hlview} {
1144 vhighlightmore
1146 return 0
1149 proc readcommit {id} {
1150 if {[catch {set contents [exec git cat-file commit $id]}]} return
1151 parsecommit $id $contents 0
1154 proc parsecommit {id contents listed} {
1155 global commitinfo cdate
1157 set inhdr 1
1158 set comment {}
1159 set headline {}
1160 set auname {}
1161 set audate {}
1162 set comname {}
1163 set comdate {}
1164 set hdrend [string first "\n\n" $contents]
1165 if {$hdrend < 0} {
1166 # should never happen...
1167 set hdrend [string length $contents]
1169 set header [string range $contents 0 [expr {$hdrend - 1}]]
1170 set comment [string range $contents [expr {$hdrend + 2}] end]
1171 foreach line [split $header "\n"] {
1172 set tag [lindex $line 0]
1173 if {$tag == "author"} {
1174 set audate [lindex $line end-1]
1175 set auname [lrange $line 1 end-2]
1176 } elseif {$tag == "committer"} {
1177 set comdate [lindex $line end-1]
1178 set comname [lrange $line 1 end-2]
1181 set headline {}
1182 # take the first non-blank line of the comment as the headline
1183 set headline [string trimleft $comment]
1184 set i [string first "\n" $headline]
1185 if {$i >= 0} {
1186 set headline [string range $headline 0 $i]
1188 set headline [string trimright $headline]
1189 set i [string first "\r" $headline]
1190 if {$i >= 0} {
1191 set headline [string trimright [string range $headline 0 $i]]
1193 if {!$listed} {
1194 # git rev-list indents the comment by 4 spaces;
1195 # if we got this via git cat-file, add the indentation
1196 set newcomment {}
1197 foreach line [split $comment "\n"] {
1198 append newcomment " "
1199 append newcomment $line
1200 append newcomment "\n"
1202 set comment $newcomment
1204 if {$comdate != {}} {
1205 set cdate($id) $comdate
1207 set commitinfo($id) [list $headline $auname $audate \
1208 $comname $comdate $comment]
1211 proc getcommit {id} {
1212 global commitdata commitinfo
1214 if {[info exists commitdata($id)]} {
1215 parsecommit $id $commitdata($id) 1
1216 } else {
1217 readcommit $id
1218 if {![info exists commitinfo($id)]} {
1219 set commitinfo($id) [list [mc "No commit information available"]]
1222 return 1
1225 proc readrefs {} {
1226 global tagids idtags headids idheads tagobjid
1227 global otherrefids idotherrefs mainhead mainheadid
1229 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1230 catch {unset $v}
1232 set refd [open [list | git show-ref -d] r]
1233 while {[gets $refd line] >= 0} {
1234 if {[string index $line 40] ne " "} continue
1235 set id [string range $line 0 39]
1236 set ref [string range $line 41 end]
1237 if {![string match "refs/*" $ref]} continue
1238 set name [string range $ref 5 end]
1239 if {[string match "remotes/*" $name]} {
1240 if {![string match "*/HEAD" $name]} {
1241 set headids($name) $id
1242 lappend idheads($id) $name
1244 } elseif {[string match "heads/*" $name]} {
1245 set name [string range $name 6 end]
1246 set headids($name) $id
1247 lappend idheads($id) $name
1248 } elseif {[string match "tags/*" $name]} {
1249 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1250 # which is what we want since the former is the commit ID
1251 set name [string range $name 5 end]
1252 if {[string match "*^{}" $name]} {
1253 set name [string range $name 0 end-3]
1254 } else {
1255 set tagobjid($name) $id
1257 set tagids($name) $id
1258 lappend idtags($id) $name
1259 } else {
1260 set otherrefids($name) $id
1261 lappend idotherrefs($id) $name
1264 catch {close $refd}
1265 set mainhead {}
1266 set mainheadid {}
1267 catch {
1268 set thehead [exec git symbolic-ref HEAD]
1269 if {[string match "refs/heads/*" $thehead]} {
1270 set mainhead [string range $thehead 11 end]
1271 if {[info exists headids($mainhead)]} {
1272 set mainheadid $headids($mainhead)
1278 # skip over fake commits
1279 proc first_real_row {} {
1280 global nullid nullid2 numcommits
1282 for {set row 0} {$row < $numcommits} {incr row} {
1283 set id [commitonrow $row]
1284 if {$id ne $nullid && $id ne $nullid2} {
1285 break
1288 return $row
1291 # update things for a head moved to a child of its previous location
1292 proc movehead {id name} {
1293 global headids idheads
1295 removehead $headids($name) $name
1296 set headids($name) $id
1297 lappend idheads($id) $name
1300 # update things when a head has been removed
1301 proc removehead {id name} {
1302 global headids idheads
1304 if {$idheads($id) eq $name} {
1305 unset idheads($id)
1306 } else {
1307 set i [lsearch -exact $idheads($id) $name]
1308 if {$i >= 0} {
1309 set idheads($id) [lreplace $idheads($id) $i $i]
1312 unset headids($name)
1315 proc show_error {w top msg} {
1316 message $w.m -text $msg -justify center -aspect 400
1317 pack $w.m -side top -fill x -padx 20 -pady 20
1318 button $w.ok -text [mc OK] -command "destroy $top"
1319 pack $w.ok -side bottom -fill x
1320 bind $top <Visibility> "grab $top; focus $top"
1321 bind $top <Key-Return> "destroy $top"
1322 tkwait window $top
1325 proc error_popup msg {
1326 set w .error
1327 toplevel $w
1328 wm transient $w .
1329 show_error $w $w $msg
1332 proc confirm_popup msg {
1333 global confirm_ok
1334 set confirm_ok 0
1335 set w .confirm
1336 toplevel $w
1337 wm transient $w .
1338 message $w.m -text $msg -justify center -aspect 400
1339 pack $w.m -side top -fill x -padx 20 -pady 20
1340 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1341 pack $w.ok -side left -fill x
1342 button $w.cancel -text [mc Cancel] -command "destroy $w"
1343 pack $w.cancel -side right -fill x
1344 bind $w <Visibility> "grab $w; focus $w"
1345 tkwait window $w
1346 return $confirm_ok
1349 proc setoptions {} {
1350 option add *Panedwindow.showHandle 1 startupFile
1351 option add *Panedwindow.sashRelief raised startupFile
1352 option add *Button.font uifont startupFile
1353 option add *Checkbutton.font uifont startupFile
1354 option add *Radiobutton.font uifont startupFile
1355 option add *Menu.font uifont startupFile
1356 option add *Menubutton.font uifont startupFile
1357 option add *Label.font uifont startupFile
1358 option add *Message.font uifont startupFile
1359 option add *Entry.font uifont startupFile
1362 proc makewindow {} {
1363 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1364 global tabstop
1365 global findtype findtypemenu findloc findstring fstring geometry
1366 global entries sha1entry sha1string sha1but
1367 global diffcontextstring diffcontext
1368 global maincursor textcursor curtextcursor
1369 global rowctxmenu fakerowmenu mergemax wrapcomment
1370 global highlight_files gdttype
1371 global searchstring sstring
1372 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1373 global headctxmenu progresscanv progressitem progresscoords statusw
1374 global fprogitem fprogcoord lastprogupdate progupdatepending
1375 global rprogitem rprogcoord
1376 global have_tk85
1378 menu .bar
1379 .bar add cascade -label [mc "File"] -menu .bar.file
1380 menu .bar.file
1381 .bar.file add command -label [mc "Update"] -command updatecommits
1382 .bar.file add command -label [mc "Reload"] -command reloadcommits
1383 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1384 .bar.file add command -label [mc "List references"] -command showrefs
1385 .bar.file add command -label [mc "Quit"] -command doquit
1386 menu .bar.edit
1387 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1388 .bar.edit add command -label [mc "Preferences"] -command doprefs
1390 menu .bar.view
1391 .bar add cascade -label [mc "View"] -menu .bar.view
1392 .bar.view add command -label [mc "New view..."] -command {newview 0}
1393 .bar.view add command -label [mc "Edit view..."] -command editview \
1394 -state disabled
1395 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
1396 .bar.view add separator
1397 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
1398 -variable selectedview -value 0
1400 menu .bar.help
1401 .bar add cascade -label [mc "Help"] -menu .bar.help
1402 .bar.help add command -label [mc "About gitk"] -command about
1403 .bar.help add command -label [mc "Key bindings"] -command keys
1404 .bar.help configure
1405 . configure -menu .bar
1407 # the gui has upper and lower half, parts of a paned window.
1408 panedwindow .ctop -orient vertical
1410 # possibly use assumed geometry
1411 if {![info exists geometry(pwsash0)]} {
1412 set geometry(topheight) [expr {15 * $linespc}]
1413 set geometry(topwidth) [expr {80 * $charspc}]
1414 set geometry(botheight) [expr {15 * $linespc}]
1415 set geometry(botwidth) [expr {50 * $charspc}]
1416 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1417 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1420 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1421 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1422 frame .tf.histframe
1423 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1425 # create three canvases
1426 set cscroll .tf.histframe.csb
1427 set canv .tf.histframe.pwclist.canv
1428 canvas $canv \
1429 -selectbackground $selectbgcolor \
1430 -background $bgcolor -bd 0 \
1431 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1432 .tf.histframe.pwclist add $canv
1433 set canv2 .tf.histframe.pwclist.canv2
1434 canvas $canv2 \
1435 -selectbackground $selectbgcolor \
1436 -background $bgcolor -bd 0 -yscrollincr $linespc
1437 .tf.histframe.pwclist add $canv2
1438 set canv3 .tf.histframe.pwclist.canv3
1439 canvas $canv3 \
1440 -selectbackground $selectbgcolor \
1441 -background $bgcolor -bd 0 -yscrollincr $linespc
1442 .tf.histframe.pwclist add $canv3
1443 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1444 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1446 # a scroll bar to rule them
1447 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1448 pack $cscroll -side right -fill y
1449 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1450 lappend bglist $canv $canv2 $canv3
1451 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1453 # we have two button bars at bottom of top frame. Bar 1
1454 frame .tf.bar
1455 frame .tf.lbar -height 15
1457 set sha1entry .tf.bar.sha1
1458 set entries $sha1entry
1459 set sha1but .tf.bar.sha1label
1460 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1461 -command gotocommit -width 8
1462 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1463 pack .tf.bar.sha1label -side left
1464 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1465 trace add variable sha1string write sha1change
1466 pack $sha1entry -side left -pady 2
1468 image create bitmap bm-left -data {
1469 #define left_width 16
1470 #define left_height 16
1471 static unsigned char left_bits[] = {
1472 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1473 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1474 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1476 image create bitmap bm-right -data {
1477 #define right_width 16
1478 #define right_height 16
1479 static unsigned char right_bits[] = {
1480 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1481 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1482 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1484 button .tf.bar.leftbut -image bm-left -command goback \
1485 -state disabled -width 26
1486 pack .tf.bar.leftbut -side left -fill y
1487 button .tf.bar.rightbut -image bm-right -command goforw \
1488 -state disabled -width 26
1489 pack .tf.bar.rightbut -side left -fill y
1491 # Status label and progress bar
1492 set statusw .tf.bar.status
1493 label $statusw -width 15 -relief sunken
1494 pack $statusw -side left -padx 5
1495 set h [expr {[font metrics uifont -linespace] + 2}]
1496 set progresscanv .tf.bar.progress
1497 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1498 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1499 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1500 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1501 pack $progresscanv -side right -expand 1 -fill x
1502 set progresscoords {0 0}
1503 set fprogcoord 0
1504 set rprogcoord 0
1505 bind $progresscanv <Configure> adjustprogress
1506 set lastprogupdate [clock clicks -milliseconds]
1507 set progupdatepending 0
1509 # build up the bottom bar of upper window
1510 label .tf.lbar.flabel -text "[mc "Find"] "
1511 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1512 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1513 label .tf.lbar.flab2 -text " [mc "commit"] "
1514 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1515 -side left -fill y
1516 set gdttype [mc "containing:"]
1517 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1518 [mc "containing:"] \
1519 [mc "touching paths:"] \
1520 [mc "adding/removing string:"]]
1521 trace add variable gdttype write gdttype_change
1522 pack .tf.lbar.gdttype -side left -fill y
1524 set findstring {}
1525 set fstring .tf.lbar.findstring
1526 lappend entries $fstring
1527 entry $fstring -width 30 -font textfont -textvariable findstring
1528 trace add variable findstring write find_change
1529 set findtype [mc "Exact"]
1530 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1531 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
1532 trace add variable findtype write findcom_change
1533 set findloc [mc "All fields"]
1534 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1535 [mc "Comments"] [mc "Author"] [mc "Committer"]
1536 trace add variable findloc write find_change
1537 pack .tf.lbar.findloc -side right
1538 pack .tf.lbar.findtype -side right
1539 pack $fstring -side left -expand 1 -fill x
1541 # Finish putting the upper half of the viewer together
1542 pack .tf.lbar -in .tf -side bottom -fill x
1543 pack .tf.bar -in .tf -side bottom -fill x
1544 pack .tf.histframe -fill both -side top -expand 1
1545 .ctop add .tf
1546 .ctop paneconfigure .tf -height $geometry(topheight)
1547 .ctop paneconfigure .tf -width $geometry(topwidth)
1549 # now build up the bottom
1550 panedwindow .pwbottom -orient horizontal
1552 # lower left, a text box over search bar, scroll bar to the right
1553 # if we know window height, then that will set the lower text height, otherwise
1554 # we set lower text height which will drive window height
1555 if {[info exists geometry(main)]} {
1556 frame .bleft -width $geometry(botwidth)
1557 } else {
1558 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1560 frame .bleft.top
1561 frame .bleft.mid
1563 button .bleft.top.search -text [mc "Search"] -command dosearch
1564 pack .bleft.top.search -side left -padx 5
1565 set sstring .bleft.top.sstring
1566 entry $sstring -width 20 -font textfont -textvariable searchstring
1567 lappend entries $sstring
1568 trace add variable searchstring write incrsearch
1569 pack $sstring -side left -expand 1 -fill x
1570 radiobutton .bleft.mid.diff -text [mc "Diff"] \
1571 -command changediffdisp -variable diffelide -value {0 0}
1572 radiobutton .bleft.mid.old -text [mc "Old version"] \
1573 -command changediffdisp -variable diffelide -value {0 1}
1574 radiobutton .bleft.mid.new -text [mc "New version"] \
1575 -command changediffdisp -variable diffelide -value {1 0}
1576 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
1577 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1578 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1579 -from 1 -increment 1 -to 10000000 \
1580 -validate all -validatecommand "diffcontextvalidate %P" \
1581 -textvariable diffcontextstring
1582 .bleft.mid.diffcontext set $diffcontext
1583 trace add variable diffcontextstring write diffcontextchange
1584 lappend entries .bleft.mid.diffcontext
1585 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1586 set ctext .bleft.ctext
1587 text $ctext -background $bgcolor -foreground $fgcolor \
1588 -state disabled -font textfont \
1589 -yscrollcommand scrolltext -wrap none
1590 if {$have_tk85} {
1591 $ctext conf -tabstyle wordprocessor
1593 scrollbar .bleft.sb -command "$ctext yview"
1594 pack .bleft.top -side top -fill x
1595 pack .bleft.mid -side top -fill x
1596 pack .bleft.sb -side right -fill y
1597 pack $ctext -side left -fill both -expand 1
1598 lappend bglist $ctext
1599 lappend fglist $ctext
1601 $ctext tag conf comment -wrap $wrapcomment
1602 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
1603 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1604 $ctext tag conf d0 -fore [lindex $diffcolors 0]
1605 $ctext tag conf d1 -fore [lindex $diffcolors 1]
1606 $ctext tag conf m0 -fore red
1607 $ctext tag conf m1 -fore blue
1608 $ctext tag conf m2 -fore green
1609 $ctext tag conf m3 -fore purple
1610 $ctext tag conf m4 -fore brown
1611 $ctext tag conf m5 -fore "#009090"
1612 $ctext tag conf m6 -fore magenta
1613 $ctext tag conf m7 -fore "#808000"
1614 $ctext tag conf m8 -fore "#009000"
1615 $ctext tag conf m9 -fore "#ff0080"
1616 $ctext tag conf m10 -fore cyan
1617 $ctext tag conf m11 -fore "#b07070"
1618 $ctext tag conf m12 -fore "#70b0f0"
1619 $ctext tag conf m13 -fore "#70f0b0"
1620 $ctext tag conf m14 -fore "#f0b070"
1621 $ctext tag conf m15 -fore "#ff70b0"
1622 $ctext tag conf mmax -fore darkgrey
1623 set mergemax 16
1624 $ctext tag conf mresult -font textfontbold
1625 $ctext tag conf msep -font textfontbold
1626 $ctext tag conf found -back yellow
1628 .pwbottom add .bleft
1629 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
1631 # lower right
1632 frame .bright
1633 frame .bright.mode
1634 radiobutton .bright.mode.patch -text [mc "Patch"] \
1635 -command reselectline -variable cmitmode -value "patch"
1636 radiobutton .bright.mode.tree -text [mc "Tree"] \
1637 -command reselectline -variable cmitmode -value "tree"
1638 grid .bright.mode.patch .bright.mode.tree -sticky ew
1639 pack .bright.mode -side top -fill x
1640 set cflist .bright.cfiles
1641 set indent [font measure mainfont "nn"]
1642 text $cflist \
1643 -selectbackground $selectbgcolor \
1644 -background $bgcolor -foreground $fgcolor \
1645 -font mainfont \
1646 -tabs [list $indent [expr {2 * $indent}]] \
1647 -yscrollcommand ".bright.sb set" \
1648 -cursor [. cget -cursor] \
1649 -spacing1 1 -spacing3 1
1650 lappend bglist $cflist
1651 lappend fglist $cflist
1652 scrollbar .bright.sb -command "$cflist yview"
1653 pack .bright.sb -side right -fill y
1654 pack $cflist -side left -fill both -expand 1
1655 $cflist tag configure highlight \
1656 -background [$cflist cget -selectbackground]
1657 $cflist tag configure bold -font mainfontbold
1659 .pwbottom add .bright
1660 .ctop add .pwbottom
1662 # restore window position if known
1663 if {[info exists geometry(main)]} {
1664 wm geometry . "$geometry(main)"
1667 if {[tk windowingsystem] eq {aqua}} {
1668 set M1B M1
1669 } else {
1670 set M1B Control
1673 bind .pwbottom <Configure> {resizecdetpanes %W %w}
1674 pack .ctop -fill both -expand 1
1675 bindall <1> {selcanvline %W %x %y}
1676 #bindall <B1-Motion> {selcanvline %W %x %y}
1677 if {[tk windowingsystem] == "win32"} {
1678 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1679 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1680 } else {
1681 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1682 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
1683 if {[tk windowingsystem] eq "aqua"} {
1684 bindall <MouseWheel> {
1685 set delta [expr {- (%D)}]
1686 allcanvs yview scroll $delta units
1690 bindall <2> "canvscan mark %W %x %y"
1691 bindall <B2-Motion> "canvscan dragto %W %x %y"
1692 bindkey <Home> selfirstline
1693 bindkey <End> sellastline
1694 bind . <Key-Up> "selnextline -1"
1695 bind . <Key-Down> "selnextline 1"
1696 bind . <Shift-Key-Up> "dofind -1 0"
1697 bind . <Shift-Key-Down> "dofind 1 0"
1698 bindkey <Key-Right> "goforw"
1699 bindkey <Key-Left> "goback"
1700 bind . <Key-Prior> "selnextpage -1"
1701 bind . <Key-Next> "selnextpage 1"
1702 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1703 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1704 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1705 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1706 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1707 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1708 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1709 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1710 bindkey <Key-space> "$ctext yview scroll 1 pages"
1711 bindkey p "selnextline -1"
1712 bindkey n "selnextline 1"
1713 bindkey z "goback"
1714 bindkey x "goforw"
1715 bindkey i "selnextline -1"
1716 bindkey k "selnextline 1"
1717 bindkey j "goback"
1718 bindkey l "goforw"
1719 bindkey b "$ctext yview scroll -1 pages"
1720 bindkey d "$ctext yview scroll 18 units"
1721 bindkey u "$ctext yview scroll -18 units"
1722 bindkey / {dofind 1 1}
1723 bindkey <Key-Return> {dofind 1 1}
1724 bindkey ? {dofind -1 1}
1725 bindkey f nextfile
1726 bindkey <F5> updatecommits
1727 bind . <$M1B-q> doquit
1728 bind . <$M1B-f> {dofind 1 1}
1729 bind . <$M1B-g> {dofind 1 0}
1730 bind . <$M1B-r> dosearchback
1731 bind . <$M1B-s> dosearch
1732 bind . <$M1B-equal> {incrfont 1}
1733 bind . <$M1B-KP_Add> {incrfont 1}
1734 bind . <$M1B-minus> {incrfont -1}
1735 bind . <$M1B-KP_Subtract> {incrfont -1}
1736 wm protocol . WM_DELETE_WINDOW doquit
1737 bind . <Button-1> "click %W"
1738 bind $fstring <Key-Return> {dofind 1 1}
1739 bind $sha1entry <Key-Return> gotocommit
1740 bind $sha1entry <<PasteSelection>> clearsha1
1741 bind $cflist <1> {sel_flist %W %x %y; break}
1742 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1743 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1744 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1746 set maincursor [. cget -cursor]
1747 set textcursor [$ctext cget -cursor]
1748 set curtextcursor $textcursor
1750 set rowctxmenu .rowctxmenu
1751 menu $rowctxmenu -tearoff 0
1752 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1753 -command {diffvssel 0}
1754 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1755 -command {diffvssel 1}
1756 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1757 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1758 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1759 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1760 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1761 -command cherrypick
1762 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1763 -command resethead
1765 set fakerowmenu .fakerowmenu
1766 menu $fakerowmenu -tearoff 0
1767 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1768 -command {diffvssel 0}
1769 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1770 -command {diffvssel 1}
1771 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1772 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1773 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1774 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1776 set headctxmenu .headctxmenu
1777 menu $headctxmenu -tearoff 0
1778 $headctxmenu add command -label [mc "Check out this branch"] \
1779 -command cobranch
1780 $headctxmenu add command -label [mc "Remove this branch"] \
1781 -command rmbranch
1783 global flist_menu
1784 set flist_menu .flistctxmenu
1785 menu $flist_menu -tearoff 0
1786 $flist_menu add command -label [mc "Highlight this too"] \
1787 -command {flist_hl 0}
1788 $flist_menu add command -label [mc "Highlight this only"] \
1789 -command {flist_hl 1}
1792 # Windows sends all mouse wheel events to the current focused window, not
1793 # the one where the mouse hovers, so bind those events here and redirect
1794 # to the correct window
1795 proc windows_mousewheel_redirector {W X Y D} {
1796 global canv canv2 canv3
1797 set w [winfo containing -displayof $W $X $Y]
1798 if {$w ne ""} {
1799 set u [expr {$D < 0 ? 5 : -5}]
1800 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1801 allcanvs yview scroll $u units
1802 } else {
1803 catch {
1804 $w yview scroll $u units
1810 # mouse-2 makes all windows scan vertically, but only the one
1811 # the cursor is in scans horizontally
1812 proc canvscan {op w x y} {
1813 global canv canv2 canv3
1814 foreach c [list $canv $canv2 $canv3] {
1815 if {$c == $w} {
1816 $c scan $op $x $y
1817 } else {
1818 $c scan $op 0 $y
1823 proc scrollcanv {cscroll f0 f1} {
1824 $cscroll set $f0 $f1
1825 drawvisible
1826 flushhighlights
1829 # when we make a key binding for the toplevel, make sure
1830 # it doesn't get triggered when that key is pressed in the
1831 # find string entry widget.
1832 proc bindkey {ev script} {
1833 global entries
1834 bind . $ev $script
1835 set escript [bind Entry $ev]
1836 if {$escript == {}} {
1837 set escript [bind Entry <Key>]
1839 foreach e $entries {
1840 bind $e $ev "$escript; break"
1844 # set the focus back to the toplevel for any click outside
1845 # the entry widgets
1846 proc click {w} {
1847 global ctext entries
1848 foreach e [concat $entries $ctext] {
1849 if {$w == $e} return
1851 focus .
1854 # Adjust the progress bar for a change in requested extent or canvas size
1855 proc adjustprogress {} {
1856 global progresscanv progressitem progresscoords
1857 global fprogitem fprogcoord lastprogupdate progupdatepending
1858 global rprogitem rprogcoord
1860 set w [expr {[winfo width $progresscanv] - 4}]
1861 set x0 [expr {$w * [lindex $progresscoords 0]}]
1862 set x1 [expr {$w * [lindex $progresscoords 1]}]
1863 set h [winfo height $progresscanv]
1864 $progresscanv coords $progressitem $x0 0 $x1 $h
1865 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1866 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1867 set now [clock clicks -milliseconds]
1868 if {$now >= $lastprogupdate + 100} {
1869 set progupdatepending 0
1870 update
1871 } elseif {!$progupdatepending} {
1872 set progupdatepending 1
1873 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1877 proc doprogupdate {} {
1878 global lastprogupdate progupdatepending
1880 if {$progupdatepending} {
1881 set progupdatepending 0
1882 set lastprogupdate [clock clicks -milliseconds]
1883 update
1887 proc savestuff {w} {
1888 global canv canv2 canv3 mainfont textfont uifont tabstop
1889 global stuffsaved findmergefiles maxgraphpct
1890 global maxwidth showneartags showlocalchanges
1891 global viewname viewfiles viewargs viewperm nextviewnum
1892 global cmitmode wrapcomment datetimeformat limitdiffs
1893 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1895 if {$stuffsaved} return
1896 if {![winfo viewable .]} return
1897 catch {
1898 set f [open "~/.gitk-new" w]
1899 puts $f [list set mainfont $mainfont]
1900 puts $f [list set textfont $textfont]
1901 puts $f [list set uifont $uifont]
1902 puts $f [list set tabstop $tabstop]
1903 puts $f [list set findmergefiles $findmergefiles]
1904 puts $f [list set maxgraphpct $maxgraphpct]
1905 puts $f [list set maxwidth $maxwidth]
1906 puts $f [list set cmitmode $cmitmode]
1907 puts $f [list set wrapcomment $wrapcomment]
1908 puts $f [list set showneartags $showneartags]
1909 puts $f [list set showlocalchanges $showlocalchanges]
1910 puts $f [list set datetimeformat $datetimeformat]
1911 puts $f [list set limitdiffs $limitdiffs]
1912 puts $f [list set bgcolor $bgcolor]
1913 puts $f [list set fgcolor $fgcolor]
1914 puts $f [list set colors $colors]
1915 puts $f [list set diffcolors $diffcolors]
1916 puts $f [list set diffcontext $diffcontext]
1917 puts $f [list set selectbgcolor $selectbgcolor]
1919 puts $f "set geometry(main) [wm geometry .]"
1920 puts $f "set geometry(topwidth) [winfo width .tf]"
1921 puts $f "set geometry(topheight) [winfo height .tf]"
1922 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1923 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1924 puts $f "set geometry(botwidth) [winfo width .bleft]"
1925 puts $f "set geometry(botheight) [winfo height .bleft]"
1927 puts -nonewline $f "set permviews {"
1928 for {set v 0} {$v < $nextviewnum} {incr v} {
1929 if {$viewperm($v)} {
1930 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1933 puts $f "}"
1934 close $f
1935 file rename -force "~/.gitk-new" "~/.gitk"
1937 set stuffsaved 1
1940 proc resizeclistpanes {win w} {
1941 global oldwidth
1942 if {[info exists oldwidth($win)]} {
1943 set s0 [$win sash coord 0]
1944 set s1 [$win sash coord 1]
1945 if {$w < 60} {
1946 set sash0 [expr {int($w/2 - 2)}]
1947 set sash1 [expr {int($w*5/6 - 2)}]
1948 } else {
1949 set factor [expr {1.0 * $w / $oldwidth($win)}]
1950 set sash0 [expr {int($factor * [lindex $s0 0])}]
1951 set sash1 [expr {int($factor * [lindex $s1 0])}]
1952 if {$sash0 < 30} {
1953 set sash0 30
1955 if {$sash1 < $sash0 + 20} {
1956 set sash1 [expr {$sash0 + 20}]
1958 if {$sash1 > $w - 10} {
1959 set sash1 [expr {$w - 10}]
1960 if {$sash0 > $sash1 - 20} {
1961 set sash0 [expr {$sash1 - 20}]
1965 $win sash place 0 $sash0 [lindex $s0 1]
1966 $win sash place 1 $sash1 [lindex $s1 1]
1968 set oldwidth($win) $w
1971 proc resizecdetpanes {win w} {
1972 global oldwidth
1973 if {[info exists oldwidth($win)]} {
1974 set s0 [$win sash coord 0]
1975 if {$w < 60} {
1976 set sash0 [expr {int($w*3/4 - 2)}]
1977 } else {
1978 set factor [expr {1.0 * $w / $oldwidth($win)}]
1979 set sash0 [expr {int($factor * [lindex $s0 0])}]
1980 if {$sash0 < 45} {
1981 set sash0 45
1983 if {$sash0 > $w - 15} {
1984 set sash0 [expr {$w - 15}]
1987 $win sash place 0 $sash0 [lindex $s0 1]
1989 set oldwidth($win) $w
1992 proc allcanvs args {
1993 global canv canv2 canv3
1994 eval $canv $args
1995 eval $canv2 $args
1996 eval $canv3 $args
1999 proc bindall {event action} {
2000 global canv canv2 canv3
2001 bind $canv $event $action
2002 bind $canv2 $event $action
2003 bind $canv3 $event $action
2006 proc about {} {
2007 global uifont
2008 set w .about
2009 if {[winfo exists $w]} {
2010 raise $w
2011 return
2013 toplevel $w
2014 wm title $w [mc "About gitk"]
2015 message $w.m -text [mc "
2016 Gitk - a commit viewer for git
2018 Copyright © 2005-2006 Paul Mackerras
2020 Use and redistribute under the terms of the GNU General Public License"] \
2021 -justify center -aspect 400 -border 2 -bg white -relief groove
2022 pack $w.m -side top -fill x -padx 2 -pady 2
2023 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2024 pack $w.ok -side bottom
2025 bind $w <Visibility> "focus $w.ok"
2026 bind $w <Key-Escape> "destroy $w"
2027 bind $w <Key-Return> "destroy $w"
2030 proc keys {} {
2031 set w .keys
2032 if {[winfo exists $w]} {
2033 raise $w
2034 return
2036 if {[tk windowingsystem] eq {aqua}} {
2037 set M1T Cmd
2038 } else {
2039 set M1T Ctrl
2041 toplevel $w
2042 wm title $w [mc "Gitk key bindings"]
2043 message $w.m -text [mc "
2044 Gitk key bindings:
2046 <$M1T-Q> Quit
2047 <Home> Move to first commit
2048 <End> Move to last commit
2049 <Up>, p, i Move up one commit
2050 <Down>, n, k Move down one commit
2051 <Left>, z, j Go back in history list
2052 <Right>, x, l Go forward in history list
2053 <PageUp> Move up one page in commit list
2054 <PageDown> Move down one page in commit list
2055 <$M1T-Home> Scroll to top of commit list
2056 <$M1T-End> Scroll to bottom of commit list
2057 <$M1T-Up> Scroll commit list up one line
2058 <$M1T-Down> Scroll commit list down one line
2059 <$M1T-PageUp> Scroll commit list up one page
2060 <$M1T-PageDown> Scroll commit list down one page
2061 <Shift-Up> Find backwards (upwards, later commits)
2062 <Shift-Down> Find forwards (downwards, earlier commits)
2063 <Delete>, b Scroll diff view up one page
2064 <Backspace> Scroll diff view up one page
2065 <Space> Scroll diff view down one page
2066 u Scroll diff view up 18 lines
2067 d Scroll diff view down 18 lines
2068 <$M1T-F> Find
2069 <$M1T-G> Move to next find hit
2070 <Return> Move to next find hit
2071 / Move to next find hit, or redo find
2072 ? Move to previous find hit
2073 f Scroll diff view to next file
2074 <$M1T-S> Search for next hit in diff view
2075 <$M1T-R> Search for previous hit in diff view
2076 <$M1T-KP+> Increase font size
2077 <$M1T-plus> Increase font size
2078 <$M1T-KP-> Decrease font size
2079 <$M1T-minus> Decrease font size
2080 <F5> Update
2081 "] \
2082 -justify left -bg white -border 2 -relief groove
2083 pack $w.m -side top -fill both -padx 2 -pady 2
2084 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2085 pack $w.ok -side bottom
2086 bind $w <Visibility> "focus $w.ok"
2087 bind $w <Key-Escape> "destroy $w"
2088 bind $w <Key-Return> "destroy $w"
2091 # Procedures for manipulating the file list window at the
2092 # bottom right of the overall window.
2094 proc treeview {w l openlevs} {
2095 global treecontents treediropen treeheight treeparent treeindex
2097 set ix 0
2098 set treeindex() 0
2099 set lev 0
2100 set prefix {}
2101 set prefixend -1
2102 set prefendstack {}
2103 set htstack {}
2104 set ht 0
2105 set treecontents() {}
2106 $w conf -state normal
2107 foreach f $l {
2108 while {[string range $f 0 $prefixend] ne $prefix} {
2109 if {$lev <= $openlevs} {
2110 $w mark set e:$treeindex($prefix) "end -1c"
2111 $w mark gravity e:$treeindex($prefix) left
2113 set treeheight($prefix) $ht
2114 incr ht [lindex $htstack end]
2115 set htstack [lreplace $htstack end end]
2116 set prefixend [lindex $prefendstack end]
2117 set prefendstack [lreplace $prefendstack end end]
2118 set prefix [string range $prefix 0 $prefixend]
2119 incr lev -1
2121 set tail [string range $f [expr {$prefixend+1}] end]
2122 while {[set slash [string first "/" $tail]] >= 0} {
2123 lappend htstack $ht
2124 set ht 0
2125 lappend prefendstack $prefixend
2126 incr prefixend [expr {$slash + 1}]
2127 set d [string range $tail 0 $slash]
2128 lappend treecontents($prefix) $d
2129 set oldprefix $prefix
2130 append prefix $d
2131 set treecontents($prefix) {}
2132 set treeindex($prefix) [incr ix]
2133 set treeparent($prefix) $oldprefix
2134 set tail [string range $tail [expr {$slash+1}] end]
2135 if {$lev <= $openlevs} {
2136 set ht 1
2137 set treediropen($prefix) [expr {$lev < $openlevs}]
2138 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2139 $w mark set d:$ix "end -1c"
2140 $w mark gravity d:$ix left
2141 set str "\n"
2142 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2143 $w insert end $str
2144 $w image create end -align center -image $bm -padx 1 \
2145 -name a:$ix
2146 $w insert end $d [highlight_tag $prefix]
2147 $w mark set s:$ix "end -1c"
2148 $w mark gravity s:$ix left
2150 incr lev
2152 if {$tail ne {}} {
2153 if {$lev <= $openlevs} {
2154 incr ht
2155 set str "\n"
2156 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2157 $w insert end $str
2158 $w insert end $tail [highlight_tag $f]
2160 lappend treecontents($prefix) $tail
2163 while {$htstack ne {}} {
2164 set treeheight($prefix) $ht
2165 incr ht [lindex $htstack end]
2166 set htstack [lreplace $htstack end end]
2167 set prefixend [lindex $prefendstack end]
2168 set prefendstack [lreplace $prefendstack end end]
2169 set prefix [string range $prefix 0 $prefixend]
2171 $w conf -state disabled
2174 proc linetoelt {l} {
2175 global treeheight treecontents
2177 set y 2
2178 set prefix {}
2179 while {1} {
2180 foreach e $treecontents($prefix) {
2181 if {$y == $l} {
2182 return "$prefix$e"
2184 set n 1
2185 if {[string index $e end] eq "/"} {
2186 set n $treeheight($prefix$e)
2187 if {$y + $n > $l} {
2188 append prefix $e
2189 incr y
2190 break
2193 incr y $n
2198 proc highlight_tree {y prefix} {
2199 global treeheight treecontents cflist
2201 foreach e $treecontents($prefix) {
2202 set path $prefix$e
2203 if {[highlight_tag $path] ne {}} {
2204 $cflist tag add bold $y.0 "$y.0 lineend"
2206 incr y
2207 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2208 set y [highlight_tree $y $path]
2211 return $y
2214 proc treeclosedir {w dir} {
2215 global treediropen treeheight treeparent treeindex
2217 set ix $treeindex($dir)
2218 $w conf -state normal
2219 $w delete s:$ix e:$ix
2220 set treediropen($dir) 0
2221 $w image configure a:$ix -image tri-rt
2222 $w conf -state disabled
2223 set n [expr {1 - $treeheight($dir)}]
2224 while {$dir ne {}} {
2225 incr treeheight($dir) $n
2226 set dir $treeparent($dir)
2230 proc treeopendir {w dir} {
2231 global treediropen treeheight treeparent treecontents treeindex
2233 set ix $treeindex($dir)
2234 $w conf -state normal
2235 $w image configure a:$ix -image tri-dn
2236 $w mark set e:$ix s:$ix
2237 $w mark gravity e:$ix right
2238 set lev 0
2239 set str "\n"
2240 set n [llength $treecontents($dir)]
2241 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2242 incr lev
2243 append str "\t"
2244 incr treeheight($x) $n
2246 foreach e $treecontents($dir) {
2247 set de $dir$e
2248 if {[string index $e end] eq "/"} {
2249 set iy $treeindex($de)
2250 $w mark set d:$iy e:$ix
2251 $w mark gravity d:$iy left
2252 $w insert e:$ix $str
2253 set treediropen($de) 0
2254 $w image create e:$ix -align center -image tri-rt -padx 1 \
2255 -name a:$iy
2256 $w insert e:$ix $e [highlight_tag $de]
2257 $w mark set s:$iy e:$ix
2258 $w mark gravity s:$iy left
2259 set treeheight($de) 1
2260 } else {
2261 $w insert e:$ix $str
2262 $w insert e:$ix $e [highlight_tag $de]
2265 $w mark gravity e:$ix left
2266 $w conf -state disabled
2267 set treediropen($dir) 1
2268 set top [lindex [split [$w index @0,0] .] 0]
2269 set ht [$w cget -height]
2270 set l [lindex [split [$w index s:$ix] .] 0]
2271 if {$l < $top} {
2272 $w yview $l.0
2273 } elseif {$l + $n + 1 > $top + $ht} {
2274 set top [expr {$l + $n + 2 - $ht}]
2275 if {$l < $top} {
2276 set top $l
2278 $w yview $top.0
2282 proc treeclick {w x y} {
2283 global treediropen cmitmode ctext cflist cflist_top
2285 if {$cmitmode ne "tree"} return
2286 if {![info exists cflist_top]} return
2287 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2288 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2289 $cflist tag add highlight $l.0 "$l.0 lineend"
2290 set cflist_top $l
2291 if {$l == 1} {
2292 $ctext yview 1.0
2293 return
2295 set e [linetoelt $l]
2296 if {[string index $e end] ne "/"} {
2297 showfile $e
2298 } elseif {$treediropen($e)} {
2299 treeclosedir $w $e
2300 } else {
2301 treeopendir $w $e
2305 proc setfilelist {id} {
2306 global treefilelist cflist
2308 treeview $cflist $treefilelist($id) 0
2311 image create bitmap tri-rt -background black -foreground blue -data {
2312 #define tri-rt_width 13
2313 #define tri-rt_height 13
2314 static unsigned char tri-rt_bits[] = {
2315 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2316 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2317 0x00, 0x00};
2318 } -maskdata {
2319 #define tri-rt-mask_width 13
2320 #define tri-rt-mask_height 13
2321 static unsigned char tri-rt-mask_bits[] = {
2322 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2323 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2324 0x08, 0x00};
2326 image create bitmap tri-dn -background black -foreground blue -data {
2327 #define tri-dn_width 13
2328 #define tri-dn_height 13
2329 static unsigned char tri-dn_bits[] = {
2330 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2331 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2332 0x00, 0x00};
2333 } -maskdata {
2334 #define tri-dn-mask_width 13
2335 #define tri-dn-mask_height 13
2336 static unsigned char tri-dn-mask_bits[] = {
2337 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2338 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2339 0x00, 0x00};
2342 image create bitmap reficon-T -background black -foreground yellow -data {
2343 #define tagicon_width 13
2344 #define tagicon_height 9
2345 static unsigned char tagicon_bits[] = {
2346 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2347 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2348 } -maskdata {
2349 #define tagicon-mask_width 13
2350 #define tagicon-mask_height 9
2351 static unsigned char tagicon-mask_bits[] = {
2352 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2353 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2355 set rectdata {
2356 #define headicon_width 13
2357 #define headicon_height 9
2358 static unsigned char headicon_bits[] = {
2359 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2360 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2362 set rectmask {
2363 #define headicon-mask_width 13
2364 #define headicon-mask_height 9
2365 static unsigned char headicon-mask_bits[] = {
2366 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2367 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2369 image create bitmap reficon-H -background black -foreground green \
2370 -data $rectdata -maskdata $rectmask
2371 image create bitmap reficon-o -background black -foreground "#ddddff" \
2372 -data $rectdata -maskdata $rectmask
2374 proc init_flist {first} {
2375 global cflist cflist_top difffilestart
2377 $cflist conf -state normal
2378 $cflist delete 0.0 end
2379 if {$first ne {}} {
2380 $cflist insert end $first
2381 set cflist_top 1
2382 $cflist tag add highlight 1.0 "1.0 lineend"
2383 } else {
2384 catch {unset cflist_top}
2386 $cflist conf -state disabled
2387 set difffilestart {}
2390 proc highlight_tag {f} {
2391 global highlight_paths
2393 foreach p $highlight_paths {
2394 if {[string match $p $f]} {
2395 return "bold"
2398 return {}
2401 proc highlight_filelist {} {
2402 global cmitmode cflist
2404 $cflist conf -state normal
2405 if {$cmitmode ne "tree"} {
2406 set end [lindex [split [$cflist index end] .] 0]
2407 for {set l 2} {$l < $end} {incr l} {
2408 set line [$cflist get $l.0 "$l.0 lineend"]
2409 if {[highlight_tag $line] ne {}} {
2410 $cflist tag add bold $l.0 "$l.0 lineend"
2413 } else {
2414 highlight_tree 2 {}
2416 $cflist conf -state disabled
2419 proc unhighlight_filelist {} {
2420 global cflist
2422 $cflist conf -state normal
2423 $cflist tag remove bold 1.0 end
2424 $cflist conf -state disabled
2427 proc add_flist {fl} {
2428 global cflist
2430 $cflist conf -state normal
2431 foreach f $fl {
2432 $cflist insert end "\n"
2433 $cflist insert end $f [highlight_tag $f]
2435 $cflist conf -state disabled
2438 proc sel_flist {w x y} {
2439 global ctext difffilestart cflist cflist_top cmitmode
2441 if {$cmitmode eq "tree"} return
2442 if {![info exists cflist_top]} return
2443 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2444 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2445 $cflist tag add highlight $l.0 "$l.0 lineend"
2446 set cflist_top $l
2447 if {$l == 1} {
2448 $ctext yview 1.0
2449 } else {
2450 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2454 proc pop_flist_menu {w X Y x y} {
2455 global ctext cflist cmitmode flist_menu flist_menu_file
2456 global treediffs diffids
2458 stopfinding
2459 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2460 if {$l <= 1} return
2461 if {$cmitmode eq "tree"} {
2462 set e [linetoelt $l]
2463 if {[string index $e end] eq "/"} return
2464 } else {
2465 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2467 set flist_menu_file $e
2468 tk_popup $flist_menu $X $Y
2471 proc flist_hl {only} {
2472 global flist_menu_file findstring gdttype
2474 set x [shellquote $flist_menu_file]
2475 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2476 set findstring $x
2477 } else {
2478 append findstring " " $x
2480 set gdttype [mc "touching paths:"]
2483 # Functions for adding and removing shell-type quoting
2485 proc shellquote {str} {
2486 if {![string match "*\['\"\\ \t]*" $str]} {
2487 return $str
2489 if {![string match "*\['\"\\]*" $str]} {
2490 return "\"$str\""
2492 if {![string match "*'*" $str]} {
2493 return "'$str'"
2495 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2498 proc shellarglist {l} {
2499 set str {}
2500 foreach a $l {
2501 if {$str ne {}} {
2502 append str " "
2504 append str [shellquote $a]
2506 return $str
2509 proc shelldequote {str} {
2510 set ret {}
2511 set used -1
2512 while {1} {
2513 incr used
2514 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2515 append ret [string range $str $used end]
2516 set used [string length $str]
2517 break
2519 set first [lindex $first 0]
2520 set ch [string index $str $first]
2521 if {$first > $used} {
2522 append ret [string range $str $used [expr {$first - 1}]]
2523 set used $first
2525 if {$ch eq " " || $ch eq "\t"} break
2526 incr used
2527 if {$ch eq "'"} {
2528 set first [string first "'" $str $used]
2529 if {$first < 0} {
2530 error "unmatched single-quote"
2532 append ret [string range $str $used [expr {$first - 1}]]
2533 set used $first
2534 continue
2536 if {$ch eq "\\"} {
2537 if {$used >= [string length $str]} {
2538 error "trailing backslash"
2540 append ret [string index $str $used]
2541 continue
2543 # here ch == "\""
2544 while {1} {
2545 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2546 error "unmatched double-quote"
2548 set first [lindex $first 0]
2549 set ch [string index $str $first]
2550 if {$first > $used} {
2551 append ret [string range $str $used [expr {$first - 1}]]
2552 set used $first
2554 if {$ch eq "\""} break
2555 incr used
2556 append ret [string index $str $used]
2557 incr used
2560 return [list $used $ret]
2563 proc shellsplit {str} {
2564 set l {}
2565 while {1} {
2566 set str [string trimleft $str]
2567 if {$str eq {}} break
2568 set dq [shelldequote $str]
2569 set n [lindex $dq 0]
2570 set word [lindex $dq 1]
2571 set str [string range $str $n end]
2572 lappend l $word
2574 return $l
2577 # Code to implement multiple views
2579 proc newview {ishighlight} {
2580 global nextviewnum newviewname newviewperm newishighlight
2581 global newviewargs revtreeargs
2583 set newishighlight $ishighlight
2584 set top .gitkview
2585 if {[winfo exists $top]} {
2586 raise $top
2587 return
2589 set newviewname($nextviewnum) "View $nextviewnum"
2590 set newviewperm($nextviewnum) 0
2591 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2592 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2595 proc editview {} {
2596 global curview
2597 global viewname viewperm newviewname newviewperm
2598 global viewargs newviewargs
2600 set top .gitkvedit-$curview
2601 if {[winfo exists $top]} {
2602 raise $top
2603 return
2605 set newviewname($curview) $viewname($curview)
2606 set newviewperm($curview) $viewperm($curview)
2607 set newviewargs($curview) [shellarglist $viewargs($curview)]
2608 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2611 proc vieweditor {top n title} {
2612 global newviewname newviewperm viewfiles bgcolor
2614 toplevel $top
2615 wm title $top $title
2616 label $top.nl -text [mc "Name"]
2617 entry $top.name -width 20 -textvariable newviewname($n)
2618 grid $top.nl $top.name -sticky w -pady 5
2619 checkbutton $top.perm -text [mc "Remember this view"] \
2620 -variable newviewperm($n)
2621 grid $top.perm - -pady 5 -sticky w
2622 message $top.al -aspect 1000 \
2623 -text [mc "Commits to include (arguments to git rev-list):"]
2624 grid $top.al - -sticky w -pady 5
2625 entry $top.args -width 50 -textvariable newviewargs($n) \
2626 -background $bgcolor
2627 grid $top.args - -sticky ew -padx 5
2628 message $top.l -aspect 1000 \
2629 -text [mc "Enter files and directories to include, one per line:"]
2630 grid $top.l - -sticky w
2631 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2632 if {[info exists viewfiles($n)]} {
2633 foreach f $viewfiles($n) {
2634 $top.t insert end $f
2635 $top.t insert end "\n"
2637 $top.t delete {end - 1c} end
2638 $top.t mark set insert 0.0
2640 grid $top.t - -sticky ew -padx 5
2641 frame $top.buts
2642 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2643 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2644 grid $top.buts.ok $top.buts.can
2645 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2646 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2647 grid $top.buts - -pady 10 -sticky ew
2648 focus $top.t
2651 proc doviewmenu {m first cmd op argv} {
2652 set nmenu [$m index end]
2653 for {set i $first} {$i <= $nmenu} {incr i} {
2654 if {[$m entrycget $i -command] eq $cmd} {
2655 eval $m $op $i $argv
2656 break
2661 proc allviewmenus {n op args} {
2662 # global viewhlmenu
2664 doviewmenu .bar.view 5 [list showview $n] $op $args
2665 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2668 proc newviewok {top n} {
2669 global nextviewnum newviewperm newviewname newishighlight
2670 global viewname viewfiles viewperm selectedview curview
2671 global viewargs newviewargs viewhlmenu
2673 if {[catch {
2674 set newargs [shellsplit $newviewargs($n)]
2675 } err]} {
2676 error_popup "[mc "Error in commit selection arguments:"] $err"
2677 wm raise $top
2678 focus $top
2679 return
2681 set files {}
2682 foreach f [split [$top.t get 0.0 end] "\n"] {
2683 set ft [string trim $f]
2684 if {$ft ne {}} {
2685 lappend files $ft
2688 if {![info exists viewfiles($n)]} {
2689 # creating a new view
2690 incr nextviewnum
2691 set viewname($n) $newviewname($n)
2692 set viewperm($n) $newviewperm($n)
2693 set viewfiles($n) $files
2694 set viewargs($n) $newargs
2695 addviewmenu $n
2696 if {!$newishighlight} {
2697 run showview $n
2698 } else {
2699 run addvhighlight $n
2701 } else {
2702 # editing an existing view
2703 set viewperm($n) $newviewperm($n)
2704 if {$newviewname($n) ne $viewname($n)} {
2705 set viewname($n) $newviewname($n)
2706 doviewmenu .bar.view 5 [list showview $n] \
2707 entryconf [list -label $viewname($n)]
2708 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2709 # entryconf [list -label $viewname($n) -value $viewname($n)]
2711 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2712 set viewfiles($n) $files
2713 set viewargs($n) $newargs
2714 if {$curview == $n} {
2715 run reloadcommits
2719 catch {destroy $top}
2722 proc delview {} {
2723 global curview viewperm hlview selectedhlview
2725 if {$curview == 0} return
2726 if {[info exists hlview] && $hlview == $curview} {
2727 set selectedhlview [mc "None"]
2728 unset hlview
2730 allviewmenus $curview delete
2731 set viewperm($curview) 0
2732 showview 0
2735 proc addviewmenu {n} {
2736 global viewname viewhlmenu
2738 .bar.view add radiobutton -label $viewname($n) \
2739 -command [list showview $n] -variable selectedview -value $n
2740 #$viewhlmenu add radiobutton -label $viewname($n) \
2741 # -command [list addvhighlight $n] -variable selectedhlview
2744 proc showview {n} {
2745 global curview viewfiles cached_commitrow ordertok
2746 global displayorder parentlist rowidlist rowisopt rowfinal
2747 global colormap rowtextx nextcolor canvxmax
2748 global numcommits viewcomplete
2749 global selectedline currentid canv canvy0
2750 global treediffs
2751 global pending_select
2752 global commitidx
2753 global selectedview selectfirst
2754 global hlview selectedhlview commitinterest
2756 if {$n == $curview} return
2757 set selid {}
2758 set ymax [lindex [$canv cget -scrollregion] 3]
2759 set span [$canv yview]
2760 set ytop [expr {[lindex $span 0] * $ymax}]
2761 set ybot [expr {[lindex $span 1] * $ymax}]
2762 set yscreen [expr {($ybot - $ytop) / 2}]
2763 if {[info exists selectedline]} {
2764 set selid $currentid
2765 set y [yc $selectedline]
2766 if {$ytop < $y && $y < $ybot} {
2767 set yscreen [expr {$y - $ytop}]
2769 } elseif {[info exists pending_select]} {
2770 set selid $pending_select
2771 unset pending_select
2773 unselectline
2774 normalline
2775 catch {unset treediffs}
2776 clear_display
2777 if {[info exists hlview] && $hlview == $n} {
2778 unset hlview
2779 set selectedhlview [mc "None"]
2781 catch {unset commitinterest}
2782 catch {unset cached_commitrow}
2783 catch {unset ordertok}
2785 set curview $n
2786 set selectedview $n
2787 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2788 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2790 run refill_reflist
2791 if {![info exists viewcomplete($n)]} {
2792 if {$selid ne {}} {
2793 set pending_select $selid
2795 getcommits
2796 return
2799 set displayorder {}
2800 set parentlist {}
2801 set rowidlist {}
2802 set rowisopt {}
2803 set rowfinal {}
2804 set numcommits $commitidx($n)
2806 catch {unset colormap}
2807 catch {unset rowtextx}
2808 set nextcolor 0
2809 set canvxmax [$canv cget -width]
2810 set curview $n
2811 set row 0
2812 setcanvscroll
2813 set yf 0
2814 set row {}
2815 set selectfirst 0
2816 if {$selid ne {} && [commitinview $selid $n]} {
2817 set row [rowofcommit $selid]
2818 # try to get the selected row in the same position on the screen
2819 set ymax [lindex [$canv cget -scrollregion] 3]
2820 set ytop [expr {[yc $row] - $yscreen}]
2821 if {$ytop < 0} {
2822 set ytop 0
2824 set yf [expr {$ytop * 1.0 / $ymax}]
2826 allcanvs yview moveto $yf
2827 drawvisible
2828 if {$row ne {}} {
2829 selectline $row 0
2830 } elseif {$selid ne {}} {
2831 set pending_select $selid
2832 } else {
2833 set row [first_real_row]
2834 if {$row < $numcommits} {
2835 selectline $row 0
2836 } else {
2837 set selectfirst 1
2840 if {!$viewcomplete($n)} {
2841 if {$numcommits == 0} {
2842 show_status [mc "Reading commits..."]
2844 } elseif {$numcommits == 0} {
2845 show_status [mc "No commits selected"]
2849 # Stuff relating to the highlighting facility
2851 proc ishighlighted {id} {
2852 global vhighlights fhighlights nhighlights rhighlights
2854 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
2855 return $nhighlights($id)
2857 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
2858 return $vhighlights($id)
2860 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
2861 return $fhighlights($id)
2863 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
2864 return $rhighlights($id)
2866 return 0
2869 proc bolden {row font} {
2870 global canv linehtag selectedline boldrows
2872 lappend boldrows $row
2873 $canv itemconf $linehtag($row) -font $font
2874 if {[info exists selectedline] && $row == $selectedline} {
2875 $canv delete secsel
2876 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2877 -outline {{}} -tags secsel \
2878 -fill [$canv cget -selectbackground]]
2879 $canv lower $t
2883 proc bolden_name {row font} {
2884 global canv2 linentag selectedline boldnamerows
2886 lappend boldnamerows $row
2887 $canv2 itemconf $linentag($row) -font $font
2888 if {[info exists selectedline] && $row == $selectedline} {
2889 $canv2 delete secsel
2890 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2891 -outline {{}} -tags secsel \
2892 -fill [$canv2 cget -selectbackground]]
2893 $canv2 lower $t
2897 proc unbolden {} {
2898 global boldrows
2900 set stillbold {}
2901 foreach row $boldrows {
2902 if {![ishighlighted [commitonrow $row]]} {
2903 bolden $row mainfont
2904 } else {
2905 lappend stillbold $row
2908 set boldrows $stillbold
2911 proc addvhighlight {n} {
2912 global hlview viewcomplete curview vhl_done commitidx
2914 if {[info exists hlview]} {
2915 delvhighlight
2917 set hlview $n
2918 if {$n != $curview && ![info exists viewcomplete($n)]} {
2919 start_rev_list $n
2921 set vhl_done $commitidx($hlview)
2922 if {$vhl_done > 0} {
2923 drawvisible
2927 proc delvhighlight {} {
2928 global hlview vhighlights
2930 if {![info exists hlview]} return
2931 unset hlview
2932 catch {unset vhighlights}
2933 unbolden
2936 proc vhighlightmore {} {
2937 global hlview vhl_done commitidx vhighlights curview
2939 set max $commitidx($hlview)
2940 set vr [visiblerows]
2941 set r0 [lindex $vr 0]
2942 set r1 [lindex $vr 1]
2943 for {set i $vhl_done} {$i < $max} {incr i} {
2944 set id [commitonrow $i $hlview]
2945 if {[commitinview $id $curview]} {
2946 set row [rowofcommit $id]
2947 if {$r0 <= $row && $row <= $r1} {
2948 if {![highlighted $row]} {
2949 bolden $row mainfontbold
2951 set vhighlights($id) 1
2955 set vhl_done $max
2958 proc askvhighlight {row id} {
2959 global hlview vhighlights iddrawn
2961 if {[commitinview $id $hlview]} {
2962 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
2963 bolden $row mainfontbold
2965 set vhighlights($id) 1
2966 } else {
2967 set vhighlights($id) 0
2971 proc hfiles_change {} {
2972 global highlight_files filehighlight fhighlights fh_serial
2973 global highlight_paths gdttype
2975 if {[info exists filehighlight]} {
2976 # delete previous highlights
2977 catch {close $filehighlight}
2978 unset filehighlight
2979 catch {unset fhighlights}
2980 unbolden
2981 unhighlight_filelist
2983 set highlight_paths {}
2984 after cancel do_file_hl $fh_serial
2985 incr fh_serial
2986 if {$highlight_files ne {}} {
2987 after 300 do_file_hl $fh_serial
2991 proc gdttype_change {name ix op} {
2992 global gdttype highlight_files findstring findpattern
2994 stopfinding
2995 if {$findstring ne {}} {
2996 if {$gdttype eq [mc "containing:"]} {
2997 if {$highlight_files ne {}} {
2998 set highlight_files {}
2999 hfiles_change
3001 findcom_change
3002 } else {
3003 if {$findpattern ne {}} {
3004 set findpattern {}
3005 findcom_change
3007 set highlight_files $findstring
3008 hfiles_change
3010 drawvisible
3012 # enable/disable findtype/findloc menus too
3015 proc find_change {name ix op} {
3016 global gdttype findstring highlight_files
3018 stopfinding
3019 if {$gdttype eq [mc "containing:"]} {
3020 findcom_change
3021 } else {
3022 if {$highlight_files ne $findstring} {
3023 set highlight_files $findstring
3024 hfiles_change
3027 drawvisible
3030 proc findcom_change args {
3031 global nhighlights boldnamerows
3032 global findpattern findtype findstring gdttype
3034 stopfinding
3035 # delete previous highlights, if any
3036 foreach row $boldnamerows {
3037 bolden_name $row mainfont
3039 set boldnamerows {}
3040 catch {unset nhighlights}
3041 unbolden
3042 unmarkmatches
3043 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3044 set findpattern {}
3045 } elseif {$findtype eq [mc "Regexp"]} {
3046 set findpattern $findstring
3047 } else {
3048 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3049 $findstring]
3050 set findpattern "*$e*"
3054 proc makepatterns {l} {
3055 set ret {}
3056 foreach e $l {
3057 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3058 if {[string index $ee end] eq "/"} {
3059 lappend ret "$ee*"
3060 } else {
3061 lappend ret $ee
3062 lappend ret "$ee/*"
3065 return $ret
3068 proc do_file_hl {serial} {
3069 global highlight_files filehighlight highlight_paths gdttype fhl_list
3071 if {$gdttype eq [mc "touching paths:"]} {
3072 if {[catch {set paths [shellsplit $highlight_files]}]} return
3073 set highlight_paths [makepatterns $paths]
3074 highlight_filelist
3075 set gdtargs [concat -- $paths]
3076 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3077 set gdtargs [list "-S$highlight_files"]
3078 } else {
3079 # must be "containing:", i.e. we're searching commit info
3080 return
3082 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3083 set filehighlight [open $cmd r+]
3084 fconfigure $filehighlight -blocking 0
3085 filerun $filehighlight readfhighlight
3086 set fhl_list {}
3087 drawvisible
3088 flushhighlights
3091 proc flushhighlights {} {
3092 global filehighlight fhl_list
3094 if {[info exists filehighlight]} {
3095 lappend fhl_list {}
3096 puts $filehighlight ""
3097 flush $filehighlight
3101 proc askfilehighlight {row id} {
3102 global filehighlight fhighlights fhl_list
3104 lappend fhl_list $id
3105 set fhighlights($id) -1
3106 puts $filehighlight $id
3109 proc readfhighlight {} {
3110 global filehighlight fhighlights curview iddrawn
3111 global fhl_list find_dirn
3113 if {![info exists filehighlight]} {
3114 return 0
3116 set nr 0
3117 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3118 set line [string trim $line]
3119 set i [lsearch -exact $fhl_list $line]
3120 if {$i < 0} continue
3121 for {set j 0} {$j < $i} {incr j} {
3122 set id [lindex $fhl_list $j]
3123 set fhighlights($id) 0
3125 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3126 if {$line eq {}} continue
3127 if {![commitinview $line $curview]} continue
3128 set row [rowofcommit $line]
3129 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3130 bolden $row mainfontbold
3132 set fhighlights($line) 1
3134 if {[eof $filehighlight]} {
3135 # strange...
3136 puts "oops, git diff-tree died"
3137 catch {close $filehighlight}
3138 unset filehighlight
3139 return 0
3141 if {[info exists find_dirn]} {
3142 run findmore
3144 return 1
3147 proc doesmatch {f} {
3148 global findtype findpattern
3150 if {$findtype eq [mc "Regexp"]} {
3151 return [regexp $findpattern $f]
3152 } elseif {$findtype eq [mc "IgnCase"]} {
3153 return [string match -nocase $findpattern $f]
3154 } else {
3155 return [string match $findpattern $f]
3159 proc askfindhighlight {row id} {
3160 global nhighlights commitinfo iddrawn
3161 global findloc
3162 global markingmatches
3164 if {![info exists commitinfo($id)]} {
3165 getcommit $id
3167 set info $commitinfo($id)
3168 set isbold 0
3169 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3170 foreach f $info ty $fldtypes {
3171 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3172 [doesmatch $f]} {
3173 if {$ty eq [mc "Author"]} {
3174 set isbold 2
3175 break
3177 set isbold 1
3180 if {$isbold && [info exists iddrawn($id)]} {
3181 if {![ishighlighted $id]} {
3182 bolden $row mainfontbold
3183 if {$isbold > 1} {
3184 bolden_name $row mainfontbold
3187 if {$markingmatches} {
3188 markrowmatches $row $id
3191 set nhighlights($id) $isbold
3194 proc markrowmatches {row id} {
3195 global canv canv2 linehtag linentag commitinfo findloc
3197 set headline [lindex $commitinfo($id) 0]
3198 set author [lindex $commitinfo($id) 1]
3199 $canv delete match$row
3200 $canv2 delete match$row
3201 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3202 set m [findmatches $headline]
3203 if {$m ne {}} {
3204 markmatches $canv $row $headline $linehtag($row) $m \
3205 [$canv itemcget $linehtag($row) -font] $row
3208 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3209 set m [findmatches $author]
3210 if {$m ne {}} {
3211 markmatches $canv2 $row $author $linentag($row) $m \
3212 [$canv2 itemcget $linentag($row) -font] $row
3217 proc vrel_change {name ix op} {
3218 global highlight_related
3220 rhighlight_none
3221 if {$highlight_related ne [mc "None"]} {
3222 run drawvisible
3226 # prepare for testing whether commits are descendents or ancestors of a
3227 proc rhighlight_sel {a} {
3228 global descendent desc_todo ancestor anc_todo
3229 global highlight_related
3231 catch {unset descendent}
3232 set desc_todo [list $a]
3233 catch {unset ancestor}
3234 set anc_todo [list $a]
3235 if {$highlight_related ne [mc "None"]} {
3236 rhighlight_none
3237 run drawvisible
3241 proc rhighlight_none {} {
3242 global rhighlights
3244 catch {unset rhighlights}
3245 unbolden
3248 proc is_descendent {a} {
3249 global curview children descendent desc_todo
3251 set v $curview
3252 set la [rowofcommit $a]
3253 set todo $desc_todo
3254 set leftover {}
3255 set done 0
3256 for {set i 0} {$i < [llength $todo]} {incr i} {
3257 set do [lindex $todo $i]
3258 if {[rowofcommit $do] < $la} {
3259 lappend leftover $do
3260 continue
3262 foreach nk $children($v,$do) {
3263 if {![info exists descendent($nk)]} {
3264 set descendent($nk) 1
3265 lappend todo $nk
3266 if {$nk eq $a} {
3267 set done 1
3271 if {$done} {
3272 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3273 return
3276 set descendent($a) 0
3277 set desc_todo $leftover
3280 proc is_ancestor {a} {
3281 global curview parents ancestor anc_todo
3283 set v $curview
3284 set la [rowofcommit $a]
3285 set todo $anc_todo
3286 set leftover {}
3287 set done 0
3288 for {set i 0} {$i < [llength $todo]} {incr i} {
3289 set do [lindex $todo $i]
3290 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3291 lappend leftover $do
3292 continue
3294 foreach np $parents($v,$do) {
3295 if {![info exists ancestor($np)]} {
3296 set ancestor($np) 1
3297 lappend todo $np
3298 if {$np eq $a} {
3299 set done 1
3303 if {$done} {
3304 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3305 return
3308 set ancestor($a) 0
3309 set anc_todo $leftover
3312 proc askrelhighlight {row id} {
3313 global descendent highlight_related iddrawn rhighlights
3314 global selectedline ancestor
3316 if {![info exists selectedline]} return
3317 set isbold 0
3318 if {$highlight_related eq [mc "Descendent"] ||
3319 $highlight_related eq [mc "Not descendent"]} {
3320 if {![info exists descendent($id)]} {
3321 is_descendent $id
3323 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
3324 set isbold 1
3326 } elseif {$highlight_related eq [mc "Ancestor"] ||
3327 $highlight_related eq [mc "Not ancestor"]} {
3328 if {![info exists ancestor($id)]} {
3329 is_ancestor $id
3331 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3332 set isbold 1
3335 if {[info exists iddrawn($id)]} {
3336 if {$isbold && ![ishighlighted $id]} {
3337 bolden $row mainfontbold
3340 set rhighlights($id) $isbold
3343 # Graph layout functions
3345 proc shortids {ids} {
3346 set res {}
3347 foreach id $ids {
3348 if {[llength $id] > 1} {
3349 lappend res [shortids $id]
3350 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3351 lappend res [string range $id 0 7]
3352 } else {
3353 lappend res $id
3356 return $res
3359 proc ntimes {n o} {
3360 set ret {}
3361 set o [list $o]
3362 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3363 if {($n & $mask) != 0} {
3364 set ret [concat $ret $o]
3366 set o [concat $o $o]
3368 return $ret
3371 proc ordertoken {id} {
3372 global ordertok curview varcid varcstart varctok curview parents children
3373 global nullid nullid2
3375 if {[info exists ordertok($id)]} {
3376 return $ordertok($id)
3378 set origid $id
3379 set todo {}
3380 while {1} {
3381 if {[info exists varcid($curview,$id)]} {
3382 set a $varcid($curview,$id)
3383 set p [lindex $varcstart($curview) $a]
3384 } else {
3385 set p [lindex $children($curview,$id) 0]
3387 if {[info exists ordertok($p)]} {
3388 set tok $ordertok($p)
3389 break
3391 set id [first_real_child $curview,$p]
3392 if {$id eq {}} {
3393 # it's a root
3394 set tok [lindex $varctok($curview) $a]
3395 break
3397 if {[llength $parents($curview,$id)] == 1} {
3398 lappend todo [list $p {}]
3399 } else {
3400 set j [lsearch -exact $parents($curview,$id) $p]
3401 if {$j < 0} {
3402 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3404 lappend todo [list $p [strrep $j]]
3407 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3408 set p [lindex $todo $i 0]
3409 append tok [lindex $todo $i 1]
3410 set ordertok($p) $tok
3412 set ordertok($origid) $tok
3413 return $tok
3416 # Work out where id should go in idlist so that order-token
3417 # values increase from left to right
3418 proc idcol {idlist id {i 0}} {
3419 set t [ordertoken $id]
3420 if {$i < 0} {
3421 set i 0
3423 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3424 if {$i > [llength $idlist]} {
3425 set i [llength $idlist]
3427 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3428 incr i
3429 } else {
3430 if {$t > [ordertoken [lindex $idlist $i]]} {
3431 while {[incr i] < [llength $idlist] &&
3432 $t >= [ordertoken [lindex $idlist $i]]} {}
3435 return $i
3438 proc initlayout {} {
3439 global rowidlist rowisopt rowfinal displayorder parentlist
3440 global numcommits canvxmax canv
3441 global nextcolor
3442 global colormap rowtextx
3443 global selectfirst
3445 set numcommits 0
3446 set displayorder {}
3447 set parentlist {}
3448 set nextcolor 0
3449 set rowidlist {}
3450 set rowisopt {}
3451 set rowfinal {}
3452 set canvxmax [$canv cget -width]
3453 catch {unset colormap}
3454 catch {unset rowtextx}
3455 set selectfirst 1
3458 proc setcanvscroll {} {
3459 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3461 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3462 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3463 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3464 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3467 proc visiblerows {} {
3468 global canv numcommits linespc
3470 set ymax [lindex [$canv cget -scrollregion] 3]
3471 if {$ymax eq {} || $ymax == 0} return
3472 set f [$canv yview]
3473 set y0 [expr {int([lindex $f 0] * $ymax)}]
3474 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3475 if {$r0 < 0} {
3476 set r0 0
3478 set y1 [expr {int([lindex $f 1] * $ymax)}]
3479 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3480 if {$r1 >= $numcommits} {
3481 set r1 [expr {$numcommits - 1}]
3483 return [list $r0 $r1]
3486 proc layoutmore {} {
3487 global commitidx viewcomplete curview
3488 global numcommits pending_select selectedline curview
3489 global selectfirst lastscrollset commitinterest
3491 set canshow $commitidx($curview)
3492 if {$canshow <= $numcommits && !$viewcomplete($curview)} return
3493 if {$numcommits == 0} {
3494 allcanvs delete all
3496 set r0 $numcommits
3497 set prev $numcommits
3498 set numcommits $canshow
3499 set t [clock clicks -milliseconds]
3500 if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
3501 set lastscrollset $t
3502 setcanvscroll
3504 set rows [visiblerows]
3505 set r1 [lindex $rows 1]
3506 if {$r1 >= $canshow} {
3507 set r1 [expr {$canshow - 1}]
3509 if {$r0 <= $r1} {
3510 drawcommits $r0 $r1
3512 if {[info exists pending_select] &&
3513 [commitinview $pending_select $curview]} {
3514 selectline [rowofcommit $pending_select] 1
3516 if {$selectfirst} {
3517 if {[info exists selectedline] || [info exists pending_select]} {
3518 set selectfirst 0
3519 } else {
3520 set l [first_real_row]
3521 selectline $l 1
3522 set selectfirst 0
3527 proc doshowlocalchanges {} {
3528 global curview mainheadid
3530 if {[commitinview $mainheadid $curview]} {
3531 dodiffindex
3532 } else {
3533 lappend commitinterest($mainheadid) {dodiffindex}
3537 proc dohidelocalchanges {} {
3538 global nullid nullid2 lserial curview
3540 if {[commitinview $nullid $curview]} {
3541 removerow $nullid $curview
3543 if {[commitinview $nullid2 $curview]} {
3544 removerow $nullid2 $curview
3546 incr lserial
3549 # spawn off a process to do git diff-index --cached HEAD
3550 proc dodiffindex {} {
3551 global lserial showlocalchanges
3553 if {!$showlocalchanges} return
3554 incr lserial
3555 set fd [open "|git diff-index --cached HEAD" r]
3556 fconfigure $fd -blocking 0
3557 filerun $fd [list readdiffindex $fd $lserial]
3560 proc readdiffindex {fd serial} {
3561 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3563 set isdiff 1
3564 if {[gets $fd line] < 0} {
3565 if {![eof $fd]} {
3566 return 1
3568 set isdiff 0
3570 # we only need to see one line and we don't really care what it says...
3571 close $fd
3573 if {$serial != $lserial} {
3574 return 0
3577 # now see if there are any local changes not checked in to the index
3578 set fd [open "|git diff-files" r]
3579 fconfigure $fd -blocking 0
3580 filerun $fd [list readdifffiles $fd $serial]
3582 if {$isdiff && ![commitinview $nullid2 $curview]} {
3583 # add the line for the changes in the index to the graph
3584 set hl [mc "Local changes checked in to index but not committed"]
3585 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3586 set commitdata($nullid2) "\n $hl\n"
3587 if {[commitinview $nullid $curview]} {
3588 removerow $nullid $curview
3590 insertrow $nullid2 $mainheadid $curview
3591 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3592 removerow $nullid2 $curview
3594 return 0
3597 proc readdifffiles {fd serial} {
3598 global mainheadid nullid nullid2 curview
3599 global commitinfo commitdata lserial
3601 set isdiff 1
3602 if {[gets $fd line] < 0} {
3603 if {![eof $fd]} {
3604 return 1
3606 set isdiff 0
3608 # we only need to see one line and we don't really care what it says...
3609 close $fd
3611 if {$serial != $lserial} {
3612 return 0
3615 if {$isdiff && ![commitinview $nullid $curview]} {
3616 # add the line for the local diff to the graph
3617 set hl [mc "Local uncommitted changes, not checked in to index"]
3618 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3619 set commitdata($nullid) "\n $hl\n"
3620 if {[commitinview $nullid2 $curview]} {
3621 set p $nullid2
3622 } else {
3623 set p $mainheadid
3625 insertrow $nullid $p $curview
3626 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3627 removerow $nullid $curview
3629 return 0
3632 proc nextuse {id row} {
3633 global curview children
3635 if {[info exists children($curview,$id)]} {
3636 foreach kid $children($curview,$id) {
3637 if {![commitinview $kid $curview]} {
3638 return -1
3640 if {[rowofcommit $kid] > $row} {
3641 return [rowofcommit $kid]
3645 if {[commitinview $id $curview]} {
3646 return [rowofcommit $id]
3648 return -1
3651 proc prevuse {id row} {
3652 global curview children
3654 set ret -1
3655 if {[info exists children($curview,$id)]} {
3656 foreach kid $children($curview,$id) {
3657 if {![commitinview $kid $curview]} break
3658 if {[rowofcommit $kid] < $row} {
3659 set ret [rowofcommit $kid]
3663 return $ret
3666 proc make_idlist {row} {
3667 global displayorder parentlist uparrowlen downarrowlen mingaplen
3668 global commitidx curview children
3670 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3671 if {$r < 0} {
3672 set r 0
3674 set ra [expr {$row - $downarrowlen}]
3675 if {$ra < 0} {
3676 set ra 0
3678 set rb [expr {$row + $uparrowlen}]
3679 if {$rb > $commitidx($curview)} {
3680 set rb $commitidx($curview)
3682 make_disporder $r [expr {$rb + 1}]
3683 set ids {}
3684 for {} {$r < $ra} {incr r} {
3685 set nextid [lindex $displayorder [expr {$r + 1}]]
3686 foreach p [lindex $parentlist $r] {
3687 if {$p eq $nextid} continue
3688 set rn [nextuse $p $r]
3689 if {$rn >= $row &&
3690 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3691 lappend ids [list [ordertoken $p] $p]
3695 for {} {$r < $row} {incr r} {
3696 set nextid [lindex $displayorder [expr {$r + 1}]]
3697 foreach p [lindex $parentlist $r] {
3698 if {$p eq $nextid} continue
3699 set rn [nextuse $p $r]
3700 if {$rn < 0 || $rn >= $row} {
3701 lappend ids [list [ordertoken $p] $p]
3705 set id [lindex $displayorder $row]
3706 lappend ids [list [ordertoken $id] $id]
3707 while {$r < $rb} {
3708 foreach p [lindex $parentlist $r] {
3709 set firstkid [lindex $children($curview,$p) 0]
3710 if {[rowofcommit $firstkid] < $row} {
3711 lappend ids [list [ordertoken $p] $p]
3714 incr r
3715 set id [lindex $displayorder $r]
3716 if {$id ne {}} {
3717 set firstkid [lindex $children($curview,$id) 0]
3718 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3719 lappend ids [list [ordertoken $id] $id]
3723 set idlist {}
3724 foreach idx [lsort -unique $ids] {
3725 lappend idlist [lindex $idx 1]
3727 return $idlist
3730 proc rowsequal {a b} {
3731 while {[set i [lsearch -exact $a {}]] >= 0} {
3732 set a [lreplace $a $i $i]
3734 while {[set i [lsearch -exact $b {}]] >= 0} {
3735 set b [lreplace $b $i $i]
3737 return [expr {$a eq $b}]
3740 proc makeupline {id row rend col} {
3741 global rowidlist uparrowlen downarrowlen mingaplen
3743 for {set r $rend} {1} {set r $rstart} {
3744 set rstart [prevuse $id $r]
3745 if {$rstart < 0} return
3746 if {$rstart < $row} break
3748 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3749 set rstart [expr {$rend - $uparrowlen - 1}]
3751 for {set r $rstart} {[incr r] <= $row} {} {
3752 set idlist [lindex $rowidlist $r]
3753 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3754 set col [idcol $idlist $id $col]
3755 lset rowidlist $r [linsert $idlist $col $id]
3756 changedrow $r
3761 proc layoutrows {row endrow} {
3762 global rowidlist rowisopt rowfinal displayorder
3763 global uparrowlen downarrowlen maxwidth mingaplen
3764 global children parentlist
3765 global commitidx viewcomplete curview
3767 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3768 set idlist {}
3769 if {$row > 0} {
3770 set rm1 [expr {$row - 1}]
3771 foreach id [lindex $rowidlist $rm1] {
3772 if {$id ne {}} {
3773 lappend idlist $id
3776 set final [lindex $rowfinal $rm1]
3778 for {} {$row < $endrow} {incr row} {
3779 set rm1 [expr {$row - 1}]
3780 if {$rm1 < 0 || $idlist eq {}} {
3781 set idlist [make_idlist $row]
3782 set final 1
3783 } else {
3784 set id [lindex $displayorder $rm1]
3785 set col [lsearch -exact $idlist $id]
3786 set idlist [lreplace $idlist $col $col]
3787 foreach p [lindex $parentlist $rm1] {
3788 if {[lsearch -exact $idlist $p] < 0} {
3789 set col [idcol $idlist $p $col]
3790 set idlist [linsert $idlist $col $p]
3791 # if not the first child, we have to insert a line going up
3792 if {$id ne [lindex $children($curview,$p) 0]} {
3793 makeupline $p $rm1 $row $col
3797 set id [lindex $displayorder $row]
3798 if {$row > $downarrowlen} {
3799 set termrow [expr {$row - $downarrowlen - 1}]
3800 foreach p [lindex $parentlist $termrow] {
3801 set i [lsearch -exact $idlist $p]
3802 if {$i < 0} continue
3803 set nr [nextuse $p $termrow]
3804 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3805 set idlist [lreplace $idlist $i $i]
3809 set col [lsearch -exact $idlist $id]
3810 if {$col < 0} {
3811 set col [idcol $idlist $id]
3812 set idlist [linsert $idlist $col $id]
3813 if {$children($curview,$id) ne {}} {
3814 makeupline $id $rm1 $row $col
3817 set r [expr {$row + $uparrowlen - 1}]
3818 if {$r < $commitidx($curview)} {
3819 set x $col
3820 foreach p [lindex $parentlist $r] {
3821 if {[lsearch -exact $idlist $p] >= 0} continue
3822 set fk [lindex $children($curview,$p) 0]
3823 if {[rowofcommit $fk] < $row} {
3824 set x [idcol $idlist $p $x]
3825 set idlist [linsert $idlist $x $p]
3828 if {[incr r] < $commitidx($curview)} {
3829 set p [lindex $displayorder $r]
3830 if {[lsearch -exact $idlist $p] < 0} {
3831 set fk [lindex $children($curview,$p) 0]
3832 if {$fk ne {} && [rowofcommit $fk] < $row} {
3833 set x [idcol $idlist $p $x]
3834 set idlist [linsert $idlist $x $p]
3840 if {$final && !$viewcomplete($curview) &&
3841 $row + $uparrowlen + $mingaplen + $downarrowlen
3842 >= $commitidx($curview)} {
3843 set final 0
3845 set l [llength $rowidlist]
3846 if {$row == $l} {
3847 lappend rowidlist $idlist
3848 lappend rowisopt 0
3849 lappend rowfinal $final
3850 } elseif {$row < $l} {
3851 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3852 lset rowidlist $row $idlist
3853 changedrow $row
3855 lset rowfinal $row $final
3856 } else {
3857 set pad [ntimes [expr {$row - $l}] {}]
3858 set rowidlist [concat $rowidlist $pad]
3859 lappend rowidlist $idlist
3860 set rowfinal [concat $rowfinal $pad]
3861 lappend rowfinal $final
3862 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3865 return $row
3868 proc changedrow {row} {
3869 global displayorder iddrawn rowisopt need_redisplay
3871 set l [llength $rowisopt]
3872 if {$row < $l} {
3873 lset rowisopt $row 0
3874 if {$row + 1 < $l} {
3875 lset rowisopt [expr {$row + 1}] 0
3876 if {$row + 2 < $l} {
3877 lset rowisopt [expr {$row + 2}] 0
3881 set id [lindex $displayorder $row]
3882 if {[info exists iddrawn($id)]} {
3883 set need_redisplay 1
3887 proc insert_pad {row col npad} {
3888 global rowidlist
3890 set pad [ntimes $npad {}]
3891 set idlist [lindex $rowidlist $row]
3892 set bef [lrange $idlist 0 [expr {$col - 1}]]
3893 set aft [lrange $idlist $col end]
3894 set i [lsearch -exact $aft {}]
3895 if {$i > 0} {
3896 set aft [lreplace $aft $i $i]
3898 lset rowidlist $row [concat $bef $pad $aft]
3899 changedrow $row
3902 proc optimize_rows {row col endrow} {
3903 global rowidlist rowisopt displayorder curview children
3905 if {$row < 1} {
3906 set row 1
3908 for {} {$row < $endrow} {incr row; set col 0} {
3909 if {[lindex $rowisopt $row]} continue
3910 set haspad 0
3911 set y0 [expr {$row - 1}]
3912 set ym [expr {$row - 2}]
3913 set idlist [lindex $rowidlist $row]
3914 set previdlist [lindex $rowidlist $y0]
3915 if {$idlist eq {} || $previdlist eq {}} continue
3916 if {$ym >= 0} {
3917 set pprevidlist [lindex $rowidlist $ym]
3918 if {$pprevidlist eq {}} continue
3919 } else {
3920 set pprevidlist {}
3922 set x0 -1
3923 set xm -1
3924 for {} {$col < [llength $idlist]} {incr col} {
3925 set id [lindex $idlist $col]
3926 if {[lindex $previdlist $col] eq $id} continue
3927 if {$id eq {}} {
3928 set haspad 1
3929 continue
3931 set x0 [lsearch -exact $previdlist $id]
3932 if {$x0 < 0} continue
3933 set z [expr {$x0 - $col}]
3934 set isarrow 0
3935 set z0 {}
3936 if {$ym >= 0} {
3937 set xm [lsearch -exact $pprevidlist $id]
3938 if {$xm >= 0} {
3939 set z0 [expr {$xm - $x0}]
3942 if {$z0 eq {}} {
3943 # if row y0 is the first child of $id then it's not an arrow
3944 if {[lindex $children($curview,$id) 0] ne
3945 [lindex $displayorder $y0]} {
3946 set isarrow 1
3949 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3950 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3951 set isarrow 1
3953 # Looking at lines from this row to the previous row,
3954 # make them go straight up if they end in an arrow on
3955 # the previous row; otherwise make them go straight up
3956 # or at 45 degrees.
3957 if {$z < -1 || ($z < 0 && $isarrow)} {
3958 # Line currently goes left too much;
3959 # insert pads in the previous row, then optimize it
3960 set npad [expr {-1 - $z + $isarrow}]
3961 insert_pad $y0 $x0 $npad
3962 if {$y0 > 0} {
3963 optimize_rows $y0 $x0 $row
3965 set previdlist [lindex $rowidlist $y0]
3966 set x0 [lsearch -exact $previdlist $id]
3967 set z [expr {$x0 - $col}]
3968 if {$z0 ne {}} {
3969 set pprevidlist [lindex $rowidlist $ym]
3970 set xm [lsearch -exact $pprevidlist $id]
3971 set z0 [expr {$xm - $x0}]
3973 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3974 # Line currently goes right too much;
3975 # insert pads in this line
3976 set npad [expr {$z - 1 + $isarrow}]
3977 insert_pad $row $col $npad
3978 set idlist [lindex $rowidlist $row]
3979 incr col $npad
3980 set z [expr {$x0 - $col}]
3981 set haspad 1
3983 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3984 # this line links to its first child on row $row-2
3985 set id [lindex $displayorder $ym]
3986 set xc [lsearch -exact $pprevidlist $id]
3987 if {$xc >= 0} {
3988 set z0 [expr {$xc - $x0}]
3991 # avoid lines jigging left then immediately right
3992 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3993 insert_pad $y0 $x0 1
3994 incr x0
3995 optimize_rows $y0 $x0 $row
3996 set previdlist [lindex $rowidlist $y0]
3999 if {!$haspad} {
4000 # Find the first column that doesn't have a line going right
4001 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4002 set id [lindex $idlist $col]
4003 if {$id eq {}} break
4004 set x0 [lsearch -exact $previdlist $id]
4005 if {$x0 < 0} {
4006 # check if this is the link to the first child
4007 set kid [lindex $displayorder $y0]
4008 if {[lindex $children($curview,$id) 0] eq $kid} {
4009 # it is, work out offset to child
4010 set x0 [lsearch -exact $previdlist $kid]
4013 if {$x0 <= $col} break
4015 # Insert a pad at that column as long as it has a line and
4016 # isn't the last column
4017 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4018 set idlist [linsert $idlist $col {}]
4019 lset rowidlist $row $idlist
4020 changedrow $row
4026 proc xc {row col} {
4027 global canvx0 linespc
4028 return [expr {$canvx0 + $col * $linespc}]
4031 proc yc {row} {
4032 global canvy0 linespc
4033 return [expr {$canvy0 + $row * $linespc}]
4036 proc linewidth {id} {
4037 global thickerline lthickness
4039 set wid $lthickness
4040 if {[info exists thickerline] && $id eq $thickerline} {
4041 set wid [expr {2 * $lthickness}]
4043 return $wid
4046 proc rowranges {id} {
4047 global curview children uparrowlen downarrowlen
4048 global rowidlist
4050 set kids $children($curview,$id)
4051 if {$kids eq {}} {
4052 return {}
4054 set ret {}
4055 lappend kids $id
4056 foreach child $kids {
4057 if {![commitinview $child $curview]} break
4058 set row [rowofcommit $child]
4059 if {![info exists prev]} {
4060 lappend ret [expr {$row + 1}]
4061 } else {
4062 if {$row <= $prevrow} {
4063 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4065 # see if the line extends the whole way from prevrow to row
4066 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4067 [lsearch -exact [lindex $rowidlist \
4068 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4069 # it doesn't, see where it ends
4070 set r [expr {$prevrow + $downarrowlen}]
4071 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4072 while {[incr r -1] > $prevrow &&
4073 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4074 } else {
4075 while {[incr r] <= $row &&
4076 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4077 incr r -1
4079 lappend ret $r
4080 # see where it starts up again
4081 set r [expr {$row - $uparrowlen}]
4082 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4083 while {[incr r] < $row &&
4084 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4085 } else {
4086 while {[incr r -1] >= $prevrow &&
4087 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4088 incr r
4090 lappend ret $r
4093 if {$child eq $id} {
4094 lappend ret $row
4096 set prev $child
4097 set prevrow $row
4099 return $ret
4102 proc drawlineseg {id row endrow arrowlow} {
4103 global rowidlist displayorder iddrawn linesegs
4104 global canv colormap linespc curview maxlinelen parentlist
4106 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4107 set le [expr {$row + 1}]
4108 set arrowhigh 1
4109 while {1} {
4110 set c [lsearch -exact [lindex $rowidlist $le] $id]
4111 if {$c < 0} {
4112 incr le -1
4113 break
4115 lappend cols $c
4116 set x [lindex $displayorder $le]
4117 if {$x eq $id} {
4118 set arrowhigh 0
4119 break
4121 if {[info exists iddrawn($x)] || $le == $endrow} {
4122 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4123 if {$c >= 0} {
4124 lappend cols $c
4125 set arrowhigh 0
4127 break
4129 incr le
4131 if {$le <= $row} {
4132 return $row
4135 set lines {}
4136 set i 0
4137 set joinhigh 0
4138 if {[info exists linesegs($id)]} {
4139 set lines $linesegs($id)
4140 foreach li $lines {
4141 set r0 [lindex $li 0]
4142 if {$r0 > $row} {
4143 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4144 set joinhigh 1
4146 break
4148 incr i
4151 set joinlow 0
4152 if {$i > 0} {
4153 set li [lindex $lines [expr {$i-1}]]
4154 set r1 [lindex $li 1]
4155 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4156 set joinlow 1
4160 set x [lindex $cols [expr {$le - $row}]]
4161 set xp [lindex $cols [expr {$le - 1 - $row}]]
4162 set dir [expr {$xp - $x}]
4163 if {$joinhigh} {
4164 set ith [lindex $lines $i 2]
4165 set coords [$canv coords $ith]
4166 set ah [$canv itemcget $ith -arrow]
4167 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4168 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4169 if {$x2 ne {} && $x - $x2 == $dir} {
4170 set coords [lrange $coords 0 end-2]
4172 } else {
4173 set coords [list [xc $le $x] [yc $le]]
4175 if {$joinlow} {
4176 set itl [lindex $lines [expr {$i-1}] 2]
4177 set al [$canv itemcget $itl -arrow]
4178 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4179 } elseif {$arrowlow} {
4180 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4181 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4182 set arrowlow 0
4185 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4186 for {set y $le} {[incr y -1] > $row} {} {
4187 set x $xp
4188 set xp [lindex $cols [expr {$y - 1 - $row}]]
4189 set ndir [expr {$xp - $x}]
4190 if {$dir != $ndir || $xp < 0} {
4191 lappend coords [xc $y $x] [yc $y]
4193 set dir $ndir
4195 if {!$joinlow} {
4196 if {$xp < 0} {
4197 # join parent line to first child
4198 set ch [lindex $displayorder $row]
4199 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4200 if {$xc < 0} {
4201 puts "oops: drawlineseg: child $ch not on row $row"
4202 } elseif {$xc != $x} {
4203 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4204 set d [expr {int(0.5 * $linespc)}]
4205 set x1 [xc $row $x]
4206 if {$xc < $x} {
4207 set x2 [expr {$x1 - $d}]
4208 } else {
4209 set x2 [expr {$x1 + $d}]
4211 set y2 [yc $row]
4212 set y1 [expr {$y2 + $d}]
4213 lappend coords $x1 $y1 $x2 $y2
4214 } elseif {$xc < $x - 1} {
4215 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4216 } elseif {$xc > $x + 1} {
4217 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4219 set x $xc
4221 lappend coords [xc $row $x] [yc $row]
4222 } else {
4223 set xn [xc $row $xp]
4224 set yn [yc $row]
4225 lappend coords $xn $yn
4227 if {!$joinhigh} {
4228 assigncolor $id
4229 set t [$canv create line $coords -width [linewidth $id] \
4230 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4231 $canv lower $t
4232 bindline $t $id
4233 set lines [linsert $lines $i [list $row $le $t]]
4234 } else {
4235 $canv coords $ith $coords
4236 if {$arrow ne $ah} {
4237 $canv itemconf $ith -arrow $arrow
4239 lset lines $i 0 $row
4241 } else {
4242 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4243 set ndir [expr {$xo - $xp}]
4244 set clow [$canv coords $itl]
4245 if {$dir == $ndir} {
4246 set clow [lrange $clow 2 end]
4248 set coords [concat $coords $clow]
4249 if {!$joinhigh} {
4250 lset lines [expr {$i-1}] 1 $le
4251 } else {
4252 # coalesce two pieces
4253 $canv delete $ith
4254 set b [lindex $lines [expr {$i-1}] 0]
4255 set e [lindex $lines $i 1]
4256 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4258 $canv coords $itl $coords
4259 if {$arrow ne $al} {
4260 $canv itemconf $itl -arrow $arrow
4264 set linesegs($id) $lines
4265 return $le
4268 proc drawparentlinks {id row} {
4269 global rowidlist canv colormap curview parentlist
4270 global idpos linespc
4272 set rowids [lindex $rowidlist $row]
4273 set col [lsearch -exact $rowids $id]
4274 if {$col < 0} return
4275 set olds [lindex $parentlist $row]
4276 set row2 [expr {$row + 1}]
4277 set x [xc $row $col]
4278 set y [yc $row]
4279 set y2 [yc $row2]
4280 set d [expr {int(0.5 * $linespc)}]
4281 set ymid [expr {$y + $d}]
4282 set ids [lindex $rowidlist $row2]
4283 # rmx = right-most X coord used
4284 set rmx 0
4285 foreach p $olds {
4286 set i [lsearch -exact $ids $p]
4287 if {$i < 0} {
4288 puts "oops, parent $p of $id not in list"
4289 continue
4291 set x2 [xc $row2 $i]
4292 if {$x2 > $rmx} {
4293 set rmx $x2
4295 set j [lsearch -exact $rowids $p]
4296 if {$j < 0} {
4297 # drawlineseg will do this one for us
4298 continue
4300 assigncolor $p
4301 # should handle duplicated parents here...
4302 set coords [list $x $y]
4303 if {$i != $col} {
4304 # if attaching to a vertical segment, draw a smaller
4305 # slant for visual distinctness
4306 if {$i == $j} {
4307 if {$i < $col} {
4308 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4309 } else {
4310 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4312 } elseif {$i < $col && $i < $j} {
4313 # segment slants towards us already
4314 lappend coords [xc $row $j] $y
4315 } else {
4316 if {$i < $col - 1} {
4317 lappend coords [expr {$x2 + $linespc}] $y
4318 } elseif {$i > $col + 1} {
4319 lappend coords [expr {$x2 - $linespc}] $y
4321 lappend coords $x2 $y2
4323 } else {
4324 lappend coords $x2 $y2
4326 set t [$canv create line $coords -width [linewidth $p] \
4327 -fill $colormap($p) -tags lines.$p]
4328 $canv lower $t
4329 bindline $t $p
4331 if {$rmx > [lindex $idpos($id) 1]} {
4332 lset idpos($id) 1 $rmx
4333 redrawtags $id
4337 proc drawlines {id} {
4338 global canv
4340 $canv itemconf lines.$id -width [linewidth $id]
4343 proc drawcmittext {id row col} {
4344 global linespc canv canv2 canv3 fgcolor curview
4345 global cmitlisted commitinfo rowidlist parentlist
4346 global rowtextx idpos idtags idheads idotherrefs
4347 global linehtag linentag linedtag selectedline
4348 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4350 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
4351 set listed $cmitlisted($curview,$id)
4352 if {$id eq $nullid} {
4353 set ofill red
4354 } elseif {$id eq $nullid2} {
4355 set ofill green
4356 } else {
4357 set ofill [expr {$listed != 0? "blue": "white"}]
4359 set x [xc $row $col]
4360 set y [yc $row]
4361 set orad [expr {$linespc / 3}]
4362 if {$listed <= 1} {
4363 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4364 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4365 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4366 } elseif {$listed == 2} {
4367 # triangle pointing left for left-side commits
4368 set t [$canv create polygon \
4369 [expr {$x - $orad}] $y \
4370 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4371 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4372 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4373 } else {
4374 # triangle pointing right for right-side commits
4375 set t [$canv create polygon \
4376 [expr {$x + $orad - 1}] $y \
4377 [expr {$x - $orad}] [expr {$y - $orad}] \
4378 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4379 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4381 $canv raise $t
4382 $canv bind $t <1> {selcanvline {} %x %y}
4383 set rmx [llength [lindex $rowidlist $row]]
4384 set olds [lindex $parentlist $row]
4385 if {$olds ne {}} {
4386 set nextids [lindex $rowidlist [expr {$row + 1}]]
4387 foreach p $olds {
4388 set i [lsearch -exact $nextids $p]
4389 if {$i > $rmx} {
4390 set rmx $i
4394 set xt [xc $row $rmx]
4395 set rowtextx($row) $xt
4396 set idpos($id) [list $x $xt $y]
4397 if {[info exists idtags($id)] || [info exists idheads($id)]
4398 || [info exists idotherrefs($id)]} {
4399 set xt [drawtags $id $x $xt $y]
4401 set headline [lindex $commitinfo($id) 0]
4402 set name [lindex $commitinfo($id) 1]
4403 set date [lindex $commitinfo($id) 2]
4404 set date [formatdate $date]
4405 set font mainfont
4406 set nfont mainfont
4407 set isbold [ishighlighted $id]
4408 if {$isbold > 0} {
4409 lappend boldrows $row
4410 set font mainfontbold
4411 if {$isbold > 1} {
4412 lappend boldnamerows $row
4413 set nfont mainfontbold
4416 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4417 -text $headline -font $font -tags text]
4418 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4419 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4420 -text $name -font $nfont -tags text]
4421 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4422 -text $date -font mainfont -tags text]
4423 if {[info exists selectedline] && $selectedline == $row} {
4424 make_secsel $row
4426 set xr [expr {$xt + [font measure $font $headline]}]
4427 if {$xr > $canvxmax} {
4428 set canvxmax $xr
4429 setcanvscroll
4433 proc drawcmitrow {row} {
4434 global displayorder rowidlist nrows_drawn
4435 global iddrawn markingmatches
4436 global commitinfo numcommits
4437 global filehighlight fhighlights findpattern nhighlights
4438 global hlview vhighlights
4439 global highlight_related rhighlights
4441 if {$row >= $numcommits} return
4443 set id [lindex $displayorder $row]
4444 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4445 askvhighlight $row $id
4447 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4448 askfilehighlight $row $id
4450 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4451 askfindhighlight $row $id
4453 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4454 askrelhighlight $row $id
4456 if {![info exists iddrawn($id)]} {
4457 set col [lsearch -exact [lindex $rowidlist $row] $id]
4458 if {$col < 0} {
4459 puts "oops, row $row id $id not in list"
4460 return
4462 if {![info exists commitinfo($id)]} {
4463 getcommit $id
4465 assigncolor $id
4466 drawcmittext $id $row $col
4467 set iddrawn($id) 1
4468 incr nrows_drawn
4470 if {$markingmatches} {
4471 markrowmatches $row $id
4475 proc drawcommits {row {endrow {}}} {
4476 global numcommits iddrawn displayorder curview need_redisplay
4477 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4479 if {$row < 0} {
4480 set row 0
4482 if {$endrow eq {}} {
4483 set endrow $row
4485 if {$endrow >= $numcommits} {
4486 set endrow [expr {$numcommits - 1}]
4489 set rl1 [expr {$row - $downarrowlen - 3}]
4490 if {$rl1 < 0} {
4491 set rl1 0
4493 set ro1 [expr {$row - 3}]
4494 if {$ro1 < 0} {
4495 set ro1 0
4497 set r2 [expr {$endrow + $uparrowlen + 3}]
4498 if {$r2 > $numcommits} {
4499 set r2 $numcommits
4501 for {set r $rl1} {$r < $r2} {incr r} {
4502 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4503 if {$rl1 < $r} {
4504 layoutrows $rl1 $r
4506 set rl1 [expr {$r + 1}]
4509 if {$rl1 < $r} {
4510 layoutrows $rl1 $r
4512 optimize_rows $ro1 0 $r2
4513 if {$need_redisplay || $nrows_drawn > 2000} {
4514 clear_display
4515 drawvisible
4518 # make the lines join to already-drawn rows either side
4519 set r [expr {$row - 1}]
4520 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4521 set r $row
4523 set er [expr {$endrow + 1}]
4524 if {$er >= $numcommits ||
4525 ![info exists iddrawn([lindex $displayorder $er])]} {
4526 set er $endrow
4528 for {} {$r <= $er} {incr r} {
4529 set id [lindex $displayorder $r]
4530 set wasdrawn [info exists iddrawn($id)]
4531 drawcmitrow $r
4532 if {$r == $er} break
4533 set nextid [lindex $displayorder [expr {$r + 1}]]
4534 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4535 drawparentlinks $id $r
4537 set rowids [lindex $rowidlist $r]
4538 foreach lid $rowids {
4539 if {$lid eq {}} continue
4540 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4541 if {$lid eq $id} {
4542 # see if this is the first child of any of its parents
4543 foreach p [lindex $parentlist $r] {
4544 if {[lsearch -exact $rowids $p] < 0} {
4545 # make this line extend up to the child
4546 set lineend($p) [drawlineseg $p $r $er 0]
4549 } else {
4550 set lineend($lid) [drawlineseg $lid $r $er 1]
4556 proc undolayout {row} {
4557 global uparrowlen mingaplen downarrowlen
4558 global rowidlist rowisopt rowfinal need_redisplay
4560 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4561 if {$r < 0} {
4562 set r 0
4564 if {[llength $rowidlist] > $r} {
4565 incr r -1
4566 set rowidlist [lrange $rowidlist 0 $r]
4567 set rowfinal [lrange $rowfinal 0 $r]
4568 set rowisopt [lrange $rowisopt 0 $r]
4569 set need_redisplay 1
4570 run drawvisible
4574 proc drawvisible {} {
4575 global canv linespc curview vrowmod selectedline targetrow targetid
4576 global need_redisplay cscroll numcommits
4578 set fs [$canv yview]
4579 set ymax [lindex [$canv cget -scrollregion] 3]
4580 if {$ymax eq {} || $ymax == 0} return
4581 set f0 [lindex $fs 0]
4582 set f1 [lindex $fs 1]
4583 set y0 [expr {int($f0 * $ymax)}]
4584 set y1 [expr {int($f1 * $ymax)}]
4586 if {[info exists targetid]} {
4587 if {[commitinview $targetid $curview]} {
4588 set r [rowofcommit $targetid]
4589 if {$r != $targetrow} {
4590 # Fix up the scrollregion and change the scrolling position
4591 # now that our target row has moved.
4592 set diff [expr {($r - $targetrow) * $linespc}]
4593 set targetrow $r
4594 setcanvscroll
4595 set ymax [lindex [$canv cget -scrollregion] 3]
4596 incr y0 $diff
4597 incr y1 $diff
4598 set f0 [expr {$y0 / $ymax}]
4599 set f1 [expr {$y1 / $ymax}]
4600 allcanvs yview moveto $f0
4601 $cscroll set $f0 $f1
4602 set need_redisplay 1
4604 } else {
4605 unset targetid
4609 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4610 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4611 if {$endrow >= $vrowmod($curview)} {
4612 update_arcrows $curview
4614 if {[info exists selectedline] &&
4615 $row <= $selectedline && $selectedline <= $endrow} {
4616 set targetrow $selectedline
4617 } else {
4618 set targetrow [expr {int(($row + $endrow) / 2)}]
4620 if {$targetrow >= $numcommits} {
4621 set targetrow [expr {$numcommits - 1}]
4623 set targetid [commitonrow $targetrow]
4624 drawcommits $row $endrow
4627 proc clear_display {} {
4628 global iddrawn linesegs need_redisplay nrows_drawn
4629 global vhighlights fhighlights nhighlights rhighlights
4631 allcanvs delete all
4632 catch {unset iddrawn}
4633 catch {unset linesegs}
4634 catch {unset vhighlights}
4635 catch {unset fhighlights}
4636 catch {unset nhighlights}
4637 catch {unset rhighlights}
4638 set need_redisplay 0
4639 set nrows_drawn 0
4642 proc findcrossings {id} {
4643 global rowidlist parentlist numcommits displayorder
4645 set cross {}
4646 set ccross {}
4647 foreach {s e} [rowranges $id] {
4648 if {$e >= $numcommits} {
4649 set e [expr {$numcommits - 1}]
4651 if {$e <= $s} continue
4652 for {set row $e} {[incr row -1] >= $s} {} {
4653 set x [lsearch -exact [lindex $rowidlist $row] $id]
4654 if {$x < 0} break
4655 set olds [lindex $parentlist $row]
4656 set kid [lindex $displayorder $row]
4657 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4658 if {$kidx < 0} continue
4659 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4660 foreach p $olds {
4661 set px [lsearch -exact $nextrow $p]
4662 if {$px < 0} continue
4663 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4664 if {[lsearch -exact $ccross $p] >= 0} continue
4665 if {$x == $px + ($kidx < $px? -1: 1)} {
4666 lappend ccross $p
4667 } elseif {[lsearch -exact $cross $p] < 0} {
4668 lappend cross $p
4674 return [concat $ccross {{}} $cross]
4677 proc assigncolor {id} {
4678 global colormap colors nextcolor
4679 global parents children children curview
4681 if {[info exists colormap($id)]} return
4682 set ncolors [llength $colors]
4683 if {[info exists children($curview,$id)]} {
4684 set kids $children($curview,$id)
4685 } else {
4686 set kids {}
4688 if {[llength $kids] == 1} {
4689 set child [lindex $kids 0]
4690 if {[info exists colormap($child)]
4691 && [llength $parents($curview,$child)] == 1} {
4692 set colormap($id) $colormap($child)
4693 return
4696 set badcolors {}
4697 set origbad {}
4698 foreach x [findcrossings $id] {
4699 if {$x eq {}} {
4700 # delimiter between corner crossings and other crossings
4701 if {[llength $badcolors] >= $ncolors - 1} break
4702 set origbad $badcolors
4704 if {[info exists colormap($x)]
4705 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4706 lappend badcolors $colormap($x)
4709 if {[llength $badcolors] >= $ncolors} {
4710 set badcolors $origbad
4712 set origbad $badcolors
4713 if {[llength $badcolors] < $ncolors - 1} {
4714 foreach child $kids {
4715 if {[info exists colormap($child)]
4716 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4717 lappend badcolors $colormap($child)
4719 foreach p $parents($curview,$child) {
4720 if {[info exists colormap($p)]
4721 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4722 lappend badcolors $colormap($p)
4726 if {[llength $badcolors] >= $ncolors} {
4727 set badcolors $origbad
4730 for {set i 0} {$i <= $ncolors} {incr i} {
4731 set c [lindex $colors $nextcolor]
4732 if {[incr nextcolor] >= $ncolors} {
4733 set nextcolor 0
4735 if {[lsearch -exact $badcolors $c]} break
4737 set colormap($id) $c
4740 proc bindline {t id} {
4741 global canv
4743 $canv bind $t <Enter> "lineenter %x %y $id"
4744 $canv bind $t <Motion> "linemotion %x %y $id"
4745 $canv bind $t <Leave> "lineleave $id"
4746 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4749 proc drawtags {id x xt y1} {
4750 global idtags idheads idotherrefs mainhead
4751 global linespc lthickness
4752 global canv rowtextx curview fgcolor bgcolor
4754 set marks {}
4755 set ntags 0
4756 set nheads 0
4757 if {[info exists idtags($id)]} {
4758 set marks $idtags($id)
4759 set ntags [llength $marks]
4761 if {[info exists idheads($id)]} {
4762 set marks [concat $marks $idheads($id)]
4763 set nheads [llength $idheads($id)]
4765 if {[info exists idotherrefs($id)]} {
4766 set marks [concat $marks $idotherrefs($id)]
4768 if {$marks eq {}} {
4769 return $xt
4772 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4773 set yt [expr {$y1 - 0.5 * $linespc}]
4774 set yb [expr {$yt + $linespc - 1}]
4775 set xvals {}
4776 set wvals {}
4777 set i -1
4778 foreach tag $marks {
4779 incr i
4780 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4781 set wid [font measure mainfontbold $tag]
4782 } else {
4783 set wid [font measure mainfont $tag]
4785 lappend xvals $xt
4786 lappend wvals $wid
4787 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4789 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4790 -width $lthickness -fill black -tags tag.$id]
4791 $canv lower $t
4792 foreach tag $marks x $xvals wid $wvals {
4793 set xl [expr {$x + $delta}]
4794 set xr [expr {$x + $delta + $wid + $lthickness}]
4795 set font mainfont
4796 if {[incr ntags -1] >= 0} {
4797 # draw a tag
4798 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4799 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4800 -width 1 -outline black -fill yellow -tags tag.$id]
4801 $canv bind $t <1> [list showtag $tag 1]
4802 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4803 } else {
4804 # draw a head or other ref
4805 if {[incr nheads -1] >= 0} {
4806 set col green
4807 if {$tag eq $mainhead} {
4808 set font mainfontbold
4810 } else {
4811 set col "#ddddff"
4813 set xl [expr {$xl - $delta/2}]
4814 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4815 -width 1 -outline black -fill $col -tags tag.$id
4816 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4817 set rwid [font measure mainfont $remoteprefix]
4818 set xi [expr {$x + 1}]
4819 set yti [expr {$yt + 1}]
4820 set xri [expr {$x + $rwid}]
4821 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4822 -width 0 -fill "#ffddaa" -tags tag.$id
4825 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4826 -font $font -tags [list tag.$id text]]
4827 if {$ntags >= 0} {
4828 $canv bind $t <1> [list showtag $tag 1]
4829 } elseif {$nheads >= 0} {
4830 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4833 return $xt
4836 proc xcoord {i level ln} {
4837 global canvx0 xspc1 xspc2
4839 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4840 if {$i > 0 && $i == $level} {
4841 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4842 } elseif {$i > $level} {
4843 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4845 return $x
4848 proc show_status {msg} {
4849 global canv fgcolor
4851 clear_display
4852 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4853 -tags text -fill $fgcolor
4856 # Don't change the text pane cursor if it is currently the hand cursor,
4857 # showing that we are over a sha1 ID link.
4858 proc settextcursor {c} {
4859 global ctext curtextcursor
4861 if {[$ctext cget -cursor] == $curtextcursor} {
4862 $ctext config -cursor $c
4864 set curtextcursor $c
4867 proc nowbusy {what {name {}}} {
4868 global isbusy busyname statusw
4870 if {[array names isbusy] eq {}} {
4871 . config -cursor watch
4872 settextcursor watch
4874 set isbusy($what) 1
4875 set busyname($what) $name
4876 if {$name ne {}} {
4877 $statusw conf -text $name
4881 proc notbusy {what} {
4882 global isbusy maincursor textcursor busyname statusw
4884 catch {
4885 unset isbusy($what)
4886 if {$busyname($what) ne {} &&
4887 [$statusw cget -text] eq $busyname($what)} {
4888 $statusw conf -text {}
4891 if {[array names isbusy] eq {}} {
4892 . config -cursor $maincursor
4893 settextcursor $textcursor
4897 proc findmatches {f} {
4898 global findtype findstring
4899 if {$findtype == [mc "Regexp"]} {
4900 set matches [regexp -indices -all -inline $findstring $f]
4901 } else {
4902 set fs $findstring
4903 if {$findtype == [mc "IgnCase"]} {
4904 set f [string tolower $f]
4905 set fs [string tolower $fs]
4907 set matches {}
4908 set i 0
4909 set l [string length $fs]
4910 while {[set j [string first $fs $f $i]] >= 0} {
4911 lappend matches [list $j [expr {$j+$l-1}]]
4912 set i [expr {$j + $l}]
4915 return $matches
4918 proc dofind {{dirn 1} {wrap 1}} {
4919 global findstring findstartline findcurline selectedline numcommits
4920 global gdttype filehighlight fh_serial find_dirn findallowwrap
4922 if {[info exists find_dirn]} {
4923 if {$find_dirn == $dirn} return
4924 stopfinding
4926 focus .
4927 if {$findstring eq {} || $numcommits == 0} return
4928 if {![info exists selectedline]} {
4929 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4930 } else {
4931 set findstartline $selectedline
4933 set findcurline $findstartline
4934 nowbusy finding [mc "Searching"]
4935 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4936 after cancel do_file_hl $fh_serial
4937 do_file_hl $fh_serial
4939 set find_dirn $dirn
4940 set findallowwrap $wrap
4941 run findmore
4944 proc stopfinding {} {
4945 global find_dirn findcurline fprogcoord
4947 if {[info exists find_dirn]} {
4948 unset find_dirn
4949 unset findcurline
4950 notbusy finding
4951 set fprogcoord 0
4952 adjustprogress
4956 proc findmore {} {
4957 global commitdata commitinfo numcommits findpattern findloc
4958 global findstartline findcurline findallowwrap
4959 global find_dirn gdttype fhighlights fprogcoord
4960 global curview varcorder vrownum varccommits vrowmod
4962 if {![info exists find_dirn]} {
4963 return 0
4965 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4966 set l $findcurline
4967 set moretodo 0
4968 if {$find_dirn > 0} {
4969 incr l
4970 if {$l >= $numcommits} {
4971 set l 0
4973 if {$l <= $findstartline} {
4974 set lim [expr {$findstartline + 1}]
4975 } else {
4976 set lim $numcommits
4977 set moretodo $findallowwrap
4979 } else {
4980 if {$l == 0} {
4981 set l $numcommits
4983 incr l -1
4984 if {$l >= $findstartline} {
4985 set lim [expr {$findstartline - 1}]
4986 } else {
4987 set lim -1
4988 set moretodo $findallowwrap
4991 set n [expr {($lim - $l) * $find_dirn}]
4992 if {$n > 500} {
4993 set n 500
4994 set moretodo 1
4996 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
4997 update_arcrows $curview
4999 set found 0
5000 set domore 1
5001 set ai [bsearch $vrownum($curview) $l]
5002 set a [lindex $varcorder($curview) $ai]
5003 set arow [lindex $vrownum($curview) $ai]
5004 set ids [lindex $varccommits($curview,$a)]
5005 set arowend [expr {$arow + [llength $ids]}]
5006 if {$gdttype eq [mc "containing:"]} {
5007 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5008 if {$l < $arow || $l >= $arowend} {
5009 incr ai $find_dirn
5010 set a [lindex $varcorder($curview) $ai]
5011 set arow [lindex $vrownum($curview) $ai]
5012 set ids [lindex $varccommits($curview,$a)]
5013 set arowend [expr {$arow + [llength $ids]}]
5015 set id [lindex $ids [expr {$l - $arow}]]
5016 # shouldn't happen unless git log doesn't give all the commits...
5017 if {![info exists commitdata($id)] ||
5018 ![doesmatch $commitdata($id)]} {
5019 continue
5021 if {![info exists commitinfo($id)]} {
5022 getcommit $id
5024 set info $commitinfo($id)
5025 foreach f $info ty $fldtypes {
5026 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5027 [doesmatch $f]} {
5028 set found 1
5029 break
5032 if {$found} break
5034 } else {
5035 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5036 if {$l < $arow || $l >= $arowend} {
5037 incr ai $find_dirn
5038 set a [lindex $varcorder($curview) $ai]
5039 set arow [lindex $vrownum($curview) $ai]
5040 set ids [lindex $varccommits($curview,$a)]
5041 set arowend [expr {$arow + [llength $ids]}]
5043 set id [lindex $ids [expr {$l - $arow}]]
5044 if {![info exists fhighlights($id)]} {
5045 # this sets fhighlights($id) to -1
5046 askfilehighlight $l $id
5048 if {$fhighlights($id) > 0} {
5049 set found $domore
5050 break
5052 if {$fhighlights($id) < 0} {
5053 if {$domore} {
5054 set domore 0
5055 set findcurline [expr {$l - $find_dirn}]
5060 if {$found || ($domore && !$moretodo)} {
5061 unset findcurline
5062 unset find_dirn
5063 notbusy finding
5064 set fprogcoord 0
5065 adjustprogress
5066 if {$found} {
5067 findselectline $l
5068 } else {
5069 bell
5071 return 0
5073 if {!$domore} {
5074 flushhighlights
5075 } else {
5076 set findcurline [expr {$l - $find_dirn}]
5078 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5079 if {$n < 0} {
5080 incr n $numcommits
5082 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5083 adjustprogress
5084 return $domore
5087 proc findselectline {l} {
5088 global findloc commentend ctext findcurline markingmatches gdttype
5090 set markingmatches 1
5091 set findcurline $l
5092 selectline $l 1
5093 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5094 # highlight the matches in the comments
5095 set f [$ctext get 1.0 $commentend]
5096 set matches [findmatches $f]
5097 foreach match $matches {
5098 set start [lindex $match 0]
5099 set end [expr {[lindex $match 1] + 1}]
5100 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5103 drawvisible
5106 # mark the bits of a headline or author that match a find string
5107 proc markmatches {canv l str tag matches font row} {
5108 global selectedline
5110 set bbox [$canv bbox $tag]
5111 set x0 [lindex $bbox 0]
5112 set y0 [lindex $bbox 1]
5113 set y1 [lindex $bbox 3]
5114 foreach match $matches {
5115 set start [lindex $match 0]
5116 set end [lindex $match 1]
5117 if {$start > $end} continue
5118 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5119 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5120 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5121 [expr {$x0+$xlen+2}] $y1 \
5122 -outline {} -tags [list match$l matches] -fill yellow]
5123 $canv lower $t
5124 if {[info exists selectedline] && $row == $selectedline} {
5125 $canv raise $t secsel
5130 proc unmarkmatches {} {
5131 global markingmatches
5133 allcanvs delete matches
5134 set markingmatches 0
5135 stopfinding
5138 proc selcanvline {w x y} {
5139 global canv canvy0 ctext linespc
5140 global rowtextx
5141 set ymax [lindex [$canv cget -scrollregion] 3]
5142 if {$ymax == {}} return
5143 set yfrac [lindex [$canv yview] 0]
5144 set y [expr {$y + $yfrac * $ymax}]
5145 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5146 if {$l < 0} {
5147 set l 0
5149 if {$w eq $canv} {
5150 set xmax [lindex [$canv cget -scrollregion] 2]
5151 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5152 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5154 unmarkmatches
5155 selectline $l 1
5158 proc commit_descriptor {p} {
5159 global commitinfo
5160 if {![info exists commitinfo($p)]} {
5161 getcommit $p
5163 set l "..."
5164 if {[llength $commitinfo($p)] > 1} {
5165 set l [lindex $commitinfo($p) 0]
5167 return "$p ($l)\n"
5170 # append some text to the ctext widget, and make any SHA1 ID
5171 # that we know about be a clickable link.
5172 proc appendwithlinks {text tags} {
5173 global ctext linknum curview pendinglinks
5175 set start [$ctext index "end - 1c"]
5176 $ctext insert end $text $tags
5177 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5178 foreach l $links {
5179 set s [lindex $l 0]
5180 set e [lindex $l 1]
5181 set linkid [string range $text $s $e]
5182 incr e
5183 $ctext tag delete link$linknum
5184 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5185 setlink $linkid link$linknum
5186 incr linknum
5190 proc setlink {id lk} {
5191 global curview ctext pendinglinks commitinterest
5193 if {[commitinview $id $curview]} {
5194 $ctext tag conf $lk -foreground blue -underline 1
5195 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5196 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5197 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5198 } else {
5199 lappend pendinglinks($id) $lk
5200 lappend commitinterest($id) {makelink %I}
5204 proc makelink {id} {
5205 global pendinglinks
5207 if {![info exists pendinglinks($id)]} return
5208 foreach lk $pendinglinks($id) {
5209 setlink $id $lk
5211 unset pendinglinks($id)
5214 proc linkcursor {w inc} {
5215 global linkentercount curtextcursor
5217 if {[incr linkentercount $inc] > 0} {
5218 $w configure -cursor hand2
5219 } else {
5220 $w configure -cursor $curtextcursor
5221 if {$linkentercount < 0} {
5222 set linkentercount 0
5227 proc viewnextline {dir} {
5228 global canv linespc
5230 $canv delete hover
5231 set ymax [lindex [$canv cget -scrollregion] 3]
5232 set wnow [$canv yview]
5233 set wtop [expr {[lindex $wnow 0] * $ymax}]
5234 set newtop [expr {$wtop + $dir * $linespc}]
5235 if {$newtop < 0} {
5236 set newtop 0
5237 } elseif {$newtop > $ymax} {
5238 set newtop $ymax
5240 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5243 # add a list of tag or branch names at position pos
5244 # returns the number of names inserted
5245 proc appendrefs {pos ids var} {
5246 global ctext linknum curview $var maxrefs
5248 if {[catch {$ctext index $pos}]} {
5249 return 0
5251 $ctext conf -state normal
5252 $ctext delete $pos "$pos lineend"
5253 set tags {}
5254 foreach id $ids {
5255 foreach tag [set $var\($id\)] {
5256 lappend tags [list $tag $id]
5259 if {[llength $tags] > $maxrefs} {
5260 $ctext insert $pos "many ([llength $tags])"
5261 } else {
5262 set tags [lsort -index 0 -decreasing $tags]
5263 set sep {}
5264 foreach ti $tags {
5265 set id [lindex $ti 1]
5266 set lk link$linknum
5267 incr linknum
5268 $ctext tag delete $lk
5269 $ctext insert $pos $sep
5270 $ctext insert $pos [lindex $ti 0] $lk
5271 setlink $id $lk
5272 set sep ", "
5275 $ctext conf -state disabled
5276 return [llength $tags]
5279 # called when we have finished computing the nearby tags
5280 proc dispneartags {delay} {
5281 global selectedline currentid showneartags tagphase
5283 if {![info exists selectedline] || !$showneartags} return
5284 after cancel dispnexttag
5285 if {$delay} {
5286 after 200 dispnexttag
5287 set tagphase -1
5288 } else {
5289 after idle dispnexttag
5290 set tagphase 0
5294 proc dispnexttag {} {
5295 global selectedline currentid showneartags tagphase ctext
5297 if {![info exists selectedline] || !$showneartags} return
5298 switch -- $tagphase {
5300 set dtags [desctags $currentid]
5301 if {$dtags ne {}} {
5302 appendrefs precedes $dtags idtags
5306 set atags [anctags $currentid]
5307 if {$atags ne {}} {
5308 appendrefs follows $atags idtags
5312 set dheads [descheads $currentid]
5313 if {$dheads ne {}} {
5314 if {[appendrefs branch $dheads idheads] > 1
5315 && [$ctext get "branch -3c"] eq "h"} {
5316 # turn "Branch" into "Branches"
5317 $ctext conf -state normal
5318 $ctext insert "branch -2c" "es"
5319 $ctext conf -state disabled
5324 if {[incr tagphase] <= 2} {
5325 after idle dispnexttag
5329 proc make_secsel {l} {
5330 global linehtag linentag linedtag canv canv2 canv3
5332 if {![info exists linehtag($l)]} return
5333 $canv delete secsel
5334 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5335 -tags secsel -fill [$canv cget -selectbackground]]
5336 $canv lower $t
5337 $canv2 delete secsel
5338 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5339 -tags secsel -fill [$canv2 cget -selectbackground]]
5340 $canv2 lower $t
5341 $canv3 delete secsel
5342 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5343 -tags secsel -fill [$canv3 cget -selectbackground]]
5344 $canv3 lower $t
5347 proc selectline {l isnew} {
5348 global canv ctext commitinfo selectedline
5349 global canvy0 linespc parents children curview
5350 global currentid sha1entry
5351 global commentend idtags linknum
5352 global mergemax numcommits pending_select
5353 global cmitmode showneartags allcommits
5355 catch {unset pending_select}
5356 $canv delete hover
5357 normalline
5358 unsel_reflist
5359 stopfinding
5360 if {$l < 0 || $l >= $numcommits} return
5361 set y [expr {$canvy0 + $l * $linespc}]
5362 set ymax [lindex [$canv cget -scrollregion] 3]
5363 set ytop [expr {$y - $linespc - 1}]
5364 set ybot [expr {$y + $linespc + 1}]
5365 set wnow [$canv yview]
5366 set wtop [expr {[lindex $wnow 0] * $ymax}]
5367 set wbot [expr {[lindex $wnow 1] * $ymax}]
5368 set wh [expr {$wbot - $wtop}]
5369 set newtop $wtop
5370 if {$ytop < $wtop} {
5371 if {$ybot < $wtop} {
5372 set newtop [expr {$y - $wh / 2.0}]
5373 } else {
5374 set newtop $ytop
5375 if {$newtop > $wtop - $linespc} {
5376 set newtop [expr {$wtop - $linespc}]
5379 } elseif {$ybot > $wbot} {
5380 if {$ytop > $wbot} {
5381 set newtop [expr {$y - $wh / 2.0}]
5382 } else {
5383 set newtop [expr {$ybot - $wh}]
5384 if {$newtop < $wtop + $linespc} {
5385 set newtop [expr {$wtop + $linespc}]
5389 if {$newtop != $wtop} {
5390 if {$newtop < 0} {
5391 set newtop 0
5393 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5394 drawvisible
5397 make_secsel $l
5399 set id [commitonrow $l]
5400 if {$isnew} {
5401 addtohistory [list selbyid $id]
5404 set selectedline $l
5405 set currentid $id
5406 $sha1entry delete 0 end
5407 $sha1entry insert 0 $id
5408 $sha1entry selection from 0
5409 $sha1entry selection to end
5410 rhighlight_sel $id
5412 $ctext conf -state normal
5413 clear_ctext
5414 set linknum 0
5415 set info $commitinfo($id)
5416 set date [formatdate [lindex $info 2]]
5417 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5418 set date [formatdate [lindex $info 4]]
5419 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5420 if {[info exists idtags($id)]} {
5421 $ctext insert end [mc "Tags:"]
5422 foreach tag $idtags($id) {
5423 $ctext insert end " $tag"
5425 $ctext insert end "\n"
5428 set headers {}
5429 set olds $parents($curview,$id)
5430 if {[llength $olds] > 1} {
5431 set np 0
5432 foreach p $olds {
5433 if {$np >= $mergemax} {
5434 set tag mmax
5435 } else {
5436 set tag m$np
5438 $ctext insert end "[mc "Parent"]: " $tag
5439 appendwithlinks [commit_descriptor $p] {}
5440 incr np
5442 } else {
5443 foreach p $olds {
5444 append headers "[mc "Parent"]: [commit_descriptor $p]"
5448 foreach c $children($curview,$id) {
5449 append headers "[mc "Child"]: [commit_descriptor $c]"
5452 # make anything that looks like a SHA1 ID be a clickable link
5453 appendwithlinks $headers {}
5454 if {$showneartags} {
5455 if {![info exists allcommits]} {
5456 getallcommits
5458 $ctext insert end "[mc "Branch"]: "
5459 $ctext mark set branch "end -1c"
5460 $ctext mark gravity branch left
5461 $ctext insert end "\n[mc "Follows"]: "
5462 $ctext mark set follows "end -1c"
5463 $ctext mark gravity follows left
5464 $ctext insert end "\n[mc "Precedes"]: "
5465 $ctext mark set precedes "end -1c"
5466 $ctext mark gravity precedes left
5467 $ctext insert end "\n"
5468 dispneartags 1
5470 $ctext insert end "\n"
5471 set comment [lindex $info 5]
5472 if {[string first "\r" $comment] >= 0} {
5473 set comment [string map {"\r" "\n "} $comment]
5475 appendwithlinks $comment {comment}
5477 $ctext tag remove found 1.0 end
5478 $ctext conf -state disabled
5479 set commentend [$ctext index "end - 1c"]
5481 init_flist [mc "Comments"]
5482 if {$cmitmode eq "tree"} {
5483 gettree $id
5484 } elseif {[llength $olds] <= 1} {
5485 startdiff $id
5486 } else {
5487 mergediff $id
5491 proc selfirstline {} {
5492 unmarkmatches
5493 selectline 0 1
5496 proc sellastline {} {
5497 global numcommits
5498 unmarkmatches
5499 set l [expr {$numcommits - 1}]
5500 selectline $l 1
5503 proc selnextline {dir} {
5504 global selectedline
5505 focus .
5506 if {![info exists selectedline]} return
5507 set l [expr {$selectedline + $dir}]
5508 unmarkmatches
5509 selectline $l 1
5512 proc selnextpage {dir} {
5513 global canv linespc selectedline numcommits
5515 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5516 if {$lpp < 1} {
5517 set lpp 1
5519 allcanvs yview scroll [expr {$dir * $lpp}] units
5520 drawvisible
5521 if {![info exists selectedline]} return
5522 set l [expr {$selectedline + $dir * $lpp}]
5523 if {$l < 0} {
5524 set l 0
5525 } elseif {$l >= $numcommits} {
5526 set l [expr $numcommits - 1]
5528 unmarkmatches
5529 selectline $l 1
5532 proc unselectline {} {
5533 global selectedline currentid
5535 catch {unset selectedline}
5536 catch {unset currentid}
5537 allcanvs delete secsel
5538 rhighlight_none
5541 proc reselectline {} {
5542 global selectedline
5544 if {[info exists selectedline]} {
5545 selectline $selectedline 0
5549 proc addtohistory {cmd} {
5550 global history historyindex curview
5552 set elt [list $curview $cmd]
5553 if {$historyindex > 0
5554 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5555 return
5558 if {$historyindex < [llength $history]} {
5559 set history [lreplace $history $historyindex end $elt]
5560 } else {
5561 lappend history $elt
5563 incr historyindex
5564 if {$historyindex > 1} {
5565 .tf.bar.leftbut conf -state normal
5566 } else {
5567 .tf.bar.leftbut conf -state disabled
5569 .tf.bar.rightbut conf -state disabled
5572 proc godo {elt} {
5573 global curview
5575 set view [lindex $elt 0]
5576 set cmd [lindex $elt 1]
5577 if {$curview != $view} {
5578 showview $view
5580 eval $cmd
5583 proc goback {} {
5584 global history historyindex
5585 focus .
5587 if {$historyindex > 1} {
5588 incr historyindex -1
5589 godo [lindex $history [expr {$historyindex - 1}]]
5590 .tf.bar.rightbut conf -state normal
5592 if {$historyindex <= 1} {
5593 .tf.bar.leftbut conf -state disabled
5597 proc goforw {} {
5598 global history historyindex
5599 focus .
5601 if {$historyindex < [llength $history]} {
5602 set cmd [lindex $history $historyindex]
5603 incr historyindex
5604 godo $cmd
5605 .tf.bar.leftbut conf -state normal
5607 if {$historyindex >= [llength $history]} {
5608 .tf.bar.rightbut conf -state disabled
5612 proc gettree {id} {
5613 global treefilelist treeidlist diffids diffmergeid treepending
5614 global nullid nullid2
5616 set diffids $id
5617 catch {unset diffmergeid}
5618 if {![info exists treefilelist($id)]} {
5619 if {![info exists treepending]} {
5620 if {$id eq $nullid} {
5621 set cmd [list | git ls-files]
5622 } elseif {$id eq $nullid2} {
5623 set cmd [list | git ls-files --stage -t]
5624 } else {
5625 set cmd [list | git ls-tree -r $id]
5627 if {[catch {set gtf [open $cmd r]}]} {
5628 return
5630 set treepending $id
5631 set treefilelist($id) {}
5632 set treeidlist($id) {}
5633 fconfigure $gtf -blocking 0
5634 filerun $gtf [list gettreeline $gtf $id]
5636 } else {
5637 setfilelist $id
5641 proc gettreeline {gtf id} {
5642 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5644 set nl 0
5645 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5646 if {$diffids eq $nullid} {
5647 set fname $line
5648 } else {
5649 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5650 set i [string first "\t" $line]
5651 if {$i < 0} continue
5652 set sha1 [lindex $line 2]
5653 set fname [string range $line [expr {$i+1}] end]
5654 if {[string index $fname 0] eq "\""} {
5655 set fname [lindex $fname 0]
5657 lappend treeidlist($id) $sha1
5659 lappend treefilelist($id) $fname
5661 if {![eof $gtf]} {
5662 return [expr {$nl >= 1000? 2: 1}]
5664 close $gtf
5665 unset treepending
5666 if {$cmitmode ne "tree"} {
5667 if {![info exists diffmergeid]} {
5668 gettreediffs $diffids
5670 } elseif {$id ne $diffids} {
5671 gettree $diffids
5672 } else {
5673 setfilelist $id
5675 return 0
5678 proc showfile {f} {
5679 global treefilelist treeidlist diffids nullid nullid2
5680 global ctext commentend
5682 set i [lsearch -exact $treefilelist($diffids) $f]
5683 if {$i < 0} {
5684 puts "oops, $f not in list for id $diffids"
5685 return
5687 if {$diffids eq $nullid} {
5688 if {[catch {set bf [open $f r]} err]} {
5689 puts "oops, can't read $f: $err"
5690 return
5692 } else {
5693 set blob [lindex $treeidlist($diffids) $i]
5694 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5695 puts "oops, error reading blob $blob: $err"
5696 return
5699 fconfigure $bf -blocking 0
5700 filerun $bf [list getblobline $bf $diffids]
5701 $ctext config -state normal
5702 clear_ctext $commentend
5703 $ctext insert end "\n"
5704 $ctext insert end "$f\n" filesep
5705 $ctext config -state disabled
5706 $ctext yview $commentend
5707 settabs 0
5710 proc getblobline {bf id} {
5711 global diffids cmitmode ctext
5713 if {$id ne $diffids || $cmitmode ne "tree"} {
5714 catch {close $bf}
5715 return 0
5717 $ctext config -state normal
5718 set nl 0
5719 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5720 $ctext insert end "$line\n"
5722 if {[eof $bf]} {
5723 # delete last newline
5724 $ctext delete "end - 2c" "end - 1c"
5725 close $bf
5726 return 0
5728 $ctext config -state disabled
5729 return [expr {$nl >= 1000? 2: 1}]
5732 proc mergediff {id} {
5733 global diffmergeid mdifffd
5734 global diffids
5735 global parents
5736 global limitdiffs viewfiles curview
5738 set diffmergeid $id
5739 set diffids $id
5740 # this doesn't seem to actually affect anything...
5741 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5742 if {$limitdiffs && $viewfiles($curview) ne {}} {
5743 set cmd [concat $cmd -- $viewfiles($curview)]
5745 if {[catch {set mdf [open $cmd r]} err]} {
5746 error_popup "[mc "Error getting merge diffs:"] $err"
5747 return
5749 fconfigure $mdf -blocking 0
5750 set mdifffd($id) $mdf
5751 set np [llength $parents($curview,$id)]
5752 settabs $np
5753 filerun $mdf [list getmergediffline $mdf $id $np]
5756 proc getmergediffline {mdf id np} {
5757 global diffmergeid ctext cflist mergemax
5758 global difffilestart mdifffd
5760 $ctext conf -state normal
5761 set nr 0
5762 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5763 if {![info exists diffmergeid] || $id != $diffmergeid
5764 || $mdf != $mdifffd($id)} {
5765 close $mdf
5766 return 0
5768 if {[regexp {^diff --cc (.*)} $line match fname]} {
5769 # start of a new file
5770 $ctext insert end "\n"
5771 set here [$ctext index "end - 1c"]
5772 lappend difffilestart $here
5773 add_flist [list $fname]
5774 set l [expr {(78 - [string length $fname]) / 2}]
5775 set pad [string range "----------------------------------------" 1 $l]
5776 $ctext insert end "$pad $fname $pad\n" filesep
5777 } elseif {[regexp {^@@} $line]} {
5778 $ctext insert end "$line\n" hunksep
5779 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5780 # do nothing
5781 } else {
5782 # parse the prefix - one ' ', '-' or '+' for each parent
5783 set spaces {}
5784 set minuses {}
5785 set pluses {}
5786 set isbad 0
5787 for {set j 0} {$j < $np} {incr j} {
5788 set c [string range $line $j $j]
5789 if {$c == " "} {
5790 lappend spaces $j
5791 } elseif {$c == "-"} {
5792 lappend minuses $j
5793 } elseif {$c == "+"} {
5794 lappend pluses $j
5795 } else {
5796 set isbad 1
5797 break
5800 set tags {}
5801 set num {}
5802 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5803 # line doesn't appear in result, parents in $minuses have the line
5804 set num [lindex $minuses 0]
5805 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5806 # line appears in result, parents in $pluses don't have the line
5807 lappend tags mresult
5808 set num [lindex $spaces 0]
5810 if {$num ne {}} {
5811 if {$num >= $mergemax} {
5812 set num "max"
5814 lappend tags m$num
5816 $ctext insert end "$line\n" $tags
5819 $ctext conf -state disabled
5820 if {[eof $mdf]} {
5821 close $mdf
5822 return 0
5824 return [expr {$nr >= 1000? 2: 1}]
5827 proc startdiff {ids} {
5828 global treediffs diffids treepending diffmergeid nullid nullid2
5830 settabs 1
5831 set diffids $ids
5832 catch {unset diffmergeid}
5833 if {![info exists treediffs($ids)] ||
5834 [lsearch -exact $ids $nullid] >= 0 ||
5835 [lsearch -exact $ids $nullid2] >= 0} {
5836 if {![info exists treepending]} {
5837 gettreediffs $ids
5839 } else {
5840 addtocflist $ids
5844 proc path_filter {filter name} {
5845 foreach p $filter {
5846 set l [string length $p]
5847 if {[string index $p end] eq "/"} {
5848 if {[string compare -length $l $p $name] == 0} {
5849 return 1
5851 } else {
5852 if {[string compare -length $l $p $name] == 0 &&
5853 ([string length $name] == $l ||
5854 [string index $name $l] eq "/")} {
5855 return 1
5859 return 0
5862 proc addtocflist {ids} {
5863 global treediffs
5865 add_flist $treediffs($ids)
5866 getblobdiffs $ids
5869 proc diffcmd {ids flags} {
5870 global nullid nullid2
5872 set i [lsearch -exact $ids $nullid]
5873 set j [lsearch -exact $ids $nullid2]
5874 if {$i >= 0} {
5875 if {[llength $ids] > 1 && $j < 0} {
5876 # comparing working directory with some specific revision
5877 set cmd [concat | git diff-index $flags]
5878 if {$i == 0} {
5879 lappend cmd -R [lindex $ids 1]
5880 } else {
5881 lappend cmd [lindex $ids 0]
5883 } else {
5884 # comparing working directory with index
5885 set cmd [concat | git diff-files $flags]
5886 if {$j == 1} {
5887 lappend cmd -R
5890 } elseif {$j >= 0} {
5891 set cmd [concat | git diff-index --cached $flags]
5892 if {[llength $ids] > 1} {
5893 # comparing index with specific revision
5894 if {$i == 0} {
5895 lappend cmd -R [lindex $ids 1]
5896 } else {
5897 lappend cmd [lindex $ids 0]
5899 } else {
5900 # comparing index with HEAD
5901 lappend cmd HEAD
5903 } else {
5904 set cmd [concat | git diff-tree -r $flags $ids]
5906 return $cmd
5909 proc gettreediffs {ids} {
5910 global treediff treepending
5912 set treepending $ids
5913 set treediff {}
5914 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5915 fconfigure $gdtf -blocking 0
5916 filerun $gdtf [list gettreediffline $gdtf $ids]
5919 proc gettreediffline {gdtf ids} {
5920 global treediff treediffs treepending diffids diffmergeid
5921 global cmitmode viewfiles curview limitdiffs
5923 set nr 0
5924 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5925 set i [string first "\t" $line]
5926 if {$i >= 0} {
5927 set file [string range $line [expr {$i+1}] end]
5928 if {[string index $file 0] eq "\""} {
5929 set file [lindex $file 0]
5931 lappend treediff $file
5934 if {![eof $gdtf]} {
5935 return [expr {$nr >= 1000? 2: 1}]
5937 close $gdtf
5938 if {$limitdiffs && $viewfiles($curview) ne {}} {
5939 set flist {}
5940 foreach f $treediff {
5941 if {[path_filter $viewfiles($curview) $f]} {
5942 lappend flist $f
5945 set treediffs($ids) $flist
5946 } else {
5947 set treediffs($ids) $treediff
5949 unset treepending
5950 if {$cmitmode eq "tree"} {
5951 gettree $diffids
5952 } elseif {$ids != $diffids} {
5953 if {![info exists diffmergeid]} {
5954 gettreediffs $diffids
5956 } else {
5957 addtocflist $ids
5959 return 0
5962 # empty string or positive integer
5963 proc diffcontextvalidate {v} {
5964 return [regexp {^(|[1-9][0-9]*)$} $v]
5967 proc diffcontextchange {n1 n2 op} {
5968 global diffcontextstring diffcontext
5970 if {[string is integer -strict $diffcontextstring]} {
5971 if {$diffcontextstring > 0} {
5972 set diffcontext $diffcontextstring
5973 reselectline
5978 proc getblobdiffs {ids} {
5979 global blobdifffd diffids env
5980 global diffinhdr treediffs
5981 global diffcontext
5982 global limitdiffs viewfiles curview
5984 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5985 if {$limitdiffs && $viewfiles($curview) ne {}} {
5986 set cmd [concat $cmd -- $viewfiles($curview)]
5988 if {[catch {set bdf [open $cmd r]} err]} {
5989 puts "error getting diffs: $err"
5990 return
5992 set diffinhdr 0
5993 fconfigure $bdf -blocking 0
5994 set blobdifffd($ids) $bdf
5995 filerun $bdf [list getblobdiffline $bdf $diffids]
5998 proc setinlist {var i val} {
5999 global $var
6001 while {[llength [set $var]] < $i} {
6002 lappend $var {}
6004 if {[llength [set $var]] == $i} {
6005 lappend $var $val
6006 } else {
6007 lset $var $i $val
6011 proc makediffhdr {fname ids} {
6012 global ctext curdiffstart treediffs
6014 set i [lsearch -exact $treediffs($ids) $fname]
6015 if {$i >= 0} {
6016 setinlist difffilestart $i $curdiffstart
6018 set l [expr {(78 - [string length $fname]) / 2}]
6019 set pad [string range "----------------------------------------" 1 $l]
6020 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6023 proc getblobdiffline {bdf ids} {
6024 global diffids blobdifffd ctext curdiffstart
6025 global diffnexthead diffnextnote difffilestart
6026 global diffinhdr treediffs
6028 set nr 0
6029 $ctext conf -state normal
6030 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6031 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6032 close $bdf
6033 return 0
6035 if {![string compare -length 11 "diff --git " $line]} {
6036 # trim off "diff --git "
6037 set line [string range $line 11 end]
6038 set diffinhdr 1
6039 # start of a new file
6040 $ctext insert end "\n"
6041 set curdiffstart [$ctext index "end - 1c"]
6042 $ctext insert end "\n" filesep
6043 # If the name hasn't changed the length will be odd,
6044 # the middle char will be a space, and the two bits either
6045 # side will be a/name and b/name, or "a/name" and "b/name".
6046 # If the name has changed we'll get "rename from" and
6047 # "rename to" or "copy from" and "copy to" lines following this,
6048 # and we'll use them to get the filenames.
6049 # This complexity is necessary because spaces in the filename(s)
6050 # don't get escaped.
6051 set l [string length $line]
6052 set i [expr {$l / 2}]
6053 if {!(($l & 1) && [string index $line $i] eq " " &&
6054 [string range $line 2 [expr {$i - 1}]] eq \
6055 [string range $line [expr {$i + 3}] end])} {
6056 continue
6058 # unescape if quoted and chop off the a/ from the front
6059 if {[string index $line 0] eq "\""} {
6060 set fname [string range [lindex $line 0] 2 end]
6061 } else {
6062 set fname [string range $line 2 [expr {$i - 1}]]
6064 makediffhdr $fname $ids
6066 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6067 $line match f1l f1c f2l f2c rest]} {
6068 $ctext insert end "$line\n" hunksep
6069 set diffinhdr 0
6071 } elseif {$diffinhdr} {
6072 if {![string compare -length 12 "rename from " $line]} {
6073 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6074 if {[string index $fname 0] eq "\""} {
6075 set fname [lindex $fname 0]
6077 set i [lsearch -exact $treediffs($ids) $fname]
6078 if {$i >= 0} {
6079 setinlist difffilestart $i $curdiffstart
6081 } elseif {![string compare -length 10 $line "rename to "] ||
6082 ![string compare -length 8 $line "copy to "]} {
6083 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6084 if {[string index $fname 0] eq "\""} {
6085 set fname [lindex $fname 0]
6087 makediffhdr $fname $ids
6088 } elseif {[string compare -length 3 $line "---"] == 0} {
6089 # do nothing
6090 continue
6091 } elseif {[string compare -length 3 $line "+++"] == 0} {
6092 set diffinhdr 0
6093 continue
6095 $ctext insert end "$line\n" filesep
6097 } else {
6098 set x [string range $line 0 0]
6099 if {$x == "-" || $x == "+"} {
6100 set tag [expr {$x == "+"}]
6101 $ctext insert end "$line\n" d$tag
6102 } elseif {$x == " "} {
6103 $ctext insert end "$line\n"
6104 } else {
6105 # "\ No newline at end of file",
6106 # or something else we don't recognize
6107 $ctext insert end "$line\n" hunksep
6111 $ctext conf -state disabled
6112 if {[eof $bdf]} {
6113 close $bdf
6114 return 0
6116 return [expr {$nr >= 1000? 2: 1}]
6119 proc changediffdisp {} {
6120 global ctext diffelide
6122 $ctext tag conf d0 -elide [lindex $diffelide 0]
6123 $ctext tag conf d1 -elide [lindex $diffelide 1]
6126 proc prevfile {} {
6127 global difffilestart ctext
6128 set prev [lindex $difffilestart 0]
6129 set here [$ctext index @0,0]
6130 foreach loc $difffilestart {
6131 if {[$ctext compare $loc >= $here]} {
6132 $ctext yview $prev
6133 return
6135 set prev $loc
6137 $ctext yview $prev
6140 proc nextfile {} {
6141 global difffilestart ctext
6142 set here [$ctext index @0,0]
6143 foreach loc $difffilestart {
6144 if {[$ctext compare $loc > $here]} {
6145 $ctext yview $loc
6146 return
6151 proc clear_ctext {{first 1.0}} {
6152 global ctext smarktop smarkbot
6153 global pendinglinks
6155 set l [lindex [split $first .] 0]
6156 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6157 set smarktop $l
6159 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6160 set smarkbot $l
6162 $ctext delete $first end
6163 if {$first eq "1.0"} {
6164 catch {unset pendinglinks}
6168 proc settabs {{firstab {}}} {
6169 global firsttabstop tabstop ctext have_tk85
6171 if {$firstab ne {} && $have_tk85} {
6172 set firsttabstop $firstab
6174 set w [font measure textfont "0"]
6175 if {$firsttabstop != 0} {
6176 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6177 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6178 } elseif {$have_tk85 || $tabstop != 8} {
6179 $ctext conf -tabs [expr {$tabstop * $w}]
6180 } else {
6181 $ctext conf -tabs {}
6185 proc incrsearch {name ix op} {
6186 global ctext searchstring searchdirn
6188 $ctext tag remove found 1.0 end
6189 if {[catch {$ctext index anchor}]} {
6190 # no anchor set, use start of selection, or of visible area
6191 set sel [$ctext tag ranges sel]
6192 if {$sel ne {}} {
6193 $ctext mark set anchor [lindex $sel 0]
6194 } elseif {$searchdirn eq "-forwards"} {
6195 $ctext mark set anchor @0,0
6196 } else {
6197 $ctext mark set anchor @0,[winfo height $ctext]
6200 if {$searchstring ne {}} {
6201 set here [$ctext search $searchdirn -- $searchstring anchor]
6202 if {$here ne {}} {
6203 $ctext see $here
6205 searchmarkvisible 1
6209 proc dosearch {} {
6210 global sstring ctext searchstring searchdirn
6212 focus $sstring
6213 $sstring icursor end
6214 set searchdirn -forwards
6215 if {$searchstring ne {}} {
6216 set sel [$ctext tag ranges sel]
6217 if {$sel ne {}} {
6218 set start "[lindex $sel 0] + 1c"
6219 } elseif {[catch {set start [$ctext index anchor]}]} {
6220 set start "@0,0"
6222 set match [$ctext search -count mlen -- $searchstring $start]
6223 $ctext tag remove sel 1.0 end
6224 if {$match eq {}} {
6225 bell
6226 return
6228 $ctext see $match
6229 set mend "$match + $mlen c"
6230 $ctext tag add sel $match $mend
6231 $ctext mark unset anchor
6235 proc dosearchback {} {
6236 global sstring ctext searchstring searchdirn
6238 focus $sstring
6239 $sstring icursor end
6240 set searchdirn -backwards
6241 if {$searchstring ne {}} {
6242 set sel [$ctext tag ranges sel]
6243 if {$sel ne {}} {
6244 set start [lindex $sel 0]
6245 } elseif {[catch {set start [$ctext index anchor]}]} {
6246 set start @0,[winfo height $ctext]
6248 set match [$ctext search -backwards -count ml -- $searchstring $start]
6249 $ctext tag remove sel 1.0 end
6250 if {$match eq {}} {
6251 bell
6252 return
6254 $ctext see $match
6255 set mend "$match + $ml c"
6256 $ctext tag add sel $match $mend
6257 $ctext mark unset anchor
6261 proc searchmark {first last} {
6262 global ctext searchstring
6264 set mend $first.0
6265 while {1} {
6266 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6267 if {$match eq {}} break
6268 set mend "$match + $mlen c"
6269 $ctext tag add found $match $mend
6273 proc searchmarkvisible {doall} {
6274 global ctext smarktop smarkbot
6276 set topline [lindex [split [$ctext index @0,0] .] 0]
6277 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6278 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6279 # no overlap with previous
6280 searchmark $topline $botline
6281 set smarktop $topline
6282 set smarkbot $botline
6283 } else {
6284 if {$topline < $smarktop} {
6285 searchmark $topline [expr {$smarktop-1}]
6286 set smarktop $topline
6288 if {$botline > $smarkbot} {
6289 searchmark [expr {$smarkbot+1}] $botline
6290 set smarkbot $botline
6295 proc scrolltext {f0 f1} {
6296 global searchstring
6298 .bleft.sb set $f0 $f1
6299 if {$searchstring ne {}} {
6300 searchmarkvisible 0
6304 proc setcoords {} {
6305 global linespc charspc canvx0 canvy0
6306 global xspc1 xspc2 lthickness
6308 set linespc [font metrics mainfont -linespace]
6309 set charspc [font measure mainfont "m"]
6310 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6311 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6312 set lthickness [expr {int($linespc / 9) + 1}]
6313 set xspc1(0) $linespc
6314 set xspc2 $linespc
6317 proc redisplay {} {
6318 global canv
6319 global selectedline
6321 set ymax [lindex [$canv cget -scrollregion] 3]
6322 if {$ymax eq {} || $ymax == 0} return
6323 set span [$canv yview]
6324 clear_display
6325 setcanvscroll
6326 allcanvs yview moveto [lindex $span 0]
6327 drawvisible
6328 if {[info exists selectedline]} {
6329 selectline $selectedline 0
6330 allcanvs yview moveto [lindex $span 0]
6334 proc parsefont {f n} {
6335 global fontattr
6337 set fontattr($f,family) [lindex $n 0]
6338 set s [lindex $n 1]
6339 if {$s eq {} || $s == 0} {
6340 set s 10
6341 } elseif {$s < 0} {
6342 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6344 set fontattr($f,size) $s
6345 set fontattr($f,weight) normal
6346 set fontattr($f,slant) roman
6347 foreach style [lrange $n 2 end] {
6348 switch -- $style {
6349 "normal" -
6350 "bold" {set fontattr($f,weight) $style}
6351 "roman" -
6352 "italic" {set fontattr($f,slant) $style}
6357 proc fontflags {f {isbold 0}} {
6358 global fontattr
6360 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6361 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6362 -slant $fontattr($f,slant)]
6365 proc fontname {f} {
6366 global fontattr
6368 set n [list $fontattr($f,family) $fontattr($f,size)]
6369 if {$fontattr($f,weight) eq "bold"} {
6370 lappend n "bold"
6372 if {$fontattr($f,slant) eq "italic"} {
6373 lappend n "italic"
6375 return $n
6378 proc incrfont {inc} {
6379 global mainfont textfont ctext canv cflist showrefstop
6380 global stopped entries fontattr
6382 unmarkmatches
6383 set s $fontattr(mainfont,size)
6384 incr s $inc
6385 if {$s < 1} {
6386 set s 1
6388 set fontattr(mainfont,size) $s
6389 font config mainfont -size $s
6390 font config mainfontbold -size $s
6391 set mainfont [fontname mainfont]
6392 set s $fontattr(textfont,size)
6393 incr s $inc
6394 if {$s < 1} {
6395 set s 1
6397 set fontattr(textfont,size) $s
6398 font config textfont -size $s
6399 font config textfontbold -size $s
6400 set textfont [fontname textfont]
6401 setcoords
6402 settabs
6403 redisplay
6406 proc clearsha1 {} {
6407 global sha1entry sha1string
6408 if {[string length $sha1string] == 40} {
6409 $sha1entry delete 0 end
6413 proc sha1change {n1 n2 op} {
6414 global sha1string currentid sha1but
6415 if {$sha1string == {}
6416 || ([info exists currentid] && $sha1string == $currentid)} {
6417 set state disabled
6418 } else {
6419 set state normal
6421 if {[$sha1but cget -state] == $state} return
6422 if {$state == "normal"} {
6423 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6424 } else {
6425 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6429 proc gotocommit {} {
6430 global sha1string tagids headids curview varcid
6432 if {$sha1string == {}
6433 || ([info exists currentid] && $sha1string == $currentid)} return
6434 if {[info exists tagids($sha1string)]} {
6435 set id $tagids($sha1string)
6436 } elseif {[info exists headids($sha1string)]} {
6437 set id $headids($sha1string)
6438 } else {
6439 set id [string tolower $sha1string]
6440 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6441 set matches [array names varcid "$curview,$id*"]
6442 if {$matches ne {}} {
6443 if {[llength $matches] > 1} {
6444 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6445 return
6447 set id [lindex [split [lindex $matches 0] ","] 1]
6451 if {[commitinview $id $curview]} {
6452 selectline [rowofcommit $id] 1
6453 return
6455 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6456 set msg [mc "SHA1 id %s is not known" $sha1string]
6457 } else {
6458 set msg [mc "Tag/Head %s is not known" $sha1string]
6460 error_popup $msg
6463 proc lineenter {x y id} {
6464 global hoverx hovery hoverid hovertimer
6465 global commitinfo canv
6467 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6468 set hoverx $x
6469 set hovery $y
6470 set hoverid $id
6471 if {[info exists hovertimer]} {
6472 after cancel $hovertimer
6474 set hovertimer [after 500 linehover]
6475 $canv delete hover
6478 proc linemotion {x y id} {
6479 global hoverx hovery hoverid hovertimer
6481 if {[info exists hoverid] && $id == $hoverid} {
6482 set hoverx $x
6483 set hovery $y
6484 if {[info exists hovertimer]} {
6485 after cancel $hovertimer
6487 set hovertimer [after 500 linehover]
6491 proc lineleave {id} {
6492 global hoverid hovertimer canv
6494 if {[info exists hoverid] && $id == $hoverid} {
6495 $canv delete hover
6496 if {[info exists hovertimer]} {
6497 after cancel $hovertimer
6498 unset hovertimer
6500 unset hoverid
6504 proc linehover {} {
6505 global hoverx hovery hoverid hovertimer
6506 global canv linespc lthickness
6507 global commitinfo
6509 set text [lindex $commitinfo($hoverid) 0]
6510 set ymax [lindex [$canv cget -scrollregion] 3]
6511 if {$ymax == {}} return
6512 set yfrac [lindex [$canv yview] 0]
6513 set x [expr {$hoverx + 2 * $linespc}]
6514 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6515 set x0 [expr {$x - 2 * $lthickness}]
6516 set y0 [expr {$y - 2 * $lthickness}]
6517 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6518 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6519 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6520 -fill \#ffff80 -outline black -width 1 -tags hover]
6521 $canv raise $t
6522 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6523 -font mainfont]
6524 $canv raise $t
6527 proc clickisonarrow {id y} {
6528 global lthickness
6530 set ranges [rowranges $id]
6531 set thresh [expr {2 * $lthickness + 6}]
6532 set n [expr {[llength $ranges] - 1}]
6533 for {set i 1} {$i < $n} {incr i} {
6534 set row [lindex $ranges $i]
6535 if {abs([yc $row] - $y) < $thresh} {
6536 return $i
6539 return {}
6542 proc arrowjump {id n y} {
6543 global canv
6545 # 1 <-> 2, 3 <-> 4, etc...
6546 set n [expr {(($n - 1) ^ 1) + 1}]
6547 set row [lindex [rowranges $id] $n]
6548 set yt [yc $row]
6549 set ymax [lindex [$canv cget -scrollregion] 3]
6550 if {$ymax eq {} || $ymax <= 0} return
6551 set view [$canv yview]
6552 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6553 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6554 if {$yfrac < 0} {
6555 set yfrac 0
6557 allcanvs yview moveto $yfrac
6560 proc lineclick {x y id isnew} {
6561 global ctext commitinfo children canv thickerline curview
6563 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6564 unmarkmatches
6565 unselectline
6566 normalline
6567 $canv delete hover
6568 # draw this line thicker than normal
6569 set thickerline $id
6570 drawlines $id
6571 if {$isnew} {
6572 set ymax [lindex [$canv cget -scrollregion] 3]
6573 if {$ymax eq {}} return
6574 set yfrac [lindex [$canv yview] 0]
6575 set y [expr {$y + $yfrac * $ymax}]
6577 set dirn [clickisonarrow $id $y]
6578 if {$dirn ne {}} {
6579 arrowjump $id $dirn $y
6580 return
6583 if {$isnew} {
6584 addtohistory [list lineclick $x $y $id 0]
6586 # fill the details pane with info about this line
6587 $ctext conf -state normal
6588 clear_ctext
6589 settabs 0
6590 $ctext insert end "[mc "Parent"]:\t"
6591 $ctext insert end $id link0
6592 setlink $id link0
6593 set info $commitinfo($id)
6594 $ctext insert end "\n\t[lindex $info 0]\n"
6595 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6596 set date [formatdate [lindex $info 2]]
6597 $ctext insert end "\t[mc "Date"]:\t$date\n"
6598 set kids $children($curview,$id)
6599 if {$kids ne {}} {
6600 $ctext insert end "\n[mc "Children"]:"
6601 set i 0
6602 foreach child $kids {
6603 incr i
6604 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6605 set info $commitinfo($child)
6606 $ctext insert end "\n\t"
6607 $ctext insert end $child link$i
6608 setlink $child link$i
6609 $ctext insert end "\n\t[lindex $info 0]"
6610 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6611 set date [formatdate [lindex $info 2]]
6612 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6615 $ctext conf -state disabled
6616 init_flist {}
6619 proc normalline {} {
6620 global thickerline
6621 if {[info exists thickerline]} {
6622 set id $thickerline
6623 unset thickerline
6624 drawlines $id
6628 proc selbyid {id} {
6629 global curview
6630 if {[commitinview $id $curview]} {
6631 selectline [rowofcommit $id] 1
6635 proc mstime {} {
6636 global startmstime
6637 if {![info exists startmstime]} {
6638 set startmstime [clock clicks -milliseconds]
6640 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6643 proc rowmenu {x y id} {
6644 global rowctxmenu selectedline rowmenuid curview
6645 global nullid nullid2 fakerowmenu mainhead
6647 stopfinding
6648 set rowmenuid $id
6649 if {![info exists selectedline]
6650 || [rowofcommit $id] eq $selectedline} {
6651 set state disabled
6652 } else {
6653 set state normal
6655 if {$id ne $nullid && $id ne $nullid2} {
6656 set menu $rowctxmenu
6657 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6658 } else {
6659 set menu $fakerowmenu
6661 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6662 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6663 $menu entryconfigure [mc "Make patch"] -state $state
6664 tk_popup $menu $x $y
6667 proc diffvssel {dirn} {
6668 global rowmenuid selectedline
6670 if {![info exists selectedline]} return
6671 if {$dirn} {
6672 set oldid [commitonrow $selectedline]
6673 set newid $rowmenuid
6674 } else {
6675 set oldid $rowmenuid
6676 set newid [commitonrow $selectedline]
6678 addtohistory [list doseldiff $oldid $newid]
6679 doseldiff $oldid $newid
6682 proc doseldiff {oldid newid} {
6683 global ctext
6684 global commitinfo
6686 $ctext conf -state normal
6687 clear_ctext
6688 init_flist [mc "Top"]
6689 $ctext insert end "[mc "From"] "
6690 $ctext insert end $oldid link0
6691 setlink $oldid link0
6692 $ctext insert end "\n "
6693 $ctext insert end [lindex $commitinfo($oldid) 0]
6694 $ctext insert end "\n\n[mc "To"] "
6695 $ctext insert end $newid link1
6696 setlink $newid link1
6697 $ctext insert end "\n "
6698 $ctext insert end [lindex $commitinfo($newid) 0]
6699 $ctext insert end "\n"
6700 $ctext conf -state disabled
6701 $ctext tag remove found 1.0 end
6702 startdiff [list $oldid $newid]
6705 proc mkpatch {} {
6706 global rowmenuid currentid commitinfo patchtop patchnum
6708 if {![info exists currentid]} return
6709 set oldid $currentid
6710 set oldhead [lindex $commitinfo($oldid) 0]
6711 set newid $rowmenuid
6712 set newhead [lindex $commitinfo($newid) 0]
6713 set top .patch
6714 set patchtop $top
6715 catch {destroy $top}
6716 toplevel $top
6717 label $top.title -text [mc "Generate patch"]
6718 grid $top.title - -pady 10
6719 label $top.from -text [mc "From:"]
6720 entry $top.fromsha1 -width 40 -relief flat
6721 $top.fromsha1 insert 0 $oldid
6722 $top.fromsha1 conf -state readonly
6723 grid $top.from $top.fromsha1 -sticky w
6724 entry $top.fromhead -width 60 -relief flat
6725 $top.fromhead insert 0 $oldhead
6726 $top.fromhead conf -state readonly
6727 grid x $top.fromhead -sticky w
6728 label $top.to -text [mc "To:"]
6729 entry $top.tosha1 -width 40 -relief flat
6730 $top.tosha1 insert 0 $newid
6731 $top.tosha1 conf -state readonly
6732 grid $top.to $top.tosha1 -sticky w
6733 entry $top.tohead -width 60 -relief flat
6734 $top.tohead insert 0 $newhead
6735 $top.tohead conf -state readonly
6736 grid x $top.tohead -sticky w
6737 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6738 grid $top.rev x -pady 10
6739 label $top.flab -text [mc "Output file:"]
6740 entry $top.fname -width 60
6741 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6742 incr patchnum
6743 grid $top.flab $top.fname -sticky w
6744 frame $top.buts
6745 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6746 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6747 grid $top.buts.gen $top.buts.can
6748 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6749 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6750 grid $top.buts - -pady 10 -sticky ew
6751 focus $top.fname
6754 proc mkpatchrev {} {
6755 global patchtop
6757 set oldid [$patchtop.fromsha1 get]
6758 set oldhead [$patchtop.fromhead get]
6759 set newid [$patchtop.tosha1 get]
6760 set newhead [$patchtop.tohead get]
6761 foreach e [list fromsha1 fromhead tosha1 tohead] \
6762 v [list $newid $newhead $oldid $oldhead] {
6763 $patchtop.$e conf -state normal
6764 $patchtop.$e delete 0 end
6765 $patchtop.$e insert 0 $v
6766 $patchtop.$e conf -state readonly
6770 proc mkpatchgo {} {
6771 global patchtop nullid nullid2
6773 set oldid [$patchtop.fromsha1 get]
6774 set newid [$patchtop.tosha1 get]
6775 set fname [$patchtop.fname get]
6776 set cmd [diffcmd [list $oldid $newid] -p]
6777 # trim off the initial "|"
6778 set cmd [lrange $cmd 1 end]
6779 lappend cmd >$fname &
6780 if {[catch {eval exec $cmd} err]} {
6781 error_popup "[mc "Error creating patch:"] $err"
6783 catch {destroy $patchtop}
6784 unset patchtop
6787 proc mkpatchcan {} {
6788 global patchtop
6790 catch {destroy $patchtop}
6791 unset patchtop
6794 proc mktag {} {
6795 global rowmenuid mktagtop commitinfo
6797 set top .maketag
6798 set mktagtop $top
6799 catch {destroy $top}
6800 toplevel $top
6801 label $top.title -text [mc "Create tag"]
6802 grid $top.title - -pady 10
6803 label $top.id -text [mc "ID:"]
6804 entry $top.sha1 -width 40 -relief flat
6805 $top.sha1 insert 0 $rowmenuid
6806 $top.sha1 conf -state readonly
6807 grid $top.id $top.sha1 -sticky w
6808 entry $top.head -width 60 -relief flat
6809 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6810 $top.head conf -state readonly
6811 grid x $top.head -sticky w
6812 label $top.tlab -text [mc "Tag name:"]
6813 entry $top.tag -width 60
6814 grid $top.tlab $top.tag -sticky w
6815 frame $top.buts
6816 button $top.buts.gen -text [mc "Create"] -command mktaggo
6817 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6818 grid $top.buts.gen $top.buts.can
6819 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6820 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6821 grid $top.buts - -pady 10 -sticky ew
6822 focus $top.tag
6825 proc domktag {} {
6826 global mktagtop env tagids idtags
6828 set id [$mktagtop.sha1 get]
6829 set tag [$mktagtop.tag get]
6830 if {$tag == {}} {
6831 error_popup [mc "No tag name specified"]
6832 return
6834 if {[info exists tagids($tag)]} {
6835 error_popup [mc "Tag \"%s\" already exists" $tag]
6836 return
6838 if {[catch {
6839 set dir [gitdir]
6840 set fname [file join $dir "refs/tags" $tag]
6841 set f [open $fname w]
6842 puts $f $id
6843 close $f
6844 } err]} {
6845 error_popup "[mc "Error creating tag:"] $err"
6846 return
6849 set tagids($tag) $id
6850 lappend idtags($id) $tag
6851 redrawtags $id
6852 addedtag $id
6853 dispneartags 0
6854 run refill_reflist
6857 proc redrawtags {id} {
6858 global canv linehtag idpos currentid curview
6859 global canvxmax iddrawn
6861 if {![commitinview $id $curview]} return
6862 if {![info exists iddrawn($id)]} return
6863 set row [rowofcommit $id]
6864 $canv delete tag.$id
6865 set xt [eval drawtags $id $idpos($id)]
6866 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6867 set text [$canv itemcget $linehtag($row) -text]
6868 set font [$canv itemcget $linehtag($row) -font]
6869 set xr [expr {$xt + [font measure $font $text]}]
6870 if {$xr > $canvxmax} {
6871 set canvxmax $xr
6872 setcanvscroll
6874 if {[info exists currentid] && $currentid == $id} {
6875 make_secsel $row
6879 proc mktagcan {} {
6880 global mktagtop
6882 catch {destroy $mktagtop}
6883 unset mktagtop
6886 proc mktaggo {} {
6887 domktag
6888 mktagcan
6891 proc writecommit {} {
6892 global rowmenuid wrcomtop commitinfo wrcomcmd
6894 set top .writecommit
6895 set wrcomtop $top
6896 catch {destroy $top}
6897 toplevel $top
6898 label $top.title -text [mc "Write commit to file"]
6899 grid $top.title - -pady 10
6900 label $top.id -text [mc "ID:"]
6901 entry $top.sha1 -width 40 -relief flat
6902 $top.sha1 insert 0 $rowmenuid
6903 $top.sha1 conf -state readonly
6904 grid $top.id $top.sha1 -sticky w
6905 entry $top.head -width 60 -relief flat
6906 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6907 $top.head conf -state readonly
6908 grid x $top.head -sticky w
6909 label $top.clab -text [mc "Command:"]
6910 entry $top.cmd -width 60 -textvariable wrcomcmd
6911 grid $top.clab $top.cmd -sticky w -pady 10
6912 label $top.flab -text [mc "Output file:"]
6913 entry $top.fname -width 60
6914 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6915 grid $top.flab $top.fname -sticky w
6916 frame $top.buts
6917 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6918 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6919 grid $top.buts.gen $top.buts.can
6920 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6921 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6922 grid $top.buts - -pady 10 -sticky ew
6923 focus $top.fname
6926 proc wrcomgo {} {
6927 global wrcomtop
6929 set id [$wrcomtop.sha1 get]
6930 set cmd "echo $id | [$wrcomtop.cmd get]"
6931 set fname [$wrcomtop.fname get]
6932 if {[catch {exec sh -c $cmd >$fname &} err]} {
6933 error_popup "[mc "Error writing commit:"] $err"
6935 catch {destroy $wrcomtop}
6936 unset wrcomtop
6939 proc wrcomcan {} {
6940 global wrcomtop
6942 catch {destroy $wrcomtop}
6943 unset wrcomtop
6946 proc mkbranch {} {
6947 global rowmenuid mkbrtop
6949 set top .makebranch
6950 catch {destroy $top}
6951 toplevel $top
6952 label $top.title -text [mc "Create new branch"]
6953 grid $top.title - -pady 10
6954 label $top.id -text [mc "ID:"]
6955 entry $top.sha1 -width 40 -relief flat
6956 $top.sha1 insert 0 $rowmenuid
6957 $top.sha1 conf -state readonly
6958 grid $top.id $top.sha1 -sticky w
6959 label $top.nlab -text [mc "Name:"]
6960 entry $top.name -width 40
6961 grid $top.nlab $top.name -sticky w
6962 frame $top.buts
6963 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6964 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6965 grid $top.buts.go $top.buts.can
6966 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6967 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6968 grid $top.buts - -pady 10 -sticky ew
6969 focus $top.name
6972 proc mkbrgo {top} {
6973 global headids idheads
6975 set name [$top.name get]
6976 set id [$top.sha1 get]
6977 if {$name eq {}} {
6978 error_popup [mc "Please specify a name for the new branch"]
6979 return
6981 catch {destroy $top}
6982 nowbusy newbranch
6983 update
6984 if {[catch {
6985 exec git branch $name $id
6986 } err]} {
6987 notbusy newbranch
6988 error_popup $err
6989 } else {
6990 set headids($name) $id
6991 lappend idheads($id) $name
6992 addedhead $id $name
6993 notbusy newbranch
6994 redrawtags $id
6995 dispneartags 0
6996 run refill_reflist
7000 proc cherrypick {} {
7001 global rowmenuid curview
7002 global mainhead
7004 set oldhead [exec git rev-parse HEAD]
7005 set dheads [descheads $rowmenuid]
7006 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7007 set ok [confirm_popup [mc "Commit %s is already\
7008 included in branch %s -- really re-apply it?" \
7009 [string range $rowmenuid 0 7] $mainhead]]
7010 if {!$ok} return
7012 nowbusy cherrypick [mc "Cherry-picking"]
7013 update
7014 # Unfortunately git-cherry-pick writes stuff to stderr even when
7015 # no error occurs, and exec takes that as an indication of error...
7016 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7017 notbusy cherrypick
7018 error_popup $err
7019 return
7021 set newhead [exec git rev-parse HEAD]
7022 if {$newhead eq $oldhead} {
7023 notbusy cherrypick
7024 error_popup [mc "No changes committed"]
7025 return
7027 addnewchild $newhead $oldhead
7028 if {[commitinview $oldhead $curview]} {
7029 insertrow $newhead $oldhead $curview
7030 if {$mainhead ne {}} {
7031 movehead $newhead $mainhead
7032 movedhead $newhead $mainhead
7034 redrawtags $oldhead
7035 redrawtags $newhead
7037 notbusy cherrypick
7040 proc resethead {} {
7041 global mainheadid mainhead rowmenuid confirm_ok resettype
7043 set confirm_ok 0
7044 set w ".confirmreset"
7045 toplevel $w
7046 wm transient $w .
7047 wm title $w [mc "Confirm reset"]
7048 message $w.m -text \
7049 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7050 -justify center -aspect 1000
7051 pack $w.m -side top -fill x -padx 20 -pady 20
7052 frame $w.f -relief sunken -border 2
7053 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7054 grid $w.f.rt -sticky w
7055 set resettype mixed
7056 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7057 -text [mc "Soft: Leave working tree and index untouched"]
7058 grid $w.f.soft -sticky w
7059 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7060 -text [mc "Mixed: Leave working tree untouched, reset index"]
7061 grid $w.f.mixed -sticky w
7062 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7063 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7064 grid $w.f.hard -sticky w
7065 pack $w.f -side top -fill x
7066 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7067 pack $w.ok -side left -fill x -padx 20 -pady 20
7068 button $w.cancel -text [mc Cancel] -command "destroy $w"
7069 pack $w.cancel -side right -fill x -padx 20 -pady 20
7070 bind $w <Visibility> "grab $w; focus $w"
7071 tkwait window $w
7072 if {!$confirm_ok} return
7073 if {[catch {set fd [open \
7074 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7075 error_popup $err
7076 } else {
7077 dohidelocalchanges
7078 filerun $fd [list readresetstat $fd]
7079 nowbusy reset [mc "Resetting"]
7083 proc readresetstat {fd} {
7084 global mainhead mainheadid showlocalchanges rprogcoord
7086 if {[gets $fd line] >= 0} {
7087 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7088 set rprogcoord [expr {1.0 * $m / $n}]
7089 adjustprogress
7091 return 1
7093 set rprogcoord 0
7094 adjustprogress
7095 notbusy reset
7096 if {[catch {close $fd} err]} {
7097 error_popup $err
7099 set oldhead $mainheadid
7100 set newhead [exec git rev-parse HEAD]
7101 if {$newhead ne $oldhead} {
7102 movehead $newhead $mainhead
7103 movedhead $newhead $mainhead
7104 set mainheadid $newhead
7105 redrawtags $oldhead
7106 redrawtags $newhead
7108 if {$showlocalchanges} {
7109 doshowlocalchanges
7111 return 0
7114 # context menu for a head
7115 proc headmenu {x y id head} {
7116 global headmenuid headmenuhead headctxmenu mainhead
7118 stopfinding
7119 set headmenuid $id
7120 set headmenuhead $head
7121 set state normal
7122 if {$head eq $mainhead} {
7123 set state disabled
7125 $headctxmenu entryconfigure 0 -state $state
7126 $headctxmenu entryconfigure 1 -state $state
7127 tk_popup $headctxmenu $x $y
7130 proc cobranch {} {
7131 global headmenuid headmenuhead mainhead headids
7132 global showlocalchanges mainheadid
7134 # check the tree is clean first??
7135 set oldmainhead $mainhead
7136 nowbusy checkout [mc "Checking out"]
7137 update
7138 dohidelocalchanges
7139 if {[catch {
7140 exec git checkout -q $headmenuhead
7141 } err]} {
7142 notbusy checkout
7143 error_popup $err
7144 } else {
7145 notbusy checkout
7146 set mainhead $headmenuhead
7147 set mainheadid $headmenuid
7148 if {[info exists headids($oldmainhead)]} {
7149 redrawtags $headids($oldmainhead)
7151 redrawtags $headmenuid
7153 if {$showlocalchanges} {
7154 dodiffindex
7158 proc rmbranch {} {
7159 global headmenuid headmenuhead mainhead
7160 global idheads
7162 set head $headmenuhead
7163 set id $headmenuid
7164 # this check shouldn't be needed any more...
7165 if {$head eq $mainhead} {
7166 error_popup [mc "Cannot delete the currently checked-out branch"]
7167 return
7169 set dheads [descheads $id]
7170 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7171 # the stuff on this branch isn't on any other branch
7172 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7173 branch.\nReally delete branch %s?" $head $head]]} return
7175 nowbusy rmbranch
7176 update
7177 if {[catch {exec git branch -D $head} err]} {
7178 notbusy rmbranch
7179 error_popup $err
7180 return
7182 removehead $id $head
7183 removedhead $id $head
7184 redrawtags $id
7185 notbusy rmbranch
7186 dispneartags 0
7187 run refill_reflist
7190 # Display a list of tags and heads
7191 proc showrefs {} {
7192 global showrefstop bgcolor fgcolor selectbgcolor
7193 global bglist fglist reflistfilter reflist maincursor
7195 set top .showrefs
7196 set showrefstop $top
7197 if {[winfo exists $top]} {
7198 raise $top
7199 refill_reflist
7200 return
7202 toplevel $top
7203 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7204 text $top.list -background $bgcolor -foreground $fgcolor \
7205 -selectbackground $selectbgcolor -font mainfont \
7206 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7207 -width 30 -height 20 -cursor $maincursor \
7208 -spacing1 1 -spacing3 1 -state disabled
7209 $top.list tag configure highlight -background $selectbgcolor
7210 lappend bglist $top.list
7211 lappend fglist $top.list
7212 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7213 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7214 grid $top.list $top.ysb -sticky nsew
7215 grid $top.xsb x -sticky ew
7216 frame $top.f
7217 label $top.f.l -text "[mc "Filter"]: "
7218 entry $top.f.e -width 20 -textvariable reflistfilter
7219 set reflistfilter "*"
7220 trace add variable reflistfilter write reflistfilter_change
7221 pack $top.f.e -side right -fill x -expand 1
7222 pack $top.f.l -side left
7223 grid $top.f - -sticky ew -pady 2
7224 button $top.close -command [list destroy $top] -text [mc "Close"]
7225 grid $top.close -
7226 grid columnconfigure $top 0 -weight 1
7227 grid rowconfigure $top 0 -weight 1
7228 bind $top.list <1> {break}
7229 bind $top.list <B1-Motion> {break}
7230 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7231 set reflist {}
7232 refill_reflist
7235 proc sel_reflist {w x y} {
7236 global showrefstop reflist headids tagids otherrefids
7238 if {![winfo exists $showrefstop]} return
7239 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7240 set ref [lindex $reflist [expr {$l-1}]]
7241 set n [lindex $ref 0]
7242 switch -- [lindex $ref 1] {
7243 "H" {selbyid $headids($n)}
7244 "T" {selbyid $tagids($n)}
7245 "o" {selbyid $otherrefids($n)}
7247 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7250 proc unsel_reflist {} {
7251 global showrefstop
7253 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7254 $showrefstop.list tag remove highlight 0.0 end
7257 proc reflistfilter_change {n1 n2 op} {
7258 global reflistfilter
7260 after cancel refill_reflist
7261 after 200 refill_reflist
7264 proc refill_reflist {} {
7265 global reflist reflistfilter showrefstop headids tagids otherrefids
7266 global curview commitinterest
7268 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7269 set refs {}
7270 foreach n [array names headids] {
7271 if {[string match $reflistfilter $n]} {
7272 if {[commitinview $headids($n) $curview]} {
7273 lappend refs [list $n H]
7274 } else {
7275 set commitinterest($headids($n)) {run refill_reflist}
7279 foreach n [array names tagids] {
7280 if {[string match $reflistfilter $n]} {
7281 if {[commitinview $tagids($n) $curview]} {
7282 lappend refs [list $n T]
7283 } else {
7284 set commitinterest($tagids($n)) {run refill_reflist}
7288 foreach n [array names otherrefids] {
7289 if {[string match $reflistfilter $n]} {
7290 if {[commitinview $otherrefids($n) $curview]} {
7291 lappend refs [list $n o]
7292 } else {
7293 set commitinterest($otherrefids($n)) {run refill_reflist}
7297 set refs [lsort -index 0 $refs]
7298 if {$refs eq $reflist} return
7300 # Update the contents of $showrefstop.list according to the
7301 # differences between $reflist (old) and $refs (new)
7302 $showrefstop.list conf -state normal
7303 $showrefstop.list insert end "\n"
7304 set i 0
7305 set j 0
7306 while {$i < [llength $reflist] || $j < [llength $refs]} {
7307 if {$i < [llength $reflist]} {
7308 if {$j < [llength $refs]} {
7309 set cmp [string compare [lindex $reflist $i 0] \
7310 [lindex $refs $j 0]]
7311 if {$cmp == 0} {
7312 set cmp [string compare [lindex $reflist $i 1] \
7313 [lindex $refs $j 1]]
7315 } else {
7316 set cmp -1
7318 } else {
7319 set cmp 1
7321 switch -- $cmp {
7322 -1 {
7323 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7324 incr i
7327 incr i
7328 incr j
7331 set l [expr {$j + 1}]
7332 $showrefstop.list image create $l.0 -align baseline \
7333 -image reficon-[lindex $refs $j 1] -padx 2
7334 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7335 incr j
7339 set reflist $refs
7340 # delete last newline
7341 $showrefstop.list delete end-2c end-1c
7342 $showrefstop.list conf -state disabled
7345 # Stuff for finding nearby tags
7346 proc getallcommits {} {
7347 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7348 global idheads idtags idotherrefs allparents tagobjid
7350 if {![info exists allcommits]} {
7351 set nextarc 0
7352 set allcommits 0
7353 set seeds {}
7354 set allcwait 0
7355 set cachedarcs 0
7356 set allccache [file join [gitdir] "gitk.cache"]
7357 if {![catch {
7358 set f [open $allccache r]
7359 set allcwait 1
7360 getcache $f
7361 }]} return
7364 if {$allcwait} {
7365 return
7367 set cmd [list | git rev-list --parents]
7368 set allcupdate [expr {$seeds ne {}}]
7369 if {!$allcupdate} {
7370 set ids "--all"
7371 } else {
7372 set refs [concat [array names idheads] [array names idtags] \
7373 [array names idotherrefs]]
7374 set ids {}
7375 set tagobjs {}
7376 foreach name [array names tagobjid] {
7377 lappend tagobjs $tagobjid($name)
7379 foreach id [lsort -unique $refs] {
7380 if {![info exists allparents($id)] &&
7381 [lsearch -exact $tagobjs $id] < 0} {
7382 lappend ids $id
7385 if {$ids ne {}} {
7386 foreach id $seeds {
7387 lappend ids "^$id"
7391 if {$ids ne {}} {
7392 set fd [open [concat $cmd $ids] r]
7393 fconfigure $fd -blocking 0
7394 incr allcommits
7395 nowbusy allcommits
7396 filerun $fd [list getallclines $fd]
7397 } else {
7398 dispneartags 0
7402 # Since most commits have 1 parent and 1 child, we group strings of
7403 # such commits into "arcs" joining branch/merge points (BMPs), which
7404 # are commits that either don't have 1 parent or don't have 1 child.
7406 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7407 # arcout(id) - outgoing arcs for BMP
7408 # arcids(a) - list of IDs on arc including end but not start
7409 # arcstart(a) - BMP ID at start of arc
7410 # arcend(a) - BMP ID at end of arc
7411 # growing(a) - arc a is still growing
7412 # arctags(a) - IDs out of arcids (excluding end) that have tags
7413 # archeads(a) - IDs out of arcids (excluding end) that have heads
7414 # The start of an arc is at the descendent end, so "incoming" means
7415 # coming from descendents, and "outgoing" means going towards ancestors.
7417 proc getallclines {fd} {
7418 global allparents allchildren idtags idheads nextarc
7419 global arcnos arcids arctags arcout arcend arcstart archeads growing
7420 global seeds allcommits cachedarcs allcupdate
7422 set nid 0
7423 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7424 set id [lindex $line 0]
7425 if {[info exists allparents($id)]} {
7426 # seen it already
7427 continue
7429 set cachedarcs 0
7430 set olds [lrange $line 1 end]
7431 set allparents($id) $olds
7432 if {![info exists allchildren($id)]} {
7433 set allchildren($id) {}
7434 set arcnos($id) {}
7435 lappend seeds $id
7436 } else {
7437 set a $arcnos($id)
7438 if {[llength $olds] == 1 && [llength $a] == 1} {
7439 lappend arcids($a) $id
7440 if {[info exists idtags($id)]} {
7441 lappend arctags($a) $id
7443 if {[info exists idheads($id)]} {
7444 lappend archeads($a) $id
7446 if {[info exists allparents($olds)]} {
7447 # seen parent already
7448 if {![info exists arcout($olds)]} {
7449 splitarc $olds
7451 lappend arcids($a) $olds
7452 set arcend($a) $olds
7453 unset growing($a)
7455 lappend allchildren($olds) $id
7456 lappend arcnos($olds) $a
7457 continue
7460 foreach a $arcnos($id) {
7461 lappend arcids($a) $id
7462 set arcend($a) $id
7463 unset growing($a)
7466 set ao {}
7467 foreach p $olds {
7468 lappend allchildren($p) $id
7469 set a [incr nextarc]
7470 set arcstart($a) $id
7471 set archeads($a) {}
7472 set arctags($a) {}
7473 set archeads($a) {}
7474 set arcids($a) {}
7475 lappend ao $a
7476 set growing($a) 1
7477 if {[info exists allparents($p)]} {
7478 # seen it already, may need to make a new branch
7479 if {![info exists arcout($p)]} {
7480 splitarc $p
7482 lappend arcids($a) $p
7483 set arcend($a) $p
7484 unset growing($a)
7486 lappend arcnos($p) $a
7488 set arcout($id) $ao
7490 if {$nid > 0} {
7491 global cached_dheads cached_dtags cached_atags
7492 catch {unset cached_dheads}
7493 catch {unset cached_dtags}
7494 catch {unset cached_atags}
7496 if {![eof $fd]} {
7497 return [expr {$nid >= 1000? 2: 1}]
7499 set cacheok 1
7500 if {[catch {
7501 fconfigure $fd -blocking 1
7502 close $fd
7503 } err]} {
7504 # got an error reading the list of commits
7505 # if we were updating, try rereading the whole thing again
7506 if {$allcupdate} {
7507 incr allcommits -1
7508 dropcache $err
7509 return
7511 error_popup "[mc "Error reading commit topology information;\
7512 branch and preceding/following tag information\
7513 will be incomplete."]\n($err)"
7514 set cacheok 0
7516 if {[incr allcommits -1] == 0} {
7517 notbusy allcommits
7518 if {$cacheok} {
7519 run savecache
7522 dispneartags 0
7523 return 0
7526 proc recalcarc {a} {
7527 global arctags archeads arcids idtags idheads
7529 set at {}
7530 set ah {}
7531 foreach id [lrange $arcids($a) 0 end-1] {
7532 if {[info exists idtags($id)]} {
7533 lappend at $id
7535 if {[info exists idheads($id)]} {
7536 lappend ah $id
7539 set arctags($a) $at
7540 set archeads($a) $ah
7543 proc splitarc {p} {
7544 global arcnos arcids nextarc arctags archeads idtags idheads
7545 global arcstart arcend arcout allparents growing
7547 set a $arcnos($p)
7548 if {[llength $a] != 1} {
7549 puts "oops splitarc called but [llength $a] arcs already"
7550 return
7552 set a [lindex $a 0]
7553 set i [lsearch -exact $arcids($a) $p]
7554 if {$i < 0} {
7555 puts "oops splitarc $p not in arc $a"
7556 return
7558 set na [incr nextarc]
7559 if {[info exists arcend($a)]} {
7560 set arcend($na) $arcend($a)
7561 } else {
7562 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7563 set j [lsearch -exact $arcnos($l) $a]
7564 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7566 set tail [lrange $arcids($a) [expr {$i+1}] end]
7567 set arcids($a) [lrange $arcids($a) 0 $i]
7568 set arcend($a) $p
7569 set arcstart($na) $p
7570 set arcout($p) $na
7571 set arcids($na) $tail
7572 if {[info exists growing($a)]} {
7573 set growing($na) 1
7574 unset growing($a)
7577 foreach id $tail {
7578 if {[llength $arcnos($id)] == 1} {
7579 set arcnos($id) $na
7580 } else {
7581 set j [lsearch -exact $arcnos($id) $a]
7582 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7586 # reconstruct tags and heads lists
7587 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7588 recalcarc $a
7589 recalcarc $na
7590 } else {
7591 set arctags($na) {}
7592 set archeads($na) {}
7596 # Update things for a new commit added that is a child of one
7597 # existing commit. Used when cherry-picking.
7598 proc addnewchild {id p} {
7599 global allparents allchildren idtags nextarc
7600 global arcnos arcids arctags arcout arcend arcstart archeads growing
7601 global seeds allcommits
7603 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7604 set allparents($id) [list $p]
7605 set allchildren($id) {}
7606 set arcnos($id) {}
7607 lappend seeds $id
7608 lappend allchildren($p) $id
7609 set a [incr nextarc]
7610 set arcstart($a) $id
7611 set archeads($a) {}
7612 set arctags($a) {}
7613 set arcids($a) [list $p]
7614 set arcend($a) $p
7615 if {![info exists arcout($p)]} {
7616 splitarc $p
7618 lappend arcnos($p) $a
7619 set arcout($id) [list $a]
7622 # This implements a cache for the topology information.
7623 # The cache saves, for each arc, the start and end of the arc,
7624 # the ids on the arc, and the outgoing arcs from the end.
7625 proc readcache {f} {
7626 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7627 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7628 global allcwait
7630 set a $nextarc
7631 set lim $cachedarcs
7632 if {$lim - $a > 500} {
7633 set lim [expr {$a + 500}]
7635 if {[catch {
7636 if {$a == $lim} {
7637 # finish reading the cache and setting up arctags, etc.
7638 set line [gets $f]
7639 if {$line ne "1"} {error "bad final version"}
7640 close $f
7641 foreach id [array names idtags] {
7642 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7643 [llength $allparents($id)] == 1} {
7644 set a [lindex $arcnos($id) 0]
7645 if {$arctags($a) eq {}} {
7646 recalcarc $a
7650 foreach id [array names idheads] {
7651 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7652 [llength $allparents($id)] == 1} {
7653 set a [lindex $arcnos($id) 0]
7654 if {$archeads($a) eq {}} {
7655 recalcarc $a
7659 foreach id [lsort -unique $possible_seeds] {
7660 if {$arcnos($id) eq {}} {
7661 lappend seeds $id
7664 set allcwait 0
7665 } else {
7666 while {[incr a] <= $lim} {
7667 set line [gets $f]
7668 if {[llength $line] != 3} {error "bad line"}
7669 set s [lindex $line 0]
7670 set arcstart($a) $s
7671 lappend arcout($s) $a
7672 if {![info exists arcnos($s)]} {
7673 lappend possible_seeds $s
7674 set arcnos($s) {}
7676 set e [lindex $line 1]
7677 if {$e eq {}} {
7678 set growing($a) 1
7679 } else {
7680 set arcend($a) $e
7681 if {![info exists arcout($e)]} {
7682 set arcout($e) {}
7685 set arcids($a) [lindex $line 2]
7686 foreach id $arcids($a) {
7687 lappend allparents($s) $id
7688 set s $id
7689 lappend arcnos($id) $a
7691 if {![info exists allparents($s)]} {
7692 set allparents($s) {}
7694 set arctags($a) {}
7695 set archeads($a) {}
7697 set nextarc [expr {$a - 1}]
7699 } err]} {
7700 dropcache $err
7701 return 0
7703 if {!$allcwait} {
7704 getallcommits
7706 return $allcwait
7709 proc getcache {f} {
7710 global nextarc cachedarcs possible_seeds
7712 if {[catch {
7713 set line [gets $f]
7714 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7715 # make sure it's an integer
7716 set cachedarcs [expr {int([lindex $line 1])}]
7717 if {$cachedarcs < 0} {error "bad number of arcs"}
7718 set nextarc 0
7719 set possible_seeds {}
7720 run readcache $f
7721 } err]} {
7722 dropcache $err
7724 return 0
7727 proc dropcache {err} {
7728 global allcwait nextarc cachedarcs seeds
7730 #puts "dropping cache ($err)"
7731 foreach v {arcnos arcout arcids arcstart arcend growing \
7732 arctags archeads allparents allchildren} {
7733 global $v
7734 catch {unset $v}
7736 set allcwait 0
7737 set nextarc 0
7738 set cachedarcs 0
7739 set seeds {}
7740 getallcommits
7743 proc writecache {f} {
7744 global cachearc cachedarcs allccache
7745 global arcstart arcend arcnos arcids arcout
7747 set a $cachearc
7748 set lim $cachedarcs
7749 if {$lim - $a > 1000} {
7750 set lim [expr {$a + 1000}]
7752 if {[catch {
7753 while {[incr a] <= $lim} {
7754 if {[info exists arcend($a)]} {
7755 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7756 } else {
7757 puts $f [list $arcstart($a) {} $arcids($a)]
7760 } err]} {
7761 catch {close $f}
7762 catch {file delete $allccache}
7763 #puts "writing cache failed ($err)"
7764 return 0
7766 set cachearc [expr {$a - 1}]
7767 if {$a > $cachedarcs} {
7768 puts $f "1"
7769 close $f
7770 return 0
7772 return 1
7775 proc savecache {} {
7776 global nextarc cachedarcs cachearc allccache
7778 if {$nextarc == $cachedarcs} return
7779 set cachearc 0
7780 set cachedarcs $nextarc
7781 catch {
7782 set f [open $allccache w]
7783 puts $f [list 1 $cachedarcs]
7784 run writecache $f
7788 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7789 # or 0 if neither is true.
7790 proc anc_or_desc {a b} {
7791 global arcout arcstart arcend arcnos cached_isanc
7793 if {$arcnos($a) eq $arcnos($b)} {
7794 # Both are on the same arc(s); either both are the same BMP,
7795 # or if one is not a BMP, the other is also not a BMP or is
7796 # the BMP at end of the arc (and it only has 1 incoming arc).
7797 # Or both can be BMPs with no incoming arcs.
7798 if {$a eq $b || $arcnos($a) eq {}} {
7799 return 0
7801 # assert {[llength $arcnos($a)] == 1}
7802 set arc [lindex $arcnos($a) 0]
7803 set i [lsearch -exact $arcids($arc) $a]
7804 set j [lsearch -exact $arcids($arc) $b]
7805 if {$i < 0 || $i > $j} {
7806 return 1
7807 } else {
7808 return -1
7812 if {![info exists arcout($a)]} {
7813 set arc [lindex $arcnos($a) 0]
7814 if {[info exists arcend($arc)]} {
7815 set aend $arcend($arc)
7816 } else {
7817 set aend {}
7819 set a $arcstart($arc)
7820 } else {
7821 set aend $a
7823 if {![info exists arcout($b)]} {
7824 set arc [lindex $arcnos($b) 0]
7825 if {[info exists arcend($arc)]} {
7826 set bend $arcend($arc)
7827 } else {
7828 set bend {}
7830 set b $arcstart($arc)
7831 } else {
7832 set bend $b
7834 if {$a eq $bend} {
7835 return 1
7837 if {$b eq $aend} {
7838 return -1
7840 if {[info exists cached_isanc($a,$bend)]} {
7841 if {$cached_isanc($a,$bend)} {
7842 return 1
7845 if {[info exists cached_isanc($b,$aend)]} {
7846 if {$cached_isanc($b,$aend)} {
7847 return -1
7849 if {[info exists cached_isanc($a,$bend)]} {
7850 return 0
7854 set todo [list $a $b]
7855 set anc($a) a
7856 set anc($b) b
7857 for {set i 0} {$i < [llength $todo]} {incr i} {
7858 set x [lindex $todo $i]
7859 if {$anc($x) eq {}} {
7860 continue
7862 foreach arc $arcnos($x) {
7863 set xd $arcstart($arc)
7864 if {$xd eq $bend} {
7865 set cached_isanc($a,$bend) 1
7866 set cached_isanc($b,$aend) 0
7867 return 1
7868 } elseif {$xd eq $aend} {
7869 set cached_isanc($b,$aend) 1
7870 set cached_isanc($a,$bend) 0
7871 return -1
7873 if {![info exists anc($xd)]} {
7874 set anc($xd) $anc($x)
7875 lappend todo $xd
7876 } elseif {$anc($xd) ne $anc($x)} {
7877 set anc($xd) {}
7881 set cached_isanc($a,$bend) 0
7882 set cached_isanc($b,$aend) 0
7883 return 0
7886 # This identifies whether $desc has an ancestor that is
7887 # a growing tip of the graph and which is not an ancestor of $anc
7888 # and returns 0 if so and 1 if not.
7889 # If we subsequently discover a tag on such a growing tip, and that
7890 # turns out to be a descendent of $anc (which it could, since we
7891 # don't necessarily see children before parents), then $desc
7892 # isn't a good choice to display as a descendent tag of
7893 # $anc (since it is the descendent of another tag which is
7894 # a descendent of $anc). Similarly, $anc isn't a good choice to
7895 # display as a ancestor tag of $desc.
7897 proc is_certain {desc anc} {
7898 global arcnos arcout arcstart arcend growing problems
7900 set certain {}
7901 if {[llength $arcnos($anc)] == 1} {
7902 # tags on the same arc are certain
7903 if {$arcnos($desc) eq $arcnos($anc)} {
7904 return 1
7906 if {![info exists arcout($anc)]} {
7907 # if $anc is partway along an arc, use the start of the arc instead
7908 set a [lindex $arcnos($anc) 0]
7909 set anc $arcstart($a)
7912 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7913 set x $desc
7914 } else {
7915 set a [lindex $arcnos($desc) 0]
7916 set x $arcend($a)
7918 if {$x == $anc} {
7919 return 1
7921 set anclist [list $x]
7922 set dl($x) 1
7923 set nnh 1
7924 set ngrowanc 0
7925 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7926 set x [lindex $anclist $i]
7927 if {$dl($x)} {
7928 incr nnh -1
7930 set done($x) 1
7931 foreach a $arcout($x) {
7932 if {[info exists growing($a)]} {
7933 if {![info exists growanc($x)] && $dl($x)} {
7934 set growanc($x) 1
7935 incr ngrowanc
7937 } else {
7938 set y $arcend($a)
7939 if {[info exists dl($y)]} {
7940 if {$dl($y)} {
7941 if {!$dl($x)} {
7942 set dl($y) 0
7943 if {![info exists done($y)]} {
7944 incr nnh -1
7946 if {[info exists growanc($x)]} {
7947 incr ngrowanc -1
7949 set xl [list $y]
7950 for {set k 0} {$k < [llength $xl]} {incr k} {
7951 set z [lindex $xl $k]
7952 foreach c $arcout($z) {
7953 if {[info exists arcend($c)]} {
7954 set v $arcend($c)
7955 if {[info exists dl($v)] && $dl($v)} {
7956 set dl($v) 0
7957 if {![info exists done($v)]} {
7958 incr nnh -1
7960 if {[info exists growanc($v)]} {
7961 incr ngrowanc -1
7963 lappend xl $v
7970 } elseif {$y eq $anc || !$dl($x)} {
7971 set dl($y) 0
7972 lappend anclist $y
7973 } else {
7974 set dl($y) 1
7975 lappend anclist $y
7976 incr nnh
7981 foreach x [array names growanc] {
7982 if {$dl($x)} {
7983 return 0
7985 return 0
7987 return 1
7990 proc validate_arctags {a} {
7991 global arctags idtags
7993 set i -1
7994 set na $arctags($a)
7995 foreach id $arctags($a) {
7996 incr i
7997 if {![info exists idtags($id)]} {
7998 set na [lreplace $na $i $i]
7999 incr i -1
8002 set arctags($a) $na
8005 proc validate_archeads {a} {
8006 global archeads idheads
8008 set i -1
8009 set na $archeads($a)
8010 foreach id $archeads($a) {
8011 incr i
8012 if {![info exists idheads($id)]} {
8013 set na [lreplace $na $i $i]
8014 incr i -1
8017 set archeads($a) $na
8020 # Return the list of IDs that have tags that are descendents of id,
8021 # ignoring IDs that are descendents of IDs already reported.
8022 proc desctags {id} {
8023 global arcnos arcstart arcids arctags idtags allparents
8024 global growing cached_dtags
8026 if {![info exists allparents($id)]} {
8027 return {}
8029 set t1 [clock clicks -milliseconds]
8030 set argid $id
8031 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8032 # part-way along an arc; check that arc first
8033 set a [lindex $arcnos($id) 0]
8034 if {$arctags($a) ne {}} {
8035 validate_arctags $a
8036 set i [lsearch -exact $arcids($a) $id]
8037 set tid {}
8038 foreach t $arctags($a) {
8039 set j [lsearch -exact $arcids($a) $t]
8040 if {$j >= $i} break
8041 set tid $t
8043 if {$tid ne {}} {
8044 return $tid
8047 set id $arcstart($a)
8048 if {[info exists idtags($id)]} {
8049 return $id
8052 if {[info exists cached_dtags($id)]} {
8053 return $cached_dtags($id)
8056 set origid $id
8057 set todo [list $id]
8058 set queued($id) 1
8059 set nc 1
8060 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8061 set id [lindex $todo $i]
8062 set done($id) 1
8063 set ta [info exists hastaggedancestor($id)]
8064 if {!$ta} {
8065 incr nc -1
8067 # ignore tags on starting node
8068 if {!$ta && $i > 0} {
8069 if {[info exists idtags($id)]} {
8070 set tagloc($id) $id
8071 set ta 1
8072 } elseif {[info exists cached_dtags($id)]} {
8073 set tagloc($id) $cached_dtags($id)
8074 set ta 1
8077 foreach a $arcnos($id) {
8078 set d $arcstart($a)
8079 if {!$ta && $arctags($a) ne {}} {
8080 validate_arctags $a
8081 if {$arctags($a) ne {}} {
8082 lappend tagloc($id) [lindex $arctags($a) end]
8085 if {$ta || $arctags($a) ne {}} {
8086 set tomark [list $d]
8087 for {set j 0} {$j < [llength $tomark]} {incr j} {
8088 set dd [lindex $tomark $j]
8089 if {![info exists hastaggedancestor($dd)]} {
8090 if {[info exists done($dd)]} {
8091 foreach b $arcnos($dd) {
8092 lappend tomark $arcstart($b)
8094 if {[info exists tagloc($dd)]} {
8095 unset tagloc($dd)
8097 } elseif {[info exists queued($dd)]} {
8098 incr nc -1
8100 set hastaggedancestor($dd) 1
8104 if {![info exists queued($d)]} {
8105 lappend todo $d
8106 set queued($d) 1
8107 if {![info exists hastaggedancestor($d)]} {
8108 incr nc
8113 set tags {}
8114 foreach id [array names tagloc] {
8115 if {![info exists hastaggedancestor($id)]} {
8116 foreach t $tagloc($id) {
8117 if {[lsearch -exact $tags $t] < 0} {
8118 lappend tags $t
8123 set t2 [clock clicks -milliseconds]
8124 set loopix $i
8126 # remove tags that are descendents of other tags
8127 for {set i 0} {$i < [llength $tags]} {incr i} {
8128 set a [lindex $tags $i]
8129 for {set j 0} {$j < $i} {incr j} {
8130 set b [lindex $tags $j]
8131 set r [anc_or_desc $a $b]
8132 if {$r == 1} {
8133 set tags [lreplace $tags $j $j]
8134 incr j -1
8135 incr i -1
8136 } elseif {$r == -1} {
8137 set tags [lreplace $tags $i $i]
8138 incr i -1
8139 break
8144 if {[array names growing] ne {}} {
8145 # graph isn't finished, need to check if any tag could get
8146 # eclipsed by another tag coming later. Simply ignore any
8147 # tags that could later get eclipsed.
8148 set ctags {}
8149 foreach t $tags {
8150 if {[is_certain $t $origid]} {
8151 lappend ctags $t
8154 if {$tags eq $ctags} {
8155 set cached_dtags($origid) $tags
8156 } else {
8157 set tags $ctags
8159 } else {
8160 set cached_dtags($origid) $tags
8162 set t3 [clock clicks -milliseconds]
8163 if {0 && $t3 - $t1 >= 100} {
8164 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8165 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8167 return $tags
8170 proc anctags {id} {
8171 global arcnos arcids arcout arcend arctags idtags allparents
8172 global growing cached_atags
8174 if {![info exists allparents($id)]} {
8175 return {}
8177 set t1 [clock clicks -milliseconds]
8178 set argid $id
8179 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8180 # part-way along an arc; check that arc first
8181 set a [lindex $arcnos($id) 0]
8182 if {$arctags($a) ne {}} {
8183 validate_arctags $a
8184 set i [lsearch -exact $arcids($a) $id]
8185 foreach t $arctags($a) {
8186 set j [lsearch -exact $arcids($a) $t]
8187 if {$j > $i} {
8188 return $t
8192 if {![info exists arcend($a)]} {
8193 return {}
8195 set id $arcend($a)
8196 if {[info exists idtags($id)]} {
8197 return $id
8200 if {[info exists cached_atags($id)]} {
8201 return $cached_atags($id)
8204 set origid $id
8205 set todo [list $id]
8206 set queued($id) 1
8207 set taglist {}
8208 set nc 1
8209 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8210 set id [lindex $todo $i]
8211 set done($id) 1
8212 set td [info exists hastaggeddescendent($id)]
8213 if {!$td} {
8214 incr nc -1
8216 # ignore tags on starting node
8217 if {!$td && $i > 0} {
8218 if {[info exists idtags($id)]} {
8219 set tagloc($id) $id
8220 set td 1
8221 } elseif {[info exists cached_atags($id)]} {
8222 set tagloc($id) $cached_atags($id)
8223 set td 1
8226 foreach a $arcout($id) {
8227 if {!$td && $arctags($a) ne {}} {
8228 validate_arctags $a
8229 if {$arctags($a) ne {}} {
8230 lappend tagloc($id) [lindex $arctags($a) 0]
8233 if {![info exists arcend($a)]} continue
8234 set d $arcend($a)
8235 if {$td || $arctags($a) ne {}} {
8236 set tomark [list $d]
8237 for {set j 0} {$j < [llength $tomark]} {incr j} {
8238 set dd [lindex $tomark $j]
8239 if {![info exists hastaggeddescendent($dd)]} {
8240 if {[info exists done($dd)]} {
8241 foreach b $arcout($dd) {
8242 if {[info exists arcend($b)]} {
8243 lappend tomark $arcend($b)
8246 if {[info exists tagloc($dd)]} {
8247 unset tagloc($dd)
8249 } elseif {[info exists queued($dd)]} {
8250 incr nc -1
8252 set hastaggeddescendent($dd) 1
8256 if {![info exists queued($d)]} {
8257 lappend todo $d
8258 set queued($d) 1
8259 if {![info exists hastaggeddescendent($d)]} {
8260 incr nc
8265 set t2 [clock clicks -milliseconds]
8266 set loopix $i
8267 set tags {}
8268 foreach id [array names tagloc] {
8269 if {![info exists hastaggeddescendent($id)]} {
8270 foreach t $tagloc($id) {
8271 if {[lsearch -exact $tags $t] < 0} {
8272 lappend tags $t
8278 # remove tags that are ancestors of other tags
8279 for {set i 0} {$i < [llength $tags]} {incr i} {
8280 set a [lindex $tags $i]
8281 for {set j 0} {$j < $i} {incr j} {
8282 set b [lindex $tags $j]
8283 set r [anc_or_desc $a $b]
8284 if {$r == -1} {
8285 set tags [lreplace $tags $j $j]
8286 incr j -1
8287 incr i -1
8288 } elseif {$r == 1} {
8289 set tags [lreplace $tags $i $i]
8290 incr i -1
8291 break
8296 if {[array names growing] ne {}} {
8297 # graph isn't finished, need to check if any tag could get
8298 # eclipsed by another tag coming later. Simply ignore any
8299 # tags that could later get eclipsed.
8300 set ctags {}
8301 foreach t $tags {
8302 if {[is_certain $origid $t]} {
8303 lappend ctags $t
8306 if {$tags eq $ctags} {
8307 set cached_atags($origid) $tags
8308 } else {
8309 set tags $ctags
8311 } else {
8312 set cached_atags($origid) $tags
8314 set t3 [clock clicks -milliseconds]
8315 if {0 && $t3 - $t1 >= 100} {
8316 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8317 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8319 return $tags
8322 # Return the list of IDs that have heads that are descendents of id,
8323 # including id itself if it has a head.
8324 proc descheads {id} {
8325 global arcnos arcstart arcids archeads idheads cached_dheads
8326 global allparents
8328 if {![info exists allparents($id)]} {
8329 return {}
8331 set aret {}
8332 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8333 # part-way along an arc; check it first
8334 set a [lindex $arcnos($id) 0]
8335 if {$archeads($a) ne {}} {
8336 validate_archeads $a
8337 set i [lsearch -exact $arcids($a) $id]
8338 foreach t $archeads($a) {
8339 set j [lsearch -exact $arcids($a) $t]
8340 if {$j > $i} break
8341 lappend aret $t
8344 set id $arcstart($a)
8346 set origid $id
8347 set todo [list $id]
8348 set seen($id) 1
8349 set ret {}
8350 for {set i 0} {$i < [llength $todo]} {incr i} {
8351 set id [lindex $todo $i]
8352 if {[info exists cached_dheads($id)]} {
8353 set ret [concat $ret $cached_dheads($id)]
8354 } else {
8355 if {[info exists idheads($id)]} {
8356 lappend ret $id
8358 foreach a $arcnos($id) {
8359 if {$archeads($a) ne {}} {
8360 validate_archeads $a
8361 if {$archeads($a) ne {}} {
8362 set ret [concat $ret $archeads($a)]
8365 set d $arcstart($a)
8366 if {![info exists seen($d)]} {
8367 lappend todo $d
8368 set seen($d) 1
8373 set ret [lsort -unique $ret]
8374 set cached_dheads($origid) $ret
8375 return [concat $ret $aret]
8378 proc addedtag {id} {
8379 global arcnos arcout cached_dtags cached_atags
8381 if {![info exists arcnos($id)]} return
8382 if {![info exists arcout($id)]} {
8383 recalcarc [lindex $arcnos($id) 0]
8385 catch {unset cached_dtags}
8386 catch {unset cached_atags}
8389 proc addedhead {hid head} {
8390 global arcnos arcout cached_dheads
8392 if {![info exists arcnos($hid)]} return
8393 if {![info exists arcout($hid)]} {
8394 recalcarc [lindex $arcnos($hid) 0]
8396 catch {unset cached_dheads}
8399 proc removedhead {hid head} {
8400 global cached_dheads
8402 catch {unset cached_dheads}
8405 proc movedhead {hid head} {
8406 global arcnos arcout cached_dheads
8408 if {![info exists arcnos($hid)]} return
8409 if {![info exists arcout($hid)]} {
8410 recalcarc [lindex $arcnos($hid) 0]
8412 catch {unset cached_dheads}
8415 proc changedrefs {} {
8416 global cached_dheads cached_dtags cached_atags
8417 global arctags archeads arcnos arcout idheads idtags
8419 foreach id [concat [array names idheads] [array names idtags]] {
8420 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8421 set a [lindex $arcnos($id) 0]
8422 if {![info exists donearc($a)]} {
8423 recalcarc $a
8424 set donearc($a) 1
8428 catch {unset cached_dtags}
8429 catch {unset cached_atags}
8430 catch {unset cached_dheads}
8433 proc rereadrefs {} {
8434 global idtags idheads idotherrefs mainheadid
8436 set refids [concat [array names idtags] \
8437 [array names idheads] [array names idotherrefs]]
8438 foreach id $refids {
8439 if {![info exists ref($id)]} {
8440 set ref($id) [listrefs $id]
8443 set oldmainhead $mainheadid
8444 readrefs
8445 changedrefs
8446 set refids [lsort -unique [concat $refids [array names idtags] \
8447 [array names idheads] [array names idotherrefs]]]
8448 foreach id $refids {
8449 set v [listrefs $id]
8450 if {![info exists ref($id)] || $ref($id) != $v ||
8451 ($id eq $oldmainhead && $id ne $mainheadid) ||
8452 ($id eq $mainheadid && $id ne $oldmainhead)} {
8453 redrawtags $id
8456 run refill_reflist
8459 proc listrefs {id} {
8460 global idtags idheads idotherrefs
8462 set x {}
8463 if {[info exists idtags($id)]} {
8464 set x $idtags($id)
8466 set y {}
8467 if {[info exists idheads($id)]} {
8468 set y $idheads($id)
8470 set z {}
8471 if {[info exists idotherrefs($id)]} {
8472 set z $idotherrefs($id)
8474 return [list $x $y $z]
8477 proc showtag {tag isnew} {
8478 global ctext tagcontents tagids linknum tagobjid
8480 if {$isnew} {
8481 addtohistory [list showtag $tag 0]
8483 $ctext conf -state normal
8484 clear_ctext
8485 settabs 0
8486 set linknum 0
8487 if {![info exists tagcontents($tag)]} {
8488 catch {
8489 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8492 if {[info exists tagcontents($tag)]} {
8493 set text $tagcontents($tag)
8494 } else {
8495 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8497 appendwithlinks $text {}
8498 $ctext conf -state disabled
8499 init_flist {}
8502 proc doquit {} {
8503 global stopped
8504 set stopped 100
8505 savestuff .
8506 destroy .
8509 proc mkfontdisp {font top which} {
8510 global fontattr fontpref $font
8512 set fontpref($font) [set $font]
8513 button $top.${font}but -text $which -font optionfont \
8514 -command [list choosefont $font $which]
8515 label $top.$font -relief flat -font $font \
8516 -text $fontattr($font,family) -justify left
8517 grid x $top.${font}but $top.$font -sticky w
8520 proc choosefont {font which} {
8521 global fontparam fontlist fonttop fontattr
8523 set fontparam(which) $which
8524 set fontparam(font) $font
8525 set fontparam(family) [font actual $font -family]
8526 set fontparam(size) $fontattr($font,size)
8527 set fontparam(weight) $fontattr($font,weight)
8528 set fontparam(slant) $fontattr($font,slant)
8529 set top .gitkfont
8530 set fonttop $top
8531 if {![winfo exists $top]} {
8532 font create sample
8533 eval font config sample [font actual $font]
8534 toplevel $top
8535 wm title $top [mc "Gitk font chooser"]
8536 label $top.l -textvariable fontparam(which)
8537 pack $top.l -side top
8538 set fontlist [lsort [font families]]
8539 frame $top.f
8540 listbox $top.f.fam -listvariable fontlist \
8541 -yscrollcommand [list $top.f.sb set]
8542 bind $top.f.fam <<ListboxSelect>> selfontfam
8543 scrollbar $top.f.sb -command [list $top.f.fam yview]
8544 pack $top.f.sb -side right -fill y
8545 pack $top.f.fam -side left -fill both -expand 1
8546 pack $top.f -side top -fill both -expand 1
8547 frame $top.g
8548 spinbox $top.g.size -from 4 -to 40 -width 4 \
8549 -textvariable fontparam(size) \
8550 -validatecommand {string is integer -strict %s}
8551 checkbutton $top.g.bold -padx 5 \
8552 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8553 -variable fontparam(weight) -onvalue bold -offvalue normal
8554 checkbutton $top.g.ital -padx 5 \
8555 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8556 -variable fontparam(slant) -onvalue italic -offvalue roman
8557 pack $top.g.size $top.g.bold $top.g.ital -side left
8558 pack $top.g -side top
8559 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8560 -background white
8561 $top.c create text 100 25 -anchor center -text $which -font sample \
8562 -fill black -tags text
8563 bind $top.c <Configure> [list centertext $top.c]
8564 pack $top.c -side top -fill x
8565 frame $top.buts
8566 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8567 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8568 grid $top.buts.ok $top.buts.can
8569 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8570 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8571 pack $top.buts -side bottom -fill x
8572 trace add variable fontparam write chg_fontparam
8573 } else {
8574 raise $top
8575 $top.c itemconf text -text $which
8577 set i [lsearch -exact $fontlist $fontparam(family)]
8578 if {$i >= 0} {
8579 $top.f.fam selection set $i
8580 $top.f.fam see $i
8584 proc centertext {w} {
8585 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8588 proc fontok {} {
8589 global fontparam fontpref prefstop
8591 set f $fontparam(font)
8592 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8593 if {$fontparam(weight) eq "bold"} {
8594 lappend fontpref($f) "bold"
8596 if {$fontparam(slant) eq "italic"} {
8597 lappend fontpref($f) "italic"
8599 set w $prefstop.$f
8600 $w conf -text $fontparam(family) -font $fontpref($f)
8602 fontcan
8605 proc fontcan {} {
8606 global fonttop fontparam
8608 if {[info exists fonttop]} {
8609 catch {destroy $fonttop}
8610 catch {font delete sample}
8611 unset fonttop
8612 unset fontparam
8616 proc selfontfam {} {
8617 global fonttop fontparam
8619 set i [$fonttop.f.fam curselection]
8620 if {$i ne {}} {
8621 set fontparam(family) [$fonttop.f.fam get $i]
8625 proc chg_fontparam {v sub op} {
8626 global fontparam
8628 font config sample -$sub $fontparam($sub)
8631 proc doprefs {} {
8632 global maxwidth maxgraphpct
8633 global oldprefs prefstop showneartags showlocalchanges
8634 global bgcolor fgcolor ctext diffcolors selectbgcolor
8635 global tabstop limitdiffs
8637 set top .gitkprefs
8638 set prefstop $top
8639 if {[winfo exists $top]} {
8640 raise $top
8641 return
8643 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8644 limitdiffs tabstop} {
8645 set oldprefs($v) [set $v]
8647 toplevel $top
8648 wm title $top [mc "Gitk preferences"]
8649 label $top.ldisp -text [mc "Commit list display options"]
8650 grid $top.ldisp - -sticky w -pady 10
8651 label $top.spacer -text " "
8652 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8653 -font optionfont
8654 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8655 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8656 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8657 -font optionfont
8658 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8659 grid x $top.maxpctl $top.maxpct -sticky w
8660 frame $top.showlocal
8661 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8662 checkbutton $top.showlocal.b -variable showlocalchanges
8663 pack $top.showlocal.b $top.showlocal.l -side left
8664 grid x $top.showlocal -sticky w
8666 label $top.ddisp -text [mc "Diff display options"]
8667 grid $top.ddisp - -sticky w -pady 10
8668 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8669 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8670 grid x $top.tabstopl $top.tabstop -sticky w
8671 frame $top.ntag
8672 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8673 checkbutton $top.ntag.b -variable showneartags
8674 pack $top.ntag.b $top.ntag.l -side left
8675 grid x $top.ntag -sticky w
8676 frame $top.ldiff
8677 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8678 checkbutton $top.ldiff.b -variable limitdiffs
8679 pack $top.ldiff.b $top.ldiff.l -side left
8680 grid x $top.ldiff -sticky w
8682 label $top.cdisp -text [mc "Colors: press to choose"]
8683 grid $top.cdisp - -sticky w -pady 10
8684 label $top.bg -padx 40 -relief sunk -background $bgcolor
8685 button $top.bgbut -text [mc "Background"] -font optionfont \
8686 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8687 grid x $top.bgbut $top.bg -sticky w
8688 label $top.fg -padx 40 -relief sunk -background $fgcolor
8689 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8690 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8691 grid x $top.fgbut $top.fg -sticky w
8692 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8693 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8694 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8695 [list $ctext tag conf d0 -foreground]]
8696 grid x $top.diffoldbut $top.diffold -sticky w
8697 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8698 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8699 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8700 [list $ctext tag conf d1 -foreground]]
8701 grid x $top.diffnewbut $top.diffnew -sticky w
8702 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8703 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8704 -command [list choosecolor diffcolors 2 $top.hunksep \
8705 "diff hunk header" \
8706 [list $ctext tag conf hunksep -foreground]]
8707 grid x $top.hunksepbut $top.hunksep -sticky w
8708 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8709 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8710 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8711 grid x $top.selbgbut $top.selbgsep -sticky w
8713 label $top.cfont -text [mc "Fonts: press to choose"]
8714 grid $top.cfont - -sticky w -pady 10
8715 mkfontdisp mainfont $top [mc "Main font"]
8716 mkfontdisp textfont $top [mc "Diff display font"]
8717 mkfontdisp uifont $top [mc "User interface font"]
8719 frame $top.buts
8720 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8721 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8722 grid $top.buts.ok $top.buts.can
8723 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8724 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8725 grid $top.buts - - -pady 10 -sticky ew
8726 bind $top <Visibility> "focus $top.buts.ok"
8729 proc choosecolor {v vi w x cmd} {
8730 global $v
8732 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8733 -title [mc "Gitk: choose color for %s" $x]]
8734 if {$c eq {}} return
8735 $w conf -background $c
8736 lset $v $vi $c
8737 eval $cmd $c
8740 proc setselbg {c} {
8741 global bglist cflist
8742 foreach w $bglist {
8743 $w configure -selectbackground $c
8745 $cflist tag configure highlight \
8746 -background [$cflist cget -selectbackground]
8747 allcanvs itemconf secsel -fill $c
8750 proc setbg {c} {
8751 global bglist
8753 foreach w $bglist {
8754 $w conf -background $c
8758 proc setfg {c} {
8759 global fglist canv
8761 foreach w $fglist {
8762 $w conf -foreground $c
8764 allcanvs itemconf text -fill $c
8765 $canv itemconf circle -outline $c
8768 proc prefscan {} {
8769 global oldprefs prefstop
8771 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8772 limitdiffs tabstop} {
8773 global $v
8774 set $v $oldprefs($v)
8776 catch {destroy $prefstop}
8777 unset prefstop
8778 fontcan
8781 proc prefsok {} {
8782 global maxwidth maxgraphpct
8783 global oldprefs prefstop showneartags showlocalchanges
8784 global fontpref mainfont textfont uifont
8785 global limitdiffs treediffs
8787 catch {destroy $prefstop}
8788 unset prefstop
8789 fontcan
8790 set fontchanged 0
8791 if {$mainfont ne $fontpref(mainfont)} {
8792 set mainfont $fontpref(mainfont)
8793 parsefont mainfont $mainfont
8794 eval font configure mainfont [fontflags mainfont]
8795 eval font configure mainfontbold [fontflags mainfont 1]
8796 setcoords
8797 set fontchanged 1
8799 if {$textfont ne $fontpref(textfont)} {
8800 set textfont $fontpref(textfont)
8801 parsefont textfont $textfont
8802 eval font configure textfont [fontflags textfont]
8803 eval font configure textfontbold [fontflags textfont 1]
8805 if {$uifont ne $fontpref(uifont)} {
8806 set uifont $fontpref(uifont)
8807 parsefont uifont $uifont
8808 eval font configure uifont [fontflags uifont]
8810 settabs
8811 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8812 if {$showlocalchanges} {
8813 doshowlocalchanges
8814 } else {
8815 dohidelocalchanges
8818 if {$limitdiffs != $oldprefs(limitdiffs)} {
8819 # treediffs elements are limited by path
8820 catch {unset treediffs}
8822 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8823 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8824 redisplay
8825 } elseif {$showneartags != $oldprefs(showneartags) ||
8826 $limitdiffs != $oldprefs(limitdiffs)} {
8827 reselectline
8831 proc formatdate {d} {
8832 global datetimeformat
8833 if {$d ne {}} {
8834 set d [clock format $d -format $datetimeformat]
8836 return $d
8839 # This list of encoding names and aliases is distilled from
8840 # http://www.iana.org/assignments/character-sets.
8841 # Not all of them are supported by Tcl.
8842 set encoding_aliases {
8843 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8844 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8845 { ISO-10646-UTF-1 csISO10646UTF1 }
8846 { ISO_646.basic:1983 ref csISO646basic1983 }
8847 { INVARIANT csINVARIANT }
8848 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8849 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8850 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8851 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8852 { NATS-DANO iso-ir-9-1 csNATSDANO }
8853 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8854 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8855 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8856 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8857 { ISO-2022-KR csISO2022KR }
8858 { EUC-KR csEUCKR }
8859 { ISO-2022-JP csISO2022JP }
8860 { ISO-2022-JP-2 csISO2022JP2 }
8861 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8862 csISO13JISC6220jp }
8863 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8864 { IT iso-ir-15 ISO646-IT csISO15Italian }
8865 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8866 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8867 { greek7-old iso-ir-18 csISO18Greek7Old }
8868 { latin-greek iso-ir-19 csISO19LatinGreek }
8869 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8870 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8871 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8872 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8873 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8874 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8875 { INIS iso-ir-49 csISO49INIS }
8876 { INIS-8 iso-ir-50 csISO50INIS8 }
8877 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8878 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8879 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8880 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8881 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8882 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8883 csISO60Norwegian1 }
8884 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8885 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8886 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8887 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8888 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8889 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8890 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8891 { greek7 iso-ir-88 csISO88Greek7 }
8892 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8893 { iso-ir-90 csISO90 }
8894 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8895 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8896 csISO92JISC62991984b }
8897 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8898 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8899 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8900 csISO95JIS62291984handadd }
8901 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8902 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8903 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8904 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8905 CP819 csISOLatin1 }
8906 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8907 { T.61-7bit iso-ir-102 csISO102T617bit }
8908 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8909 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8910 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8911 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8912 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8913 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8914 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8915 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8916 arabic csISOLatinArabic }
8917 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8918 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8919 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8920 greek greek8 csISOLatinGreek }
8921 { T.101-G2 iso-ir-128 csISO128T101G2 }
8922 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8923 csISOLatinHebrew }
8924 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8925 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8926 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8927 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8928 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8929 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8930 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8931 csISOLatinCyrillic }
8932 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8933 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8934 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8935 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8936 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8937 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8938 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8939 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8940 { ISO_10367-box iso-ir-155 csISO10367Box }
8941 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8942 { latin-lap lap iso-ir-158 csISO158Lap }
8943 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8944 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8945 { us-dk csUSDK }
8946 { dk-us csDKUS }
8947 { JIS_X0201 X0201 csHalfWidthKatakana }
8948 { KSC5636 ISO646-KR csKSC5636 }
8949 { ISO-10646-UCS-2 csUnicode }
8950 { ISO-10646-UCS-4 csUCS4 }
8951 { DEC-MCS dec csDECMCS }
8952 { hp-roman8 roman8 r8 csHPRoman8 }
8953 { macintosh mac csMacintosh }
8954 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8955 csIBM037 }
8956 { IBM038 EBCDIC-INT cp038 csIBM038 }
8957 { IBM273 CP273 csIBM273 }
8958 { IBM274 EBCDIC-BE CP274 csIBM274 }
8959 { IBM275 EBCDIC-BR cp275 csIBM275 }
8960 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8961 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8962 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8963 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8964 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8965 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8966 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8967 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8968 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8969 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8970 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8971 { IBM437 cp437 437 csPC8CodePage437 }
8972 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8973 { IBM775 cp775 csPC775Baltic }
8974 { IBM850 cp850 850 csPC850Multilingual }
8975 { IBM851 cp851 851 csIBM851 }
8976 { IBM852 cp852 852 csPCp852 }
8977 { IBM855 cp855 855 csIBM855 }
8978 { IBM857 cp857 857 csIBM857 }
8979 { IBM860 cp860 860 csIBM860 }
8980 { IBM861 cp861 861 cp-is csIBM861 }
8981 { IBM862 cp862 862 csPC862LatinHebrew }
8982 { IBM863 cp863 863 csIBM863 }
8983 { IBM864 cp864 csIBM864 }
8984 { IBM865 cp865 865 csIBM865 }
8985 { IBM866 cp866 866 csIBM866 }
8986 { IBM868 CP868 cp-ar csIBM868 }
8987 { IBM869 cp869 869 cp-gr csIBM869 }
8988 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8989 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8990 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8991 { IBM891 cp891 csIBM891 }
8992 { IBM903 cp903 csIBM903 }
8993 { IBM904 cp904 904 csIBBM904 }
8994 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8995 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8996 { IBM1026 CP1026 csIBM1026 }
8997 { EBCDIC-AT-DE csIBMEBCDICATDE }
8998 { EBCDIC-AT-DE-A csEBCDICATDEA }
8999 { EBCDIC-CA-FR csEBCDICCAFR }
9000 { EBCDIC-DK-NO csEBCDICDKNO }
9001 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9002 { EBCDIC-FI-SE csEBCDICFISE }
9003 { EBCDIC-FI-SE-A csEBCDICFISEA }
9004 { EBCDIC-FR csEBCDICFR }
9005 { EBCDIC-IT csEBCDICIT }
9006 { EBCDIC-PT csEBCDICPT }
9007 { EBCDIC-ES csEBCDICES }
9008 { EBCDIC-ES-A csEBCDICESA }
9009 { EBCDIC-ES-S csEBCDICESS }
9010 { EBCDIC-UK csEBCDICUK }
9011 { EBCDIC-US csEBCDICUS }
9012 { UNKNOWN-8BIT csUnknown8BiT }
9013 { MNEMONIC csMnemonic }
9014 { MNEM csMnem }
9015 { VISCII csVISCII }
9016 { VIQR csVIQR }
9017 { KOI8-R csKOI8R }
9018 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9019 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9020 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9021 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9022 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9023 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9024 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9025 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9026 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9027 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9028 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9029 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9030 { IBM1047 IBM-1047 }
9031 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9032 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9033 { UNICODE-1-1 csUnicode11 }
9034 { CESU-8 csCESU-8 }
9035 { BOCU-1 csBOCU-1 }
9036 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9037 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9038 l8 }
9039 { ISO-8859-15 ISO_8859-15 Latin-9 }
9040 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9041 { GBK CP936 MS936 windows-936 }
9042 { JIS_Encoding csJISEncoding }
9043 { Shift_JIS MS_Kanji csShiftJIS }
9044 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9045 EUC-JP }
9046 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9047 { ISO-10646-UCS-Basic csUnicodeASCII }
9048 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9049 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9050 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9051 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9052 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9053 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9054 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9055 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9056 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9057 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9058 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9059 { Ventura-US csVenturaUS }
9060 { Ventura-International csVenturaInternational }
9061 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9062 { PC8-Turkish csPC8Turkish }
9063 { IBM-Symbols csIBMSymbols }
9064 { IBM-Thai csIBMThai }
9065 { HP-Legal csHPLegal }
9066 { HP-Pi-font csHPPiFont }
9067 { HP-Math8 csHPMath8 }
9068 { Adobe-Symbol-Encoding csHPPSMath }
9069 { HP-DeskTop csHPDesktop }
9070 { Ventura-Math csVenturaMath }
9071 { Microsoft-Publishing csMicrosoftPublishing }
9072 { Windows-31J csWindows31J }
9073 { GB2312 csGB2312 }
9074 { Big5 csBig5 }
9077 proc tcl_encoding {enc} {
9078 global encoding_aliases
9079 set names [encoding names]
9080 set lcnames [string tolower $names]
9081 set enc [string tolower $enc]
9082 set i [lsearch -exact $lcnames $enc]
9083 if {$i < 0} {
9084 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9085 if {[regsub {^iso[-_]} $enc iso encx]} {
9086 set i [lsearch -exact $lcnames $encx]
9089 if {$i < 0} {
9090 foreach l $encoding_aliases {
9091 set ll [string tolower $l]
9092 if {[lsearch -exact $ll $enc] < 0} continue
9093 # look through the aliases for one that tcl knows about
9094 foreach e $ll {
9095 set i [lsearch -exact $lcnames $e]
9096 if {$i < 0} {
9097 if {[regsub {^iso[-_]} $e iso ex]} {
9098 set i [lsearch -exact $lcnames $ex]
9101 if {$i >= 0} break
9103 break
9106 if {$i >= 0} {
9107 return [lindex $names $i]
9109 return {}
9112 # First check that Tcl/Tk is recent enough
9113 if {[catch {package require Tk 8.4} err]} {
9114 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9115 Gitk requires at least Tcl/Tk 8.4."]
9116 exit 1
9119 # defaults...
9120 set datemode 0
9121 set wrcomcmd "git diff-tree --stdin -p --pretty"
9123 set gitencoding {}
9124 catch {
9125 set gitencoding [exec git config --get i18n.commitencoding]
9127 if {$gitencoding == ""} {
9128 set gitencoding "utf-8"
9130 set tclencoding [tcl_encoding $gitencoding]
9131 if {$tclencoding == {}} {
9132 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9135 set mainfont {Helvetica 9}
9136 set textfont {Courier 9}
9137 set uifont {Helvetica 9 bold}
9138 set tabstop 8
9139 set findmergefiles 0
9140 set maxgraphpct 50
9141 set maxwidth 16
9142 set revlistorder 0
9143 set fastdate 0
9144 set uparrowlen 5
9145 set downarrowlen 5
9146 set mingaplen 100
9147 set cmitmode "patch"
9148 set wrapcomment "none"
9149 set showneartags 1
9150 set maxrefs 20
9151 set maxlinelen 200
9152 set showlocalchanges 1
9153 set limitdiffs 1
9154 set datetimeformat "%Y-%m-%d %H:%M:%S"
9156 set colors {green red blue magenta darkgrey brown orange}
9157 set bgcolor white
9158 set fgcolor black
9159 set diffcolors {red "#00a000" blue}
9160 set diffcontext 3
9161 set selectbgcolor gray85
9163 ## For msgcat loading, first locate the installation location.
9164 if { [info exists ::env(GITK_MSGSDIR)] } {
9165 ## Msgsdir was manually set in the environment.
9166 set gitk_msgsdir $::env(GITK_MSGSDIR)
9167 } else {
9168 ## Let's guess the prefix from argv0.
9169 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9170 set gitk_libdir [file join $gitk_prefix share gitk lib]
9171 set gitk_msgsdir [file join $gitk_libdir msgs]
9172 unset gitk_prefix
9175 ## Internationalization (i18n) through msgcat and gettext. See
9176 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9177 package require msgcat
9178 namespace import ::msgcat::mc
9179 ## And eventually load the actual message catalog
9180 ::msgcat::mcload $gitk_msgsdir
9182 catch {source ~/.gitk}
9184 font create optionfont -family sans-serif -size -12
9186 parsefont mainfont $mainfont
9187 eval font create mainfont [fontflags mainfont]
9188 eval font create mainfontbold [fontflags mainfont 1]
9190 parsefont textfont $textfont
9191 eval font create textfont [fontflags textfont]
9192 eval font create textfontbold [fontflags textfont 1]
9194 parsefont uifont $uifont
9195 eval font create uifont [fontflags uifont]
9197 setoptions
9199 # check that we can find a .git directory somewhere...
9200 if {[catch {set gitdir [gitdir]}]} {
9201 show_error {} . [mc "Cannot find a git repository here."]
9202 exit 1
9204 if {![file isdirectory $gitdir]} {
9205 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9206 exit 1
9209 set mergeonly 0
9210 set revtreeargs {}
9211 set cmdline_files {}
9212 set i 0
9213 foreach arg $argv {
9214 switch -- $arg {
9215 "" { }
9216 "-d" { set datemode 1 }
9217 "--merge" {
9218 set mergeonly 1
9219 lappend revtreeargs $arg
9221 "--" {
9222 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9223 break
9225 default {
9226 lappend revtreeargs $arg
9229 incr i
9232 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9233 # no -- on command line, but some arguments (other than -d)
9234 if {[catch {
9235 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9236 set cmdline_files [split $f "\n"]
9237 set n [llength $cmdline_files]
9238 set revtreeargs [lrange $revtreeargs 0 end-$n]
9239 # Unfortunately git rev-parse doesn't produce an error when
9240 # something is both a revision and a filename. To be consistent
9241 # with git log and git rev-list, check revtreeargs for filenames.
9242 foreach arg $revtreeargs {
9243 if {[file exists $arg]} {
9244 show_error {} . [mc "Ambiguous argument '%s': both revision\
9245 and filename" $arg]
9246 exit 1
9249 } err]} {
9250 # unfortunately we get both stdout and stderr in $err,
9251 # so look for "fatal:".
9252 set i [string first "fatal:" $err]
9253 if {$i > 0} {
9254 set err [string range $err [expr {$i + 6}] end]
9256 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9257 exit 1
9261 if {$mergeonly} {
9262 # find the list of unmerged files
9263 set mlist {}
9264 set nr_unmerged 0
9265 if {[catch {
9266 set fd [open "| git ls-files -u" r]
9267 } err]} {
9268 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9269 exit 1
9271 while {[gets $fd line] >= 0} {
9272 set i [string first "\t" $line]
9273 if {$i < 0} continue
9274 set fname [string range $line [expr {$i+1}] end]
9275 if {[lsearch -exact $mlist $fname] >= 0} continue
9276 incr nr_unmerged
9277 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9278 lappend mlist $fname
9281 catch {close $fd}
9282 if {$mlist eq {}} {
9283 if {$nr_unmerged == 0} {
9284 show_error {} . [mc "No files selected: --merge specified but\
9285 no files are unmerged."]
9286 } else {
9287 show_error {} . [mc "No files selected: --merge specified but\
9288 no unmerged files are within file limit."]
9290 exit 1
9292 set cmdline_files $mlist
9295 set nullid "0000000000000000000000000000000000000000"
9296 set nullid2 "0000000000000000000000000000000000000001"
9298 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9300 set runq {}
9301 set history {}
9302 set historyindex 0
9303 set fh_serial 0
9304 set nhl_names {}
9305 set highlight_paths {}
9306 set findpattern {}
9307 set searchdirn -forwards
9308 set boldrows {}
9309 set boldnamerows {}
9310 set diffelide {0 0}
9311 set markingmatches 0
9312 set linkentercount 0
9313 set need_redisplay 0
9314 set nrows_drawn 0
9315 set firsttabstop 0
9317 set nextviewnum 1
9318 set curview 0
9319 set selectedview 0
9320 set selectedhlview [mc "None"]
9321 set highlight_related [mc "None"]
9322 set highlight_files {}
9323 set viewfiles(0) {}
9324 set viewperm(0) 0
9325 set viewargs(0) {}
9327 set loginstance 0
9328 set cmdlineok 0
9329 set stopped 0
9330 set stuffsaved 0
9331 set patchnum 0
9332 set lserial 0
9333 setcoords
9334 makewindow
9335 # wait for the window to become visible
9336 tkwait visibility .
9337 wm title . "[file tail $argv0]: [file tail [pwd]]"
9338 readrefs
9340 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9341 # create a view for the files/dirs specified on the command line
9342 set curview 1
9343 set selectedview 1
9344 set nextviewnum 2
9345 set viewname(1) [mc "Command line"]
9346 set viewfiles(1) $cmdline_files
9347 set viewargs(1) $revtreeargs
9348 set viewperm(1) 0
9349 addviewmenu 1
9350 .bar.view entryconf [mc "Edit view..."] -state normal
9351 .bar.view entryconf [mc "Delete view"] -state normal
9354 if {[info exists permviews]} {
9355 foreach v $permviews {
9356 set n $nextviewnum
9357 incr nextviewnum
9358 set viewname($n) [lindex $v 0]
9359 set viewfiles($n) [lindex $v 1]
9360 set viewargs($n) [lindex $v 2]
9361 set viewperm($n) 1
9362 addviewmenu $n
9365 getcommits