Merge branch 'master' into dev
[git/dscho.git] / gitk
blobdc716597f079aece8e8dde4cf5a5ee703f0165dd
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return [exec git rev-parse --git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
24 proc run args {
25 global isonrunq runq
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {}} {
30 after idle dorunq
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
36 proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
40 proc filereadable {fd script} {
41 global runq
43 fileevent $fd readable {}
44 if {$runq eq {}} {
45 after idle dorunq
47 lappend runq [list $fd $script]
50 proc nukefile {fd} {
51 global runq
53 for {set i 0} {$i < [llength $runq]} {} {
54 if {[lindex $runq $i 0] eq $fd} {
55 set runq [lreplace $runq $i $i]
56 } else {
57 incr i
62 proc dorunq {} {
63 global isonrunq runq
65 set tstart [clock clicks -milliseconds]
66 set t0 $tstart
67 while {[llength $runq] > 0} {
68 set fd [lindex $runq 0 0]
69 set script [lindex $runq 0 1]
70 set repeat [eval $script]
71 set t1 [clock clicks -milliseconds]
72 set t [expr {$t1 - $t0}]
73 set runq [lrange $runq 1 end]
74 if {$repeat ne {} && $repeat} {
75 if {$fd eq {} || $repeat == 2} {
76 # script returns 1 if it wants to be readded
77 # file readers return 2 if they could do more straight away
78 lappend runq [list $fd $script]
79 } else {
80 fileevent $fd readable [list filereadable $fd $script]
82 } elseif {$fd eq {}} {
83 unset isonrunq($script)
85 set t0 $t1
86 if {$t1 - $tstart >= 80} break
88 if {$runq ne {}} {
89 after idle dorunq
93 # Start off a git rev-list process and arrange to read its output
94 proc start_rev_list {view} {
95 global startmsecs
96 global commfd leftover tclencoding datemode
97 global viewargs viewfiles commitidx viewcomplete vnextroot
98 global showlocalchanges commitinterest mainheadid
99 global progressdirn progresscoords proglastnc curview
100 global viewincl viewactive loginstance viewinstances
102 set startmsecs [clock clicks -milliseconds]
103 set commitidx($view) 0
104 set viewcomplete($view) 0
105 set viewactive($view) 1
106 set vnextroot($view) 0
107 varcinit $view
109 set commits [eval exec git rev-parse --default HEAD --revs-only \
110 $viewargs($view)]
111 set viewincl($view) {}
112 foreach c $commits {
113 if {![string match "^*" $c]} {
114 lappend viewincl($view) $c
117 if {[catch {
118 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
119 --boundary $commits "--" $viewfiles($view)] r]
120 } err]} {
121 error_popup "[mc "Error executing git log:"] $err"
122 exit 1
124 set i [incr loginstance]
125 set viewinstances($view) [list $i]
126 set commfd($i) $fd
127 set leftover($i) {}
128 if {$showlocalchanges} {
129 lappend commitinterest($mainheadid) {dodiffindex}
131 fconfigure $fd -blocking 0 -translation lf -eofchar {}
132 if {$tclencoding != {}} {
133 fconfigure $fd -encoding $tclencoding
135 filerun $fd [list getcommitlines $fd $i $view]
136 nowbusy $view [mc "Reading"]
137 if {$view == $curview} {
138 set progressdirn 1
139 set progresscoords {0 0}
140 set proglastnc 0
144 proc stop_rev_list {view} {
145 global commfd viewinstances leftover
147 foreach inst $viewinstances($view) {
148 set fd $commfd($inst)
149 catch {
150 set pid [pid $fd]
151 exec kill $pid
153 catch {close $fd}
154 nukefile $fd
155 unset commfd($inst)
156 unset leftover($inst)
158 set viewinstances($view) {}
161 proc getcommits {} {
162 global canv curview
164 initlayout
165 start_rev_list $curview
166 show_status [mc "Reading commits..."]
169 proc updatecommits {} {
170 global curview viewargs viewfiles viewincl viewinstances
171 global viewactive viewcomplete loginstance tclencoding mainheadid
172 global varcid startmsecs commfd showneartags showlocalchanges leftover
173 global mainheadid
175 set oldmainid $mainheadid
176 rereadrefs
177 if {$showlocalchanges} {
178 if {$mainheadid ne $oldmainid} {
179 dohidelocalchanges
181 if {[commitinview $mainheadid $curview]} {
182 dodiffindex
185 set view $curview
186 set commits [exec git rev-parse --default HEAD --revs-only \
187 $viewargs($view)]
188 set pos {}
189 set neg {}
190 foreach c $commits {
191 if {[string match "^*" $c]} {
192 lappend neg $c
193 } else {
194 if {!([info exists varcid($view,$c)] ||
195 [lsearch -exact $viewincl($view) $c] >= 0)} {
196 lappend pos $c
200 if {$pos eq {}} {
201 return
203 foreach id $viewincl($view) {
204 lappend neg "^$id"
206 set viewincl($view) [concat $viewincl($view) $pos]
207 if {[catch {
208 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
209 --boundary $pos $neg "--" $viewfiles($view)] r]
210 } err]} {
211 error_popup "Error executing git log: $err"
212 exit 1
214 if {$viewactive($view) == 0} {
215 set startmsecs [clock clicks -milliseconds]
217 set i [incr loginstance]
218 lappend viewinstances($view) $i
219 set commfd($i) $fd
220 set leftover($i) {}
221 fconfigure $fd -blocking 0 -translation lf -eofchar {}
222 if {$tclencoding != {}} {
223 fconfigure $fd -encoding $tclencoding
225 filerun $fd [list getcommitlines $fd $i $view]
226 incr viewactive($view)
227 set viewcomplete($view) 0
228 nowbusy $view "Reading"
229 if {$showneartags} {
230 getallcommits
234 proc reloadcommits {} {
235 global curview viewcomplete selectedline currentid thickerline
236 global showneartags treediffs commitinterest cached_commitrow
237 global progresscoords targetid
239 if {!$viewcomplete($curview)} {
240 stop_rev_list $curview
241 set progresscoords {0 0}
242 adjustprogress
244 resetvarcs $curview
245 catch {unset selectedline}
246 catch {unset currentid}
247 catch {unset thickerline}
248 catch {unset treediffs}
249 readrefs
250 changedrefs
251 if {$showneartags} {
252 getallcommits
254 clear_display
255 catch {unset commitinterest}
256 catch {unset cached_commitrow}
257 catch {unset targetid}
258 setcanvscroll
259 getcommits
262 # This makes a string representation of a positive integer which
263 # sorts as a string in numerical order
264 proc strrep {n} {
265 if {$n < 16} {
266 return [format "%x" $n]
267 } elseif {$n < 256} {
268 return [format "x%.2x" $n]
269 } elseif {$n < 65536} {
270 return [format "y%.4x" $n]
272 return [format "z%.8x" $n]
275 # Procedures used in reordering commits from git log (without
276 # --topo-order) into the order for display.
278 proc varcinit {view} {
279 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
280 global vtokmod varcmod vrowmod varcix vlastins
282 set varcstart($view) {{}}
283 set vupptr($view) {0}
284 set vdownptr($view) {0}
285 set vleftptr($view) {0}
286 set vbackptr($view) {0}
287 set varctok($view) {{}}
288 set varcrow($view) {{}}
289 set vtokmod($view) {}
290 set varcmod($view) 0
291 set vrowmod($view) 0
292 set varcix($view) {{}}
293 set vlastins($view) {0}
296 proc resetvarcs {view} {
297 global varcid varccommits parents children vseedcount ordertok
299 foreach vid [array names varcid $view,*] {
300 unset varcid($vid)
301 unset children($vid)
302 unset parents($vid)
304 # some commits might have children but haven't been seen yet
305 foreach vid [array names children $view,*] {
306 unset children($vid)
308 foreach va [array names varccommits $view,*] {
309 unset varccommits($va)
311 foreach vd [array names vseedcount $view,*] {
312 unset vseedcount($vd)
314 catch {unset ordertok}
317 proc newvarc {view id} {
318 global varcid varctok parents children datemode
319 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
320 global commitdata commitinfo vseedcount varccommits vlastins
322 set a [llength $varctok($view)]
323 set vid $view,$id
324 if {[llength $children($vid)] == 0 || $datemode} {
325 if {![info exists commitinfo($id)]} {
326 parsecommit $id $commitdata($id) 1
328 set cdate [lindex $commitinfo($id) 4]
329 if {![string is integer -strict $cdate]} {
330 set cdate 0
332 if {![info exists vseedcount($view,$cdate)]} {
333 set vseedcount($view,$cdate) -1
335 set c [incr vseedcount($view,$cdate)]
336 set cdate [expr {$cdate ^ 0xffffffff}]
337 set tok "s[strrep $cdate][strrep $c]"
338 } else {
339 set tok {}
341 set ka 0
342 if {[llength $children($vid)] > 0} {
343 set kid [lindex $children($vid) end]
344 set k $varcid($view,$kid)
345 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
346 set ki $kid
347 set ka $k
348 set tok [lindex $varctok($view) $k]
351 if {$ka != 0} {
352 set i [lsearch -exact $parents($view,$ki) $id]
353 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
354 append tok [strrep $j]
356 set c [lindex $vlastins($view) $ka]
357 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
358 set c $ka
359 set b [lindex $vdownptr($view) $ka]
360 } else {
361 set b [lindex $vleftptr($view) $c]
363 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
364 set c $b
365 set b [lindex $vleftptr($view) $c]
367 if {$c == $ka} {
368 lset vdownptr($view) $ka $a
369 lappend vbackptr($view) 0
370 } else {
371 lset vleftptr($view) $c $a
372 lappend vbackptr($view) $c
374 lset vlastins($view) $ka $a
375 lappend vupptr($view) $ka
376 lappend vleftptr($view) $b
377 if {$b != 0} {
378 lset vbackptr($view) $b $a
380 lappend varctok($view) $tok
381 lappend varcstart($view) $id
382 lappend vdownptr($view) 0
383 lappend varcrow($view) {}
384 lappend varcix($view) {}
385 set varccommits($view,$a) {}
386 lappend vlastins($view) 0
387 return $a
390 proc splitvarc {p v} {
391 global varcid varcstart varccommits varctok
392 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
394 set oa $varcid($v,$p)
395 set ac $varccommits($v,$oa)
396 set i [lsearch -exact $varccommits($v,$oa) $p]
397 if {$i <= 0} return
398 set na [llength $varctok($v)]
399 # "%" sorts before "0"...
400 set tok "[lindex $varctok($v) $oa]%[strrep $i]"
401 lappend varctok($v) $tok
402 lappend varcrow($v) {}
403 lappend varcix($v) {}
404 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
405 set varccommits($v,$na) [lrange $ac $i end]
406 lappend varcstart($v) $p
407 foreach id $varccommits($v,$na) {
408 set varcid($v,$id) $na
410 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
411 lset vdownptr($v) $oa $na
412 lappend vupptr($v) $oa
413 lappend vleftptr($v) 0
414 lappend vbackptr($v) 0
415 lappend vlastins($v) 0
416 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
417 lset vupptr($v) $b $na
421 proc renumbervarc {a v} {
422 global parents children varctok varcstart varccommits
423 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
425 set t1 [clock clicks -milliseconds]
426 set todo {}
427 set isrelated($a) 1
428 set kidchanged($a) 1
429 set ntot 0
430 while {$a != 0} {
431 if {[info exists isrelated($a)]} {
432 lappend todo $a
433 set id [lindex $varccommits($v,$a) end]
434 foreach p $parents($v,$id) {
435 if {[info exists varcid($v,$p)]} {
436 set isrelated($varcid($v,$p)) 1
440 incr ntot
441 set b [lindex $vdownptr($v) $a]
442 if {$b == 0} {
443 while {$a != 0} {
444 set b [lindex $vleftptr($v) $a]
445 if {$b != 0} break
446 set a [lindex $vupptr($v) $a]
449 set a $b
451 foreach a $todo {
452 if {![info exists kidchanged($a)]} continue
453 set id [lindex $varcstart($v) $a]
454 if {[llength $children($v,$id)] > 1} {
455 set children($v,$id) [lsort -command [list vtokcmp $v] \
456 $children($v,$id)]
458 set oldtok [lindex $varctok($v) $a]
459 if {!$datemode} {
460 set tok {}
461 } else {
462 set tok $oldtok
464 set ka 0
465 set kid [last_real_child $v,$id]
466 if {$kid ne {}} {
467 set k $varcid($v,$kid)
468 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
469 set ki $kid
470 set ka $k
471 set tok [lindex $varctok($v) $k]
474 if {$ka != 0} {
475 set i [lsearch -exact $parents($v,$ki) $id]
476 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
477 append tok [strrep $j]
479 if {$tok eq $oldtok} {
480 continue
482 set id [lindex $varccommits($v,$a) end]
483 foreach p $parents($v,$id) {
484 if {[info exists varcid($v,$p)]} {
485 set kidchanged($varcid($v,$p)) 1
486 } else {
487 set sortkids($p) 1
490 lset varctok($v) $a $tok
491 set b [lindex $vupptr($v) $a]
492 if {$b != $ka} {
493 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
494 modify_arc $v $ka
496 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
497 modify_arc $v $b
499 set c [lindex $vbackptr($v) $a]
500 set d [lindex $vleftptr($v) $a]
501 if {$c == 0} {
502 lset vdownptr($v) $b $d
503 } else {
504 lset vleftptr($v) $c $d
506 if {$d != 0} {
507 lset vbackptr($v) $d $c
509 lset vupptr($v) $a $ka
510 set c [lindex $vlastins($v) $ka]
511 if {$c == 0 || \
512 [string compare $tok [lindex $varctok($v) $c]] < 0} {
513 set c $ka
514 set b [lindex $vdownptr($v) $ka]
515 } else {
516 set b [lindex $vleftptr($v) $c]
518 while {$b != 0 && \
519 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
520 set c $b
521 set b [lindex $vleftptr($v) $c]
523 if {$c == $ka} {
524 lset vdownptr($v) $ka $a
525 lset vbackptr($v) $a 0
526 } else {
527 lset vleftptr($v) $c $a
528 lset vbackptr($v) $a $c
530 lset vleftptr($v) $a $b
531 if {$b != 0} {
532 lset vbackptr($v) $b $a
534 lset vlastins($v) $ka $a
537 foreach id [array names sortkids] {
538 if {[llength $children($v,$id)] > 1} {
539 set children($v,$id) [lsort -command [list vtokcmp $v] \
540 $children($v,$id)]
543 set t2 [clock clicks -milliseconds]
544 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
547 proc fix_reversal {p a v} {
548 global varcid varcstart varctok vupptr
550 set pa $varcid($v,$p)
551 if {$p ne [lindex $varcstart($v) $pa]} {
552 splitvarc $p $v
553 set pa $varcid($v,$p)
555 # seeds always need to be renumbered
556 if {[lindex $vupptr($v) $pa] == 0 ||
557 [string compare [lindex $varctok($v) $a] \
558 [lindex $varctok($v) $pa]] > 0} {
559 renumbervarc $pa $v
563 proc insertrow {id p v} {
564 global varcid varccommits parents children cmitlisted
565 global commitidx varctok vtokmod targetid targetrow
567 set a $varcid($v,$p)
568 set i [lsearch -exact $varccommits($v,$a) $p]
569 if {$i < 0} {
570 puts "oops: insertrow can't find [shortids $p] on arc $a"
571 return
573 set children($v,$id) {}
574 set parents($v,$id) [list $p]
575 set varcid($v,$id) $a
576 lappend children($v,$p) $id
577 set cmitlisted($v,$id) 1
578 incr commitidx($v)
579 # note we deliberately don't update varcstart($v) even if $i == 0
580 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
581 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
582 modify_arc $v $a $i
584 if {[info exists targetid]} {
585 if {![comes_before $targetid $p]} {
586 incr targetrow
589 drawvisible
592 proc removerow {id v} {
593 global varcid varccommits parents children commitidx
594 global varctok vtokmod cmitlisted currentid selectedline
595 global targetid
597 if {[llength $parents($v,$id)] != 1} {
598 puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
599 return
601 set p [lindex $parents($v,$id) 0]
602 set a $varcid($v,$id)
603 set i [lsearch -exact $varccommits($v,$a) $id]
604 if {$i < 0} {
605 puts "oops: removerow can't find [shortids $id] on arc $a"
606 return
608 unset varcid($v,$id)
609 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
610 unset parents($v,$id)
611 unset children($v,$id)
612 unset cmitlisted($v,$id)
613 incr commitidx($v) -1
614 set j [lsearch -exact $children($v,$p) $id]
615 if {$j >= 0} {
616 set children($v,$p) [lreplace $children($v,$p) $j $j]
618 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
619 modify_arc $v $a $i
621 if {[info exist currentid] && $id eq $currentid} {
622 unset currentid
623 unset selectedline
625 if {[info exists targetid] && $targetid eq $id} {
626 set targetid $p
628 drawvisible
631 proc first_real_child {vp} {
632 global children nullid nullid2
634 foreach id $children($vp) {
635 if {$id ne $nullid && $id ne $nullid2} {
636 return $id
639 return {}
642 proc last_real_child {vp} {
643 global children nullid nullid2
645 set kids $children($vp)
646 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
647 set id [lindex $kids $i]
648 if {$id ne $nullid && $id ne $nullid2} {
649 return $id
652 return {}
655 proc vtokcmp {v a b} {
656 global varctok varcid
658 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
659 [lindex $varctok($v) $varcid($v,$b)]]
662 proc modify_arc {v a {lim {}}} {
663 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
664 global vhighlights nhighlights fhighlights rhighlights
666 set vtokmod($v) [lindex $varctok($v) $a]
667 set varcmod($v) $a
668 if {$v == $curview} {
669 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
670 set a [lindex $vupptr($v) $a]
671 set lim {}
673 set r 0
674 if {$a != 0} {
675 if {$lim eq {}} {
676 set lim [llength $varccommits($v,$a)]
678 set r [expr {[lindex $varcrow($v) $a] + $lim}]
680 set vrowmod($v) $r
681 undolayout $r
683 catch {unset nhighlights}
684 catch {unset fhighlights}
685 catch {unset vhighlights}
686 catch {unset rhighlights}
689 proc update_arcrows {v} {
690 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
691 global varcid vrownum varcorder varcix varccommits
692 global vupptr vdownptr vleftptr varctok
693 global displayorder parentlist curview cached_commitrow
695 set narctot [expr {[llength $varctok($v)] - 1}]
696 set a $varcmod($v)
697 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
698 # go up the tree until we find something that has a row number,
699 # or we get to a seed
700 set a [lindex $vupptr($v) $a]
702 if {$a == 0} {
703 set a [lindex $vdownptr($v) 0]
704 if {$a == 0} return
705 set vrownum($v) {0}
706 set varcorder($v) [list $a]
707 lset varcix($v) $a 0
708 lset varcrow($v) $a 0
709 set arcn 0
710 set row 0
711 } else {
712 set arcn [lindex $varcix($v) $a]
713 # see if a is the last arc; if so, nothing to do
714 if {$arcn == $narctot - 1} {
715 return
717 if {[llength $vrownum($v)] > $arcn + 1} {
718 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
719 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
721 set row [lindex $varcrow($v) $a]
723 if {$v == $curview} {
724 if {[llength $displayorder] > $vrowmod($v)} {
725 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
726 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
728 catch {unset cached_commitrow}
730 while {1} {
731 set p $a
732 incr row [llength $varccommits($v,$a)]
733 # go down if possible
734 set b [lindex $vdownptr($v) $a]
735 if {$b == 0} {
736 # if not, go left, or go up until we can go left
737 while {$a != 0} {
738 set b [lindex $vleftptr($v) $a]
739 if {$b != 0} break
740 set a [lindex $vupptr($v) $a]
742 if {$a == 0} break
744 set a $b
745 incr arcn
746 lappend vrownum($v) $row
747 lappend varcorder($v) $a
748 lset varcix($v) $a $arcn
749 lset varcrow($v) $a $row
751 set vtokmod($v) [lindex $varctok($v) $p]
752 set varcmod($v) $p
753 set vrowmod($v) $row
754 if {[info exists currentid]} {
755 set selectedline [rowofcommit $currentid]
759 # Test whether view $v contains commit $id
760 proc commitinview {id v} {
761 global varcid
763 return [info exists varcid($v,$id)]
766 # Return the row number for commit $id in the current view
767 proc rowofcommit {id} {
768 global varcid varccommits varcrow curview cached_commitrow
769 global varctok vtokmod
771 set v $curview
772 if {![info exists varcid($v,$id)]} {
773 puts "oops rowofcommit no arc for [shortids $id]"
774 return {}
776 set a $varcid($v,$id)
777 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
778 update_arcrows $v
780 if {[info exists cached_commitrow($id)]} {
781 return $cached_commitrow($id)
783 set i [lsearch -exact $varccommits($v,$a) $id]
784 if {$i < 0} {
785 puts "oops didn't find commit [shortids $id] in arc $a"
786 return {}
788 incr i [lindex $varcrow($v) $a]
789 set cached_commitrow($id) $i
790 return $i
793 # Returns 1 if a is on an earlier row than b, otherwise 0
794 proc comes_before {a b} {
795 global varcid varctok curview
797 set v $curview
798 if {$a eq $b || ![info exists varcid($v,$a)] || \
799 ![info exists varcid($v,$b)]} {
800 return 0
802 if {$varcid($v,$a) != $varcid($v,$b)} {
803 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
804 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
806 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
809 proc bsearch {l elt} {
810 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
811 return 0
813 set lo 0
814 set hi [llength $l]
815 while {$hi - $lo > 1} {
816 set mid [expr {int(($lo + $hi) / 2)}]
817 set t [lindex $l $mid]
818 if {$elt < $t} {
819 set hi $mid
820 } elseif {$elt > $t} {
821 set lo $mid
822 } else {
823 return $mid
826 return $lo
829 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
830 proc make_disporder {start end} {
831 global vrownum curview commitidx displayorder parentlist
832 global varccommits varcorder parents vrowmod varcrow
833 global d_valid_start d_valid_end
835 if {$end > $vrowmod($curview)} {
836 update_arcrows $curview
838 set ai [bsearch $vrownum($curview) $start]
839 set start [lindex $vrownum($curview) $ai]
840 set narc [llength $vrownum($curview)]
841 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
842 set a [lindex $varcorder($curview) $ai]
843 set l [llength $displayorder]
844 set al [llength $varccommits($curview,$a)]
845 if {$l < $r + $al} {
846 if {$l < $r} {
847 set pad [ntimes [expr {$r - $l}] {}]
848 set displayorder [concat $displayorder $pad]
849 set parentlist [concat $parentlist $pad]
850 } elseif {$l > $r} {
851 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
852 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
854 foreach id $varccommits($curview,$a) {
855 lappend displayorder $id
856 lappend parentlist $parents($curview,$id)
858 } elseif {[lindex $displayorder $r] eq {}} {
859 set i $r
860 foreach id $varccommits($curview,$a) {
861 lset displayorder $i $id
862 lset parentlist $i $parents($curview,$id)
863 incr i
866 incr r $al
870 proc commitonrow {row} {
871 global displayorder
873 set id [lindex $displayorder $row]
874 if {$id eq {}} {
875 make_disporder $row [expr {$row + 1}]
876 set id [lindex $displayorder $row]
878 return $id
881 proc closevarcs {v} {
882 global varctok varccommits varcid parents children
883 global cmitlisted commitidx commitinterest vtokmod
885 set missing_parents 0
886 set scripts {}
887 set narcs [llength $varctok($v)]
888 for {set a 1} {$a < $narcs} {incr a} {
889 set id [lindex $varccommits($v,$a) end]
890 foreach p $parents($v,$id) {
891 if {[info exists varcid($v,$p)]} continue
892 # add p as a new commit
893 incr missing_parents
894 set cmitlisted($v,$p) 0
895 set parents($v,$p) {}
896 if {[llength $children($v,$p)] == 1 &&
897 [llength $parents($v,$id)] == 1} {
898 set b $a
899 } else {
900 set b [newvarc $v $p]
902 set varcid($v,$p) $b
903 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
904 modify_arc $v $b
906 lappend varccommits($v,$b) $p
907 incr commitidx($v)
908 if {[info exists commitinterest($p)]} {
909 foreach script $commitinterest($p) {
910 lappend scripts [string map [list "%I" $p] $script]
912 unset commitinterest($id)
916 if {$missing_parents > 0} {
917 foreach s $scripts {
918 eval $s
923 proc getcommitlines {fd inst view} {
924 global cmitlisted commitinterest leftover
925 global commitidx commitdata datemode
926 global parents children curview hlview
927 global vnextroot idpending ordertok
928 global varccommits varcid varctok vtokmod
930 set stuff [read $fd 500000]
931 # git log doesn't terminate the last commit with a null...
932 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
933 set stuff "\0"
935 if {$stuff == {}} {
936 if {![eof $fd]} {
937 return 1
939 global commfd viewcomplete viewactive viewname progresscoords
940 global viewinstances
941 unset commfd($inst)
942 set i [lsearch -exact $viewinstances($view) $inst]
943 if {$i >= 0} {
944 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
946 # set it blocking so we wait for the process to terminate
947 fconfigure $fd -blocking 1
948 if {[catch {close $fd} err]} {
949 set fv {}
950 if {$view != $curview} {
951 set fv " for the \"$viewname($view)\" view"
953 if {[string range $err 0 4] == "usage"} {
954 set err "Gitk: error reading commits$fv:\
955 bad arguments to git rev-list."
956 if {$viewname($view) eq "Command line"} {
957 append err \
958 " (Note: arguments to gitk are passed to git rev-list\
959 to allow selection of commits to be displayed.)"
961 } else {
962 set err "Error reading commits$fv: $err"
964 error_popup $err
966 if {[incr viewactive($view) -1] <= 0} {
967 set viewcomplete($view) 1
968 # Check if we have seen any ids listed as parents that haven't
969 # appeared in the list
970 closevarcs $view
971 notbusy $view
972 set progresscoords {0 0}
973 adjustprogress
975 if {$view == $curview} {
976 run chewcommits $view
978 return 0
980 set start 0
981 set gotsome 0
982 set scripts {}
983 while 1 {
984 set i [string first "\0" $stuff $start]
985 if {$i < 0} {
986 append leftover($inst) [string range $stuff $start end]
987 break
989 if {$start == 0} {
990 set cmit $leftover($inst)
991 append cmit [string range $stuff 0 [expr {$i - 1}]]
992 set leftover($inst) {}
993 } else {
994 set cmit [string range $stuff $start [expr {$i - 1}]]
996 set start [expr {$i + 1}]
997 set j [string first "\n" $cmit]
998 set ok 0
999 set listed 1
1000 if {$j >= 0 && [string match "commit *" $cmit]} {
1001 set ids [string range $cmit 7 [expr {$j - 1}]]
1002 if {[string match {[-<>]*} $ids]} {
1003 switch -- [string index $ids 0] {
1004 "-" {set listed 0}
1005 "<" {set listed 2}
1006 ">" {set listed 3}
1008 set ids [string range $ids 1 end]
1010 set ok 1
1011 foreach id $ids {
1012 if {[string length $id] != 40} {
1013 set ok 0
1014 break
1018 if {!$ok} {
1019 set shortcmit $cmit
1020 if {[string length $shortcmit] > 80} {
1021 set shortcmit "[string range $shortcmit 0 80]..."
1023 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1024 exit 1
1026 set id [lindex $ids 0]
1027 set vid $view,$id
1028 if {!$listed && [info exists parents($vid)]} continue
1029 if {$listed} {
1030 set olds [lrange $ids 1 end]
1031 } else {
1032 set olds {}
1034 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1035 set cmitlisted($vid) $listed
1036 set parents($vid) $olds
1037 set a 0
1038 if {![info exists children($vid)]} {
1039 set children($vid) {}
1040 } elseif {[llength $children($vid)] == 1} {
1041 set k [lindex $children($vid) 0]
1042 if {[llength $parents($view,$k)] == 1 &&
1043 (!$datemode ||
1044 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1045 set a $varcid($view,$k)
1048 if {$a == 0} {
1049 # new arc
1050 set a [newvarc $view $id]
1052 set varcid($vid) $a
1053 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1054 modify_arc $view $a
1056 lappend varccommits($view,$a) $id
1058 set i 0
1059 foreach p $olds {
1060 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1061 set vp $view,$p
1062 if {[llength [lappend children($vp) $id]] > 1 &&
1063 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1064 set children($vp) [lsort -command [list vtokcmp $view] \
1065 $children($vp)]
1066 catch {unset ordertok}
1068 if {[info exists varcid($view,$p)]} {
1069 fix_reversal $p $a $view
1072 incr i
1075 incr commitidx($view)
1076 if {[info exists commitinterest($id)]} {
1077 foreach script $commitinterest($id) {
1078 lappend scripts [string map [list "%I" $id] $script]
1080 unset commitinterest($id)
1082 set gotsome 1
1084 if {$gotsome} {
1085 run chewcommits $view
1086 foreach s $scripts {
1087 eval $s
1089 if {$view == $curview} {
1090 # update progress bar
1091 global progressdirn progresscoords proglastnc
1092 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1093 set proglastnc $commitidx($view)
1094 set l [lindex $progresscoords 0]
1095 set r [lindex $progresscoords 1]
1096 if {$progressdirn} {
1097 set r [expr {$r + $inc}]
1098 if {$r >= 1.0} {
1099 set r 1.0
1100 set progressdirn 0
1102 if {$r > 0.2} {
1103 set l [expr {$r - 0.2}]
1105 } else {
1106 set l [expr {$l - $inc}]
1107 if {$l <= 0.0} {
1108 set l 0.0
1109 set progressdirn 1
1111 set r [expr {$l + 0.2}]
1113 set progresscoords [list $l $r]
1114 adjustprogress
1117 return 2
1120 proc chewcommits {view} {
1121 global curview hlview viewcomplete
1122 global pending_select
1124 if {$view == $curview} {
1125 layoutmore
1126 if {$viewcomplete($view)} {
1127 global commitidx varctok
1128 global numcommits startmsecs
1129 global mainheadid commitinfo nullid
1131 if {[info exists pending_select]} {
1132 set row [first_real_row]
1133 selectline $row 1
1135 if {$commitidx($curview) > 0} {
1136 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1137 #puts "overall $ms ms for $numcommits commits"
1138 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1139 } else {
1140 show_status [mc "No commits selected"]
1142 notbusy layout
1145 if {[info exists hlview] && $view == $hlview} {
1146 vhighlightmore
1148 return 0
1151 proc readcommit {id} {
1152 if {[catch {set contents [exec git cat-file commit $id]}]} return
1153 parsecommit $id $contents 0
1156 proc parsecommit {id contents listed} {
1157 global commitinfo cdate
1159 set inhdr 1
1160 set comment {}
1161 set headline {}
1162 set auname {}
1163 set audate {}
1164 set comname {}
1165 set comdate {}
1166 set hdrend [string first "\n\n" $contents]
1167 if {$hdrend < 0} {
1168 # should never happen...
1169 set hdrend [string length $contents]
1171 set header [string range $contents 0 [expr {$hdrend - 1}]]
1172 set comment [string range $contents [expr {$hdrend + 2}] end]
1173 foreach line [split $header "\n"] {
1174 set tag [lindex $line 0]
1175 if {$tag == "author"} {
1176 set audate [lindex $line end-1]
1177 set auname [lrange $line 1 end-2]
1178 } elseif {$tag == "committer"} {
1179 set comdate [lindex $line end-1]
1180 set comname [lrange $line 1 end-2]
1183 set headline {}
1184 # take the first non-blank line of the comment as the headline
1185 set headline [string trimleft $comment]
1186 set i [string first "\n" $headline]
1187 if {$i >= 0} {
1188 set headline [string range $headline 0 $i]
1190 set headline [string trimright $headline]
1191 set i [string first "\r" $headline]
1192 if {$i >= 0} {
1193 set headline [string trimright [string range $headline 0 $i]]
1195 if {!$listed} {
1196 # git rev-list indents the comment by 4 spaces;
1197 # if we got this via git cat-file, add the indentation
1198 set newcomment {}
1199 foreach line [split $comment "\n"] {
1200 append newcomment " "
1201 append newcomment $line
1202 append newcomment "\n"
1204 set comment $newcomment
1206 if {$comdate != {}} {
1207 set cdate($id) $comdate
1209 set commitinfo($id) [list $headline $auname $audate \
1210 $comname $comdate $comment]
1213 proc getcommit {id} {
1214 global commitdata commitinfo
1216 if {[info exists commitdata($id)]} {
1217 parsecommit $id $commitdata($id) 1
1218 } else {
1219 readcommit $id
1220 if {![info exists commitinfo($id)]} {
1221 set commitinfo($id) [list [mc "No commit information available"]]
1224 return 1
1227 proc readrefs {} {
1228 global tagids idtags headids idheads tagobjid
1229 global otherrefids idotherrefs mainhead mainheadid
1231 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1232 catch {unset $v}
1234 set refd [open [list | git show-ref -d] r]
1235 while {[gets $refd line] >= 0} {
1236 if {[string index $line 40] ne " "} continue
1237 set id [string range $line 0 39]
1238 set ref [string range $line 41 end]
1239 if {![string match "refs/*" $ref]} continue
1240 set name [string range $ref 5 end]
1241 if {[string match "remotes/*" $name]} {
1242 if {![string match "*/HEAD" $name]} {
1243 set headids($name) $id
1244 lappend idheads($id) $name
1246 } elseif {[string match "heads/*" $name]} {
1247 set name [string range $name 6 end]
1248 set headids($name) $id
1249 lappend idheads($id) $name
1250 } elseif {[string match "tags/*" $name]} {
1251 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1252 # which is what we want since the former is the commit ID
1253 set name [string range $name 5 end]
1254 if {[string match "*^{}" $name]} {
1255 set name [string range $name 0 end-3]
1256 } else {
1257 set tagobjid($name) $id
1259 set tagids($name) $id
1260 lappend idtags($id) $name
1261 } else {
1262 set otherrefids($name) $id
1263 lappend idotherrefs($id) $name
1266 catch {close $refd}
1267 set mainhead {}
1268 set mainheadid {}
1269 catch {
1270 set thehead [exec git symbolic-ref HEAD]
1271 if {[string match "refs/heads/*" $thehead]} {
1272 set mainhead [string range $thehead 11 end]
1273 if {[info exists headids($mainhead)]} {
1274 set mainheadid $headids($mainhead)
1280 # skip over fake commits
1281 proc first_real_row {} {
1282 global nullid nullid2 numcommits
1284 for {set row 0} {$row < $numcommits} {incr row} {
1285 set id [commitonrow $row]
1286 if {$id ne $nullid && $id ne $nullid2} {
1287 break
1290 return $row
1293 # update things for a head moved to a child of its previous location
1294 proc movehead {id name} {
1295 global headids idheads
1297 removehead $headids($name) $name
1298 set headids($name) $id
1299 lappend idheads($id) $name
1302 # update things when a head has been removed
1303 proc removehead {id name} {
1304 global headids idheads
1306 if {$idheads($id) eq $name} {
1307 unset idheads($id)
1308 } else {
1309 set i [lsearch -exact $idheads($id) $name]
1310 if {$i >= 0} {
1311 set idheads($id) [lreplace $idheads($id) $i $i]
1314 unset headids($name)
1317 proc show_error {w top msg} {
1318 message $w.m -text $msg -justify center -aspect 400
1319 pack $w.m -side top -fill x -padx 20 -pady 20
1320 button $w.ok -text [mc OK] -command "destroy $top"
1321 pack $w.ok -side bottom -fill x
1322 bind $top <Visibility> "grab $top; focus $top"
1323 bind $top <Key-Return> "destroy $top"
1324 tkwait window $top
1327 proc error_popup msg {
1328 set w .error
1329 toplevel $w
1330 wm transient $w .
1331 show_error $w $w $msg
1334 proc confirm_popup msg {
1335 global confirm_ok
1336 set confirm_ok 0
1337 set w .confirm
1338 toplevel $w
1339 wm transient $w .
1340 message $w.m -text $msg -justify center -aspect 400
1341 pack $w.m -side top -fill x -padx 20 -pady 20
1342 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1343 pack $w.ok -side left -fill x
1344 button $w.cancel -text [mc Cancel] -command "destroy $w"
1345 pack $w.cancel -side right -fill x
1346 bind $w <Visibility> "grab $w; focus $w"
1347 tkwait window $w
1348 return $confirm_ok
1351 proc setoptions {} {
1352 option add *Panedwindow.showHandle 1 startupFile
1353 option add *Panedwindow.sashRelief raised startupFile
1354 option add *Button.font uifont startupFile
1355 option add *Checkbutton.font uifont startupFile
1356 option add *Radiobutton.font uifont startupFile
1357 option add *Menu.font uifont startupFile
1358 option add *Menubutton.font uifont startupFile
1359 option add *Label.font uifont startupFile
1360 option add *Message.font uifont startupFile
1361 option add *Entry.font uifont startupFile
1364 proc makewindow {} {
1365 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1366 global tabstop
1367 global findtype findtypemenu findloc findstring fstring geometry
1368 global entries sha1entry sha1string sha1but
1369 global diffcontextstring diffcontext
1370 global maincursor textcursor curtextcursor
1371 global rowctxmenu fakerowmenu mergemax wrapcomment
1372 global highlight_files gdttype
1373 global searchstring sstring
1374 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1375 global headctxmenu progresscanv progressitem progresscoords statusw
1376 global fprogitem fprogcoord lastprogupdate progupdatepending
1377 global rprogitem rprogcoord
1378 global have_tk85
1380 menu .bar
1381 .bar add cascade -label [mc "File"] -menu .bar.file
1382 menu .bar.file
1383 .bar.file add command -label [mc "Update"] -command updatecommits
1384 .bar.file add command -label [mc "Reload"] -command reloadcommits
1385 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1386 .bar.file add command -label [mc "List references"] -command showrefs
1387 .bar.file add command -label [mc "Quit"] -command doquit
1388 menu .bar.edit
1389 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1390 .bar.edit add command -label [mc "Preferences"] -command doprefs
1392 menu .bar.view
1393 .bar add cascade -label [mc "View"] -menu .bar.view
1394 .bar.view add command -label [mc "New view..."] -command {newview 0}
1395 .bar.view add command -label [mc "Edit view..."] -command editview \
1396 -state disabled
1397 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
1398 .bar.view add separator
1399 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
1400 -variable selectedview -value 0
1402 menu .bar.help
1403 .bar add cascade -label [mc "Help"] -menu .bar.help
1404 .bar.help add command -label [mc "About gitk"] -command about
1405 .bar.help add command -label [mc "Key bindings"] -command keys
1406 .bar.help configure
1407 . configure -menu .bar
1409 # the gui has upper and lower half, parts of a paned window.
1410 panedwindow .ctop -orient vertical
1412 # possibly use assumed geometry
1413 if {![info exists geometry(pwsash0)]} {
1414 set geometry(topheight) [expr {15 * $linespc}]
1415 set geometry(topwidth) [expr {80 * $charspc}]
1416 set geometry(botheight) [expr {15 * $linespc}]
1417 set geometry(botwidth) [expr {50 * $charspc}]
1418 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1419 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1422 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1423 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1424 frame .tf.histframe
1425 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1427 # create three canvases
1428 set cscroll .tf.histframe.csb
1429 set canv .tf.histframe.pwclist.canv
1430 canvas $canv \
1431 -selectbackground $selectbgcolor \
1432 -background $bgcolor -bd 0 \
1433 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1434 .tf.histframe.pwclist add $canv
1435 set canv2 .tf.histframe.pwclist.canv2
1436 canvas $canv2 \
1437 -selectbackground $selectbgcolor \
1438 -background $bgcolor -bd 0 -yscrollincr $linespc
1439 .tf.histframe.pwclist add $canv2
1440 set canv3 .tf.histframe.pwclist.canv3
1441 canvas $canv3 \
1442 -selectbackground $selectbgcolor \
1443 -background $bgcolor -bd 0 -yscrollincr $linespc
1444 .tf.histframe.pwclist add $canv3
1445 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1446 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1448 # a scroll bar to rule them
1449 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1450 pack $cscroll -side right -fill y
1451 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1452 lappend bglist $canv $canv2 $canv3
1453 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1455 # we have two button bars at bottom of top frame. Bar 1
1456 frame .tf.bar
1457 frame .tf.lbar -height 15
1459 set sha1entry .tf.bar.sha1
1460 set entries $sha1entry
1461 set sha1but .tf.bar.sha1label
1462 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1463 -command gotocommit -width 8
1464 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1465 pack .tf.bar.sha1label -side left
1466 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1467 trace add variable sha1string write sha1change
1468 pack $sha1entry -side left -pady 2
1470 image create bitmap bm-left -data {
1471 #define left_width 16
1472 #define left_height 16
1473 static unsigned char left_bits[] = {
1474 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1475 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1476 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1478 image create bitmap bm-right -data {
1479 #define right_width 16
1480 #define right_height 16
1481 static unsigned char right_bits[] = {
1482 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1483 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1484 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1486 button .tf.bar.leftbut -image bm-left -command goback \
1487 -state disabled -width 26
1488 pack .tf.bar.leftbut -side left -fill y
1489 button .tf.bar.rightbut -image bm-right -command goforw \
1490 -state disabled -width 26
1491 pack .tf.bar.rightbut -side left -fill y
1493 # Status label and progress bar
1494 set statusw .tf.bar.status
1495 label $statusw -width 15 -relief sunken
1496 pack $statusw -side left -padx 5
1497 set h [expr {[font metrics uifont -linespace] + 2}]
1498 set progresscanv .tf.bar.progress
1499 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1500 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1501 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1502 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1503 pack $progresscanv -side right -expand 1 -fill x
1504 set progresscoords {0 0}
1505 set fprogcoord 0
1506 set rprogcoord 0
1507 bind $progresscanv <Configure> adjustprogress
1508 set lastprogupdate [clock clicks -milliseconds]
1509 set progupdatepending 0
1511 # build up the bottom bar of upper window
1512 label .tf.lbar.flabel -text "[mc "Find"] "
1513 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1514 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1515 label .tf.lbar.flab2 -text " [mc "commit"] "
1516 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1517 -side left -fill y
1518 set gdttype [mc "containing:"]
1519 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1520 [mc "containing:"] \
1521 [mc "touching paths:"] \
1522 [mc "adding/removing string:"]]
1523 trace add variable gdttype write gdttype_change
1524 pack .tf.lbar.gdttype -side left -fill y
1526 set findstring {}
1527 set fstring .tf.lbar.findstring
1528 lappend entries $fstring
1529 entry $fstring -width 30 -font textfont -textvariable findstring
1530 trace add variable findstring write find_change
1531 set findtype [mc "Exact"]
1532 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1533 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
1534 trace add variable findtype write findcom_change
1535 set findloc [mc "All fields"]
1536 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1537 [mc "Comments"] [mc "Author"] [mc "Committer"]
1538 trace add variable findloc write find_change
1539 pack .tf.lbar.findloc -side right
1540 pack .tf.lbar.findtype -side right
1541 pack $fstring -side left -expand 1 -fill x
1543 # Finish putting the upper half of the viewer together
1544 pack .tf.lbar -in .tf -side bottom -fill x
1545 pack .tf.bar -in .tf -side bottom -fill x
1546 pack .tf.histframe -fill both -side top -expand 1
1547 .ctop add .tf
1548 .ctop paneconfigure .tf -height $geometry(topheight)
1549 .ctop paneconfigure .tf -width $geometry(topwidth)
1551 # now build up the bottom
1552 panedwindow .pwbottom -orient horizontal
1554 # lower left, a text box over search bar, scroll bar to the right
1555 # if we know window height, then that will set the lower text height, otherwise
1556 # we set lower text height which will drive window height
1557 if {[info exists geometry(main)]} {
1558 frame .bleft -width $geometry(botwidth)
1559 } else {
1560 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1562 frame .bleft.top
1563 frame .bleft.mid
1565 button .bleft.top.search -text [mc "Search"] -command dosearch
1566 pack .bleft.top.search -side left -padx 5
1567 set sstring .bleft.top.sstring
1568 entry $sstring -width 20 -font textfont -textvariable searchstring
1569 lappend entries $sstring
1570 trace add variable searchstring write incrsearch
1571 pack $sstring -side left -expand 1 -fill x
1572 radiobutton .bleft.mid.diff -text [mc "Diff"] \
1573 -command changediffdisp -variable diffelide -value {0 0}
1574 radiobutton .bleft.mid.old -text [mc "Old version"] \
1575 -command changediffdisp -variable diffelide -value {0 1}
1576 radiobutton .bleft.mid.new -text [mc "New version"] \
1577 -command changediffdisp -variable diffelide -value {1 0}
1578 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
1579 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1580 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1581 -from 1 -increment 1 -to 10000000 \
1582 -validate all -validatecommand "diffcontextvalidate %P" \
1583 -textvariable diffcontextstring
1584 .bleft.mid.diffcontext set $diffcontext
1585 trace add variable diffcontextstring write diffcontextchange
1586 lappend entries .bleft.mid.diffcontext
1587 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1588 set ctext .bleft.ctext
1589 text $ctext -background $bgcolor -foreground $fgcolor \
1590 -state disabled -font textfont \
1591 -yscrollcommand scrolltext -wrap none
1592 if {$have_tk85} {
1593 $ctext conf -tabstyle wordprocessor
1595 scrollbar .bleft.sb -command "$ctext yview"
1596 pack .bleft.top -side top -fill x
1597 pack .bleft.mid -side top -fill x
1598 pack .bleft.sb -side right -fill y
1599 pack $ctext -side left -fill both -expand 1
1600 lappend bglist $ctext
1601 lappend fglist $ctext
1603 $ctext tag conf comment -wrap $wrapcomment
1604 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
1605 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1606 $ctext tag conf d0 -fore [lindex $diffcolors 0]
1607 $ctext tag conf d1 -fore [lindex $diffcolors 1]
1608 $ctext tag conf m0 -fore red
1609 $ctext tag conf m1 -fore blue
1610 $ctext tag conf m2 -fore green
1611 $ctext tag conf m3 -fore purple
1612 $ctext tag conf m4 -fore brown
1613 $ctext tag conf m5 -fore "#009090"
1614 $ctext tag conf m6 -fore magenta
1615 $ctext tag conf m7 -fore "#808000"
1616 $ctext tag conf m8 -fore "#009000"
1617 $ctext tag conf m9 -fore "#ff0080"
1618 $ctext tag conf m10 -fore cyan
1619 $ctext tag conf m11 -fore "#b07070"
1620 $ctext tag conf m12 -fore "#70b0f0"
1621 $ctext tag conf m13 -fore "#70f0b0"
1622 $ctext tag conf m14 -fore "#f0b070"
1623 $ctext tag conf m15 -fore "#ff70b0"
1624 $ctext tag conf mmax -fore darkgrey
1625 set mergemax 16
1626 $ctext tag conf mresult -font textfontbold
1627 $ctext tag conf msep -font textfontbold
1628 $ctext tag conf found -back yellow
1630 .pwbottom add .bleft
1631 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
1633 # lower right
1634 frame .bright
1635 frame .bright.mode
1636 radiobutton .bright.mode.patch -text [mc "Patch"] \
1637 -command reselectline -variable cmitmode -value "patch"
1638 radiobutton .bright.mode.tree -text [mc "Tree"] \
1639 -command reselectline -variable cmitmode -value "tree"
1640 grid .bright.mode.patch .bright.mode.tree -sticky ew
1641 pack .bright.mode -side top -fill x
1642 set cflist .bright.cfiles
1643 set indent [font measure mainfont "nn"]
1644 text $cflist \
1645 -selectbackground $selectbgcolor \
1646 -background $bgcolor -foreground $fgcolor \
1647 -font mainfont \
1648 -tabs [list $indent [expr {2 * $indent}]] \
1649 -yscrollcommand ".bright.sb set" \
1650 -cursor [. cget -cursor] \
1651 -spacing1 1 -spacing3 1
1652 lappend bglist $cflist
1653 lappend fglist $cflist
1654 scrollbar .bright.sb -command "$cflist yview"
1655 pack .bright.sb -side right -fill y
1656 pack $cflist -side left -fill both -expand 1
1657 $cflist tag configure highlight \
1658 -background [$cflist cget -selectbackground]
1659 $cflist tag configure bold -font mainfontbold
1661 .pwbottom add .bright
1662 .ctop add .pwbottom
1664 # restore window position if known
1665 if {[info exists geometry(main)]} {
1666 wm geometry . "$geometry(main)"
1669 if {[tk windowingsystem] eq {aqua}} {
1670 set M1B M1
1671 } else {
1672 set M1B Control
1675 bind .pwbottom <Configure> {resizecdetpanes %W %w}
1676 pack .ctop -fill both -expand 1
1677 bindall <1> {selcanvline %W %x %y}
1678 #bindall <B1-Motion> {selcanvline %W %x %y}
1679 if {[tk windowingsystem] == "win32"} {
1680 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1681 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1682 } else {
1683 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1684 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
1685 if {[tk windowingsystem] eq "aqua"} {
1686 bindall <MouseWheel> {
1687 set delta [expr {- (%D)}]
1688 allcanvs yview scroll $delta units
1692 bindall <2> "canvscan mark %W %x %y"
1693 bindall <B2-Motion> "canvscan dragto %W %x %y"
1694 bindkey <Home> selfirstline
1695 bindkey <End> sellastline
1696 bind . <Key-Up> "selnextline -1"
1697 bind . <Key-Down> "selnextline 1"
1698 bind . <Shift-Key-Up> "dofind -1 0"
1699 bind . <Shift-Key-Down> "dofind 1 0"
1700 bindkey <Key-Right> "goforw"
1701 bindkey <Key-Left> "goback"
1702 bind . <Key-Prior> "selnextpage -1"
1703 bind . <Key-Next> "selnextpage 1"
1704 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1705 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1706 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1707 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1708 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1709 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1710 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1711 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1712 bindkey <Key-space> "$ctext yview scroll 1 pages"
1713 bindkey p "selnextline -1"
1714 bindkey n "selnextline 1"
1715 bindkey z "goback"
1716 bindkey x "goforw"
1717 bindkey i "selnextline -1"
1718 bindkey k "selnextline 1"
1719 bindkey j "goback"
1720 bindkey l "goforw"
1721 bindkey b "$ctext yview scroll -1 pages"
1722 bindkey d "$ctext yview scroll 18 units"
1723 bindkey u "$ctext yview scroll -18 units"
1724 bindkey / {dofind 1 1}
1725 bindkey <Key-Return> {dofind 1 1}
1726 bindkey ? {dofind -1 1}
1727 bindkey f nextfile
1728 bindkey <F5> updatecommits
1729 bind . <$M1B-q> doquit
1730 bind . <$M1B-f> {dofind 1 1}
1731 bind . <$M1B-g> {dofind 1 0}
1732 bind . <$M1B-r> dosearchback
1733 bind . <$M1B-s> dosearch
1734 bind . <$M1B-equal> {incrfont 1}
1735 bind . <$M1B-KP_Add> {incrfont 1}
1736 bind . <$M1B-minus> {incrfont -1}
1737 bind . <$M1B-KP_Subtract> {incrfont -1}
1738 wm protocol . WM_DELETE_WINDOW doquit
1739 bind . <Button-1> "click %W"
1740 bind $fstring <Key-Return> {dofind 1 1}
1741 bind $sha1entry <Key-Return> gotocommit
1742 bind $sha1entry <<PasteSelection>> clearsha1
1743 bind $cflist <1> {sel_flist %W %x %y; break}
1744 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1745 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1746 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1748 set maincursor [. cget -cursor]
1749 set textcursor [$ctext cget -cursor]
1750 set curtextcursor $textcursor
1752 set rowctxmenu .rowctxmenu
1753 menu $rowctxmenu -tearoff 0
1754 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1755 -command {diffvssel 0}
1756 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1757 -command {diffvssel 1}
1758 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1759 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1760 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1761 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1762 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1763 -command cherrypick
1764 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1765 -command resethead
1767 set fakerowmenu .fakerowmenu
1768 menu $fakerowmenu -tearoff 0
1769 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1770 -command {diffvssel 0}
1771 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1772 -command {diffvssel 1}
1773 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1774 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1775 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1776 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1778 set headctxmenu .headctxmenu
1779 menu $headctxmenu -tearoff 0
1780 $headctxmenu add command -label [mc "Check out this branch"] \
1781 -command cobranch
1782 $headctxmenu add command -label [mc "Remove this branch"] \
1783 -command rmbranch
1785 global flist_menu
1786 set flist_menu .flistctxmenu
1787 menu $flist_menu -tearoff 0
1788 $flist_menu add command -label [mc "Highlight this too"] \
1789 -command {flist_hl 0}
1790 $flist_menu add command -label [mc "Highlight this only"] \
1791 -command {flist_hl 1}
1794 # Windows sends all mouse wheel events to the current focused window, not
1795 # the one where the mouse hovers, so bind those events here and redirect
1796 # to the correct window
1797 proc windows_mousewheel_redirector {W X Y D} {
1798 global canv canv2 canv3
1799 set w [winfo containing -displayof $W $X $Y]
1800 if {$w ne ""} {
1801 set u [expr {$D < 0 ? 5 : -5}]
1802 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1803 allcanvs yview scroll $u units
1804 } else {
1805 catch {
1806 $w yview scroll $u units
1812 # mouse-2 makes all windows scan vertically, but only the one
1813 # the cursor is in scans horizontally
1814 proc canvscan {op w x y} {
1815 global canv canv2 canv3
1816 foreach c [list $canv $canv2 $canv3] {
1817 if {$c == $w} {
1818 $c scan $op $x $y
1819 } else {
1820 $c scan $op 0 $y
1825 proc scrollcanv {cscroll f0 f1} {
1826 $cscroll set $f0 $f1
1827 drawvisible
1828 flushhighlights
1831 # when we make a key binding for the toplevel, make sure
1832 # it doesn't get triggered when that key is pressed in the
1833 # find string entry widget.
1834 proc bindkey {ev script} {
1835 global entries
1836 bind . $ev $script
1837 set escript [bind Entry $ev]
1838 if {$escript == {}} {
1839 set escript [bind Entry <Key>]
1841 foreach e $entries {
1842 bind $e $ev "$escript; break"
1846 # set the focus back to the toplevel for any click outside
1847 # the entry widgets
1848 proc click {w} {
1849 global ctext entries
1850 foreach e [concat $entries $ctext] {
1851 if {$w == $e} return
1853 focus .
1856 # Adjust the progress bar for a change in requested extent or canvas size
1857 proc adjustprogress {} {
1858 global progresscanv progressitem progresscoords
1859 global fprogitem fprogcoord lastprogupdate progupdatepending
1860 global rprogitem rprogcoord
1862 set w [expr {[winfo width $progresscanv] - 4}]
1863 set x0 [expr {$w * [lindex $progresscoords 0]}]
1864 set x1 [expr {$w * [lindex $progresscoords 1]}]
1865 set h [winfo height $progresscanv]
1866 $progresscanv coords $progressitem $x0 0 $x1 $h
1867 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1868 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1869 set now [clock clicks -milliseconds]
1870 if {$now >= $lastprogupdate + 100} {
1871 set progupdatepending 0
1872 update
1873 } elseif {!$progupdatepending} {
1874 set progupdatepending 1
1875 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1879 proc doprogupdate {} {
1880 global lastprogupdate progupdatepending
1882 if {$progupdatepending} {
1883 set progupdatepending 0
1884 set lastprogupdate [clock clicks -milliseconds]
1885 update
1889 proc savestuff {w} {
1890 global canv canv2 canv3 mainfont textfont uifont tabstop
1891 global stuffsaved findmergefiles maxgraphpct
1892 global maxwidth showneartags showlocalchanges
1893 global viewname viewfiles viewargs viewperm nextviewnum
1894 global cmitmode wrapcomment datetimeformat limitdiffs
1895 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1897 if {$stuffsaved} return
1898 if {![winfo viewable .]} return
1899 catch {
1900 set f [open "~/.gitk-new" w]
1901 puts $f [list set mainfont $mainfont]
1902 puts $f [list set textfont $textfont]
1903 puts $f [list set uifont $uifont]
1904 puts $f [list set tabstop $tabstop]
1905 puts $f [list set findmergefiles $findmergefiles]
1906 puts $f [list set maxgraphpct $maxgraphpct]
1907 puts $f [list set maxwidth $maxwidth]
1908 puts $f [list set cmitmode $cmitmode]
1909 puts $f [list set wrapcomment $wrapcomment]
1910 puts $f [list set showneartags $showneartags]
1911 puts $f [list set showlocalchanges $showlocalchanges]
1912 puts $f [list set datetimeformat $datetimeformat]
1913 puts $f [list set limitdiffs $limitdiffs]
1914 puts $f [list set bgcolor $bgcolor]
1915 puts $f [list set fgcolor $fgcolor]
1916 puts $f [list set colors $colors]
1917 puts $f [list set diffcolors $diffcolors]
1918 puts $f [list set diffcontext $diffcontext]
1919 puts $f [list set selectbgcolor $selectbgcolor]
1921 puts $f "set geometry(main) [wm geometry .]"
1922 puts $f "set geometry(topwidth) [winfo width .tf]"
1923 puts $f "set geometry(topheight) [winfo height .tf]"
1924 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1925 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1926 puts $f "set geometry(botwidth) [winfo width .bleft]"
1927 puts $f "set geometry(botheight) [winfo height .bleft]"
1929 puts -nonewline $f "set permviews {"
1930 for {set v 0} {$v < $nextviewnum} {incr v} {
1931 if {$viewperm($v)} {
1932 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1935 puts $f "}"
1936 close $f
1937 file rename -force "~/.gitk-new" "~/.gitk"
1939 set stuffsaved 1
1942 proc resizeclistpanes {win w} {
1943 global oldwidth
1944 if {[info exists oldwidth($win)]} {
1945 set s0 [$win sash coord 0]
1946 set s1 [$win sash coord 1]
1947 if {$w < 60} {
1948 set sash0 [expr {int($w/2 - 2)}]
1949 set sash1 [expr {int($w*5/6 - 2)}]
1950 } else {
1951 set factor [expr {1.0 * $w / $oldwidth($win)}]
1952 set sash0 [expr {int($factor * [lindex $s0 0])}]
1953 set sash1 [expr {int($factor * [lindex $s1 0])}]
1954 if {$sash0 < 30} {
1955 set sash0 30
1957 if {$sash1 < $sash0 + 20} {
1958 set sash1 [expr {$sash0 + 20}]
1960 if {$sash1 > $w - 10} {
1961 set sash1 [expr {$w - 10}]
1962 if {$sash0 > $sash1 - 20} {
1963 set sash0 [expr {$sash1 - 20}]
1967 $win sash place 0 $sash0 [lindex $s0 1]
1968 $win sash place 1 $sash1 [lindex $s1 1]
1970 set oldwidth($win) $w
1973 proc resizecdetpanes {win w} {
1974 global oldwidth
1975 if {[info exists oldwidth($win)]} {
1976 set s0 [$win sash coord 0]
1977 if {$w < 60} {
1978 set sash0 [expr {int($w*3/4 - 2)}]
1979 } else {
1980 set factor [expr {1.0 * $w / $oldwidth($win)}]
1981 set sash0 [expr {int($factor * [lindex $s0 0])}]
1982 if {$sash0 < 45} {
1983 set sash0 45
1985 if {$sash0 > $w - 15} {
1986 set sash0 [expr {$w - 15}]
1989 $win sash place 0 $sash0 [lindex $s0 1]
1991 set oldwidth($win) $w
1994 proc allcanvs args {
1995 global canv canv2 canv3
1996 eval $canv $args
1997 eval $canv2 $args
1998 eval $canv3 $args
2001 proc bindall {event action} {
2002 global canv canv2 canv3
2003 bind $canv $event $action
2004 bind $canv2 $event $action
2005 bind $canv3 $event $action
2008 proc about {} {
2009 global uifont
2010 set w .about
2011 if {[winfo exists $w]} {
2012 raise $w
2013 return
2015 toplevel $w
2016 wm title $w [mc "About gitk"]
2017 message $w.m -text [mc "
2018 Gitk - a commit viewer for git
2020 Copyright © 2005-2006 Paul Mackerras
2022 Use and redistribute under the terms of the GNU General Public License"] \
2023 -justify center -aspect 400 -border 2 -bg white -relief groove
2024 pack $w.m -side top -fill x -padx 2 -pady 2
2025 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2026 pack $w.ok -side bottom
2027 bind $w <Visibility> "focus $w.ok"
2028 bind $w <Key-Escape> "destroy $w"
2029 bind $w <Key-Return> "destroy $w"
2032 proc keys {} {
2033 set w .keys
2034 if {[winfo exists $w]} {
2035 raise $w
2036 return
2038 if {[tk windowingsystem] eq {aqua}} {
2039 set M1T Cmd
2040 } else {
2041 set M1T Ctrl
2043 toplevel $w
2044 wm title $w [mc "Gitk key bindings"]
2045 message $w.m -text [mc "
2046 Gitk key bindings:
2048 <$M1T-Q> Quit
2049 <Home> Move to first commit
2050 <End> Move to last commit
2051 <Up>, p, i Move up one commit
2052 <Down>, n, k Move down one commit
2053 <Left>, z, j Go back in history list
2054 <Right>, x, l Go forward in history list
2055 <PageUp> Move up one page in commit list
2056 <PageDown> Move down one page in commit list
2057 <$M1T-Home> Scroll to top of commit list
2058 <$M1T-End> Scroll to bottom of commit list
2059 <$M1T-Up> Scroll commit list up one line
2060 <$M1T-Down> Scroll commit list down one line
2061 <$M1T-PageUp> Scroll commit list up one page
2062 <$M1T-PageDown> Scroll commit list down one page
2063 <Shift-Up> Find backwards (upwards, later commits)
2064 <Shift-Down> Find forwards (downwards, earlier commits)
2065 <Delete>, b Scroll diff view up one page
2066 <Backspace> Scroll diff view up one page
2067 <Space> Scroll diff view down one page
2068 u Scroll diff view up 18 lines
2069 d Scroll diff view down 18 lines
2070 <$M1T-F> Find
2071 <$M1T-G> Move to next find hit
2072 <Return> Move to next find hit
2073 / Move to next find hit, or redo find
2074 ? Move to previous find hit
2075 f Scroll diff view to next file
2076 <$M1T-S> Search for next hit in diff view
2077 <$M1T-R> Search for previous hit in diff view
2078 <$M1T-KP+> Increase font size
2079 <$M1T-plus> Increase font size
2080 <$M1T-KP-> Decrease font size
2081 <$M1T-minus> Decrease font size
2082 <F5> Update
2083 "] \
2084 -justify left -bg white -border 2 -relief groove
2085 pack $w.m -side top -fill both -padx 2 -pady 2
2086 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2087 pack $w.ok -side bottom
2088 bind $w <Visibility> "focus $w.ok"
2089 bind $w <Key-Escape> "destroy $w"
2090 bind $w <Key-Return> "destroy $w"
2093 # Procedures for manipulating the file list window at the
2094 # bottom right of the overall window.
2096 proc treeview {w l openlevs} {
2097 global treecontents treediropen treeheight treeparent treeindex
2099 set ix 0
2100 set treeindex() 0
2101 set lev 0
2102 set prefix {}
2103 set prefixend -1
2104 set prefendstack {}
2105 set htstack {}
2106 set ht 0
2107 set treecontents() {}
2108 $w conf -state normal
2109 foreach f $l {
2110 while {[string range $f 0 $prefixend] ne $prefix} {
2111 if {$lev <= $openlevs} {
2112 $w mark set e:$treeindex($prefix) "end -1c"
2113 $w mark gravity e:$treeindex($prefix) left
2115 set treeheight($prefix) $ht
2116 incr ht [lindex $htstack end]
2117 set htstack [lreplace $htstack end end]
2118 set prefixend [lindex $prefendstack end]
2119 set prefendstack [lreplace $prefendstack end end]
2120 set prefix [string range $prefix 0 $prefixend]
2121 incr lev -1
2123 set tail [string range $f [expr {$prefixend+1}] end]
2124 while {[set slash [string first "/" $tail]] >= 0} {
2125 lappend htstack $ht
2126 set ht 0
2127 lappend prefendstack $prefixend
2128 incr prefixend [expr {$slash + 1}]
2129 set d [string range $tail 0 $slash]
2130 lappend treecontents($prefix) $d
2131 set oldprefix $prefix
2132 append prefix $d
2133 set treecontents($prefix) {}
2134 set treeindex($prefix) [incr ix]
2135 set treeparent($prefix) $oldprefix
2136 set tail [string range $tail [expr {$slash+1}] end]
2137 if {$lev <= $openlevs} {
2138 set ht 1
2139 set treediropen($prefix) [expr {$lev < $openlevs}]
2140 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2141 $w mark set d:$ix "end -1c"
2142 $w mark gravity d:$ix left
2143 set str "\n"
2144 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2145 $w insert end $str
2146 $w image create end -align center -image $bm -padx 1 \
2147 -name a:$ix
2148 $w insert end $d [highlight_tag $prefix]
2149 $w mark set s:$ix "end -1c"
2150 $w mark gravity s:$ix left
2152 incr lev
2154 if {$tail ne {}} {
2155 if {$lev <= $openlevs} {
2156 incr ht
2157 set str "\n"
2158 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2159 $w insert end $str
2160 $w insert end $tail [highlight_tag $f]
2162 lappend treecontents($prefix) $tail
2165 while {$htstack ne {}} {
2166 set treeheight($prefix) $ht
2167 incr ht [lindex $htstack end]
2168 set htstack [lreplace $htstack end end]
2169 set prefixend [lindex $prefendstack end]
2170 set prefendstack [lreplace $prefendstack end end]
2171 set prefix [string range $prefix 0 $prefixend]
2173 $w conf -state disabled
2176 proc linetoelt {l} {
2177 global treeheight treecontents
2179 set y 2
2180 set prefix {}
2181 while {1} {
2182 foreach e $treecontents($prefix) {
2183 if {$y == $l} {
2184 return "$prefix$e"
2186 set n 1
2187 if {[string index $e end] eq "/"} {
2188 set n $treeheight($prefix$e)
2189 if {$y + $n > $l} {
2190 append prefix $e
2191 incr y
2192 break
2195 incr y $n
2200 proc highlight_tree {y prefix} {
2201 global treeheight treecontents cflist
2203 foreach e $treecontents($prefix) {
2204 set path $prefix$e
2205 if {[highlight_tag $path] ne {}} {
2206 $cflist tag add bold $y.0 "$y.0 lineend"
2208 incr y
2209 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2210 set y [highlight_tree $y $path]
2213 return $y
2216 proc treeclosedir {w dir} {
2217 global treediropen treeheight treeparent treeindex
2219 set ix $treeindex($dir)
2220 $w conf -state normal
2221 $w delete s:$ix e:$ix
2222 set treediropen($dir) 0
2223 $w image configure a:$ix -image tri-rt
2224 $w conf -state disabled
2225 set n [expr {1 - $treeheight($dir)}]
2226 while {$dir ne {}} {
2227 incr treeheight($dir) $n
2228 set dir $treeparent($dir)
2232 proc treeopendir {w dir} {
2233 global treediropen treeheight treeparent treecontents treeindex
2235 set ix $treeindex($dir)
2236 $w conf -state normal
2237 $w image configure a:$ix -image tri-dn
2238 $w mark set e:$ix s:$ix
2239 $w mark gravity e:$ix right
2240 set lev 0
2241 set str "\n"
2242 set n [llength $treecontents($dir)]
2243 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2244 incr lev
2245 append str "\t"
2246 incr treeheight($x) $n
2248 foreach e $treecontents($dir) {
2249 set de $dir$e
2250 if {[string index $e end] eq "/"} {
2251 set iy $treeindex($de)
2252 $w mark set d:$iy e:$ix
2253 $w mark gravity d:$iy left
2254 $w insert e:$ix $str
2255 set treediropen($de) 0
2256 $w image create e:$ix -align center -image tri-rt -padx 1 \
2257 -name a:$iy
2258 $w insert e:$ix $e [highlight_tag $de]
2259 $w mark set s:$iy e:$ix
2260 $w mark gravity s:$iy left
2261 set treeheight($de) 1
2262 } else {
2263 $w insert e:$ix $str
2264 $w insert e:$ix $e [highlight_tag $de]
2267 $w mark gravity e:$ix left
2268 $w conf -state disabled
2269 set treediropen($dir) 1
2270 set top [lindex [split [$w index @0,0] .] 0]
2271 set ht [$w cget -height]
2272 set l [lindex [split [$w index s:$ix] .] 0]
2273 if {$l < $top} {
2274 $w yview $l.0
2275 } elseif {$l + $n + 1 > $top + $ht} {
2276 set top [expr {$l + $n + 2 - $ht}]
2277 if {$l < $top} {
2278 set top $l
2280 $w yview $top.0
2284 proc treeclick {w x y} {
2285 global treediropen cmitmode ctext cflist cflist_top
2287 if {$cmitmode ne "tree"} return
2288 if {![info exists cflist_top]} return
2289 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2290 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2291 $cflist tag add highlight $l.0 "$l.0 lineend"
2292 set cflist_top $l
2293 if {$l == 1} {
2294 $ctext yview 1.0
2295 return
2297 set e [linetoelt $l]
2298 if {[string index $e end] ne "/"} {
2299 showfile $e
2300 } elseif {$treediropen($e)} {
2301 treeclosedir $w $e
2302 } else {
2303 treeopendir $w $e
2307 proc setfilelist {id} {
2308 global treefilelist cflist
2310 treeview $cflist $treefilelist($id) 0
2313 image create bitmap tri-rt -background black -foreground blue -data {
2314 #define tri-rt_width 13
2315 #define tri-rt_height 13
2316 static unsigned char tri-rt_bits[] = {
2317 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2318 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2319 0x00, 0x00};
2320 } -maskdata {
2321 #define tri-rt-mask_width 13
2322 #define tri-rt-mask_height 13
2323 static unsigned char tri-rt-mask_bits[] = {
2324 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2325 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2326 0x08, 0x00};
2328 image create bitmap tri-dn -background black -foreground blue -data {
2329 #define tri-dn_width 13
2330 #define tri-dn_height 13
2331 static unsigned char tri-dn_bits[] = {
2332 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2333 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2334 0x00, 0x00};
2335 } -maskdata {
2336 #define tri-dn-mask_width 13
2337 #define tri-dn-mask_height 13
2338 static unsigned char tri-dn-mask_bits[] = {
2339 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2340 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2341 0x00, 0x00};
2344 image create bitmap reficon-T -background black -foreground yellow -data {
2345 #define tagicon_width 13
2346 #define tagicon_height 9
2347 static unsigned char tagicon_bits[] = {
2348 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2349 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2350 } -maskdata {
2351 #define tagicon-mask_width 13
2352 #define tagicon-mask_height 9
2353 static unsigned char tagicon-mask_bits[] = {
2354 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2355 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2357 set rectdata {
2358 #define headicon_width 13
2359 #define headicon_height 9
2360 static unsigned char headicon_bits[] = {
2361 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2362 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2364 set rectmask {
2365 #define headicon-mask_width 13
2366 #define headicon-mask_height 9
2367 static unsigned char headicon-mask_bits[] = {
2368 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2369 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2371 image create bitmap reficon-H -background black -foreground green \
2372 -data $rectdata -maskdata $rectmask
2373 image create bitmap reficon-o -background black -foreground "#ddddff" \
2374 -data $rectdata -maskdata $rectmask
2376 proc init_flist {first} {
2377 global cflist cflist_top difffilestart
2379 $cflist conf -state normal
2380 $cflist delete 0.0 end
2381 if {$first ne {}} {
2382 $cflist insert end $first
2383 set cflist_top 1
2384 $cflist tag add highlight 1.0 "1.0 lineend"
2385 } else {
2386 catch {unset cflist_top}
2388 $cflist conf -state disabled
2389 set difffilestart {}
2392 proc highlight_tag {f} {
2393 global highlight_paths
2395 foreach p $highlight_paths {
2396 if {[string match $p $f]} {
2397 return "bold"
2400 return {}
2403 proc highlight_filelist {} {
2404 global cmitmode cflist
2406 $cflist conf -state normal
2407 if {$cmitmode ne "tree"} {
2408 set end [lindex [split [$cflist index end] .] 0]
2409 for {set l 2} {$l < $end} {incr l} {
2410 set line [$cflist get $l.0 "$l.0 lineend"]
2411 if {[highlight_tag $line] ne {}} {
2412 $cflist tag add bold $l.0 "$l.0 lineend"
2415 } else {
2416 highlight_tree 2 {}
2418 $cflist conf -state disabled
2421 proc unhighlight_filelist {} {
2422 global cflist
2424 $cflist conf -state normal
2425 $cflist tag remove bold 1.0 end
2426 $cflist conf -state disabled
2429 proc add_flist {fl} {
2430 global cflist
2432 $cflist conf -state normal
2433 foreach f $fl {
2434 $cflist insert end "\n"
2435 $cflist insert end $f [highlight_tag $f]
2437 $cflist conf -state disabled
2440 proc sel_flist {w x y} {
2441 global ctext difffilestart cflist cflist_top cmitmode
2443 if {$cmitmode eq "tree"} return
2444 if {![info exists cflist_top]} return
2445 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2446 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2447 $cflist tag add highlight $l.0 "$l.0 lineend"
2448 set cflist_top $l
2449 if {$l == 1} {
2450 $ctext yview 1.0
2451 } else {
2452 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2456 proc pop_flist_menu {w X Y x y} {
2457 global ctext cflist cmitmode flist_menu flist_menu_file
2458 global treediffs diffids
2460 stopfinding
2461 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2462 if {$l <= 1} return
2463 if {$cmitmode eq "tree"} {
2464 set e [linetoelt $l]
2465 if {[string index $e end] eq "/"} return
2466 } else {
2467 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2469 set flist_menu_file $e
2470 tk_popup $flist_menu $X $Y
2473 proc flist_hl {only} {
2474 global flist_menu_file findstring gdttype
2476 set x [shellquote $flist_menu_file]
2477 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2478 set findstring $x
2479 } else {
2480 append findstring " " $x
2482 set gdttype [mc "touching paths:"]
2485 # Functions for adding and removing shell-type quoting
2487 proc shellquote {str} {
2488 if {![string match "*\['\"\\ \t]*" $str]} {
2489 return $str
2491 if {![string match "*\['\"\\]*" $str]} {
2492 return "\"$str\""
2494 if {![string match "*'*" $str]} {
2495 return "'$str'"
2497 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2500 proc shellarglist {l} {
2501 set str {}
2502 foreach a $l {
2503 if {$str ne {}} {
2504 append str " "
2506 append str [shellquote $a]
2508 return $str
2511 proc shelldequote {str} {
2512 set ret {}
2513 set used -1
2514 while {1} {
2515 incr used
2516 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2517 append ret [string range $str $used end]
2518 set used [string length $str]
2519 break
2521 set first [lindex $first 0]
2522 set ch [string index $str $first]
2523 if {$first > $used} {
2524 append ret [string range $str $used [expr {$first - 1}]]
2525 set used $first
2527 if {$ch eq " " || $ch eq "\t"} break
2528 incr used
2529 if {$ch eq "'"} {
2530 set first [string first "'" $str $used]
2531 if {$first < 0} {
2532 error "unmatched single-quote"
2534 append ret [string range $str $used [expr {$first - 1}]]
2535 set used $first
2536 continue
2538 if {$ch eq "\\"} {
2539 if {$used >= [string length $str]} {
2540 error "trailing backslash"
2542 append ret [string index $str $used]
2543 continue
2545 # here ch == "\""
2546 while {1} {
2547 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2548 error "unmatched double-quote"
2550 set first [lindex $first 0]
2551 set ch [string index $str $first]
2552 if {$first > $used} {
2553 append ret [string range $str $used [expr {$first - 1}]]
2554 set used $first
2556 if {$ch eq "\""} break
2557 incr used
2558 append ret [string index $str $used]
2559 incr used
2562 return [list $used $ret]
2565 proc shellsplit {str} {
2566 set l {}
2567 while {1} {
2568 set str [string trimleft $str]
2569 if {$str eq {}} break
2570 set dq [shelldequote $str]
2571 set n [lindex $dq 0]
2572 set word [lindex $dq 1]
2573 set str [string range $str $n end]
2574 lappend l $word
2576 return $l
2579 # Code to implement multiple views
2581 proc newview {ishighlight} {
2582 global nextviewnum newviewname newviewperm newishighlight
2583 global newviewargs revtreeargs
2585 set newishighlight $ishighlight
2586 set top .gitkview
2587 if {[winfo exists $top]} {
2588 raise $top
2589 return
2591 set newviewname($nextviewnum) "View $nextviewnum"
2592 set newviewperm($nextviewnum) 0
2593 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2594 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2597 proc editview {} {
2598 global curview
2599 global viewname viewperm newviewname newviewperm
2600 global viewargs newviewargs
2602 set top .gitkvedit-$curview
2603 if {[winfo exists $top]} {
2604 raise $top
2605 return
2607 set newviewname($curview) $viewname($curview)
2608 set newviewperm($curview) $viewperm($curview)
2609 set newviewargs($curview) [shellarglist $viewargs($curview)]
2610 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2613 proc vieweditor {top n title} {
2614 global newviewname newviewperm viewfiles
2616 toplevel $top
2617 wm title $top $title
2618 label $top.nl -text [mc "Name"]
2619 entry $top.name -width 20 -textvariable newviewname($n)
2620 grid $top.nl $top.name -sticky w -pady 5
2621 checkbutton $top.perm -text [mc "Remember this view"] \
2622 -variable newviewperm($n)
2623 grid $top.perm - -pady 5 -sticky w
2624 message $top.al -aspect 1000 \
2625 -text [mc "Commits to include (arguments to git rev-list):"]
2626 grid $top.al - -sticky w -pady 5
2627 entry $top.args -width 50 -textvariable newviewargs($n) \
2628 -background white
2629 grid $top.args - -sticky ew -padx 5
2630 message $top.l -aspect 1000 \
2631 -text [mc "Enter files and directories to include, one per line:"]
2632 grid $top.l - -sticky w
2633 text $top.t -width 40 -height 10 -background white -font uifont
2634 if {[info exists viewfiles($n)]} {
2635 foreach f $viewfiles($n) {
2636 $top.t insert end $f
2637 $top.t insert end "\n"
2639 $top.t delete {end - 1c} end
2640 $top.t mark set insert 0.0
2642 grid $top.t - -sticky ew -padx 5
2643 frame $top.buts
2644 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2645 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2646 grid $top.buts.ok $top.buts.can
2647 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2648 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2649 grid $top.buts - -pady 10 -sticky ew
2650 focus $top.t
2653 proc doviewmenu {m first cmd op argv} {
2654 set nmenu [$m index end]
2655 for {set i $first} {$i <= $nmenu} {incr i} {
2656 if {[$m entrycget $i -command] eq $cmd} {
2657 eval $m $op $i $argv
2658 break
2663 proc allviewmenus {n op args} {
2664 # global viewhlmenu
2666 doviewmenu .bar.view 5 [list showview $n] $op $args
2667 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2670 proc newviewok {top n} {
2671 global nextviewnum newviewperm newviewname newishighlight
2672 global viewname viewfiles viewperm selectedview curview
2673 global viewargs newviewargs viewhlmenu
2675 if {[catch {
2676 set newargs [shellsplit $newviewargs($n)]
2677 } err]} {
2678 error_popup "[mc "Error in commit selection arguments:"] $err"
2679 wm raise $top
2680 focus $top
2681 return
2683 set files {}
2684 foreach f [split [$top.t get 0.0 end] "\n"] {
2685 set ft [string trim $f]
2686 if {$ft ne {}} {
2687 lappend files $ft
2690 if {![info exists viewfiles($n)]} {
2691 # creating a new view
2692 incr nextviewnum
2693 set viewname($n) $newviewname($n)
2694 set viewperm($n) $newviewperm($n)
2695 set viewfiles($n) $files
2696 set viewargs($n) $newargs
2697 addviewmenu $n
2698 if {!$newishighlight} {
2699 run showview $n
2700 } else {
2701 run addvhighlight $n
2703 } else {
2704 # editing an existing view
2705 set viewperm($n) $newviewperm($n)
2706 if {$newviewname($n) ne $viewname($n)} {
2707 set viewname($n) $newviewname($n)
2708 doviewmenu .bar.view 5 [list showview $n] \
2709 entryconf [list -label $viewname($n)]
2710 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2711 # entryconf [list -label $viewname($n) -value $viewname($n)]
2713 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2714 set viewfiles($n) $files
2715 set viewargs($n) $newargs
2716 if {$curview == $n} {
2717 run reloadcommits
2721 catch {destroy $top}
2724 proc delview {} {
2725 global curview viewperm hlview selectedhlview
2727 if {$curview == 0} return
2728 if {[info exists hlview] && $hlview == $curview} {
2729 set selectedhlview [mc "None"]
2730 unset hlview
2732 allviewmenus $curview delete
2733 set viewperm($curview) 0
2734 showview 0
2737 proc addviewmenu {n} {
2738 global viewname viewhlmenu
2740 .bar.view add radiobutton -label $viewname($n) \
2741 -command [list showview $n] -variable selectedview -value $n
2742 #$viewhlmenu add radiobutton -label $viewname($n) \
2743 # -command [list addvhighlight $n] -variable selectedhlview
2746 proc showview {n} {
2747 global curview viewfiles cached_commitrow ordertok
2748 global displayorder parentlist rowidlist rowisopt rowfinal
2749 global colormap rowtextx nextcolor canvxmax
2750 global numcommits viewcomplete
2751 global selectedline currentid canv canvy0
2752 global treediffs
2753 global pending_select
2754 global commitidx
2755 global selectedview selectfirst
2756 global hlview selectedhlview commitinterest
2758 if {$n == $curview} return
2759 set selid {}
2760 set ymax [lindex [$canv cget -scrollregion] 3]
2761 set span [$canv yview]
2762 set ytop [expr {[lindex $span 0] * $ymax}]
2763 set ybot [expr {[lindex $span 1] * $ymax}]
2764 set yscreen [expr {($ybot - $ytop) / 2}]
2765 if {[info exists selectedline]} {
2766 set selid $currentid
2767 set y [yc $selectedline]
2768 if {$ytop < $y && $y < $ybot} {
2769 set yscreen [expr {$y - $ytop}]
2771 } elseif {[info exists pending_select]} {
2772 set selid $pending_select
2773 unset pending_select
2775 unselectline
2776 normalline
2777 catch {unset treediffs}
2778 clear_display
2779 if {[info exists hlview] && $hlview == $n} {
2780 unset hlview
2781 set selectedhlview [mc "None"]
2783 catch {unset commitinterest}
2784 catch {unset cached_commitrow}
2785 catch {unset ordertok}
2787 set curview $n
2788 set selectedview $n
2789 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2790 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2792 run refill_reflist
2793 if {![info exists viewcomplete($n)]} {
2794 if {$selid ne {}} {
2795 set pending_select $selid
2797 getcommits
2798 return
2801 set displayorder {}
2802 set parentlist {}
2803 set rowidlist {}
2804 set rowisopt {}
2805 set rowfinal {}
2806 set numcommits $commitidx($n)
2808 catch {unset colormap}
2809 catch {unset rowtextx}
2810 set nextcolor 0
2811 set canvxmax [$canv cget -width]
2812 set curview $n
2813 set row 0
2814 setcanvscroll
2815 set yf 0
2816 set row {}
2817 set selectfirst 0
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 {$selid ne {}} {
2833 set pending_select $selid
2834 } else {
2835 set row [first_real_row]
2836 if {$row < $numcommits} {
2837 selectline $row 0
2838 } else {
2839 set selectfirst 1
2842 if {!$viewcomplete($n)} {
2843 if {$numcommits == 0} {
2844 show_status [mc "Reading commits..."]
2846 } elseif {$numcommits == 0} {
2847 show_status [mc "No commits selected"]
2851 # Stuff relating to the highlighting facility
2853 proc ishighlighted {row} {
2854 global vhighlights fhighlights nhighlights rhighlights
2856 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2857 return $nhighlights($row)
2859 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2860 return $vhighlights($row)
2862 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2863 return $fhighlights($row)
2865 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2866 return $rhighlights($row)
2868 return 0
2871 proc bolden {row font} {
2872 global canv linehtag selectedline boldrows
2874 lappend boldrows $row
2875 $canv itemconf $linehtag($row) -font $font
2876 if {[info exists selectedline] && $row == $selectedline} {
2877 $canv delete secsel
2878 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2879 -outline {{}} -tags secsel \
2880 -fill [$canv cget -selectbackground]]
2881 $canv lower $t
2885 proc bolden_name {row font} {
2886 global canv2 linentag selectedline boldnamerows
2888 lappend boldnamerows $row
2889 $canv2 itemconf $linentag($row) -font $font
2890 if {[info exists selectedline] && $row == $selectedline} {
2891 $canv2 delete secsel
2892 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2893 -outline {{}} -tags secsel \
2894 -fill [$canv2 cget -selectbackground]]
2895 $canv2 lower $t
2899 proc unbolden {} {
2900 global boldrows
2902 set stillbold {}
2903 foreach row $boldrows {
2904 if {![ishighlighted $row]} {
2905 bolden $row mainfont
2906 } else {
2907 lappend stillbold $row
2910 set boldrows $stillbold
2913 proc addvhighlight {n} {
2914 global hlview viewcomplete curview vhl_done vhighlights commitidx
2916 if {[info exists hlview]} {
2917 delvhighlight
2919 set hlview $n
2920 if {$n != $curview && ![info exists viewcomplete($n)]} {
2921 start_rev_list $n
2923 set vhl_done $commitidx($hlview)
2924 if {$vhl_done > 0} {
2925 drawvisible
2929 proc delvhighlight {} {
2930 global hlview vhighlights
2932 if {![info exists hlview]} return
2933 unset hlview
2934 catch {unset vhighlights}
2935 unbolden
2938 proc vhighlightmore {} {
2939 global hlview vhl_done commitidx vhighlights curview
2941 set max $commitidx($hlview)
2942 set vr [visiblerows]
2943 set r0 [lindex $vr 0]
2944 set r1 [lindex $vr 1]
2945 for {set i $vhl_done} {$i < $max} {incr i} {
2946 set id [commitonrow $i $hlview]
2947 if {[commitinview $id $curview]} {
2948 set row [rowofcommit $id]
2949 if {$r0 <= $row && $row <= $r1} {
2950 if {![highlighted $row]} {
2951 bolden $row mainfontbold
2953 set vhighlights($row) 1
2957 set vhl_done $max
2960 proc askvhighlight {row id} {
2961 global hlview vhighlights iddrawn
2963 if {[commitinview $id $hlview]} {
2964 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2965 bolden $row mainfontbold
2967 set vhighlights($row) 1
2968 } else {
2969 set vhighlights($row) 0
2973 proc hfiles_change {} {
2974 global highlight_files filehighlight fhighlights fh_serial
2975 global highlight_paths gdttype
2977 if {[info exists filehighlight]} {
2978 # delete previous highlights
2979 catch {close $filehighlight}
2980 unset filehighlight
2981 catch {unset fhighlights}
2982 unbolden
2983 unhighlight_filelist
2985 set highlight_paths {}
2986 after cancel do_file_hl $fh_serial
2987 incr fh_serial
2988 if {$highlight_files ne {}} {
2989 after 300 do_file_hl $fh_serial
2993 proc gdttype_change {name ix op} {
2994 global gdttype highlight_files findstring findpattern
2996 stopfinding
2997 if {$findstring ne {}} {
2998 if {$gdttype eq [mc "containing:"]} {
2999 if {$highlight_files ne {}} {
3000 set highlight_files {}
3001 hfiles_change
3003 findcom_change
3004 } else {
3005 if {$findpattern ne {}} {
3006 set findpattern {}
3007 findcom_change
3009 set highlight_files $findstring
3010 hfiles_change
3012 drawvisible
3014 # enable/disable findtype/findloc menus too
3017 proc find_change {name ix op} {
3018 global gdttype findstring highlight_files
3020 stopfinding
3021 if {$gdttype eq [mc "containing:"]} {
3022 findcom_change
3023 } else {
3024 if {$highlight_files ne $findstring} {
3025 set highlight_files $findstring
3026 hfiles_change
3029 drawvisible
3032 proc findcom_change args {
3033 global nhighlights boldnamerows
3034 global findpattern findtype findstring gdttype
3036 stopfinding
3037 # delete previous highlights, if any
3038 foreach row $boldnamerows {
3039 bolden_name $row mainfont
3041 set boldnamerows {}
3042 catch {unset nhighlights}
3043 unbolden
3044 unmarkmatches
3045 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3046 set findpattern {}
3047 } elseif {$findtype eq [mc "Regexp"]} {
3048 set findpattern $findstring
3049 } else {
3050 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3051 $findstring]
3052 set findpattern "*$e*"
3056 proc makepatterns {l} {
3057 set ret {}
3058 foreach e $l {
3059 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3060 if {[string index $ee end] eq "/"} {
3061 lappend ret "$ee*"
3062 } else {
3063 lappend ret $ee
3064 lappend ret "$ee/*"
3067 return $ret
3070 proc do_file_hl {serial} {
3071 global highlight_files filehighlight highlight_paths gdttype fhl_list
3073 if {$gdttype eq [mc "touching paths:"]} {
3074 if {[catch {set paths [shellsplit $highlight_files]}]} return
3075 set highlight_paths [makepatterns $paths]
3076 highlight_filelist
3077 set gdtargs [concat -- $paths]
3078 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3079 set gdtargs [list "-S$highlight_files"]
3080 } else {
3081 # must be "containing:", i.e. we're searching commit info
3082 return
3084 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3085 set filehighlight [open $cmd r+]
3086 fconfigure $filehighlight -blocking 0
3087 filerun $filehighlight readfhighlight
3088 set fhl_list {}
3089 drawvisible
3090 flushhighlights
3093 proc flushhighlights {} {
3094 global filehighlight fhl_list
3096 if {[info exists filehighlight]} {
3097 lappend fhl_list {}
3098 puts $filehighlight ""
3099 flush $filehighlight
3103 proc askfilehighlight {row id} {
3104 global filehighlight fhighlights fhl_list
3106 lappend fhl_list $id
3107 set fhighlights($row) -1
3108 puts $filehighlight $id
3111 proc readfhighlight {} {
3112 global filehighlight fhighlights curview iddrawn
3113 global fhl_list find_dirn
3115 if {![info exists filehighlight]} {
3116 return 0
3118 set nr 0
3119 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3120 set line [string trim $line]
3121 set i [lsearch -exact $fhl_list $line]
3122 if {$i < 0} continue
3123 for {set j 0} {$j < $i} {incr j} {
3124 set id [lindex $fhl_list $j]
3125 if {[commitinview $id $curview]} {
3126 set fhighlights([rowofcommit $id]) 0
3129 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3130 if {$line eq {}} continue
3131 if {![commitinview $line $curview]} continue
3132 set row [rowofcommit $line]
3133 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
3134 bolden $row mainfontbold
3136 set fhighlights($row) 1
3138 if {[eof $filehighlight]} {
3139 # strange...
3140 puts "oops, git diff-tree died"
3141 catch {close $filehighlight}
3142 unset filehighlight
3143 return 0
3145 if {[info exists find_dirn]} {
3146 run findmore
3148 return 1
3151 proc doesmatch {f} {
3152 global findtype findpattern
3154 if {$findtype eq [mc "Regexp"]} {
3155 return [regexp $findpattern $f]
3156 } elseif {$findtype eq [mc "IgnCase"]} {
3157 return [string match -nocase $findpattern $f]
3158 } else {
3159 return [string match $findpattern $f]
3163 proc askfindhighlight {row id} {
3164 global nhighlights commitinfo iddrawn
3165 global findloc
3166 global markingmatches
3168 if {![info exists commitinfo($id)]} {
3169 getcommit $id
3171 set info $commitinfo($id)
3172 set isbold 0
3173 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3174 foreach f $info ty $fldtypes {
3175 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3176 [doesmatch $f]} {
3177 if {$ty eq [mc "Author"]} {
3178 set isbold 2
3179 break
3181 set isbold 1
3184 if {$isbold && [info exists iddrawn($id)]} {
3185 if {![ishighlighted $row]} {
3186 bolden $row mainfontbold
3187 if {$isbold > 1} {
3188 bolden_name $row mainfontbold
3191 if {$markingmatches} {
3192 markrowmatches $row $id
3195 set nhighlights($row) $isbold
3198 proc markrowmatches {row id} {
3199 global canv canv2 linehtag linentag commitinfo findloc
3201 set headline [lindex $commitinfo($id) 0]
3202 set author [lindex $commitinfo($id) 1]
3203 $canv delete match$row
3204 $canv2 delete match$row
3205 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3206 set m [findmatches $headline]
3207 if {$m ne {}} {
3208 markmatches $canv $row $headline $linehtag($row) $m \
3209 [$canv itemcget $linehtag($row) -font] $row
3212 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3213 set m [findmatches $author]
3214 if {$m ne {}} {
3215 markmatches $canv2 $row $author $linentag($row) $m \
3216 [$canv2 itemcget $linentag($row) -font] $row
3221 proc vrel_change {name ix op} {
3222 global highlight_related
3224 rhighlight_none
3225 if {$highlight_related ne [mc "None"]} {
3226 run drawvisible
3230 # prepare for testing whether commits are descendents or ancestors of a
3231 proc rhighlight_sel {a} {
3232 global descendent desc_todo ancestor anc_todo
3233 global highlight_related rhighlights
3235 catch {unset descendent}
3236 set desc_todo [list $a]
3237 catch {unset ancestor}
3238 set anc_todo [list $a]
3239 if {$highlight_related ne [mc "None"]} {
3240 rhighlight_none
3241 run drawvisible
3245 proc rhighlight_none {} {
3246 global rhighlights
3248 catch {unset rhighlights}
3249 unbolden
3252 proc is_descendent {a} {
3253 global curview children descendent desc_todo
3255 set v $curview
3256 set la [rowofcommit $a]
3257 set todo $desc_todo
3258 set leftover {}
3259 set done 0
3260 for {set i 0} {$i < [llength $todo]} {incr i} {
3261 set do [lindex $todo $i]
3262 if {[rowofcommit $do] < $la} {
3263 lappend leftover $do
3264 continue
3266 foreach nk $children($v,$do) {
3267 if {![info exists descendent($nk)]} {
3268 set descendent($nk) 1
3269 lappend todo $nk
3270 if {$nk eq $a} {
3271 set done 1
3275 if {$done} {
3276 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3277 return
3280 set descendent($a) 0
3281 set desc_todo $leftover
3284 proc is_ancestor {a} {
3285 global curview parents ancestor anc_todo
3287 set v $curview
3288 set la [rowofcommit $a]
3289 set todo $anc_todo
3290 set leftover {}
3291 set done 0
3292 for {set i 0} {$i < [llength $todo]} {incr i} {
3293 set do [lindex $todo $i]
3294 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3295 lappend leftover $do
3296 continue
3298 foreach np $parents($v,$do) {
3299 if {![info exists ancestor($np)]} {
3300 set ancestor($np) 1
3301 lappend todo $np
3302 if {$np eq $a} {
3303 set done 1
3307 if {$done} {
3308 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3309 return
3312 set ancestor($a) 0
3313 set anc_todo $leftover
3316 proc askrelhighlight {row id} {
3317 global descendent highlight_related iddrawn rhighlights
3318 global selectedline ancestor
3320 if {![info exists selectedline]} return
3321 set isbold 0
3322 if {$highlight_related eq [mc "Descendent"] ||
3323 $highlight_related eq [mc "Not descendent"]} {
3324 if {![info exists descendent($id)]} {
3325 is_descendent $id
3327 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
3328 set isbold 1
3330 } elseif {$highlight_related eq [mc "Ancestor"] ||
3331 $highlight_related eq [mc "Not ancestor"]} {
3332 if {![info exists ancestor($id)]} {
3333 is_ancestor $id
3335 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3336 set isbold 1
3339 if {[info exists iddrawn($id)]} {
3340 if {$isbold && ![ishighlighted $row]} {
3341 bolden $row mainfontbold
3344 set rhighlights($row) $isbold
3347 # Graph layout functions
3349 proc shortids {ids} {
3350 set res {}
3351 foreach id $ids {
3352 if {[llength $id] > 1} {
3353 lappend res [shortids $id]
3354 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3355 lappend res [string range $id 0 7]
3356 } else {
3357 lappend res $id
3360 return $res
3363 proc ntimes {n o} {
3364 set ret {}
3365 set o [list $o]
3366 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3367 if {($n & $mask) != 0} {
3368 set ret [concat $ret $o]
3370 set o [concat $o $o]
3372 return $ret
3375 proc ordertoken {id} {
3376 global ordertok curview varcid varcstart varctok curview parents children
3377 global nullid nullid2
3379 if {[info exists ordertok($id)]} {
3380 return $ordertok($id)
3382 set origid $id
3383 set todo {}
3384 while {1} {
3385 if {[info exists varcid($curview,$id)]} {
3386 set a $varcid($curview,$id)
3387 set p [lindex $varcstart($curview) $a]
3388 } else {
3389 set p [lindex $children($curview,$id) 0]
3391 if {[info exists ordertok($p)]} {
3392 set tok $ordertok($p)
3393 break
3395 set id [first_real_child $curview,$p]
3396 if {$id eq {}} {
3397 # it's a root
3398 set tok [lindex $varctok($curview) $a]
3399 break
3401 if {[llength $parents($curview,$id)] == 1} {
3402 lappend todo [list $p {}]
3403 } else {
3404 set j [lsearch -exact $parents($curview,$id) $p]
3405 if {$j < 0} {
3406 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3408 lappend todo [list $p [strrep $j]]
3411 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3412 set p [lindex $todo $i 0]
3413 append tok [lindex $todo $i 1]
3414 set ordertok($p) $tok
3416 set ordertok($origid) $tok
3417 return $tok
3420 # Work out where id should go in idlist so that order-token
3421 # values increase from left to right
3422 proc idcol {idlist id {i 0}} {
3423 set t [ordertoken $id]
3424 if {$i < 0} {
3425 set i 0
3427 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3428 if {$i > [llength $idlist]} {
3429 set i [llength $idlist]
3431 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3432 incr i
3433 } else {
3434 if {$t > [ordertoken [lindex $idlist $i]]} {
3435 while {[incr i] < [llength $idlist] &&
3436 $t >= [ordertoken [lindex $idlist $i]]} {}
3439 return $i
3442 proc initlayout {} {
3443 global rowidlist rowisopt rowfinal displayorder parentlist
3444 global numcommits canvxmax canv
3445 global nextcolor
3446 global colormap rowtextx
3447 global selectfirst
3449 set numcommits 0
3450 set displayorder {}
3451 set parentlist {}
3452 set nextcolor 0
3453 set rowidlist {}
3454 set rowisopt {}
3455 set rowfinal {}
3456 set canvxmax [$canv cget -width]
3457 catch {unset colormap}
3458 catch {unset rowtextx}
3459 set selectfirst 1
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 selectfirst 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
3520 if {$selectfirst} {
3521 if {[info exists selectedline] || [info exists pending_select]} {
3522 set selectfirst 0
3523 } else {
3524 set l [first_real_row]
3525 selectline $l 1
3526 set selectfirst 0
3531 proc doshowlocalchanges {} {
3532 global curview mainheadid
3534 if {[commitinview $mainheadid $curview]} {
3535 dodiffindex
3536 } else {
3537 lappend commitinterest($mainheadid) {dodiffindex}
3541 proc dohidelocalchanges {} {
3542 global nullid nullid2 lserial curview
3544 if {[commitinview $nullid $curview]} {
3545 removerow $nullid $curview
3547 if {[commitinview $nullid2 $curview]} {
3548 removerow $nullid2 $curview
3550 incr lserial
3553 # spawn off a process to do git diff-index --cached HEAD
3554 proc dodiffindex {} {
3555 global lserial showlocalchanges
3557 if {!$showlocalchanges} return
3558 incr lserial
3559 set fd [open "|git diff-index --cached HEAD" r]
3560 fconfigure $fd -blocking 0
3561 filerun $fd [list readdiffindex $fd $lserial]
3564 proc readdiffindex {fd serial} {
3565 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3567 set isdiff 1
3568 if {[gets $fd line] < 0} {
3569 if {![eof $fd]} {
3570 return 1
3572 set isdiff 0
3574 # we only need to see one line and we don't really care what it says...
3575 close $fd
3577 if {$serial != $lserial} {
3578 return 0
3581 # now see if there are any local changes not checked in to the index
3582 set fd [open "|git diff-files" r]
3583 fconfigure $fd -blocking 0
3584 filerun $fd [list readdifffiles $fd $serial]
3586 if {$isdiff && ![commitinview $nullid2 $curview]} {
3587 # add the line for the changes in the index to the graph
3588 set hl [mc "Local changes checked in to index but not committed"]
3589 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3590 set commitdata($nullid2) "\n $hl\n"
3591 if {[commitinview $nullid $curview]} {
3592 removerow $nullid $curview
3594 insertrow $nullid2 $mainheadid $curview
3595 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3596 removerow $nullid2 $curview
3598 return 0
3601 proc readdifffiles {fd serial} {
3602 global mainheadid nullid nullid2 curview
3603 global commitinfo commitdata lserial
3605 set isdiff 1
3606 if {[gets $fd line] < 0} {
3607 if {![eof $fd]} {
3608 return 1
3610 set isdiff 0
3612 # we only need to see one line and we don't really care what it says...
3613 close $fd
3615 if {$serial != $lserial} {
3616 return 0
3619 if {$isdiff && ![commitinview $nullid $curview]} {
3620 # add the line for the local diff to the graph
3621 set hl [mc "Local uncommitted changes, not checked in to index"]
3622 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3623 set commitdata($nullid) "\n $hl\n"
3624 if {[commitinview $nullid2 $curview]} {
3625 set p $nullid2
3626 } else {
3627 set p $mainheadid
3629 insertrow $nullid $p $curview
3630 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3631 removerow $nullid $curview
3633 return 0
3636 proc nextuse {id row} {
3637 global curview children
3639 if {[info exists children($curview,$id)]} {
3640 foreach kid $children($curview,$id) {
3641 if {![commitinview $kid $curview]} {
3642 return -1
3644 if {[rowofcommit $kid] > $row} {
3645 return [rowofcommit $kid]
3649 if {[commitinview $id $curview]} {
3650 return [rowofcommit $id]
3652 return -1
3655 proc prevuse {id row} {
3656 global curview children
3658 set ret -1
3659 if {[info exists children($curview,$id)]} {
3660 foreach kid $children($curview,$id) {
3661 if {![commitinview $kid $curview]} break
3662 if {[rowofcommit $kid] < $row} {
3663 set ret [rowofcommit $kid]
3667 return $ret
3670 proc make_idlist {row} {
3671 global displayorder parentlist uparrowlen downarrowlen mingaplen
3672 global commitidx curview children
3674 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3675 if {$r < 0} {
3676 set r 0
3678 set ra [expr {$row - $downarrowlen}]
3679 if {$ra < 0} {
3680 set ra 0
3682 set rb [expr {$row + $uparrowlen}]
3683 if {$rb > $commitidx($curview)} {
3684 set rb $commitidx($curview)
3686 make_disporder $r [expr {$rb + 1}]
3687 set ids {}
3688 for {} {$r < $ra} {incr r} {
3689 set nextid [lindex $displayorder [expr {$r + 1}]]
3690 foreach p [lindex $parentlist $r] {
3691 if {$p eq $nextid} continue
3692 set rn [nextuse $p $r]
3693 if {$rn >= $row &&
3694 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3695 lappend ids [list [ordertoken $p] $p]
3699 for {} {$r < $row} {incr r} {
3700 set nextid [lindex $displayorder [expr {$r + 1}]]
3701 foreach p [lindex $parentlist $r] {
3702 if {$p eq $nextid} continue
3703 set rn [nextuse $p $r]
3704 if {$rn < 0 || $rn >= $row} {
3705 lappend ids [list [ordertoken $p] $p]
3709 set id [lindex $displayorder $row]
3710 lappend ids [list [ordertoken $id] $id]
3711 while {$r < $rb} {
3712 foreach p [lindex $parentlist $r] {
3713 set firstkid [lindex $children($curview,$p) 0]
3714 if {[rowofcommit $firstkid] < $row} {
3715 lappend ids [list [ordertoken $p] $p]
3718 incr r
3719 set id [lindex $displayorder $r]
3720 if {$id ne {}} {
3721 set firstkid [lindex $children($curview,$id) 0]
3722 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3723 lappend ids [list [ordertoken $id] $id]
3727 set idlist {}
3728 foreach idx [lsort -unique $ids] {
3729 lappend idlist [lindex $idx 1]
3731 return $idlist
3734 proc rowsequal {a b} {
3735 while {[set i [lsearch -exact $a {}]] >= 0} {
3736 set a [lreplace $a $i $i]
3738 while {[set i [lsearch -exact $b {}]] >= 0} {
3739 set b [lreplace $b $i $i]
3741 return [expr {$a eq $b}]
3744 proc makeupline {id row rend col} {
3745 global rowidlist uparrowlen downarrowlen mingaplen
3747 for {set r $rend} {1} {set r $rstart} {
3748 set rstart [prevuse $id $r]
3749 if {$rstart < 0} return
3750 if {$rstart < $row} break
3752 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3753 set rstart [expr {$rend - $uparrowlen - 1}]
3755 for {set r $rstart} {[incr r] <= $row} {} {
3756 set idlist [lindex $rowidlist $r]
3757 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3758 set col [idcol $idlist $id $col]
3759 lset rowidlist $r [linsert $idlist $col $id]
3760 changedrow $r
3765 proc layoutrows {row endrow} {
3766 global rowidlist rowisopt rowfinal displayorder
3767 global uparrowlen downarrowlen maxwidth mingaplen
3768 global children parentlist
3769 global commitidx viewcomplete curview
3771 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3772 set idlist {}
3773 if {$row > 0} {
3774 set rm1 [expr {$row - 1}]
3775 foreach id [lindex $rowidlist $rm1] {
3776 if {$id ne {}} {
3777 lappend idlist $id
3780 set final [lindex $rowfinal $rm1]
3782 for {} {$row < $endrow} {incr row} {
3783 set rm1 [expr {$row - 1}]
3784 if {$rm1 < 0 || $idlist eq {}} {
3785 set idlist [make_idlist $row]
3786 set final 1
3787 } else {
3788 set id [lindex $displayorder $rm1]
3789 set col [lsearch -exact $idlist $id]
3790 set idlist [lreplace $idlist $col $col]
3791 foreach p [lindex $parentlist $rm1] {
3792 if {[lsearch -exact $idlist $p] < 0} {
3793 set col [idcol $idlist $p $col]
3794 set idlist [linsert $idlist $col $p]
3795 # if not the first child, we have to insert a line going up
3796 if {$id ne [lindex $children($curview,$p) 0]} {
3797 makeupline $p $rm1 $row $col
3801 set id [lindex $displayorder $row]
3802 if {$row > $downarrowlen} {
3803 set termrow [expr {$row - $downarrowlen - 1}]
3804 foreach p [lindex $parentlist $termrow] {
3805 set i [lsearch -exact $idlist $p]
3806 if {$i < 0} continue
3807 set nr [nextuse $p $termrow]
3808 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3809 set idlist [lreplace $idlist $i $i]
3813 set col [lsearch -exact $idlist $id]
3814 if {$col < 0} {
3815 set col [idcol $idlist $id]
3816 set idlist [linsert $idlist $col $id]
3817 if {$children($curview,$id) ne {}} {
3818 makeupline $id $rm1 $row $col
3821 set r [expr {$row + $uparrowlen - 1}]
3822 if {$r < $commitidx($curview)} {
3823 set x $col
3824 foreach p [lindex $parentlist $r] {
3825 if {[lsearch -exact $idlist $p] >= 0} continue
3826 set fk [lindex $children($curview,$p) 0]
3827 if {[rowofcommit $fk] < $row} {
3828 set x [idcol $idlist $p $x]
3829 set idlist [linsert $idlist $x $p]
3832 if {[incr r] < $commitidx($curview)} {
3833 set p [lindex $displayorder $r]
3834 if {[lsearch -exact $idlist $p] < 0} {
3835 set fk [lindex $children($curview,$p) 0]
3836 if {$fk ne {} && [rowofcommit $fk] < $row} {
3837 set x [idcol $idlist $p $x]
3838 set idlist [linsert $idlist $x $p]
3844 if {$final && !$viewcomplete($curview) &&
3845 $row + $uparrowlen + $mingaplen + $downarrowlen
3846 >= $commitidx($curview)} {
3847 set final 0
3849 set l [llength $rowidlist]
3850 if {$row == $l} {
3851 lappend rowidlist $idlist
3852 lappend rowisopt 0
3853 lappend rowfinal $final
3854 } elseif {$row < $l} {
3855 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3856 lset rowidlist $row $idlist
3857 changedrow $row
3859 lset rowfinal $row $final
3860 } else {
3861 set pad [ntimes [expr {$row - $l}] {}]
3862 set rowidlist [concat $rowidlist $pad]
3863 lappend rowidlist $idlist
3864 set rowfinal [concat $rowfinal $pad]
3865 lappend rowfinal $final
3866 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3869 return $row
3872 proc changedrow {row} {
3873 global displayorder iddrawn rowisopt need_redisplay
3875 set l [llength $rowisopt]
3876 if {$row < $l} {
3877 lset rowisopt $row 0
3878 if {$row + 1 < $l} {
3879 lset rowisopt [expr {$row + 1}] 0
3880 if {$row + 2 < $l} {
3881 lset rowisopt [expr {$row + 2}] 0
3885 set id [lindex $displayorder $row]
3886 if {[info exists iddrawn($id)]} {
3887 set need_redisplay 1
3891 proc insert_pad {row col npad} {
3892 global rowidlist
3894 set pad [ntimes $npad {}]
3895 set idlist [lindex $rowidlist $row]
3896 set bef [lrange $idlist 0 [expr {$col - 1}]]
3897 set aft [lrange $idlist $col end]
3898 set i [lsearch -exact $aft {}]
3899 if {$i > 0} {
3900 set aft [lreplace $aft $i $i]
3902 lset rowidlist $row [concat $bef $pad $aft]
3903 changedrow $row
3906 proc optimize_rows {row col endrow} {
3907 global rowidlist rowisopt displayorder curview children
3909 if {$row < 1} {
3910 set row 1
3912 for {} {$row < $endrow} {incr row; set col 0} {
3913 if {[lindex $rowisopt $row]} continue
3914 set haspad 0
3915 set y0 [expr {$row - 1}]
3916 set ym [expr {$row - 2}]
3917 set idlist [lindex $rowidlist $row]
3918 set previdlist [lindex $rowidlist $y0]
3919 if {$idlist eq {} || $previdlist eq {}} continue
3920 if {$ym >= 0} {
3921 set pprevidlist [lindex $rowidlist $ym]
3922 if {$pprevidlist eq {}} continue
3923 } else {
3924 set pprevidlist {}
3926 set x0 -1
3927 set xm -1
3928 for {} {$col < [llength $idlist]} {incr col} {
3929 set id [lindex $idlist $col]
3930 if {[lindex $previdlist $col] eq $id} continue
3931 if {$id eq {}} {
3932 set haspad 1
3933 continue
3935 set x0 [lsearch -exact $previdlist $id]
3936 if {$x0 < 0} continue
3937 set z [expr {$x0 - $col}]
3938 set isarrow 0
3939 set z0 {}
3940 if {$ym >= 0} {
3941 set xm [lsearch -exact $pprevidlist $id]
3942 if {$xm >= 0} {
3943 set z0 [expr {$xm - $x0}]
3946 if {$z0 eq {}} {
3947 # if row y0 is the first child of $id then it's not an arrow
3948 if {[lindex $children($curview,$id) 0] ne
3949 [lindex $displayorder $y0]} {
3950 set isarrow 1
3953 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3954 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3955 set isarrow 1
3957 # Looking at lines from this row to the previous row,
3958 # make them go straight up if they end in an arrow on
3959 # the previous row; otherwise make them go straight up
3960 # or at 45 degrees.
3961 if {$z < -1 || ($z < 0 && $isarrow)} {
3962 # Line currently goes left too much;
3963 # insert pads in the previous row, then optimize it
3964 set npad [expr {-1 - $z + $isarrow}]
3965 insert_pad $y0 $x0 $npad
3966 if {$y0 > 0} {
3967 optimize_rows $y0 $x0 $row
3969 set previdlist [lindex $rowidlist $y0]
3970 set x0 [lsearch -exact $previdlist $id]
3971 set z [expr {$x0 - $col}]
3972 if {$z0 ne {}} {
3973 set pprevidlist [lindex $rowidlist $ym]
3974 set xm [lsearch -exact $pprevidlist $id]
3975 set z0 [expr {$xm - $x0}]
3977 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3978 # Line currently goes right too much;
3979 # insert pads in this line
3980 set npad [expr {$z - 1 + $isarrow}]
3981 insert_pad $row $col $npad
3982 set idlist [lindex $rowidlist $row]
3983 incr col $npad
3984 set z [expr {$x0 - $col}]
3985 set haspad 1
3987 if {$z0 eq {} && !$isarrow && $ym >= 0} {
3988 # this line links to its first child on row $row-2
3989 set id [lindex $displayorder $ym]
3990 set xc [lsearch -exact $pprevidlist $id]
3991 if {$xc >= 0} {
3992 set z0 [expr {$xc - $x0}]
3995 # avoid lines jigging left then immediately right
3996 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3997 insert_pad $y0 $x0 1
3998 incr x0
3999 optimize_rows $y0 $x0 $row
4000 set previdlist [lindex $rowidlist $y0]
4003 if {!$haspad} {
4004 # Find the first column that doesn't have a line going right
4005 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4006 set id [lindex $idlist $col]
4007 if {$id eq {}} break
4008 set x0 [lsearch -exact $previdlist $id]
4009 if {$x0 < 0} {
4010 # check if this is the link to the first child
4011 set kid [lindex $displayorder $y0]
4012 if {[lindex $children($curview,$id) 0] eq $kid} {
4013 # it is, work out offset to child
4014 set x0 [lsearch -exact $previdlist $kid]
4017 if {$x0 <= $col} break
4019 # Insert a pad at that column as long as it has a line and
4020 # isn't the last column
4021 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4022 set idlist [linsert $idlist $col {}]
4023 lset rowidlist $row $idlist
4024 changedrow $row
4030 proc xc {row col} {
4031 global canvx0 linespc
4032 return [expr {$canvx0 + $col * $linespc}]
4035 proc yc {row} {
4036 global canvy0 linespc
4037 return [expr {$canvy0 + $row * $linespc}]
4040 proc linewidth {id} {
4041 global thickerline lthickness
4043 set wid $lthickness
4044 if {[info exists thickerline] && $id eq $thickerline} {
4045 set wid [expr {2 * $lthickness}]
4047 return $wid
4050 proc rowranges {id} {
4051 global curview children uparrowlen downarrowlen
4052 global rowidlist
4054 set kids $children($curview,$id)
4055 if {$kids eq {}} {
4056 return {}
4058 set ret {}
4059 lappend kids $id
4060 foreach child $kids {
4061 if {![commitinview $child $curview]} break
4062 set row [rowofcommit $child]
4063 if {![info exists prev]} {
4064 lappend ret [expr {$row + 1}]
4065 } else {
4066 if {$row <= $prevrow} {
4067 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4069 # see if the line extends the whole way from prevrow to row
4070 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4071 [lsearch -exact [lindex $rowidlist \
4072 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4073 # it doesn't, see where it ends
4074 set r [expr {$prevrow + $downarrowlen}]
4075 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4076 while {[incr r -1] > $prevrow &&
4077 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4078 } else {
4079 while {[incr r] <= $row &&
4080 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4081 incr r -1
4083 lappend ret $r
4084 # see where it starts up again
4085 set r [expr {$row - $uparrowlen}]
4086 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4087 while {[incr r] < $row &&
4088 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4089 } else {
4090 while {[incr r -1] >= $prevrow &&
4091 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4092 incr r
4094 lappend ret $r
4097 if {$child eq $id} {
4098 lappend ret $row
4100 set prev $child
4101 set prevrow $row
4103 return $ret
4106 proc drawlineseg {id row endrow arrowlow} {
4107 global rowidlist displayorder iddrawn linesegs
4108 global canv colormap linespc curview maxlinelen parentlist
4110 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4111 set le [expr {$row + 1}]
4112 set arrowhigh 1
4113 while {1} {
4114 set c [lsearch -exact [lindex $rowidlist $le] $id]
4115 if {$c < 0} {
4116 incr le -1
4117 break
4119 lappend cols $c
4120 set x [lindex $displayorder $le]
4121 if {$x eq $id} {
4122 set arrowhigh 0
4123 break
4125 if {[info exists iddrawn($x)] || $le == $endrow} {
4126 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4127 if {$c >= 0} {
4128 lappend cols $c
4129 set arrowhigh 0
4131 break
4133 incr le
4135 if {$le <= $row} {
4136 return $row
4139 set lines {}
4140 set i 0
4141 set joinhigh 0
4142 if {[info exists linesegs($id)]} {
4143 set lines $linesegs($id)
4144 foreach li $lines {
4145 set r0 [lindex $li 0]
4146 if {$r0 > $row} {
4147 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4148 set joinhigh 1
4150 break
4152 incr i
4155 set joinlow 0
4156 if {$i > 0} {
4157 set li [lindex $lines [expr {$i-1}]]
4158 set r1 [lindex $li 1]
4159 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4160 set joinlow 1
4164 set x [lindex $cols [expr {$le - $row}]]
4165 set xp [lindex $cols [expr {$le - 1 - $row}]]
4166 set dir [expr {$xp - $x}]
4167 if {$joinhigh} {
4168 set ith [lindex $lines $i 2]
4169 set coords [$canv coords $ith]
4170 set ah [$canv itemcget $ith -arrow]
4171 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4172 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4173 if {$x2 ne {} && $x - $x2 == $dir} {
4174 set coords [lrange $coords 0 end-2]
4176 } else {
4177 set coords [list [xc $le $x] [yc $le]]
4179 if {$joinlow} {
4180 set itl [lindex $lines [expr {$i-1}] 2]
4181 set al [$canv itemcget $itl -arrow]
4182 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4183 } elseif {$arrowlow} {
4184 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4185 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4186 set arrowlow 0
4189 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4190 for {set y $le} {[incr y -1] > $row} {} {
4191 set x $xp
4192 set xp [lindex $cols [expr {$y - 1 - $row}]]
4193 set ndir [expr {$xp - $x}]
4194 if {$dir != $ndir || $xp < 0} {
4195 lappend coords [xc $y $x] [yc $y]
4197 set dir $ndir
4199 if {!$joinlow} {
4200 if {$xp < 0} {
4201 # join parent line to first child
4202 set ch [lindex $displayorder $row]
4203 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4204 if {$xc < 0} {
4205 puts "oops: drawlineseg: child $ch not on row $row"
4206 } elseif {$xc != $x} {
4207 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4208 set d [expr {int(0.5 * $linespc)}]
4209 set x1 [xc $row $x]
4210 if {$xc < $x} {
4211 set x2 [expr {$x1 - $d}]
4212 } else {
4213 set x2 [expr {$x1 + $d}]
4215 set y2 [yc $row]
4216 set y1 [expr {$y2 + $d}]
4217 lappend coords $x1 $y1 $x2 $y2
4218 } elseif {$xc < $x - 1} {
4219 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4220 } elseif {$xc > $x + 1} {
4221 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4223 set x $xc
4225 lappend coords [xc $row $x] [yc $row]
4226 } else {
4227 set xn [xc $row $xp]
4228 set yn [yc $row]
4229 lappend coords $xn $yn
4231 if {!$joinhigh} {
4232 assigncolor $id
4233 set t [$canv create line $coords -width [linewidth $id] \
4234 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4235 $canv lower $t
4236 bindline $t $id
4237 set lines [linsert $lines $i [list $row $le $t]]
4238 } else {
4239 $canv coords $ith $coords
4240 if {$arrow ne $ah} {
4241 $canv itemconf $ith -arrow $arrow
4243 lset lines $i 0 $row
4245 } else {
4246 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4247 set ndir [expr {$xo - $xp}]
4248 set clow [$canv coords $itl]
4249 if {$dir == $ndir} {
4250 set clow [lrange $clow 2 end]
4252 set coords [concat $coords $clow]
4253 if {!$joinhigh} {
4254 lset lines [expr {$i-1}] 1 $le
4255 } else {
4256 # coalesce two pieces
4257 $canv delete $ith
4258 set b [lindex $lines [expr {$i-1}] 0]
4259 set e [lindex $lines $i 1]
4260 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4262 $canv coords $itl $coords
4263 if {$arrow ne $al} {
4264 $canv itemconf $itl -arrow $arrow
4268 set linesegs($id) $lines
4269 return $le
4272 proc drawparentlinks {id row} {
4273 global rowidlist canv colormap curview parentlist
4274 global idpos linespc
4276 set rowids [lindex $rowidlist $row]
4277 set col [lsearch -exact $rowids $id]
4278 if {$col < 0} return
4279 set olds [lindex $parentlist $row]
4280 set row2 [expr {$row + 1}]
4281 set x [xc $row $col]
4282 set y [yc $row]
4283 set y2 [yc $row2]
4284 set d [expr {int(0.5 * $linespc)}]
4285 set ymid [expr {$y + $d}]
4286 set ids [lindex $rowidlist $row2]
4287 # rmx = right-most X coord used
4288 set rmx 0
4289 foreach p $olds {
4290 set i [lsearch -exact $ids $p]
4291 if {$i < 0} {
4292 puts "oops, parent $p of $id not in list"
4293 continue
4295 set x2 [xc $row2 $i]
4296 if {$x2 > $rmx} {
4297 set rmx $x2
4299 set j [lsearch -exact $rowids $p]
4300 if {$j < 0} {
4301 # drawlineseg will do this one for us
4302 continue
4304 assigncolor $p
4305 # should handle duplicated parents here...
4306 set coords [list $x $y]
4307 if {$i != $col} {
4308 # if attaching to a vertical segment, draw a smaller
4309 # slant for visual distinctness
4310 if {$i == $j} {
4311 if {$i < $col} {
4312 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4313 } else {
4314 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4316 } elseif {$i < $col && $i < $j} {
4317 # segment slants towards us already
4318 lappend coords [xc $row $j] $y
4319 } else {
4320 if {$i < $col - 1} {
4321 lappend coords [expr {$x2 + $linespc}] $y
4322 } elseif {$i > $col + 1} {
4323 lappend coords [expr {$x2 - $linespc}] $y
4325 lappend coords $x2 $y2
4327 } else {
4328 lappend coords $x2 $y2
4330 set t [$canv create line $coords -width [linewidth $p] \
4331 -fill $colormap($p) -tags lines.$p]
4332 $canv lower $t
4333 bindline $t $p
4335 if {$rmx > [lindex $idpos($id) 1]} {
4336 lset idpos($id) 1 $rmx
4337 redrawtags $id
4341 proc drawlines {id} {
4342 global canv
4344 $canv itemconf lines.$id -width [linewidth $id]
4347 proc drawcmittext {id row col} {
4348 global linespc canv canv2 canv3 fgcolor curview
4349 global cmitlisted commitinfo rowidlist parentlist
4350 global rowtextx idpos idtags idheads idotherrefs
4351 global linehtag linentag linedtag selectedline
4352 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4354 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
4355 set listed $cmitlisted($curview,$id)
4356 if {$id eq $nullid} {
4357 set ofill red
4358 } elseif {$id eq $nullid2} {
4359 set ofill green
4360 } else {
4361 set ofill [expr {$listed != 0? "blue": "white"}]
4363 set x [xc $row $col]
4364 set y [yc $row]
4365 set orad [expr {$linespc / 3}]
4366 if {$listed <= 1} {
4367 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4368 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4369 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4370 } elseif {$listed == 2} {
4371 # triangle pointing left for left-side commits
4372 set t [$canv create polygon \
4373 [expr {$x - $orad}] $y \
4374 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4375 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4376 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4377 } else {
4378 # triangle pointing right for right-side commits
4379 set t [$canv create polygon \
4380 [expr {$x + $orad - 1}] $y \
4381 [expr {$x - $orad}] [expr {$y - $orad}] \
4382 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4383 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4385 $canv raise $t
4386 $canv bind $t <1> {selcanvline {} %x %y}
4387 set rmx [llength [lindex $rowidlist $row]]
4388 set olds [lindex $parentlist $row]
4389 if {$olds ne {}} {
4390 set nextids [lindex $rowidlist [expr {$row + 1}]]
4391 foreach p $olds {
4392 set i [lsearch -exact $nextids $p]
4393 if {$i > $rmx} {
4394 set rmx $i
4398 set xt [xc $row $rmx]
4399 set rowtextx($row) $xt
4400 set idpos($id) [list $x $xt $y]
4401 if {[info exists idtags($id)] || [info exists idheads($id)]
4402 || [info exists idotherrefs($id)]} {
4403 set xt [drawtags $id $x $xt $y]
4405 set headline [lindex $commitinfo($id) 0]
4406 set name [lindex $commitinfo($id) 1]
4407 set date [lindex $commitinfo($id) 2]
4408 set date [formatdate $date]
4409 set font mainfont
4410 set nfont mainfont
4411 set isbold [ishighlighted $row]
4412 if {$isbold > 0} {
4413 lappend boldrows $row
4414 set font mainfontbold
4415 if {$isbold > 1} {
4416 lappend boldnamerows $row
4417 set nfont mainfontbold
4420 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4421 -text $headline -font $font -tags text]
4422 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4423 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4424 -text $name -font $nfont -tags text]
4425 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4426 -text $date -font mainfont -tags text]
4427 if {[info exists selectedline] && $selectedline == $row} {
4428 make_secsel $row
4430 set xr [expr {$xt + [font measure $font $headline]}]
4431 if {$xr > $canvxmax} {
4432 set canvxmax $xr
4433 setcanvscroll
4437 proc drawcmitrow {row} {
4438 global displayorder rowidlist nrows_drawn
4439 global iddrawn markingmatches
4440 global commitinfo numcommits
4441 global filehighlight fhighlights findpattern nhighlights
4442 global hlview vhighlights
4443 global highlight_related rhighlights
4445 if {$row >= $numcommits} return
4447 set id [lindex $displayorder $row]
4448 if {[info exists hlview] && ![info exists vhighlights($row)]} {
4449 askvhighlight $row $id
4451 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
4452 askfilehighlight $row $id
4454 if {$findpattern ne {} && ![info exists nhighlights($row)]} {
4455 askfindhighlight $row $id
4457 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
4458 askrelhighlight $row $id
4460 if {![info exists iddrawn($id)]} {
4461 set col [lsearch -exact [lindex $rowidlist $row] $id]
4462 if {$col < 0} {
4463 puts "oops, row $row id $id not in list"
4464 return
4466 if {![info exists commitinfo($id)]} {
4467 getcommit $id
4469 assigncolor $id
4470 drawcmittext $id $row $col
4471 set iddrawn($id) 1
4472 incr nrows_drawn
4474 if {$markingmatches} {
4475 markrowmatches $row $id
4479 proc drawcommits {row {endrow {}}} {
4480 global numcommits iddrawn displayorder curview need_redisplay
4481 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4483 if {$row < 0} {
4484 set row 0
4486 if {$endrow eq {}} {
4487 set endrow $row
4489 if {$endrow >= $numcommits} {
4490 set endrow [expr {$numcommits - 1}]
4493 set rl1 [expr {$row - $downarrowlen - 3}]
4494 if {$rl1 < 0} {
4495 set rl1 0
4497 set ro1 [expr {$row - 3}]
4498 if {$ro1 < 0} {
4499 set ro1 0
4501 set r2 [expr {$endrow + $uparrowlen + 3}]
4502 if {$r2 > $numcommits} {
4503 set r2 $numcommits
4505 for {set r $rl1} {$r < $r2} {incr r} {
4506 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4507 if {$rl1 < $r} {
4508 layoutrows $rl1 $r
4510 set rl1 [expr {$r + 1}]
4513 if {$rl1 < $r} {
4514 layoutrows $rl1 $r
4516 optimize_rows $ro1 0 $r2
4517 if {$need_redisplay || $nrows_drawn > 2000} {
4518 clear_display
4519 drawvisible
4522 # make the lines join to already-drawn rows either side
4523 set r [expr {$row - 1}]
4524 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4525 set r $row
4527 set er [expr {$endrow + 1}]
4528 if {$er >= $numcommits ||
4529 ![info exists iddrawn([lindex $displayorder $er])]} {
4530 set er $endrow
4532 for {} {$r <= $er} {incr r} {
4533 set id [lindex $displayorder $r]
4534 set wasdrawn [info exists iddrawn($id)]
4535 drawcmitrow $r
4536 if {$r == $er} break
4537 set nextid [lindex $displayorder [expr {$r + 1}]]
4538 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4539 drawparentlinks $id $r
4541 set rowids [lindex $rowidlist $r]
4542 foreach lid $rowids {
4543 if {$lid eq {}} continue
4544 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4545 if {$lid eq $id} {
4546 # see if this is the first child of any of its parents
4547 foreach p [lindex $parentlist $r] {
4548 if {[lsearch -exact $rowids $p] < 0} {
4549 # make this line extend up to the child
4550 set lineend($p) [drawlineseg $p $r $er 0]
4553 } else {
4554 set lineend($lid) [drawlineseg $lid $r $er 1]
4560 proc undolayout {row} {
4561 global uparrowlen mingaplen downarrowlen
4562 global rowidlist rowisopt rowfinal need_redisplay
4564 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4565 if {$r < 0} {
4566 set r 0
4568 if {[llength $rowidlist] > $r} {
4569 incr r -1
4570 set rowidlist [lrange $rowidlist 0 $r]
4571 set rowfinal [lrange $rowfinal 0 $r]
4572 set rowisopt [lrange $rowisopt 0 $r]
4573 set need_redisplay 1
4574 run drawvisible
4578 proc drawvisible {} {
4579 global canv linespc curview vrowmod selectedline targetrow targetid
4580 global need_redisplay cscroll numcommits
4582 set fs [$canv yview]
4583 set ymax [lindex [$canv cget -scrollregion] 3]
4584 if {$ymax eq {} || $ymax == 0} return
4585 set f0 [lindex $fs 0]
4586 set f1 [lindex $fs 1]
4587 set y0 [expr {int($f0 * $ymax)}]
4588 set y1 [expr {int($f1 * $ymax)}]
4590 if {[info exists targetid]} {
4591 if {[commitinview $targetid $curview]} {
4592 set r [rowofcommit $targetid]
4593 if {$r != $targetrow} {
4594 # Fix up the scrollregion and change the scrolling position
4595 # now that our target row has moved.
4596 set diff [expr {($r - $targetrow) * $linespc}]
4597 set targetrow $r
4598 setcanvscroll
4599 set ymax [lindex [$canv cget -scrollregion] 3]
4600 incr y0 $diff
4601 incr y1 $diff
4602 set f0 [expr {$y0 / $ymax}]
4603 set f1 [expr {$y1 / $ymax}]
4604 allcanvs yview moveto $f0
4605 $cscroll set $f0 $f1
4606 set need_redisplay 1
4608 } else {
4609 unset targetid
4613 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4614 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4615 if {$endrow >= $vrowmod($curview)} {
4616 update_arcrows $curview
4618 if {[info exists selectedline] &&
4619 $row <= $selectedline && $selectedline <= $endrow} {
4620 set targetrow $selectedline
4621 } else {
4622 set targetrow [expr {int(($row + $endrow) / 2)}]
4624 if {$targetrow >= $numcommits} {
4625 set targetrow [expr {$numcommits - 1}]
4627 set targetid [commitonrow $targetrow]
4628 drawcommits $row $endrow
4631 proc clear_display {} {
4632 global iddrawn linesegs need_redisplay nrows_drawn
4633 global vhighlights fhighlights nhighlights rhighlights
4635 allcanvs delete all
4636 catch {unset iddrawn}
4637 catch {unset linesegs}
4638 catch {unset vhighlights}
4639 catch {unset fhighlights}
4640 catch {unset nhighlights}
4641 catch {unset rhighlights}
4642 set need_redisplay 0
4643 set nrows_drawn 0
4646 proc findcrossings {id} {
4647 global rowidlist parentlist numcommits displayorder
4649 set cross {}
4650 set ccross {}
4651 foreach {s e} [rowranges $id] {
4652 if {$e >= $numcommits} {
4653 set e [expr {$numcommits - 1}]
4655 if {$e <= $s} continue
4656 for {set row $e} {[incr row -1] >= $s} {} {
4657 set x [lsearch -exact [lindex $rowidlist $row] $id]
4658 if {$x < 0} break
4659 set olds [lindex $parentlist $row]
4660 set kid [lindex $displayorder $row]
4661 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4662 if {$kidx < 0} continue
4663 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4664 foreach p $olds {
4665 set px [lsearch -exact $nextrow $p]
4666 if {$px < 0} continue
4667 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4668 if {[lsearch -exact $ccross $p] >= 0} continue
4669 if {$x == $px + ($kidx < $px? -1: 1)} {
4670 lappend ccross $p
4671 } elseif {[lsearch -exact $cross $p] < 0} {
4672 lappend cross $p
4678 return [concat $ccross {{}} $cross]
4681 proc assigncolor {id} {
4682 global colormap colors nextcolor
4683 global parents children children curview
4685 if {[info exists colormap($id)]} return
4686 set ncolors [llength $colors]
4687 if {[info exists children($curview,$id)]} {
4688 set kids $children($curview,$id)
4689 } else {
4690 set kids {}
4692 if {[llength $kids] == 1} {
4693 set child [lindex $kids 0]
4694 if {[info exists colormap($child)]
4695 && [llength $parents($curview,$child)] == 1} {
4696 set colormap($id) $colormap($child)
4697 return
4700 set badcolors {}
4701 set origbad {}
4702 foreach x [findcrossings $id] {
4703 if {$x eq {}} {
4704 # delimiter between corner crossings and other crossings
4705 if {[llength $badcolors] >= $ncolors - 1} break
4706 set origbad $badcolors
4708 if {[info exists colormap($x)]
4709 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4710 lappend badcolors $colormap($x)
4713 if {[llength $badcolors] >= $ncolors} {
4714 set badcolors $origbad
4716 set origbad $badcolors
4717 if {[llength $badcolors] < $ncolors - 1} {
4718 foreach child $kids {
4719 if {[info exists colormap($child)]
4720 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4721 lappend badcolors $colormap($child)
4723 foreach p $parents($curview,$child) {
4724 if {[info exists colormap($p)]
4725 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4726 lappend badcolors $colormap($p)
4730 if {[llength $badcolors] >= $ncolors} {
4731 set badcolors $origbad
4734 for {set i 0} {$i <= $ncolors} {incr i} {
4735 set c [lindex $colors $nextcolor]
4736 if {[incr nextcolor] >= $ncolors} {
4737 set nextcolor 0
4739 if {[lsearch -exact $badcolors $c]} break
4741 set colormap($id) $c
4744 proc bindline {t id} {
4745 global canv
4747 $canv bind $t <Enter> "lineenter %x %y $id"
4748 $canv bind $t <Motion> "linemotion %x %y $id"
4749 $canv bind $t <Leave> "lineleave $id"
4750 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4753 proc drawtags {id x xt y1} {
4754 global idtags idheads idotherrefs mainhead
4755 global linespc lthickness
4756 global canv rowtextx curview fgcolor bgcolor
4758 set marks {}
4759 set ntags 0
4760 set nheads 0
4761 if {[info exists idtags($id)]} {
4762 set marks $idtags($id)
4763 set ntags [llength $marks]
4765 if {[info exists idheads($id)]} {
4766 set marks [concat $marks $idheads($id)]
4767 set nheads [llength $idheads($id)]
4769 if {[info exists idotherrefs($id)]} {
4770 set marks [concat $marks $idotherrefs($id)]
4772 if {$marks eq {}} {
4773 return $xt
4776 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4777 set yt [expr {$y1 - 0.5 * $linespc}]
4778 set yb [expr {$yt + $linespc - 1}]
4779 set xvals {}
4780 set wvals {}
4781 set i -1
4782 foreach tag $marks {
4783 incr i
4784 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4785 set wid [font measure mainfontbold $tag]
4786 } else {
4787 set wid [font measure mainfont $tag]
4789 lappend xvals $xt
4790 lappend wvals $wid
4791 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4793 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4794 -width $lthickness -fill black -tags tag.$id]
4795 $canv lower $t
4796 foreach tag $marks x $xvals wid $wvals {
4797 set xl [expr {$x + $delta}]
4798 set xr [expr {$x + $delta + $wid + $lthickness}]
4799 set font mainfont
4800 if {[incr ntags -1] >= 0} {
4801 # draw a tag
4802 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4803 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4804 -width 1 -outline black -fill yellow -tags tag.$id]
4805 $canv bind $t <1> [list showtag $tag 1]
4806 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4807 } else {
4808 # draw a head or other ref
4809 if {[incr nheads -1] >= 0} {
4810 set col green
4811 if {$tag eq $mainhead} {
4812 set font mainfontbold
4814 } else {
4815 set col "#ddddff"
4817 set xl [expr {$xl - $delta/2}]
4818 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4819 -width 1 -outline black -fill $col -tags tag.$id
4820 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4821 set rwid [font measure mainfont $remoteprefix]
4822 set xi [expr {$x + 1}]
4823 set yti [expr {$yt + 1}]
4824 set xri [expr {$x + $rwid}]
4825 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4826 -width 0 -fill "#ffddaa" -tags tag.$id
4829 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4830 -font $font -tags [list tag.$id text]]
4831 if {$ntags >= 0} {
4832 $canv bind $t <1> [list showtag $tag 1]
4833 } elseif {$nheads >= 0} {
4834 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4837 return $xt
4840 proc xcoord {i level ln} {
4841 global canvx0 xspc1 xspc2
4843 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4844 if {$i > 0 && $i == $level} {
4845 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4846 } elseif {$i > $level} {
4847 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4849 return $x
4852 proc show_status {msg} {
4853 global canv fgcolor
4855 clear_display
4856 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4857 -tags text -fill $fgcolor
4860 # Don't change the text pane cursor if it is currently the hand cursor,
4861 # showing that we are over a sha1 ID link.
4862 proc settextcursor {c} {
4863 global ctext curtextcursor
4865 if {[$ctext cget -cursor] == $curtextcursor} {
4866 $ctext config -cursor $c
4868 set curtextcursor $c
4871 proc nowbusy {what {name {}}} {
4872 global isbusy busyname statusw
4874 if {[array names isbusy] eq {}} {
4875 . config -cursor watch
4876 settextcursor watch
4878 set isbusy($what) 1
4879 set busyname($what) $name
4880 if {$name ne {}} {
4881 $statusw conf -text $name
4885 proc notbusy {what} {
4886 global isbusy maincursor textcursor busyname statusw
4888 catch {
4889 unset isbusy($what)
4890 if {$busyname($what) ne {} &&
4891 [$statusw cget -text] eq $busyname($what)} {
4892 $statusw conf -text {}
4895 if {[array names isbusy] eq {}} {
4896 . config -cursor $maincursor
4897 settextcursor $textcursor
4901 proc findmatches {f} {
4902 global findtype findstring
4903 if {$findtype == [mc "Regexp"]} {
4904 set matches [regexp -indices -all -inline $findstring $f]
4905 } else {
4906 set fs $findstring
4907 if {$findtype == [mc "IgnCase"]} {
4908 set f [string tolower $f]
4909 set fs [string tolower $fs]
4911 set matches {}
4912 set i 0
4913 set l [string length $fs]
4914 while {[set j [string first $fs $f $i]] >= 0} {
4915 lappend matches [list $j [expr {$j+$l-1}]]
4916 set i [expr {$j + $l}]
4919 return $matches
4922 proc dofind {{dirn 1} {wrap 1}} {
4923 global findstring findstartline findcurline selectedline numcommits
4924 global gdttype filehighlight fh_serial find_dirn findallowwrap
4926 if {[info exists find_dirn]} {
4927 if {$find_dirn == $dirn} return
4928 stopfinding
4930 focus .
4931 if {$findstring eq {} || $numcommits == 0} return
4932 if {![info exists selectedline]} {
4933 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4934 } else {
4935 set findstartline $selectedline
4937 set findcurline $findstartline
4938 nowbusy finding [mc "Searching"]
4939 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4940 after cancel do_file_hl $fh_serial
4941 do_file_hl $fh_serial
4943 set find_dirn $dirn
4944 set findallowwrap $wrap
4945 run findmore
4948 proc stopfinding {} {
4949 global find_dirn findcurline fprogcoord
4951 if {[info exists find_dirn]} {
4952 unset find_dirn
4953 unset findcurline
4954 notbusy finding
4955 set fprogcoord 0
4956 adjustprogress
4960 proc findmore {} {
4961 global commitdata commitinfo numcommits findpattern findloc
4962 global findstartline findcurline findallowwrap
4963 global find_dirn gdttype fhighlights fprogcoord
4964 global curview varcorder vrownum varccommits vrowmod
4966 if {![info exists find_dirn]} {
4967 return 0
4969 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4970 set l $findcurline
4971 set moretodo 0
4972 if {$find_dirn > 0} {
4973 incr l
4974 if {$l >= $numcommits} {
4975 set l 0
4977 if {$l <= $findstartline} {
4978 set lim [expr {$findstartline + 1}]
4979 } else {
4980 set lim $numcommits
4981 set moretodo $findallowwrap
4983 } else {
4984 if {$l == 0} {
4985 set l $numcommits
4987 incr l -1
4988 if {$l >= $findstartline} {
4989 set lim [expr {$findstartline - 1}]
4990 } else {
4991 set lim -1
4992 set moretodo $findallowwrap
4995 set n [expr {($lim - $l) * $find_dirn}]
4996 if {$n > 500} {
4997 set n 500
4998 set moretodo 1
5000 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5001 update_arcrows $curview
5003 set found 0
5004 set domore 1
5005 set ai [bsearch $vrownum($curview) $l]
5006 set a [lindex $varcorder($curview) $ai]
5007 set arow [lindex $vrownum($curview) $ai]
5008 set ids [lindex $varccommits($curview,$a)]
5009 set arowend [expr {$arow + [llength $ids]}]
5010 if {$gdttype eq [mc "containing:"]} {
5011 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5012 if {$l < $arow || $l >= $arowend} {
5013 incr ai $find_dirn
5014 set a [lindex $varcorder($curview) $ai]
5015 set arow [lindex $vrownum($curview) $ai]
5016 set ids [lindex $varccommits($curview,$a)]
5017 set arowend [expr {$arow + [llength $ids]}]
5019 set id [lindex $ids [expr {$l - $arow}]]
5020 # shouldn't happen unless git log doesn't give all the commits...
5021 if {![info exists commitdata($id)] ||
5022 ![doesmatch $commitdata($id)]} {
5023 continue
5025 if {![info exists commitinfo($id)]} {
5026 getcommit $id
5028 set info $commitinfo($id)
5029 foreach f $info ty $fldtypes {
5030 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5031 [doesmatch $f]} {
5032 set found 1
5033 break
5036 if {$found} break
5038 } else {
5039 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5040 if {$l < $arow || $l >= $arowend} {
5041 incr ai $find_dirn
5042 set a [lindex $varcorder($curview) $ai]
5043 set arow [lindex $vrownum($curview) $ai]
5044 set ids [lindex $varccommits($curview,$a)]
5045 set arowend [expr {$arow + [llength $ids]}]
5047 set id [lindex $ids [expr {$l - $arow}]]
5048 if {![info exists fhighlights($l)]} {
5049 # this sets fhighlights($l) to -1
5050 askfilehighlight $l $id
5052 if {$fhighlights($l) > 0} {
5053 set found $domore
5054 break
5056 if {$fhighlights($l) < 0} {
5057 if {$domore} {
5058 set domore 0
5059 set findcurline [expr {$l - $find_dirn}]
5064 if {$found || ($domore && !$moretodo)} {
5065 unset findcurline
5066 unset find_dirn
5067 notbusy finding
5068 set fprogcoord 0
5069 adjustprogress
5070 if {$found} {
5071 findselectline $l
5072 } else {
5073 bell
5075 return 0
5077 if {!$domore} {
5078 flushhighlights
5079 } else {
5080 set findcurline [expr {$l - $find_dirn}]
5082 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5083 if {$n < 0} {
5084 incr n $numcommits
5086 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5087 adjustprogress
5088 return $domore
5091 proc findselectline {l} {
5092 global findloc commentend ctext findcurline markingmatches gdttype
5094 set markingmatches 1
5095 set findcurline $l
5096 selectline $l 1
5097 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5098 # highlight the matches in the comments
5099 set f [$ctext get 1.0 $commentend]
5100 set matches [findmatches $f]
5101 foreach match $matches {
5102 set start [lindex $match 0]
5103 set end [expr {[lindex $match 1] + 1}]
5104 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5107 drawvisible
5110 # mark the bits of a headline or author that match a find string
5111 proc markmatches {canv l str tag matches font row} {
5112 global selectedline
5114 set bbox [$canv bbox $tag]
5115 set x0 [lindex $bbox 0]
5116 set y0 [lindex $bbox 1]
5117 set y1 [lindex $bbox 3]
5118 foreach match $matches {
5119 set start [lindex $match 0]
5120 set end [lindex $match 1]
5121 if {$start > $end} continue
5122 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5123 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5124 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5125 [expr {$x0+$xlen+2}] $y1 \
5126 -outline {} -tags [list match$l matches] -fill yellow]
5127 $canv lower $t
5128 if {[info exists selectedline] && $row == $selectedline} {
5129 $canv raise $t secsel
5134 proc unmarkmatches {} {
5135 global markingmatches
5137 allcanvs delete matches
5138 set markingmatches 0
5139 stopfinding
5142 proc selcanvline {w x y} {
5143 global canv canvy0 ctext linespc
5144 global rowtextx
5145 set ymax [lindex [$canv cget -scrollregion] 3]
5146 if {$ymax == {}} return
5147 set yfrac [lindex [$canv yview] 0]
5148 set y [expr {$y + $yfrac * $ymax}]
5149 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5150 if {$l < 0} {
5151 set l 0
5153 if {$w eq $canv} {
5154 set xmax [lindex [$canv cget -scrollregion] 2]
5155 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5156 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5158 unmarkmatches
5159 selectline $l 1
5162 proc commit_descriptor {p} {
5163 global commitinfo
5164 if {![info exists commitinfo($p)]} {
5165 getcommit $p
5167 set l "..."
5168 if {[llength $commitinfo($p)] > 1} {
5169 set l [lindex $commitinfo($p) 0]
5171 return "$p ($l)\n"
5174 # append some text to the ctext widget, and make any SHA1 ID
5175 # that we know about be a clickable link.
5176 proc appendwithlinks {text tags} {
5177 global ctext linknum curview pendinglinks
5179 set start [$ctext index "end - 1c"]
5180 $ctext insert end $text $tags
5181 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5182 foreach l $links {
5183 set s [lindex $l 0]
5184 set e [lindex $l 1]
5185 set linkid [string range $text $s $e]
5186 incr e
5187 $ctext tag delete link$linknum
5188 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5189 setlink $linkid link$linknum
5190 incr linknum
5194 proc setlink {id lk} {
5195 global curview ctext pendinglinks commitinterest
5197 if {[commitinview $id $curview]} {
5198 $ctext tag conf $lk -foreground blue -underline 1
5199 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5200 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5201 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5202 } else {
5203 lappend pendinglinks($id) $lk
5204 lappend commitinterest($id) {makelink %I}
5208 proc makelink {id} {
5209 global pendinglinks
5211 if {![info exists pendinglinks($id)]} return
5212 foreach lk $pendinglinks($id) {
5213 setlink $id $lk
5215 unset pendinglinks($id)
5218 proc linkcursor {w inc} {
5219 global linkentercount curtextcursor
5221 if {[incr linkentercount $inc] > 0} {
5222 $w configure -cursor hand2
5223 } else {
5224 $w configure -cursor $curtextcursor
5225 if {$linkentercount < 0} {
5226 set linkentercount 0
5231 proc viewnextline {dir} {
5232 global canv linespc
5234 $canv delete hover
5235 set ymax [lindex [$canv cget -scrollregion] 3]
5236 set wnow [$canv yview]
5237 set wtop [expr {[lindex $wnow 0] * $ymax}]
5238 set newtop [expr {$wtop + $dir * $linespc}]
5239 if {$newtop < 0} {
5240 set newtop 0
5241 } elseif {$newtop > $ymax} {
5242 set newtop $ymax
5244 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5247 # add a list of tag or branch names at position pos
5248 # returns the number of names inserted
5249 proc appendrefs {pos ids var} {
5250 global ctext linknum curview $var maxrefs
5252 if {[catch {$ctext index $pos}]} {
5253 return 0
5255 $ctext conf -state normal
5256 $ctext delete $pos "$pos lineend"
5257 set tags {}
5258 foreach id $ids {
5259 foreach tag [set $var\($id\)] {
5260 lappend tags [list $tag $id]
5263 if {[llength $tags] > $maxrefs} {
5264 $ctext insert $pos "many ([llength $tags])"
5265 } else {
5266 set tags [lsort -index 0 -decreasing $tags]
5267 set sep {}
5268 foreach ti $tags {
5269 set id [lindex $ti 1]
5270 set lk link$linknum
5271 incr linknum
5272 $ctext tag delete $lk
5273 $ctext insert $pos $sep
5274 $ctext insert $pos [lindex $ti 0] $lk
5275 setlink $id $lk
5276 set sep ", "
5279 $ctext conf -state disabled
5280 return [llength $tags]
5283 # called when we have finished computing the nearby tags
5284 proc dispneartags {delay} {
5285 global selectedline currentid showneartags tagphase
5287 if {![info exists selectedline] || !$showneartags} return
5288 after cancel dispnexttag
5289 if {$delay} {
5290 after 200 dispnexttag
5291 set tagphase -1
5292 } else {
5293 after idle dispnexttag
5294 set tagphase 0
5298 proc dispnexttag {} {
5299 global selectedline currentid showneartags tagphase ctext
5301 if {![info exists selectedline] || !$showneartags} return
5302 switch -- $tagphase {
5304 set dtags [desctags $currentid]
5305 if {$dtags ne {}} {
5306 appendrefs precedes $dtags idtags
5310 set atags [anctags $currentid]
5311 if {$atags ne {}} {
5312 appendrefs follows $atags idtags
5316 set dheads [descheads $currentid]
5317 if {$dheads ne {}} {
5318 if {[appendrefs branch $dheads idheads] > 1
5319 && [$ctext get "branch -3c"] eq "h"} {
5320 # turn "Branch" into "Branches"
5321 $ctext conf -state normal
5322 $ctext insert "branch -2c" "es"
5323 $ctext conf -state disabled
5328 if {[incr tagphase] <= 2} {
5329 after idle dispnexttag
5333 proc make_secsel {l} {
5334 global linehtag linentag linedtag canv canv2 canv3
5336 if {![info exists linehtag($l)]} return
5337 $canv delete secsel
5338 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5339 -tags secsel -fill [$canv cget -selectbackground]]
5340 $canv lower $t
5341 $canv2 delete secsel
5342 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5343 -tags secsel -fill [$canv2 cget -selectbackground]]
5344 $canv2 lower $t
5345 $canv3 delete secsel
5346 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5347 -tags secsel -fill [$canv3 cget -selectbackground]]
5348 $canv3 lower $t
5351 proc selectline {l isnew} {
5352 global canv ctext commitinfo selectedline
5353 global canvy0 linespc parents children curview
5354 global currentid sha1entry
5355 global commentend idtags linknum
5356 global mergemax numcommits pending_select
5357 global cmitmode showneartags allcommits
5359 catch {unset pending_select}
5360 $canv delete hover
5361 normalline
5362 unsel_reflist
5363 stopfinding
5364 if {$l < 0 || $l >= $numcommits} return
5365 set y [expr {$canvy0 + $l * $linespc}]
5366 set ymax [lindex [$canv cget -scrollregion] 3]
5367 set ytop [expr {$y - $linespc - 1}]
5368 set ybot [expr {$y + $linespc + 1}]
5369 set wnow [$canv yview]
5370 set wtop [expr {[lindex $wnow 0] * $ymax}]
5371 set wbot [expr {[lindex $wnow 1] * $ymax}]
5372 set wh [expr {$wbot - $wtop}]
5373 set newtop $wtop
5374 if {$ytop < $wtop} {
5375 if {$ybot < $wtop} {
5376 set newtop [expr {$y - $wh / 2.0}]
5377 } else {
5378 set newtop $ytop
5379 if {$newtop > $wtop - $linespc} {
5380 set newtop [expr {$wtop - $linespc}]
5383 } elseif {$ybot > $wbot} {
5384 if {$ytop > $wbot} {
5385 set newtop [expr {$y - $wh / 2.0}]
5386 } else {
5387 set newtop [expr {$ybot - $wh}]
5388 if {$newtop < $wtop + $linespc} {
5389 set newtop [expr {$wtop + $linespc}]
5393 if {$newtop != $wtop} {
5394 if {$newtop < 0} {
5395 set newtop 0
5397 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5398 drawvisible
5401 make_secsel $l
5403 set id [commitonrow $l]
5404 if {$isnew} {
5405 addtohistory [list selbyid $id]
5408 set selectedline $l
5409 set currentid $id
5410 $sha1entry delete 0 end
5411 $sha1entry insert 0 $id
5412 $sha1entry selection from 0
5413 $sha1entry selection to end
5414 rhighlight_sel $id
5416 $ctext conf -state normal
5417 clear_ctext
5418 set linknum 0
5419 set info $commitinfo($id)
5420 set date [formatdate [lindex $info 2]]
5421 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5422 set date [formatdate [lindex $info 4]]
5423 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5424 if {[info exists idtags($id)]} {
5425 $ctext insert end [mc "Tags:"]
5426 foreach tag $idtags($id) {
5427 $ctext insert end " $tag"
5429 $ctext insert end "\n"
5432 set headers {}
5433 set olds $parents($curview,$id)
5434 if {[llength $olds] > 1} {
5435 set np 0
5436 foreach p $olds {
5437 if {$np >= $mergemax} {
5438 set tag mmax
5439 } else {
5440 set tag m$np
5442 $ctext insert end "[mc "Parent"]: " $tag
5443 appendwithlinks [commit_descriptor $p] {}
5444 incr np
5446 } else {
5447 foreach p $olds {
5448 append headers "[mc "Parent"]: [commit_descriptor $p]"
5452 foreach c $children($curview,$id) {
5453 append headers "[mc "Child"]: [commit_descriptor $c]"
5456 # make anything that looks like a SHA1 ID be a clickable link
5457 appendwithlinks $headers {}
5458 if {$showneartags} {
5459 if {![info exists allcommits]} {
5460 getallcommits
5462 $ctext insert end "[mc "Branch"]: "
5463 $ctext mark set branch "end -1c"
5464 $ctext mark gravity branch left
5465 $ctext insert end "\n[mc "Follows"]: "
5466 $ctext mark set follows "end -1c"
5467 $ctext mark gravity follows left
5468 $ctext insert end "\n[mc "Precedes"]: "
5469 $ctext mark set precedes "end -1c"
5470 $ctext mark gravity precedes left
5471 $ctext insert end "\n"
5472 dispneartags 1
5474 $ctext insert end "\n"
5475 set comment [lindex $info 5]
5476 if {[string first "\r" $comment] >= 0} {
5477 set comment [string map {"\r" "\n "} $comment]
5479 appendwithlinks $comment {comment}
5481 $ctext tag remove found 1.0 end
5482 $ctext conf -state disabled
5483 set commentend [$ctext index "end - 1c"]
5485 init_flist [mc "Comments"]
5486 if {$cmitmode eq "tree"} {
5487 gettree $id
5488 } elseif {[llength $olds] <= 1} {
5489 startdiff $id
5490 } else {
5491 mergediff $id
5495 proc selfirstline {} {
5496 unmarkmatches
5497 selectline 0 1
5500 proc sellastline {} {
5501 global numcommits
5502 unmarkmatches
5503 set l [expr {$numcommits - 1}]
5504 selectline $l 1
5507 proc selnextline {dir} {
5508 global selectedline
5509 focus .
5510 if {![info exists selectedline]} return
5511 set l [expr {$selectedline + $dir}]
5512 unmarkmatches
5513 selectline $l 1
5516 proc selnextpage {dir} {
5517 global canv linespc selectedline numcommits
5519 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5520 if {$lpp < 1} {
5521 set lpp 1
5523 allcanvs yview scroll [expr {$dir * $lpp}] units
5524 drawvisible
5525 if {![info exists selectedline]} return
5526 set l [expr {$selectedline + $dir * $lpp}]
5527 if {$l < 0} {
5528 set l 0
5529 } elseif {$l >= $numcommits} {
5530 set l [expr $numcommits - 1]
5532 unmarkmatches
5533 selectline $l 1
5536 proc unselectline {} {
5537 global selectedline currentid
5539 catch {unset selectedline}
5540 catch {unset currentid}
5541 allcanvs delete secsel
5542 rhighlight_none
5545 proc reselectline {} {
5546 global selectedline
5548 if {[info exists selectedline]} {
5549 selectline $selectedline 0
5553 proc addtohistory {cmd} {
5554 global history historyindex curview
5556 set elt [list $curview $cmd]
5557 if {$historyindex > 0
5558 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5559 return
5562 if {$historyindex < [llength $history]} {
5563 set history [lreplace $history $historyindex end $elt]
5564 } else {
5565 lappend history $elt
5567 incr historyindex
5568 if {$historyindex > 1} {
5569 .tf.bar.leftbut conf -state normal
5570 } else {
5571 .tf.bar.leftbut conf -state disabled
5573 .tf.bar.rightbut conf -state disabled
5576 proc godo {elt} {
5577 global curview
5579 set view [lindex $elt 0]
5580 set cmd [lindex $elt 1]
5581 if {$curview != $view} {
5582 showview $view
5584 eval $cmd
5587 proc goback {} {
5588 global history historyindex
5589 focus .
5591 if {$historyindex > 1} {
5592 incr historyindex -1
5593 godo [lindex $history [expr {$historyindex - 1}]]
5594 .tf.bar.rightbut conf -state normal
5596 if {$historyindex <= 1} {
5597 .tf.bar.leftbut conf -state disabled
5601 proc goforw {} {
5602 global history historyindex
5603 focus .
5605 if {$historyindex < [llength $history]} {
5606 set cmd [lindex $history $historyindex]
5607 incr historyindex
5608 godo $cmd
5609 .tf.bar.leftbut conf -state normal
5611 if {$historyindex >= [llength $history]} {
5612 .tf.bar.rightbut conf -state disabled
5616 proc gettree {id} {
5617 global treefilelist treeidlist diffids diffmergeid treepending
5618 global nullid nullid2
5620 set diffids $id
5621 catch {unset diffmergeid}
5622 if {![info exists treefilelist($id)]} {
5623 if {![info exists treepending]} {
5624 if {$id eq $nullid} {
5625 set cmd [list | git ls-files]
5626 } elseif {$id eq $nullid2} {
5627 set cmd [list | git ls-files --stage -t]
5628 } else {
5629 set cmd [list | git ls-tree -r $id]
5631 if {[catch {set gtf [open $cmd r]}]} {
5632 return
5634 set treepending $id
5635 set treefilelist($id) {}
5636 set treeidlist($id) {}
5637 fconfigure $gtf -blocking 0
5638 filerun $gtf [list gettreeline $gtf $id]
5640 } else {
5641 setfilelist $id
5645 proc gettreeline {gtf id} {
5646 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5648 set nl 0
5649 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5650 if {$diffids eq $nullid} {
5651 set fname $line
5652 } else {
5653 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5654 set i [string first "\t" $line]
5655 if {$i < 0} continue
5656 set sha1 [lindex $line 2]
5657 set fname [string range $line [expr {$i+1}] end]
5658 if {[string index $fname 0] eq "\""} {
5659 set fname [lindex $fname 0]
5661 lappend treeidlist($id) $sha1
5663 lappend treefilelist($id) $fname
5665 if {![eof $gtf]} {
5666 return [expr {$nl >= 1000? 2: 1}]
5668 close $gtf
5669 unset treepending
5670 if {$cmitmode ne "tree"} {
5671 if {![info exists diffmergeid]} {
5672 gettreediffs $diffids
5674 } elseif {$id ne $diffids} {
5675 gettree $diffids
5676 } else {
5677 setfilelist $id
5679 return 0
5682 proc showfile {f} {
5683 global treefilelist treeidlist diffids nullid nullid2
5684 global ctext commentend
5686 set i [lsearch -exact $treefilelist($diffids) $f]
5687 if {$i < 0} {
5688 puts "oops, $f not in list for id $diffids"
5689 return
5691 if {$diffids eq $nullid} {
5692 if {[catch {set bf [open $f r]} err]} {
5693 puts "oops, can't read $f: $err"
5694 return
5696 } else {
5697 set blob [lindex $treeidlist($diffids) $i]
5698 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5699 puts "oops, error reading blob $blob: $err"
5700 return
5703 fconfigure $bf -blocking 0
5704 filerun $bf [list getblobline $bf $diffids]
5705 $ctext config -state normal
5706 clear_ctext $commentend
5707 $ctext insert end "\n"
5708 $ctext insert end "$f\n" filesep
5709 $ctext config -state disabled
5710 $ctext yview $commentend
5711 settabs 0
5714 proc getblobline {bf id} {
5715 global diffids cmitmode ctext
5717 if {$id ne $diffids || $cmitmode ne "tree"} {
5718 catch {close $bf}
5719 return 0
5721 $ctext config -state normal
5722 set nl 0
5723 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5724 $ctext insert end "$line\n"
5726 if {[eof $bf]} {
5727 # delete last newline
5728 $ctext delete "end - 2c" "end - 1c"
5729 close $bf
5730 return 0
5732 $ctext config -state disabled
5733 return [expr {$nl >= 1000? 2: 1}]
5736 proc mergediff {id} {
5737 global diffmergeid mdifffd
5738 global diffids
5739 global parents
5740 global limitdiffs viewfiles curview
5742 set diffmergeid $id
5743 set diffids $id
5744 # this doesn't seem to actually affect anything...
5745 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5746 if {$limitdiffs && $viewfiles($curview) ne {}} {
5747 set cmd [concat $cmd -- $viewfiles($curview)]
5749 if {[catch {set mdf [open $cmd r]} err]} {
5750 error_popup "[mc "Error getting merge diffs:"] $err"
5751 return
5753 fconfigure $mdf -blocking 0
5754 set mdifffd($id) $mdf
5755 set np [llength $parents($curview,$id)]
5756 settabs $np
5757 filerun $mdf [list getmergediffline $mdf $id $np]
5760 proc getmergediffline {mdf id np} {
5761 global diffmergeid ctext cflist mergemax
5762 global difffilestart mdifffd
5764 $ctext conf -state normal
5765 set nr 0
5766 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5767 if {![info exists diffmergeid] || $id != $diffmergeid
5768 || $mdf != $mdifffd($id)} {
5769 close $mdf
5770 return 0
5772 if {[regexp {^diff --cc (.*)} $line match fname]} {
5773 # start of a new file
5774 $ctext insert end "\n"
5775 set here [$ctext index "end - 1c"]
5776 lappend difffilestart $here
5777 add_flist [list $fname]
5778 set l [expr {(78 - [string length $fname]) / 2}]
5779 set pad [string range "----------------------------------------" 1 $l]
5780 $ctext insert end "$pad $fname $pad\n" filesep
5781 } elseif {[regexp {^@@} $line]} {
5782 $ctext insert end "$line\n" hunksep
5783 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5784 # do nothing
5785 } else {
5786 # parse the prefix - one ' ', '-' or '+' for each parent
5787 set spaces {}
5788 set minuses {}
5789 set pluses {}
5790 set isbad 0
5791 for {set j 0} {$j < $np} {incr j} {
5792 set c [string range $line $j $j]
5793 if {$c == " "} {
5794 lappend spaces $j
5795 } elseif {$c == "-"} {
5796 lappend minuses $j
5797 } elseif {$c == "+"} {
5798 lappend pluses $j
5799 } else {
5800 set isbad 1
5801 break
5804 set tags {}
5805 set num {}
5806 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5807 # line doesn't appear in result, parents in $minuses have the line
5808 set num [lindex $minuses 0]
5809 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5810 # line appears in result, parents in $pluses don't have the line
5811 lappend tags mresult
5812 set num [lindex $spaces 0]
5814 if {$num ne {}} {
5815 if {$num >= $mergemax} {
5816 set num "max"
5818 lappend tags m$num
5820 $ctext insert end "$line\n" $tags
5823 $ctext conf -state disabled
5824 if {[eof $mdf]} {
5825 close $mdf
5826 return 0
5828 return [expr {$nr >= 1000? 2: 1}]
5831 proc startdiff {ids} {
5832 global treediffs diffids treepending diffmergeid nullid nullid2
5834 settabs 1
5835 set diffids $ids
5836 catch {unset diffmergeid}
5837 if {![info exists treediffs($ids)] ||
5838 [lsearch -exact $ids $nullid] >= 0 ||
5839 [lsearch -exact $ids $nullid2] >= 0} {
5840 if {![info exists treepending]} {
5841 gettreediffs $ids
5843 } else {
5844 addtocflist $ids
5848 proc path_filter {filter name} {
5849 foreach p $filter {
5850 set l [string length $p]
5851 if {[string index $p end] eq "/"} {
5852 if {[string compare -length $l $p $name] == 0} {
5853 return 1
5855 } else {
5856 if {[string compare -length $l $p $name] == 0 &&
5857 ([string length $name] == $l ||
5858 [string index $name $l] eq "/")} {
5859 return 1
5863 return 0
5866 proc addtocflist {ids} {
5867 global treediffs
5869 add_flist $treediffs($ids)
5870 getblobdiffs $ids
5873 proc diffcmd {ids flags} {
5874 global nullid nullid2
5876 set i [lsearch -exact $ids $nullid]
5877 set j [lsearch -exact $ids $nullid2]
5878 if {$i >= 0} {
5879 if {[llength $ids] > 1 && $j < 0} {
5880 # comparing working directory with some specific revision
5881 set cmd [concat | git diff-index $flags]
5882 if {$i == 0} {
5883 lappend cmd -R [lindex $ids 1]
5884 } else {
5885 lappend cmd [lindex $ids 0]
5887 } else {
5888 # comparing working directory with index
5889 set cmd [concat | git diff-files $flags]
5890 if {$j == 1} {
5891 lappend cmd -R
5894 } elseif {$j >= 0} {
5895 set cmd [concat | git diff-index --cached $flags]
5896 if {[llength $ids] > 1} {
5897 # comparing index with specific revision
5898 if {$i == 0} {
5899 lappend cmd -R [lindex $ids 1]
5900 } else {
5901 lappend cmd [lindex $ids 0]
5903 } else {
5904 # comparing index with HEAD
5905 lappend cmd HEAD
5907 } else {
5908 set cmd [concat | git diff-tree -r $flags $ids]
5910 return $cmd
5913 proc gettreediffs {ids} {
5914 global treediff treepending
5916 set treepending $ids
5917 set treediff {}
5918 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5919 fconfigure $gdtf -blocking 0
5920 filerun $gdtf [list gettreediffline $gdtf $ids]
5923 proc gettreediffline {gdtf ids} {
5924 global treediff treediffs treepending diffids diffmergeid
5925 global cmitmode viewfiles curview limitdiffs
5927 set nr 0
5928 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5929 set i [string first "\t" $line]
5930 if {$i >= 0} {
5931 set file [string range $line [expr {$i+1}] end]
5932 if {[string index $file 0] eq "\""} {
5933 set file [lindex $file 0]
5935 lappend treediff $file
5938 if {![eof $gdtf]} {
5939 return [expr {$nr >= 1000? 2: 1}]
5941 close $gdtf
5942 if {$limitdiffs && $viewfiles($curview) ne {}} {
5943 set flist {}
5944 foreach f $treediff {
5945 if {[path_filter $viewfiles($curview) $f]} {
5946 lappend flist $f
5949 set treediffs($ids) $flist
5950 } else {
5951 set treediffs($ids) $treediff
5953 unset treepending
5954 if {$cmitmode eq "tree"} {
5955 gettree $diffids
5956 } elseif {$ids != $diffids} {
5957 if {![info exists diffmergeid]} {
5958 gettreediffs $diffids
5960 } else {
5961 addtocflist $ids
5963 return 0
5966 # empty string or positive integer
5967 proc diffcontextvalidate {v} {
5968 return [regexp {^(|[1-9][0-9]*)$} $v]
5971 proc diffcontextchange {n1 n2 op} {
5972 global diffcontextstring diffcontext
5974 if {[string is integer -strict $diffcontextstring]} {
5975 if {$diffcontextstring > 0} {
5976 set diffcontext $diffcontextstring
5977 reselectline
5982 proc getblobdiffs {ids} {
5983 global blobdifffd diffids env
5984 global diffinhdr treediffs
5985 global diffcontext
5986 global limitdiffs viewfiles curview
5988 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5989 if {$limitdiffs && $viewfiles($curview) ne {}} {
5990 set cmd [concat $cmd -- $viewfiles($curview)]
5992 if {[catch {set bdf [open $cmd r]} err]} {
5993 puts "error getting diffs: $err"
5994 return
5996 set diffinhdr 0
5997 fconfigure $bdf -blocking 0
5998 set blobdifffd($ids) $bdf
5999 filerun $bdf [list getblobdiffline $bdf $diffids]
6002 proc setinlist {var i val} {
6003 global $var
6005 while {[llength [set $var]] < $i} {
6006 lappend $var {}
6008 if {[llength [set $var]] == $i} {
6009 lappend $var $val
6010 } else {
6011 lset $var $i $val
6015 proc makediffhdr {fname ids} {
6016 global ctext curdiffstart treediffs
6018 set i [lsearch -exact $treediffs($ids) $fname]
6019 if {$i >= 0} {
6020 setinlist difffilestart $i $curdiffstart
6022 set l [expr {(78 - [string length $fname]) / 2}]
6023 set pad [string range "----------------------------------------" 1 $l]
6024 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6027 proc getblobdiffline {bdf ids} {
6028 global diffids blobdifffd ctext curdiffstart
6029 global diffnexthead diffnextnote difffilestart
6030 global diffinhdr treediffs
6032 set nr 0
6033 $ctext conf -state normal
6034 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6035 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6036 close $bdf
6037 return 0
6039 if {![string compare -length 11 "diff --git " $line]} {
6040 # trim off "diff --git "
6041 set line [string range $line 11 end]
6042 set diffinhdr 1
6043 # start of a new file
6044 $ctext insert end "\n"
6045 set curdiffstart [$ctext index "end - 1c"]
6046 $ctext insert end "\n" filesep
6047 # If the name hasn't changed the length will be odd,
6048 # the middle char will be a space, and the two bits either
6049 # side will be a/name and b/name, or "a/name" and "b/name".
6050 # If the name has changed we'll get "rename from" and
6051 # "rename to" or "copy from" and "copy to" lines following this,
6052 # and we'll use them to get the filenames.
6053 # This complexity is necessary because spaces in the filename(s)
6054 # don't get escaped.
6055 set l [string length $line]
6056 set i [expr {$l / 2}]
6057 if {!(($l & 1) && [string index $line $i] eq " " &&
6058 [string range $line 2 [expr {$i - 1}]] eq \
6059 [string range $line [expr {$i + 3}] end])} {
6060 continue
6062 # unescape if quoted and chop off the a/ from the front
6063 if {[string index $line 0] eq "\""} {
6064 set fname [string range [lindex $line 0] 2 end]
6065 } else {
6066 set fname [string range $line 2 [expr {$i - 1}]]
6068 makediffhdr $fname $ids
6070 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6071 $line match f1l f1c f2l f2c rest]} {
6072 $ctext insert end "$line\n" hunksep
6073 set diffinhdr 0
6075 } elseif {$diffinhdr} {
6076 if {![string compare -length 12 "rename from " $line]} {
6077 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6078 if {[string index $fname 0] eq "\""} {
6079 set fname [lindex $fname 0]
6081 set i [lsearch -exact $treediffs($ids) $fname]
6082 if {$i >= 0} {
6083 setinlist difffilestart $i $curdiffstart
6085 } elseif {![string compare -length 10 $line "rename to "] ||
6086 ![string compare -length 8 $line "copy to "]} {
6087 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6088 if {[string index $fname 0] eq "\""} {
6089 set fname [lindex $fname 0]
6091 makediffhdr $fname $ids
6092 } elseif {[string compare -length 3 $line "---"] == 0} {
6093 # do nothing
6094 continue
6095 } elseif {[string compare -length 3 $line "+++"] == 0} {
6096 set diffinhdr 0
6097 continue
6099 $ctext insert end "$line\n" filesep
6101 } else {
6102 set x [string range $line 0 0]
6103 if {$x == "-" || $x == "+"} {
6104 set tag [expr {$x == "+"}]
6105 $ctext insert end "$line\n" d$tag
6106 } elseif {$x == " "} {
6107 $ctext insert end "$line\n"
6108 } else {
6109 # "\ No newline at end of file",
6110 # or something else we don't recognize
6111 $ctext insert end "$line\n" hunksep
6115 $ctext conf -state disabled
6116 if {[eof $bdf]} {
6117 close $bdf
6118 return 0
6120 return [expr {$nr >= 1000? 2: 1}]
6123 proc changediffdisp {} {
6124 global ctext diffelide
6126 $ctext tag conf d0 -elide [lindex $diffelide 0]
6127 $ctext tag conf d1 -elide [lindex $diffelide 1]
6130 proc prevfile {} {
6131 global difffilestart ctext
6132 set prev [lindex $difffilestart 0]
6133 set here [$ctext index @0,0]
6134 foreach loc $difffilestart {
6135 if {[$ctext compare $loc >= $here]} {
6136 $ctext yview $prev
6137 return
6139 set prev $loc
6141 $ctext yview $prev
6144 proc nextfile {} {
6145 global difffilestart ctext
6146 set here [$ctext index @0,0]
6147 foreach loc $difffilestart {
6148 if {[$ctext compare $loc > $here]} {
6149 $ctext yview $loc
6150 return
6155 proc clear_ctext {{first 1.0}} {
6156 global ctext smarktop smarkbot
6157 global pendinglinks
6159 set l [lindex [split $first .] 0]
6160 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6161 set smarktop $l
6163 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6164 set smarkbot $l
6166 $ctext delete $first end
6167 if {$first eq "1.0"} {
6168 catch {unset pendinglinks}
6172 proc settabs {{firstab {}}} {
6173 global firsttabstop tabstop ctext have_tk85
6175 if {$firstab ne {} && $have_tk85} {
6176 set firsttabstop $firstab
6178 set w [font measure textfont "0"]
6179 if {$firsttabstop != 0} {
6180 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6181 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6182 } elseif {$have_tk85 || $tabstop != 8} {
6183 $ctext conf -tabs [expr {$tabstop * $w}]
6184 } else {
6185 $ctext conf -tabs {}
6189 proc incrsearch {name ix op} {
6190 global ctext searchstring searchdirn
6192 $ctext tag remove found 1.0 end
6193 if {[catch {$ctext index anchor}]} {
6194 # no anchor set, use start of selection, or of visible area
6195 set sel [$ctext tag ranges sel]
6196 if {$sel ne {}} {
6197 $ctext mark set anchor [lindex $sel 0]
6198 } elseif {$searchdirn eq "-forwards"} {
6199 $ctext mark set anchor @0,0
6200 } else {
6201 $ctext mark set anchor @0,[winfo height $ctext]
6204 if {$searchstring ne {}} {
6205 set here [$ctext search $searchdirn -- $searchstring anchor]
6206 if {$here ne {}} {
6207 $ctext see $here
6209 searchmarkvisible 1
6213 proc dosearch {} {
6214 global sstring ctext searchstring searchdirn
6216 focus $sstring
6217 $sstring icursor end
6218 set searchdirn -forwards
6219 if {$searchstring ne {}} {
6220 set sel [$ctext tag ranges sel]
6221 if {$sel ne {}} {
6222 set start "[lindex $sel 0] + 1c"
6223 } elseif {[catch {set start [$ctext index anchor]}]} {
6224 set start "@0,0"
6226 set match [$ctext search -count mlen -- $searchstring $start]
6227 $ctext tag remove sel 1.0 end
6228 if {$match eq {}} {
6229 bell
6230 return
6232 $ctext see $match
6233 set mend "$match + $mlen c"
6234 $ctext tag add sel $match $mend
6235 $ctext mark unset anchor
6239 proc dosearchback {} {
6240 global sstring ctext searchstring searchdirn
6242 focus $sstring
6243 $sstring icursor end
6244 set searchdirn -backwards
6245 if {$searchstring ne {}} {
6246 set sel [$ctext tag ranges sel]
6247 if {$sel ne {}} {
6248 set start [lindex $sel 0]
6249 } elseif {[catch {set start [$ctext index anchor]}]} {
6250 set start @0,[winfo height $ctext]
6252 set match [$ctext search -backwards -count ml -- $searchstring $start]
6253 $ctext tag remove sel 1.0 end
6254 if {$match eq {}} {
6255 bell
6256 return
6258 $ctext see $match
6259 set mend "$match + $ml c"
6260 $ctext tag add sel $match $mend
6261 $ctext mark unset anchor
6265 proc searchmark {first last} {
6266 global ctext searchstring
6268 set mend $first.0
6269 while {1} {
6270 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6271 if {$match eq {}} break
6272 set mend "$match + $mlen c"
6273 $ctext tag add found $match $mend
6277 proc searchmarkvisible {doall} {
6278 global ctext smarktop smarkbot
6280 set topline [lindex [split [$ctext index @0,0] .] 0]
6281 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6282 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6283 # no overlap with previous
6284 searchmark $topline $botline
6285 set smarktop $topline
6286 set smarkbot $botline
6287 } else {
6288 if {$topline < $smarktop} {
6289 searchmark $topline [expr {$smarktop-1}]
6290 set smarktop $topline
6292 if {$botline > $smarkbot} {
6293 searchmark [expr {$smarkbot+1}] $botline
6294 set smarkbot $botline
6299 proc scrolltext {f0 f1} {
6300 global searchstring
6302 .bleft.sb set $f0 $f1
6303 if {$searchstring ne {}} {
6304 searchmarkvisible 0
6308 proc setcoords {} {
6309 global linespc charspc canvx0 canvy0
6310 global xspc1 xspc2 lthickness
6312 set linespc [font metrics mainfont -linespace]
6313 set charspc [font measure mainfont "m"]
6314 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6315 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6316 set lthickness [expr {int($linespc / 9) + 1}]
6317 set xspc1(0) $linespc
6318 set xspc2 $linespc
6321 proc redisplay {} {
6322 global canv
6323 global selectedline
6325 set ymax [lindex [$canv cget -scrollregion] 3]
6326 if {$ymax eq {} || $ymax == 0} return
6327 set span [$canv yview]
6328 clear_display
6329 setcanvscroll
6330 allcanvs yview moveto [lindex $span 0]
6331 drawvisible
6332 if {[info exists selectedline]} {
6333 selectline $selectedline 0
6334 allcanvs yview moveto [lindex $span 0]
6338 proc parsefont {f n} {
6339 global fontattr
6341 set fontattr($f,family) [lindex $n 0]
6342 set s [lindex $n 1]
6343 if {$s eq {} || $s == 0} {
6344 set s 10
6345 } elseif {$s < 0} {
6346 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6348 set fontattr($f,size) $s
6349 set fontattr($f,weight) normal
6350 set fontattr($f,slant) roman
6351 foreach style [lrange $n 2 end] {
6352 switch -- $style {
6353 "normal" -
6354 "bold" {set fontattr($f,weight) $style}
6355 "roman" -
6356 "italic" {set fontattr($f,slant) $style}
6361 proc fontflags {f {isbold 0}} {
6362 global fontattr
6364 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6365 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6366 -slant $fontattr($f,slant)]
6369 proc fontname {f} {
6370 global fontattr
6372 set n [list $fontattr($f,family) $fontattr($f,size)]
6373 if {$fontattr($f,weight) eq "bold"} {
6374 lappend n "bold"
6376 if {$fontattr($f,slant) eq "italic"} {
6377 lappend n "italic"
6379 return $n
6382 proc incrfont {inc} {
6383 global mainfont textfont ctext canv cflist showrefstop
6384 global stopped entries fontattr
6386 unmarkmatches
6387 set s $fontattr(mainfont,size)
6388 incr s $inc
6389 if {$s < 1} {
6390 set s 1
6392 set fontattr(mainfont,size) $s
6393 font config mainfont -size $s
6394 font config mainfontbold -size $s
6395 set mainfont [fontname mainfont]
6396 set s $fontattr(textfont,size)
6397 incr s $inc
6398 if {$s < 1} {
6399 set s 1
6401 set fontattr(textfont,size) $s
6402 font config textfont -size $s
6403 font config textfontbold -size $s
6404 set textfont [fontname textfont]
6405 setcoords
6406 settabs
6407 redisplay
6410 proc clearsha1 {} {
6411 global sha1entry sha1string
6412 if {[string length $sha1string] == 40} {
6413 $sha1entry delete 0 end
6417 proc sha1change {n1 n2 op} {
6418 global sha1string currentid sha1but
6419 if {$sha1string == {}
6420 || ([info exists currentid] && $sha1string == $currentid)} {
6421 set state disabled
6422 } else {
6423 set state normal
6425 if {[$sha1but cget -state] == $state} return
6426 if {$state == "normal"} {
6427 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6428 } else {
6429 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6433 proc gotocommit {} {
6434 global sha1string tagids headids curview varcid
6436 if {$sha1string == {}
6437 || ([info exists currentid] && $sha1string == $currentid)} return
6438 if {[info exists tagids($sha1string)]} {
6439 set id $tagids($sha1string)
6440 } elseif {[info exists headids($sha1string)]} {
6441 set id $headids($sha1string)
6442 } else {
6443 set id [string tolower $sha1string]
6444 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6445 set matches [array names varcid "$curview,$id*"]
6446 if {$matches ne {}} {
6447 if {[llength $matches] > 1} {
6448 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6449 return
6451 set id [lindex [split [lindex $matches 0] ","] 1]
6455 if {[commitinview $id $curview]} {
6456 selectline [rowofcommit $id] 1
6457 return
6459 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6460 set msg [mc "SHA1 id %s is not known" $sha1string]
6461 } else {
6462 set msg [mc "Tag/Head %s is not known" $sha1string]
6464 error_popup $msg
6467 proc lineenter {x y id} {
6468 global hoverx hovery hoverid hovertimer
6469 global commitinfo canv
6471 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6472 set hoverx $x
6473 set hovery $y
6474 set hoverid $id
6475 if {[info exists hovertimer]} {
6476 after cancel $hovertimer
6478 set hovertimer [after 500 linehover]
6479 $canv delete hover
6482 proc linemotion {x y id} {
6483 global hoverx hovery hoverid hovertimer
6485 if {[info exists hoverid] && $id == $hoverid} {
6486 set hoverx $x
6487 set hovery $y
6488 if {[info exists hovertimer]} {
6489 after cancel $hovertimer
6491 set hovertimer [after 500 linehover]
6495 proc lineleave {id} {
6496 global hoverid hovertimer canv
6498 if {[info exists hoverid] && $id == $hoverid} {
6499 $canv delete hover
6500 if {[info exists hovertimer]} {
6501 after cancel $hovertimer
6502 unset hovertimer
6504 unset hoverid
6508 proc linehover {} {
6509 global hoverx hovery hoverid hovertimer
6510 global canv linespc lthickness
6511 global commitinfo
6513 set text [lindex $commitinfo($hoverid) 0]
6514 set ymax [lindex [$canv cget -scrollregion] 3]
6515 if {$ymax == {}} return
6516 set yfrac [lindex [$canv yview] 0]
6517 set x [expr {$hoverx + 2 * $linespc}]
6518 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6519 set x0 [expr {$x - 2 * $lthickness}]
6520 set y0 [expr {$y - 2 * $lthickness}]
6521 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6522 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6523 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6524 -fill \#ffff80 -outline black -width 1 -tags hover]
6525 $canv raise $t
6526 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6527 -font mainfont]
6528 $canv raise $t
6531 proc clickisonarrow {id y} {
6532 global lthickness
6534 set ranges [rowranges $id]
6535 set thresh [expr {2 * $lthickness + 6}]
6536 set n [expr {[llength $ranges] - 1}]
6537 for {set i 1} {$i < $n} {incr i} {
6538 set row [lindex $ranges $i]
6539 if {abs([yc $row] - $y) < $thresh} {
6540 return $i
6543 return {}
6546 proc arrowjump {id n y} {
6547 global canv
6549 # 1 <-> 2, 3 <-> 4, etc...
6550 set n [expr {(($n - 1) ^ 1) + 1}]
6551 set row [lindex [rowranges $id] $n]
6552 set yt [yc $row]
6553 set ymax [lindex [$canv cget -scrollregion] 3]
6554 if {$ymax eq {} || $ymax <= 0} return
6555 set view [$canv yview]
6556 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6557 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6558 if {$yfrac < 0} {
6559 set yfrac 0
6561 allcanvs yview moveto $yfrac
6564 proc lineclick {x y id isnew} {
6565 global ctext commitinfo children canv thickerline curview
6567 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6568 unmarkmatches
6569 unselectline
6570 normalline
6571 $canv delete hover
6572 # draw this line thicker than normal
6573 set thickerline $id
6574 drawlines $id
6575 if {$isnew} {
6576 set ymax [lindex [$canv cget -scrollregion] 3]
6577 if {$ymax eq {}} return
6578 set yfrac [lindex [$canv yview] 0]
6579 set y [expr {$y + $yfrac * $ymax}]
6581 set dirn [clickisonarrow $id $y]
6582 if {$dirn ne {}} {
6583 arrowjump $id $dirn $y
6584 return
6587 if {$isnew} {
6588 addtohistory [list lineclick $x $y $id 0]
6590 # fill the details pane with info about this line
6591 $ctext conf -state normal
6592 clear_ctext
6593 settabs 0
6594 $ctext insert end "[mc "Parent"]:\t"
6595 $ctext insert end $id link0
6596 setlink $id link0
6597 set info $commitinfo($id)
6598 $ctext insert end "\n\t[lindex $info 0]\n"
6599 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6600 set date [formatdate [lindex $info 2]]
6601 $ctext insert end "\t[mc "Date"]:\t$date\n"
6602 set kids $children($curview,$id)
6603 if {$kids ne {}} {
6604 $ctext insert end "\n[mc "Children"]:"
6605 set i 0
6606 foreach child $kids {
6607 incr i
6608 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6609 set info $commitinfo($child)
6610 $ctext insert end "\n\t"
6611 $ctext insert end $child link$i
6612 setlink $child link$i
6613 $ctext insert end "\n\t[lindex $info 0]"
6614 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6615 set date [formatdate [lindex $info 2]]
6616 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6619 $ctext conf -state disabled
6620 init_flist {}
6623 proc normalline {} {
6624 global thickerline
6625 if {[info exists thickerline]} {
6626 set id $thickerline
6627 unset thickerline
6628 drawlines $id
6632 proc selbyid {id} {
6633 global curview
6634 if {[commitinview $id $curview]} {
6635 selectline [rowofcommit $id] 1
6639 proc mstime {} {
6640 global startmstime
6641 if {![info exists startmstime]} {
6642 set startmstime [clock clicks -milliseconds]
6644 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6647 proc rowmenu {x y id} {
6648 global rowctxmenu selectedline rowmenuid curview
6649 global nullid nullid2 fakerowmenu mainhead
6651 stopfinding
6652 set rowmenuid $id
6653 if {![info exists selectedline]
6654 || [rowofcommit $id] eq $selectedline} {
6655 set state disabled
6656 } else {
6657 set state normal
6659 if {$id ne $nullid && $id ne $nullid2} {
6660 set menu $rowctxmenu
6661 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6662 } else {
6663 set menu $fakerowmenu
6665 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6666 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6667 $menu entryconfigure [mc "Make patch"] -state $state
6668 tk_popup $menu $x $y
6671 proc diffvssel {dirn} {
6672 global rowmenuid selectedline
6674 if {![info exists selectedline]} return
6675 if {$dirn} {
6676 set oldid [commitonrow $selectedline]
6677 set newid $rowmenuid
6678 } else {
6679 set oldid $rowmenuid
6680 set newid [commitonrow $selectedline]
6682 addtohistory [list doseldiff $oldid $newid]
6683 doseldiff $oldid $newid
6686 proc doseldiff {oldid newid} {
6687 global ctext
6688 global commitinfo
6690 $ctext conf -state normal
6691 clear_ctext
6692 init_flist [mc "Top"]
6693 $ctext insert end "[mc "From"] "
6694 $ctext insert end $oldid link0
6695 setlink $oldid link0
6696 $ctext insert end "\n "
6697 $ctext insert end [lindex $commitinfo($oldid) 0]
6698 $ctext insert end "\n\n[mc "To"] "
6699 $ctext insert end $newid link1
6700 setlink $newid link1
6701 $ctext insert end "\n "
6702 $ctext insert end [lindex $commitinfo($newid) 0]
6703 $ctext insert end "\n"
6704 $ctext conf -state disabled
6705 $ctext tag remove found 1.0 end
6706 startdiff [list $oldid $newid]
6709 proc mkpatch {} {
6710 global rowmenuid currentid commitinfo patchtop patchnum
6712 if {![info exists currentid]} return
6713 set oldid $currentid
6714 set oldhead [lindex $commitinfo($oldid) 0]
6715 set newid $rowmenuid
6716 set newhead [lindex $commitinfo($newid) 0]
6717 set top .patch
6718 set patchtop $top
6719 catch {destroy $top}
6720 toplevel $top
6721 label $top.title -text [mc "Generate patch"]
6722 grid $top.title - -pady 10
6723 label $top.from -text [mc "From:"]
6724 entry $top.fromsha1 -width 40 -relief flat
6725 $top.fromsha1 insert 0 $oldid
6726 $top.fromsha1 conf -state readonly
6727 grid $top.from $top.fromsha1 -sticky w
6728 entry $top.fromhead -width 60 -relief flat
6729 $top.fromhead insert 0 $oldhead
6730 $top.fromhead conf -state readonly
6731 grid x $top.fromhead -sticky w
6732 label $top.to -text [mc "To:"]
6733 entry $top.tosha1 -width 40 -relief flat
6734 $top.tosha1 insert 0 $newid
6735 $top.tosha1 conf -state readonly
6736 grid $top.to $top.tosha1 -sticky w
6737 entry $top.tohead -width 60 -relief flat
6738 $top.tohead insert 0 $newhead
6739 $top.tohead conf -state readonly
6740 grid x $top.tohead -sticky w
6741 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6742 grid $top.rev x -pady 10
6743 label $top.flab -text [mc "Output file:"]
6744 entry $top.fname -width 60
6745 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6746 incr patchnum
6747 grid $top.flab $top.fname -sticky w
6748 frame $top.buts
6749 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6750 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6751 grid $top.buts.gen $top.buts.can
6752 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6753 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6754 grid $top.buts - -pady 10 -sticky ew
6755 focus $top.fname
6758 proc mkpatchrev {} {
6759 global patchtop
6761 set oldid [$patchtop.fromsha1 get]
6762 set oldhead [$patchtop.fromhead get]
6763 set newid [$patchtop.tosha1 get]
6764 set newhead [$patchtop.tohead get]
6765 foreach e [list fromsha1 fromhead tosha1 tohead] \
6766 v [list $newid $newhead $oldid $oldhead] {
6767 $patchtop.$e conf -state normal
6768 $patchtop.$e delete 0 end
6769 $patchtop.$e insert 0 $v
6770 $patchtop.$e conf -state readonly
6774 proc mkpatchgo {} {
6775 global patchtop nullid nullid2
6777 set oldid [$patchtop.fromsha1 get]
6778 set newid [$patchtop.tosha1 get]
6779 set fname [$patchtop.fname get]
6780 set cmd [diffcmd [list $oldid $newid] -p]
6781 # trim off the initial "|"
6782 set cmd [lrange $cmd 1 end]
6783 lappend cmd >$fname &
6784 if {[catch {eval exec $cmd} err]} {
6785 error_popup "[mc "Error creating patch:"] $err"
6787 catch {destroy $patchtop}
6788 unset patchtop
6791 proc mkpatchcan {} {
6792 global patchtop
6794 catch {destroy $patchtop}
6795 unset patchtop
6798 proc mktag {} {
6799 global rowmenuid mktagtop commitinfo
6801 set top .maketag
6802 set mktagtop $top
6803 catch {destroy $top}
6804 toplevel $top
6805 label $top.title -text [mc "Create tag"]
6806 grid $top.title - -pady 10
6807 label $top.id -text [mc "ID:"]
6808 entry $top.sha1 -width 40 -relief flat
6809 $top.sha1 insert 0 $rowmenuid
6810 $top.sha1 conf -state readonly
6811 grid $top.id $top.sha1 -sticky w
6812 entry $top.head -width 60 -relief flat
6813 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6814 $top.head conf -state readonly
6815 grid x $top.head -sticky w
6816 label $top.tlab -text [mc "Tag name:"]
6817 entry $top.tag -width 60
6818 grid $top.tlab $top.tag -sticky w
6819 frame $top.buts
6820 button $top.buts.gen -text [mc "Create"] -command mktaggo
6821 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6822 grid $top.buts.gen $top.buts.can
6823 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6824 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6825 grid $top.buts - -pady 10 -sticky ew
6826 focus $top.tag
6829 proc domktag {} {
6830 global mktagtop env tagids idtags
6832 set id [$mktagtop.sha1 get]
6833 set tag [$mktagtop.tag get]
6834 if {$tag == {}} {
6835 error_popup [mc "No tag name specified"]
6836 return
6838 if {[info exists tagids($tag)]} {
6839 error_popup [mc "Tag \"%s\" already exists" $tag]
6840 return
6842 if {[catch {
6843 set dir [gitdir]
6844 set fname [file join $dir "refs/tags" $tag]
6845 set f [open $fname w]
6846 puts $f $id
6847 close $f
6848 } err]} {
6849 error_popup "[mc "Error creating tag:"] $err"
6850 return
6853 set tagids($tag) $id
6854 lappend idtags($id) $tag
6855 redrawtags $id
6856 addedtag $id
6857 dispneartags 0
6858 run refill_reflist
6861 proc redrawtags {id} {
6862 global canv linehtag idpos currentid curview
6863 global canvxmax iddrawn
6865 if {![commitinview $id $curview]} return
6866 if {![info exists iddrawn($id)]} return
6867 set row [rowofcommit $id]
6868 $canv delete tag.$id
6869 set xt [eval drawtags $id $idpos($id)]
6870 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6871 set text [$canv itemcget $linehtag($row) -text]
6872 set font [$canv itemcget $linehtag($row) -font]
6873 set xr [expr {$xt + [font measure $font $text]}]
6874 if {$xr > $canvxmax} {
6875 set canvxmax $xr
6876 setcanvscroll
6878 if {[info exists currentid] && $currentid == $id} {
6879 make_secsel $row
6883 proc mktagcan {} {
6884 global mktagtop
6886 catch {destroy $mktagtop}
6887 unset mktagtop
6890 proc mktaggo {} {
6891 domktag
6892 mktagcan
6895 proc writecommit {} {
6896 global rowmenuid wrcomtop commitinfo wrcomcmd
6898 set top .writecommit
6899 set wrcomtop $top
6900 catch {destroy $top}
6901 toplevel $top
6902 label $top.title -text [mc "Write commit to file"]
6903 grid $top.title - -pady 10
6904 label $top.id -text [mc "ID:"]
6905 entry $top.sha1 -width 40 -relief flat
6906 $top.sha1 insert 0 $rowmenuid
6907 $top.sha1 conf -state readonly
6908 grid $top.id $top.sha1 -sticky w
6909 entry $top.head -width 60 -relief flat
6910 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6911 $top.head conf -state readonly
6912 grid x $top.head -sticky w
6913 label $top.clab -text [mc "Command:"]
6914 entry $top.cmd -width 60 -textvariable wrcomcmd
6915 grid $top.clab $top.cmd -sticky w -pady 10
6916 label $top.flab -text [mc "Output file:"]
6917 entry $top.fname -width 60
6918 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6919 grid $top.flab $top.fname -sticky w
6920 frame $top.buts
6921 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6922 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6923 grid $top.buts.gen $top.buts.can
6924 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6925 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6926 grid $top.buts - -pady 10 -sticky ew
6927 focus $top.fname
6930 proc wrcomgo {} {
6931 global wrcomtop
6933 set id [$wrcomtop.sha1 get]
6934 set cmd "echo $id | [$wrcomtop.cmd get]"
6935 set fname [$wrcomtop.fname get]
6936 if {[catch {exec sh -c $cmd >$fname &} err]} {
6937 error_popup "[mc "Error writing commit:"] $err"
6939 catch {destroy $wrcomtop}
6940 unset wrcomtop
6943 proc wrcomcan {} {
6944 global wrcomtop
6946 catch {destroy $wrcomtop}
6947 unset wrcomtop
6950 proc mkbranch {} {
6951 global rowmenuid mkbrtop
6953 set top .makebranch
6954 catch {destroy $top}
6955 toplevel $top
6956 label $top.title -text [mc "Create new branch"]
6957 grid $top.title - -pady 10
6958 label $top.id -text [mc "ID:"]
6959 entry $top.sha1 -width 40 -relief flat
6960 $top.sha1 insert 0 $rowmenuid
6961 $top.sha1 conf -state readonly
6962 grid $top.id $top.sha1 -sticky w
6963 label $top.nlab -text [mc "Name:"]
6964 entry $top.name -width 40
6965 grid $top.nlab $top.name -sticky w
6966 frame $top.buts
6967 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6968 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6969 grid $top.buts.go $top.buts.can
6970 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6971 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6972 grid $top.buts - -pady 10 -sticky ew
6973 focus $top.name
6976 proc mkbrgo {top} {
6977 global headids idheads
6979 set name [$top.name get]
6980 set id [$top.sha1 get]
6981 if {$name eq {}} {
6982 error_popup [mc "Please specify a name for the new branch"]
6983 return
6985 catch {destroy $top}
6986 nowbusy newbranch
6987 update
6988 if {[catch {
6989 exec git branch $name $id
6990 } err]} {
6991 notbusy newbranch
6992 error_popup $err
6993 } else {
6994 set headids($name) $id
6995 lappend idheads($id) $name
6996 addedhead $id $name
6997 notbusy newbranch
6998 redrawtags $id
6999 dispneartags 0
7000 run refill_reflist
7004 proc cherrypick {} {
7005 global rowmenuid curview
7006 global mainhead
7008 set oldhead [exec git rev-parse HEAD]
7009 set dheads [descheads $rowmenuid]
7010 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7011 set ok [confirm_popup [mc "Commit %s is already\
7012 included in branch %s -- really re-apply it?" \
7013 [string range $rowmenuid 0 7] $mainhead]]
7014 if {!$ok} return
7016 nowbusy cherrypick [mc "Cherry-picking"]
7017 update
7018 # Unfortunately git-cherry-pick writes stuff to stderr even when
7019 # no error occurs, and exec takes that as an indication of error...
7020 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7021 notbusy cherrypick
7022 error_popup $err
7023 return
7025 set newhead [exec git rev-parse HEAD]
7026 if {$newhead eq $oldhead} {
7027 notbusy cherrypick
7028 error_popup [mc "No changes committed"]
7029 return
7031 addnewchild $newhead $oldhead
7032 if {[commitinview $oldhead $curview]} {
7033 insertrow $newhead $oldhead $curview
7034 if {$mainhead ne {}} {
7035 movehead $newhead $mainhead
7036 movedhead $newhead $mainhead
7038 redrawtags $oldhead
7039 redrawtags $newhead
7041 notbusy cherrypick
7044 proc resethead {} {
7045 global mainheadid mainhead rowmenuid confirm_ok resettype
7047 set confirm_ok 0
7048 set w ".confirmreset"
7049 toplevel $w
7050 wm transient $w .
7051 wm title $w [mc "Confirm reset"]
7052 message $w.m -text \
7053 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7054 -justify center -aspect 1000
7055 pack $w.m -side top -fill x -padx 20 -pady 20
7056 frame $w.f -relief sunken -border 2
7057 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7058 grid $w.f.rt -sticky w
7059 set resettype mixed
7060 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7061 -text [mc "Soft: Leave working tree and index untouched"]
7062 grid $w.f.soft -sticky w
7063 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7064 -text [mc "Mixed: Leave working tree untouched, reset index"]
7065 grid $w.f.mixed -sticky w
7066 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7067 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7068 grid $w.f.hard -sticky w
7069 pack $w.f -side top -fill x
7070 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7071 pack $w.ok -side left -fill x -padx 20 -pady 20
7072 button $w.cancel -text [mc Cancel] -command "destroy $w"
7073 pack $w.cancel -side right -fill x -padx 20 -pady 20
7074 bind $w <Visibility> "grab $w; focus $w"
7075 tkwait window $w
7076 if {!$confirm_ok} return
7077 if {[catch {set fd [open \
7078 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7079 error_popup $err
7080 } else {
7081 dohidelocalchanges
7082 filerun $fd [list readresetstat $fd]
7083 nowbusy reset [mc "Resetting"]
7087 proc readresetstat {fd} {
7088 global mainhead mainheadid showlocalchanges rprogcoord
7090 if {[gets $fd line] >= 0} {
7091 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7092 set rprogcoord [expr {1.0 * $m / $n}]
7093 adjustprogress
7095 return 1
7097 set rprogcoord 0
7098 adjustprogress
7099 notbusy reset
7100 if {[catch {close $fd} err]} {
7101 error_popup $err
7103 set oldhead $mainheadid
7104 set newhead [exec git rev-parse HEAD]
7105 if {$newhead ne $oldhead} {
7106 movehead $newhead $mainhead
7107 movedhead $newhead $mainhead
7108 set mainheadid $newhead
7109 redrawtags $oldhead
7110 redrawtags $newhead
7112 if {$showlocalchanges} {
7113 doshowlocalchanges
7115 return 0
7118 # context menu for a head
7119 proc headmenu {x y id head} {
7120 global headmenuid headmenuhead headctxmenu mainhead
7122 stopfinding
7123 set headmenuid $id
7124 set headmenuhead $head
7125 set state normal
7126 if {$head eq $mainhead} {
7127 set state disabled
7129 $headctxmenu entryconfigure 0 -state $state
7130 $headctxmenu entryconfigure 1 -state $state
7131 tk_popup $headctxmenu $x $y
7134 proc cobranch {} {
7135 global headmenuid headmenuhead mainhead headids
7136 global showlocalchanges mainheadid
7138 # check the tree is clean first??
7139 set oldmainhead $mainhead
7140 nowbusy checkout [mc "Checking out"]
7141 update
7142 dohidelocalchanges
7143 if {[catch {
7144 exec git checkout -q $headmenuhead
7145 } err]} {
7146 notbusy checkout
7147 error_popup $err
7148 } else {
7149 notbusy checkout
7150 set mainhead $headmenuhead
7151 set mainheadid $headmenuid
7152 if {[info exists headids($oldmainhead)]} {
7153 redrawtags $headids($oldmainhead)
7155 redrawtags $headmenuid
7157 if {$showlocalchanges} {
7158 dodiffindex
7162 proc rmbranch {} {
7163 global headmenuid headmenuhead mainhead
7164 global idheads
7166 set head $headmenuhead
7167 set id $headmenuid
7168 # this check shouldn't be needed any more...
7169 if {$head eq $mainhead} {
7170 error_popup [mc "Cannot delete the currently checked-out branch"]
7171 return
7173 set dheads [descheads $id]
7174 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7175 # the stuff on this branch isn't on any other branch
7176 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7177 branch.\nReally delete branch %s?" $head $head]]} return
7179 nowbusy rmbranch
7180 update
7181 if {[catch {exec git branch -D $head} err]} {
7182 notbusy rmbranch
7183 error_popup $err
7184 return
7186 removehead $id $head
7187 removedhead $id $head
7188 redrawtags $id
7189 notbusy rmbranch
7190 dispneartags 0
7191 run refill_reflist
7194 # Display a list of tags and heads
7195 proc showrefs {} {
7196 global showrefstop bgcolor fgcolor selectbgcolor
7197 global bglist fglist reflistfilter reflist maincursor
7199 set top .showrefs
7200 set showrefstop $top
7201 if {[winfo exists $top]} {
7202 raise $top
7203 refill_reflist
7204 return
7206 toplevel $top
7207 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7208 text $top.list -background $bgcolor -foreground $fgcolor \
7209 -selectbackground $selectbgcolor -font mainfont \
7210 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7211 -width 30 -height 20 -cursor $maincursor \
7212 -spacing1 1 -spacing3 1 -state disabled
7213 $top.list tag configure highlight -background $selectbgcolor
7214 lappend bglist $top.list
7215 lappend fglist $top.list
7216 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7217 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7218 grid $top.list $top.ysb -sticky nsew
7219 grid $top.xsb x -sticky ew
7220 frame $top.f
7221 label $top.f.l -text "[mc "Filter"]: "
7222 entry $top.f.e -width 20 -textvariable reflistfilter
7223 set reflistfilter "*"
7224 trace add variable reflistfilter write reflistfilter_change
7225 pack $top.f.e -side right -fill x -expand 1
7226 pack $top.f.l -side left
7227 grid $top.f - -sticky ew -pady 2
7228 button $top.close -command [list destroy $top] -text [mc "Close"]
7229 grid $top.close -
7230 grid columnconfigure $top 0 -weight 1
7231 grid rowconfigure $top 0 -weight 1
7232 bind $top.list <1> {break}
7233 bind $top.list <B1-Motion> {break}
7234 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7235 set reflist {}
7236 refill_reflist
7239 proc sel_reflist {w x y} {
7240 global showrefstop reflist headids tagids otherrefids
7242 if {![winfo exists $showrefstop]} return
7243 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7244 set ref [lindex $reflist [expr {$l-1}]]
7245 set n [lindex $ref 0]
7246 switch -- [lindex $ref 1] {
7247 "H" {selbyid $headids($n)}
7248 "T" {selbyid $tagids($n)}
7249 "o" {selbyid $otherrefids($n)}
7251 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7254 proc unsel_reflist {} {
7255 global showrefstop
7257 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7258 $showrefstop.list tag remove highlight 0.0 end
7261 proc reflistfilter_change {n1 n2 op} {
7262 global reflistfilter
7264 after cancel refill_reflist
7265 after 200 refill_reflist
7268 proc refill_reflist {} {
7269 global reflist reflistfilter showrefstop headids tagids otherrefids
7270 global curview commitinterest
7272 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7273 set refs {}
7274 foreach n [array names headids] {
7275 if {[string match $reflistfilter $n]} {
7276 if {[commitinview $headids($n) $curview]} {
7277 lappend refs [list $n H]
7278 } else {
7279 set commitinterest($headids($n)) {run refill_reflist}
7283 foreach n [array names tagids] {
7284 if {[string match $reflistfilter $n]} {
7285 if {[commitinview $tagids($n) $curview]} {
7286 lappend refs [list $n T]
7287 } else {
7288 set commitinterest($tagids($n)) {run refill_reflist}
7292 foreach n [array names otherrefids] {
7293 if {[string match $reflistfilter $n]} {
7294 if {[commitinview $otherrefids($n) $curview]} {
7295 lappend refs [list $n o]
7296 } else {
7297 set commitinterest($otherrefids($n)) {run refill_reflist}
7301 set refs [lsort -index 0 $refs]
7302 if {$refs eq $reflist} return
7304 # Update the contents of $showrefstop.list according to the
7305 # differences between $reflist (old) and $refs (new)
7306 $showrefstop.list conf -state normal
7307 $showrefstop.list insert end "\n"
7308 set i 0
7309 set j 0
7310 while {$i < [llength $reflist] || $j < [llength $refs]} {
7311 if {$i < [llength $reflist]} {
7312 if {$j < [llength $refs]} {
7313 set cmp [string compare [lindex $reflist $i 0] \
7314 [lindex $refs $j 0]]
7315 if {$cmp == 0} {
7316 set cmp [string compare [lindex $reflist $i 1] \
7317 [lindex $refs $j 1]]
7319 } else {
7320 set cmp -1
7322 } else {
7323 set cmp 1
7325 switch -- $cmp {
7326 -1 {
7327 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7328 incr i
7331 incr i
7332 incr j
7335 set l [expr {$j + 1}]
7336 $showrefstop.list image create $l.0 -align baseline \
7337 -image reficon-[lindex $refs $j 1] -padx 2
7338 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7339 incr j
7343 set reflist $refs
7344 # delete last newline
7345 $showrefstop.list delete end-2c end-1c
7346 $showrefstop.list conf -state disabled
7349 # Stuff for finding nearby tags
7350 proc getallcommits {} {
7351 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7352 global idheads idtags idotherrefs allparents tagobjid
7354 if {![info exists allcommits]} {
7355 set nextarc 0
7356 set allcommits 0
7357 set seeds {}
7358 set allcwait 0
7359 set cachedarcs 0
7360 set allccache [file join [gitdir] "gitk.cache"]
7361 if {![catch {
7362 set f [open $allccache r]
7363 set allcwait 1
7364 getcache $f
7365 }]} return
7368 if {$allcwait} {
7369 return
7371 set cmd [list | git rev-list --parents]
7372 set allcupdate [expr {$seeds ne {}}]
7373 if {!$allcupdate} {
7374 set ids "--all"
7375 } else {
7376 set refs [concat [array names idheads] [array names idtags] \
7377 [array names idotherrefs]]
7378 set ids {}
7379 set tagobjs {}
7380 foreach name [array names tagobjid] {
7381 lappend tagobjs $tagobjid($name)
7383 foreach id [lsort -unique $refs] {
7384 if {![info exists allparents($id)] &&
7385 [lsearch -exact $tagobjs $id] < 0} {
7386 lappend ids $id
7389 if {$ids ne {}} {
7390 foreach id $seeds {
7391 lappend ids "^$id"
7395 if {$ids ne {}} {
7396 set fd [open [concat $cmd $ids] r]
7397 fconfigure $fd -blocking 0
7398 incr allcommits
7399 nowbusy allcommits
7400 filerun $fd [list getallclines $fd]
7401 } else {
7402 dispneartags 0
7406 # Since most commits have 1 parent and 1 child, we group strings of
7407 # such commits into "arcs" joining branch/merge points (BMPs), which
7408 # are commits that either don't have 1 parent or don't have 1 child.
7410 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7411 # arcout(id) - outgoing arcs for BMP
7412 # arcids(a) - list of IDs on arc including end but not start
7413 # arcstart(a) - BMP ID at start of arc
7414 # arcend(a) - BMP ID at end of arc
7415 # growing(a) - arc a is still growing
7416 # arctags(a) - IDs out of arcids (excluding end) that have tags
7417 # archeads(a) - IDs out of arcids (excluding end) that have heads
7418 # The start of an arc is at the descendent end, so "incoming" means
7419 # coming from descendents, and "outgoing" means going towards ancestors.
7421 proc getallclines {fd} {
7422 global allparents allchildren idtags idheads nextarc
7423 global arcnos arcids arctags arcout arcend arcstart archeads growing
7424 global seeds allcommits cachedarcs allcupdate
7426 set nid 0
7427 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7428 set id [lindex $line 0]
7429 if {[info exists allparents($id)]} {
7430 # seen it already
7431 continue
7433 set cachedarcs 0
7434 set olds [lrange $line 1 end]
7435 set allparents($id) $olds
7436 if {![info exists allchildren($id)]} {
7437 set allchildren($id) {}
7438 set arcnos($id) {}
7439 lappend seeds $id
7440 } else {
7441 set a $arcnos($id)
7442 if {[llength $olds] == 1 && [llength $a] == 1} {
7443 lappend arcids($a) $id
7444 if {[info exists idtags($id)]} {
7445 lappend arctags($a) $id
7447 if {[info exists idheads($id)]} {
7448 lappend archeads($a) $id
7450 if {[info exists allparents($olds)]} {
7451 # seen parent already
7452 if {![info exists arcout($olds)]} {
7453 splitarc $olds
7455 lappend arcids($a) $olds
7456 set arcend($a) $olds
7457 unset growing($a)
7459 lappend allchildren($olds) $id
7460 lappend arcnos($olds) $a
7461 continue
7464 foreach a $arcnos($id) {
7465 lappend arcids($a) $id
7466 set arcend($a) $id
7467 unset growing($a)
7470 set ao {}
7471 foreach p $olds {
7472 lappend allchildren($p) $id
7473 set a [incr nextarc]
7474 set arcstart($a) $id
7475 set archeads($a) {}
7476 set arctags($a) {}
7477 set archeads($a) {}
7478 set arcids($a) {}
7479 lappend ao $a
7480 set growing($a) 1
7481 if {[info exists allparents($p)]} {
7482 # seen it already, may need to make a new branch
7483 if {![info exists arcout($p)]} {
7484 splitarc $p
7486 lappend arcids($a) $p
7487 set arcend($a) $p
7488 unset growing($a)
7490 lappend arcnos($p) $a
7492 set arcout($id) $ao
7494 if {$nid > 0} {
7495 global cached_dheads cached_dtags cached_atags
7496 catch {unset cached_dheads}
7497 catch {unset cached_dtags}
7498 catch {unset cached_atags}
7500 if {![eof $fd]} {
7501 return [expr {$nid >= 1000? 2: 1}]
7503 set cacheok 1
7504 if {[catch {
7505 fconfigure $fd -blocking 1
7506 close $fd
7507 } err]} {
7508 # got an error reading the list of commits
7509 # if we were updating, try rereading the whole thing again
7510 if {$allcupdate} {
7511 incr allcommits -1
7512 dropcache $err
7513 return
7515 error_popup "[mc "Error reading commit topology information;\
7516 branch and preceding/following tag information\
7517 will be incomplete."]\n($err)"
7518 set cacheok 0
7520 if {[incr allcommits -1] == 0} {
7521 notbusy allcommits
7522 if {$cacheok} {
7523 run savecache
7526 dispneartags 0
7527 return 0
7530 proc recalcarc {a} {
7531 global arctags archeads arcids idtags idheads
7533 set at {}
7534 set ah {}
7535 foreach id [lrange $arcids($a) 0 end-1] {
7536 if {[info exists idtags($id)]} {
7537 lappend at $id
7539 if {[info exists idheads($id)]} {
7540 lappend ah $id
7543 set arctags($a) $at
7544 set archeads($a) $ah
7547 proc splitarc {p} {
7548 global arcnos arcids nextarc arctags archeads idtags idheads
7549 global arcstart arcend arcout allparents growing
7551 set a $arcnos($p)
7552 if {[llength $a] != 1} {
7553 puts "oops splitarc called but [llength $a] arcs already"
7554 return
7556 set a [lindex $a 0]
7557 set i [lsearch -exact $arcids($a) $p]
7558 if {$i < 0} {
7559 puts "oops splitarc $p not in arc $a"
7560 return
7562 set na [incr nextarc]
7563 if {[info exists arcend($a)]} {
7564 set arcend($na) $arcend($a)
7565 } else {
7566 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7567 set j [lsearch -exact $arcnos($l) $a]
7568 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7570 set tail [lrange $arcids($a) [expr {$i+1}] end]
7571 set arcids($a) [lrange $arcids($a) 0 $i]
7572 set arcend($a) $p
7573 set arcstart($na) $p
7574 set arcout($p) $na
7575 set arcids($na) $tail
7576 if {[info exists growing($a)]} {
7577 set growing($na) 1
7578 unset growing($a)
7581 foreach id $tail {
7582 if {[llength $arcnos($id)] == 1} {
7583 set arcnos($id) $na
7584 } else {
7585 set j [lsearch -exact $arcnos($id) $a]
7586 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7590 # reconstruct tags and heads lists
7591 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7592 recalcarc $a
7593 recalcarc $na
7594 } else {
7595 set arctags($na) {}
7596 set archeads($na) {}
7600 # Update things for a new commit added that is a child of one
7601 # existing commit. Used when cherry-picking.
7602 proc addnewchild {id p} {
7603 global allparents allchildren idtags nextarc
7604 global arcnos arcids arctags arcout arcend arcstart archeads growing
7605 global seeds allcommits
7607 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7608 set allparents($id) [list $p]
7609 set allchildren($id) {}
7610 set arcnos($id) {}
7611 lappend seeds $id
7612 lappend allchildren($p) $id
7613 set a [incr nextarc]
7614 set arcstart($a) $id
7615 set archeads($a) {}
7616 set arctags($a) {}
7617 set arcids($a) [list $p]
7618 set arcend($a) $p
7619 if {![info exists arcout($p)]} {
7620 splitarc $p
7622 lappend arcnos($p) $a
7623 set arcout($id) [list $a]
7626 # This implements a cache for the topology information.
7627 # The cache saves, for each arc, the start and end of the arc,
7628 # the ids on the arc, and the outgoing arcs from the end.
7629 proc readcache {f} {
7630 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7631 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7632 global allcwait
7634 set a $nextarc
7635 set lim $cachedarcs
7636 if {$lim - $a > 500} {
7637 set lim [expr {$a + 500}]
7639 if {[catch {
7640 if {$a == $lim} {
7641 # finish reading the cache and setting up arctags, etc.
7642 set line [gets $f]
7643 if {$line ne "1"} {error "bad final version"}
7644 close $f
7645 foreach id [array names idtags] {
7646 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7647 [llength $allparents($id)] == 1} {
7648 set a [lindex $arcnos($id) 0]
7649 if {$arctags($a) eq {}} {
7650 recalcarc $a
7654 foreach id [array names idheads] {
7655 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7656 [llength $allparents($id)] == 1} {
7657 set a [lindex $arcnos($id) 0]
7658 if {$archeads($a) eq {}} {
7659 recalcarc $a
7663 foreach id [lsort -unique $possible_seeds] {
7664 if {$arcnos($id) eq {}} {
7665 lappend seeds $id
7668 set allcwait 0
7669 } else {
7670 while {[incr a] <= $lim} {
7671 set line [gets $f]
7672 if {[llength $line] != 3} {error "bad line"}
7673 set s [lindex $line 0]
7674 set arcstart($a) $s
7675 lappend arcout($s) $a
7676 if {![info exists arcnos($s)]} {
7677 lappend possible_seeds $s
7678 set arcnos($s) {}
7680 set e [lindex $line 1]
7681 if {$e eq {}} {
7682 set growing($a) 1
7683 } else {
7684 set arcend($a) $e
7685 if {![info exists arcout($e)]} {
7686 set arcout($e) {}
7689 set arcids($a) [lindex $line 2]
7690 foreach id $arcids($a) {
7691 lappend allparents($s) $id
7692 set s $id
7693 lappend arcnos($id) $a
7695 if {![info exists allparents($s)]} {
7696 set allparents($s) {}
7698 set arctags($a) {}
7699 set archeads($a) {}
7701 set nextarc [expr {$a - 1}]
7703 } err]} {
7704 dropcache $err
7705 return 0
7707 if {!$allcwait} {
7708 getallcommits
7710 return $allcwait
7713 proc getcache {f} {
7714 global nextarc cachedarcs possible_seeds
7716 if {[catch {
7717 set line [gets $f]
7718 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7719 # make sure it's an integer
7720 set cachedarcs [expr {int([lindex $line 1])}]
7721 if {$cachedarcs < 0} {error "bad number of arcs"}
7722 set nextarc 0
7723 set possible_seeds {}
7724 run readcache $f
7725 } err]} {
7726 dropcache $err
7728 return 0
7731 proc dropcache {err} {
7732 global allcwait nextarc cachedarcs seeds
7734 #puts "dropping cache ($err)"
7735 foreach v {arcnos arcout arcids arcstart arcend growing \
7736 arctags archeads allparents allchildren} {
7737 global $v
7738 catch {unset $v}
7740 set allcwait 0
7741 set nextarc 0
7742 set cachedarcs 0
7743 set seeds {}
7744 getallcommits
7747 proc writecache {f} {
7748 global cachearc cachedarcs allccache
7749 global arcstart arcend arcnos arcids arcout
7751 set a $cachearc
7752 set lim $cachedarcs
7753 if {$lim - $a > 1000} {
7754 set lim [expr {$a + 1000}]
7756 if {[catch {
7757 while {[incr a] <= $lim} {
7758 if {[info exists arcend($a)]} {
7759 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7760 } else {
7761 puts $f [list $arcstart($a) {} $arcids($a)]
7764 } err]} {
7765 catch {close $f}
7766 catch {file delete $allccache}
7767 #puts "writing cache failed ($err)"
7768 return 0
7770 set cachearc [expr {$a - 1}]
7771 if {$a > $cachedarcs} {
7772 puts $f "1"
7773 close $f
7774 return 0
7776 return 1
7779 proc savecache {} {
7780 global nextarc cachedarcs cachearc allccache
7782 if {$nextarc == $cachedarcs} return
7783 set cachearc 0
7784 set cachedarcs $nextarc
7785 catch {
7786 set f [open $allccache w]
7787 puts $f [list 1 $cachedarcs]
7788 run writecache $f
7792 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7793 # or 0 if neither is true.
7794 proc anc_or_desc {a b} {
7795 global arcout arcstart arcend arcnos cached_isanc
7797 if {$arcnos($a) eq $arcnos($b)} {
7798 # Both are on the same arc(s); either both are the same BMP,
7799 # or if one is not a BMP, the other is also not a BMP or is
7800 # the BMP at end of the arc (and it only has 1 incoming arc).
7801 # Or both can be BMPs with no incoming arcs.
7802 if {$a eq $b || $arcnos($a) eq {}} {
7803 return 0
7805 # assert {[llength $arcnos($a)] == 1}
7806 set arc [lindex $arcnos($a) 0]
7807 set i [lsearch -exact $arcids($arc) $a]
7808 set j [lsearch -exact $arcids($arc) $b]
7809 if {$i < 0 || $i > $j} {
7810 return 1
7811 } else {
7812 return -1
7816 if {![info exists arcout($a)]} {
7817 set arc [lindex $arcnos($a) 0]
7818 if {[info exists arcend($arc)]} {
7819 set aend $arcend($arc)
7820 } else {
7821 set aend {}
7823 set a $arcstart($arc)
7824 } else {
7825 set aend $a
7827 if {![info exists arcout($b)]} {
7828 set arc [lindex $arcnos($b) 0]
7829 if {[info exists arcend($arc)]} {
7830 set bend $arcend($arc)
7831 } else {
7832 set bend {}
7834 set b $arcstart($arc)
7835 } else {
7836 set bend $b
7838 if {$a eq $bend} {
7839 return 1
7841 if {$b eq $aend} {
7842 return -1
7844 if {[info exists cached_isanc($a,$bend)]} {
7845 if {$cached_isanc($a,$bend)} {
7846 return 1
7849 if {[info exists cached_isanc($b,$aend)]} {
7850 if {$cached_isanc($b,$aend)} {
7851 return -1
7853 if {[info exists cached_isanc($a,$bend)]} {
7854 return 0
7858 set todo [list $a $b]
7859 set anc($a) a
7860 set anc($b) b
7861 for {set i 0} {$i < [llength $todo]} {incr i} {
7862 set x [lindex $todo $i]
7863 if {$anc($x) eq {}} {
7864 continue
7866 foreach arc $arcnos($x) {
7867 set xd $arcstart($arc)
7868 if {$xd eq $bend} {
7869 set cached_isanc($a,$bend) 1
7870 set cached_isanc($b,$aend) 0
7871 return 1
7872 } elseif {$xd eq $aend} {
7873 set cached_isanc($b,$aend) 1
7874 set cached_isanc($a,$bend) 0
7875 return -1
7877 if {![info exists anc($xd)]} {
7878 set anc($xd) $anc($x)
7879 lappend todo $xd
7880 } elseif {$anc($xd) ne $anc($x)} {
7881 set anc($xd) {}
7885 set cached_isanc($a,$bend) 0
7886 set cached_isanc($b,$aend) 0
7887 return 0
7890 # This identifies whether $desc has an ancestor that is
7891 # a growing tip of the graph and which is not an ancestor of $anc
7892 # and returns 0 if so and 1 if not.
7893 # If we subsequently discover a tag on such a growing tip, and that
7894 # turns out to be a descendent of $anc (which it could, since we
7895 # don't necessarily see children before parents), then $desc
7896 # isn't a good choice to display as a descendent tag of
7897 # $anc (since it is the descendent of another tag which is
7898 # a descendent of $anc). Similarly, $anc isn't a good choice to
7899 # display as a ancestor tag of $desc.
7901 proc is_certain {desc anc} {
7902 global arcnos arcout arcstart arcend growing problems
7904 set certain {}
7905 if {[llength $arcnos($anc)] == 1} {
7906 # tags on the same arc are certain
7907 if {$arcnos($desc) eq $arcnos($anc)} {
7908 return 1
7910 if {![info exists arcout($anc)]} {
7911 # if $anc is partway along an arc, use the start of the arc instead
7912 set a [lindex $arcnos($anc) 0]
7913 set anc $arcstart($a)
7916 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7917 set x $desc
7918 } else {
7919 set a [lindex $arcnos($desc) 0]
7920 set x $arcend($a)
7922 if {$x == $anc} {
7923 return 1
7925 set anclist [list $x]
7926 set dl($x) 1
7927 set nnh 1
7928 set ngrowanc 0
7929 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7930 set x [lindex $anclist $i]
7931 if {$dl($x)} {
7932 incr nnh -1
7934 set done($x) 1
7935 foreach a $arcout($x) {
7936 if {[info exists growing($a)]} {
7937 if {![info exists growanc($x)] && $dl($x)} {
7938 set growanc($x) 1
7939 incr ngrowanc
7941 } else {
7942 set y $arcend($a)
7943 if {[info exists dl($y)]} {
7944 if {$dl($y)} {
7945 if {!$dl($x)} {
7946 set dl($y) 0
7947 if {![info exists done($y)]} {
7948 incr nnh -1
7950 if {[info exists growanc($x)]} {
7951 incr ngrowanc -1
7953 set xl [list $y]
7954 for {set k 0} {$k < [llength $xl]} {incr k} {
7955 set z [lindex $xl $k]
7956 foreach c $arcout($z) {
7957 if {[info exists arcend($c)]} {
7958 set v $arcend($c)
7959 if {[info exists dl($v)] && $dl($v)} {
7960 set dl($v) 0
7961 if {![info exists done($v)]} {
7962 incr nnh -1
7964 if {[info exists growanc($v)]} {
7965 incr ngrowanc -1
7967 lappend xl $v
7974 } elseif {$y eq $anc || !$dl($x)} {
7975 set dl($y) 0
7976 lappend anclist $y
7977 } else {
7978 set dl($y) 1
7979 lappend anclist $y
7980 incr nnh
7985 foreach x [array names growanc] {
7986 if {$dl($x)} {
7987 return 0
7989 return 0
7991 return 1
7994 proc validate_arctags {a} {
7995 global arctags idtags
7997 set i -1
7998 set na $arctags($a)
7999 foreach id $arctags($a) {
8000 incr i
8001 if {![info exists idtags($id)]} {
8002 set na [lreplace $na $i $i]
8003 incr i -1
8006 set arctags($a) $na
8009 proc validate_archeads {a} {
8010 global archeads idheads
8012 set i -1
8013 set na $archeads($a)
8014 foreach id $archeads($a) {
8015 incr i
8016 if {![info exists idheads($id)]} {
8017 set na [lreplace $na $i $i]
8018 incr i -1
8021 set archeads($a) $na
8024 # Return the list of IDs that have tags that are descendents of id,
8025 # ignoring IDs that are descendents of IDs already reported.
8026 proc desctags {id} {
8027 global arcnos arcstart arcids arctags idtags allparents
8028 global growing cached_dtags
8030 if {![info exists allparents($id)]} {
8031 return {}
8033 set t1 [clock clicks -milliseconds]
8034 set argid $id
8035 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8036 # part-way along an arc; check that arc first
8037 set a [lindex $arcnos($id) 0]
8038 if {$arctags($a) ne {}} {
8039 validate_arctags $a
8040 set i [lsearch -exact $arcids($a) $id]
8041 set tid {}
8042 foreach t $arctags($a) {
8043 set j [lsearch -exact $arcids($a) $t]
8044 if {$j >= $i} break
8045 set tid $t
8047 if {$tid ne {}} {
8048 return $tid
8051 set id $arcstart($a)
8052 if {[info exists idtags($id)]} {
8053 return $id
8056 if {[info exists cached_dtags($id)]} {
8057 return $cached_dtags($id)
8060 set origid $id
8061 set todo [list $id]
8062 set queued($id) 1
8063 set nc 1
8064 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8065 set id [lindex $todo $i]
8066 set done($id) 1
8067 set ta [info exists hastaggedancestor($id)]
8068 if {!$ta} {
8069 incr nc -1
8071 # ignore tags on starting node
8072 if {!$ta && $i > 0} {
8073 if {[info exists idtags($id)]} {
8074 set tagloc($id) $id
8075 set ta 1
8076 } elseif {[info exists cached_dtags($id)]} {
8077 set tagloc($id) $cached_dtags($id)
8078 set ta 1
8081 foreach a $arcnos($id) {
8082 set d $arcstart($a)
8083 if {!$ta && $arctags($a) ne {}} {
8084 validate_arctags $a
8085 if {$arctags($a) ne {}} {
8086 lappend tagloc($id) [lindex $arctags($a) end]
8089 if {$ta || $arctags($a) ne {}} {
8090 set tomark [list $d]
8091 for {set j 0} {$j < [llength $tomark]} {incr j} {
8092 set dd [lindex $tomark $j]
8093 if {![info exists hastaggedancestor($dd)]} {
8094 if {[info exists done($dd)]} {
8095 foreach b $arcnos($dd) {
8096 lappend tomark $arcstart($b)
8098 if {[info exists tagloc($dd)]} {
8099 unset tagloc($dd)
8101 } elseif {[info exists queued($dd)]} {
8102 incr nc -1
8104 set hastaggedancestor($dd) 1
8108 if {![info exists queued($d)]} {
8109 lappend todo $d
8110 set queued($d) 1
8111 if {![info exists hastaggedancestor($d)]} {
8112 incr nc
8117 set tags {}
8118 foreach id [array names tagloc] {
8119 if {![info exists hastaggedancestor($id)]} {
8120 foreach t $tagloc($id) {
8121 if {[lsearch -exact $tags $t] < 0} {
8122 lappend tags $t
8127 set t2 [clock clicks -milliseconds]
8128 set loopix $i
8130 # remove tags that are descendents of other tags
8131 for {set i 0} {$i < [llength $tags]} {incr i} {
8132 set a [lindex $tags $i]
8133 for {set j 0} {$j < $i} {incr j} {
8134 set b [lindex $tags $j]
8135 set r [anc_or_desc $a $b]
8136 if {$r == 1} {
8137 set tags [lreplace $tags $j $j]
8138 incr j -1
8139 incr i -1
8140 } elseif {$r == -1} {
8141 set tags [lreplace $tags $i $i]
8142 incr i -1
8143 break
8148 if {[array names growing] ne {}} {
8149 # graph isn't finished, need to check if any tag could get
8150 # eclipsed by another tag coming later. Simply ignore any
8151 # tags that could later get eclipsed.
8152 set ctags {}
8153 foreach t $tags {
8154 if {[is_certain $t $origid]} {
8155 lappend ctags $t
8158 if {$tags eq $ctags} {
8159 set cached_dtags($origid) $tags
8160 } else {
8161 set tags $ctags
8163 } else {
8164 set cached_dtags($origid) $tags
8166 set t3 [clock clicks -milliseconds]
8167 if {0 && $t3 - $t1 >= 100} {
8168 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8169 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8171 return $tags
8174 proc anctags {id} {
8175 global arcnos arcids arcout arcend arctags idtags allparents
8176 global growing cached_atags
8178 if {![info exists allparents($id)]} {
8179 return {}
8181 set t1 [clock clicks -milliseconds]
8182 set argid $id
8183 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8184 # part-way along an arc; check that arc first
8185 set a [lindex $arcnos($id) 0]
8186 if {$arctags($a) ne {}} {
8187 validate_arctags $a
8188 set i [lsearch -exact $arcids($a) $id]
8189 foreach t $arctags($a) {
8190 set j [lsearch -exact $arcids($a) $t]
8191 if {$j > $i} {
8192 return $t
8196 if {![info exists arcend($a)]} {
8197 return {}
8199 set id $arcend($a)
8200 if {[info exists idtags($id)]} {
8201 return $id
8204 if {[info exists cached_atags($id)]} {
8205 return $cached_atags($id)
8208 set origid $id
8209 set todo [list $id]
8210 set queued($id) 1
8211 set taglist {}
8212 set nc 1
8213 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8214 set id [lindex $todo $i]
8215 set done($id) 1
8216 set td [info exists hastaggeddescendent($id)]
8217 if {!$td} {
8218 incr nc -1
8220 # ignore tags on starting node
8221 if {!$td && $i > 0} {
8222 if {[info exists idtags($id)]} {
8223 set tagloc($id) $id
8224 set td 1
8225 } elseif {[info exists cached_atags($id)]} {
8226 set tagloc($id) $cached_atags($id)
8227 set td 1
8230 foreach a $arcout($id) {
8231 if {!$td && $arctags($a) ne {}} {
8232 validate_arctags $a
8233 if {$arctags($a) ne {}} {
8234 lappend tagloc($id) [lindex $arctags($a) 0]
8237 if {![info exists arcend($a)]} continue
8238 set d $arcend($a)
8239 if {$td || $arctags($a) ne {}} {
8240 set tomark [list $d]
8241 for {set j 0} {$j < [llength $tomark]} {incr j} {
8242 set dd [lindex $tomark $j]
8243 if {![info exists hastaggeddescendent($dd)]} {
8244 if {[info exists done($dd)]} {
8245 foreach b $arcout($dd) {
8246 if {[info exists arcend($b)]} {
8247 lappend tomark $arcend($b)
8250 if {[info exists tagloc($dd)]} {
8251 unset tagloc($dd)
8253 } elseif {[info exists queued($dd)]} {
8254 incr nc -1
8256 set hastaggeddescendent($dd) 1
8260 if {![info exists queued($d)]} {
8261 lappend todo $d
8262 set queued($d) 1
8263 if {![info exists hastaggeddescendent($d)]} {
8264 incr nc
8269 set t2 [clock clicks -milliseconds]
8270 set loopix $i
8271 set tags {}
8272 foreach id [array names tagloc] {
8273 if {![info exists hastaggeddescendent($id)]} {
8274 foreach t $tagloc($id) {
8275 if {[lsearch -exact $tags $t] < 0} {
8276 lappend tags $t
8282 # remove tags that are ancestors of other tags
8283 for {set i 0} {$i < [llength $tags]} {incr i} {
8284 set a [lindex $tags $i]
8285 for {set j 0} {$j < $i} {incr j} {
8286 set b [lindex $tags $j]
8287 set r [anc_or_desc $a $b]
8288 if {$r == -1} {
8289 set tags [lreplace $tags $j $j]
8290 incr j -1
8291 incr i -1
8292 } elseif {$r == 1} {
8293 set tags [lreplace $tags $i $i]
8294 incr i -1
8295 break
8300 if {[array names growing] ne {}} {
8301 # graph isn't finished, need to check if any tag could get
8302 # eclipsed by another tag coming later. Simply ignore any
8303 # tags that could later get eclipsed.
8304 set ctags {}
8305 foreach t $tags {
8306 if {[is_certain $origid $t]} {
8307 lappend ctags $t
8310 if {$tags eq $ctags} {
8311 set cached_atags($origid) $tags
8312 } else {
8313 set tags $ctags
8315 } else {
8316 set cached_atags($origid) $tags
8318 set t3 [clock clicks -milliseconds]
8319 if {0 && $t3 - $t1 >= 100} {
8320 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8321 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8323 return $tags
8326 # Return the list of IDs that have heads that are descendents of id,
8327 # including id itself if it has a head.
8328 proc descheads {id} {
8329 global arcnos arcstart arcids archeads idheads cached_dheads
8330 global allparents
8332 if {![info exists allparents($id)]} {
8333 return {}
8335 set aret {}
8336 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8337 # part-way along an arc; check it first
8338 set a [lindex $arcnos($id) 0]
8339 if {$archeads($a) ne {}} {
8340 validate_archeads $a
8341 set i [lsearch -exact $arcids($a) $id]
8342 foreach t $archeads($a) {
8343 set j [lsearch -exact $arcids($a) $t]
8344 if {$j > $i} break
8345 lappend aret $t
8348 set id $arcstart($a)
8350 set origid $id
8351 set todo [list $id]
8352 set seen($id) 1
8353 set ret {}
8354 for {set i 0} {$i < [llength $todo]} {incr i} {
8355 set id [lindex $todo $i]
8356 if {[info exists cached_dheads($id)]} {
8357 set ret [concat $ret $cached_dheads($id)]
8358 } else {
8359 if {[info exists idheads($id)]} {
8360 lappend ret $id
8362 foreach a $arcnos($id) {
8363 if {$archeads($a) ne {}} {
8364 validate_archeads $a
8365 if {$archeads($a) ne {}} {
8366 set ret [concat $ret $archeads($a)]
8369 set d $arcstart($a)
8370 if {![info exists seen($d)]} {
8371 lappend todo $d
8372 set seen($d) 1
8377 set ret [lsort -unique $ret]
8378 set cached_dheads($origid) $ret
8379 return [concat $ret $aret]
8382 proc addedtag {id} {
8383 global arcnos arcout cached_dtags cached_atags
8385 if {![info exists arcnos($id)]} return
8386 if {![info exists arcout($id)]} {
8387 recalcarc [lindex $arcnos($id) 0]
8389 catch {unset cached_dtags}
8390 catch {unset cached_atags}
8393 proc addedhead {hid head} {
8394 global arcnos arcout cached_dheads
8396 if {![info exists arcnos($hid)]} return
8397 if {![info exists arcout($hid)]} {
8398 recalcarc [lindex $arcnos($hid) 0]
8400 catch {unset cached_dheads}
8403 proc removedhead {hid head} {
8404 global cached_dheads
8406 catch {unset cached_dheads}
8409 proc movedhead {hid head} {
8410 global arcnos arcout cached_dheads
8412 if {![info exists arcnos($hid)]} return
8413 if {![info exists arcout($hid)]} {
8414 recalcarc [lindex $arcnos($hid) 0]
8416 catch {unset cached_dheads}
8419 proc changedrefs {} {
8420 global cached_dheads cached_dtags cached_atags
8421 global arctags archeads arcnos arcout idheads idtags
8423 foreach id [concat [array names idheads] [array names idtags]] {
8424 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8425 set a [lindex $arcnos($id) 0]
8426 if {![info exists donearc($a)]} {
8427 recalcarc $a
8428 set donearc($a) 1
8432 catch {unset cached_dtags}
8433 catch {unset cached_atags}
8434 catch {unset cached_dheads}
8437 proc rereadrefs {} {
8438 global idtags idheads idotherrefs mainheadid
8440 set refids [concat [array names idtags] \
8441 [array names idheads] [array names idotherrefs]]
8442 foreach id $refids {
8443 if {![info exists ref($id)]} {
8444 set ref($id) [listrefs $id]
8447 set oldmainhead $mainheadid
8448 readrefs
8449 changedrefs
8450 set refids [lsort -unique [concat $refids [array names idtags] \
8451 [array names idheads] [array names idotherrefs]]]
8452 foreach id $refids {
8453 set v [listrefs $id]
8454 if {![info exists ref($id)] || $ref($id) != $v ||
8455 ($id eq $oldmainhead && $id ne $mainheadid) ||
8456 ($id eq $mainheadid && $id ne $oldmainhead)} {
8457 redrawtags $id
8460 run refill_reflist
8463 proc listrefs {id} {
8464 global idtags idheads idotherrefs
8466 set x {}
8467 if {[info exists idtags($id)]} {
8468 set x $idtags($id)
8470 set y {}
8471 if {[info exists idheads($id)]} {
8472 set y $idheads($id)
8474 set z {}
8475 if {[info exists idotherrefs($id)]} {
8476 set z $idotherrefs($id)
8478 return [list $x $y $z]
8481 proc showtag {tag isnew} {
8482 global ctext tagcontents tagids linknum tagobjid
8484 if {$isnew} {
8485 addtohistory [list showtag $tag 0]
8487 $ctext conf -state normal
8488 clear_ctext
8489 settabs 0
8490 set linknum 0
8491 if {![info exists tagcontents($tag)]} {
8492 catch {
8493 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8496 if {[info exists tagcontents($tag)]} {
8497 set text $tagcontents($tag)
8498 } else {
8499 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8501 appendwithlinks $text {}
8502 $ctext conf -state disabled
8503 init_flist {}
8506 proc doquit {} {
8507 global stopped
8508 set stopped 100
8509 savestuff .
8510 destroy .
8513 proc mkfontdisp {font top which} {
8514 global fontattr fontpref $font
8516 set fontpref($font) [set $font]
8517 button $top.${font}but -text $which -font optionfont \
8518 -command [list choosefont $font $which]
8519 label $top.$font -relief flat -font $font \
8520 -text $fontattr($font,family) -justify left
8521 grid x $top.${font}but $top.$font -sticky w
8524 proc choosefont {font which} {
8525 global fontparam fontlist fonttop fontattr
8527 set fontparam(which) $which
8528 set fontparam(font) $font
8529 set fontparam(family) [font actual $font -family]
8530 set fontparam(size) $fontattr($font,size)
8531 set fontparam(weight) $fontattr($font,weight)
8532 set fontparam(slant) $fontattr($font,slant)
8533 set top .gitkfont
8534 set fonttop $top
8535 if {![winfo exists $top]} {
8536 font create sample
8537 eval font config sample [font actual $font]
8538 toplevel $top
8539 wm title $top [mc "Gitk font chooser"]
8540 label $top.l -textvariable fontparam(which)
8541 pack $top.l -side top
8542 set fontlist [lsort [font families]]
8543 frame $top.f
8544 listbox $top.f.fam -listvariable fontlist \
8545 -yscrollcommand [list $top.f.sb set]
8546 bind $top.f.fam <<ListboxSelect>> selfontfam
8547 scrollbar $top.f.sb -command [list $top.f.fam yview]
8548 pack $top.f.sb -side right -fill y
8549 pack $top.f.fam -side left -fill both -expand 1
8550 pack $top.f -side top -fill both -expand 1
8551 frame $top.g
8552 spinbox $top.g.size -from 4 -to 40 -width 4 \
8553 -textvariable fontparam(size) \
8554 -validatecommand {string is integer -strict %s}
8555 checkbutton $top.g.bold -padx 5 \
8556 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8557 -variable fontparam(weight) -onvalue bold -offvalue normal
8558 checkbutton $top.g.ital -padx 5 \
8559 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8560 -variable fontparam(slant) -onvalue italic -offvalue roman
8561 pack $top.g.size $top.g.bold $top.g.ital -side left
8562 pack $top.g -side top
8563 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8564 -background white
8565 $top.c create text 100 25 -anchor center -text $which -font sample \
8566 -fill black -tags text
8567 bind $top.c <Configure> [list centertext $top.c]
8568 pack $top.c -side top -fill x
8569 frame $top.buts
8570 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8571 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8572 grid $top.buts.ok $top.buts.can
8573 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8574 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8575 pack $top.buts -side bottom -fill x
8576 trace add variable fontparam write chg_fontparam
8577 } else {
8578 raise $top
8579 $top.c itemconf text -text $which
8581 set i [lsearch -exact $fontlist $fontparam(family)]
8582 if {$i >= 0} {
8583 $top.f.fam selection set $i
8584 $top.f.fam see $i
8588 proc centertext {w} {
8589 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8592 proc fontok {} {
8593 global fontparam fontpref prefstop
8595 set f $fontparam(font)
8596 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8597 if {$fontparam(weight) eq "bold"} {
8598 lappend fontpref($f) "bold"
8600 if {$fontparam(slant) eq "italic"} {
8601 lappend fontpref($f) "italic"
8603 set w $prefstop.$f
8604 $w conf -text $fontparam(family) -font $fontpref($f)
8606 fontcan
8609 proc fontcan {} {
8610 global fonttop fontparam
8612 if {[info exists fonttop]} {
8613 catch {destroy $fonttop}
8614 catch {font delete sample}
8615 unset fonttop
8616 unset fontparam
8620 proc selfontfam {} {
8621 global fonttop fontparam
8623 set i [$fonttop.f.fam curselection]
8624 if {$i ne {}} {
8625 set fontparam(family) [$fonttop.f.fam get $i]
8629 proc chg_fontparam {v sub op} {
8630 global fontparam
8632 font config sample -$sub $fontparam($sub)
8635 proc doprefs {} {
8636 global maxwidth maxgraphpct
8637 global oldprefs prefstop showneartags showlocalchanges
8638 global bgcolor fgcolor ctext diffcolors selectbgcolor
8639 global tabstop limitdiffs
8641 set top .gitkprefs
8642 set prefstop $top
8643 if {[winfo exists $top]} {
8644 raise $top
8645 return
8647 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8648 limitdiffs tabstop} {
8649 set oldprefs($v) [set $v]
8651 toplevel $top
8652 wm title $top [mc "Gitk preferences"]
8653 label $top.ldisp -text [mc "Commit list display options"]
8654 grid $top.ldisp - -sticky w -pady 10
8655 label $top.spacer -text " "
8656 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8657 -font optionfont
8658 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8659 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8660 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8661 -font optionfont
8662 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8663 grid x $top.maxpctl $top.maxpct -sticky w
8664 frame $top.showlocal
8665 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8666 checkbutton $top.showlocal.b -variable showlocalchanges
8667 pack $top.showlocal.b $top.showlocal.l -side left
8668 grid x $top.showlocal -sticky w
8670 label $top.ddisp -text [mc "Diff display options"]
8671 grid $top.ddisp - -sticky w -pady 10
8672 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8673 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8674 grid x $top.tabstopl $top.tabstop -sticky w
8675 frame $top.ntag
8676 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8677 checkbutton $top.ntag.b -variable showneartags
8678 pack $top.ntag.b $top.ntag.l -side left
8679 grid x $top.ntag -sticky w
8680 frame $top.ldiff
8681 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8682 checkbutton $top.ldiff.b -variable limitdiffs
8683 pack $top.ldiff.b $top.ldiff.l -side left
8684 grid x $top.ldiff -sticky w
8686 label $top.cdisp -text [mc "Colors: press to choose"]
8687 grid $top.cdisp - -sticky w -pady 10
8688 label $top.bg -padx 40 -relief sunk -background $bgcolor
8689 button $top.bgbut -text [mc "Background"] -font optionfont \
8690 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8691 grid x $top.bgbut $top.bg -sticky w
8692 label $top.fg -padx 40 -relief sunk -background $fgcolor
8693 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8694 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8695 grid x $top.fgbut $top.fg -sticky w
8696 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8697 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8698 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8699 [list $ctext tag conf d0 -foreground]]
8700 grid x $top.diffoldbut $top.diffold -sticky w
8701 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8702 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8703 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8704 [list $ctext tag conf d1 -foreground]]
8705 grid x $top.diffnewbut $top.diffnew -sticky w
8706 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8707 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8708 -command [list choosecolor diffcolors 2 $top.hunksep \
8709 "diff hunk header" \
8710 [list $ctext tag conf hunksep -foreground]]
8711 grid x $top.hunksepbut $top.hunksep -sticky w
8712 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8713 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8714 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8715 grid x $top.selbgbut $top.selbgsep -sticky w
8717 label $top.cfont -text [mc "Fonts: press to choose"]
8718 grid $top.cfont - -sticky w -pady 10
8719 mkfontdisp mainfont $top [mc "Main font"]
8720 mkfontdisp textfont $top [mc "Diff display font"]
8721 mkfontdisp uifont $top [mc "User interface font"]
8723 frame $top.buts
8724 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8725 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8726 grid $top.buts.ok $top.buts.can
8727 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8728 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8729 grid $top.buts - - -pady 10 -sticky ew
8730 bind $top <Visibility> "focus $top.buts.ok"
8733 proc choosecolor {v vi w x cmd} {
8734 global $v
8736 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8737 -title [mc "Gitk: choose color for %s" $x]]
8738 if {$c eq {}} return
8739 $w conf -background $c
8740 lset $v $vi $c
8741 eval $cmd $c
8744 proc setselbg {c} {
8745 global bglist cflist
8746 foreach w $bglist {
8747 $w configure -selectbackground $c
8749 $cflist tag configure highlight \
8750 -background [$cflist cget -selectbackground]
8751 allcanvs itemconf secsel -fill $c
8754 proc setbg {c} {
8755 global bglist
8757 foreach w $bglist {
8758 $w conf -background $c
8762 proc setfg {c} {
8763 global fglist canv
8765 foreach w $fglist {
8766 $w conf -foreground $c
8768 allcanvs itemconf text -fill $c
8769 $canv itemconf circle -outline $c
8772 proc prefscan {} {
8773 global oldprefs prefstop
8775 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8776 limitdiffs tabstop} {
8777 global $v
8778 set $v $oldprefs($v)
8780 catch {destroy $prefstop}
8781 unset prefstop
8782 fontcan
8785 proc prefsok {} {
8786 global maxwidth maxgraphpct
8787 global oldprefs prefstop showneartags showlocalchanges
8788 global fontpref mainfont textfont uifont
8789 global limitdiffs treediffs
8791 catch {destroy $prefstop}
8792 unset prefstop
8793 fontcan
8794 set fontchanged 0
8795 if {$mainfont ne $fontpref(mainfont)} {
8796 set mainfont $fontpref(mainfont)
8797 parsefont mainfont $mainfont
8798 eval font configure mainfont [fontflags mainfont]
8799 eval font configure mainfontbold [fontflags mainfont 1]
8800 setcoords
8801 set fontchanged 1
8803 if {$textfont ne $fontpref(textfont)} {
8804 set textfont $fontpref(textfont)
8805 parsefont textfont $textfont
8806 eval font configure textfont [fontflags textfont]
8807 eval font configure textfontbold [fontflags textfont 1]
8809 if {$uifont ne $fontpref(uifont)} {
8810 set uifont $fontpref(uifont)
8811 parsefont uifont $uifont
8812 eval font configure uifont [fontflags uifont]
8814 settabs
8815 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8816 if {$showlocalchanges} {
8817 doshowlocalchanges
8818 } else {
8819 dohidelocalchanges
8822 if {$limitdiffs != $oldprefs(limitdiffs)} {
8823 # treediffs elements are limited by path
8824 catch {unset treediffs}
8826 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8827 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8828 redisplay
8829 } elseif {$showneartags != $oldprefs(showneartags) ||
8830 $limitdiffs != $oldprefs(limitdiffs)} {
8831 reselectline
8835 proc formatdate {d} {
8836 global datetimeformat
8837 if {$d ne {}} {
8838 set d [clock format $d -format $datetimeformat]
8840 return $d
8843 # This list of encoding names and aliases is distilled from
8844 # http://www.iana.org/assignments/character-sets.
8845 # Not all of them are supported by Tcl.
8846 set encoding_aliases {
8847 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8848 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8849 { ISO-10646-UTF-1 csISO10646UTF1 }
8850 { ISO_646.basic:1983 ref csISO646basic1983 }
8851 { INVARIANT csINVARIANT }
8852 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8853 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8854 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8855 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8856 { NATS-DANO iso-ir-9-1 csNATSDANO }
8857 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8858 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8859 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8860 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8861 { ISO-2022-KR csISO2022KR }
8862 { EUC-KR csEUCKR }
8863 { ISO-2022-JP csISO2022JP }
8864 { ISO-2022-JP-2 csISO2022JP2 }
8865 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8866 csISO13JISC6220jp }
8867 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8868 { IT iso-ir-15 ISO646-IT csISO15Italian }
8869 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8870 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8871 { greek7-old iso-ir-18 csISO18Greek7Old }
8872 { latin-greek iso-ir-19 csISO19LatinGreek }
8873 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8874 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8875 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8876 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8877 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8878 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8879 { INIS iso-ir-49 csISO49INIS }
8880 { INIS-8 iso-ir-50 csISO50INIS8 }
8881 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8882 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8883 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8884 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8885 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8886 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8887 csISO60Norwegian1 }
8888 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8889 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8890 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8891 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8892 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8893 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8894 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8895 { greek7 iso-ir-88 csISO88Greek7 }
8896 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8897 { iso-ir-90 csISO90 }
8898 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8899 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8900 csISO92JISC62991984b }
8901 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8902 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8903 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8904 csISO95JIS62291984handadd }
8905 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8906 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8907 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8908 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8909 CP819 csISOLatin1 }
8910 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8911 { T.61-7bit iso-ir-102 csISO102T617bit }
8912 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8913 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8914 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8915 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8916 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8917 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8918 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8919 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8920 arabic csISOLatinArabic }
8921 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8922 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8923 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8924 greek greek8 csISOLatinGreek }
8925 { T.101-G2 iso-ir-128 csISO128T101G2 }
8926 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8927 csISOLatinHebrew }
8928 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8929 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8930 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8931 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8932 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8933 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8934 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8935 csISOLatinCyrillic }
8936 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8937 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8938 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8939 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8940 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8941 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8942 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8943 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8944 { ISO_10367-box iso-ir-155 csISO10367Box }
8945 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8946 { latin-lap lap iso-ir-158 csISO158Lap }
8947 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8948 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8949 { us-dk csUSDK }
8950 { dk-us csDKUS }
8951 { JIS_X0201 X0201 csHalfWidthKatakana }
8952 { KSC5636 ISO646-KR csKSC5636 }
8953 { ISO-10646-UCS-2 csUnicode }
8954 { ISO-10646-UCS-4 csUCS4 }
8955 { DEC-MCS dec csDECMCS }
8956 { hp-roman8 roman8 r8 csHPRoman8 }
8957 { macintosh mac csMacintosh }
8958 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8959 csIBM037 }
8960 { IBM038 EBCDIC-INT cp038 csIBM038 }
8961 { IBM273 CP273 csIBM273 }
8962 { IBM274 EBCDIC-BE CP274 csIBM274 }
8963 { IBM275 EBCDIC-BR cp275 csIBM275 }
8964 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8965 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8966 { IBM280 CP280 ebcdic-cp-it csIBM280 }
8967 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8968 { IBM284 CP284 ebcdic-cp-es csIBM284 }
8969 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8970 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8971 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8972 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8973 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8974 { IBM424 cp424 ebcdic-cp-he csIBM424 }
8975 { IBM437 cp437 437 csPC8CodePage437 }
8976 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8977 { IBM775 cp775 csPC775Baltic }
8978 { IBM850 cp850 850 csPC850Multilingual }
8979 { IBM851 cp851 851 csIBM851 }
8980 { IBM852 cp852 852 csPCp852 }
8981 { IBM855 cp855 855 csIBM855 }
8982 { IBM857 cp857 857 csIBM857 }
8983 { IBM860 cp860 860 csIBM860 }
8984 { IBM861 cp861 861 cp-is csIBM861 }
8985 { IBM862 cp862 862 csPC862LatinHebrew }
8986 { IBM863 cp863 863 csIBM863 }
8987 { IBM864 cp864 csIBM864 }
8988 { IBM865 cp865 865 csIBM865 }
8989 { IBM866 cp866 866 csIBM866 }
8990 { IBM868 CP868 cp-ar csIBM868 }
8991 { IBM869 cp869 869 cp-gr csIBM869 }
8992 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8993 { IBM871 CP871 ebcdic-cp-is csIBM871 }
8994 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8995 { IBM891 cp891 csIBM891 }
8996 { IBM903 cp903 csIBM903 }
8997 { IBM904 cp904 904 csIBBM904 }
8998 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8999 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9000 { IBM1026 CP1026 csIBM1026 }
9001 { EBCDIC-AT-DE csIBMEBCDICATDE }
9002 { EBCDIC-AT-DE-A csEBCDICATDEA }
9003 { EBCDIC-CA-FR csEBCDICCAFR }
9004 { EBCDIC-DK-NO csEBCDICDKNO }
9005 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9006 { EBCDIC-FI-SE csEBCDICFISE }
9007 { EBCDIC-FI-SE-A csEBCDICFISEA }
9008 { EBCDIC-FR csEBCDICFR }
9009 { EBCDIC-IT csEBCDICIT }
9010 { EBCDIC-PT csEBCDICPT }
9011 { EBCDIC-ES csEBCDICES }
9012 { EBCDIC-ES-A csEBCDICESA }
9013 { EBCDIC-ES-S csEBCDICESS }
9014 { EBCDIC-UK csEBCDICUK }
9015 { EBCDIC-US csEBCDICUS }
9016 { UNKNOWN-8BIT csUnknown8BiT }
9017 { MNEMONIC csMnemonic }
9018 { MNEM csMnem }
9019 { VISCII csVISCII }
9020 { VIQR csVIQR }
9021 { KOI8-R csKOI8R }
9022 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9023 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9024 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9025 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9026 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9027 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9028 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9029 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9030 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9031 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9032 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9033 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9034 { IBM1047 IBM-1047 }
9035 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9036 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9037 { UNICODE-1-1 csUnicode11 }
9038 { CESU-8 csCESU-8 }
9039 { BOCU-1 csBOCU-1 }
9040 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9041 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9042 l8 }
9043 { ISO-8859-15 ISO_8859-15 Latin-9 }
9044 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9045 { GBK CP936 MS936 windows-936 }
9046 { JIS_Encoding csJISEncoding }
9047 { Shift_JIS MS_Kanji csShiftJIS }
9048 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9049 EUC-JP }
9050 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9051 { ISO-10646-UCS-Basic csUnicodeASCII }
9052 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9053 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9054 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9055 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9056 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9057 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9058 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9059 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9060 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9061 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9062 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9063 { Ventura-US csVenturaUS }
9064 { Ventura-International csVenturaInternational }
9065 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9066 { PC8-Turkish csPC8Turkish }
9067 { IBM-Symbols csIBMSymbols }
9068 { IBM-Thai csIBMThai }
9069 { HP-Legal csHPLegal }
9070 { HP-Pi-font csHPPiFont }
9071 { HP-Math8 csHPMath8 }
9072 { Adobe-Symbol-Encoding csHPPSMath }
9073 { HP-DeskTop csHPDesktop }
9074 { Ventura-Math csVenturaMath }
9075 { Microsoft-Publishing csMicrosoftPublishing }
9076 { Windows-31J csWindows31J }
9077 { GB2312 csGB2312 }
9078 { Big5 csBig5 }
9081 proc tcl_encoding {enc} {
9082 global encoding_aliases
9083 set names [encoding names]
9084 set lcnames [string tolower $names]
9085 set enc [string tolower $enc]
9086 set i [lsearch -exact $lcnames $enc]
9087 if {$i < 0} {
9088 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9089 if {[regsub {^iso[-_]} $enc iso encx]} {
9090 set i [lsearch -exact $lcnames $encx]
9093 if {$i < 0} {
9094 foreach l $encoding_aliases {
9095 set ll [string tolower $l]
9096 if {[lsearch -exact $ll $enc] < 0} continue
9097 # look through the aliases for one that tcl knows about
9098 foreach e $ll {
9099 set i [lsearch -exact $lcnames $e]
9100 if {$i < 0} {
9101 if {[regsub {^iso[-_]} $e iso ex]} {
9102 set i [lsearch -exact $lcnames $ex]
9105 if {$i >= 0} break
9107 break
9110 if {$i >= 0} {
9111 return [lindex $names $i]
9113 return {}
9116 # First check that Tcl/Tk is recent enough
9117 if {[catch {package require Tk 8.4} err]} {
9118 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9119 Gitk requires at least Tcl/Tk 8.4."]
9120 exit 1
9123 # defaults...
9124 set datemode 0
9125 set wrcomcmd "git diff-tree --stdin -p --pretty"
9127 set gitencoding {}
9128 catch {
9129 set gitencoding [exec git config --get i18n.commitencoding]
9131 if {$gitencoding == ""} {
9132 set gitencoding "utf-8"
9134 set tclencoding [tcl_encoding $gitencoding]
9135 if {$tclencoding == {}} {
9136 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9139 set mainfont {Helvetica 9}
9140 set textfont {Courier 9}
9141 set uifont {Helvetica 9 bold}
9142 set tabstop 8
9143 set findmergefiles 0
9144 set maxgraphpct 50
9145 set maxwidth 16
9146 set revlistorder 0
9147 set fastdate 0
9148 set uparrowlen 5
9149 set downarrowlen 5
9150 set mingaplen 100
9151 set cmitmode "patch"
9152 set wrapcomment "none"
9153 set showneartags 1
9154 set maxrefs 20
9155 set maxlinelen 200
9156 set showlocalchanges 1
9157 set limitdiffs 1
9158 set datetimeformat "%Y-%m-%d %H:%M:%S"
9160 set colors {green red blue magenta darkgrey brown orange}
9161 set bgcolor white
9162 set fgcolor black
9163 set diffcolors {red "#00a000" blue}
9164 set diffcontext 3
9165 set selectbgcolor gray85
9167 ## For msgcat loading, first locate the installation location.
9168 if { [info exists ::env(GITK_MSGSDIR)] } {
9169 ## Msgsdir was manually set in the environment.
9170 set gitk_msgsdir $::env(GITK_MSGSDIR)
9171 } else {
9172 ## Let's guess the prefix from argv0.
9173 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9174 set gitk_libdir [file join $gitk_prefix share gitk lib]
9175 set gitk_msgsdir [file join $gitk_libdir msgs]
9176 unset gitk_prefix
9179 ## Internationalization (i18n) through msgcat and gettext. See
9180 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9181 package require msgcat
9182 namespace import ::msgcat::mc
9183 ## And eventually load the actual message catalog
9184 ::msgcat::mcload $gitk_msgsdir
9186 catch {source ~/.gitk}
9188 font create optionfont -family sans-serif -size -12
9190 parsefont mainfont $mainfont
9191 eval font create mainfont [fontflags mainfont]
9192 eval font create mainfontbold [fontflags mainfont 1]
9194 parsefont textfont $textfont
9195 eval font create textfont [fontflags textfont]
9196 eval font create textfontbold [fontflags textfont 1]
9198 parsefont uifont $uifont
9199 eval font create uifont [fontflags uifont]
9201 setoptions
9203 # check that we can find a .git directory somewhere...
9204 if {[catch {set gitdir [gitdir]}]} {
9205 show_error {} . [mc "Cannot find a git repository here."]
9206 exit 1
9208 if {![file isdirectory $gitdir]} {
9209 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9210 exit 1
9213 set mergeonly 0
9214 set revtreeargs {}
9215 set cmdline_files {}
9216 set i 0
9217 foreach arg $argv {
9218 switch -- $arg {
9219 "" { }
9220 "-d" { set datemode 1 }
9221 "--merge" {
9222 set mergeonly 1
9223 lappend revtreeargs $arg
9225 "--" {
9226 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9227 break
9229 default {
9230 lappend revtreeargs $arg
9233 incr i
9236 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9237 # no -- on command line, but some arguments (other than -d)
9238 if {[catch {
9239 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9240 set cmdline_files [split $f "\n"]
9241 set n [llength $cmdline_files]
9242 set revtreeargs [lrange $revtreeargs 0 end-$n]
9243 # Unfortunately git rev-parse doesn't produce an error when
9244 # something is both a revision and a filename. To be consistent
9245 # with git log and git rev-list, check revtreeargs for filenames.
9246 foreach arg $revtreeargs {
9247 if {[file exists $arg]} {
9248 show_error {} . [mc "Ambiguous argument '%s': both revision\
9249 and filename" $arg]
9250 exit 1
9253 } err]} {
9254 # unfortunately we get both stdout and stderr in $err,
9255 # so look for "fatal:".
9256 set i [string first "fatal:" $err]
9257 if {$i > 0} {
9258 set err [string range $err [expr {$i + 6}] end]
9260 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9261 exit 1
9265 if {$mergeonly} {
9266 # find the list of unmerged files
9267 set mlist {}
9268 set nr_unmerged 0
9269 if {[catch {
9270 set fd [open "| git ls-files -u" r]
9271 } err]} {
9272 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9273 exit 1
9275 while {[gets $fd line] >= 0} {
9276 set i [string first "\t" $line]
9277 if {$i < 0} continue
9278 set fname [string range $line [expr {$i+1}] end]
9279 if {[lsearch -exact $mlist $fname] >= 0} continue
9280 incr nr_unmerged
9281 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9282 lappend mlist $fname
9285 catch {close $fd}
9286 if {$mlist eq {}} {
9287 if {$nr_unmerged == 0} {
9288 show_error {} . [mc "No files selected: --merge specified but\
9289 no files are unmerged."]
9290 } else {
9291 show_error {} . [mc "No files selected: --merge specified but\
9292 no unmerged files are within file limit."]
9294 exit 1
9296 set cmdline_files $mlist
9299 set nullid "0000000000000000000000000000000000000000"
9300 set nullid2 "0000000000000000000000000000000000000001"
9302 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9304 set runq {}
9305 set history {}
9306 set historyindex 0
9307 set fh_serial 0
9308 set nhl_names {}
9309 set highlight_paths {}
9310 set findpattern {}
9311 set searchdirn -forwards
9312 set boldrows {}
9313 set boldnamerows {}
9314 set diffelide {0 0}
9315 set markingmatches 0
9316 set linkentercount 0
9317 set need_redisplay 0
9318 set nrows_drawn 0
9319 set firsttabstop 0
9321 set nextviewnum 1
9322 set curview 0
9323 set selectedview 0
9324 set selectedhlview [mc "None"]
9325 set highlight_related [mc "None"]
9326 set highlight_files {}
9327 set viewfiles(0) {}
9328 set viewperm(0) 0
9329 set viewargs(0) {}
9331 set loginstance 0
9332 set cmdlineok 0
9333 set stopped 0
9334 set stuffsaved 0
9335 set patchnum 0
9336 set lserial 0
9337 setcoords
9338 makewindow
9339 # wait for the window to become visible
9340 tkwait visibility .
9341 wm title . "[file tail $argv0]: [file tail [pwd]]"
9342 readrefs
9344 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9345 # create a view for the files/dirs specified on the command line
9346 set curview 1
9347 set selectedview 1
9348 set nextviewnum 2
9349 set viewname(1) [mc "Command line"]
9350 set viewfiles(1) $cmdline_files
9351 set viewargs(1) $revtreeargs
9352 set viewperm(1) 0
9353 addviewmenu 1
9354 .bar.view entryconf [mc "Edit view..."] -state normal
9355 .bar.view entryconf [mc "Delete view"] -state normal
9358 if {[info exists permviews]} {
9359 foreach v $permviews {
9360 set n $nextviewnum
9361 incr nextviewnum
9362 set viewname($n) [lindex $v 0]
9363 set viewfiles($n) [lindex $v 1]
9364 set viewargs($n) [lindex $v 2]
9365 set viewperm($n) 1
9366 addviewmenu $n
9369 getcommits