gitk: Cope better with getting commits that we have already seen
[alt-git.git] / gitk
blob09f431b0357f34ec79b42bd790eac65187576d81
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return [exec git rev-parse --git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
24 proc run args {
25 global isonrunq runq
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {}} {
30 after idle dorunq
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
36 proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
40 proc filereadable {fd script} {
41 global runq
43 fileevent $fd readable {}
44 if {$runq eq {}} {
45 after idle dorunq
47 lappend runq [list $fd $script]
50 proc nukefile {fd} {
51 global runq
53 for {set i 0} {$i < [llength $runq]} {} {
54 if {[lindex $runq $i 0] eq $fd} {
55 set runq [lreplace $runq $i $i]
56 } else {
57 incr i
62 proc dorunq {} {
63 global isonrunq runq
65 set tstart [clock clicks -milliseconds]
66 set t0 $tstart
67 while {[llength $runq] > 0} {
68 set fd [lindex $runq 0 0]
69 set script [lindex $runq 0 1]
70 set repeat [eval $script]
71 set t1 [clock clicks -milliseconds]
72 set t [expr {$t1 - $t0}]
73 set runq [lrange $runq 1 end]
74 if {$repeat ne {} && $repeat} {
75 if {$fd eq {} || $repeat == 2} {
76 # script returns 1 if it wants to be readded
77 # file readers return 2 if they could do more straight away
78 lappend runq [list $fd $script]
79 } else {
80 fileevent $fd readable [list filereadable $fd $script]
82 } elseif {$fd eq {}} {
83 unset isonrunq($script)
85 set t0 $t1
86 if {$t1 - $tstart >= 80} break
88 if {$runq ne {}} {
89 after idle dorunq
93 # Start off a git rev-list process and arrange to read its output
94 proc start_rev_list {view} {
95 global startmsecs
96 global commfd leftover tclencoding datemode
97 global viewargs viewfiles commitidx viewcomplete vnextroot
98 global showlocalchanges commitinterest mainheadid
99 global progressdirn progresscoords proglastnc curview
100 global viewincl viewactive loginstance viewinstances
101 global pending_select mainheadid
103 set startmsecs [clock clicks -milliseconds]
104 set commitidx($view) 0
105 set viewcomplete($view) 0
106 set viewactive($view) 1
107 set vnextroot($view) 0
108 varcinit $view
110 set commits [eval exec git rev-parse --default HEAD --revs-only \
111 $viewargs($view)]
112 set viewincl($view) {}
113 foreach c $commits {
114 if {[regexp {^[0-9a-fA-F]{40}$} $c]} {
115 lappend viewincl($view) $c
118 if {[catch {
119 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
120 --boundary $commits "--" $viewfiles($view)] r]
121 } err]} {
122 error_popup "[mc "Error executing git log:"] $err"
123 exit 1
125 set i [incr loginstance]
126 set viewinstances($view) [list $i]
127 set commfd($i) $fd
128 set leftover($i) {}
129 if {$showlocalchanges} {
130 lappend commitinterest($mainheadid) {dodiffindex}
132 fconfigure $fd -blocking 0 -translation lf -eofchar {}
133 if {$tclencoding != {}} {
134 fconfigure $fd -encoding $tclencoding
136 filerun $fd [list getcommitlines $fd $i $view]
137 nowbusy $view [mc "Reading"]
138 if {$view == $curview} {
139 set progressdirn 1
140 set progresscoords {0 0}
141 set proglastnc 0
142 set pending_select $mainheadid
146 proc stop_rev_list {view} {
147 global commfd viewinstances leftover
149 foreach inst $viewinstances($view) {
150 set fd $commfd($inst)
151 catch {
152 set pid [pid $fd]
153 exec kill $pid
155 catch {close $fd}
156 nukefile $fd
157 unset commfd($inst)
158 unset leftover($inst)
160 set viewinstances($view) {}
163 proc getcommits {} {
164 global canv curview
166 initlayout
167 start_rev_list $curview
168 show_status [mc "Reading commits..."]
171 proc updatecommits {} {
172 global curview viewargs viewfiles viewincl viewinstances
173 global viewactive viewcomplete loginstance tclencoding mainheadid
174 global varcid startmsecs commfd showneartags showlocalchanges leftover
175 global mainheadid pending_select
177 set oldmainid $mainheadid
178 rereadrefs
179 if {$showlocalchanges} {
180 if {$mainheadid ne $oldmainid} {
181 dohidelocalchanges
183 if {[commitinview $mainheadid $curview]} {
184 dodiffindex
187 set view $curview
188 set commits [exec git rev-parse --default HEAD --revs-only \
189 $viewargs($view)]
190 set pos {}
191 set neg {}
192 set flags {}
193 foreach c $commits {
194 if {[string match "^*" $c]} {
195 lappend neg $c
196 } elseif {[regexp {^[0-9a-fA-F]{40}$} $c]} {
197 if {!([info exists varcid($view,$c)] ||
198 [lsearch -exact $viewincl($view) $c] >= 0)} {
199 lappend pos $c
201 } else {
202 lappend flags $c
205 if {$pos eq {}} {
206 return
208 foreach id $viewincl($view) {
209 lappend neg "^$id"
211 set viewincl($view) [concat $viewincl($view) $pos]
212 if {[catch {
213 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
214 --boundary $pos $neg $flags "--" $viewfiles($view)] r]
215 } err]} {
216 error_popup "Error executing git log: $err"
217 exit 1
219 if {$viewactive($view) == 0} {
220 set startmsecs [clock clicks -milliseconds]
222 set i [incr loginstance]
223 lappend viewinstances($view) $i
224 set commfd($i) $fd
225 set leftover($i) {}
226 fconfigure $fd -blocking 0 -translation lf -eofchar {}
227 if {$tclencoding != {}} {
228 fconfigure $fd -encoding $tclencoding
230 filerun $fd [list getcommitlines $fd $i $view]
231 incr viewactive($view)
232 set viewcomplete($view) 0
233 set pending_select $mainheadid
234 nowbusy $view "Reading"
235 if {$showneartags} {
236 getallcommits
240 proc reloadcommits {} {
241 global curview viewcomplete selectedline currentid thickerline
242 global showneartags treediffs commitinterest cached_commitrow
243 global progresscoords targetid
245 if {!$viewcomplete($curview)} {
246 stop_rev_list $curview
247 set progresscoords {0 0}
248 adjustprogress
250 resetvarcs $curview
251 catch {unset selectedline}
252 catch {unset currentid}
253 catch {unset thickerline}
254 catch {unset treediffs}
255 readrefs
256 changedrefs
257 if {$showneartags} {
258 getallcommits
260 clear_display
261 catch {unset commitinterest}
262 catch {unset cached_commitrow}
263 catch {unset targetid}
264 setcanvscroll
265 getcommits
266 return 0
269 # This makes a string representation of a positive integer which
270 # sorts as a string in numerical order
271 proc strrep {n} {
272 if {$n < 16} {
273 return [format "%x" $n]
274 } elseif {$n < 256} {
275 return [format "x%.2x" $n]
276 } elseif {$n < 65536} {
277 return [format "y%.4x" $n]
279 return [format "z%.8x" $n]
282 # Procedures used in reordering commits from git log (without
283 # --topo-order) into the order for display.
285 proc varcinit {view} {
286 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
287 global vtokmod varcmod vrowmod varcix vlastins
289 set varcstart($view) {{}}
290 set vupptr($view) {0}
291 set vdownptr($view) {0}
292 set vleftptr($view) {0}
293 set vbackptr($view) {0}
294 set varctok($view) {{}}
295 set varcrow($view) {{}}
296 set vtokmod($view) {}
297 set varcmod($view) 0
298 set vrowmod($view) 0
299 set varcix($view) {{}}
300 set vlastins($view) {0}
303 proc resetvarcs {view} {
304 global varcid varccommits parents children vseedcount ordertok
306 foreach vid [array names varcid $view,*] {
307 unset varcid($vid)
308 unset children($vid)
309 unset parents($vid)
311 # some commits might have children but haven't been seen yet
312 foreach vid [array names children $view,*] {
313 unset children($vid)
315 foreach va [array names varccommits $view,*] {
316 unset varccommits($va)
318 foreach vd [array names vseedcount $view,*] {
319 unset vseedcount($vd)
321 catch {unset ordertok}
324 proc newvarc {view id} {
325 global varcid varctok parents children datemode
326 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
327 global commitdata commitinfo vseedcount varccommits vlastins
329 set a [llength $varctok($view)]
330 set vid $view,$id
331 if {[llength $children($vid)] == 0 || $datemode} {
332 if {![info exists commitinfo($id)]} {
333 parsecommit $id $commitdata($id) 1
335 set cdate [lindex $commitinfo($id) 4]
336 if {![string is integer -strict $cdate]} {
337 set cdate 0
339 if {![info exists vseedcount($view,$cdate)]} {
340 set vseedcount($view,$cdate) -1
342 set c [incr vseedcount($view,$cdate)]
343 set cdate [expr {$cdate ^ 0xffffffff}]
344 set tok "s[strrep $cdate][strrep $c]"
345 } else {
346 set tok {}
348 set ka 0
349 if {[llength $children($vid)] > 0} {
350 set kid [lindex $children($vid) end]
351 set k $varcid($view,$kid)
352 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
353 set ki $kid
354 set ka $k
355 set tok [lindex $varctok($view) $k]
358 if {$ka != 0} {
359 set i [lsearch -exact $parents($view,$ki) $id]
360 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
361 append tok [strrep $j]
363 set c [lindex $vlastins($view) $ka]
364 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
365 set c $ka
366 set b [lindex $vdownptr($view) $ka]
367 } else {
368 set b [lindex $vleftptr($view) $c]
370 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
371 set c $b
372 set b [lindex $vleftptr($view) $c]
374 if {$c == $ka} {
375 lset vdownptr($view) $ka $a
376 lappend vbackptr($view) 0
377 } else {
378 lset vleftptr($view) $c $a
379 lappend vbackptr($view) $c
381 lset vlastins($view) $ka $a
382 lappend vupptr($view) $ka
383 lappend vleftptr($view) $b
384 if {$b != 0} {
385 lset vbackptr($view) $b $a
387 lappend varctok($view) $tok
388 lappend varcstart($view) $id
389 lappend vdownptr($view) 0
390 lappend varcrow($view) {}
391 lappend varcix($view) {}
392 set varccommits($view,$a) {}
393 lappend vlastins($view) 0
394 return $a
397 proc splitvarc {p v} {
398 global varcid varcstart varccommits varctok
399 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
401 set oa $varcid($v,$p)
402 set ac $varccommits($v,$oa)
403 set i [lsearch -exact $varccommits($v,$oa) $p]
404 if {$i <= 0} return
405 set na [llength $varctok($v)]
406 # "%" sorts before "0"...
407 set tok "[lindex $varctok($v) $oa]%[strrep $i]"
408 lappend varctok($v) $tok
409 lappend varcrow($v) {}
410 lappend varcix($v) {}
411 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
412 set varccommits($v,$na) [lrange $ac $i end]
413 lappend varcstart($v) $p
414 foreach id $varccommits($v,$na) {
415 set varcid($v,$id) $na
417 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
418 lset vdownptr($v) $oa $na
419 lappend vupptr($v) $oa
420 lappend vleftptr($v) 0
421 lappend vbackptr($v) 0
422 lappend vlastins($v) 0
423 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
424 lset vupptr($v) $b $na
428 proc renumbervarc {a v} {
429 global parents children varctok varcstart varccommits
430 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
432 set t1 [clock clicks -milliseconds]
433 set todo {}
434 set isrelated($a) 1
435 set kidchanged($a) 1
436 set ntot 0
437 while {$a != 0} {
438 if {[info exists isrelated($a)]} {
439 lappend todo $a
440 set id [lindex $varccommits($v,$a) end]
441 foreach p $parents($v,$id) {
442 if {[info exists varcid($v,$p)]} {
443 set isrelated($varcid($v,$p)) 1
447 incr ntot
448 set b [lindex $vdownptr($v) $a]
449 if {$b == 0} {
450 while {$a != 0} {
451 set b [lindex $vleftptr($v) $a]
452 if {$b != 0} break
453 set a [lindex $vupptr($v) $a]
456 set a $b
458 foreach a $todo {
459 if {![info exists kidchanged($a)]} continue
460 set id [lindex $varcstart($v) $a]
461 if {[llength $children($v,$id)] > 1} {
462 set children($v,$id) [lsort -command [list vtokcmp $v] \
463 $children($v,$id)]
465 set oldtok [lindex $varctok($v) $a]
466 if {!$datemode} {
467 set tok {}
468 } else {
469 set tok $oldtok
471 set ka 0
472 set kid [last_real_child $v,$id]
473 if {$kid ne {}} {
474 set k $varcid($v,$kid)
475 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
476 set ki $kid
477 set ka $k
478 set tok [lindex $varctok($v) $k]
481 if {$ka != 0} {
482 set i [lsearch -exact $parents($v,$ki) $id]
483 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
484 append tok [strrep $j]
486 if {$tok eq $oldtok} {
487 continue
489 set id [lindex $varccommits($v,$a) end]
490 foreach p $parents($v,$id) {
491 if {[info exists varcid($v,$p)]} {
492 set kidchanged($varcid($v,$p)) 1
493 } else {
494 set sortkids($p) 1
497 lset varctok($v) $a $tok
498 set b [lindex $vupptr($v) $a]
499 if {$b != $ka} {
500 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
501 modify_arc $v $ka
503 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
504 modify_arc $v $b
506 set c [lindex $vbackptr($v) $a]
507 set d [lindex $vleftptr($v) $a]
508 if {$c == 0} {
509 lset vdownptr($v) $b $d
510 } else {
511 lset vleftptr($v) $c $d
513 if {$d != 0} {
514 lset vbackptr($v) $d $c
516 lset vupptr($v) $a $ka
517 set c [lindex $vlastins($v) $ka]
518 if {$c == 0 || \
519 [string compare $tok [lindex $varctok($v) $c]] < 0} {
520 set c $ka
521 set b [lindex $vdownptr($v) $ka]
522 } else {
523 set b [lindex $vleftptr($v) $c]
525 while {$b != 0 && \
526 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
527 set c $b
528 set b [lindex $vleftptr($v) $c]
530 if {$c == $ka} {
531 lset vdownptr($v) $ka $a
532 lset vbackptr($v) $a 0
533 } else {
534 lset vleftptr($v) $c $a
535 lset vbackptr($v) $a $c
537 lset vleftptr($v) $a $b
538 if {$b != 0} {
539 lset vbackptr($v) $b $a
541 lset vlastins($v) $ka $a
544 foreach id [array names sortkids] {
545 if {[llength $children($v,$id)] > 1} {
546 set children($v,$id) [lsort -command [list vtokcmp $v] \
547 $children($v,$id)]
550 set t2 [clock clicks -milliseconds]
551 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
554 proc fix_reversal {p a v} {
555 global varcid varcstart varctok vupptr
557 set pa $varcid($v,$p)
558 if {$p ne [lindex $varcstart($v) $pa]} {
559 splitvarc $p $v
560 set pa $varcid($v,$p)
562 # seeds always need to be renumbered
563 if {[lindex $vupptr($v) $pa] == 0 ||
564 [string compare [lindex $varctok($v) $a] \
565 [lindex $varctok($v) $pa]] > 0} {
566 renumbervarc $pa $v
570 proc insertrow {id p v} {
571 global cmitlisted children parents varcid varctok vtokmod
572 global varccommits ordertok commitidx numcommits curview
573 global targetid targetrow
575 readcommit $id
576 set vid $v,$id
577 set cmitlisted($vid) 1
578 set children($vid) {}
579 set parents($vid) [list $p]
580 set a [newvarc $v $id]
581 set varcid($vid) $a
582 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
583 modify_arc $v $a
585 lappend varccommits($v,$a) $id
586 set vp $v,$p
587 if {[llength [lappend children($vp) $id]] > 1} {
588 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
589 catch {unset ordertok}
591 fix_reversal $p $a $v
592 incr commitidx($v)
593 if {$v == $curview} {
594 set numcommits $commitidx($v)
595 setcanvscroll
596 if {[info exists targetid]} {
597 if {![comes_before $targetid $p]} {
598 incr targetrow
604 proc insertfakerow {id p} {
605 global varcid varccommits parents children cmitlisted
606 global commitidx varctok vtokmod targetid targetrow curview numcommits
608 set v $curview
609 set a $varcid($v,$p)
610 set i [lsearch -exact $varccommits($v,$a) $p]
611 if {$i < 0} {
612 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
613 return
615 set children($v,$id) {}
616 set parents($v,$id) [list $p]
617 set varcid($v,$id) $a
618 lappend children($v,$p) $id
619 set cmitlisted($v,$id) 1
620 set numcommits [incr commitidx($v)]
621 # note we deliberately don't update varcstart($v) even if $i == 0
622 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
623 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
624 modify_arc $v $a $i
626 if {[info exists targetid]} {
627 if {![comes_before $targetid $p]} {
628 incr targetrow
631 setcanvscroll
632 drawvisible
635 proc removefakerow {id} {
636 global varcid varccommits parents children commitidx
637 global varctok vtokmod cmitlisted currentid selectedline
638 global targetid curview numcommits
640 set v $curview
641 if {[llength $parents($v,$id)] != 1} {
642 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
643 return
645 set p [lindex $parents($v,$id) 0]
646 set a $varcid($v,$id)
647 set i [lsearch -exact $varccommits($v,$a) $id]
648 if {$i < 0} {
649 puts "oops: removefakerow can't find [shortids $id] on arc $a"
650 return
652 unset varcid($v,$id)
653 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
654 unset parents($v,$id)
655 unset children($v,$id)
656 unset cmitlisted($v,$id)
657 set numcommits [incr commitidx($v) -1]
658 set j [lsearch -exact $children($v,$p) $id]
659 if {$j >= 0} {
660 set children($v,$p) [lreplace $children($v,$p) $j $j]
662 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
663 modify_arc $v $a $i
665 if {[info exist currentid] && $id eq $currentid} {
666 unset currentid
667 unset selectedline
669 if {[info exists targetid] && $targetid eq $id} {
670 set targetid $p
672 setcanvscroll
673 drawvisible
676 proc first_real_child {vp} {
677 global children nullid nullid2
679 foreach id $children($vp) {
680 if {$id ne $nullid && $id ne $nullid2} {
681 return $id
684 return {}
687 proc last_real_child {vp} {
688 global children nullid nullid2
690 set kids $children($vp)
691 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
692 set id [lindex $kids $i]
693 if {$id ne $nullid && $id ne $nullid2} {
694 return $id
697 return {}
700 proc vtokcmp {v a b} {
701 global varctok varcid
703 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
704 [lindex $varctok($v) $varcid($v,$b)]]
707 proc modify_arc {v a {lim {}}} {
708 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
710 set vtokmod($v) [lindex $varctok($v) $a]
711 set varcmod($v) $a
712 if {$v == $curview} {
713 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
714 set a [lindex $vupptr($v) $a]
715 set lim {}
717 set r 0
718 if {$a != 0} {
719 if {$lim eq {}} {
720 set lim [llength $varccommits($v,$a)]
722 set r [expr {[lindex $varcrow($v) $a] + $lim}]
724 set vrowmod($v) $r
725 undolayout $r
729 proc update_arcrows {v} {
730 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
731 global varcid vrownum varcorder varcix varccommits
732 global vupptr vdownptr vleftptr varctok
733 global displayorder parentlist curview cached_commitrow
735 set narctot [expr {[llength $varctok($v)] - 1}]
736 set a $varcmod($v)
737 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
738 # go up the tree until we find something that has a row number,
739 # or we get to a seed
740 set a [lindex $vupptr($v) $a]
742 if {$a == 0} {
743 set a [lindex $vdownptr($v) 0]
744 if {$a == 0} return
745 set vrownum($v) {0}
746 set varcorder($v) [list $a]
747 lset varcix($v) $a 0
748 lset varcrow($v) $a 0
749 set arcn 0
750 set row 0
751 } else {
752 set arcn [lindex $varcix($v) $a]
753 # see if a is the last arc; if so, nothing to do
754 if {$arcn == $narctot - 1} {
755 return
757 if {[llength $vrownum($v)] > $arcn + 1} {
758 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
759 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
761 set row [lindex $varcrow($v) $a]
763 if {$v == $curview} {
764 if {[llength $displayorder] > $vrowmod($v)} {
765 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
766 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
768 catch {unset cached_commitrow}
770 while {1} {
771 set p $a
772 incr row [llength $varccommits($v,$a)]
773 # go down if possible
774 set b [lindex $vdownptr($v) $a]
775 if {$b == 0} {
776 # if not, go left, or go up until we can go left
777 while {$a != 0} {
778 set b [lindex $vleftptr($v) $a]
779 if {$b != 0} break
780 set a [lindex $vupptr($v) $a]
782 if {$a == 0} break
784 set a $b
785 incr arcn
786 lappend vrownum($v) $row
787 lappend varcorder($v) $a
788 lset varcix($v) $a $arcn
789 lset varcrow($v) $a $row
791 set vtokmod($v) [lindex $varctok($v) $p]
792 set varcmod($v) $p
793 set vrowmod($v) $row
794 if {[info exists currentid]} {
795 set selectedline [rowofcommit $currentid]
799 # Test whether view $v contains commit $id
800 proc commitinview {id v} {
801 global varcid
803 return [info exists varcid($v,$id)]
806 # Return the row number for commit $id in the current view
807 proc rowofcommit {id} {
808 global varcid varccommits varcrow curview cached_commitrow
809 global varctok vtokmod
811 set v $curview
812 if {![info exists varcid($v,$id)]} {
813 puts "oops rowofcommit no arc for [shortids $id]"
814 return {}
816 set a $varcid($v,$id)
817 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
818 update_arcrows $v
820 if {[info exists cached_commitrow($id)]} {
821 return $cached_commitrow($id)
823 set i [lsearch -exact $varccommits($v,$a) $id]
824 if {$i < 0} {
825 puts "oops didn't find commit [shortids $id] in arc $a"
826 return {}
828 incr i [lindex $varcrow($v) $a]
829 set cached_commitrow($id) $i
830 return $i
833 # Returns 1 if a is on an earlier row than b, otherwise 0
834 proc comes_before {a b} {
835 global varcid varctok curview
837 set v $curview
838 if {$a eq $b || ![info exists varcid($v,$a)] || \
839 ![info exists varcid($v,$b)]} {
840 return 0
842 if {$varcid($v,$a) != $varcid($v,$b)} {
843 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
844 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
846 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
849 proc bsearch {l elt} {
850 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
851 return 0
853 set lo 0
854 set hi [llength $l]
855 while {$hi - $lo > 1} {
856 set mid [expr {int(($lo + $hi) / 2)}]
857 set t [lindex $l $mid]
858 if {$elt < $t} {
859 set hi $mid
860 } elseif {$elt > $t} {
861 set lo $mid
862 } else {
863 return $mid
866 return $lo
869 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
870 proc make_disporder {start end} {
871 global vrownum curview commitidx displayorder parentlist
872 global varccommits varcorder parents vrowmod varcrow
873 global d_valid_start d_valid_end
875 if {$end > $vrowmod($curview)} {
876 update_arcrows $curview
878 set ai [bsearch $vrownum($curview) $start]
879 set start [lindex $vrownum($curview) $ai]
880 set narc [llength $vrownum($curview)]
881 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
882 set a [lindex $varcorder($curview) $ai]
883 set l [llength $displayorder]
884 set al [llength $varccommits($curview,$a)]
885 if {$l < $r + $al} {
886 if {$l < $r} {
887 set pad [ntimes [expr {$r - $l}] {}]
888 set displayorder [concat $displayorder $pad]
889 set parentlist [concat $parentlist $pad]
890 } elseif {$l > $r} {
891 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
892 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
894 foreach id $varccommits($curview,$a) {
895 lappend displayorder $id
896 lappend parentlist $parents($curview,$id)
898 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
899 set i $r
900 foreach id $varccommits($curview,$a) {
901 lset displayorder $i $id
902 lset parentlist $i $parents($curview,$id)
903 incr i
906 incr r $al
910 proc commitonrow {row} {
911 global displayorder
913 set id [lindex $displayorder $row]
914 if {$id eq {}} {
915 make_disporder $row [expr {$row + 1}]
916 set id [lindex $displayorder $row]
918 return $id
921 proc closevarcs {v} {
922 global varctok varccommits varcid parents children
923 global cmitlisted commitidx commitinterest vtokmod
925 set missing_parents 0
926 set scripts {}
927 set narcs [llength $varctok($v)]
928 for {set a 1} {$a < $narcs} {incr a} {
929 set id [lindex $varccommits($v,$a) end]
930 foreach p $parents($v,$id) {
931 if {[info exists varcid($v,$p)]} continue
932 # add p as a new commit
933 incr missing_parents
934 set cmitlisted($v,$p) 0
935 set parents($v,$p) {}
936 if {[llength $children($v,$p)] == 1 &&
937 [llength $parents($v,$id)] == 1} {
938 set b $a
939 } else {
940 set b [newvarc $v $p]
942 set varcid($v,$p) $b
943 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
944 modify_arc $v $b
946 lappend varccommits($v,$b) $p
947 incr commitidx($v)
948 if {[info exists commitinterest($p)]} {
949 foreach script $commitinterest($p) {
950 lappend scripts [string map [list "%I" $p] $script]
952 unset commitinterest($id)
956 if {$missing_parents > 0} {
957 foreach s $scripts {
958 eval $s
963 proc getcommitlines {fd inst view} {
964 global cmitlisted commitinterest leftover
965 global commitidx commitdata datemode
966 global parents children curview hlview
967 global vnextroot idpending ordertok
968 global varccommits varcid varctok vtokmod
970 set stuff [read $fd 500000]
971 # git log doesn't terminate the last commit with a null...
972 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
973 set stuff "\0"
975 if {$stuff == {}} {
976 if {![eof $fd]} {
977 return 1
979 global commfd viewcomplete viewactive viewname progresscoords
980 global viewinstances
981 unset commfd($inst)
982 set i [lsearch -exact $viewinstances($view) $inst]
983 if {$i >= 0} {
984 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
986 # set it blocking so we wait for the process to terminate
987 fconfigure $fd -blocking 1
988 if {[catch {close $fd} err]} {
989 set fv {}
990 if {$view != $curview} {
991 set fv " for the \"$viewname($view)\" view"
993 if {[string range $err 0 4] == "usage"} {
994 set err "Gitk: error reading commits$fv:\
995 bad arguments to git rev-list."
996 if {$viewname($view) eq "Command line"} {
997 append err \
998 " (Note: arguments to gitk are passed to git rev-list\
999 to allow selection of commits to be displayed.)"
1001 } else {
1002 set err "Error reading commits$fv: $err"
1004 error_popup $err
1006 if {[incr viewactive($view) -1] <= 0} {
1007 set viewcomplete($view) 1
1008 # Check if we have seen any ids listed as parents that haven't
1009 # appeared in the list
1010 closevarcs $view
1011 notbusy $view
1012 set progresscoords {0 0}
1013 adjustprogress
1015 if {$view == $curview} {
1016 run chewcommits $view
1018 return 0
1020 set start 0
1021 set gotsome 0
1022 set scripts {}
1023 while 1 {
1024 set i [string first "\0" $stuff $start]
1025 if {$i < 0} {
1026 append leftover($inst) [string range $stuff $start end]
1027 break
1029 if {$start == 0} {
1030 set cmit $leftover($inst)
1031 append cmit [string range $stuff 0 [expr {$i - 1}]]
1032 set leftover($inst) {}
1033 } else {
1034 set cmit [string range $stuff $start [expr {$i - 1}]]
1036 set start [expr {$i + 1}]
1037 set j [string first "\n" $cmit]
1038 set ok 0
1039 set listed 1
1040 if {$j >= 0 && [string match "commit *" $cmit]} {
1041 set ids [string range $cmit 7 [expr {$j - 1}]]
1042 if {[string match {[-<>]*} $ids]} {
1043 switch -- [string index $ids 0] {
1044 "-" {set listed 0}
1045 "<" {set listed 2}
1046 ">" {set listed 3}
1048 set ids [string range $ids 1 end]
1050 set ok 1
1051 foreach id $ids {
1052 if {[string length $id] != 40} {
1053 set ok 0
1054 break
1058 if {!$ok} {
1059 set shortcmit $cmit
1060 if {[string length $shortcmit] > 80} {
1061 set shortcmit "[string range $shortcmit 0 80]..."
1063 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1064 exit 1
1066 set id [lindex $ids 0]
1067 set vid $view,$id
1068 set a 0
1069 if {[info exists varcid($vid)]} {
1070 if {$cmitlisted($vid) || !$listed} continue
1071 set a $varcid($vid)
1073 if {$listed} {
1074 set olds [lrange $ids 1 end]
1075 } else {
1076 set olds {}
1078 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1079 set cmitlisted($vid) $listed
1080 set parents($vid) $olds
1081 if {![info exists children($vid)]} {
1082 set children($vid) {}
1083 } elseif {$a == 0 && [llength $children($vid)] == 1} {
1084 set k [lindex $children($vid) 0]
1085 if {[llength $parents($view,$k)] == 1 &&
1086 (!$datemode ||
1087 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1088 set a $varcid($view,$k)
1091 if {$a == 0} {
1092 # new arc
1093 set a [newvarc $view $id]
1095 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1096 modify_arc $view $a
1098 if {![info exists varcid($vid)]} {
1099 set varcid($vid) $a
1100 lappend varccommits($view,$a) $id
1101 incr commitidx($view)
1104 set i 0
1105 foreach p $olds {
1106 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1107 set vp $view,$p
1108 if {[llength [lappend children($vp) $id]] > 1 &&
1109 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1110 set children($vp) [lsort -command [list vtokcmp $view] \
1111 $children($vp)]
1112 catch {unset ordertok}
1114 if {[info exists varcid($view,$p)]} {
1115 fix_reversal $p $a $view
1118 incr i
1121 if {[info exists commitinterest($id)]} {
1122 foreach script $commitinterest($id) {
1123 lappend scripts [string map [list "%I" $id] $script]
1125 unset commitinterest($id)
1127 set gotsome 1
1129 if {$gotsome} {
1130 run chewcommits $view
1131 foreach s $scripts {
1132 eval $s
1134 if {$view == $curview} {
1135 # update progress bar
1136 global progressdirn progresscoords proglastnc
1137 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1138 set proglastnc $commitidx($view)
1139 set l [lindex $progresscoords 0]
1140 set r [lindex $progresscoords 1]
1141 if {$progressdirn} {
1142 set r [expr {$r + $inc}]
1143 if {$r >= 1.0} {
1144 set r 1.0
1145 set progressdirn 0
1147 if {$r > 0.2} {
1148 set l [expr {$r - 0.2}]
1150 } else {
1151 set l [expr {$l - $inc}]
1152 if {$l <= 0.0} {
1153 set l 0.0
1154 set progressdirn 1
1156 set r [expr {$l + 0.2}]
1158 set progresscoords [list $l $r]
1159 adjustprogress
1162 return 2
1165 proc chewcommits {view} {
1166 global curview hlview viewcomplete
1167 global pending_select
1169 if {$view == $curview} {
1170 layoutmore
1171 if {$viewcomplete($view)} {
1172 global commitidx varctok
1173 global numcommits startmsecs
1174 global mainheadid commitinfo nullid
1176 if {[info exists pending_select]} {
1177 set row [first_real_row]
1178 selectline $row 1
1180 if {$commitidx($curview) > 0} {
1181 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1182 #puts "overall $ms ms for $numcommits commits"
1183 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1184 } else {
1185 show_status [mc "No commits selected"]
1187 notbusy layout
1190 if {[info exists hlview] && $view == $hlview} {
1191 vhighlightmore
1193 return 0
1196 proc readcommit {id} {
1197 if {[catch {set contents [exec git cat-file commit $id]}]} return
1198 parsecommit $id $contents 0
1201 proc parsecommit {id contents listed} {
1202 global commitinfo cdate
1204 set inhdr 1
1205 set comment {}
1206 set headline {}
1207 set auname {}
1208 set audate {}
1209 set comname {}
1210 set comdate {}
1211 set hdrend [string first "\n\n" $contents]
1212 if {$hdrend < 0} {
1213 # should never happen...
1214 set hdrend [string length $contents]
1216 set header [string range $contents 0 [expr {$hdrend - 1}]]
1217 set comment [string range $contents [expr {$hdrend + 2}] end]
1218 foreach line [split $header "\n"] {
1219 set tag [lindex $line 0]
1220 if {$tag == "author"} {
1221 set audate [lindex $line end-1]
1222 set auname [lrange $line 1 end-2]
1223 } elseif {$tag == "committer"} {
1224 set comdate [lindex $line end-1]
1225 set comname [lrange $line 1 end-2]
1228 set headline {}
1229 # take the first non-blank line of the comment as the headline
1230 set headline [string trimleft $comment]
1231 set i [string first "\n" $headline]
1232 if {$i >= 0} {
1233 set headline [string range $headline 0 $i]
1235 set headline [string trimright $headline]
1236 set i [string first "\r" $headline]
1237 if {$i >= 0} {
1238 set headline [string trimright [string range $headline 0 $i]]
1240 if {!$listed} {
1241 # git rev-list indents the comment by 4 spaces;
1242 # if we got this via git cat-file, add the indentation
1243 set newcomment {}
1244 foreach line [split $comment "\n"] {
1245 append newcomment " "
1246 append newcomment $line
1247 append newcomment "\n"
1249 set comment $newcomment
1251 if {$comdate != {}} {
1252 set cdate($id) $comdate
1254 set commitinfo($id) [list $headline $auname $audate \
1255 $comname $comdate $comment]
1258 proc getcommit {id} {
1259 global commitdata commitinfo
1261 if {[info exists commitdata($id)]} {
1262 parsecommit $id $commitdata($id) 1
1263 } else {
1264 readcommit $id
1265 if {![info exists commitinfo($id)]} {
1266 set commitinfo($id) [list [mc "No commit information available"]]
1269 return 1
1272 proc readrefs {} {
1273 global tagids idtags headids idheads tagobjid
1274 global otherrefids idotherrefs mainhead mainheadid
1276 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1277 catch {unset $v}
1279 set refd [open [list | git show-ref -d] r]
1280 while {[gets $refd line] >= 0} {
1281 if {[string index $line 40] ne " "} continue
1282 set id [string range $line 0 39]
1283 set ref [string range $line 41 end]
1284 if {![string match "refs/*" $ref]} continue
1285 set name [string range $ref 5 end]
1286 if {[string match "remotes/*" $name]} {
1287 if {![string match "*/HEAD" $name]} {
1288 set headids($name) $id
1289 lappend idheads($id) $name
1291 } elseif {[string match "heads/*" $name]} {
1292 set name [string range $name 6 end]
1293 set headids($name) $id
1294 lappend idheads($id) $name
1295 } elseif {[string match "tags/*" $name]} {
1296 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1297 # which is what we want since the former is the commit ID
1298 set name [string range $name 5 end]
1299 if {[string match "*^{}" $name]} {
1300 set name [string range $name 0 end-3]
1301 } else {
1302 set tagobjid($name) $id
1304 set tagids($name) $id
1305 lappend idtags($id) $name
1306 } else {
1307 set otherrefids($name) $id
1308 lappend idotherrefs($id) $name
1311 catch {close $refd}
1312 set mainhead {}
1313 set mainheadid {}
1314 catch {
1315 set thehead [exec git symbolic-ref HEAD]
1316 if {[string match "refs/heads/*" $thehead]} {
1317 set mainhead [string range $thehead 11 end]
1318 if {[info exists headids($mainhead)]} {
1319 set mainheadid $headids($mainhead)
1325 # skip over fake commits
1326 proc first_real_row {} {
1327 global nullid nullid2 numcommits
1329 for {set row 0} {$row < $numcommits} {incr row} {
1330 set id [commitonrow $row]
1331 if {$id ne $nullid && $id ne $nullid2} {
1332 break
1335 return $row
1338 # update things for a head moved to a child of its previous location
1339 proc movehead {id name} {
1340 global headids idheads
1342 removehead $headids($name) $name
1343 set headids($name) $id
1344 lappend idheads($id) $name
1347 # update things when a head has been removed
1348 proc removehead {id name} {
1349 global headids idheads
1351 if {$idheads($id) eq $name} {
1352 unset idheads($id)
1353 } else {
1354 set i [lsearch -exact $idheads($id) $name]
1355 if {$i >= 0} {
1356 set idheads($id) [lreplace $idheads($id) $i $i]
1359 unset headids($name)
1362 proc show_error {w top msg} {
1363 message $w.m -text $msg -justify center -aspect 400
1364 pack $w.m -side top -fill x -padx 20 -pady 20
1365 button $w.ok -text [mc OK] -command "destroy $top"
1366 pack $w.ok -side bottom -fill x
1367 bind $top <Visibility> "grab $top; focus $top"
1368 bind $top <Key-Return> "destroy $top"
1369 tkwait window $top
1372 proc error_popup msg {
1373 set w .error
1374 toplevel $w
1375 wm transient $w .
1376 show_error $w $w $msg
1379 proc confirm_popup msg {
1380 global confirm_ok
1381 set confirm_ok 0
1382 set w .confirm
1383 toplevel $w
1384 wm transient $w .
1385 message $w.m -text $msg -justify center -aspect 400
1386 pack $w.m -side top -fill x -padx 20 -pady 20
1387 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1388 pack $w.ok -side left -fill x
1389 button $w.cancel -text [mc Cancel] -command "destroy $w"
1390 pack $w.cancel -side right -fill x
1391 bind $w <Visibility> "grab $w; focus $w"
1392 tkwait window $w
1393 return $confirm_ok
1396 proc setoptions {} {
1397 option add *Panedwindow.showHandle 1 startupFile
1398 option add *Panedwindow.sashRelief raised startupFile
1399 option add *Button.font uifont startupFile
1400 option add *Checkbutton.font uifont startupFile
1401 option add *Radiobutton.font uifont startupFile
1402 option add *Menu.font uifont startupFile
1403 option add *Menubutton.font uifont startupFile
1404 option add *Label.font uifont startupFile
1405 option add *Message.font uifont startupFile
1406 option add *Entry.font uifont startupFile
1409 proc makewindow {} {
1410 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1411 global tabstop
1412 global findtype findtypemenu findloc findstring fstring geometry
1413 global entries sha1entry sha1string sha1but
1414 global diffcontextstring diffcontext
1415 global maincursor textcursor curtextcursor
1416 global rowctxmenu fakerowmenu mergemax wrapcomment
1417 global highlight_files gdttype
1418 global searchstring sstring
1419 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1420 global headctxmenu progresscanv progressitem progresscoords statusw
1421 global fprogitem fprogcoord lastprogupdate progupdatepending
1422 global rprogitem rprogcoord
1423 global have_tk85
1425 menu .bar
1426 .bar add cascade -label [mc "File"] -menu .bar.file
1427 menu .bar.file
1428 .bar.file add command -label [mc "Update"] -command updatecommits
1429 .bar.file add command -label [mc "Reload"] -command reloadcommits
1430 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1431 .bar.file add command -label [mc "List references"] -command showrefs
1432 .bar.file add command -label [mc "Quit"] -command doquit
1433 menu .bar.edit
1434 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1435 .bar.edit add command -label [mc "Preferences"] -command doprefs
1437 menu .bar.view
1438 .bar add cascade -label [mc "View"] -menu .bar.view
1439 .bar.view add command -label [mc "New view..."] -command {newview 0}
1440 .bar.view add command -label [mc "Edit view..."] -command editview \
1441 -state disabled
1442 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
1443 .bar.view add separator
1444 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
1445 -variable selectedview -value 0
1447 menu .bar.help
1448 .bar add cascade -label [mc "Help"] -menu .bar.help
1449 .bar.help add command -label [mc "About gitk"] -command about
1450 .bar.help add command -label [mc "Key bindings"] -command keys
1451 .bar.help configure
1452 . configure -menu .bar
1454 # the gui has upper and lower half, parts of a paned window.
1455 panedwindow .ctop -orient vertical
1457 # possibly use assumed geometry
1458 if {![info exists geometry(pwsash0)]} {
1459 set geometry(topheight) [expr {15 * $linespc}]
1460 set geometry(topwidth) [expr {80 * $charspc}]
1461 set geometry(botheight) [expr {15 * $linespc}]
1462 set geometry(botwidth) [expr {50 * $charspc}]
1463 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1464 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1467 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1468 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1469 frame .tf.histframe
1470 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1472 # create three canvases
1473 set cscroll .tf.histframe.csb
1474 set canv .tf.histframe.pwclist.canv
1475 canvas $canv \
1476 -selectbackground $selectbgcolor \
1477 -background $bgcolor -bd 0 \
1478 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1479 .tf.histframe.pwclist add $canv
1480 set canv2 .tf.histframe.pwclist.canv2
1481 canvas $canv2 \
1482 -selectbackground $selectbgcolor \
1483 -background $bgcolor -bd 0 -yscrollincr $linespc
1484 .tf.histframe.pwclist add $canv2
1485 set canv3 .tf.histframe.pwclist.canv3
1486 canvas $canv3 \
1487 -selectbackground $selectbgcolor \
1488 -background $bgcolor -bd 0 -yscrollincr $linespc
1489 .tf.histframe.pwclist add $canv3
1490 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1491 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1493 # a scroll bar to rule them
1494 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1495 pack $cscroll -side right -fill y
1496 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1497 lappend bglist $canv $canv2 $canv3
1498 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1500 # we have two button bars at bottom of top frame. Bar 1
1501 frame .tf.bar
1502 frame .tf.lbar -height 15
1504 set sha1entry .tf.bar.sha1
1505 set entries $sha1entry
1506 set sha1but .tf.bar.sha1label
1507 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1508 -command gotocommit -width 8
1509 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1510 pack .tf.bar.sha1label -side left
1511 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1512 trace add variable sha1string write sha1change
1513 pack $sha1entry -side left -pady 2
1515 image create bitmap bm-left -data {
1516 #define left_width 16
1517 #define left_height 16
1518 static unsigned char left_bits[] = {
1519 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1520 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1521 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1523 image create bitmap bm-right -data {
1524 #define right_width 16
1525 #define right_height 16
1526 static unsigned char right_bits[] = {
1527 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1528 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1529 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1531 button .tf.bar.leftbut -image bm-left -command goback \
1532 -state disabled -width 26
1533 pack .tf.bar.leftbut -side left -fill y
1534 button .tf.bar.rightbut -image bm-right -command goforw \
1535 -state disabled -width 26
1536 pack .tf.bar.rightbut -side left -fill y
1538 # Status label and progress bar
1539 set statusw .tf.bar.status
1540 label $statusw -width 15 -relief sunken
1541 pack $statusw -side left -padx 5
1542 set h [expr {[font metrics uifont -linespace] + 2}]
1543 set progresscanv .tf.bar.progress
1544 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1545 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1546 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1547 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1548 pack $progresscanv -side right -expand 1 -fill x
1549 set progresscoords {0 0}
1550 set fprogcoord 0
1551 set rprogcoord 0
1552 bind $progresscanv <Configure> adjustprogress
1553 set lastprogupdate [clock clicks -milliseconds]
1554 set progupdatepending 0
1556 # build up the bottom bar of upper window
1557 label .tf.lbar.flabel -text "[mc "Find"] "
1558 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1559 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1560 label .tf.lbar.flab2 -text " [mc "commit"] "
1561 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1562 -side left -fill y
1563 set gdttype [mc "containing:"]
1564 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1565 [mc "containing:"] \
1566 [mc "touching paths:"] \
1567 [mc "adding/removing string:"]]
1568 trace add variable gdttype write gdttype_change
1569 pack .tf.lbar.gdttype -side left -fill y
1571 set findstring {}
1572 set fstring .tf.lbar.findstring
1573 lappend entries $fstring
1574 entry $fstring -width 30 -font textfont -textvariable findstring
1575 trace add variable findstring write find_change
1576 set findtype [mc "Exact"]
1577 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1578 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
1579 trace add variable findtype write findcom_change
1580 set findloc [mc "All fields"]
1581 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1582 [mc "Comments"] [mc "Author"] [mc "Committer"]
1583 trace add variable findloc write find_change
1584 pack .tf.lbar.findloc -side right
1585 pack .tf.lbar.findtype -side right
1586 pack $fstring -side left -expand 1 -fill x
1588 # Finish putting the upper half of the viewer together
1589 pack .tf.lbar -in .tf -side bottom -fill x
1590 pack .tf.bar -in .tf -side bottom -fill x
1591 pack .tf.histframe -fill both -side top -expand 1
1592 .ctop add .tf
1593 .ctop paneconfigure .tf -height $geometry(topheight)
1594 .ctop paneconfigure .tf -width $geometry(topwidth)
1596 # now build up the bottom
1597 panedwindow .pwbottom -orient horizontal
1599 # lower left, a text box over search bar, scroll bar to the right
1600 # if we know window height, then that will set the lower text height, otherwise
1601 # we set lower text height which will drive window height
1602 if {[info exists geometry(main)]} {
1603 frame .bleft -width $geometry(botwidth)
1604 } else {
1605 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1607 frame .bleft.top
1608 frame .bleft.mid
1610 button .bleft.top.search -text [mc "Search"] -command dosearch
1611 pack .bleft.top.search -side left -padx 5
1612 set sstring .bleft.top.sstring
1613 entry $sstring -width 20 -font textfont -textvariable searchstring
1614 lappend entries $sstring
1615 trace add variable searchstring write incrsearch
1616 pack $sstring -side left -expand 1 -fill x
1617 radiobutton .bleft.mid.diff -text [mc "Diff"] \
1618 -command changediffdisp -variable diffelide -value {0 0}
1619 radiobutton .bleft.mid.old -text [mc "Old version"] \
1620 -command changediffdisp -variable diffelide -value {0 1}
1621 radiobutton .bleft.mid.new -text [mc "New version"] \
1622 -command changediffdisp -variable diffelide -value {1 0}
1623 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
1624 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1625 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1626 -from 1 -increment 1 -to 10000000 \
1627 -validate all -validatecommand "diffcontextvalidate %P" \
1628 -textvariable diffcontextstring
1629 .bleft.mid.diffcontext set $diffcontext
1630 trace add variable diffcontextstring write diffcontextchange
1631 lappend entries .bleft.mid.diffcontext
1632 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1633 set ctext .bleft.ctext
1634 text $ctext -background $bgcolor -foreground $fgcolor \
1635 -state disabled -font textfont \
1636 -yscrollcommand scrolltext -wrap none
1637 if {$have_tk85} {
1638 $ctext conf -tabstyle wordprocessor
1640 scrollbar .bleft.sb -command "$ctext yview"
1641 pack .bleft.top -side top -fill x
1642 pack .bleft.mid -side top -fill x
1643 pack .bleft.sb -side right -fill y
1644 pack $ctext -side left -fill both -expand 1
1645 lappend bglist $ctext
1646 lappend fglist $ctext
1648 $ctext tag conf comment -wrap $wrapcomment
1649 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
1650 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1651 $ctext tag conf d0 -fore [lindex $diffcolors 0]
1652 $ctext tag conf d1 -fore [lindex $diffcolors 1]
1653 $ctext tag conf m0 -fore red
1654 $ctext tag conf m1 -fore blue
1655 $ctext tag conf m2 -fore green
1656 $ctext tag conf m3 -fore purple
1657 $ctext tag conf m4 -fore brown
1658 $ctext tag conf m5 -fore "#009090"
1659 $ctext tag conf m6 -fore magenta
1660 $ctext tag conf m7 -fore "#808000"
1661 $ctext tag conf m8 -fore "#009000"
1662 $ctext tag conf m9 -fore "#ff0080"
1663 $ctext tag conf m10 -fore cyan
1664 $ctext tag conf m11 -fore "#b07070"
1665 $ctext tag conf m12 -fore "#70b0f0"
1666 $ctext tag conf m13 -fore "#70f0b0"
1667 $ctext tag conf m14 -fore "#f0b070"
1668 $ctext tag conf m15 -fore "#ff70b0"
1669 $ctext tag conf mmax -fore darkgrey
1670 set mergemax 16
1671 $ctext tag conf mresult -font textfontbold
1672 $ctext tag conf msep -font textfontbold
1673 $ctext tag conf found -back yellow
1675 .pwbottom add .bleft
1676 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
1678 # lower right
1679 frame .bright
1680 frame .bright.mode
1681 radiobutton .bright.mode.patch -text [mc "Patch"] \
1682 -command reselectline -variable cmitmode -value "patch"
1683 radiobutton .bright.mode.tree -text [mc "Tree"] \
1684 -command reselectline -variable cmitmode -value "tree"
1685 grid .bright.mode.patch .bright.mode.tree -sticky ew
1686 pack .bright.mode -side top -fill x
1687 set cflist .bright.cfiles
1688 set indent [font measure mainfont "nn"]
1689 text $cflist \
1690 -selectbackground $selectbgcolor \
1691 -background $bgcolor -foreground $fgcolor \
1692 -font mainfont \
1693 -tabs [list $indent [expr {2 * $indent}]] \
1694 -yscrollcommand ".bright.sb set" \
1695 -cursor [. cget -cursor] \
1696 -spacing1 1 -spacing3 1
1697 lappend bglist $cflist
1698 lappend fglist $cflist
1699 scrollbar .bright.sb -command "$cflist yview"
1700 pack .bright.sb -side right -fill y
1701 pack $cflist -side left -fill both -expand 1
1702 $cflist tag configure highlight \
1703 -background [$cflist cget -selectbackground]
1704 $cflist tag configure bold -font mainfontbold
1706 .pwbottom add .bright
1707 .ctop add .pwbottom
1709 # restore window position if known
1710 if {[info exists geometry(main)]} {
1711 wm geometry . "$geometry(main)"
1714 if {[tk windowingsystem] eq {aqua}} {
1715 set M1B M1
1716 } else {
1717 set M1B Control
1720 bind .pwbottom <Configure> {resizecdetpanes %W %w}
1721 pack .ctop -fill both -expand 1
1722 bindall <1> {selcanvline %W %x %y}
1723 #bindall <B1-Motion> {selcanvline %W %x %y}
1724 if {[tk windowingsystem] == "win32"} {
1725 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1726 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1727 } else {
1728 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1729 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
1730 if {[tk windowingsystem] eq "aqua"} {
1731 bindall <MouseWheel> {
1732 set delta [expr {- (%D)}]
1733 allcanvs yview scroll $delta units
1737 bindall <2> "canvscan mark %W %x %y"
1738 bindall <B2-Motion> "canvscan dragto %W %x %y"
1739 bindkey <Home> selfirstline
1740 bindkey <End> sellastline
1741 bind . <Key-Up> "selnextline -1"
1742 bind . <Key-Down> "selnextline 1"
1743 bind . <Shift-Key-Up> "dofind -1 0"
1744 bind . <Shift-Key-Down> "dofind 1 0"
1745 bindkey <Key-Right> "goforw"
1746 bindkey <Key-Left> "goback"
1747 bind . <Key-Prior> "selnextpage -1"
1748 bind . <Key-Next> "selnextpage 1"
1749 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1750 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1751 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1752 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1753 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1754 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1755 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1756 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1757 bindkey <Key-space> "$ctext yview scroll 1 pages"
1758 bindkey p "selnextline -1"
1759 bindkey n "selnextline 1"
1760 bindkey z "goback"
1761 bindkey x "goforw"
1762 bindkey i "selnextline -1"
1763 bindkey k "selnextline 1"
1764 bindkey j "goback"
1765 bindkey l "goforw"
1766 bindkey b "$ctext yview scroll -1 pages"
1767 bindkey d "$ctext yview scroll 18 units"
1768 bindkey u "$ctext yview scroll -18 units"
1769 bindkey / {dofind 1 1}
1770 bindkey <Key-Return> {dofind 1 1}
1771 bindkey ? {dofind -1 1}
1772 bindkey f nextfile
1773 bindkey <F5> updatecommits
1774 bind . <$M1B-q> doquit
1775 bind . <$M1B-f> {dofind 1 1}
1776 bind . <$M1B-g> {dofind 1 0}
1777 bind . <$M1B-r> dosearchback
1778 bind . <$M1B-s> dosearch
1779 bind . <$M1B-equal> {incrfont 1}
1780 bind . <$M1B-KP_Add> {incrfont 1}
1781 bind . <$M1B-minus> {incrfont -1}
1782 bind . <$M1B-KP_Subtract> {incrfont -1}
1783 wm protocol . WM_DELETE_WINDOW doquit
1784 bind . <Button-1> "click %W"
1785 bind $fstring <Key-Return> {dofind 1 1}
1786 bind $sha1entry <Key-Return> gotocommit
1787 bind $sha1entry <<PasteSelection>> clearsha1
1788 bind $cflist <1> {sel_flist %W %x %y; break}
1789 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1790 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1791 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1793 set maincursor [. cget -cursor]
1794 set textcursor [$ctext cget -cursor]
1795 set curtextcursor $textcursor
1797 set rowctxmenu .rowctxmenu
1798 menu $rowctxmenu -tearoff 0
1799 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1800 -command {diffvssel 0}
1801 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1802 -command {diffvssel 1}
1803 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1804 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1805 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1806 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1807 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1808 -command cherrypick
1809 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1810 -command resethead
1812 set fakerowmenu .fakerowmenu
1813 menu $fakerowmenu -tearoff 0
1814 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1815 -command {diffvssel 0}
1816 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1817 -command {diffvssel 1}
1818 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1819 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1820 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1821 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1823 set headctxmenu .headctxmenu
1824 menu $headctxmenu -tearoff 0
1825 $headctxmenu add command -label [mc "Check out this branch"] \
1826 -command cobranch
1827 $headctxmenu add command -label [mc "Remove this branch"] \
1828 -command rmbranch
1830 global flist_menu
1831 set flist_menu .flistctxmenu
1832 menu $flist_menu -tearoff 0
1833 $flist_menu add command -label [mc "Highlight this too"] \
1834 -command {flist_hl 0}
1835 $flist_menu add command -label [mc "Highlight this only"] \
1836 -command {flist_hl 1}
1839 # Windows sends all mouse wheel events to the current focused window, not
1840 # the one where the mouse hovers, so bind those events here and redirect
1841 # to the correct window
1842 proc windows_mousewheel_redirector {W X Y D} {
1843 global canv canv2 canv3
1844 set w [winfo containing -displayof $W $X $Y]
1845 if {$w ne ""} {
1846 set u [expr {$D < 0 ? 5 : -5}]
1847 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1848 allcanvs yview scroll $u units
1849 } else {
1850 catch {
1851 $w yview scroll $u units
1857 # mouse-2 makes all windows scan vertically, but only the one
1858 # the cursor is in scans horizontally
1859 proc canvscan {op w x y} {
1860 global canv canv2 canv3
1861 foreach c [list $canv $canv2 $canv3] {
1862 if {$c == $w} {
1863 $c scan $op $x $y
1864 } else {
1865 $c scan $op 0 $y
1870 proc scrollcanv {cscroll f0 f1} {
1871 $cscroll set $f0 $f1
1872 drawvisible
1873 flushhighlights
1876 # when we make a key binding for the toplevel, make sure
1877 # it doesn't get triggered when that key is pressed in the
1878 # find string entry widget.
1879 proc bindkey {ev script} {
1880 global entries
1881 bind . $ev $script
1882 set escript [bind Entry $ev]
1883 if {$escript == {}} {
1884 set escript [bind Entry <Key>]
1886 foreach e $entries {
1887 bind $e $ev "$escript; break"
1891 # set the focus back to the toplevel for any click outside
1892 # the entry widgets
1893 proc click {w} {
1894 global ctext entries
1895 foreach e [concat $entries $ctext] {
1896 if {$w == $e} return
1898 focus .
1901 # Adjust the progress bar for a change in requested extent or canvas size
1902 proc adjustprogress {} {
1903 global progresscanv progressitem progresscoords
1904 global fprogitem fprogcoord lastprogupdate progupdatepending
1905 global rprogitem rprogcoord
1907 set w [expr {[winfo width $progresscanv] - 4}]
1908 set x0 [expr {$w * [lindex $progresscoords 0]}]
1909 set x1 [expr {$w * [lindex $progresscoords 1]}]
1910 set h [winfo height $progresscanv]
1911 $progresscanv coords $progressitem $x0 0 $x1 $h
1912 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1913 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1914 set now [clock clicks -milliseconds]
1915 if {$now >= $lastprogupdate + 100} {
1916 set progupdatepending 0
1917 update
1918 } elseif {!$progupdatepending} {
1919 set progupdatepending 1
1920 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1924 proc doprogupdate {} {
1925 global lastprogupdate progupdatepending
1927 if {$progupdatepending} {
1928 set progupdatepending 0
1929 set lastprogupdate [clock clicks -milliseconds]
1930 update
1934 proc savestuff {w} {
1935 global canv canv2 canv3 mainfont textfont uifont tabstop
1936 global stuffsaved findmergefiles maxgraphpct
1937 global maxwidth showneartags showlocalchanges
1938 global viewname viewfiles viewargs viewperm nextviewnum
1939 global cmitmode wrapcomment datetimeformat limitdiffs
1940 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1942 if {$stuffsaved} return
1943 if {![winfo viewable .]} return
1944 catch {
1945 set f [open "~/.gitk-new" w]
1946 puts $f [list set mainfont $mainfont]
1947 puts $f [list set textfont $textfont]
1948 puts $f [list set uifont $uifont]
1949 puts $f [list set tabstop $tabstop]
1950 puts $f [list set findmergefiles $findmergefiles]
1951 puts $f [list set maxgraphpct $maxgraphpct]
1952 puts $f [list set maxwidth $maxwidth]
1953 puts $f [list set cmitmode $cmitmode]
1954 puts $f [list set wrapcomment $wrapcomment]
1955 puts $f [list set showneartags $showneartags]
1956 puts $f [list set showlocalchanges $showlocalchanges]
1957 puts $f [list set datetimeformat $datetimeformat]
1958 puts $f [list set limitdiffs $limitdiffs]
1959 puts $f [list set bgcolor $bgcolor]
1960 puts $f [list set fgcolor $fgcolor]
1961 puts $f [list set colors $colors]
1962 puts $f [list set diffcolors $diffcolors]
1963 puts $f [list set diffcontext $diffcontext]
1964 puts $f [list set selectbgcolor $selectbgcolor]
1966 puts $f "set geometry(main) [wm geometry .]"
1967 puts $f "set geometry(topwidth) [winfo width .tf]"
1968 puts $f "set geometry(topheight) [winfo height .tf]"
1969 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1970 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1971 puts $f "set geometry(botwidth) [winfo width .bleft]"
1972 puts $f "set geometry(botheight) [winfo height .bleft]"
1974 puts -nonewline $f "set permviews {"
1975 for {set v 0} {$v < $nextviewnum} {incr v} {
1976 if {$viewperm($v)} {
1977 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1980 puts $f "}"
1981 close $f
1982 file rename -force "~/.gitk-new" "~/.gitk"
1984 set stuffsaved 1
1987 proc resizeclistpanes {win w} {
1988 global oldwidth
1989 if {[info exists oldwidth($win)]} {
1990 set s0 [$win sash coord 0]
1991 set s1 [$win sash coord 1]
1992 if {$w < 60} {
1993 set sash0 [expr {int($w/2 - 2)}]
1994 set sash1 [expr {int($w*5/6 - 2)}]
1995 } else {
1996 set factor [expr {1.0 * $w / $oldwidth($win)}]
1997 set sash0 [expr {int($factor * [lindex $s0 0])}]
1998 set sash1 [expr {int($factor * [lindex $s1 0])}]
1999 if {$sash0 < 30} {
2000 set sash0 30
2002 if {$sash1 < $sash0 + 20} {
2003 set sash1 [expr {$sash0 + 20}]
2005 if {$sash1 > $w - 10} {
2006 set sash1 [expr {$w - 10}]
2007 if {$sash0 > $sash1 - 20} {
2008 set sash0 [expr {$sash1 - 20}]
2012 $win sash place 0 $sash0 [lindex $s0 1]
2013 $win sash place 1 $sash1 [lindex $s1 1]
2015 set oldwidth($win) $w
2018 proc resizecdetpanes {win w} {
2019 global oldwidth
2020 if {[info exists oldwidth($win)]} {
2021 set s0 [$win sash coord 0]
2022 if {$w < 60} {
2023 set sash0 [expr {int($w*3/4 - 2)}]
2024 } else {
2025 set factor [expr {1.0 * $w / $oldwidth($win)}]
2026 set sash0 [expr {int($factor * [lindex $s0 0])}]
2027 if {$sash0 < 45} {
2028 set sash0 45
2030 if {$sash0 > $w - 15} {
2031 set sash0 [expr {$w - 15}]
2034 $win sash place 0 $sash0 [lindex $s0 1]
2036 set oldwidth($win) $w
2039 proc allcanvs args {
2040 global canv canv2 canv3
2041 eval $canv $args
2042 eval $canv2 $args
2043 eval $canv3 $args
2046 proc bindall {event action} {
2047 global canv canv2 canv3
2048 bind $canv $event $action
2049 bind $canv2 $event $action
2050 bind $canv3 $event $action
2053 proc about {} {
2054 global uifont
2055 set w .about
2056 if {[winfo exists $w]} {
2057 raise $w
2058 return
2060 toplevel $w
2061 wm title $w [mc "About gitk"]
2062 message $w.m -text [mc "
2063 Gitk - a commit viewer for git
2065 Copyright © 2005-2006 Paul Mackerras
2067 Use and redistribute under the terms of the GNU General Public License"] \
2068 -justify center -aspect 400 -border 2 -bg white -relief groove
2069 pack $w.m -side top -fill x -padx 2 -pady 2
2070 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2071 pack $w.ok -side bottom
2072 bind $w <Visibility> "focus $w.ok"
2073 bind $w <Key-Escape> "destroy $w"
2074 bind $w <Key-Return> "destroy $w"
2077 proc keys {} {
2078 set w .keys
2079 if {[winfo exists $w]} {
2080 raise $w
2081 return
2083 if {[tk windowingsystem] eq {aqua}} {
2084 set M1T Cmd
2085 } else {
2086 set M1T Ctrl
2088 toplevel $w
2089 wm title $w [mc "Gitk key bindings"]
2090 message $w.m -text [mc "
2091 Gitk key bindings:
2093 <$M1T-Q> Quit
2094 <Home> Move to first commit
2095 <End> Move to last commit
2096 <Up>, p, i Move up one commit
2097 <Down>, n, k Move down one commit
2098 <Left>, z, j Go back in history list
2099 <Right>, x, l Go forward in history list
2100 <PageUp> Move up one page in commit list
2101 <PageDown> Move down one page in commit list
2102 <$M1T-Home> Scroll to top of commit list
2103 <$M1T-End> Scroll to bottom of commit list
2104 <$M1T-Up> Scroll commit list up one line
2105 <$M1T-Down> Scroll commit list down one line
2106 <$M1T-PageUp> Scroll commit list up one page
2107 <$M1T-PageDown> Scroll commit list down one page
2108 <Shift-Up> Find backwards (upwards, later commits)
2109 <Shift-Down> Find forwards (downwards, earlier commits)
2110 <Delete>, b Scroll diff view up one page
2111 <Backspace> Scroll diff view up one page
2112 <Space> Scroll diff view down one page
2113 u Scroll diff view up 18 lines
2114 d Scroll diff view down 18 lines
2115 <$M1T-F> Find
2116 <$M1T-G> Move to next find hit
2117 <Return> Move to next find hit
2118 / Move to next find hit, or redo find
2119 ? Move to previous find hit
2120 f Scroll diff view to next file
2121 <$M1T-S> Search for next hit in diff view
2122 <$M1T-R> Search for previous hit in diff view
2123 <$M1T-KP+> Increase font size
2124 <$M1T-plus> Increase font size
2125 <$M1T-KP-> Decrease font size
2126 <$M1T-minus> Decrease font size
2127 <F5> Update
2128 "] \
2129 -justify left -bg white -border 2 -relief groove
2130 pack $w.m -side top -fill both -padx 2 -pady 2
2131 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2132 pack $w.ok -side bottom
2133 bind $w <Visibility> "focus $w.ok"
2134 bind $w <Key-Escape> "destroy $w"
2135 bind $w <Key-Return> "destroy $w"
2138 # Procedures for manipulating the file list window at the
2139 # bottom right of the overall window.
2141 proc treeview {w l openlevs} {
2142 global treecontents treediropen treeheight treeparent treeindex
2144 set ix 0
2145 set treeindex() 0
2146 set lev 0
2147 set prefix {}
2148 set prefixend -1
2149 set prefendstack {}
2150 set htstack {}
2151 set ht 0
2152 set treecontents() {}
2153 $w conf -state normal
2154 foreach f $l {
2155 while {[string range $f 0 $prefixend] ne $prefix} {
2156 if {$lev <= $openlevs} {
2157 $w mark set e:$treeindex($prefix) "end -1c"
2158 $w mark gravity e:$treeindex($prefix) left
2160 set treeheight($prefix) $ht
2161 incr ht [lindex $htstack end]
2162 set htstack [lreplace $htstack end end]
2163 set prefixend [lindex $prefendstack end]
2164 set prefendstack [lreplace $prefendstack end end]
2165 set prefix [string range $prefix 0 $prefixend]
2166 incr lev -1
2168 set tail [string range $f [expr {$prefixend+1}] end]
2169 while {[set slash [string first "/" $tail]] >= 0} {
2170 lappend htstack $ht
2171 set ht 0
2172 lappend prefendstack $prefixend
2173 incr prefixend [expr {$slash + 1}]
2174 set d [string range $tail 0 $slash]
2175 lappend treecontents($prefix) $d
2176 set oldprefix $prefix
2177 append prefix $d
2178 set treecontents($prefix) {}
2179 set treeindex($prefix) [incr ix]
2180 set treeparent($prefix) $oldprefix
2181 set tail [string range $tail [expr {$slash+1}] end]
2182 if {$lev <= $openlevs} {
2183 set ht 1
2184 set treediropen($prefix) [expr {$lev < $openlevs}]
2185 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2186 $w mark set d:$ix "end -1c"
2187 $w mark gravity d:$ix left
2188 set str "\n"
2189 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2190 $w insert end $str
2191 $w image create end -align center -image $bm -padx 1 \
2192 -name a:$ix
2193 $w insert end $d [highlight_tag $prefix]
2194 $w mark set s:$ix "end -1c"
2195 $w mark gravity s:$ix left
2197 incr lev
2199 if {$tail ne {}} {
2200 if {$lev <= $openlevs} {
2201 incr ht
2202 set str "\n"
2203 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2204 $w insert end $str
2205 $w insert end $tail [highlight_tag $f]
2207 lappend treecontents($prefix) $tail
2210 while {$htstack ne {}} {
2211 set treeheight($prefix) $ht
2212 incr ht [lindex $htstack end]
2213 set htstack [lreplace $htstack end end]
2214 set prefixend [lindex $prefendstack end]
2215 set prefendstack [lreplace $prefendstack end end]
2216 set prefix [string range $prefix 0 $prefixend]
2218 $w conf -state disabled
2221 proc linetoelt {l} {
2222 global treeheight treecontents
2224 set y 2
2225 set prefix {}
2226 while {1} {
2227 foreach e $treecontents($prefix) {
2228 if {$y == $l} {
2229 return "$prefix$e"
2231 set n 1
2232 if {[string index $e end] eq "/"} {
2233 set n $treeheight($prefix$e)
2234 if {$y + $n > $l} {
2235 append prefix $e
2236 incr y
2237 break
2240 incr y $n
2245 proc highlight_tree {y prefix} {
2246 global treeheight treecontents cflist
2248 foreach e $treecontents($prefix) {
2249 set path $prefix$e
2250 if {[highlight_tag $path] ne {}} {
2251 $cflist tag add bold $y.0 "$y.0 lineend"
2253 incr y
2254 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2255 set y [highlight_tree $y $path]
2258 return $y
2261 proc treeclosedir {w dir} {
2262 global treediropen treeheight treeparent treeindex
2264 set ix $treeindex($dir)
2265 $w conf -state normal
2266 $w delete s:$ix e:$ix
2267 set treediropen($dir) 0
2268 $w image configure a:$ix -image tri-rt
2269 $w conf -state disabled
2270 set n [expr {1 - $treeheight($dir)}]
2271 while {$dir ne {}} {
2272 incr treeheight($dir) $n
2273 set dir $treeparent($dir)
2277 proc treeopendir {w dir} {
2278 global treediropen treeheight treeparent treecontents treeindex
2280 set ix $treeindex($dir)
2281 $w conf -state normal
2282 $w image configure a:$ix -image tri-dn
2283 $w mark set e:$ix s:$ix
2284 $w mark gravity e:$ix right
2285 set lev 0
2286 set str "\n"
2287 set n [llength $treecontents($dir)]
2288 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2289 incr lev
2290 append str "\t"
2291 incr treeheight($x) $n
2293 foreach e $treecontents($dir) {
2294 set de $dir$e
2295 if {[string index $e end] eq "/"} {
2296 set iy $treeindex($de)
2297 $w mark set d:$iy e:$ix
2298 $w mark gravity d:$iy left
2299 $w insert e:$ix $str
2300 set treediropen($de) 0
2301 $w image create e:$ix -align center -image tri-rt -padx 1 \
2302 -name a:$iy
2303 $w insert e:$ix $e [highlight_tag $de]
2304 $w mark set s:$iy e:$ix
2305 $w mark gravity s:$iy left
2306 set treeheight($de) 1
2307 } else {
2308 $w insert e:$ix $str
2309 $w insert e:$ix $e [highlight_tag $de]
2312 $w mark gravity e:$ix left
2313 $w conf -state disabled
2314 set treediropen($dir) 1
2315 set top [lindex [split [$w index @0,0] .] 0]
2316 set ht [$w cget -height]
2317 set l [lindex [split [$w index s:$ix] .] 0]
2318 if {$l < $top} {
2319 $w yview $l.0
2320 } elseif {$l + $n + 1 > $top + $ht} {
2321 set top [expr {$l + $n + 2 - $ht}]
2322 if {$l < $top} {
2323 set top $l
2325 $w yview $top.0
2329 proc treeclick {w x y} {
2330 global treediropen cmitmode ctext cflist cflist_top
2332 if {$cmitmode ne "tree"} return
2333 if {![info exists cflist_top]} return
2334 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2335 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2336 $cflist tag add highlight $l.0 "$l.0 lineend"
2337 set cflist_top $l
2338 if {$l == 1} {
2339 $ctext yview 1.0
2340 return
2342 set e [linetoelt $l]
2343 if {[string index $e end] ne "/"} {
2344 showfile $e
2345 } elseif {$treediropen($e)} {
2346 treeclosedir $w $e
2347 } else {
2348 treeopendir $w $e
2352 proc setfilelist {id} {
2353 global treefilelist cflist
2355 treeview $cflist $treefilelist($id) 0
2358 image create bitmap tri-rt -background black -foreground blue -data {
2359 #define tri-rt_width 13
2360 #define tri-rt_height 13
2361 static unsigned char tri-rt_bits[] = {
2362 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2363 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2364 0x00, 0x00};
2365 } -maskdata {
2366 #define tri-rt-mask_width 13
2367 #define tri-rt-mask_height 13
2368 static unsigned char tri-rt-mask_bits[] = {
2369 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2370 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2371 0x08, 0x00};
2373 image create bitmap tri-dn -background black -foreground blue -data {
2374 #define tri-dn_width 13
2375 #define tri-dn_height 13
2376 static unsigned char tri-dn_bits[] = {
2377 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2378 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2379 0x00, 0x00};
2380 } -maskdata {
2381 #define tri-dn-mask_width 13
2382 #define tri-dn-mask_height 13
2383 static unsigned char tri-dn-mask_bits[] = {
2384 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2385 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2386 0x00, 0x00};
2389 image create bitmap reficon-T -background black -foreground yellow -data {
2390 #define tagicon_width 13
2391 #define tagicon_height 9
2392 static unsigned char tagicon_bits[] = {
2393 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2394 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2395 } -maskdata {
2396 #define tagicon-mask_width 13
2397 #define tagicon-mask_height 9
2398 static unsigned char tagicon-mask_bits[] = {
2399 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2400 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2402 set rectdata {
2403 #define headicon_width 13
2404 #define headicon_height 9
2405 static unsigned char headicon_bits[] = {
2406 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2407 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2409 set rectmask {
2410 #define headicon-mask_width 13
2411 #define headicon-mask_height 9
2412 static unsigned char headicon-mask_bits[] = {
2413 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2414 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2416 image create bitmap reficon-H -background black -foreground green \
2417 -data $rectdata -maskdata $rectmask
2418 image create bitmap reficon-o -background black -foreground "#ddddff" \
2419 -data $rectdata -maskdata $rectmask
2421 proc init_flist {first} {
2422 global cflist cflist_top difffilestart
2424 $cflist conf -state normal
2425 $cflist delete 0.0 end
2426 if {$first ne {}} {
2427 $cflist insert end $first
2428 set cflist_top 1
2429 $cflist tag add highlight 1.0 "1.0 lineend"
2430 } else {
2431 catch {unset cflist_top}
2433 $cflist conf -state disabled
2434 set difffilestart {}
2437 proc highlight_tag {f} {
2438 global highlight_paths
2440 foreach p $highlight_paths {
2441 if {[string match $p $f]} {
2442 return "bold"
2445 return {}
2448 proc highlight_filelist {} {
2449 global cmitmode cflist
2451 $cflist conf -state normal
2452 if {$cmitmode ne "tree"} {
2453 set end [lindex [split [$cflist index end] .] 0]
2454 for {set l 2} {$l < $end} {incr l} {
2455 set line [$cflist get $l.0 "$l.0 lineend"]
2456 if {[highlight_tag $line] ne {}} {
2457 $cflist tag add bold $l.0 "$l.0 lineend"
2460 } else {
2461 highlight_tree 2 {}
2463 $cflist conf -state disabled
2466 proc unhighlight_filelist {} {
2467 global cflist
2469 $cflist conf -state normal
2470 $cflist tag remove bold 1.0 end
2471 $cflist conf -state disabled
2474 proc add_flist {fl} {
2475 global cflist
2477 $cflist conf -state normal
2478 foreach f $fl {
2479 $cflist insert end "\n"
2480 $cflist insert end $f [highlight_tag $f]
2482 $cflist conf -state disabled
2485 proc sel_flist {w x y} {
2486 global ctext difffilestart cflist cflist_top cmitmode
2488 if {$cmitmode eq "tree"} return
2489 if {![info exists cflist_top]} return
2490 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2491 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2492 $cflist tag add highlight $l.0 "$l.0 lineend"
2493 set cflist_top $l
2494 if {$l == 1} {
2495 $ctext yview 1.0
2496 } else {
2497 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2501 proc pop_flist_menu {w X Y x y} {
2502 global ctext cflist cmitmode flist_menu flist_menu_file
2503 global treediffs diffids
2505 stopfinding
2506 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2507 if {$l <= 1} return
2508 if {$cmitmode eq "tree"} {
2509 set e [linetoelt $l]
2510 if {[string index $e end] eq "/"} return
2511 } else {
2512 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2514 set flist_menu_file $e
2515 tk_popup $flist_menu $X $Y
2518 proc flist_hl {only} {
2519 global flist_menu_file findstring gdttype
2521 set x [shellquote $flist_menu_file]
2522 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2523 set findstring $x
2524 } else {
2525 append findstring " " $x
2527 set gdttype [mc "touching paths:"]
2530 # Functions for adding and removing shell-type quoting
2532 proc shellquote {str} {
2533 if {![string match "*\['\"\\ \t]*" $str]} {
2534 return $str
2536 if {![string match "*\['\"\\]*" $str]} {
2537 return "\"$str\""
2539 if {![string match "*'*" $str]} {
2540 return "'$str'"
2542 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2545 proc shellarglist {l} {
2546 set str {}
2547 foreach a $l {
2548 if {$str ne {}} {
2549 append str " "
2551 append str [shellquote $a]
2553 return $str
2556 proc shelldequote {str} {
2557 set ret {}
2558 set used -1
2559 while {1} {
2560 incr used
2561 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2562 append ret [string range $str $used end]
2563 set used [string length $str]
2564 break
2566 set first [lindex $first 0]
2567 set ch [string index $str $first]
2568 if {$first > $used} {
2569 append ret [string range $str $used [expr {$first - 1}]]
2570 set used $first
2572 if {$ch eq " " || $ch eq "\t"} break
2573 incr used
2574 if {$ch eq "'"} {
2575 set first [string first "'" $str $used]
2576 if {$first < 0} {
2577 error "unmatched single-quote"
2579 append ret [string range $str $used [expr {$first - 1}]]
2580 set used $first
2581 continue
2583 if {$ch eq "\\"} {
2584 if {$used >= [string length $str]} {
2585 error "trailing backslash"
2587 append ret [string index $str $used]
2588 continue
2590 # here ch == "\""
2591 while {1} {
2592 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2593 error "unmatched double-quote"
2595 set first [lindex $first 0]
2596 set ch [string index $str $first]
2597 if {$first > $used} {
2598 append ret [string range $str $used [expr {$first - 1}]]
2599 set used $first
2601 if {$ch eq "\""} break
2602 incr used
2603 append ret [string index $str $used]
2604 incr used
2607 return [list $used $ret]
2610 proc shellsplit {str} {
2611 set l {}
2612 while {1} {
2613 set str [string trimleft $str]
2614 if {$str eq {}} break
2615 set dq [shelldequote $str]
2616 set n [lindex $dq 0]
2617 set word [lindex $dq 1]
2618 set str [string range $str $n end]
2619 lappend l $word
2621 return $l
2624 # Code to implement multiple views
2626 proc newview {ishighlight} {
2627 global nextviewnum newviewname newviewperm newishighlight
2628 global newviewargs revtreeargs
2630 set newishighlight $ishighlight
2631 set top .gitkview
2632 if {[winfo exists $top]} {
2633 raise $top
2634 return
2636 set newviewname($nextviewnum) "View $nextviewnum"
2637 set newviewperm($nextviewnum) 0
2638 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2639 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2642 proc editview {} {
2643 global curview
2644 global viewname viewperm newviewname newviewperm
2645 global viewargs newviewargs
2647 set top .gitkvedit-$curview
2648 if {[winfo exists $top]} {
2649 raise $top
2650 return
2652 set newviewname($curview) $viewname($curview)
2653 set newviewperm($curview) $viewperm($curview)
2654 set newviewargs($curview) [shellarglist $viewargs($curview)]
2655 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2658 proc vieweditor {top n title} {
2659 global newviewname newviewperm viewfiles bgcolor
2661 toplevel $top
2662 wm title $top $title
2663 label $top.nl -text [mc "Name"]
2664 entry $top.name -width 20 -textvariable newviewname($n)
2665 grid $top.nl $top.name -sticky w -pady 5
2666 checkbutton $top.perm -text [mc "Remember this view"] \
2667 -variable newviewperm($n)
2668 grid $top.perm - -pady 5 -sticky w
2669 message $top.al -aspect 1000 \
2670 -text [mc "Commits to include (arguments to git rev-list):"]
2671 grid $top.al - -sticky w -pady 5
2672 entry $top.args -width 50 -textvariable newviewargs($n) \
2673 -background $bgcolor
2674 grid $top.args - -sticky ew -padx 5
2675 message $top.l -aspect 1000 \
2676 -text [mc "Enter files and directories to include, one per line:"]
2677 grid $top.l - -sticky w
2678 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2679 if {[info exists viewfiles($n)]} {
2680 foreach f $viewfiles($n) {
2681 $top.t insert end $f
2682 $top.t insert end "\n"
2684 $top.t delete {end - 1c} end
2685 $top.t mark set insert 0.0
2687 grid $top.t - -sticky ew -padx 5
2688 frame $top.buts
2689 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2690 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2691 grid $top.buts.ok $top.buts.can
2692 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2693 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2694 grid $top.buts - -pady 10 -sticky ew
2695 focus $top.t
2698 proc doviewmenu {m first cmd op argv} {
2699 set nmenu [$m index end]
2700 for {set i $first} {$i <= $nmenu} {incr i} {
2701 if {[$m entrycget $i -command] eq $cmd} {
2702 eval $m $op $i $argv
2703 break
2708 proc allviewmenus {n op args} {
2709 # global viewhlmenu
2711 doviewmenu .bar.view 5 [list showview $n] $op $args
2712 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2715 proc newviewok {top n} {
2716 global nextviewnum newviewperm newviewname newishighlight
2717 global viewname viewfiles viewperm selectedview curview
2718 global viewargs newviewargs viewhlmenu
2720 if {[catch {
2721 set newargs [shellsplit $newviewargs($n)]
2722 } err]} {
2723 error_popup "[mc "Error in commit selection arguments:"] $err"
2724 wm raise $top
2725 focus $top
2726 return
2728 set files {}
2729 foreach f [split [$top.t get 0.0 end] "\n"] {
2730 set ft [string trim $f]
2731 if {$ft ne {}} {
2732 lappend files $ft
2735 if {![info exists viewfiles($n)]} {
2736 # creating a new view
2737 incr nextviewnum
2738 set viewname($n) $newviewname($n)
2739 set viewperm($n) $newviewperm($n)
2740 set viewfiles($n) $files
2741 set viewargs($n) $newargs
2742 addviewmenu $n
2743 if {!$newishighlight} {
2744 run showview $n
2745 } else {
2746 run addvhighlight $n
2748 } else {
2749 # editing an existing view
2750 set viewperm($n) $newviewperm($n)
2751 if {$newviewname($n) ne $viewname($n)} {
2752 set viewname($n) $newviewname($n)
2753 doviewmenu .bar.view 5 [list showview $n] \
2754 entryconf [list -label $viewname($n)]
2755 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2756 # entryconf [list -label $viewname($n) -value $viewname($n)]
2758 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2759 set viewfiles($n) $files
2760 set viewargs($n) $newargs
2761 if {$curview == $n} {
2762 run reloadcommits
2766 catch {destroy $top}
2769 proc delview {} {
2770 global curview viewperm hlview selectedhlview
2772 if {$curview == 0} return
2773 if {[info exists hlview] && $hlview == $curview} {
2774 set selectedhlview [mc "None"]
2775 unset hlview
2777 allviewmenus $curview delete
2778 set viewperm($curview) 0
2779 showview 0
2782 proc addviewmenu {n} {
2783 global viewname viewhlmenu
2785 .bar.view add radiobutton -label $viewname($n) \
2786 -command [list showview $n] -variable selectedview -value $n
2787 #$viewhlmenu add radiobutton -label $viewname($n) \
2788 # -command [list addvhighlight $n] -variable selectedhlview
2791 proc showview {n} {
2792 global curview viewfiles cached_commitrow ordertok
2793 global displayorder parentlist rowidlist rowisopt rowfinal
2794 global colormap rowtextx nextcolor canvxmax
2795 global numcommits viewcomplete
2796 global selectedline currentid canv canvy0
2797 global treediffs
2798 global pending_select mainheadid
2799 global commitidx
2800 global selectedview
2801 global hlview selectedhlview commitinterest
2803 if {$n == $curview} return
2804 set selid {}
2805 set ymax [lindex [$canv cget -scrollregion] 3]
2806 set span [$canv yview]
2807 set ytop [expr {[lindex $span 0] * $ymax}]
2808 set ybot [expr {[lindex $span 1] * $ymax}]
2809 set yscreen [expr {($ybot - $ytop) / 2}]
2810 if {[info exists selectedline]} {
2811 set selid $currentid
2812 set y [yc $selectedline]
2813 if {$ytop < $y && $y < $ybot} {
2814 set yscreen [expr {$y - $ytop}]
2816 } elseif {[info exists pending_select]} {
2817 set selid $pending_select
2818 unset pending_select
2820 unselectline
2821 normalline
2822 catch {unset treediffs}
2823 clear_display
2824 if {[info exists hlview] && $hlview == $n} {
2825 unset hlview
2826 set selectedhlview [mc "None"]
2828 catch {unset commitinterest}
2829 catch {unset cached_commitrow}
2830 catch {unset ordertok}
2832 set curview $n
2833 set selectedview $n
2834 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2835 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2837 run refill_reflist
2838 if {![info exists viewcomplete($n)]} {
2839 if {$selid ne {}} {
2840 set pending_select $selid
2842 getcommits
2843 return
2846 set displayorder {}
2847 set parentlist {}
2848 set rowidlist {}
2849 set rowisopt {}
2850 set rowfinal {}
2851 set numcommits $commitidx($n)
2853 catch {unset colormap}
2854 catch {unset rowtextx}
2855 set nextcolor 0
2856 set canvxmax [$canv cget -width]
2857 set curview $n
2858 set row 0
2859 setcanvscroll
2860 set yf 0
2861 set row {}
2862 if {$selid ne {} && [commitinview $selid $n]} {
2863 set row [rowofcommit $selid]
2864 # try to get the selected row in the same position on the screen
2865 set ymax [lindex [$canv cget -scrollregion] 3]
2866 set ytop [expr {[yc $row] - $yscreen}]
2867 if {$ytop < 0} {
2868 set ytop 0
2870 set yf [expr {$ytop * 1.0 / $ymax}]
2872 allcanvs yview moveto $yf
2873 drawvisible
2874 if {$row ne {}} {
2875 selectline $row 0
2876 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
2877 selectline [rowofcommit $mainheadid] 1
2878 } elseif {!$viewcomplete($n)} {
2879 if {$selid ne {}} {
2880 set pending_select $selid
2881 } else {
2882 set pending_select $mainheadid
2884 } else {
2885 set row [first_real_row]
2886 if {$row < $numcommits} {
2887 selectline $row 0
2890 if {!$viewcomplete($n)} {
2891 if {$numcommits == 0} {
2892 show_status [mc "Reading commits..."]
2894 } elseif {$numcommits == 0} {
2895 show_status [mc "No commits selected"]
2899 # Stuff relating to the highlighting facility
2901 proc ishighlighted {id} {
2902 global vhighlights fhighlights nhighlights rhighlights
2904 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
2905 return $nhighlights($id)
2907 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
2908 return $vhighlights($id)
2910 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
2911 return $fhighlights($id)
2913 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
2914 return $rhighlights($id)
2916 return 0
2919 proc bolden {row font} {
2920 global canv linehtag selectedline boldrows
2922 lappend boldrows $row
2923 $canv itemconf $linehtag($row) -font $font
2924 if {[info exists selectedline] && $row == $selectedline} {
2925 $canv delete secsel
2926 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2927 -outline {{}} -tags secsel \
2928 -fill [$canv cget -selectbackground]]
2929 $canv lower $t
2933 proc bolden_name {row font} {
2934 global canv2 linentag selectedline boldnamerows
2936 lappend boldnamerows $row
2937 $canv2 itemconf $linentag($row) -font $font
2938 if {[info exists selectedline] && $row == $selectedline} {
2939 $canv2 delete secsel
2940 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2941 -outline {{}} -tags secsel \
2942 -fill [$canv2 cget -selectbackground]]
2943 $canv2 lower $t
2947 proc unbolden {} {
2948 global boldrows
2950 set stillbold {}
2951 foreach row $boldrows {
2952 if {![ishighlighted [commitonrow $row]]} {
2953 bolden $row mainfont
2954 } else {
2955 lappend stillbold $row
2958 set boldrows $stillbold
2961 proc addvhighlight {n} {
2962 global hlview viewcomplete curview vhl_done commitidx
2964 if {[info exists hlview]} {
2965 delvhighlight
2967 set hlview $n
2968 if {$n != $curview && ![info exists viewcomplete($n)]} {
2969 start_rev_list $n
2971 set vhl_done $commitidx($hlview)
2972 if {$vhl_done > 0} {
2973 drawvisible
2977 proc delvhighlight {} {
2978 global hlview vhighlights
2980 if {![info exists hlview]} return
2981 unset hlview
2982 catch {unset vhighlights}
2983 unbolden
2986 proc vhighlightmore {} {
2987 global hlview vhl_done commitidx vhighlights curview
2989 set max $commitidx($hlview)
2990 set vr [visiblerows]
2991 set r0 [lindex $vr 0]
2992 set r1 [lindex $vr 1]
2993 for {set i $vhl_done} {$i < $max} {incr i} {
2994 set id [commitonrow $i $hlview]
2995 if {[commitinview $id $curview]} {
2996 set row [rowofcommit $id]
2997 if {$r0 <= $row && $row <= $r1} {
2998 if {![highlighted $row]} {
2999 bolden $row mainfontbold
3001 set vhighlights($id) 1
3005 set vhl_done $max
3008 proc askvhighlight {row id} {
3009 global hlview vhighlights iddrawn
3011 if {[commitinview $id $hlview]} {
3012 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3013 bolden $row mainfontbold
3015 set vhighlights($id) 1
3016 } else {
3017 set vhighlights($id) 0
3021 proc hfiles_change {} {
3022 global highlight_files filehighlight fhighlights fh_serial
3023 global highlight_paths gdttype
3025 if {[info exists filehighlight]} {
3026 # delete previous highlights
3027 catch {close $filehighlight}
3028 unset filehighlight
3029 catch {unset fhighlights}
3030 unbolden
3031 unhighlight_filelist
3033 set highlight_paths {}
3034 after cancel do_file_hl $fh_serial
3035 incr fh_serial
3036 if {$highlight_files ne {}} {
3037 after 300 do_file_hl $fh_serial
3041 proc gdttype_change {name ix op} {
3042 global gdttype highlight_files findstring findpattern
3044 stopfinding
3045 if {$findstring ne {}} {
3046 if {$gdttype eq [mc "containing:"]} {
3047 if {$highlight_files ne {}} {
3048 set highlight_files {}
3049 hfiles_change
3051 findcom_change
3052 } else {
3053 if {$findpattern ne {}} {
3054 set findpattern {}
3055 findcom_change
3057 set highlight_files $findstring
3058 hfiles_change
3060 drawvisible
3062 # enable/disable findtype/findloc menus too
3065 proc find_change {name ix op} {
3066 global gdttype findstring highlight_files
3068 stopfinding
3069 if {$gdttype eq [mc "containing:"]} {
3070 findcom_change
3071 } else {
3072 if {$highlight_files ne $findstring} {
3073 set highlight_files $findstring
3074 hfiles_change
3077 drawvisible
3080 proc findcom_change args {
3081 global nhighlights boldnamerows
3082 global findpattern findtype findstring gdttype
3084 stopfinding
3085 # delete previous highlights, if any
3086 foreach row $boldnamerows {
3087 bolden_name $row mainfont
3089 set boldnamerows {}
3090 catch {unset nhighlights}
3091 unbolden
3092 unmarkmatches
3093 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3094 set findpattern {}
3095 } elseif {$findtype eq [mc "Regexp"]} {
3096 set findpattern $findstring
3097 } else {
3098 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3099 $findstring]
3100 set findpattern "*$e*"
3104 proc makepatterns {l} {
3105 set ret {}
3106 foreach e $l {
3107 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3108 if {[string index $ee end] eq "/"} {
3109 lappend ret "$ee*"
3110 } else {
3111 lappend ret $ee
3112 lappend ret "$ee/*"
3115 return $ret
3118 proc do_file_hl {serial} {
3119 global highlight_files filehighlight highlight_paths gdttype fhl_list
3121 if {$gdttype eq [mc "touching paths:"]} {
3122 if {[catch {set paths [shellsplit $highlight_files]}]} return
3123 set highlight_paths [makepatterns $paths]
3124 highlight_filelist
3125 set gdtargs [concat -- $paths]
3126 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3127 set gdtargs [list "-S$highlight_files"]
3128 } else {
3129 # must be "containing:", i.e. we're searching commit info
3130 return
3132 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3133 set filehighlight [open $cmd r+]
3134 fconfigure $filehighlight -blocking 0
3135 filerun $filehighlight readfhighlight
3136 set fhl_list {}
3137 drawvisible
3138 flushhighlights
3141 proc flushhighlights {} {
3142 global filehighlight fhl_list
3144 if {[info exists filehighlight]} {
3145 lappend fhl_list {}
3146 puts $filehighlight ""
3147 flush $filehighlight
3151 proc askfilehighlight {row id} {
3152 global filehighlight fhighlights fhl_list
3154 lappend fhl_list $id
3155 set fhighlights($id) -1
3156 puts $filehighlight $id
3159 proc readfhighlight {} {
3160 global filehighlight fhighlights curview iddrawn
3161 global fhl_list find_dirn
3163 if {![info exists filehighlight]} {
3164 return 0
3166 set nr 0
3167 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3168 set line [string trim $line]
3169 set i [lsearch -exact $fhl_list $line]
3170 if {$i < 0} continue
3171 for {set j 0} {$j < $i} {incr j} {
3172 set id [lindex $fhl_list $j]
3173 set fhighlights($id) 0
3175 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3176 if {$line eq {}} continue
3177 if {![commitinview $line $curview]} continue
3178 set row [rowofcommit $line]
3179 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3180 bolden $row mainfontbold
3182 set fhighlights($line) 1
3184 if {[eof $filehighlight]} {
3185 # strange...
3186 puts "oops, git diff-tree died"
3187 catch {close $filehighlight}
3188 unset filehighlight
3189 return 0
3191 if {[info exists find_dirn]} {
3192 run findmore
3194 return 1
3197 proc doesmatch {f} {
3198 global findtype findpattern
3200 if {$findtype eq [mc "Regexp"]} {
3201 return [regexp $findpattern $f]
3202 } elseif {$findtype eq [mc "IgnCase"]} {
3203 return [string match -nocase $findpattern $f]
3204 } else {
3205 return [string match $findpattern $f]
3209 proc askfindhighlight {row id} {
3210 global nhighlights commitinfo iddrawn
3211 global findloc
3212 global markingmatches
3214 if {![info exists commitinfo($id)]} {
3215 getcommit $id
3217 set info $commitinfo($id)
3218 set isbold 0
3219 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3220 foreach f $info ty $fldtypes {
3221 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3222 [doesmatch $f]} {
3223 if {$ty eq [mc "Author"]} {
3224 set isbold 2
3225 break
3227 set isbold 1
3230 if {$isbold && [info exists iddrawn($id)]} {
3231 if {![ishighlighted $id]} {
3232 bolden $row mainfontbold
3233 if {$isbold > 1} {
3234 bolden_name $row mainfontbold
3237 if {$markingmatches} {
3238 markrowmatches $row $id
3241 set nhighlights($id) $isbold
3244 proc markrowmatches {row id} {
3245 global canv canv2 linehtag linentag commitinfo findloc
3247 set headline [lindex $commitinfo($id) 0]
3248 set author [lindex $commitinfo($id) 1]
3249 $canv delete match$row
3250 $canv2 delete match$row
3251 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3252 set m [findmatches $headline]
3253 if {$m ne {}} {
3254 markmatches $canv $row $headline $linehtag($row) $m \
3255 [$canv itemcget $linehtag($row) -font] $row
3258 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3259 set m [findmatches $author]
3260 if {$m ne {}} {
3261 markmatches $canv2 $row $author $linentag($row) $m \
3262 [$canv2 itemcget $linentag($row) -font] $row
3267 proc vrel_change {name ix op} {
3268 global highlight_related
3270 rhighlight_none
3271 if {$highlight_related ne [mc "None"]} {
3272 run drawvisible
3276 # prepare for testing whether commits are descendents or ancestors of a
3277 proc rhighlight_sel {a} {
3278 global descendent desc_todo ancestor anc_todo
3279 global highlight_related
3281 catch {unset descendent}
3282 set desc_todo [list $a]
3283 catch {unset ancestor}
3284 set anc_todo [list $a]
3285 if {$highlight_related ne [mc "None"]} {
3286 rhighlight_none
3287 run drawvisible
3291 proc rhighlight_none {} {
3292 global rhighlights
3294 catch {unset rhighlights}
3295 unbolden
3298 proc is_descendent {a} {
3299 global curview children descendent desc_todo
3301 set v $curview
3302 set la [rowofcommit $a]
3303 set todo $desc_todo
3304 set leftover {}
3305 set done 0
3306 for {set i 0} {$i < [llength $todo]} {incr i} {
3307 set do [lindex $todo $i]
3308 if {[rowofcommit $do] < $la} {
3309 lappend leftover $do
3310 continue
3312 foreach nk $children($v,$do) {
3313 if {![info exists descendent($nk)]} {
3314 set descendent($nk) 1
3315 lappend todo $nk
3316 if {$nk eq $a} {
3317 set done 1
3321 if {$done} {
3322 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3323 return
3326 set descendent($a) 0
3327 set desc_todo $leftover
3330 proc is_ancestor {a} {
3331 global curview parents ancestor anc_todo
3333 set v $curview
3334 set la [rowofcommit $a]
3335 set todo $anc_todo
3336 set leftover {}
3337 set done 0
3338 for {set i 0} {$i < [llength $todo]} {incr i} {
3339 set do [lindex $todo $i]
3340 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3341 lappend leftover $do
3342 continue
3344 foreach np $parents($v,$do) {
3345 if {![info exists ancestor($np)]} {
3346 set ancestor($np) 1
3347 lappend todo $np
3348 if {$np eq $a} {
3349 set done 1
3353 if {$done} {
3354 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3355 return
3358 set ancestor($a) 0
3359 set anc_todo $leftover
3362 proc askrelhighlight {row id} {
3363 global descendent highlight_related iddrawn rhighlights
3364 global selectedline ancestor
3366 if {![info exists selectedline]} return
3367 set isbold 0
3368 if {$highlight_related eq [mc "Descendent"] ||
3369 $highlight_related eq [mc "Not descendent"]} {
3370 if {![info exists descendent($id)]} {
3371 is_descendent $id
3373 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
3374 set isbold 1
3376 } elseif {$highlight_related eq [mc "Ancestor"] ||
3377 $highlight_related eq [mc "Not ancestor"]} {
3378 if {![info exists ancestor($id)]} {
3379 is_ancestor $id
3381 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3382 set isbold 1
3385 if {[info exists iddrawn($id)]} {
3386 if {$isbold && ![ishighlighted $id]} {
3387 bolden $row mainfontbold
3390 set rhighlights($id) $isbold
3393 # Graph layout functions
3395 proc shortids {ids} {
3396 set res {}
3397 foreach id $ids {
3398 if {[llength $id] > 1} {
3399 lappend res [shortids $id]
3400 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3401 lappend res [string range $id 0 7]
3402 } else {
3403 lappend res $id
3406 return $res
3409 proc ntimes {n o} {
3410 set ret {}
3411 set o [list $o]
3412 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3413 if {($n & $mask) != 0} {
3414 set ret [concat $ret $o]
3416 set o [concat $o $o]
3418 return $ret
3421 proc ordertoken {id} {
3422 global ordertok curview varcid varcstart varctok curview parents children
3423 global nullid nullid2
3425 if {[info exists ordertok($id)]} {
3426 return $ordertok($id)
3428 set origid $id
3429 set todo {}
3430 while {1} {
3431 if {[info exists varcid($curview,$id)]} {
3432 set a $varcid($curview,$id)
3433 set p [lindex $varcstart($curview) $a]
3434 } else {
3435 set p [lindex $children($curview,$id) 0]
3437 if {[info exists ordertok($p)]} {
3438 set tok $ordertok($p)
3439 break
3441 set id [first_real_child $curview,$p]
3442 if {$id eq {}} {
3443 # it's a root
3444 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3445 break
3447 if {[llength $parents($curview,$id)] == 1} {
3448 lappend todo [list $p {}]
3449 } else {
3450 set j [lsearch -exact $parents($curview,$id) $p]
3451 if {$j < 0} {
3452 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3454 lappend todo [list $p [strrep $j]]
3457 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3458 set p [lindex $todo $i 0]
3459 append tok [lindex $todo $i 1]
3460 set ordertok($p) $tok
3462 set ordertok($origid) $tok
3463 return $tok
3466 # Work out where id should go in idlist so that order-token
3467 # values increase from left to right
3468 proc idcol {idlist id {i 0}} {
3469 set t [ordertoken $id]
3470 if {$i < 0} {
3471 set i 0
3473 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3474 if {$i > [llength $idlist]} {
3475 set i [llength $idlist]
3477 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3478 incr i
3479 } else {
3480 if {$t > [ordertoken [lindex $idlist $i]]} {
3481 while {[incr i] < [llength $idlist] &&
3482 $t >= [ordertoken [lindex $idlist $i]]} {}
3485 return $i
3488 proc initlayout {} {
3489 global rowidlist rowisopt rowfinal displayorder parentlist
3490 global numcommits canvxmax canv
3491 global nextcolor
3492 global colormap rowtextx
3494 set numcommits 0
3495 set displayorder {}
3496 set parentlist {}
3497 set nextcolor 0
3498 set rowidlist {}
3499 set rowisopt {}
3500 set rowfinal {}
3501 set canvxmax [$canv cget -width]
3502 catch {unset colormap}
3503 catch {unset rowtextx}
3506 proc setcanvscroll {} {
3507 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3509 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3510 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3511 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3512 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3515 proc visiblerows {} {
3516 global canv numcommits linespc
3518 set ymax [lindex [$canv cget -scrollregion] 3]
3519 if {$ymax eq {} || $ymax == 0} return
3520 set f [$canv yview]
3521 set y0 [expr {int([lindex $f 0] * $ymax)}]
3522 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3523 if {$r0 < 0} {
3524 set r0 0
3526 set y1 [expr {int([lindex $f 1] * $ymax)}]
3527 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3528 if {$r1 >= $numcommits} {
3529 set r1 [expr {$numcommits - 1}]
3531 return [list $r0 $r1]
3534 proc layoutmore {} {
3535 global commitidx viewcomplete curview
3536 global numcommits pending_select selectedline curview
3537 global lastscrollset commitinterest
3539 set canshow $commitidx($curview)
3540 if {$canshow <= $numcommits && !$viewcomplete($curview)} return
3541 if {$numcommits == 0} {
3542 allcanvs delete all
3544 set r0 $numcommits
3545 set prev $numcommits
3546 set numcommits $canshow
3547 set t [clock clicks -milliseconds]
3548 if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
3549 set lastscrollset $t
3550 setcanvscroll
3552 set rows [visiblerows]
3553 set r1 [lindex $rows 1]
3554 if {$r1 >= $canshow} {
3555 set r1 [expr {$canshow - 1}]
3557 if {$r0 <= $r1} {
3558 drawcommits $r0 $r1
3560 if {[info exists pending_select] &&
3561 [commitinview $pending_select $curview]} {
3562 selectline [rowofcommit $pending_select] 1
3566 proc doshowlocalchanges {} {
3567 global curview mainheadid
3569 if {[commitinview $mainheadid $curview]} {
3570 dodiffindex
3571 } else {
3572 lappend commitinterest($mainheadid) {dodiffindex}
3576 proc dohidelocalchanges {} {
3577 global nullid nullid2 lserial curview
3579 if {[commitinview $nullid $curview]} {
3580 removefakerow $nullid
3582 if {[commitinview $nullid2 $curview]} {
3583 removefakerow $nullid2
3585 incr lserial
3588 # spawn off a process to do git diff-index --cached HEAD
3589 proc dodiffindex {} {
3590 global lserial showlocalchanges
3592 if {!$showlocalchanges} return
3593 incr lserial
3594 set fd [open "|git diff-index --cached HEAD" r]
3595 fconfigure $fd -blocking 0
3596 filerun $fd [list readdiffindex $fd $lserial]
3599 proc readdiffindex {fd serial} {
3600 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3602 set isdiff 1
3603 if {[gets $fd line] < 0} {
3604 if {![eof $fd]} {
3605 return 1
3607 set isdiff 0
3609 # we only need to see one line and we don't really care what it says...
3610 close $fd
3612 if {$serial != $lserial} {
3613 return 0
3616 # now see if there are any local changes not checked in to the index
3617 set fd [open "|git diff-files" r]
3618 fconfigure $fd -blocking 0
3619 filerun $fd [list readdifffiles $fd $serial]
3621 if {$isdiff && ![commitinview $nullid2 $curview]} {
3622 # add the line for the changes in the index to the graph
3623 set hl [mc "Local changes checked in to index but not committed"]
3624 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3625 set commitdata($nullid2) "\n $hl\n"
3626 if {[commitinview $nullid $curview]} {
3627 removefakerow $nullid
3629 insertfakerow $nullid2 $mainheadid
3630 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3631 removefakerow $nullid2
3633 return 0
3636 proc readdifffiles {fd serial} {
3637 global mainheadid nullid nullid2 curview
3638 global commitinfo commitdata lserial
3640 set isdiff 1
3641 if {[gets $fd line] < 0} {
3642 if {![eof $fd]} {
3643 return 1
3645 set isdiff 0
3647 # we only need to see one line and we don't really care what it says...
3648 close $fd
3650 if {$serial != $lserial} {
3651 return 0
3654 if {$isdiff && ![commitinview $nullid $curview]} {
3655 # add the line for the local diff to the graph
3656 set hl [mc "Local uncommitted changes, not checked in to index"]
3657 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3658 set commitdata($nullid) "\n $hl\n"
3659 if {[commitinview $nullid2 $curview]} {
3660 set p $nullid2
3661 } else {
3662 set p $mainheadid
3664 insertfakerow $nullid $p
3665 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3666 removefakerow $nullid
3668 return 0
3671 proc nextuse {id row} {
3672 global curview children
3674 if {[info exists children($curview,$id)]} {
3675 foreach kid $children($curview,$id) {
3676 if {![commitinview $kid $curview]} {
3677 return -1
3679 if {[rowofcommit $kid] > $row} {
3680 return [rowofcommit $kid]
3684 if {[commitinview $id $curview]} {
3685 return [rowofcommit $id]
3687 return -1
3690 proc prevuse {id row} {
3691 global curview children
3693 set ret -1
3694 if {[info exists children($curview,$id)]} {
3695 foreach kid $children($curview,$id) {
3696 if {![commitinview $kid $curview]} break
3697 if {[rowofcommit $kid] < $row} {
3698 set ret [rowofcommit $kid]
3702 return $ret
3705 proc make_idlist {row} {
3706 global displayorder parentlist uparrowlen downarrowlen mingaplen
3707 global commitidx curview children
3709 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3710 if {$r < 0} {
3711 set r 0
3713 set ra [expr {$row - $downarrowlen}]
3714 if {$ra < 0} {
3715 set ra 0
3717 set rb [expr {$row + $uparrowlen}]
3718 if {$rb > $commitidx($curview)} {
3719 set rb $commitidx($curview)
3721 make_disporder $r [expr {$rb + 1}]
3722 set ids {}
3723 for {} {$r < $ra} {incr r} {
3724 set nextid [lindex $displayorder [expr {$r + 1}]]
3725 foreach p [lindex $parentlist $r] {
3726 if {$p eq $nextid} continue
3727 set rn [nextuse $p $r]
3728 if {$rn >= $row &&
3729 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3730 lappend ids [list [ordertoken $p] $p]
3734 for {} {$r < $row} {incr r} {
3735 set nextid [lindex $displayorder [expr {$r + 1}]]
3736 foreach p [lindex $parentlist $r] {
3737 if {$p eq $nextid} continue
3738 set rn [nextuse $p $r]
3739 if {$rn < 0 || $rn >= $row} {
3740 lappend ids [list [ordertoken $p] $p]
3744 set id [lindex $displayorder $row]
3745 lappend ids [list [ordertoken $id] $id]
3746 while {$r < $rb} {
3747 foreach p [lindex $parentlist $r] {
3748 set firstkid [lindex $children($curview,$p) 0]
3749 if {[rowofcommit $firstkid] < $row} {
3750 lappend ids [list [ordertoken $p] $p]
3753 incr r
3754 set id [lindex $displayorder $r]
3755 if {$id ne {}} {
3756 set firstkid [lindex $children($curview,$id) 0]
3757 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3758 lappend ids [list [ordertoken $id] $id]
3762 set idlist {}
3763 foreach idx [lsort -unique $ids] {
3764 lappend idlist [lindex $idx 1]
3766 return $idlist
3769 proc rowsequal {a b} {
3770 while {[set i [lsearch -exact $a {}]] >= 0} {
3771 set a [lreplace $a $i $i]
3773 while {[set i [lsearch -exact $b {}]] >= 0} {
3774 set b [lreplace $b $i $i]
3776 return [expr {$a eq $b}]
3779 proc makeupline {id row rend col} {
3780 global rowidlist uparrowlen downarrowlen mingaplen
3782 for {set r $rend} {1} {set r $rstart} {
3783 set rstart [prevuse $id $r]
3784 if {$rstart < 0} return
3785 if {$rstart < $row} break
3787 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3788 set rstart [expr {$rend - $uparrowlen - 1}]
3790 for {set r $rstart} {[incr r] <= $row} {} {
3791 set idlist [lindex $rowidlist $r]
3792 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3793 set col [idcol $idlist $id $col]
3794 lset rowidlist $r [linsert $idlist $col $id]
3795 changedrow $r
3800 proc layoutrows {row endrow} {
3801 global rowidlist rowisopt rowfinal displayorder
3802 global uparrowlen downarrowlen maxwidth mingaplen
3803 global children parentlist
3804 global commitidx viewcomplete curview
3806 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3807 set idlist {}
3808 if {$row > 0} {
3809 set rm1 [expr {$row - 1}]
3810 foreach id [lindex $rowidlist $rm1] {
3811 if {$id ne {}} {
3812 lappend idlist $id
3815 set final [lindex $rowfinal $rm1]
3817 for {} {$row < $endrow} {incr row} {
3818 set rm1 [expr {$row - 1}]
3819 if {$rm1 < 0 || $idlist eq {}} {
3820 set idlist [make_idlist $row]
3821 set final 1
3822 } else {
3823 set id [lindex $displayorder $rm1]
3824 set col [lsearch -exact $idlist $id]
3825 set idlist [lreplace $idlist $col $col]
3826 foreach p [lindex $parentlist $rm1] {
3827 if {[lsearch -exact $idlist $p] < 0} {
3828 set col [idcol $idlist $p $col]
3829 set idlist [linsert $idlist $col $p]
3830 # if not the first child, we have to insert a line going up
3831 if {$id ne [lindex $children($curview,$p) 0]} {
3832 makeupline $p $rm1 $row $col
3836 set id [lindex $displayorder $row]
3837 if {$row > $downarrowlen} {
3838 set termrow [expr {$row - $downarrowlen - 1}]
3839 foreach p [lindex $parentlist $termrow] {
3840 set i [lsearch -exact $idlist $p]
3841 if {$i < 0} continue
3842 set nr [nextuse $p $termrow]
3843 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3844 set idlist [lreplace $idlist $i $i]
3848 set col [lsearch -exact $idlist $id]
3849 if {$col < 0} {
3850 set col [idcol $idlist $id]
3851 set idlist [linsert $idlist $col $id]
3852 if {$children($curview,$id) ne {}} {
3853 makeupline $id $rm1 $row $col
3856 set r [expr {$row + $uparrowlen - 1}]
3857 if {$r < $commitidx($curview)} {
3858 set x $col
3859 foreach p [lindex $parentlist $r] {
3860 if {[lsearch -exact $idlist $p] >= 0} continue
3861 set fk [lindex $children($curview,$p) 0]
3862 if {[rowofcommit $fk] < $row} {
3863 set x [idcol $idlist $p $x]
3864 set idlist [linsert $idlist $x $p]
3867 if {[incr r] < $commitidx($curview)} {
3868 set p [lindex $displayorder $r]
3869 if {[lsearch -exact $idlist $p] < 0} {
3870 set fk [lindex $children($curview,$p) 0]
3871 if {$fk ne {} && [rowofcommit $fk] < $row} {
3872 set x [idcol $idlist $p $x]
3873 set idlist [linsert $idlist $x $p]
3879 if {$final && !$viewcomplete($curview) &&
3880 $row + $uparrowlen + $mingaplen + $downarrowlen
3881 >= $commitidx($curview)} {
3882 set final 0
3884 set l [llength $rowidlist]
3885 if {$row == $l} {
3886 lappend rowidlist $idlist
3887 lappend rowisopt 0
3888 lappend rowfinal $final
3889 } elseif {$row < $l} {
3890 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3891 lset rowidlist $row $idlist
3892 changedrow $row
3894 lset rowfinal $row $final
3895 } else {
3896 set pad [ntimes [expr {$row - $l}] {}]
3897 set rowidlist [concat $rowidlist $pad]
3898 lappend rowidlist $idlist
3899 set rowfinal [concat $rowfinal $pad]
3900 lappend rowfinal $final
3901 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3904 return $row
3907 proc changedrow {row} {
3908 global displayorder iddrawn rowisopt need_redisplay
3910 set l [llength $rowisopt]
3911 if {$row < $l} {
3912 lset rowisopt $row 0
3913 if {$row + 1 < $l} {
3914 lset rowisopt [expr {$row + 1}] 0
3915 if {$row + 2 < $l} {
3916 lset rowisopt [expr {$row + 2}] 0
3920 set id [lindex $displayorder $row]
3921 if {[info exists iddrawn($id)]} {
3922 set need_redisplay 1
3926 proc insert_pad {row col npad} {
3927 global rowidlist
3929 set pad [ntimes $npad {}]
3930 set idlist [lindex $rowidlist $row]
3931 set bef [lrange $idlist 0 [expr {$col - 1}]]
3932 set aft [lrange $idlist $col end]
3933 set i [lsearch -exact $aft {}]
3934 if {$i > 0} {
3935 set aft [lreplace $aft $i $i]
3937 lset rowidlist $row [concat $bef $pad $aft]
3938 changedrow $row
3941 proc optimize_rows {row col endrow} {
3942 global rowidlist rowisopt displayorder curview children
3944 if {$row < 1} {
3945 set row 1
3947 for {} {$row < $endrow} {incr row; set col 0} {
3948 if {[lindex $rowisopt $row]} continue
3949 set haspad 0
3950 set y0 [expr {$row - 1}]
3951 set ym [expr {$row - 2}]
3952 set idlist [lindex $rowidlist $row]
3953 set previdlist [lindex $rowidlist $y0]
3954 if {$idlist eq {} || $previdlist eq {}} continue
3955 if {$ym >= 0} {
3956 set pprevidlist [lindex $rowidlist $ym]
3957 if {$pprevidlist eq {}} continue
3958 } else {
3959 set pprevidlist {}
3961 set x0 -1
3962 set xm -1
3963 for {} {$col < [llength $idlist]} {incr col} {
3964 set id [lindex $idlist $col]
3965 if {[lindex $previdlist $col] eq $id} continue
3966 if {$id eq {}} {
3967 set haspad 1
3968 continue
3970 set x0 [lsearch -exact $previdlist $id]
3971 if {$x0 < 0} continue
3972 set z [expr {$x0 - $col}]
3973 set isarrow 0
3974 set z0 {}
3975 if {$ym >= 0} {
3976 set xm [lsearch -exact $pprevidlist $id]
3977 if {$xm >= 0} {
3978 set z0 [expr {$xm - $x0}]
3981 if {$z0 eq {}} {
3982 # if row y0 is the first child of $id then it's not an arrow
3983 if {[lindex $children($curview,$id) 0] ne
3984 [lindex $displayorder $y0]} {
3985 set isarrow 1
3988 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3989 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3990 set isarrow 1
3992 # Looking at lines from this row to the previous row,
3993 # make them go straight up if they end in an arrow on
3994 # the previous row; otherwise make them go straight up
3995 # or at 45 degrees.
3996 if {$z < -1 || ($z < 0 && $isarrow)} {
3997 # Line currently goes left too much;
3998 # insert pads in the previous row, then optimize it
3999 set npad [expr {-1 - $z + $isarrow}]
4000 insert_pad $y0 $x0 $npad
4001 if {$y0 > 0} {
4002 optimize_rows $y0 $x0 $row
4004 set previdlist [lindex $rowidlist $y0]
4005 set x0 [lsearch -exact $previdlist $id]
4006 set z [expr {$x0 - $col}]
4007 if {$z0 ne {}} {
4008 set pprevidlist [lindex $rowidlist $ym]
4009 set xm [lsearch -exact $pprevidlist $id]
4010 set z0 [expr {$xm - $x0}]
4012 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4013 # Line currently goes right too much;
4014 # insert pads in this line
4015 set npad [expr {$z - 1 + $isarrow}]
4016 insert_pad $row $col $npad
4017 set idlist [lindex $rowidlist $row]
4018 incr col $npad
4019 set z [expr {$x0 - $col}]
4020 set haspad 1
4022 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4023 # this line links to its first child on row $row-2
4024 set id [lindex $displayorder $ym]
4025 set xc [lsearch -exact $pprevidlist $id]
4026 if {$xc >= 0} {
4027 set z0 [expr {$xc - $x0}]
4030 # avoid lines jigging left then immediately right
4031 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4032 insert_pad $y0 $x0 1
4033 incr x0
4034 optimize_rows $y0 $x0 $row
4035 set previdlist [lindex $rowidlist $y0]
4038 if {!$haspad} {
4039 # Find the first column that doesn't have a line going right
4040 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4041 set id [lindex $idlist $col]
4042 if {$id eq {}} break
4043 set x0 [lsearch -exact $previdlist $id]
4044 if {$x0 < 0} {
4045 # check if this is the link to the first child
4046 set kid [lindex $displayorder $y0]
4047 if {[lindex $children($curview,$id) 0] eq $kid} {
4048 # it is, work out offset to child
4049 set x0 [lsearch -exact $previdlist $kid]
4052 if {$x0 <= $col} break
4054 # Insert a pad at that column as long as it has a line and
4055 # isn't the last column
4056 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4057 set idlist [linsert $idlist $col {}]
4058 lset rowidlist $row $idlist
4059 changedrow $row
4065 proc xc {row col} {
4066 global canvx0 linespc
4067 return [expr {$canvx0 + $col * $linespc}]
4070 proc yc {row} {
4071 global canvy0 linespc
4072 return [expr {$canvy0 + $row * $linespc}]
4075 proc linewidth {id} {
4076 global thickerline lthickness
4078 set wid $lthickness
4079 if {[info exists thickerline] && $id eq $thickerline} {
4080 set wid [expr {2 * $lthickness}]
4082 return $wid
4085 proc rowranges {id} {
4086 global curview children uparrowlen downarrowlen
4087 global rowidlist
4089 set kids $children($curview,$id)
4090 if {$kids eq {}} {
4091 return {}
4093 set ret {}
4094 lappend kids $id
4095 foreach child $kids {
4096 if {![commitinview $child $curview]} break
4097 set row [rowofcommit $child]
4098 if {![info exists prev]} {
4099 lappend ret [expr {$row + 1}]
4100 } else {
4101 if {$row <= $prevrow} {
4102 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4104 # see if the line extends the whole way from prevrow to row
4105 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4106 [lsearch -exact [lindex $rowidlist \
4107 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4108 # it doesn't, see where it ends
4109 set r [expr {$prevrow + $downarrowlen}]
4110 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4111 while {[incr r -1] > $prevrow &&
4112 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4113 } else {
4114 while {[incr r] <= $row &&
4115 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4116 incr r -1
4118 lappend ret $r
4119 # see where it starts up again
4120 set r [expr {$row - $uparrowlen}]
4121 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4122 while {[incr r] < $row &&
4123 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4124 } else {
4125 while {[incr r -1] >= $prevrow &&
4126 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4127 incr r
4129 lappend ret $r
4132 if {$child eq $id} {
4133 lappend ret $row
4135 set prev $child
4136 set prevrow $row
4138 return $ret
4141 proc drawlineseg {id row endrow arrowlow} {
4142 global rowidlist displayorder iddrawn linesegs
4143 global canv colormap linespc curview maxlinelen parentlist
4145 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4146 set le [expr {$row + 1}]
4147 set arrowhigh 1
4148 while {1} {
4149 set c [lsearch -exact [lindex $rowidlist $le] $id]
4150 if {$c < 0} {
4151 incr le -1
4152 break
4154 lappend cols $c
4155 set x [lindex $displayorder $le]
4156 if {$x eq $id} {
4157 set arrowhigh 0
4158 break
4160 if {[info exists iddrawn($x)] || $le == $endrow} {
4161 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4162 if {$c >= 0} {
4163 lappend cols $c
4164 set arrowhigh 0
4166 break
4168 incr le
4170 if {$le <= $row} {
4171 return $row
4174 set lines {}
4175 set i 0
4176 set joinhigh 0
4177 if {[info exists linesegs($id)]} {
4178 set lines $linesegs($id)
4179 foreach li $lines {
4180 set r0 [lindex $li 0]
4181 if {$r0 > $row} {
4182 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4183 set joinhigh 1
4185 break
4187 incr i
4190 set joinlow 0
4191 if {$i > 0} {
4192 set li [lindex $lines [expr {$i-1}]]
4193 set r1 [lindex $li 1]
4194 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4195 set joinlow 1
4199 set x [lindex $cols [expr {$le - $row}]]
4200 set xp [lindex $cols [expr {$le - 1 - $row}]]
4201 set dir [expr {$xp - $x}]
4202 if {$joinhigh} {
4203 set ith [lindex $lines $i 2]
4204 set coords [$canv coords $ith]
4205 set ah [$canv itemcget $ith -arrow]
4206 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4207 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4208 if {$x2 ne {} && $x - $x2 == $dir} {
4209 set coords [lrange $coords 0 end-2]
4211 } else {
4212 set coords [list [xc $le $x] [yc $le]]
4214 if {$joinlow} {
4215 set itl [lindex $lines [expr {$i-1}] 2]
4216 set al [$canv itemcget $itl -arrow]
4217 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4218 } elseif {$arrowlow} {
4219 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4220 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4221 set arrowlow 0
4224 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4225 for {set y $le} {[incr y -1] > $row} {} {
4226 set x $xp
4227 set xp [lindex $cols [expr {$y - 1 - $row}]]
4228 set ndir [expr {$xp - $x}]
4229 if {$dir != $ndir || $xp < 0} {
4230 lappend coords [xc $y $x] [yc $y]
4232 set dir $ndir
4234 if {!$joinlow} {
4235 if {$xp < 0} {
4236 # join parent line to first child
4237 set ch [lindex $displayorder $row]
4238 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4239 if {$xc < 0} {
4240 puts "oops: drawlineseg: child $ch not on row $row"
4241 } elseif {$xc != $x} {
4242 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4243 set d [expr {int(0.5 * $linespc)}]
4244 set x1 [xc $row $x]
4245 if {$xc < $x} {
4246 set x2 [expr {$x1 - $d}]
4247 } else {
4248 set x2 [expr {$x1 + $d}]
4250 set y2 [yc $row]
4251 set y1 [expr {$y2 + $d}]
4252 lappend coords $x1 $y1 $x2 $y2
4253 } elseif {$xc < $x - 1} {
4254 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4255 } elseif {$xc > $x + 1} {
4256 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4258 set x $xc
4260 lappend coords [xc $row $x] [yc $row]
4261 } else {
4262 set xn [xc $row $xp]
4263 set yn [yc $row]
4264 lappend coords $xn $yn
4266 if {!$joinhigh} {
4267 assigncolor $id
4268 set t [$canv create line $coords -width [linewidth $id] \
4269 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4270 $canv lower $t
4271 bindline $t $id
4272 set lines [linsert $lines $i [list $row $le $t]]
4273 } else {
4274 $canv coords $ith $coords
4275 if {$arrow ne $ah} {
4276 $canv itemconf $ith -arrow $arrow
4278 lset lines $i 0 $row
4280 } else {
4281 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4282 set ndir [expr {$xo - $xp}]
4283 set clow [$canv coords $itl]
4284 if {$dir == $ndir} {
4285 set clow [lrange $clow 2 end]
4287 set coords [concat $coords $clow]
4288 if {!$joinhigh} {
4289 lset lines [expr {$i-1}] 1 $le
4290 } else {
4291 # coalesce two pieces
4292 $canv delete $ith
4293 set b [lindex $lines [expr {$i-1}] 0]
4294 set e [lindex $lines $i 1]
4295 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4297 $canv coords $itl $coords
4298 if {$arrow ne $al} {
4299 $canv itemconf $itl -arrow $arrow
4303 set linesegs($id) $lines
4304 return $le
4307 proc drawparentlinks {id row} {
4308 global rowidlist canv colormap curview parentlist
4309 global idpos linespc
4311 set rowids [lindex $rowidlist $row]
4312 set col [lsearch -exact $rowids $id]
4313 if {$col < 0} return
4314 set olds [lindex $parentlist $row]
4315 set row2 [expr {$row + 1}]
4316 set x [xc $row $col]
4317 set y [yc $row]
4318 set y2 [yc $row2]
4319 set d [expr {int(0.5 * $linespc)}]
4320 set ymid [expr {$y + $d}]
4321 set ids [lindex $rowidlist $row2]
4322 # rmx = right-most X coord used
4323 set rmx 0
4324 foreach p $olds {
4325 set i [lsearch -exact $ids $p]
4326 if {$i < 0} {
4327 puts "oops, parent $p of $id not in list"
4328 continue
4330 set x2 [xc $row2 $i]
4331 if {$x2 > $rmx} {
4332 set rmx $x2
4334 set j [lsearch -exact $rowids $p]
4335 if {$j < 0} {
4336 # drawlineseg will do this one for us
4337 continue
4339 assigncolor $p
4340 # should handle duplicated parents here...
4341 set coords [list $x $y]
4342 if {$i != $col} {
4343 # if attaching to a vertical segment, draw a smaller
4344 # slant for visual distinctness
4345 if {$i == $j} {
4346 if {$i < $col} {
4347 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4348 } else {
4349 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4351 } elseif {$i < $col && $i < $j} {
4352 # segment slants towards us already
4353 lappend coords [xc $row $j] $y
4354 } else {
4355 if {$i < $col - 1} {
4356 lappend coords [expr {$x2 + $linespc}] $y
4357 } elseif {$i > $col + 1} {
4358 lappend coords [expr {$x2 - $linespc}] $y
4360 lappend coords $x2 $y2
4362 } else {
4363 lappend coords $x2 $y2
4365 set t [$canv create line $coords -width [linewidth $p] \
4366 -fill $colormap($p) -tags lines.$p]
4367 $canv lower $t
4368 bindline $t $p
4370 if {$rmx > [lindex $idpos($id) 1]} {
4371 lset idpos($id) 1 $rmx
4372 redrawtags $id
4376 proc drawlines {id} {
4377 global canv
4379 $canv itemconf lines.$id -width [linewidth $id]
4382 proc drawcmittext {id row col} {
4383 global linespc canv canv2 canv3 fgcolor curview
4384 global cmitlisted commitinfo rowidlist parentlist
4385 global rowtextx idpos idtags idheads idotherrefs
4386 global linehtag linentag linedtag selectedline
4387 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4389 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
4390 set listed $cmitlisted($curview,$id)
4391 if {$id eq $nullid} {
4392 set ofill red
4393 } elseif {$id eq $nullid2} {
4394 set ofill green
4395 } else {
4396 set ofill [expr {$listed != 0? "blue": "white"}]
4398 set x [xc $row $col]
4399 set y [yc $row]
4400 set orad [expr {$linespc / 3}]
4401 if {$listed <= 1} {
4402 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4403 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4404 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4405 } elseif {$listed == 2} {
4406 # triangle pointing left for left-side commits
4407 set t [$canv create polygon \
4408 [expr {$x - $orad}] $y \
4409 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4410 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4411 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4412 } else {
4413 # triangle pointing right for right-side commits
4414 set t [$canv create polygon \
4415 [expr {$x + $orad - 1}] $y \
4416 [expr {$x - $orad}] [expr {$y - $orad}] \
4417 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4418 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4420 $canv raise $t
4421 $canv bind $t <1> {selcanvline {} %x %y}
4422 set rmx [llength [lindex $rowidlist $row]]
4423 set olds [lindex $parentlist $row]
4424 if {$olds ne {}} {
4425 set nextids [lindex $rowidlist [expr {$row + 1}]]
4426 foreach p $olds {
4427 set i [lsearch -exact $nextids $p]
4428 if {$i > $rmx} {
4429 set rmx $i
4433 set xt [xc $row $rmx]
4434 set rowtextx($row) $xt
4435 set idpos($id) [list $x $xt $y]
4436 if {[info exists idtags($id)] || [info exists idheads($id)]
4437 || [info exists idotherrefs($id)]} {
4438 set xt [drawtags $id $x $xt $y]
4440 set headline [lindex $commitinfo($id) 0]
4441 set name [lindex $commitinfo($id) 1]
4442 set date [lindex $commitinfo($id) 2]
4443 set date [formatdate $date]
4444 set font mainfont
4445 set nfont mainfont
4446 set isbold [ishighlighted $id]
4447 if {$isbold > 0} {
4448 lappend boldrows $row
4449 set font mainfontbold
4450 if {$isbold > 1} {
4451 lappend boldnamerows $row
4452 set nfont mainfontbold
4455 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4456 -text $headline -font $font -tags text]
4457 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4458 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4459 -text $name -font $nfont -tags text]
4460 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4461 -text $date -font mainfont -tags text]
4462 if {[info exists selectedline] && $selectedline == $row} {
4463 make_secsel $row
4465 set xr [expr {$xt + [font measure $font $headline]}]
4466 if {$xr > $canvxmax} {
4467 set canvxmax $xr
4468 setcanvscroll
4472 proc drawcmitrow {row} {
4473 global displayorder rowidlist nrows_drawn
4474 global iddrawn markingmatches
4475 global commitinfo numcommits
4476 global filehighlight fhighlights findpattern nhighlights
4477 global hlview vhighlights
4478 global highlight_related rhighlights
4480 if {$row >= $numcommits} return
4482 set id [lindex $displayorder $row]
4483 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4484 askvhighlight $row $id
4486 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4487 askfilehighlight $row $id
4489 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4490 askfindhighlight $row $id
4492 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4493 askrelhighlight $row $id
4495 if {![info exists iddrawn($id)]} {
4496 set col [lsearch -exact [lindex $rowidlist $row] $id]
4497 if {$col < 0} {
4498 puts "oops, row $row id $id not in list"
4499 return
4501 if {![info exists commitinfo($id)]} {
4502 getcommit $id
4504 assigncolor $id
4505 drawcmittext $id $row $col
4506 set iddrawn($id) 1
4507 incr nrows_drawn
4509 if {$markingmatches} {
4510 markrowmatches $row $id
4514 proc drawcommits {row {endrow {}}} {
4515 global numcommits iddrawn displayorder curview need_redisplay
4516 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4518 if {$row < 0} {
4519 set row 0
4521 if {$endrow eq {}} {
4522 set endrow $row
4524 if {$endrow >= $numcommits} {
4525 set endrow [expr {$numcommits - 1}]
4528 set rl1 [expr {$row - $downarrowlen - 3}]
4529 if {$rl1 < 0} {
4530 set rl1 0
4532 set ro1 [expr {$row - 3}]
4533 if {$ro1 < 0} {
4534 set ro1 0
4536 set r2 [expr {$endrow + $uparrowlen + 3}]
4537 if {$r2 > $numcommits} {
4538 set r2 $numcommits
4540 for {set r $rl1} {$r < $r2} {incr r} {
4541 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4542 if {$rl1 < $r} {
4543 layoutrows $rl1 $r
4545 set rl1 [expr {$r + 1}]
4548 if {$rl1 < $r} {
4549 layoutrows $rl1 $r
4551 optimize_rows $ro1 0 $r2
4552 if {$need_redisplay || $nrows_drawn > 2000} {
4553 clear_display
4554 drawvisible
4557 # make the lines join to already-drawn rows either side
4558 set r [expr {$row - 1}]
4559 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4560 set r $row
4562 set er [expr {$endrow + 1}]
4563 if {$er >= $numcommits ||
4564 ![info exists iddrawn([lindex $displayorder $er])]} {
4565 set er $endrow
4567 for {} {$r <= $er} {incr r} {
4568 set id [lindex $displayorder $r]
4569 set wasdrawn [info exists iddrawn($id)]
4570 drawcmitrow $r
4571 if {$r == $er} break
4572 set nextid [lindex $displayorder [expr {$r + 1}]]
4573 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4574 drawparentlinks $id $r
4576 set rowids [lindex $rowidlist $r]
4577 foreach lid $rowids {
4578 if {$lid eq {}} continue
4579 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4580 if {$lid eq $id} {
4581 # see if this is the first child of any of its parents
4582 foreach p [lindex $parentlist $r] {
4583 if {[lsearch -exact $rowids $p] < 0} {
4584 # make this line extend up to the child
4585 set lineend($p) [drawlineseg $p $r $er 0]
4588 } else {
4589 set lineend($lid) [drawlineseg $lid $r $er 1]
4595 proc undolayout {row} {
4596 global uparrowlen mingaplen downarrowlen
4597 global rowidlist rowisopt rowfinal need_redisplay
4599 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4600 if {$r < 0} {
4601 set r 0
4603 if {[llength $rowidlist] > $r} {
4604 incr r -1
4605 set rowidlist [lrange $rowidlist 0 $r]
4606 set rowfinal [lrange $rowfinal 0 $r]
4607 set rowisopt [lrange $rowisopt 0 $r]
4608 set need_redisplay 1
4609 run drawvisible
4613 proc drawvisible {} {
4614 global canv linespc curview vrowmod selectedline targetrow targetid
4615 global need_redisplay cscroll numcommits
4617 set fs [$canv yview]
4618 set ymax [lindex [$canv cget -scrollregion] 3]
4619 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
4620 set f0 [lindex $fs 0]
4621 set f1 [lindex $fs 1]
4622 set y0 [expr {int($f0 * $ymax)}]
4623 set y1 [expr {int($f1 * $ymax)}]
4625 if {[info exists targetid]} {
4626 if {[commitinview $targetid $curview]} {
4627 set r [rowofcommit $targetid]
4628 if {$r != $targetrow} {
4629 # Fix up the scrollregion and change the scrolling position
4630 # now that our target row has moved.
4631 set diff [expr {($r - $targetrow) * $linespc}]
4632 set targetrow $r
4633 setcanvscroll
4634 set ymax [lindex [$canv cget -scrollregion] 3]
4635 incr y0 $diff
4636 incr y1 $diff
4637 set f0 [expr {$y0 / $ymax}]
4638 set f1 [expr {$y1 / $ymax}]
4639 allcanvs yview moveto $f0
4640 $cscroll set $f0 $f1
4641 set need_redisplay 1
4643 } else {
4644 unset targetid
4648 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4649 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4650 if {$endrow >= $vrowmod($curview)} {
4651 update_arcrows $curview
4653 if {[info exists selectedline] &&
4654 $row <= $selectedline && $selectedline <= $endrow} {
4655 set targetrow $selectedline
4656 } else {
4657 set targetrow [expr {int(($row + $endrow) / 2)}]
4659 if {$targetrow >= $numcommits} {
4660 set targetrow [expr {$numcommits - 1}]
4662 set targetid [commitonrow $targetrow]
4663 drawcommits $row $endrow
4666 proc clear_display {} {
4667 global iddrawn linesegs need_redisplay nrows_drawn
4668 global vhighlights fhighlights nhighlights rhighlights
4670 allcanvs delete all
4671 catch {unset iddrawn}
4672 catch {unset linesegs}
4673 catch {unset vhighlights}
4674 catch {unset fhighlights}
4675 catch {unset nhighlights}
4676 catch {unset rhighlights}
4677 set need_redisplay 0
4678 set nrows_drawn 0
4681 proc findcrossings {id} {
4682 global rowidlist parentlist numcommits displayorder
4684 set cross {}
4685 set ccross {}
4686 foreach {s e} [rowranges $id] {
4687 if {$e >= $numcommits} {
4688 set e [expr {$numcommits - 1}]
4690 if {$e <= $s} continue
4691 for {set row $e} {[incr row -1] >= $s} {} {
4692 set x [lsearch -exact [lindex $rowidlist $row] $id]
4693 if {$x < 0} break
4694 set olds [lindex $parentlist $row]
4695 set kid [lindex $displayorder $row]
4696 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4697 if {$kidx < 0} continue
4698 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4699 foreach p $olds {
4700 set px [lsearch -exact $nextrow $p]
4701 if {$px < 0} continue
4702 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4703 if {[lsearch -exact $ccross $p] >= 0} continue
4704 if {$x == $px + ($kidx < $px? -1: 1)} {
4705 lappend ccross $p
4706 } elseif {[lsearch -exact $cross $p] < 0} {
4707 lappend cross $p
4713 return [concat $ccross {{}} $cross]
4716 proc assigncolor {id} {
4717 global colormap colors nextcolor
4718 global parents children children curview
4720 if {[info exists colormap($id)]} return
4721 set ncolors [llength $colors]
4722 if {[info exists children($curview,$id)]} {
4723 set kids $children($curview,$id)
4724 } else {
4725 set kids {}
4727 if {[llength $kids] == 1} {
4728 set child [lindex $kids 0]
4729 if {[info exists colormap($child)]
4730 && [llength $parents($curview,$child)] == 1} {
4731 set colormap($id) $colormap($child)
4732 return
4735 set badcolors {}
4736 set origbad {}
4737 foreach x [findcrossings $id] {
4738 if {$x eq {}} {
4739 # delimiter between corner crossings and other crossings
4740 if {[llength $badcolors] >= $ncolors - 1} break
4741 set origbad $badcolors
4743 if {[info exists colormap($x)]
4744 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4745 lappend badcolors $colormap($x)
4748 if {[llength $badcolors] >= $ncolors} {
4749 set badcolors $origbad
4751 set origbad $badcolors
4752 if {[llength $badcolors] < $ncolors - 1} {
4753 foreach child $kids {
4754 if {[info exists colormap($child)]
4755 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4756 lappend badcolors $colormap($child)
4758 foreach p $parents($curview,$child) {
4759 if {[info exists colormap($p)]
4760 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4761 lappend badcolors $colormap($p)
4765 if {[llength $badcolors] >= $ncolors} {
4766 set badcolors $origbad
4769 for {set i 0} {$i <= $ncolors} {incr i} {
4770 set c [lindex $colors $nextcolor]
4771 if {[incr nextcolor] >= $ncolors} {
4772 set nextcolor 0
4774 if {[lsearch -exact $badcolors $c]} break
4776 set colormap($id) $c
4779 proc bindline {t id} {
4780 global canv
4782 $canv bind $t <Enter> "lineenter %x %y $id"
4783 $canv bind $t <Motion> "linemotion %x %y $id"
4784 $canv bind $t <Leave> "lineleave $id"
4785 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4788 proc drawtags {id x xt y1} {
4789 global idtags idheads idotherrefs mainhead
4790 global linespc lthickness
4791 global canv rowtextx curview fgcolor bgcolor
4793 set marks {}
4794 set ntags 0
4795 set nheads 0
4796 if {[info exists idtags($id)]} {
4797 set marks $idtags($id)
4798 set ntags [llength $marks]
4800 if {[info exists idheads($id)]} {
4801 set marks [concat $marks $idheads($id)]
4802 set nheads [llength $idheads($id)]
4804 if {[info exists idotherrefs($id)]} {
4805 set marks [concat $marks $idotherrefs($id)]
4807 if {$marks eq {}} {
4808 return $xt
4811 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4812 set yt [expr {$y1 - 0.5 * $linespc}]
4813 set yb [expr {$yt + $linespc - 1}]
4814 set xvals {}
4815 set wvals {}
4816 set i -1
4817 foreach tag $marks {
4818 incr i
4819 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4820 set wid [font measure mainfontbold $tag]
4821 } else {
4822 set wid [font measure mainfont $tag]
4824 lappend xvals $xt
4825 lappend wvals $wid
4826 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4828 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4829 -width $lthickness -fill black -tags tag.$id]
4830 $canv lower $t
4831 foreach tag $marks x $xvals wid $wvals {
4832 set xl [expr {$x + $delta}]
4833 set xr [expr {$x + $delta + $wid + $lthickness}]
4834 set font mainfont
4835 if {[incr ntags -1] >= 0} {
4836 # draw a tag
4837 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4838 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4839 -width 1 -outline black -fill yellow -tags tag.$id]
4840 $canv bind $t <1> [list showtag $tag 1]
4841 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4842 } else {
4843 # draw a head or other ref
4844 if {[incr nheads -1] >= 0} {
4845 set col green
4846 if {$tag eq $mainhead} {
4847 set font mainfontbold
4849 } else {
4850 set col "#ddddff"
4852 set xl [expr {$xl - $delta/2}]
4853 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4854 -width 1 -outline black -fill $col -tags tag.$id
4855 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4856 set rwid [font measure mainfont $remoteprefix]
4857 set xi [expr {$x + 1}]
4858 set yti [expr {$yt + 1}]
4859 set xri [expr {$x + $rwid}]
4860 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4861 -width 0 -fill "#ffddaa" -tags tag.$id
4864 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4865 -font $font -tags [list tag.$id text]]
4866 if {$ntags >= 0} {
4867 $canv bind $t <1> [list showtag $tag 1]
4868 } elseif {$nheads >= 0} {
4869 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4872 return $xt
4875 proc xcoord {i level ln} {
4876 global canvx0 xspc1 xspc2
4878 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4879 if {$i > 0 && $i == $level} {
4880 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4881 } elseif {$i > $level} {
4882 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4884 return $x
4887 proc show_status {msg} {
4888 global canv fgcolor
4890 clear_display
4891 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4892 -tags text -fill $fgcolor
4895 # Don't change the text pane cursor if it is currently the hand cursor,
4896 # showing that we are over a sha1 ID link.
4897 proc settextcursor {c} {
4898 global ctext curtextcursor
4900 if {[$ctext cget -cursor] == $curtextcursor} {
4901 $ctext config -cursor $c
4903 set curtextcursor $c
4906 proc nowbusy {what {name {}}} {
4907 global isbusy busyname statusw
4909 if {[array names isbusy] eq {}} {
4910 . config -cursor watch
4911 settextcursor watch
4913 set isbusy($what) 1
4914 set busyname($what) $name
4915 if {$name ne {}} {
4916 $statusw conf -text $name
4920 proc notbusy {what} {
4921 global isbusy maincursor textcursor busyname statusw
4923 catch {
4924 unset isbusy($what)
4925 if {$busyname($what) ne {} &&
4926 [$statusw cget -text] eq $busyname($what)} {
4927 $statusw conf -text {}
4930 if {[array names isbusy] eq {}} {
4931 . config -cursor $maincursor
4932 settextcursor $textcursor
4936 proc findmatches {f} {
4937 global findtype findstring
4938 if {$findtype == [mc "Regexp"]} {
4939 set matches [regexp -indices -all -inline $findstring $f]
4940 } else {
4941 set fs $findstring
4942 if {$findtype == [mc "IgnCase"]} {
4943 set f [string tolower $f]
4944 set fs [string tolower $fs]
4946 set matches {}
4947 set i 0
4948 set l [string length $fs]
4949 while {[set j [string first $fs $f $i]] >= 0} {
4950 lappend matches [list $j [expr {$j+$l-1}]]
4951 set i [expr {$j + $l}]
4954 return $matches
4957 proc dofind {{dirn 1} {wrap 1}} {
4958 global findstring findstartline findcurline selectedline numcommits
4959 global gdttype filehighlight fh_serial find_dirn findallowwrap
4961 if {[info exists find_dirn]} {
4962 if {$find_dirn == $dirn} return
4963 stopfinding
4965 focus .
4966 if {$findstring eq {} || $numcommits == 0} return
4967 if {![info exists selectedline]} {
4968 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4969 } else {
4970 set findstartline $selectedline
4972 set findcurline $findstartline
4973 nowbusy finding [mc "Searching"]
4974 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4975 after cancel do_file_hl $fh_serial
4976 do_file_hl $fh_serial
4978 set find_dirn $dirn
4979 set findallowwrap $wrap
4980 run findmore
4983 proc stopfinding {} {
4984 global find_dirn findcurline fprogcoord
4986 if {[info exists find_dirn]} {
4987 unset find_dirn
4988 unset findcurline
4989 notbusy finding
4990 set fprogcoord 0
4991 adjustprogress
4995 proc findmore {} {
4996 global commitdata commitinfo numcommits findpattern findloc
4997 global findstartline findcurline findallowwrap
4998 global find_dirn gdttype fhighlights fprogcoord
4999 global curview varcorder vrownum varccommits vrowmod
5001 if {![info exists find_dirn]} {
5002 return 0
5004 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5005 set l $findcurline
5006 set moretodo 0
5007 if {$find_dirn > 0} {
5008 incr l
5009 if {$l >= $numcommits} {
5010 set l 0
5012 if {$l <= $findstartline} {
5013 set lim [expr {$findstartline + 1}]
5014 } else {
5015 set lim $numcommits
5016 set moretodo $findallowwrap
5018 } else {
5019 if {$l == 0} {
5020 set l $numcommits
5022 incr l -1
5023 if {$l >= $findstartline} {
5024 set lim [expr {$findstartline - 1}]
5025 } else {
5026 set lim -1
5027 set moretodo $findallowwrap
5030 set n [expr {($lim - $l) * $find_dirn}]
5031 if {$n > 500} {
5032 set n 500
5033 set moretodo 1
5035 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5036 update_arcrows $curview
5038 set found 0
5039 set domore 1
5040 set ai [bsearch $vrownum($curview) $l]
5041 set a [lindex $varcorder($curview) $ai]
5042 set arow [lindex $vrownum($curview) $ai]
5043 set ids [lindex $varccommits($curview,$a)]
5044 set arowend [expr {$arow + [llength $ids]}]
5045 if {$gdttype eq [mc "containing:"]} {
5046 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5047 if {$l < $arow || $l >= $arowend} {
5048 incr ai $find_dirn
5049 set a [lindex $varcorder($curview) $ai]
5050 set arow [lindex $vrownum($curview) $ai]
5051 set ids [lindex $varccommits($curview,$a)]
5052 set arowend [expr {$arow + [llength $ids]}]
5054 set id [lindex $ids [expr {$l - $arow}]]
5055 # shouldn't happen unless git log doesn't give all the commits...
5056 if {![info exists commitdata($id)] ||
5057 ![doesmatch $commitdata($id)]} {
5058 continue
5060 if {![info exists commitinfo($id)]} {
5061 getcommit $id
5063 set info $commitinfo($id)
5064 foreach f $info ty $fldtypes {
5065 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5066 [doesmatch $f]} {
5067 set found 1
5068 break
5071 if {$found} break
5073 } else {
5074 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5075 if {$l < $arow || $l >= $arowend} {
5076 incr ai $find_dirn
5077 set a [lindex $varcorder($curview) $ai]
5078 set arow [lindex $vrownum($curview) $ai]
5079 set ids [lindex $varccommits($curview,$a)]
5080 set arowend [expr {$arow + [llength $ids]}]
5082 set id [lindex $ids [expr {$l - $arow}]]
5083 if {![info exists fhighlights($id)]} {
5084 # this sets fhighlights($id) to -1
5085 askfilehighlight $l $id
5087 if {$fhighlights($id) > 0} {
5088 set found $domore
5089 break
5091 if {$fhighlights($id) < 0} {
5092 if {$domore} {
5093 set domore 0
5094 set findcurline [expr {$l - $find_dirn}]
5099 if {$found || ($domore && !$moretodo)} {
5100 unset findcurline
5101 unset find_dirn
5102 notbusy finding
5103 set fprogcoord 0
5104 adjustprogress
5105 if {$found} {
5106 findselectline $l
5107 } else {
5108 bell
5110 return 0
5112 if {!$domore} {
5113 flushhighlights
5114 } else {
5115 set findcurline [expr {$l - $find_dirn}]
5117 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5118 if {$n < 0} {
5119 incr n $numcommits
5121 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5122 adjustprogress
5123 return $domore
5126 proc findselectline {l} {
5127 global findloc commentend ctext findcurline markingmatches gdttype
5129 set markingmatches 1
5130 set findcurline $l
5131 selectline $l 1
5132 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5133 # highlight the matches in the comments
5134 set f [$ctext get 1.0 $commentend]
5135 set matches [findmatches $f]
5136 foreach match $matches {
5137 set start [lindex $match 0]
5138 set end [expr {[lindex $match 1] + 1}]
5139 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5142 drawvisible
5145 # mark the bits of a headline or author that match a find string
5146 proc markmatches {canv l str tag matches font row} {
5147 global selectedline
5149 set bbox [$canv bbox $tag]
5150 set x0 [lindex $bbox 0]
5151 set y0 [lindex $bbox 1]
5152 set y1 [lindex $bbox 3]
5153 foreach match $matches {
5154 set start [lindex $match 0]
5155 set end [lindex $match 1]
5156 if {$start > $end} continue
5157 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5158 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5159 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5160 [expr {$x0+$xlen+2}] $y1 \
5161 -outline {} -tags [list match$l matches] -fill yellow]
5162 $canv lower $t
5163 if {[info exists selectedline] && $row == $selectedline} {
5164 $canv raise $t secsel
5169 proc unmarkmatches {} {
5170 global markingmatches
5172 allcanvs delete matches
5173 set markingmatches 0
5174 stopfinding
5177 proc selcanvline {w x y} {
5178 global canv canvy0 ctext linespc
5179 global rowtextx
5180 set ymax [lindex [$canv cget -scrollregion] 3]
5181 if {$ymax == {}} return
5182 set yfrac [lindex [$canv yview] 0]
5183 set y [expr {$y + $yfrac * $ymax}]
5184 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5185 if {$l < 0} {
5186 set l 0
5188 if {$w eq $canv} {
5189 set xmax [lindex [$canv cget -scrollregion] 2]
5190 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5191 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5193 unmarkmatches
5194 selectline $l 1
5197 proc commit_descriptor {p} {
5198 global commitinfo
5199 if {![info exists commitinfo($p)]} {
5200 getcommit $p
5202 set l "..."
5203 if {[llength $commitinfo($p)] > 1} {
5204 set l [lindex $commitinfo($p) 0]
5206 return "$p ($l)\n"
5209 # append some text to the ctext widget, and make any SHA1 ID
5210 # that we know about be a clickable link.
5211 proc appendwithlinks {text tags} {
5212 global ctext linknum curview pendinglinks
5214 set start [$ctext index "end - 1c"]
5215 $ctext insert end $text $tags
5216 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5217 foreach l $links {
5218 set s [lindex $l 0]
5219 set e [lindex $l 1]
5220 set linkid [string range $text $s $e]
5221 incr e
5222 $ctext tag delete link$linknum
5223 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5224 setlink $linkid link$linknum
5225 incr linknum
5229 proc setlink {id lk} {
5230 global curview ctext pendinglinks commitinterest
5232 if {[commitinview $id $curview]} {
5233 $ctext tag conf $lk -foreground blue -underline 1
5234 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5235 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5236 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5237 } else {
5238 lappend pendinglinks($id) $lk
5239 lappend commitinterest($id) {makelink %I}
5243 proc makelink {id} {
5244 global pendinglinks
5246 if {![info exists pendinglinks($id)]} return
5247 foreach lk $pendinglinks($id) {
5248 setlink $id $lk
5250 unset pendinglinks($id)
5253 proc linkcursor {w inc} {
5254 global linkentercount curtextcursor
5256 if {[incr linkentercount $inc] > 0} {
5257 $w configure -cursor hand2
5258 } else {
5259 $w configure -cursor $curtextcursor
5260 if {$linkentercount < 0} {
5261 set linkentercount 0
5266 proc viewnextline {dir} {
5267 global canv linespc
5269 $canv delete hover
5270 set ymax [lindex [$canv cget -scrollregion] 3]
5271 set wnow [$canv yview]
5272 set wtop [expr {[lindex $wnow 0] * $ymax}]
5273 set newtop [expr {$wtop + $dir * $linespc}]
5274 if {$newtop < 0} {
5275 set newtop 0
5276 } elseif {$newtop > $ymax} {
5277 set newtop $ymax
5279 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5282 # add a list of tag or branch names at position pos
5283 # returns the number of names inserted
5284 proc appendrefs {pos ids var} {
5285 global ctext linknum curview $var maxrefs
5287 if {[catch {$ctext index $pos}]} {
5288 return 0
5290 $ctext conf -state normal
5291 $ctext delete $pos "$pos lineend"
5292 set tags {}
5293 foreach id $ids {
5294 foreach tag [set $var\($id\)] {
5295 lappend tags [list $tag $id]
5298 if {[llength $tags] > $maxrefs} {
5299 $ctext insert $pos "many ([llength $tags])"
5300 } else {
5301 set tags [lsort -index 0 -decreasing $tags]
5302 set sep {}
5303 foreach ti $tags {
5304 set id [lindex $ti 1]
5305 set lk link$linknum
5306 incr linknum
5307 $ctext tag delete $lk
5308 $ctext insert $pos $sep
5309 $ctext insert $pos [lindex $ti 0] $lk
5310 setlink $id $lk
5311 set sep ", "
5314 $ctext conf -state disabled
5315 return [llength $tags]
5318 # called when we have finished computing the nearby tags
5319 proc dispneartags {delay} {
5320 global selectedline currentid showneartags tagphase
5322 if {![info exists selectedline] || !$showneartags} return
5323 after cancel dispnexttag
5324 if {$delay} {
5325 after 200 dispnexttag
5326 set tagphase -1
5327 } else {
5328 after idle dispnexttag
5329 set tagphase 0
5333 proc dispnexttag {} {
5334 global selectedline currentid showneartags tagphase ctext
5336 if {![info exists selectedline] || !$showneartags} return
5337 switch -- $tagphase {
5339 set dtags [desctags $currentid]
5340 if {$dtags ne {}} {
5341 appendrefs precedes $dtags idtags
5345 set atags [anctags $currentid]
5346 if {$atags ne {}} {
5347 appendrefs follows $atags idtags
5351 set dheads [descheads $currentid]
5352 if {$dheads ne {}} {
5353 if {[appendrefs branch $dheads idheads] > 1
5354 && [$ctext get "branch -3c"] eq "h"} {
5355 # turn "Branch" into "Branches"
5356 $ctext conf -state normal
5357 $ctext insert "branch -2c" "es"
5358 $ctext conf -state disabled
5363 if {[incr tagphase] <= 2} {
5364 after idle dispnexttag
5368 proc make_secsel {l} {
5369 global linehtag linentag linedtag canv canv2 canv3
5371 if {![info exists linehtag($l)]} return
5372 $canv delete secsel
5373 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5374 -tags secsel -fill [$canv cget -selectbackground]]
5375 $canv lower $t
5376 $canv2 delete secsel
5377 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5378 -tags secsel -fill [$canv2 cget -selectbackground]]
5379 $canv2 lower $t
5380 $canv3 delete secsel
5381 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5382 -tags secsel -fill [$canv3 cget -selectbackground]]
5383 $canv3 lower $t
5386 proc selectline {l isnew} {
5387 global canv ctext commitinfo selectedline
5388 global canvy0 linespc parents children curview
5389 global currentid sha1entry
5390 global commentend idtags linknum
5391 global mergemax numcommits pending_select
5392 global cmitmode showneartags allcommits
5393 global targetrow targetid
5395 catch {unset pending_select}
5396 $canv delete hover
5397 normalline
5398 unsel_reflist
5399 stopfinding
5400 if {$l < 0 || $l >= $numcommits} return
5401 set y [expr {$canvy0 + $l * $linespc}]
5402 set ymax [lindex [$canv cget -scrollregion] 3]
5403 set ytop [expr {$y - $linespc - 1}]
5404 set ybot [expr {$y + $linespc + 1}]
5405 set wnow [$canv yview]
5406 set wtop [expr {[lindex $wnow 0] * $ymax}]
5407 set wbot [expr {[lindex $wnow 1] * $ymax}]
5408 set wh [expr {$wbot - $wtop}]
5409 set newtop $wtop
5410 if {$ytop < $wtop} {
5411 if {$ybot < $wtop} {
5412 set newtop [expr {$y - $wh / 2.0}]
5413 } else {
5414 set newtop $ytop
5415 if {$newtop > $wtop - $linespc} {
5416 set newtop [expr {$wtop - $linespc}]
5419 } elseif {$ybot > $wbot} {
5420 if {$ytop > $wbot} {
5421 set newtop [expr {$y - $wh / 2.0}]
5422 } else {
5423 set newtop [expr {$ybot - $wh}]
5424 if {$newtop < $wtop + $linespc} {
5425 set newtop [expr {$wtop + $linespc}]
5429 if {$newtop != $wtop} {
5430 if {$newtop < 0} {
5431 set newtop 0
5433 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5434 drawvisible
5437 make_secsel $l
5439 set id [commitonrow $l]
5440 if {$isnew} {
5441 addtohistory [list selbyid $id]
5444 set selectedline $l
5445 set currentid $id
5446 set targetid $id
5447 set targetrow $l
5448 $sha1entry delete 0 end
5449 $sha1entry insert 0 $id
5450 $sha1entry selection from 0
5451 $sha1entry selection to end
5452 rhighlight_sel $id
5454 $ctext conf -state normal
5455 clear_ctext
5456 set linknum 0
5457 set info $commitinfo($id)
5458 set date [formatdate [lindex $info 2]]
5459 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5460 set date [formatdate [lindex $info 4]]
5461 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5462 if {[info exists idtags($id)]} {
5463 $ctext insert end [mc "Tags:"]
5464 foreach tag $idtags($id) {
5465 $ctext insert end " $tag"
5467 $ctext insert end "\n"
5470 set headers {}
5471 set olds $parents($curview,$id)
5472 if {[llength $olds] > 1} {
5473 set np 0
5474 foreach p $olds {
5475 if {$np >= $mergemax} {
5476 set tag mmax
5477 } else {
5478 set tag m$np
5480 $ctext insert end "[mc "Parent"]: " $tag
5481 appendwithlinks [commit_descriptor $p] {}
5482 incr np
5484 } else {
5485 foreach p $olds {
5486 append headers "[mc "Parent"]: [commit_descriptor $p]"
5490 foreach c $children($curview,$id) {
5491 append headers "[mc "Child"]: [commit_descriptor $c]"
5494 # make anything that looks like a SHA1 ID be a clickable link
5495 appendwithlinks $headers {}
5496 if {$showneartags} {
5497 if {![info exists allcommits]} {
5498 getallcommits
5500 $ctext insert end "[mc "Branch"]: "
5501 $ctext mark set branch "end -1c"
5502 $ctext mark gravity branch left
5503 $ctext insert end "\n[mc "Follows"]: "
5504 $ctext mark set follows "end -1c"
5505 $ctext mark gravity follows left
5506 $ctext insert end "\n[mc "Precedes"]: "
5507 $ctext mark set precedes "end -1c"
5508 $ctext mark gravity precedes left
5509 $ctext insert end "\n"
5510 dispneartags 1
5512 $ctext insert end "\n"
5513 set comment [lindex $info 5]
5514 if {[string first "\r" $comment] >= 0} {
5515 set comment [string map {"\r" "\n "} $comment]
5517 appendwithlinks $comment {comment}
5519 $ctext tag remove found 1.0 end
5520 $ctext conf -state disabled
5521 set commentend [$ctext index "end - 1c"]
5523 init_flist [mc "Comments"]
5524 if {$cmitmode eq "tree"} {
5525 gettree $id
5526 } elseif {[llength $olds] <= 1} {
5527 startdiff $id
5528 } else {
5529 mergediff $id
5533 proc selfirstline {} {
5534 unmarkmatches
5535 selectline 0 1
5538 proc sellastline {} {
5539 global numcommits
5540 unmarkmatches
5541 set l [expr {$numcommits - 1}]
5542 selectline $l 1
5545 proc selnextline {dir} {
5546 global selectedline
5547 focus .
5548 if {![info exists selectedline]} return
5549 set l [expr {$selectedline + $dir}]
5550 unmarkmatches
5551 selectline $l 1
5554 proc selnextpage {dir} {
5555 global canv linespc selectedline numcommits
5557 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5558 if {$lpp < 1} {
5559 set lpp 1
5561 allcanvs yview scroll [expr {$dir * $lpp}] units
5562 drawvisible
5563 if {![info exists selectedline]} return
5564 set l [expr {$selectedline + $dir * $lpp}]
5565 if {$l < 0} {
5566 set l 0
5567 } elseif {$l >= $numcommits} {
5568 set l [expr $numcommits - 1]
5570 unmarkmatches
5571 selectline $l 1
5574 proc unselectline {} {
5575 global selectedline currentid
5577 catch {unset selectedline}
5578 catch {unset currentid}
5579 allcanvs delete secsel
5580 rhighlight_none
5583 proc reselectline {} {
5584 global selectedline
5586 if {[info exists selectedline]} {
5587 selectline $selectedline 0
5591 proc addtohistory {cmd} {
5592 global history historyindex curview
5594 set elt [list $curview $cmd]
5595 if {$historyindex > 0
5596 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5597 return
5600 if {$historyindex < [llength $history]} {
5601 set history [lreplace $history $historyindex end $elt]
5602 } else {
5603 lappend history $elt
5605 incr historyindex
5606 if {$historyindex > 1} {
5607 .tf.bar.leftbut conf -state normal
5608 } else {
5609 .tf.bar.leftbut conf -state disabled
5611 .tf.bar.rightbut conf -state disabled
5614 proc godo {elt} {
5615 global curview
5617 set view [lindex $elt 0]
5618 set cmd [lindex $elt 1]
5619 if {$curview != $view} {
5620 showview $view
5622 eval $cmd
5625 proc goback {} {
5626 global history historyindex
5627 focus .
5629 if {$historyindex > 1} {
5630 incr historyindex -1
5631 godo [lindex $history [expr {$historyindex - 1}]]
5632 .tf.bar.rightbut conf -state normal
5634 if {$historyindex <= 1} {
5635 .tf.bar.leftbut conf -state disabled
5639 proc goforw {} {
5640 global history historyindex
5641 focus .
5643 if {$historyindex < [llength $history]} {
5644 set cmd [lindex $history $historyindex]
5645 incr historyindex
5646 godo $cmd
5647 .tf.bar.leftbut conf -state normal
5649 if {$historyindex >= [llength $history]} {
5650 .tf.bar.rightbut conf -state disabled
5654 proc gettree {id} {
5655 global treefilelist treeidlist diffids diffmergeid treepending
5656 global nullid nullid2
5658 set diffids $id
5659 catch {unset diffmergeid}
5660 if {![info exists treefilelist($id)]} {
5661 if {![info exists treepending]} {
5662 if {$id eq $nullid} {
5663 set cmd [list | git ls-files]
5664 } elseif {$id eq $nullid2} {
5665 set cmd [list | git ls-files --stage -t]
5666 } else {
5667 set cmd [list | git ls-tree -r $id]
5669 if {[catch {set gtf [open $cmd r]}]} {
5670 return
5672 set treepending $id
5673 set treefilelist($id) {}
5674 set treeidlist($id) {}
5675 fconfigure $gtf -blocking 0
5676 filerun $gtf [list gettreeline $gtf $id]
5678 } else {
5679 setfilelist $id
5683 proc gettreeline {gtf id} {
5684 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5686 set nl 0
5687 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5688 if {$diffids eq $nullid} {
5689 set fname $line
5690 } else {
5691 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5692 set i [string first "\t" $line]
5693 if {$i < 0} continue
5694 set sha1 [lindex $line 2]
5695 set fname [string range $line [expr {$i+1}] end]
5696 if {[string index $fname 0] eq "\""} {
5697 set fname [lindex $fname 0]
5699 lappend treeidlist($id) $sha1
5701 lappend treefilelist($id) $fname
5703 if {![eof $gtf]} {
5704 return [expr {$nl >= 1000? 2: 1}]
5706 close $gtf
5707 unset treepending
5708 if {$cmitmode ne "tree"} {
5709 if {![info exists diffmergeid]} {
5710 gettreediffs $diffids
5712 } elseif {$id ne $diffids} {
5713 gettree $diffids
5714 } else {
5715 setfilelist $id
5717 return 0
5720 proc showfile {f} {
5721 global treefilelist treeidlist diffids nullid nullid2
5722 global ctext commentend
5724 set i [lsearch -exact $treefilelist($diffids) $f]
5725 if {$i < 0} {
5726 puts "oops, $f not in list for id $diffids"
5727 return
5729 if {$diffids eq $nullid} {
5730 if {[catch {set bf [open $f r]} err]} {
5731 puts "oops, can't read $f: $err"
5732 return
5734 } else {
5735 set blob [lindex $treeidlist($diffids) $i]
5736 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5737 puts "oops, error reading blob $blob: $err"
5738 return
5741 fconfigure $bf -blocking 0
5742 filerun $bf [list getblobline $bf $diffids]
5743 $ctext config -state normal
5744 clear_ctext $commentend
5745 $ctext insert end "\n"
5746 $ctext insert end "$f\n" filesep
5747 $ctext config -state disabled
5748 $ctext yview $commentend
5749 settabs 0
5752 proc getblobline {bf id} {
5753 global diffids cmitmode ctext
5755 if {$id ne $diffids || $cmitmode ne "tree"} {
5756 catch {close $bf}
5757 return 0
5759 $ctext config -state normal
5760 set nl 0
5761 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5762 $ctext insert end "$line\n"
5764 if {[eof $bf]} {
5765 # delete last newline
5766 $ctext delete "end - 2c" "end - 1c"
5767 close $bf
5768 return 0
5770 $ctext config -state disabled
5771 return [expr {$nl >= 1000? 2: 1}]
5774 proc mergediff {id} {
5775 global diffmergeid mdifffd
5776 global diffids
5777 global parents
5778 global limitdiffs viewfiles curview
5780 set diffmergeid $id
5781 set diffids $id
5782 # this doesn't seem to actually affect anything...
5783 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5784 if {$limitdiffs && $viewfiles($curview) ne {}} {
5785 set cmd [concat $cmd -- $viewfiles($curview)]
5787 if {[catch {set mdf [open $cmd r]} err]} {
5788 error_popup "[mc "Error getting merge diffs:"] $err"
5789 return
5791 fconfigure $mdf -blocking 0
5792 set mdifffd($id) $mdf
5793 set np [llength $parents($curview,$id)]
5794 settabs $np
5795 filerun $mdf [list getmergediffline $mdf $id $np]
5798 proc getmergediffline {mdf id np} {
5799 global diffmergeid ctext cflist mergemax
5800 global difffilestart mdifffd
5802 $ctext conf -state normal
5803 set nr 0
5804 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5805 if {![info exists diffmergeid] || $id != $diffmergeid
5806 || $mdf != $mdifffd($id)} {
5807 close $mdf
5808 return 0
5810 if {[regexp {^diff --cc (.*)} $line match fname]} {
5811 # start of a new file
5812 $ctext insert end "\n"
5813 set here [$ctext index "end - 1c"]
5814 lappend difffilestart $here
5815 add_flist [list $fname]
5816 set l [expr {(78 - [string length $fname]) / 2}]
5817 set pad [string range "----------------------------------------" 1 $l]
5818 $ctext insert end "$pad $fname $pad\n" filesep
5819 } elseif {[regexp {^@@} $line]} {
5820 $ctext insert end "$line\n" hunksep
5821 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5822 # do nothing
5823 } else {
5824 # parse the prefix - one ' ', '-' or '+' for each parent
5825 set spaces {}
5826 set minuses {}
5827 set pluses {}
5828 set isbad 0
5829 for {set j 0} {$j < $np} {incr j} {
5830 set c [string range $line $j $j]
5831 if {$c == " "} {
5832 lappend spaces $j
5833 } elseif {$c == "-"} {
5834 lappend minuses $j
5835 } elseif {$c == "+"} {
5836 lappend pluses $j
5837 } else {
5838 set isbad 1
5839 break
5842 set tags {}
5843 set num {}
5844 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5845 # line doesn't appear in result, parents in $minuses have the line
5846 set num [lindex $minuses 0]
5847 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5848 # line appears in result, parents in $pluses don't have the line
5849 lappend tags mresult
5850 set num [lindex $spaces 0]
5852 if {$num ne {}} {
5853 if {$num >= $mergemax} {
5854 set num "max"
5856 lappend tags m$num
5858 $ctext insert end "$line\n" $tags
5861 $ctext conf -state disabled
5862 if {[eof $mdf]} {
5863 close $mdf
5864 return 0
5866 return [expr {$nr >= 1000? 2: 1}]
5869 proc startdiff {ids} {
5870 global treediffs diffids treepending diffmergeid nullid nullid2
5872 settabs 1
5873 set diffids $ids
5874 catch {unset diffmergeid}
5875 if {![info exists treediffs($ids)] ||
5876 [lsearch -exact $ids $nullid] >= 0 ||
5877 [lsearch -exact $ids $nullid2] >= 0} {
5878 if {![info exists treepending]} {
5879 gettreediffs $ids
5881 } else {
5882 addtocflist $ids
5886 proc path_filter {filter name} {
5887 foreach p $filter {
5888 set l [string length $p]
5889 if {[string index $p end] eq "/"} {
5890 if {[string compare -length $l $p $name] == 0} {
5891 return 1
5893 } else {
5894 if {[string compare -length $l $p $name] == 0 &&
5895 ([string length $name] == $l ||
5896 [string index $name $l] eq "/")} {
5897 return 1
5901 return 0
5904 proc addtocflist {ids} {
5905 global treediffs
5907 add_flist $treediffs($ids)
5908 getblobdiffs $ids
5911 proc diffcmd {ids flags} {
5912 global nullid nullid2
5914 set i [lsearch -exact $ids $nullid]
5915 set j [lsearch -exact $ids $nullid2]
5916 if {$i >= 0} {
5917 if {[llength $ids] > 1 && $j < 0} {
5918 # comparing working directory with some specific revision
5919 set cmd [concat | git diff-index $flags]
5920 if {$i == 0} {
5921 lappend cmd -R [lindex $ids 1]
5922 } else {
5923 lappend cmd [lindex $ids 0]
5925 } else {
5926 # comparing working directory with index
5927 set cmd [concat | git diff-files $flags]
5928 if {$j == 1} {
5929 lappend cmd -R
5932 } elseif {$j >= 0} {
5933 set cmd [concat | git diff-index --cached $flags]
5934 if {[llength $ids] > 1} {
5935 # comparing index with specific revision
5936 if {$i == 0} {
5937 lappend cmd -R [lindex $ids 1]
5938 } else {
5939 lappend cmd [lindex $ids 0]
5941 } else {
5942 # comparing index with HEAD
5943 lappend cmd HEAD
5945 } else {
5946 set cmd [concat | git diff-tree -r $flags $ids]
5948 return $cmd
5951 proc gettreediffs {ids} {
5952 global treediff treepending
5954 set treepending $ids
5955 set treediff {}
5956 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5957 fconfigure $gdtf -blocking 0
5958 filerun $gdtf [list gettreediffline $gdtf $ids]
5961 proc gettreediffline {gdtf ids} {
5962 global treediff treediffs treepending diffids diffmergeid
5963 global cmitmode viewfiles curview limitdiffs
5965 set nr 0
5966 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5967 set i [string first "\t" $line]
5968 if {$i >= 0} {
5969 set file [string range $line [expr {$i+1}] end]
5970 if {[string index $file 0] eq "\""} {
5971 set file [lindex $file 0]
5973 lappend treediff $file
5976 if {![eof $gdtf]} {
5977 return [expr {$nr >= 1000? 2: 1}]
5979 close $gdtf
5980 if {$limitdiffs && $viewfiles($curview) ne {}} {
5981 set flist {}
5982 foreach f $treediff {
5983 if {[path_filter $viewfiles($curview) $f]} {
5984 lappend flist $f
5987 set treediffs($ids) $flist
5988 } else {
5989 set treediffs($ids) $treediff
5991 unset treepending
5992 if {$cmitmode eq "tree"} {
5993 gettree $diffids
5994 } elseif {$ids != $diffids} {
5995 if {![info exists diffmergeid]} {
5996 gettreediffs $diffids
5998 } else {
5999 addtocflist $ids
6001 return 0
6004 # empty string or positive integer
6005 proc diffcontextvalidate {v} {
6006 return [regexp {^(|[1-9][0-9]*)$} $v]
6009 proc diffcontextchange {n1 n2 op} {
6010 global diffcontextstring diffcontext
6012 if {[string is integer -strict $diffcontextstring]} {
6013 if {$diffcontextstring > 0} {
6014 set diffcontext $diffcontextstring
6015 reselectline
6020 proc getblobdiffs {ids} {
6021 global blobdifffd diffids env
6022 global diffinhdr treediffs
6023 global diffcontext
6024 global limitdiffs viewfiles curview
6026 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6027 if {$limitdiffs && $viewfiles($curview) ne {}} {
6028 set cmd [concat $cmd -- $viewfiles($curview)]
6030 if {[catch {set bdf [open $cmd r]} err]} {
6031 puts "error getting diffs: $err"
6032 return
6034 set diffinhdr 0
6035 fconfigure $bdf -blocking 0
6036 set blobdifffd($ids) $bdf
6037 filerun $bdf [list getblobdiffline $bdf $diffids]
6040 proc setinlist {var i val} {
6041 global $var
6043 while {[llength [set $var]] < $i} {
6044 lappend $var {}
6046 if {[llength [set $var]] == $i} {
6047 lappend $var $val
6048 } else {
6049 lset $var $i $val
6053 proc makediffhdr {fname ids} {
6054 global ctext curdiffstart treediffs
6056 set i [lsearch -exact $treediffs($ids) $fname]
6057 if {$i >= 0} {
6058 setinlist difffilestart $i $curdiffstart
6060 set l [expr {(78 - [string length $fname]) / 2}]
6061 set pad [string range "----------------------------------------" 1 $l]
6062 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6065 proc getblobdiffline {bdf ids} {
6066 global diffids blobdifffd ctext curdiffstart
6067 global diffnexthead diffnextnote difffilestart
6068 global diffinhdr treediffs
6070 set nr 0
6071 $ctext conf -state normal
6072 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6073 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6074 close $bdf
6075 return 0
6077 if {![string compare -length 11 "diff --git " $line]} {
6078 # trim off "diff --git "
6079 set line [string range $line 11 end]
6080 set diffinhdr 1
6081 # start of a new file
6082 $ctext insert end "\n"
6083 set curdiffstart [$ctext index "end - 1c"]
6084 $ctext insert end "\n" filesep
6085 # If the name hasn't changed the length will be odd,
6086 # the middle char will be a space, and the two bits either
6087 # side will be a/name and b/name, or "a/name" and "b/name".
6088 # If the name has changed we'll get "rename from" and
6089 # "rename to" or "copy from" and "copy to" lines following this,
6090 # and we'll use them to get the filenames.
6091 # This complexity is necessary because spaces in the filename(s)
6092 # don't get escaped.
6093 set l [string length $line]
6094 set i [expr {$l / 2}]
6095 if {!(($l & 1) && [string index $line $i] eq " " &&
6096 [string range $line 2 [expr {$i - 1}]] eq \
6097 [string range $line [expr {$i + 3}] end])} {
6098 continue
6100 # unescape if quoted and chop off the a/ from the front
6101 if {[string index $line 0] eq "\""} {
6102 set fname [string range [lindex $line 0] 2 end]
6103 } else {
6104 set fname [string range $line 2 [expr {$i - 1}]]
6106 makediffhdr $fname $ids
6108 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6109 $line match f1l f1c f2l f2c rest]} {
6110 $ctext insert end "$line\n" hunksep
6111 set diffinhdr 0
6113 } elseif {$diffinhdr} {
6114 if {![string compare -length 12 "rename from " $line]} {
6115 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6116 if {[string index $fname 0] eq "\""} {
6117 set fname [lindex $fname 0]
6119 set i [lsearch -exact $treediffs($ids) $fname]
6120 if {$i >= 0} {
6121 setinlist difffilestart $i $curdiffstart
6123 } elseif {![string compare -length 10 $line "rename to "] ||
6124 ![string compare -length 8 $line "copy to "]} {
6125 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6126 if {[string index $fname 0] eq "\""} {
6127 set fname [lindex $fname 0]
6129 makediffhdr $fname $ids
6130 } elseif {[string compare -length 3 $line "---"] == 0} {
6131 # do nothing
6132 continue
6133 } elseif {[string compare -length 3 $line "+++"] == 0} {
6134 set diffinhdr 0
6135 continue
6137 $ctext insert end "$line\n" filesep
6139 } else {
6140 set x [string range $line 0 0]
6141 if {$x == "-" || $x == "+"} {
6142 set tag [expr {$x == "+"}]
6143 $ctext insert end "$line\n" d$tag
6144 } elseif {$x == " "} {
6145 $ctext insert end "$line\n"
6146 } else {
6147 # "\ No newline at end of file",
6148 # or something else we don't recognize
6149 $ctext insert end "$line\n" hunksep
6153 $ctext conf -state disabled
6154 if {[eof $bdf]} {
6155 close $bdf
6156 return 0
6158 return [expr {$nr >= 1000? 2: 1}]
6161 proc changediffdisp {} {
6162 global ctext diffelide
6164 $ctext tag conf d0 -elide [lindex $diffelide 0]
6165 $ctext tag conf d1 -elide [lindex $diffelide 1]
6168 proc prevfile {} {
6169 global difffilestart ctext
6170 set prev [lindex $difffilestart 0]
6171 set here [$ctext index @0,0]
6172 foreach loc $difffilestart {
6173 if {[$ctext compare $loc >= $here]} {
6174 $ctext yview $prev
6175 return
6177 set prev $loc
6179 $ctext yview $prev
6182 proc nextfile {} {
6183 global difffilestart ctext
6184 set here [$ctext index @0,0]
6185 foreach loc $difffilestart {
6186 if {[$ctext compare $loc > $here]} {
6187 $ctext yview $loc
6188 return
6193 proc clear_ctext {{first 1.0}} {
6194 global ctext smarktop smarkbot
6195 global pendinglinks
6197 set l [lindex [split $first .] 0]
6198 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6199 set smarktop $l
6201 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6202 set smarkbot $l
6204 $ctext delete $first end
6205 if {$first eq "1.0"} {
6206 catch {unset pendinglinks}
6210 proc settabs {{firstab {}}} {
6211 global firsttabstop tabstop ctext have_tk85
6213 if {$firstab ne {} && $have_tk85} {
6214 set firsttabstop $firstab
6216 set w [font measure textfont "0"]
6217 if {$firsttabstop != 0} {
6218 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6219 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6220 } elseif {$have_tk85 || $tabstop != 8} {
6221 $ctext conf -tabs [expr {$tabstop * $w}]
6222 } else {
6223 $ctext conf -tabs {}
6227 proc incrsearch {name ix op} {
6228 global ctext searchstring searchdirn
6230 $ctext tag remove found 1.0 end
6231 if {[catch {$ctext index anchor}]} {
6232 # no anchor set, use start of selection, or of visible area
6233 set sel [$ctext tag ranges sel]
6234 if {$sel ne {}} {
6235 $ctext mark set anchor [lindex $sel 0]
6236 } elseif {$searchdirn eq "-forwards"} {
6237 $ctext mark set anchor @0,0
6238 } else {
6239 $ctext mark set anchor @0,[winfo height $ctext]
6242 if {$searchstring ne {}} {
6243 set here [$ctext search $searchdirn -- $searchstring anchor]
6244 if {$here ne {}} {
6245 $ctext see $here
6247 searchmarkvisible 1
6251 proc dosearch {} {
6252 global sstring ctext searchstring searchdirn
6254 focus $sstring
6255 $sstring icursor end
6256 set searchdirn -forwards
6257 if {$searchstring ne {}} {
6258 set sel [$ctext tag ranges sel]
6259 if {$sel ne {}} {
6260 set start "[lindex $sel 0] + 1c"
6261 } elseif {[catch {set start [$ctext index anchor]}]} {
6262 set start "@0,0"
6264 set match [$ctext search -count mlen -- $searchstring $start]
6265 $ctext tag remove sel 1.0 end
6266 if {$match eq {}} {
6267 bell
6268 return
6270 $ctext see $match
6271 set mend "$match + $mlen c"
6272 $ctext tag add sel $match $mend
6273 $ctext mark unset anchor
6277 proc dosearchback {} {
6278 global sstring ctext searchstring searchdirn
6280 focus $sstring
6281 $sstring icursor end
6282 set searchdirn -backwards
6283 if {$searchstring ne {}} {
6284 set sel [$ctext tag ranges sel]
6285 if {$sel ne {}} {
6286 set start [lindex $sel 0]
6287 } elseif {[catch {set start [$ctext index anchor]}]} {
6288 set start @0,[winfo height $ctext]
6290 set match [$ctext search -backwards -count ml -- $searchstring $start]
6291 $ctext tag remove sel 1.0 end
6292 if {$match eq {}} {
6293 bell
6294 return
6296 $ctext see $match
6297 set mend "$match + $ml c"
6298 $ctext tag add sel $match $mend
6299 $ctext mark unset anchor
6303 proc searchmark {first last} {
6304 global ctext searchstring
6306 set mend $first.0
6307 while {1} {
6308 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6309 if {$match eq {}} break
6310 set mend "$match + $mlen c"
6311 $ctext tag add found $match $mend
6315 proc searchmarkvisible {doall} {
6316 global ctext smarktop smarkbot
6318 set topline [lindex [split [$ctext index @0,0] .] 0]
6319 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6320 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6321 # no overlap with previous
6322 searchmark $topline $botline
6323 set smarktop $topline
6324 set smarkbot $botline
6325 } else {
6326 if {$topline < $smarktop} {
6327 searchmark $topline [expr {$smarktop-1}]
6328 set smarktop $topline
6330 if {$botline > $smarkbot} {
6331 searchmark [expr {$smarkbot+1}] $botline
6332 set smarkbot $botline
6337 proc scrolltext {f0 f1} {
6338 global searchstring
6340 .bleft.sb set $f0 $f1
6341 if {$searchstring ne {}} {
6342 searchmarkvisible 0
6346 proc setcoords {} {
6347 global linespc charspc canvx0 canvy0
6348 global xspc1 xspc2 lthickness
6350 set linespc [font metrics mainfont -linespace]
6351 set charspc [font measure mainfont "m"]
6352 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6353 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6354 set lthickness [expr {int($linespc / 9) + 1}]
6355 set xspc1(0) $linespc
6356 set xspc2 $linespc
6359 proc redisplay {} {
6360 global canv
6361 global selectedline
6363 set ymax [lindex [$canv cget -scrollregion] 3]
6364 if {$ymax eq {} || $ymax == 0} return
6365 set span [$canv yview]
6366 clear_display
6367 setcanvscroll
6368 allcanvs yview moveto [lindex $span 0]
6369 drawvisible
6370 if {[info exists selectedline]} {
6371 selectline $selectedline 0
6372 allcanvs yview moveto [lindex $span 0]
6376 proc parsefont {f n} {
6377 global fontattr
6379 set fontattr($f,family) [lindex $n 0]
6380 set s [lindex $n 1]
6381 if {$s eq {} || $s == 0} {
6382 set s 10
6383 } elseif {$s < 0} {
6384 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6386 set fontattr($f,size) $s
6387 set fontattr($f,weight) normal
6388 set fontattr($f,slant) roman
6389 foreach style [lrange $n 2 end] {
6390 switch -- $style {
6391 "normal" -
6392 "bold" {set fontattr($f,weight) $style}
6393 "roman" -
6394 "italic" {set fontattr($f,slant) $style}
6399 proc fontflags {f {isbold 0}} {
6400 global fontattr
6402 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6403 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6404 -slant $fontattr($f,slant)]
6407 proc fontname {f} {
6408 global fontattr
6410 set n [list $fontattr($f,family) $fontattr($f,size)]
6411 if {$fontattr($f,weight) eq "bold"} {
6412 lappend n "bold"
6414 if {$fontattr($f,slant) eq "italic"} {
6415 lappend n "italic"
6417 return $n
6420 proc incrfont {inc} {
6421 global mainfont textfont ctext canv cflist showrefstop
6422 global stopped entries fontattr
6424 unmarkmatches
6425 set s $fontattr(mainfont,size)
6426 incr s $inc
6427 if {$s < 1} {
6428 set s 1
6430 set fontattr(mainfont,size) $s
6431 font config mainfont -size $s
6432 font config mainfontbold -size $s
6433 set mainfont [fontname mainfont]
6434 set s $fontattr(textfont,size)
6435 incr s $inc
6436 if {$s < 1} {
6437 set s 1
6439 set fontattr(textfont,size) $s
6440 font config textfont -size $s
6441 font config textfontbold -size $s
6442 set textfont [fontname textfont]
6443 setcoords
6444 settabs
6445 redisplay
6448 proc clearsha1 {} {
6449 global sha1entry sha1string
6450 if {[string length $sha1string] == 40} {
6451 $sha1entry delete 0 end
6455 proc sha1change {n1 n2 op} {
6456 global sha1string currentid sha1but
6457 if {$sha1string == {}
6458 || ([info exists currentid] && $sha1string == $currentid)} {
6459 set state disabled
6460 } else {
6461 set state normal
6463 if {[$sha1but cget -state] == $state} return
6464 if {$state == "normal"} {
6465 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6466 } else {
6467 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6471 proc gotocommit {} {
6472 global sha1string tagids headids curview varcid
6474 if {$sha1string == {}
6475 || ([info exists currentid] && $sha1string == $currentid)} return
6476 if {[info exists tagids($sha1string)]} {
6477 set id $tagids($sha1string)
6478 } elseif {[info exists headids($sha1string)]} {
6479 set id $headids($sha1string)
6480 } else {
6481 set id [string tolower $sha1string]
6482 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6483 set matches [array names varcid "$curview,$id*"]
6484 if {$matches ne {}} {
6485 if {[llength $matches] > 1} {
6486 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6487 return
6489 set id [lindex [split [lindex $matches 0] ","] 1]
6493 if {[commitinview $id $curview]} {
6494 selectline [rowofcommit $id] 1
6495 return
6497 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6498 set msg [mc "SHA1 id %s is not known" $sha1string]
6499 } else {
6500 set msg [mc "Tag/Head %s is not known" $sha1string]
6502 error_popup $msg
6505 proc lineenter {x y id} {
6506 global hoverx hovery hoverid hovertimer
6507 global commitinfo canv
6509 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6510 set hoverx $x
6511 set hovery $y
6512 set hoverid $id
6513 if {[info exists hovertimer]} {
6514 after cancel $hovertimer
6516 set hovertimer [after 500 linehover]
6517 $canv delete hover
6520 proc linemotion {x y id} {
6521 global hoverx hovery hoverid hovertimer
6523 if {[info exists hoverid] && $id == $hoverid} {
6524 set hoverx $x
6525 set hovery $y
6526 if {[info exists hovertimer]} {
6527 after cancel $hovertimer
6529 set hovertimer [after 500 linehover]
6533 proc lineleave {id} {
6534 global hoverid hovertimer canv
6536 if {[info exists hoverid] && $id == $hoverid} {
6537 $canv delete hover
6538 if {[info exists hovertimer]} {
6539 after cancel $hovertimer
6540 unset hovertimer
6542 unset hoverid
6546 proc linehover {} {
6547 global hoverx hovery hoverid hovertimer
6548 global canv linespc lthickness
6549 global commitinfo
6551 set text [lindex $commitinfo($hoverid) 0]
6552 set ymax [lindex [$canv cget -scrollregion] 3]
6553 if {$ymax == {}} return
6554 set yfrac [lindex [$canv yview] 0]
6555 set x [expr {$hoverx + 2 * $linespc}]
6556 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6557 set x0 [expr {$x - 2 * $lthickness}]
6558 set y0 [expr {$y - 2 * $lthickness}]
6559 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6560 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6561 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6562 -fill \#ffff80 -outline black -width 1 -tags hover]
6563 $canv raise $t
6564 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6565 -font mainfont]
6566 $canv raise $t
6569 proc clickisonarrow {id y} {
6570 global lthickness
6572 set ranges [rowranges $id]
6573 set thresh [expr {2 * $lthickness + 6}]
6574 set n [expr {[llength $ranges] - 1}]
6575 for {set i 1} {$i < $n} {incr i} {
6576 set row [lindex $ranges $i]
6577 if {abs([yc $row] - $y) < $thresh} {
6578 return $i
6581 return {}
6584 proc arrowjump {id n y} {
6585 global canv
6587 # 1 <-> 2, 3 <-> 4, etc...
6588 set n [expr {(($n - 1) ^ 1) + 1}]
6589 set row [lindex [rowranges $id] $n]
6590 set yt [yc $row]
6591 set ymax [lindex [$canv cget -scrollregion] 3]
6592 if {$ymax eq {} || $ymax <= 0} return
6593 set view [$canv yview]
6594 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6595 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6596 if {$yfrac < 0} {
6597 set yfrac 0
6599 allcanvs yview moveto $yfrac
6602 proc lineclick {x y id isnew} {
6603 global ctext commitinfo children canv thickerline curview
6605 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6606 unmarkmatches
6607 unselectline
6608 normalline
6609 $canv delete hover
6610 # draw this line thicker than normal
6611 set thickerline $id
6612 drawlines $id
6613 if {$isnew} {
6614 set ymax [lindex [$canv cget -scrollregion] 3]
6615 if {$ymax eq {}} return
6616 set yfrac [lindex [$canv yview] 0]
6617 set y [expr {$y + $yfrac * $ymax}]
6619 set dirn [clickisonarrow $id $y]
6620 if {$dirn ne {}} {
6621 arrowjump $id $dirn $y
6622 return
6625 if {$isnew} {
6626 addtohistory [list lineclick $x $y $id 0]
6628 # fill the details pane with info about this line
6629 $ctext conf -state normal
6630 clear_ctext
6631 settabs 0
6632 $ctext insert end "[mc "Parent"]:\t"
6633 $ctext insert end $id link0
6634 setlink $id link0
6635 set info $commitinfo($id)
6636 $ctext insert end "\n\t[lindex $info 0]\n"
6637 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6638 set date [formatdate [lindex $info 2]]
6639 $ctext insert end "\t[mc "Date"]:\t$date\n"
6640 set kids $children($curview,$id)
6641 if {$kids ne {}} {
6642 $ctext insert end "\n[mc "Children"]:"
6643 set i 0
6644 foreach child $kids {
6645 incr i
6646 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6647 set info $commitinfo($child)
6648 $ctext insert end "\n\t"
6649 $ctext insert end $child link$i
6650 setlink $child link$i
6651 $ctext insert end "\n\t[lindex $info 0]"
6652 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6653 set date [formatdate [lindex $info 2]]
6654 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6657 $ctext conf -state disabled
6658 init_flist {}
6661 proc normalline {} {
6662 global thickerline
6663 if {[info exists thickerline]} {
6664 set id $thickerline
6665 unset thickerline
6666 drawlines $id
6670 proc selbyid {id} {
6671 global curview
6672 if {[commitinview $id $curview]} {
6673 selectline [rowofcommit $id] 1
6677 proc mstime {} {
6678 global startmstime
6679 if {![info exists startmstime]} {
6680 set startmstime [clock clicks -milliseconds]
6682 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6685 proc rowmenu {x y id} {
6686 global rowctxmenu selectedline rowmenuid curview
6687 global nullid nullid2 fakerowmenu mainhead
6689 stopfinding
6690 set rowmenuid $id
6691 if {![info exists selectedline]
6692 || [rowofcommit $id] eq $selectedline} {
6693 set state disabled
6694 } else {
6695 set state normal
6697 if {$id ne $nullid && $id ne $nullid2} {
6698 set menu $rowctxmenu
6699 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6700 } else {
6701 set menu $fakerowmenu
6703 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6704 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6705 $menu entryconfigure [mc "Make patch"] -state $state
6706 tk_popup $menu $x $y
6709 proc diffvssel {dirn} {
6710 global rowmenuid selectedline
6712 if {![info exists selectedline]} return
6713 if {$dirn} {
6714 set oldid [commitonrow $selectedline]
6715 set newid $rowmenuid
6716 } else {
6717 set oldid $rowmenuid
6718 set newid [commitonrow $selectedline]
6720 addtohistory [list doseldiff $oldid $newid]
6721 doseldiff $oldid $newid
6724 proc doseldiff {oldid newid} {
6725 global ctext
6726 global commitinfo
6728 $ctext conf -state normal
6729 clear_ctext
6730 init_flist [mc "Top"]
6731 $ctext insert end "[mc "From"] "
6732 $ctext insert end $oldid link0
6733 setlink $oldid link0
6734 $ctext insert end "\n "
6735 $ctext insert end [lindex $commitinfo($oldid) 0]
6736 $ctext insert end "\n\n[mc "To"] "
6737 $ctext insert end $newid link1
6738 setlink $newid link1
6739 $ctext insert end "\n "
6740 $ctext insert end [lindex $commitinfo($newid) 0]
6741 $ctext insert end "\n"
6742 $ctext conf -state disabled
6743 $ctext tag remove found 1.0 end
6744 startdiff [list $oldid $newid]
6747 proc mkpatch {} {
6748 global rowmenuid currentid commitinfo patchtop patchnum
6750 if {![info exists currentid]} return
6751 set oldid $currentid
6752 set oldhead [lindex $commitinfo($oldid) 0]
6753 set newid $rowmenuid
6754 set newhead [lindex $commitinfo($newid) 0]
6755 set top .patch
6756 set patchtop $top
6757 catch {destroy $top}
6758 toplevel $top
6759 label $top.title -text [mc "Generate patch"]
6760 grid $top.title - -pady 10
6761 label $top.from -text [mc "From:"]
6762 entry $top.fromsha1 -width 40 -relief flat
6763 $top.fromsha1 insert 0 $oldid
6764 $top.fromsha1 conf -state readonly
6765 grid $top.from $top.fromsha1 -sticky w
6766 entry $top.fromhead -width 60 -relief flat
6767 $top.fromhead insert 0 $oldhead
6768 $top.fromhead conf -state readonly
6769 grid x $top.fromhead -sticky w
6770 label $top.to -text [mc "To:"]
6771 entry $top.tosha1 -width 40 -relief flat
6772 $top.tosha1 insert 0 $newid
6773 $top.tosha1 conf -state readonly
6774 grid $top.to $top.tosha1 -sticky w
6775 entry $top.tohead -width 60 -relief flat
6776 $top.tohead insert 0 $newhead
6777 $top.tohead conf -state readonly
6778 grid x $top.tohead -sticky w
6779 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6780 grid $top.rev x -pady 10
6781 label $top.flab -text [mc "Output file:"]
6782 entry $top.fname -width 60
6783 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6784 incr patchnum
6785 grid $top.flab $top.fname -sticky w
6786 frame $top.buts
6787 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6788 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6789 grid $top.buts.gen $top.buts.can
6790 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6791 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6792 grid $top.buts - -pady 10 -sticky ew
6793 focus $top.fname
6796 proc mkpatchrev {} {
6797 global patchtop
6799 set oldid [$patchtop.fromsha1 get]
6800 set oldhead [$patchtop.fromhead get]
6801 set newid [$patchtop.tosha1 get]
6802 set newhead [$patchtop.tohead get]
6803 foreach e [list fromsha1 fromhead tosha1 tohead] \
6804 v [list $newid $newhead $oldid $oldhead] {
6805 $patchtop.$e conf -state normal
6806 $patchtop.$e delete 0 end
6807 $patchtop.$e insert 0 $v
6808 $patchtop.$e conf -state readonly
6812 proc mkpatchgo {} {
6813 global patchtop nullid nullid2
6815 set oldid [$patchtop.fromsha1 get]
6816 set newid [$patchtop.tosha1 get]
6817 set fname [$patchtop.fname get]
6818 set cmd [diffcmd [list $oldid $newid] -p]
6819 # trim off the initial "|"
6820 set cmd [lrange $cmd 1 end]
6821 lappend cmd >$fname &
6822 if {[catch {eval exec $cmd} err]} {
6823 error_popup "[mc "Error creating patch:"] $err"
6825 catch {destroy $patchtop}
6826 unset patchtop
6829 proc mkpatchcan {} {
6830 global patchtop
6832 catch {destroy $patchtop}
6833 unset patchtop
6836 proc mktag {} {
6837 global rowmenuid mktagtop commitinfo
6839 set top .maketag
6840 set mktagtop $top
6841 catch {destroy $top}
6842 toplevel $top
6843 label $top.title -text [mc "Create tag"]
6844 grid $top.title - -pady 10
6845 label $top.id -text [mc "ID:"]
6846 entry $top.sha1 -width 40 -relief flat
6847 $top.sha1 insert 0 $rowmenuid
6848 $top.sha1 conf -state readonly
6849 grid $top.id $top.sha1 -sticky w
6850 entry $top.head -width 60 -relief flat
6851 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6852 $top.head conf -state readonly
6853 grid x $top.head -sticky w
6854 label $top.tlab -text [mc "Tag name:"]
6855 entry $top.tag -width 60
6856 grid $top.tlab $top.tag -sticky w
6857 frame $top.buts
6858 button $top.buts.gen -text [mc "Create"] -command mktaggo
6859 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6860 grid $top.buts.gen $top.buts.can
6861 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6862 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6863 grid $top.buts - -pady 10 -sticky ew
6864 focus $top.tag
6867 proc domktag {} {
6868 global mktagtop env tagids idtags
6870 set id [$mktagtop.sha1 get]
6871 set tag [$mktagtop.tag get]
6872 if {$tag == {}} {
6873 error_popup [mc "No tag name specified"]
6874 return
6876 if {[info exists tagids($tag)]} {
6877 error_popup [mc "Tag \"%s\" already exists" $tag]
6878 return
6880 if {[catch {
6881 set dir [gitdir]
6882 set fname [file join $dir "refs/tags" $tag]
6883 set f [open $fname w]
6884 puts $f $id
6885 close $f
6886 } err]} {
6887 error_popup "[mc "Error creating tag:"] $err"
6888 return
6891 set tagids($tag) $id
6892 lappend idtags($id) $tag
6893 redrawtags $id
6894 addedtag $id
6895 dispneartags 0
6896 run refill_reflist
6899 proc redrawtags {id} {
6900 global canv linehtag idpos currentid curview
6901 global canvxmax iddrawn
6903 if {![commitinview $id $curview]} return
6904 if {![info exists iddrawn($id)]} return
6905 set row [rowofcommit $id]
6906 $canv delete tag.$id
6907 set xt [eval drawtags $id $idpos($id)]
6908 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6909 set text [$canv itemcget $linehtag($row) -text]
6910 set font [$canv itemcget $linehtag($row) -font]
6911 set xr [expr {$xt + [font measure $font $text]}]
6912 if {$xr > $canvxmax} {
6913 set canvxmax $xr
6914 setcanvscroll
6916 if {[info exists currentid] && $currentid == $id} {
6917 make_secsel $row
6921 proc mktagcan {} {
6922 global mktagtop
6924 catch {destroy $mktagtop}
6925 unset mktagtop
6928 proc mktaggo {} {
6929 domktag
6930 mktagcan
6933 proc writecommit {} {
6934 global rowmenuid wrcomtop commitinfo wrcomcmd
6936 set top .writecommit
6937 set wrcomtop $top
6938 catch {destroy $top}
6939 toplevel $top
6940 label $top.title -text [mc "Write commit to file"]
6941 grid $top.title - -pady 10
6942 label $top.id -text [mc "ID:"]
6943 entry $top.sha1 -width 40 -relief flat
6944 $top.sha1 insert 0 $rowmenuid
6945 $top.sha1 conf -state readonly
6946 grid $top.id $top.sha1 -sticky w
6947 entry $top.head -width 60 -relief flat
6948 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6949 $top.head conf -state readonly
6950 grid x $top.head -sticky w
6951 label $top.clab -text [mc "Command:"]
6952 entry $top.cmd -width 60 -textvariable wrcomcmd
6953 grid $top.clab $top.cmd -sticky w -pady 10
6954 label $top.flab -text [mc "Output file:"]
6955 entry $top.fname -width 60
6956 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6957 grid $top.flab $top.fname -sticky w
6958 frame $top.buts
6959 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6960 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6961 grid $top.buts.gen $top.buts.can
6962 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6963 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6964 grid $top.buts - -pady 10 -sticky ew
6965 focus $top.fname
6968 proc wrcomgo {} {
6969 global wrcomtop
6971 set id [$wrcomtop.sha1 get]
6972 set cmd "echo $id | [$wrcomtop.cmd get]"
6973 set fname [$wrcomtop.fname get]
6974 if {[catch {exec sh -c $cmd >$fname &} err]} {
6975 error_popup "[mc "Error writing commit:"] $err"
6977 catch {destroy $wrcomtop}
6978 unset wrcomtop
6981 proc wrcomcan {} {
6982 global wrcomtop
6984 catch {destroy $wrcomtop}
6985 unset wrcomtop
6988 proc mkbranch {} {
6989 global rowmenuid mkbrtop
6991 set top .makebranch
6992 catch {destroy $top}
6993 toplevel $top
6994 label $top.title -text [mc "Create new branch"]
6995 grid $top.title - -pady 10
6996 label $top.id -text [mc "ID:"]
6997 entry $top.sha1 -width 40 -relief flat
6998 $top.sha1 insert 0 $rowmenuid
6999 $top.sha1 conf -state readonly
7000 grid $top.id $top.sha1 -sticky w
7001 label $top.nlab -text [mc "Name:"]
7002 entry $top.name -width 40
7003 grid $top.nlab $top.name -sticky w
7004 frame $top.buts
7005 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7006 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7007 grid $top.buts.go $top.buts.can
7008 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7009 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7010 grid $top.buts - -pady 10 -sticky ew
7011 focus $top.name
7014 proc mkbrgo {top} {
7015 global headids idheads
7017 set name [$top.name get]
7018 set id [$top.sha1 get]
7019 if {$name eq {}} {
7020 error_popup [mc "Please specify a name for the new branch"]
7021 return
7023 catch {destroy $top}
7024 nowbusy newbranch
7025 update
7026 if {[catch {
7027 exec git branch $name $id
7028 } err]} {
7029 notbusy newbranch
7030 error_popup $err
7031 } else {
7032 set headids($name) $id
7033 lappend idheads($id) $name
7034 addedhead $id $name
7035 notbusy newbranch
7036 redrawtags $id
7037 dispneartags 0
7038 run refill_reflist
7042 proc cherrypick {} {
7043 global rowmenuid curview viewincl
7044 global mainhead mainheadid
7046 set oldhead [exec git rev-parse HEAD]
7047 set dheads [descheads $rowmenuid]
7048 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7049 set ok [confirm_popup [mc "Commit %s is already\
7050 included in branch %s -- really re-apply it?" \
7051 [string range $rowmenuid 0 7] $mainhead]]
7052 if {!$ok} return
7054 nowbusy cherrypick [mc "Cherry-picking"]
7055 update
7056 # Unfortunately git-cherry-pick writes stuff to stderr even when
7057 # no error occurs, and exec takes that as an indication of error...
7058 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7059 notbusy cherrypick
7060 error_popup $err
7061 return
7063 set newhead [exec git rev-parse HEAD]
7064 if {$newhead eq $oldhead} {
7065 notbusy cherrypick
7066 error_popup [mc "No changes committed"]
7067 return
7069 addnewchild $newhead $oldhead
7070 if {[commitinview $oldhead $curview]} {
7071 insertrow $newhead $oldhead $curview
7072 if {$mainhead ne {}} {
7073 movehead $newhead $mainhead
7074 movedhead $newhead $mainhead
7075 set mainheadid $newhead
7077 # remove oldhead from viewincl and add newhead
7078 set i [lsearch -exact $viewincl($curview) $oldhead]
7079 if {$i >= 0} {
7080 set viewincl($curview) [lreplace $viewincl($curview) $i $i]
7082 lappend viewincl($curview) $newhead
7083 redrawtags $oldhead
7084 redrawtags $newhead
7085 selbyid $newhead
7087 notbusy cherrypick
7090 proc resethead {} {
7091 global mainhead rowmenuid confirm_ok resettype
7093 set confirm_ok 0
7094 set w ".confirmreset"
7095 toplevel $w
7096 wm transient $w .
7097 wm title $w [mc "Confirm reset"]
7098 message $w.m -text \
7099 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7100 -justify center -aspect 1000
7101 pack $w.m -side top -fill x -padx 20 -pady 20
7102 frame $w.f -relief sunken -border 2
7103 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7104 grid $w.f.rt -sticky w
7105 set resettype mixed
7106 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7107 -text [mc "Soft: Leave working tree and index untouched"]
7108 grid $w.f.soft -sticky w
7109 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7110 -text [mc "Mixed: Leave working tree untouched, reset index"]
7111 grid $w.f.mixed -sticky w
7112 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7113 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7114 grid $w.f.hard -sticky w
7115 pack $w.f -side top -fill x
7116 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7117 pack $w.ok -side left -fill x -padx 20 -pady 20
7118 button $w.cancel -text [mc Cancel] -command "destroy $w"
7119 pack $w.cancel -side right -fill x -padx 20 -pady 20
7120 bind $w <Visibility> "grab $w; focus $w"
7121 tkwait window $w
7122 if {!$confirm_ok} return
7123 if {[catch {set fd [open \
7124 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7125 error_popup $err
7126 } else {
7127 dohidelocalchanges
7128 filerun $fd [list readresetstat $fd]
7129 nowbusy reset [mc "Resetting"]
7130 selbyid $rowmenuid
7134 proc readresetstat {fd} {
7135 global mainhead mainheadid showlocalchanges rprogcoord
7137 if {[gets $fd line] >= 0} {
7138 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7139 set rprogcoord [expr {1.0 * $m / $n}]
7140 adjustprogress
7142 return 1
7144 set rprogcoord 0
7145 adjustprogress
7146 notbusy reset
7147 if {[catch {close $fd} err]} {
7148 error_popup $err
7150 set oldhead $mainheadid
7151 set newhead [exec git rev-parse HEAD]
7152 if {$newhead ne $oldhead} {
7153 movehead $newhead $mainhead
7154 movedhead $newhead $mainhead
7155 set mainheadid $newhead
7156 redrawtags $oldhead
7157 redrawtags $newhead
7159 if {$showlocalchanges} {
7160 doshowlocalchanges
7162 return 0
7165 # context menu for a head
7166 proc headmenu {x y id head} {
7167 global headmenuid headmenuhead headctxmenu mainhead
7169 stopfinding
7170 set headmenuid $id
7171 set headmenuhead $head
7172 set state normal
7173 if {$head eq $mainhead} {
7174 set state disabled
7176 $headctxmenu entryconfigure 0 -state $state
7177 $headctxmenu entryconfigure 1 -state $state
7178 tk_popup $headctxmenu $x $y
7181 proc cobranch {} {
7182 global headmenuid headmenuhead mainhead headids
7183 global showlocalchanges mainheadid
7185 # check the tree is clean first??
7186 set oldmainhead $mainhead
7187 nowbusy checkout [mc "Checking out"]
7188 update
7189 dohidelocalchanges
7190 if {[catch {
7191 exec git checkout -q $headmenuhead
7192 } err]} {
7193 notbusy checkout
7194 error_popup $err
7195 } else {
7196 notbusy checkout
7197 set mainhead $headmenuhead
7198 set mainheadid $headmenuid
7199 if {[info exists headids($oldmainhead)]} {
7200 redrawtags $headids($oldmainhead)
7202 redrawtags $headmenuid
7203 selbyid $headmenuid
7205 if {$showlocalchanges} {
7206 dodiffindex
7210 proc rmbranch {} {
7211 global headmenuid headmenuhead mainhead
7212 global idheads
7214 set head $headmenuhead
7215 set id $headmenuid
7216 # this check shouldn't be needed any more...
7217 if {$head eq $mainhead} {
7218 error_popup [mc "Cannot delete the currently checked-out branch"]
7219 return
7221 set dheads [descheads $id]
7222 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7223 # the stuff on this branch isn't on any other branch
7224 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7225 branch.\nReally delete branch %s?" $head $head]]} return
7227 nowbusy rmbranch
7228 update
7229 if {[catch {exec git branch -D $head} err]} {
7230 notbusy rmbranch
7231 error_popup $err
7232 return
7234 removehead $id $head
7235 removedhead $id $head
7236 redrawtags $id
7237 notbusy rmbranch
7238 dispneartags 0
7239 run refill_reflist
7242 # Display a list of tags and heads
7243 proc showrefs {} {
7244 global showrefstop bgcolor fgcolor selectbgcolor
7245 global bglist fglist reflistfilter reflist maincursor
7247 set top .showrefs
7248 set showrefstop $top
7249 if {[winfo exists $top]} {
7250 raise $top
7251 refill_reflist
7252 return
7254 toplevel $top
7255 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7256 text $top.list -background $bgcolor -foreground $fgcolor \
7257 -selectbackground $selectbgcolor -font mainfont \
7258 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7259 -width 30 -height 20 -cursor $maincursor \
7260 -spacing1 1 -spacing3 1 -state disabled
7261 $top.list tag configure highlight -background $selectbgcolor
7262 lappend bglist $top.list
7263 lappend fglist $top.list
7264 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7265 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7266 grid $top.list $top.ysb -sticky nsew
7267 grid $top.xsb x -sticky ew
7268 frame $top.f
7269 label $top.f.l -text "[mc "Filter"]: "
7270 entry $top.f.e -width 20 -textvariable reflistfilter
7271 set reflistfilter "*"
7272 trace add variable reflistfilter write reflistfilter_change
7273 pack $top.f.e -side right -fill x -expand 1
7274 pack $top.f.l -side left
7275 grid $top.f - -sticky ew -pady 2
7276 button $top.close -command [list destroy $top] -text [mc "Close"]
7277 grid $top.close -
7278 grid columnconfigure $top 0 -weight 1
7279 grid rowconfigure $top 0 -weight 1
7280 bind $top.list <1> {break}
7281 bind $top.list <B1-Motion> {break}
7282 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7283 set reflist {}
7284 refill_reflist
7287 proc sel_reflist {w x y} {
7288 global showrefstop reflist headids tagids otherrefids
7290 if {![winfo exists $showrefstop]} return
7291 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7292 set ref [lindex $reflist [expr {$l-1}]]
7293 set n [lindex $ref 0]
7294 switch -- [lindex $ref 1] {
7295 "H" {selbyid $headids($n)}
7296 "T" {selbyid $tagids($n)}
7297 "o" {selbyid $otherrefids($n)}
7299 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7302 proc unsel_reflist {} {
7303 global showrefstop
7305 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7306 $showrefstop.list tag remove highlight 0.0 end
7309 proc reflistfilter_change {n1 n2 op} {
7310 global reflistfilter
7312 after cancel refill_reflist
7313 after 200 refill_reflist
7316 proc refill_reflist {} {
7317 global reflist reflistfilter showrefstop headids tagids otherrefids
7318 global curview commitinterest
7320 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7321 set refs {}
7322 foreach n [array names headids] {
7323 if {[string match $reflistfilter $n]} {
7324 if {[commitinview $headids($n) $curview]} {
7325 lappend refs [list $n H]
7326 } else {
7327 set commitinterest($headids($n)) {run refill_reflist}
7331 foreach n [array names tagids] {
7332 if {[string match $reflistfilter $n]} {
7333 if {[commitinview $tagids($n) $curview]} {
7334 lappend refs [list $n T]
7335 } else {
7336 set commitinterest($tagids($n)) {run refill_reflist}
7340 foreach n [array names otherrefids] {
7341 if {[string match $reflistfilter $n]} {
7342 if {[commitinview $otherrefids($n) $curview]} {
7343 lappend refs [list $n o]
7344 } else {
7345 set commitinterest($otherrefids($n)) {run refill_reflist}
7349 set refs [lsort -index 0 $refs]
7350 if {$refs eq $reflist} return
7352 # Update the contents of $showrefstop.list according to the
7353 # differences between $reflist (old) and $refs (new)
7354 $showrefstop.list conf -state normal
7355 $showrefstop.list insert end "\n"
7356 set i 0
7357 set j 0
7358 while {$i < [llength $reflist] || $j < [llength $refs]} {
7359 if {$i < [llength $reflist]} {
7360 if {$j < [llength $refs]} {
7361 set cmp [string compare [lindex $reflist $i 0] \
7362 [lindex $refs $j 0]]
7363 if {$cmp == 0} {
7364 set cmp [string compare [lindex $reflist $i 1] \
7365 [lindex $refs $j 1]]
7367 } else {
7368 set cmp -1
7370 } else {
7371 set cmp 1
7373 switch -- $cmp {
7374 -1 {
7375 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7376 incr i
7379 incr i
7380 incr j
7383 set l [expr {$j + 1}]
7384 $showrefstop.list image create $l.0 -align baseline \
7385 -image reficon-[lindex $refs $j 1] -padx 2
7386 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7387 incr j
7391 set reflist $refs
7392 # delete last newline
7393 $showrefstop.list delete end-2c end-1c
7394 $showrefstop.list conf -state disabled
7397 # Stuff for finding nearby tags
7398 proc getallcommits {} {
7399 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7400 global idheads idtags idotherrefs allparents tagobjid
7402 if {![info exists allcommits]} {
7403 set nextarc 0
7404 set allcommits 0
7405 set seeds {}
7406 set allcwait 0
7407 set cachedarcs 0
7408 set allccache [file join [gitdir] "gitk.cache"]
7409 if {![catch {
7410 set f [open $allccache r]
7411 set allcwait 1
7412 getcache $f
7413 }]} return
7416 if {$allcwait} {
7417 return
7419 set cmd [list | git rev-list --parents]
7420 set allcupdate [expr {$seeds ne {}}]
7421 if {!$allcupdate} {
7422 set ids "--all"
7423 } else {
7424 set refs [concat [array names idheads] [array names idtags] \
7425 [array names idotherrefs]]
7426 set ids {}
7427 set tagobjs {}
7428 foreach name [array names tagobjid] {
7429 lappend tagobjs $tagobjid($name)
7431 foreach id [lsort -unique $refs] {
7432 if {![info exists allparents($id)] &&
7433 [lsearch -exact $tagobjs $id] < 0} {
7434 lappend ids $id
7437 if {$ids ne {}} {
7438 foreach id $seeds {
7439 lappend ids "^$id"
7443 if {$ids ne {}} {
7444 set fd [open [concat $cmd $ids] r]
7445 fconfigure $fd -blocking 0
7446 incr allcommits
7447 nowbusy allcommits
7448 filerun $fd [list getallclines $fd]
7449 } else {
7450 dispneartags 0
7454 # Since most commits have 1 parent and 1 child, we group strings of
7455 # such commits into "arcs" joining branch/merge points (BMPs), which
7456 # are commits that either don't have 1 parent or don't have 1 child.
7458 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7459 # arcout(id) - outgoing arcs for BMP
7460 # arcids(a) - list of IDs on arc including end but not start
7461 # arcstart(a) - BMP ID at start of arc
7462 # arcend(a) - BMP ID at end of arc
7463 # growing(a) - arc a is still growing
7464 # arctags(a) - IDs out of arcids (excluding end) that have tags
7465 # archeads(a) - IDs out of arcids (excluding end) that have heads
7466 # The start of an arc is at the descendent end, so "incoming" means
7467 # coming from descendents, and "outgoing" means going towards ancestors.
7469 proc getallclines {fd} {
7470 global allparents allchildren idtags idheads nextarc
7471 global arcnos arcids arctags arcout arcend arcstart archeads growing
7472 global seeds allcommits cachedarcs allcupdate
7474 set nid 0
7475 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7476 set id [lindex $line 0]
7477 if {[info exists allparents($id)]} {
7478 # seen it already
7479 continue
7481 set cachedarcs 0
7482 set olds [lrange $line 1 end]
7483 set allparents($id) $olds
7484 if {![info exists allchildren($id)]} {
7485 set allchildren($id) {}
7486 set arcnos($id) {}
7487 lappend seeds $id
7488 } else {
7489 set a $arcnos($id)
7490 if {[llength $olds] == 1 && [llength $a] == 1} {
7491 lappend arcids($a) $id
7492 if {[info exists idtags($id)]} {
7493 lappend arctags($a) $id
7495 if {[info exists idheads($id)]} {
7496 lappend archeads($a) $id
7498 if {[info exists allparents($olds)]} {
7499 # seen parent already
7500 if {![info exists arcout($olds)]} {
7501 splitarc $olds
7503 lappend arcids($a) $olds
7504 set arcend($a) $olds
7505 unset growing($a)
7507 lappend allchildren($olds) $id
7508 lappend arcnos($olds) $a
7509 continue
7512 foreach a $arcnos($id) {
7513 lappend arcids($a) $id
7514 set arcend($a) $id
7515 unset growing($a)
7518 set ao {}
7519 foreach p $olds {
7520 lappend allchildren($p) $id
7521 set a [incr nextarc]
7522 set arcstart($a) $id
7523 set archeads($a) {}
7524 set arctags($a) {}
7525 set archeads($a) {}
7526 set arcids($a) {}
7527 lappend ao $a
7528 set growing($a) 1
7529 if {[info exists allparents($p)]} {
7530 # seen it already, may need to make a new branch
7531 if {![info exists arcout($p)]} {
7532 splitarc $p
7534 lappend arcids($a) $p
7535 set arcend($a) $p
7536 unset growing($a)
7538 lappend arcnos($p) $a
7540 set arcout($id) $ao
7542 if {$nid > 0} {
7543 global cached_dheads cached_dtags cached_atags
7544 catch {unset cached_dheads}
7545 catch {unset cached_dtags}
7546 catch {unset cached_atags}
7548 if {![eof $fd]} {
7549 return [expr {$nid >= 1000? 2: 1}]
7551 set cacheok 1
7552 if {[catch {
7553 fconfigure $fd -blocking 1
7554 close $fd
7555 } err]} {
7556 # got an error reading the list of commits
7557 # if we were updating, try rereading the whole thing again
7558 if {$allcupdate} {
7559 incr allcommits -1
7560 dropcache $err
7561 return
7563 error_popup "[mc "Error reading commit topology information;\
7564 branch and preceding/following tag information\
7565 will be incomplete."]\n($err)"
7566 set cacheok 0
7568 if {[incr allcommits -1] == 0} {
7569 notbusy allcommits
7570 if {$cacheok} {
7571 run savecache
7574 dispneartags 0
7575 return 0
7578 proc recalcarc {a} {
7579 global arctags archeads arcids idtags idheads
7581 set at {}
7582 set ah {}
7583 foreach id [lrange $arcids($a) 0 end-1] {
7584 if {[info exists idtags($id)]} {
7585 lappend at $id
7587 if {[info exists idheads($id)]} {
7588 lappend ah $id
7591 set arctags($a) $at
7592 set archeads($a) $ah
7595 proc splitarc {p} {
7596 global arcnos arcids nextarc arctags archeads idtags idheads
7597 global arcstart arcend arcout allparents growing
7599 set a $arcnos($p)
7600 if {[llength $a] != 1} {
7601 puts "oops splitarc called but [llength $a] arcs already"
7602 return
7604 set a [lindex $a 0]
7605 set i [lsearch -exact $arcids($a) $p]
7606 if {$i < 0} {
7607 puts "oops splitarc $p not in arc $a"
7608 return
7610 set na [incr nextarc]
7611 if {[info exists arcend($a)]} {
7612 set arcend($na) $arcend($a)
7613 } else {
7614 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7615 set j [lsearch -exact $arcnos($l) $a]
7616 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7618 set tail [lrange $arcids($a) [expr {$i+1}] end]
7619 set arcids($a) [lrange $arcids($a) 0 $i]
7620 set arcend($a) $p
7621 set arcstart($na) $p
7622 set arcout($p) $na
7623 set arcids($na) $tail
7624 if {[info exists growing($a)]} {
7625 set growing($na) 1
7626 unset growing($a)
7629 foreach id $tail {
7630 if {[llength $arcnos($id)] == 1} {
7631 set arcnos($id) $na
7632 } else {
7633 set j [lsearch -exact $arcnos($id) $a]
7634 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7638 # reconstruct tags and heads lists
7639 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7640 recalcarc $a
7641 recalcarc $na
7642 } else {
7643 set arctags($na) {}
7644 set archeads($na) {}
7648 # Update things for a new commit added that is a child of one
7649 # existing commit. Used when cherry-picking.
7650 proc addnewchild {id p} {
7651 global allparents allchildren idtags nextarc
7652 global arcnos arcids arctags arcout arcend arcstart archeads growing
7653 global seeds allcommits
7655 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7656 set allparents($id) [list $p]
7657 set allchildren($id) {}
7658 set arcnos($id) {}
7659 lappend seeds $id
7660 lappend allchildren($p) $id
7661 set a [incr nextarc]
7662 set arcstart($a) $id
7663 set archeads($a) {}
7664 set arctags($a) {}
7665 set arcids($a) [list $p]
7666 set arcend($a) $p
7667 if {![info exists arcout($p)]} {
7668 splitarc $p
7670 lappend arcnos($p) $a
7671 set arcout($id) [list $a]
7674 # This implements a cache for the topology information.
7675 # The cache saves, for each arc, the start and end of the arc,
7676 # the ids on the arc, and the outgoing arcs from the end.
7677 proc readcache {f} {
7678 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7679 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7680 global allcwait
7682 set a $nextarc
7683 set lim $cachedarcs
7684 if {$lim - $a > 500} {
7685 set lim [expr {$a + 500}]
7687 if {[catch {
7688 if {$a == $lim} {
7689 # finish reading the cache and setting up arctags, etc.
7690 set line [gets $f]
7691 if {$line ne "1"} {error "bad final version"}
7692 close $f
7693 foreach id [array names idtags] {
7694 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7695 [llength $allparents($id)] == 1} {
7696 set a [lindex $arcnos($id) 0]
7697 if {$arctags($a) eq {}} {
7698 recalcarc $a
7702 foreach id [array names idheads] {
7703 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7704 [llength $allparents($id)] == 1} {
7705 set a [lindex $arcnos($id) 0]
7706 if {$archeads($a) eq {}} {
7707 recalcarc $a
7711 foreach id [lsort -unique $possible_seeds] {
7712 if {$arcnos($id) eq {}} {
7713 lappend seeds $id
7716 set allcwait 0
7717 } else {
7718 while {[incr a] <= $lim} {
7719 set line [gets $f]
7720 if {[llength $line] != 3} {error "bad line"}
7721 set s [lindex $line 0]
7722 set arcstart($a) $s
7723 lappend arcout($s) $a
7724 if {![info exists arcnos($s)]} {
7725 lappend possible_seeds $s
7726 set arcnos($s) {}
7728 set e [lindex $line 1]
7729 if {$e eq {}} {
7730 set growing($a) 1
7731 } else {
7732 set arcend($a) $e
7733 if {![info exists arcout($e)]} {
7734 set arcout($e) {}
7737 set arcids($a) [lindex $line 2]
7738 foreach id $arcids($a) {
7739 lappend allparents($s) $id
7740 set s $id
7741 lappend arcnos($id) $a
7743 if {![info exists allparents($s)]} {
7744 set allparents($s) {}
7746 set arctags($a) {}
7747 set archeads($a) {}
7749 set nextarc [expr {$a - 1}]
7751 } err]} {
7752 dropcache $err
7753 return 0
7755 if {!$allcwait} {
7756 getallcommits
7758 return $allcwait
7761 proc getcache {f} {
7762 global nextarc cachedarcs possible_seeds
7764 if {[catch {
7765 set line [gets $f]
7766 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7767 # make sure it's an integer
7768 set cachedarcs [expr {int([lindex $line 1])}]
7769 if {$cachedarcs < 0} {error "bad number of arcs"}
7770 set nextarc 0
7771 set possible_seeds {}
7772 run readcache $f
7773 } err]} {
7774 dropcache $err
7776 return 0
7779 proc dropcache {err} {
7780 global allcwait nextarc cachedarcs seeds
7782 #puts "dropping cache ($err)"
7783 foreach v {arcnos arcout arcids arcstart arcend growing \
7784 arctags archeads allparents allchildren} {
7785 global $v
7786 catch {unset $v}
7788 set allcwait 0
7789 set nextarc 0
7790 set cachedarcs 0
7791 set seeds {}
7792 getallcommits
7795 proc writecache {f} {
7796 global cachearc cachedarcs allccache
7797 global arcstart arcend arcnos arcids arcout
7799 set a $cachearc
7800 set lim $cachedarcs
7801 if {$lim - $a > 1000} {
7802 set lim [expr {$a + 1000}]
7804 if {[catch {
7805 while {[incr a] <= $lim} {
7806 if {[info exists arcend($a)]} {
7807 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7808 } else {
7809 puts $f [list $arcstart($a) {} $arcids($a)]
7812 } err]} {
7813 catch {close $f}
7814 catch {file delete $allccache}
7815 #puts "writing cache failed ($err)"
7816 return 0
7818 set cachearc [expr {$a - 1}]
7819 if {$a > $cachedarcs} {
7820 puts $f "1"
7821 close $f
7822 return 0
7824 return 1
7827 proc savecache {} {
7828 global nextarc cachedarcs cachearc allccache
7830 if {$nextarc == $cachedarcs} return
7831 set cachearc 0
7832 set cachedarcs $nextarc
7833 catch {
7834 set f [open $allccache w]
7835 puts $f [list 1 $cachedarcs]
7836 run writecache $f
7840 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7841 # or 0 if neither is true.
7842 proc anc_or_desc {a b} {
7843 global arcout arcstart arcend arcnos cached_isanc
7845 if {$arcnos($a) eq $arcnos($b)} {
7846 # Both are on the same arc(s); either both are the same BMP,
7847 # or if one is not a BMP, the other is also not a BMP or is
7848 # the BMP at end of the arc (and it only has 1 incoming arc).
7849 # Or both can be BMPs with no incoming arcs.
7850 if {$a eq $b || $arcnos($a) eq {}} {
7851 return 0
7853 # assert {[llength $arcnos($a)] == 1}
7854 set arc [lindex $arcnos($a) 0]
7855 set i [lsearch -exact $arcids($arc) $a]
7856 set j [lsearch -exact $arcids($arc) $b]
7857 if {$i < 0 || $i > $j} {
7858 return 1
7859 } else {
7860 return -1
7864 if {![info exists arcout($a)]} {
7865 set arc [lindex $arcnos($a) 0]
7866 if {[info exists arcend($arc)]} {
7867 set aend $arcend($arc)
7868 } else {
7869 set aend {}
7871 set a $arcstart($arc)
7872 } else {
7873 set aend $a
7875 if {![info exists arcout($b)]} {
7876 set arc [lindex $arcnos($b) 0]
7877 if {[info exists arcend($arc)]} {
7878 set bend $arcend($arc)
7879 } else {
7880 set bend {}
7882 set b $arcstart($arc)
7883 } else {
7884 set bend $b
7886 if {$a eq $bend} {
7887 return 1
7889 if {$b eq $aend} {
7890 return -1
7892 if {[info exists cached_isanc($a,$bend)]} {
7893 if {$cached_isanc($a,$bend)} {
7894 return 1
7897 if {[info exists cached_isanc($b,$aend)]} {
7898 if {$cached_isanc($b,$aend)} {
7899 return -1
7901 if {[info exists cached_isanc($a,$bend)]} {
7902 return 0
7906 set todo [list $a $b]
7907 set anc($a) a
7908 set anc($b) b
7909 for {set i 0} {$i < [llength $todo]} {incr i} {
7910 set x [lindex $todo $i]
7911 if {$anc($x) eq {}} {
7912 continue
7914 foreach arc $arcnos($x) {
7915 set xd $arcstart($arc)
7916 if {$xd eq $bend} {
7917 set cached_isanc($a,$bend) 1
7918 set cached_isanc($b,$aend) 0
7919 return 1
7920 } elseif {$xd eq $aend} {
7921 set cached_isanc($b,$aend) 1
7922 set cached_isanc($a,$bend) 0
7923 return -1
7925 if {![info exists anc($xd)]} {
7926 set anc($xd) $anc($x)
7927 lappend todo $xd
7928 } elseif {$anc($xd) ne $anc($x)} {
7929 set anc($xd) {}
7933 set cached_isanc($a,$bend) 0
7934 set cached_isanc($b,$aend) 0
7935 return 0
7938 # This identifies whether $desc has an ancestor that is
7939 # a growing tip of the graph and which is not an ancestor of $anc
7940 # and returns 0 if so and 1 if not.
7941 # If we subsequently discover a tag on such a growing tip, and that
7942 # turns out to be a descendent of $anc (which it could, since we
7943 # don't necessarily see children before parents), then $desc
7944 # isn't a good choice to display as a descendent tag of
7945 # $anc (since it is the descendent of another tag which is
7946 # a descendent of $anc). Similarly, $anc isn't a good choice to
7947 # display as a ancestor tag of $desc.
7949 proc is_certain {desc anc} {
7950 global arcnos arcout arcstart arcend growing problems
7952 set certain {}
7953 if {[llength $arcnos($anc)] == 1} {
7954 # tags on the same arc are certain
7955 if {$arcnos($desc) eq $arcnos($anc)} {
7956 return 1
7958 if {![info exists arcout($anc)]} {
7959 # if $anc is partway along an arc, use the start of the arc instead
7960 set a [lindex $arcnos($anc) 0]
7961 set anc $arcstart($a)
7964 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7965 set x $desc
7966 } else {
7967 set a [lindex $arcnos($desc) 0]
7968 set x $arcend($a)
7970 if {$x == $anc} {
7971 return 1
7973 set anclist [list $x]
7974 set dl($x) 1
7975 set nnh 1
7976 set ngrowanc 0
7977 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7978 set x [lindex $anclist $i]
7979 if {$dl($x)} {
7980 incr nnh -1
7982 set done($x) 1
7983 foreach a $arcout($x) {
7984 if {[info exists growing($a)]} {
7985 if {![info exists growanc($x)] && $dl($x)} {
7986 set growanc($x) 1
7987 incr ngrowanc
7989 } else {
7990 set y $arcend($a)
7991 if {[info exists dl($y)]} {
7992 if {$dl($y)} {
7993 if {!$dl($x)} {
7994 set dl($y) 0
7995 if {![info exists done($y)]} {
7996 incr nnh -1
7998 if {[info exists growanc($x)]} {
7999 incr ngrowanc -1
8001 set xl [list $y]
8002 for {set k 0} {$k < [llength $xl]} {incr k} {
8003 set z [lindex $xl $k]
8004 foreach c $arcout($z) {
8005 if {[info exists arcend($c)]} {
8006 set v $arcend($c)
8007 if {[info exists dl($v)] && $dl($v)} {
8008 set dl($v) 0
8009 if {![info exists done($v)]} {
8010 incr nnh -1
8012 if {[info exists growanc($v)]} {
8013 incr ngrowanc -1
8015 lappend xl $v
8022 } elseif {$y eq $anc || !$dl($x)} {
8023 set dl($y) 0
8024 lappend anclist $y
8025 } else {
8026 set dl($y) 1
8027 lappend anclist $y
8028 incr nnh
8033 foreach x [array names growanc] {
8034 if {$dl($x)} {
8035 return 0
8037 return 0
8039 return 1
8042 proc validate_arctags {a} {
8043 global arctags idtags
8045 set i -1
8046 set na $arctags($a)
8047 foreach id $arctags($a) {
8048 incr i
8049 if {![info exists idtags($id)]} {
8050 set na [lreplace $na $i $i]
8051 incr i -1
8054 set arctags($a) $na
8057 proc validate_archeads {a} {
8058 global archeads idheads
8060 set i -1
8061 set na $archeads($a)
8062 foreach id $archeads($a) {
8063 incr i
8064 if {![info exists idheads($id)]} {
8065 set na [lreplace $na $i $i]
8066 incr i -1
8069 set archeads($a) $na
8072 # Return the list of IDs that have tags that are descendents of id,
8073 # ignoring IDs that are descendents of IDs already reported.
8074 proc desctags {id} {
8075 global arcnos arcstart arcids arctags idtags allparents
8076 global growing cached_dtags
8078 if {![info exists allparents($id)]} {
8079 return {}
8081 set t1 [clock clicks -milliseconds]
8082 set argid $id
8083 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8084 # part-way along an arc; check that arc first
8085 set a [lindex $arcnos($id) 0]
8086 if {$arctags($a) ne {}} {
8087 validate_arctags $a
8088 set i [lsearch -exact $arcids($a) $id]
8089 set tid {}
8090 foreach t $arctags($a) {
8091 set j [lsearch -exact $arcids($a) $t]
8092 if {$j >= $i} break
8093 set tid $t
8095 if {$tid ne {}} {
8096 return $tid
8099 set id $arcstart($a)
8100 if {[info exists idtags($id)]} {
8101 return $id
8104 if {[info exists cached_dtags($id)]} {
8105 return $cached_dtags($id)
8108 set origid $id
8109 set todo [list $id]
8110 set queued($id) 1
8111 set nc 1
8112 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8113 set id [lindex $todo $i]
8114 set done($id) 1
8115 set ta [info exists hastaggedancestor($id)]
8116 if {!$ta} {
8117 incr nc -1
8119 # ignore tags on starting node
8120 if {!$ta && $i > 0} {
8121 if {[info exists idtags($id)]} {
8122 set tagloc($id) $id
8123 set ta 1
8124 } elseif {[info exists cached_dtags($id)]} {
8125 set tagloc($id) $cached_dtags($id)
8126 set ta 1
8129 foreach a $arcnos($id) {
8130 set d $arcstart($a)
8131 if {!$ta && $arctags($a) ne {}} {
8132 validate_arctags $a
8133 if {$arctags($a) ne {}} {
8134 lappend tagloc($id) [lindex $arctags($a) end]
8137 if {$ta || $arctags($a) ne {}} {
8138 set tomark [list $d]
8139 for {set j 0} {$j < [llength $tomark]} {incr j} {
8140 set dd [lindex $tomark $j]
8141 if {![info exists hastaggedancestor($dd)]} {
8142 if {[info exists done($dd)]} {
8143 foreach b $arcnos($dd) {
8144 lappend tomark $arcstart($b)
8146 if {[info exists tagloc($dd)]} {
8147 unset tagloc($dd)
8149 } elseif {[info exists queued($dd)]} {
8150 incr nc -1
8152 set hastaggedancestor($dd) 1
8156 if {![info exists queued($d)]} {
8157 lappend todo $d
8158 set queued($d) 1
8159 if {![info exists hastaggedancestor($d)]} {
8160 incr nc
8165 set tags {}
8166 foreach id [array names tagloc] {
8167 if {![info exists hastaggedancestor($id)]} {
8168 foreach t $tagloc($id) {
8169 if {[lsearch -exact $tags $t] < 0} {
8170 lappend tags $t
8175 set t2 [clock clicks -milliseconds]
8176 set loopix $i
8178 # remove tags that are descendents of other tags
8179 for {set i 0} {$i < [llength $tags]} {incr i} {
8180 set a [lindex $tags $i]
8181 for {set j 0} {$j < $i} {incr j} {
8182 set b [lindex $tags $j]
8183 set r [anc_or_desc $a $b]
8184 if {$r == 1} {
8185 set tags [lreplace $tags $j $j]
8186 incr j -1
8187 incr i -1
8188 } elseif {$r == -1} {
8189 set tags [lreplace $tags $i $i]
8190 incr i -1
8191 break
8196 if {[array names growing] ne {}} {
8197 # graph isn't finished, need to check if any tag could get
8198 # eclipsed by another tag coming later. Simply ignore any
8199 # tags that could later get eclipsed.
8200 set ctags {}
8201 foreach t $tags {
8202 if {[is_certain $t $origid]} {
8203 lappend ctags $t
8206 if {$tags eq $ctags} {
8207 set cached_dtags($origid) $tags
8208 } else {
8209 set tags $ctags
8211 } else {
8212 set cached_dtags($origid) $tags
8214 set t3 [clock clicks -milliseconds]
8215 if {0 && $t3 - $t1 >= 100} {
8216 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8217 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8219 return $tags
8222 proc anctags {id} {
8223 global arcnos arcids arcout arcend arctags idtags allparents
8224 global growing cached_atags
8226 if {![info exists allparents($id)]} {
8227 return {}
8229 set t1 [clock clicks -milliseconds]
8230 set argid $id
8231 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8232 # part-way along an arc; check that arc first
8233 set a [lindex $arcnos($id) 0]
8234 if {$arctags($a) ne {}} {
8235 validate_arctags $a
8236 set i [lsearch -exact $arcids($a) $id]
8237 foreach t $arctags($a) {
8238 set j [lsearch -exact $arcids($a) $t]
8239 if {$j > $i} {
8240 return $t
8244 if {![info exists arcend($a)]} {
8245 return {}
8247 set id $arcend($a)
8248 if {[info exists idtags($id)]} {
8249 return $id
8252 if {[info exists cached_atags($id)]} {
8253 return $cached_atags($id)
8256 set origid $id
8257 set todo [list $id]
8258 set queued($id) 1
8259 set taglist {}
8260 set nc 1
8261 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8262 set id [lindex $todo $i]
8263 set done($id) 1
8264 set td [info exists hastaggeddescendent($id)]
8265 if {!$td} {
8266 incr nc -1
8268 # ignore tags on starting node
8269 if {!$td && $i > 0} {
8270 if {[info exists idtags($id)]} {
8271 set tagloc($id) $id
8272 set td 1
8273 } elseif {[info exists cached_atags($id)]} {
8274 set tagloc($id) $cached_atags($id)
8275 set td 1
8278 foreach a $arcout($id) {
8279 if {!$td && $arctags($a) ne {}} {
8280 validate_arctags $a
8281 if {$arctags($a) ne {}} {
8282 lappend tagloc($id) [lindex $arctags($a) 0]
8285 if {![info exists arcend($a)]} continue
8286 set d $arcend($a)
8287 if {$td || $arctags($a) ne {}} {
8288 set tomark [list $d]
8289 for {set j 0} {$j < [llength $tomark]} {incr j} {
8290 set dd [lindex $tomark $j]
8291 if {![info exists hastaggeddescendent($dd)]} {
8292 if {[info exists done($dd)]} {
8293 foreach b $arcout($dd) {
8294 if {[info exists arcend($b)]} {
8295 lappend tomark $arcend($b)
8298 if {[info exists tagloc($dd)]} {
8299 unset tagloc($dd)
8301 } elseif {[info exists queued($dd)]} {
8302 incr nc -1
8304 set hastaggeddescendent($dd) 1
8308 if {![info exists queued($d)]} {
8309 lappend todo $d
8310 set queued($d) 1
8311 if {![info exists hastaggeddescendent($d)]} {
8312 incr nc
8317 set t2 [clock clicks -milliseconds]
8318 set loopix $i
8319 set tags {}
8320 foreach id [array names tagloc] {
8321 if {![info exists hastaggeddescendent($id)]} {
8322 foreach t $tagloc($id) {
8323 if {[lsearch -exact $tags $t] < 0} {
8324 lappend tags $t
8330 # remove tags that are ancestors of other tags
8331 for {set i 0} {$i < [llength $tags]} {incr i} {
8332 set a [lindex $tags $i]
8333 for {set j 0} {$j < $i} {incr j} {
8334 set b [lindex $tags $j]
8335 set r [anc_or_desc $a $b]
8336 if {$r == -1} {
8337 set tags [lreplace $tags $j $j]
8338 incr j -1
8339 incr i -1
8340 } elseif {$r == 1} {
8341 set tags [lreplace $tags $i $i]
8342 incr i -1
8343 break
8348 if {[array names growing] ne {}} {
8349 # graph isn't finished, need to check if any tag could get
8350 # eclipsed by another tag coming later. Simply ignore any
8351 # tags that could later get eclipsed.
8352 set ctags {}
8353 foreach t $tags {
8354 if {[is_certain $origid $t]} {
8355 lappend ctags $t
8358 if {$tags eq $ctags} {
8359 set cached_atags($origid) $tags
8360 } else {
8361 set tags $ctags
8363 } else {
8364 set cached_atags($origid) $tags
8366 set t3 [clock clicks -milliseconds]
8367 if {0 && $t3 - $t1 >= 100} {
8368 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8369 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8371 return $tags
8374 # Return the list of IDs that have heads that are descendents of id,
8375 # including id itself if it has a head.
8376 proc descheads {id} {
8377 global arcnos arcstart arcids archeads idheads cached_dheads
8378 global allparents
8380 if {![info exists allparents($id)]} {
8381 return {}
8383 set aret {}
8384 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8385 # part-way along an arc; check it first
8386 set a [lindex $arcnos($id) 0]
8387 if {$archeads($a) ne {}} {
8388 validate_archeads $a
8389 set i [lsearch -exact $arcids($a) $id]
8390 foreach t $archeads($a) {
8391 set j [lsearch -exact $arcids($a) $t]
8392 if {$j > $i} break
8393 lappend aret $t
8396 set id $arcstart($a)
8398 set origid $id
8399 set todo [list $id]
8400 set seen($id) 1
8401 set ret {}
8402 for {set i 0} {$i < [llength $todo]} {incr i} {
8403 set id [lindex $todo $i]
8404 if {[info exists cached_dheads($id)]} {
8405 set ret [concat $ret $cached_dheads($id)]
8406 } else {
8407 if {[info exists idheads($id)]} {
8408 lappend ret $id
8410 foreach a $arcnos($id) {
8411 if {$archeads($a) ne {}} {
8412 validate_archeads $a
8413 if {$archeads($a) ne {}} {
8414 set ret [concat $ret $archeads($a)]
8417 set d $arcstart($a)
8418 if {![info exists seen($d)]} {
8419 lappend todo $d
8420 set seen($d) 1
8425 set ret [lsort -unique $ret]
8426 set cached_dheads($origid) $ret
8427 return [concat $ret $aret]
8430 proc addedtag {id} {
8431 global arcnos arcout cached_dtags cached_atags
8433 if {![info exists arcnos($id)]} return
8434 if {![info exists arcout($id)]} {
8435 recalcarc [lindex $arcnos($id) 0]
8437 catch {unset cached_dtags}
8438 catch {unset cached_atags}
8441 proc addedhead {hid head} {
8442 global arcnos arcout cached_dheads
8444 if {![info exists arcnos($hid)]} return
8445 if {![info exists arcout($hid)]} {
8446 recalcarc [lindex $arcnos($hid) 0]
8448 catch {unset cached_dheads}
8451 proc removedhead {hid head} {
8452 global cached_dheads
8454 catch {unset cached_dheads}
8457 proc movedhead {hid head} {
8458 global arcnos arcout cached_dheads
8460 if {![info exists arcnos($hid)]} return
8461 if {![info exists arcout($hid)]} {
8462 recalcarc [lindex $arcnos($hid) 0]
8464 catch {unset cached_dheads}
8467 proc changedrefs {} {
8468 global cached_dheads cached_dtags cached_atags
8469 global arctags archeads arcnos arcout idheads idtags
8471 foreach id [concat [array names idheads] [array names idtags]] {
8472 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8473 set a [lindex $arcnos($id) 0]
8474 if {![info exists donearc($a)]} {
8475 recalcarc $a
8476 set donearc($a) 1
8480 catch {unset cached_dtags}
8481 catch {unset cached_atags}
8482 catch {unset cached_dheads}
8485 proc rereadrefs {} {
8486 global idtags idheads idotherrefs mainheadid
8488 set refids [concat [array names idtags] \
8489 [array names idheads] [array names idotherrefs]]
8490 foreach id $refids {
8491 if {![info exists ref($id)]} {
8492 set ref($id) [listrefs $id]
8495 set oldmainhead $mainheadid
8496 readrefs
8497 changedrefs
8498 set refids [lsort -unique [concat $refids [array names idtags] \
8499 [array names idheads] [array names idotherrefs]]]
8500 foreach id $refids {
8501 set v [listrefs $id]
8502 if {![info exists ref($id)] || $ref($id) != $v ||
8503 ($id eq $oldmainhead && $id ne $mainheadid) ||
8504 ($id eq $mainheadid && $id ne $oldmainhead)} {
8505 redrawtags $id
8508 run refill_reflist
8511 proc listrefs {id} {
8512 global idtags idheads idotherrefs
8514 set x {}
8515 if {[info exists idtags($id)]} {
8516 set x $idtags($id)
8518 set y {}
8519 if {[info exists idheads($id)]} {
8520 set y $idheads($id)
8522 set z {}
8523 if {[info exists idotherrefs($id)]} {
8524 set z $idotherrefs($id)
8526 return [list $x $y $z]
8529 proc showtag {tag isnew} {
8530 global ctext tagcontents tagids linknum tagobjid
8532 if {$isnew} {
8533 addtohistory [list showtag $tag 0]
8535 $ctext conf -state normal
8536 clear_ctext
8537 settabs 0
8538 set linknum 0
8539 if {![info exists tagcontents($tag)]} {
8540 catch {
8541 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8544 if {[info exists tagcontents($tag)]} {
8545 set text $tagcontents($tag)
8546 } else {
8547 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8549 appendwithlinks $text {}
8550 $ctext conf -state disabled
8551 init_flist {}
8554 proc doquit {} {
8555 global stopped
8556 set stopped 100
8557 savestuff .
8558 destroy .
8561 proc mkfontdisp {font top which} {
8562 global fontattr fontpref $font
8564 set fontpref($font) [set $font]
8565 button $top.${font}but -text $which -font optionfont \
8566 -command [list choosefont $font $which]
8567 label $top.$font -relief flat -font $font \
8568 -text $fontattr($font,family) -justify left
8569 grid x $top.${font}but $top.$font -sticky w
8572 proc choosefont {font which} {
8573 global fontparam fontlist fonttop fontattr
8575 set fontparam(which) $which
8576 set fontparam(font) $font
8577 set fontparam(family) [font actual $font -family]
8578 set fontparam(size) $fontattr($font,size)
8579 set fontparam(weight) $fontattr($font,weight)
8580 set fontparam(slant) $fontattr($font,slant)
8581 set top .gitkfont
8582 set fonttop $top
8583 if {![winfo exists $top]} {
8584 font create sample
8585 eval font config sample [font actual $font]
8586 toplevel $top
8587 wm title $top [mc "Gitk font chooser"]
8588 label $top.l -textvariable fontparam(which)
8589 pack $top.l -side top
8590 set fontlist [lsort [font families]]
8591 frame $top.f
8592 listbox $top.f.fam -listvariable fontlist \
8593 -yscrollcommand [list $top.f.sb set]
8594 bind $top.f.fam <<ListboxSelect>> selfontfam
8595 scrollbar $top.f.sb -command [list $top.f.fam yview]
8596 pack $top.f.sb -side right -fill y
8597 pack $top.f.fam -side left -fill both -expand 1
8598 pack $top.f -side top -fill both -expand 1
8599 frame $top.g
8600 spinbox $top.g.size -from 4 -to 40 -width 4 \
8601 -textvariable fontparam(size) \
8602 -validatecommand {string is integer -strict %s}
8603 checkbutton $top.g.bold -padx 5 \
8604 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8605 -variable fontparam(weight) -onvalue bold -offvalue normal
8606 checkbutton $top.g.ital -padx 5 \
8607 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8608 -variable fontparam(slant) -onvalue italic -offvalue roman
8609 pack $top.g.size $top.g.bold $top.g.ital -side left
8610 pack $top.g -side top
8611 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8612 -background white
8613 $top.c create text 100 25 -anchor center -text $which -font sample \
8614 -fill black -tags text
8615 bind $top.c <Configure> [list centertext $top.c]
8616 pack $top.c -side top -fill x
8617 frame $top.buts
8618 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8619 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8620 grid $top.buts.ok $top.buts.can
8621 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8622 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8623 pack $top.buts -side bottom -fill x
8624 trace add variable fontparam write chg_fontparam
8625 } else {
8626 raise $top
8627 $top.c itemconf text -text $which
8629 set i [lsearch -exact $fontlist $fontparam(family)]
8630 if {$i >= 0} {
8631 $top.f.fam selection set $i
8632 $top.f.fam see $i
8636 proc centertext {w} {
8637 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8640 proc fontok {} {
8641 global fontparam fontpref prefstop
8643 set f $fontparam(font)
8644 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8645 if {$fontparam(weight) eq "bold"} {
8646 lappend fontpref($f) "bold"
8648 if {$fontparam(slant) eq "italic"} {
8649 lappend fontpref($f) "italic"
8651 set w $prefstop.$f
8652 $w conf -text $fontparam(family) -font $fontpref($f)
8654 fontcan
8657 proc fontcan {} {
8658 global fonttop fontparam
8660 if {[info exists fonttop]} {
8661 catch {destroy $fonttop}
8662 catch {font delete sample}
8663 unset fonttop
8664 unset fontparam
8668 proc selfontfam {} {
8669 global fonttop fontparam
8671 set i [$fonttop.f.fam curselection]
8672 if {$i ne {}} {
8673 set fontparam(family) [$fonttop.f.fam get $i]
8677 proc chg_fontparam {v sub op} {
8678 global fontparam
8680 font config sample -$sub $fontparam($sub)
8683 proc doprefs {} {
8684 global maxwidth maxgraphpct
8685 global oldprefs prefstop showneartags showlocalchanges
8686 global bgcolor fgcolor ctext diffcolors selectbgcolor
8687 global tabstop limitdiffs
8689 set top .gitkprefs
8690 set prefstop $top
8691 if {[winfo exists $top]} {
8692 raise $top
8693 return
8695 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8696 limitdiffs tabstop} {
8697 set oldprefs($v) [set $v]
8699 toplevel $top
8700 wm title $top [mc "Gitk preferences"]
8701 label $top.ldisp -text [mc "Commit list display options"]
8702 grid $top.ldisp - -sticky w -pady 10
8703 label $top.spacer -text " "
8704 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8705 -font optionfont
8706 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8707 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8708 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8709 -font optionfont
8710 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8711 grid x $top.maxpctl $top.maxpct -sticky w
8712 frame $top.showlocal
8713 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8714 checkbutton $top.showlocal.b -variable showlocalchanges
8715 pack $top.showlocal.b $top.showlocal.l -side left
8716 grid x $top.showlocal -sticky w
8718 label $top.ddisp -text [mc "Diff display options"]
8719 grid $top.ddisp - -sticky w -pady 10
8720 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8721 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8722 grid x $top.tabstopl $top.tabstop -sticky w
8723 frame $top.ntag
8724 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8725 checkbutton $top.ntag.b -variable showneartags
8726 pack $top.ntag.b $top.ntag.l -side left
8727 grid x $top.ntag -sticky w
8728 frame $top.ldiff
8729 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8730 checkbutton $top.ldiff.b -variable limitdiffs
8731 pack $top.ldiff.b $top.ldiff.l -side left
8732 grid x $top.ldiff -sticky w
8734 label $top.cdisp -text [mc "Colors: press to choose"]
8735 grid $top.cdisp - -sticky w -pady 10
8736 label $top.bg -padx 40 -relief sunk -background $bgcolor
8737 button $top.bgbut -text [mc "Background"] -font optionfont \
8738 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8739 grid x $top.bgbut $top.bg -sticky w
8740 label $top.fg -padx 40 -relief sunk -background $fgcolor
8741 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8742 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8743 grid x $top.fgbut $top.fg -sticky w
8744 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8745 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8746 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8747 [list $ctext tag conf d0 -foreground]]
8748 grid x $top.diffoldbut $top.diffold -sticky w
8749 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8750 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8751 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8752 [list $ctext tag conf d1 -foreground]]
8753 grid x $top.diffnewbut $top.diffnew -sticky w
8754 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8755 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8756 -command [list choosecolor diffcolors 2 $top.hunksep \
8757 "diff hunk header" \
8758 [list $ctext tag conf hunksep -foreground]]
8759 grid x $top.hunksepbut $top.hunksep -sticky w
8760 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8761 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8762 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8763 grid x $top.selbgbut $top.selbgsep -sticky w
8765 label $top.cfont -text [mc "Fonts: press to choose"]
8766 grid $top.cfont - -sticky w -pady 10
8767 mkfontdisp mainfont $top [mc "Main font"]
8768 mkfontdisp textfont $top [mc "Diff display font"]
8769 mkfontdisp uifont $top [mc "User interface font"]
8771 frame $top.buts
8772 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8773 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8774 grid $top.buts.ok $top.buts.can
8775 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8776 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8777 grid $top.buts - - -pady 10 -sticky ew
8778 bind $top <Visibility> "focus $top.buts.ok"
8781 proc choosecolor {v vi w x cmd} {
8782 global $v
8784 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8785 -title [mc "Gitk: choose color for %s" $x]]
8786 if {$c eq {}} return
8787 $w conf -background $c
8788 lset $v $vi $c
8789 eval $cmd $c
8792 proc setselbg {c} {
8793 global bglist cflist
8794 foreach w $bglist {
8795 $w configure -selectbackground $c
8797 $cflist tag configure highlight \
8798 -background [$cflist cget -selectbackground]
8799 allcanvs itemconf secsel -fill $c
8802 proc setbg {c} {
8803 global bglist
8805 foreach w $bglist {
8806 $w conf -background $c
8810 proc setfg {c} {
8811 global fglist canv
8813 foreach w $fglist {
8814 $w conf -foreground $c
8816 allcanvs itemconf text -fill $c
8817 $canv itemconf circle -outline $c
8820 proc prefscan {} {
8821 global oldprefs prefstop
8823 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8824 limitdiffs tabstop} {
8825 global $v
8826 set $v $oldprefs($v)
8828 catch {destroy $prefstop}
8829 unset prefstop
8830 fontcan
8833 proc prefsok {} {
8834 global maxwidth maxgraphpct
8835 global oldprefs prefstop showneartags showlocalchanges
8836 global fontpref mainfont textfont uifont
8837 global limitdiffs treediffs
8839 catch {destroy $prefstop}
8840 unset prefstop
8841 fontcan
8842 set fontchanged 0
8843 if {$mainfont ne $fontpref(mainfont)} {
8844 set mainfont $fontpref(mainfont)
8845 parsefont mainfont $mainfont
8846 eval font configure mainfont [fontflags mainfont]
8847 eval font configure mainfontbold [fontflags mainfont 1]
8848 setcoords
8849 set fontchanged 1
8851 if {$textfont ne $fontpref(textfont)} {
8852 set textfont $fontpref(textfont)
8853 parsefont textfont $textfont
8854 eval font configure textfont [fontflags textfont]
8855 eval font configure textfontbold [fontflags textfont 1]
8857 if {$uifont ne $fontpref(uifont)} {
8858 set uifont $fontpref(uifont)
8859 parsefont uifont $uifont
8860 eval font configure uifont [fontflags uifont]
8862 settabs
8863 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8864 if {$showlocalchanges} {
8865 doshowlocalchanges
8866 } else {
8867 dohidelocalchanges
8870 if {$limitdiffs != $oldprefs(limitdiffs)} {
8871 # treediffs elements are limited by path
8872 catch {unset treediffs}
8874 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8875 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8876 redisplay
8877 } elseif {$showneartags != $oldprefs(showneartags) ||
8878 $limitdiffs != $oldprefs(limitdiffs)} {
8879 reselectline
8883 proc formatdate {d} {
8884 global datetimeformat
8885 if {$d ne {}} {
8886 set d [clock format $d -format $datetimeformat]
8888 return $d
8891 # This list of encoding names and aliases is distilled from
8892 # http://www.iana.org/assignments/character-sets.
8893 # Not all of them are supported by Tcl.
8894 set encoding_aliases {
8895 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8896 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8897 { ISO-10646-UTF-1 csISO10646UTF1 }
8898 { ISO_646.basic:1983 ref csISO646basic1983 }
8899 { INVARIANT csINVARIANT }
8900 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8901 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8902 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8903 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8904 { NATS-DANO iso-ir-9-1 csNATSDANO }
8905 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8906 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8907 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8908 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8909 { ISO-2022-KR csISO2022KR }
8910 { EUC-KR csEUCKR }
8911 { ISO-2022-JP csISO2022JP }
8912 { ISO-2022-JP-2 csISO2022JP2 }
8913 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8914 csISO13JISC6220jp }
8915 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8916 { IT iso-ir-15 ISO646-IT csISO15Italian }
8917 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8918 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8919 { greek7-old iso-ir-18 csISO18Greek7Old }
8920 { latin-greek iso-ir-19 csISO19LatinGreek }
8921 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8922 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8923 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8924 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8925 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8926 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8927 { INIS iso-ir-49 csISO49INIS }
8928 { INIS-8 iso-ir-50 csISO50INIS8 }
8929 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8930 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8931 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8932 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8933 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8934 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8935 csISO60Norwegian1 }
8936 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8937 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8938 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8939 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8940 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8941 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8942 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8943 { greek7 iso-ir-88 csISO88Greek7 }
8944 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8945 { iso-ir-90 csISO90 }
8946 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8947 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8948 csISO92JISC62991984b }
8949 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8950 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8951 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8952 csISO95JIS62291984handadd }
8953 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8954 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8955 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8956 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8957 CP819 csISOLatin1 }
8958 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8959 { T.61-7bit iso-ir-102 csISO102T617bit }
8960 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8961 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8962 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8963 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8964 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8965 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8966 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8967 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8968 arabic csISOLatinArabic }
8969 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8970 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8971 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8972 greek greek8 csISOLatinGreek }
8973 { T.101-G2 iso-ir-128 csISO128T101G2 }
8974 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8975 csISOLatinHebrew }
8976 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8977 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8978 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8979 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8980 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8981 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8982 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8983 csISOLatinCyrillic }
8984 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8985 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8986 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8987 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8988 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8989 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8990 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8991 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8992 { ISO_10367-box iso-ir-155 csISO10367Box }
8993 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8994 { latin-lap lap iso-ir-158 csISO158Lap }
8995 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8996 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8997 { us-dk csUSDK }
8998 { dk-us csDKUS }
8999 { JIS_X0201 X0201 csHalfWidthKatakana }
9000 { KSC5636 ISO646-KR csKSC5636 }
9001 { ISO-10646-UCS-2 csUnicode }
9002 { ISO-10646-UCS-4 csUCS4 }
9003 { DEC-MCS dec csDECMCS }
9004 { hp-roman8 roman8 r8 csHPRoman8 }
9005 { macintosh mac csMacintosh }
9006 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9007 csIBM037 }
9008 { IBM038 EBCDIC-INT cp038 csIBM038 }
9009 { IBM273 CP273 csIBM273 }
9010 { IBM274 EBCDIC-BE CP274 csIBM274 }
9011 { IBM275 EBCDIC-BR cp275 csIBM275 }
9012 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9013 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9014 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9015 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9016 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9017 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9018 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9019 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9020 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9021 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9022 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9023 { IBM437 cp437 437 csPC8CodePage437 }
9024 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9025 { IBM775 cp775 csPC775Baltic }
9026 { IBM850 cp850 850 csPC850Multilingual }
9027 { IBM851 cp851 851 csIBM851 }
9028 { IBM852 cp852 852 csPCp852 }
9029 { IBM855 cp855 855 csIBM855 }
9030 { IBM857 cp857 857 csIBM857 }
9031 { IBM860 cp860 860 csIBM860 }
9032 { IBM861 cp861 861 cp-is csIBM861 }
9033 { IBM862 cp862 862 csPC862LatinHebrew }
9034 { IBM863 cp863 863 csIBM863 }
9035 { IBM864 cp864 csIBM864 }
9036 { IBM865 cp865 865 csIBM865 }
9037 { IBM866 cp866 866 csIBM866 }
9038 { IBM868 CP868 cp-ar csIBM868 }
9039 { IBM869 cp869 869 cp-gr csIBM869 }
9040 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9041 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9042 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9043 { IBM891 cp891 csIBM891 }
9044 { IBM903 cp903 csIBM903 }
9045 { IBM904 cp904 904 csIBBM904 }
9046 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9047 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9048 { IBM1026 CP1026 csIBM1026 }
9049 { EBCDIC-AT-DE csIBMEBCDICATDE }
9050 { EBCDIC-AT-DE-A csEBCDICATDEA }
9051 { EBCDIC-CA-FR csEBCDICCAFR }
9052 { EBCDIC-DK-NO csEBCDICDKNO }
9053 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9054 { EBCDIC-FI-SE csEBCDICFISE }
9055 { EBCDIC-FI-SE-A csEBCDICFISEA }
9056 { EBCDIC-FR csEBCDICFR }
9057 { EBCDIC-IT csEBCDICIT }
9058 { EBCDIC-PT csEBCDICPT }
9059 { EBCDIC-ES csEBCDICES }
9060 { EBCDIC-ES-A csEBCDICESA }
9061 { EBCDIC-ES-S csEBCDICESS }
9062 { EBCDIC-UK csEBCDICUK }
9063 { EBCDIC-US csEBCDICUS }
9064 { UNKNOWN-8BIT csUnknown8BiT }
9065 { MNEMONIC csMnemonic }
9066 { MNEM csMnem }
9067 { VISCII csVISCII }
9068 { VIQR csVIQR }
9069 { KOI8-R csKOI8R }
9070 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9071 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9072 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9073 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9074 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9075 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9076 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9077 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9078 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9079 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9080 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9081 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9082 { IBM1047 IBM-1047 }
9083 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9084 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9085 { UNICODE-1-1 csUnicode11 }
9086 { CESU-8 csCESU-8 }
9087 { BOCU-1 csBOCU-1 }
9088 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9089 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9090 l8 }
9091 { ISO-8859-15 ISO_8859-15 Latin-9 }
9092 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9093 { GBK CP936 MS936 windows-936 }
9094 { JIS_Encoding csJISEncoding }
9095 { Shift_JIS MS_Kanji csShiftJIS }
9096 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9097 EUC-JP }
9098 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9099 { ISO-10646-UCS-Basic csUnicodeASCII }
9100 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9101 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9102 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9103 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9104 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9105 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9106 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9107 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9108 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9109 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9110 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9111 { Ventura-US csVenturaUS }
9112 { Ventura-International csVenturaInternational }
9113 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9114 { PC8-Turkish csPC8Turkish }
9115 { IBM-Symbols csIBMSymbols }
9116 { IBM-Thai csIBMThai }
9117 { HP-Legal csHPLegal }
9118 { HP-Pi-font csHPPiFont }
9119 { HP-Math8 csHPMath8 }
9120 { Adobe-Symbol-Encoding csHPPSMath }
9121 { HP-DeskTop csHPDesktop }
9122 { Ventura-Math csVenturaMath }
9123 { Microsoft-Publishing csMicrosoftPublishing }
9124 { Windows-31J csWindows31J }
9125 { GB2312 csGB2312 }
9126 { Big5 csBig5 }
9129 proc tcl_encoding {enc} {
9130 global encoding_aliases
9131 set names [encoding names]
9132 set lcnames [string tolower $names]
9133 set enc [string tolower $enc]
9134 set i [lsearch -exact $lcnames $enc]
9135 if {$i < 0} {
9136 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9137 if {[regsub {^iso[-_]} $enc iso encx]} {
9138 set i [lsearch -exact $lcnames $encx]
9141 if {$i < 0} {
9142 foreach l $encoding_aliases {
9143 set ll [string tolower $l]
9144 if {[lsearch -exact $ll $enc] < 0} continue
9145 # look through the aliases for one that tcl knows about
9146 foreach e $ll {
9147 set i [lsearch -exact $lcnames $e]
9148 if {$i < 0} {
9149 if {[regsub {^iso[-_]} $e iso ex]} {
9150 set i [lsearch -exact $lcnames $ex]
9153 if {$i >= 0} break
9155 break
9158 if {$i >= 0} {
9159 return [lindex $names $i]
9161 return {}
9164 # First check that Tcl/Tk is recent enough
9165 if {[catch {package require Tk 8.4} err]} {
9166 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9167 Gitk requires at least Tcl/Tk 8.4."]
9168 exit 1
9171 # defaults...
9172 set datemode 0
9173 set wrcomcmd "git diff-tree --stdin -p --pretty"
9175 set gitencoding {}
9176 catch {
9177 set gitencoding [exec git config --get i18n.commitencoding]
9179 if {$gitencoding == ""} {
9180 set gitencoding "utf-8"
9182 set tclencoding [tcl_encoding $gitencoding]
9183 if {$tclencoding == {}} {
9184 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9187 set mainfont {Helvetica 9}
9188 set textfont {Courier 9}
9189 set uifont {Helvetica 9 bold}
9190 set tabstop 8
9191 set findmergefiles 0
9192 set maxgraphpct 50
9193 set maxwidth 16
9194 set revlistorder 0
9195 set fastdate 0
9196 set uparrowlen 5
9197 set downarrowlen 5
9198 set mingaplen 100
9199 set cmitmode "patch"
9200 set wrapcomment "none"
9201 set showneartags 1
9202 set maxrefs 20
9203 set maxlinelen 200
9204 set showlocalchanges 1
9205 set limitdiffs 1
9206 set datetimeformat "%Y-%m-%d %H:%M:%S"
9208 set colors {green red blue magenta darkgrey brown orange}
9209 set bgcolor white
9210 set fgcolor black
9211 set diffcolors {red "#00a000" blue}
9212 set diffcontext 3
9213 set selectbgcolor gray85
9215 ## For msgcat loading, first locate the installation location.
9216 if { [info exists ::env(GITK_MSGSDIR)] } {
9217 ## Msgsdir was manually set in the environment.
9218 set gitk_msgsdir $::env(GITK_MSGSDIR)
9219 } else {
9220 ## Let's guess the prefix from argv0.
9221 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9222 set gitk_libdir [file join $gitk_prefix share gitk lib]
9223 set gitk_msgsdir [file join $gitk_libdir msgs]
9224 unset gitk_prefix
9227 ## Internationalization (i18n) through msgcat and gettext. See
9228 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9229 package require msgcat
9230 namespace import ::msgcat::mc
9231 ## And eventually load the actual message catalog
9232 ::msgcat::mcload $gitk_msgsdir
9234 catch {source ~/.gitk}
9236 font create optionfont -family sans-serif -size -12
9238 parsefont mainfont $mainfont
9239 eval font create mainfont [fontflags mainfont]
9240 eval font create mainfontbold [fontflags mainfont 1]
9242 parsefont textfont $textfont
9243 eval font create textfont [fontflags textfont]
9244 eval font create textfontbold [fontflags textfont 1]
9246 parsefont uifont $uifont
9247 eval font create uifont [fontflags uifont]
9249 setoptions
9251 # check that we can find a .git directory somewhere...
9252 if {[catch {set gitdir [gitdir]}]} {
9253 show_error {} . [mc "Cannot find a git repository here."]
9254 exit 1
9256 if {![file isdirectory $gitdir]} {
9257 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9258 exit 1
9261 set mergeonly 0
9262 set revtreeargs {}
9263 set cmdline_files {}
9264 set i 0
9265 foreach arg $argv {
9266 switch -- $arg {
9267 "" { }
9268 "-d" { set datemode 1 }
9269 "--merge" {
9270 set mergeonly 1
9271 lappend revtreeargs $arg
9273 "--" {
9274 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9275 break
9277 default {
9278 lappend revtreeargs $arg
9281 incr i
9284 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9285 # no -- on command line, but some arguments (other than -d)
9286 if {[catch {
9287 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9288 set cmdline_files [split $f "\n"]
9289 set n [llength $cmdline_files]
9290 set revtreeargs [lrange $revtreeargs 0 end-$n]
9291 # Unfortunately git rev-parse doesn't produce an error when
9292 # something is both a revision and a filename. To be consistent
9293 # with git log and git rev-list, check revtreeargs for filenames.
9294 foreach arg $revtreeargs {
9295 if {[file exists $arg]} {
9296 show_error {} . [mc "Ambiguous argument '%s': both revision\
9297 and filename" $arg]
9298 exit 1
9301 } err]} {
9302 # unfortunately we get both stdout and stderr in $err,
9303 # so look for "fatal:".
9304 set i [string first "fatal:" $err]
9305 if {$i > 0} {
9306 set err [string range $err [expr {$i + 6}] end]
9308 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9309 exit 1
9313 if {$mergeonly} {
9314 # find the list of unmerged files
9315 set mlist {}
9316 set nr_unmerged 0
9317 if {[catch {
9318 set fd [open "| git ls-files -u" r]
9319 } err]} {
9320 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9321 exit 1
9323 while {[gets $fd line] >= 0} {
9324 set i [string first "\t" $line]
9325 if {$i < 0} continue
9326 set fname [string range $line [expr {$i+1}] end]
9327 if {[lsearch -exact $mlist $fname] >= 0} continue
9328 incr nr_unmerged
9329 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9330 lappend mlist $fname
9333 catch {close $fd}
9334 if {$mlist eq {}} {
9335 if {$nr_unmerged == 0} {
9336 show_error {} . [mc "No files selected: --merge specified but\
9337 no files are unmerged."]
9338 } else {
9339 show_error {} . [mc "No files selected: --merge specified but\
9340 no unmerged files are within file limit."]
9342 exit 1
9344 set cmdline_files $mlist
9347 set nullid "0000000000000000000000000000000000000000"
9348 set nullid2 "0000000000000000000000000000000000000001"
9350 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9352 set runq {}
9353 set history {}
9354 set historyindex 0
9355 set fh_serial 0
9356 set nhl_names {}
9357 set highlight_paths {}
9358 set findpattern {}
9359 set searchdirn -forwards
9360 set boldrows {}
9361 set boldnamerows {}
9362 set diffelide {0 0}
9363 set markingmatches 0
9364 set linkentercount 0
9365 set need_redisplay 0
9366 set nrows_drawn 0
9367 set firsttabstop 0
9369 set nextviewnum 1
9370 set curview 0
9371 set selectedview 0
9372 set selectedhlview [mc "None"]
9373 set highlight_related [mc "None"]
9374 set highlight_files {}
9375 set viewfiles(0) {}
9376 set viewperm(0) 0
9377 set viewargs(0) {}
9379 set loginstance 0
9380 set cmdlineok 0
9381 set stopped 0
9382 set stuffsaved 0
9383 set patchnum 0
9384 set lserial 0
9385 setcoords
9386 makewindow
9387 # wait for the window to become visible
9388 tkwait visibility .
9389 wm title . "[file tail $argv0]: [file tail [pwd]]"
9390 readrefs
9392 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9393 # create a view for the files/dirs specified on the command line
9394 set curview 1
9395 set selectedview 1
9396 set nextviewnum 2
9397 set viewname(1) [mc "Command line"]
9398 set viewfiles(1) $cmdline_files
9399 set viewargs(1) $revtreeargs
9400 set viewperm(1) 0
9401 addviewmenu 1
9402 .bar.view entryconf [mc "Edit view..."] -state normal
9403 .bar.view entryconf [mc "Delete view"] -state normal
9406 if {[info exists permviews]} {
9407 foreach v $permviews {
9408 set n $nextviewnum
9409 incr nextviewnum
9410 set viewname($n) [lindex $v 0]
9411 set viewfiles($n) [lindex $v 1]
9412 set viewargs($n) [lindex $v 2]
9413 set viewperm($n) 1
9414 addviewmenu $n
9417 getcommits