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