gitk: Fix cherry-picking to insert a real row not a fake row
[git/mingw/4msysgit/gitPS1fix.git] / gitk
blob36199e330517212b0ac2675dcf9509f6a5aa6188
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 if {!$listed && [info exists parents($vid)]} continue
1069 if {$listed} {
1070 set olds [lrange $ids 1 end]
1071 } else {
1072 set olds {}
1074 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1075 set cmitlisted($vid) $listed
1076 set parents($vid) $olds
1077 set a 0
1078 if {![info exists children($vid)]} {
1079 set children($vid) {}
1080 } elseif {[llength $children($vid)] == 1} {
1081 set k [lindex $children($vid) 0]
1082 if {[llength $parents($view,$k)] == 1 &&
1083 (!$datemode ||
1084 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1085 set a $varcid($view,$k)
1088 if {$a == 0} {
1089 # new arc
1090 set a [newvarc $view $id]
1092 set varcid($vid) $a
1093 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1094 modify_arc $view $a
1096 lappend varccommits($view,$a) $id
1098 set i 0
1099 foreach p $olds {
1100 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1101 set vp $view,$p
1102 if {[llength [lappend children($vp) $id]] > 1 &&
1103 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1104 set children($vp) [lsort -command [list vtokcmp $view] \
1105 $children($vp)]
1106 catch {unset ordertok}
1108 if {[info exists varcid($view,$p)]} {
1109 fix_reversal $p $a $view
1112 incr i
1115 incr commitidx($view)
1116 if {[info exists commitinterest($id)]} {
1117 foreach script $commitinterest($id) {
1118 lappend scripts [string map [list "%I" $id] $script]
1120 unset commitinterest($id)
1122 set gotsome 1
1124 if {$gotsome} {
1125 run chewcommits $view
1126 foreach s $scripts {
1127 eval $s
1129 if {$view == $curview} {
1130 # update progress bar
1131 global progressdirn progresscoords proglastnc
1132 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1133 set proglastnc $commitidx($view)
1134 set l [lindex $progresscoords 0]
1135 set r [lindex $progresscoords 1]
1136 if {$progressdirn} {
1137 set r [expr {$r + $inc}]
1138 if {$r >= 1.0} {
1139 set r 1.0
1140 set progressdirn 0
1142 if {$r > 0.2} {
1143 set l [expr {$r - 0.2}]
1145 } else {
1146 set l [expr {$l - $inc}]
1147 if {$l <= 0.0} {
1148 set l 0.0
1149 set progressdirn 1
1151 set r [expr {$l + 0.2}]
1153 set progresscoords [list $l $r]
1154 adjustprogress
1157 return 2
1160 proc chewcommits {view} {
1161 global curview hlview viewcomplete
1162 global pending_select
1164 if {$view == $curview} {
1165 layoutmore
1166 if {$viewcomplete($view)} {
1167 global commitidx varctok
1168 global numcommits startmsecs
1169 global mainheadid commitinfo nullid
1171 if {[info exists pending_select]} {
1172 set row [first_real_row]
1173 selectline $row 1
1175 if {$commitidx($curview) > 0} {
1176 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1177 #puts "overall $ms ms for $numcommits commits"
1178 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1179 } else {
1180 show_status [mc "No commits selected"]
1182 notbusy layout
1185 if {[info exists hlview] && $view == $hlview} {
1186 vhighlightmore
1188 return 0
1191 proc readcommit {id} {
1192 if {[catch {set contents [exec git cat-file commit $id]}]} return
1193 parsecommit $id $contents 0
1196 proc parsecommit {id contents listed} {
1197 global commitinfo cdate
1199 set inhdr 1
1200 set comment {}
1201 set headline {}
1202 set auname {}
1203 set audate {}
1204 set comname {}
1205 set comdate {}
1206 set hdrend [string first "\n\n" $contents]
1207 if {$hdrend < 0} {
1208 # should never happen...
1209 set hdrend [string length $contents]
1211 set header [string range $contents 0 [expr {$hdrend - 1}]]
1212 set comment [string range $contents [expr {$hdrend + 2}] end]
1213 foreach line [split $header "\n"] {
1214 set tag [lindex $line 0]
1215 if {$tag == "author"} {
1216 set audate [lindex $line end-1]
1217 set auname [lrange $line 1 end-2]
1218 } elseif {$tag == "committer"} {
1219 set comdate [lindex $line end-1]
1220 set comname [lrange $line 1 end-2]
1223 set headline {}
1224 # take the first non-blank line of the comment as the headline
1225 set headline [string trimleft $comment]
1226 set i [string first "\n" $headline]
1227 if {$i >= 0} {
1228 set headline [string range $headline 0 $i]
1230 set headline [string trimright $headline]
1231 set i [string first "\r" $headline]
1232 if {$i >= 0} {
1233 set headline [string trimright [string range $headline 0 $i]]
1235 if {!$listed} {
1236 # git rev-list indents the comment by 4 spaces;
1237 # if we got this via git cat-file, add the indentation
1238 set newcomment {}
1239 foreach line [split $comment "\n"] {
1240 append newcomment " "
1241 append newcomment $line
1242 append newcomment "\n"
1244 set comment $newcomment
1246 if {$comdate != {}} {
1247 set cdate($id) $comdate
1249 set commitinfo($id) [list $headline $auname $audate \
1250 $comname $comdate $comment]
1253 proc getcommit {id} {
1254 global commitdata commitinfo
1256 if {[info exists commitdata($id)]} {
1257 parsecommit $id $commitdata($id) 1
1258 } else {
1259 readcommit $id
1260 if {![info exists commitinfo($id)]} {
1261 set commitinfo($id) [list [mc "No commit information available"]]
1264 return 1
1267 proc readrefs {} {
1268 global tagids idtags headids idheads tagobjid
1269 global otherrefids idotherrefs mainhead mainheadid
1271 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1272 catch {unset $v}
1274 set refd [open [list | git show-ref -d] r]
1275 while {[gets $refd line] >= 0} {
1276 if {[string index $line 40] ne " "} continue
1277 set id [string range $line 0 39]
1278 set ref [string range $line 41 end]
1279 if {![string match "refs/*" $ref]} continue
1280 set name [string range $ref 5 end]
1281 if {[string match "remotes/*" $name]} {
1282 if {![string match "*/HEAD" $name]} {
1283 set headids($name) $id
1284 lappend idheads($id) $name
1286 } elseif {[string match "heads/*" $name]} {
1287 set name [string range $name 6 end]
1288 set headids($name) $id
1289 lappend idheads($id) $name
1290 } elseif {[string match "tags/*" $name]} {
1291 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1292 # which is what we want since the former is the commit ID
1293 set name [string range $name 5 end]
1294 if {[string match "*^{}" $name]} {
1295 set name [string range $name 0 end-3]
1296 } else {
1297 set tagobjid($name) $id
1299 set tagids($name) $id
1300 lappend idtags($id) $name
1301 } else {
1302 set otherrefids($name) $id
1303 lappend idotherrefs($id) $name
1306 catch {close $refd}
1307 set mainhead {}
1308 set mainheadid {}
1309 catch {
1310 set thehead [exec git symbolic-ref HEAD]
1311 if {[string match "refs/heads/*" $thehead]} {
1312 set mainhead [string range $thehead 11 end]
1313 if {[info exists headids($mainhead)]} {
1314 set mainheadid $headids($mainhead)
1320 # skip over fake commits
1321 proc first_real_row {} {
1322 global nullid nullid2 numcommits
1324 for {set row 0} {$row < $numcommits} {incr row} {
1325 set id [commitonrow $row]
1326 if {$id ne $nullid && $id ne $nullid2} {
1327 break
1330 return $row
1333 # update things for a head moved to a child of its previous location
1334 proc movehead {id name} {
1335 global headids idheads
1337 removehead $headids($name) $name
1338 set headids($name) $id
1339 lappend idheads($id) $name
1342 # update things when a head has been removed
1343 proc removehead {id name} {
1344 global headids idheads
1346 if {$idheads($id) eq $name} {
1347 unset idheads($id)
1348 } else {
1349 set i [lsearch -exact $idheads($id) $name]
1350 if {$i >= 0} {
1351 set idheads($id) [lreplace $idheads($id) $i $i]
1354 unset headids($name)
1357 proc show_error {w top msg} {
1358 message $w.m -text $msg -justify center -aspect 400
1359 pack $w.m -side top -fill x -padx 20 -pady 20
1360 button $w.ok -text [mc OK] -command "destroy $top"
1361 pack $w.ok -side bottom -fill x
1362 bind $top <Visibility> "grab $top; focus $top"
1363 bind $top <Key-Return> "destroy $top"
1364 tkwait window $top
1367 proc error_popup msg {
1368 set w .error
1369 toplevel $w
1370 wm transient $w .
1371 show_error $w $w $msg
1374 proc confirm_popup msg {
1375 global confirm_ok
1376 set confirm_ok 0
1377 set w .confirm
1378 toplevel $w
1379 wm transient $w .
1380 message $w.m -text $msg -justify center -aspect 400
1381 pack $w.m -side top -fill x -padx 20 -pady 20
1382 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1383 pack $w.ok -side left -fill x
1384 button $w.cancel -text [mc Cancel] -command "destroy $w"
1385 pack $w.cancel -side right -fill x
1386 bind $w <Visibility> "grab $w; focus $w"
1387 tkwait window $w
1388 return $confirm_ok
1391 proc setoptions {} {
1392 option add *Panedwindow.showHandle 1 startupFile
1393 option add *Panedwindow.sashRelief raised startupFile
1394 option add *Button.font uifont startupFile
1395 option add *Checkbutton.font uifont startupFile
1396 option add *Radiobutton.font uifont startupFile
1397 option add *Menu.font uifont startupFile
1398 option add *Menubutton.font uifont startupFile
1399 option add *Label.font uifont startupFile
1400 option add *Message.font uifont startupFile
1401 option add *Entry.font uifont startupFile
1404 proc makewindow {} {
1405 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1406 global tabstop
1407 global findtype findtypemenu findloc findstring fstring geometry
1408 global entries sha1entry sha1string sha1but
1409 global diffcontextstring diffcontext
1410 global maincursor textcursor curtextcursor
1411 global rowctxmenu fakerowmenu mergemax wrapcomment
1412 global highlight_files gdttype
1413 global searchstring sstring
1414 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1415 global headctxmenu progresscanv progressitem progresscoords statusw
1416 global fprogitem fprogcoord lastprogupdate progupdatepending
1417 global rprogitem rprogcoord
1418 global have_tk85
1420 menu .bar
1421 .bar add cascade -label [mc "File"] -menu .bar.file
1422 menu .bar.file
1423 .bar.file add command -label [mc "Update"] -command updatecommits
1424 .bar.file add command -label [mc "Reload"] -command reloadcommits
1425 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1426 .bar.file add command -label [mc "List references"] -command showrefs
1427 .bar.file add command -label [mc "Quit"] -command doquit
1428 menu .bar.edit
1429 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1430 .bar.edit add command -label [mc "Preferences"] -command doprefs
1432 menu .bar.view
1433 .bar add cascade -label [mc "View"] -menu .bar.view
1434 .bar.view add command -label [mc "New view..."] -command {newview 0}
1435 .bar.view add command -label [mc "Edit view..."] -command editview \
1436 -state disabled
1437 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
1438 .bar.view add separator
1439 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
1440 -variable selectedview -value 0
1442 menu .bar.help
1443 .bar add cascade -label [mc "Help"] -menu .bar.help
1444 .bar.help add command -label [mc "About gitk"] -command about
1445 .bar.help add command -label [mc "Key bindings"] -command keys
1446 .bar.help configure
1447 . configure -menu .bar
1449 # the gui has upper and lower half, parts of a paned window.
1450 panedwindow .ctop -orient vertical
1452 # possibly use assumed geometry
1453 if {![info exists geometry(pwsash0)]} {
1454 set geometry(topheight) [expr {15 * $linespc}]
1455 set geometry(topwidth) [expr {80 * $charspc}]
1456 set geometry(botheight) [expr {15 * $linespc}]
1457 set geometry(botwidth) [expr {50 * $charspc}]
1458 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1459 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1462 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1463 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1464 frame .tf.histframe
1465 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1467 # create three canvases
1468 set cscroll .tf.histframe.csb
1469 set canv .tf.histframe.pwclist.canv
1470 canvas $canv \
1471 -selectbackground $selectbgcolor \
1472 -background $bgcolor -bd 0 \
1473 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1474 .tf.histframe.pwclist add $canv
1475 set canv2 .tf.histframe.pwclist.canv2
1476 canvas $canv2 \
1477 -selectbackground $selectbgcolor \
1478 -background $bgcolor -bd 0 -yscrollincr $linespc
1479 .tf.histframe.pwclist add $canv2
1480 set canv3 .tf.histframe.pwclist.canv3
1481 canvas $canv3 \
1482 -selectbackground $selectbgcolor \
1483 -background $bgcolor -bd 0 -yscrollincr $linespc
1484 .tf.histframe.pwclist add $canv3
1485 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1486 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1488 # a scroll bar to rule them
1489 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1490 pack $cscroll -side right -fill y
1491 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1492 lappend bglist $canv $canv2 $canv3
1493 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1495 # we have two button bars at bottom of top frame. Bar 1
1496 frame .tf.bar
1497 frame .tf.lbar -height 15
1499 set sha1entry .tf.bar.sha1
1500 set entries $sha1entry
1501 set sha1but .tf.bar.sha1label
1502 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1503 -command gotocommit -width 8
1504 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1505 pack .tf.bar.sha1label -side left
1506 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1507 trace add variable sha1string write sha1change
1508 pack $sha1entry -side left -pady 2
1510 image create bitmap bm-left -data {
1511 #define left_width 16
1512 #define left_height 16
1513 static unsigned char left_bits[] = {
1514 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1515 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1516 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1518 image create bitmap bm-right -data {
1519 #define right_width 16
1520 #define right_height 16
1521 static unsigned char right_bits[] = {
1522 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1523 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1524 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1526 button .tf.bar.leftbut -image bm-left -command goback \
1527 -state disabled -width 26
1528 pack .tf.bar.leftbut -side left -fill y
1529 button .tf.bar.rightbut -image bm-right -command goforw \
1530 -state disabled -width 26
1531 pack .tf.bar.rightbut -side left -fill y
1533 # Status label and progress bar
1534 set statusw .tf.bar.status
1535 label $statusw -width 15 -relief sunken
1536 pack $statusw -side left -padx 5
1537 set h [expr {[font metrics uifont -linespace] + 2}]
1538 set progresscanv .tf.bar.progress
1539 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1540 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1541 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1542 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1543 pack $progresscanv -side right -expand 1 -fill x
1544 set progresscoords {0 0}
1545 set fprogcoord 0
1546 set rprogcoord 0
1547 bind $progresscanv <Configure> adjustprogress
1548 set lastprogupdate [clock clicks -milliseconds]
1549 set progupdatepending 0
1551 # build up the bottom bar of upper window
1552 label .tf.lbar.flabel -text "[mc "Find"] "
1553 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1554 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1555 label .tf.lbar.flab2 -text " [mc "commit"] "
1556 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1557 -side left -fill y
1558 set gdttype [mc "containing:"]
1559 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1560 [mc "containing:"] \
1561 [mc "touching paths:"] \
1562 [mc "adding/removing string:"]]
1563 trace add variable gdttype write gdttype_change
1564 pack .tf.lbar.gdttype -side left -fill y
1566 set findstring {}
1567 set fstring .tf.lbar.findstring
1568 lappend entries $fstring
1569 entry $fstring -width 30 -font textfont -textvariable findstring
1570 trace add variable findstring write find_change
1571 set findtype [mc "Exact"]
1572 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1573 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
1574 trace add variable findtype write findcom_change
1575 set findloc [mc "All fields"]
1576 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1577 [mc "Comments"] [mc "Author"] [mc "Committer"]
1578 trace add variable findloc write find_change
1579 pack .tf.lbar.findloc -side right
1580 pack .tf.lbar.findtype -side right
1581 pack $fstring -side left -expand 1 -fill x
1583 # Finish putting the upper half of the viewer together
1584 pack .tf.lbar -in .tf -side bottom -fill x
1585 pack .tf.bar -in .tf -side bottom -fill x
1586 pack .tf.histframe -fill both -side top -expand 1
1587 .ctop add .tf
1588 .ctop paneconfigure .tf -height $geometry(topheight)
1589 .ctop paneconfigure .tf -width $geometry(topwidth)
1591 # now build up the bottom
1592 panedwindow .pwbottom -orient horizontal
1594 # lower left, a text box over search bar, scroll bar to the right
1595 # if we know window height, then that will set the lower text height, otherwise
1596 # we set lower text height which will drive window height
1597 if {[info exists geometry(main)]} {
1598 frame .bleft -width $geometry(botwidth)
1599 } else {
1600 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1602 frame .bleft.top
1603 frame .bleft.mid
1605 button .bleft.top.search -text [mc "Search"] -command dosearch
1606 pack .bleft.top.search -side left -padx 5
1607 set sstring .bleft.top.sstring
1608 entry $sstring -width 20 -font textfont -textvariable searchstring
1609 lappend entries $sstring
1610 trace add variable searchstring write incrsearch
1611 pack $sstring -side left -expand 1 -fill x
1612 radiobutton .bleft.mid.diff -text [mc "Diff"] \
1613 -command changediffdisp -variable diffelide -value {0 0}
1614 radiobutton .bleft.mid.old -text [mc "Old version"] \
1615 -command changediffdisp -variable diffelide -value {0 1}
1616 radiobutton .bleft.mid.new -text [mc "New version"] \
1617 -command changediffdisp -variable diffelide -value {1 0}
1618 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
1619 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1620 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1621 -from 1 -increment 1 -to 10000000 \
1622 -validate all -validatecommand "diffcontextvalidate %P" \
1623 -textvariable diffcontextstring
1624 .bleft.mid.diffcontext set $diffcontext
1625 trace add variable diffcontextstring write diffcontextchange
1626 lappend entries .bleft.mid.diffcontext
1627 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1628 set ctext .bleft.ctext
1629 text $ctext -background $bgcolor -foreground $fgcolor \
1630 -state disabled -font textfont \
1631 -yscrollcommand scrolltext -wrap none
1632 if {$have_tk85} {
1633 $ctext conf -tabstyle wordprocessor
1635 scrollbar .bleft.sb -command "$ctext yview"
1636 pack .bleft.top -side top -fill x
1637 pack .bleft.mid -side top -fill x
1638 pack .bleft.sb -side right -fill y
1639 pack $ctext -side left -fill both -expand 1
1640 lappend bglist $ctext
1641 lappend fglist $ctext
1643 $ctext tag conf comment -wrap $wrapcomment
1644 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
1645 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1646 $ctext tag conf d0 -fore [lindex $diffcolors 0]
1647 $ctext tag conf d1 -fore [lindex $diffcolors 1]
1648 $ctext tag conf m0 -fore red
1649 $ctext tag conf m1 -fore blue
1650 $ctext tag conf m2 -fore green
1651 $ctext tag conf m3 -fore purple
1652 $ctext tag conf m4 -fore brown
1653 $ctext tag conf m5 -fore "#009090"
1654 $ctext tag conf m6 -fore magenta
1655 $ctext tag conf m7 -fore "#808000"
1656 $ctext tag conf m8 -fore "#009000"
1657 $ctext tag conf m9 -fore "#ff0080"
1658 $ctext tag conf m10 -fore cyan
1659 $ctext tag conf m11 -fore "#b07070"
1660 $ctext tag conf m12 -fore "#70b0f0"
1661 $ctext tag conf m13 -fore "#70f0b0"
1662 $ctext tag conf m14 -fore "#f0b070"
1663 $ctext tag conf m15 -fore "#ff70b0"
1664 $ctext tag conf mmax -fore darkgrey
1665 set mergemax 16
1666 $ctext tag conf mresult -font textfontbold
1667 $ctext tag conf msep -font textfontbold
1668 $ctext tag conf found -back yellow
1670 .pwbottom add .bleft
1671 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
1673 # lower right
1674 frame .bright
1675 frame .bright.mode
1676 radiobutton .bright.mode.patch -text [mc "Patch"] \
1677 -command reselectline -variable cmitmode -value "patch"
1678 radiobutton .bright.mode.tree -text [mc "Tree"] \
1679 -command reselectline -variable cmitmode -value "tree"
1680 grid .bright.mode.patch .bright.mode.tree -sticky ew
1681 pack .bright.mode -side top -fill x
1682 set cflist .bright.cfiles
1683 set indent [font measure mainfont "nn"]
1684 text $cflist \
1685 -selectbackground $selectbgcolor \
1686 -background $bgcolor -foreground $fgcolor \
1687 -font mainfont \
1688 -tabs [list $indent [expr {2 * $indent}]] \
1689 -yscrollcommand ".bright.sb set" \
1690 -cursor [. cget -cursor] \
1691 -spacing1 1 -spacing3 1
1692 lappend bglist $cflist
1693 lappend fglist $cflist
1694 scrollbar .bright.sb -command "$cflist yview"
1695 pack .bright.sb -side right -fill y
1696 pack $cflist -side left -fill both -expand 1
1697 $cflist tag configure highlight \
1698 -background [$cflist cget -selectbackground]
1699 $cflist tag configure bold -font mainfontbold
1701 .pwbottom add .bright
1702 .ctop add .pwbottom
1704 # restore window position if known
1705 if {[info exists geometry(main)]} {
1706 wm geometry . "$geometry(main)"
1709 if {[tk windowingsystem] eq {aqua}} {
1710 set M1B M1
1711 } else {
1712 set M1B Control
1715 bind .pwbottom <Configure> {resizecdetpanes %W %w}
1716 pack .ctop -fill both -expand 1
1717 bindall <1> {selcanvline %W %x %y}
1718 #bindall <B1-Motion> {selcanvline %W %x %y}
1719 if {[tk windowingsystem] == "win32"} {
1720 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1721 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1722 } else {
1723 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1724 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
1725 if {[tk windowingsystem] eq "aqua"} {
1726 bindall <MouseWheel> {
1727 set delta [expr {- (%D)}]
1728 allcanvs yview scroll $delta units
1732 bindall <2> "canvscan mark %W %x %y"
1733 bindall <B2-Motion> "canvscan dragto %W %x %y"
1734 bindkey <Home> selfirstline
1735 bindkey <End> sellastline
1736 bind . <Key-Up> "selnextline -1"
1737 bind . <Key-Down> "selnextline 1"
1738 bind . <Shift-Key-Up> "dofind -1 0"
1739 bind . <Shift-Key-Down> "dofind 1 0"
1740 bindkey <Key-Right> "goforw"
1741 bindkey <Key-Left> "goback"
1742 bind . <Key-Prior> "selnextpage -1"
1743 bind . <Key-Next> "selnextpage 1"
1744 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1745 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1746 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1747 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1748 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1749 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1750 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1751 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1752 bindkey <Key-space> "$ctext yview scroll 1 pages"
1753 bindkey p "selnextline -1"
1754 bindkey n "selnextline 1"
1755 bindkey z "goback"
1756 bindkey x "goforw"
1757 bindkey i "selnextline -1"
1758 bindkey k "selnextline 1"
1759 bindkey j "goback"
1760 bindkey l "goforw"
1761 bindkey b "$ctext yview scroll -1 pages"
1762 bindkey d "$ctext yview scroll 18 units"
1763 bindkey u "$ctext yview scroll -18 units"
1764 bindkey / {dofind 1 1}
1765 bindkey <Key-Return> {dofind 1 1}
1766 bindkey ? {dofind -1 1}
1767 bindkey f nextfile
1768 bindkey <F5> updatecommits
1769 bind . <$M1B-q> doquit
1770 bind . <$M1B-f> {dofind 1 1}
1771 bind . <$M1B-g> {dofind 1 0}
1772 bind . <$M1B-r> dosearchback
1773 bind . <$M1B-s> dosearch
1774 bind . <$M1B-equal> {incrfont 1}
1775 bind . <$M1B-KP_Add> {incrfont 1}
1776 bind . <$M1B-minus> {incrfont -1}
1777 bind . <$M1B-KP_Subtract> {incrfont -1}
1778 wm protocol . WM_DELETE_WINDOW doquit
1779 bind . <Button-1> "click %W"
1780 bind $fstring <Key-Return> {dofind 1 1}
1781 bind $sha1entry <Key-Return> gotocommit
1782 bind $sha1entry <<PasteSelection>> clearsha1
1783 bind $cflist <1> {sel_flist %W %x %y; break}
1784 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1785 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1786 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1788 set maincursor [. cget -cursor]
1789 set textcursor [$ctext cget -cursor]
1790 set curtextcursor $textcursor
1792 set rowctxmenu .rowctxmenu
1793 menu $rowctxmenu -tearoff 0
1794 $rowctxmenu add command -label [mc "Diff this -> selected"] \
1795 -command {diffvssel 0}
1796 $rowctxmenu add command -label [mc "Diff selected -> this"] \
1797 -command {diffvssel 1}
1798 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1799 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1800 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1801 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1802 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
1803 -command cherrypick
1804 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
1805 -command resethead
1807 set fakerowmenu .fakerowmenu
1808 menu $fakerowmenu -tearoff 0
1809 $fakerowmenu add command -label [mc "Diff this -> selected"] \
1810 -command {diffvssel 0}
1811 $fakerowmenu add command -label [mc "Diff selected -> this"] \
1812 -command {diffvssel 1}
1813 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1814 # $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1815 # $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1816 # $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
1818 set headctxmenu .headctxmenu
1819 menu $headctxmenu -tearoff 0
1820 $headctxmenu add command -label [mc "Check out this branch"] \
1821 -command cobranch
1822 $headctxmenu add command -label [mc "Remove this branch"] \
1823 -command rmbranch
1825 global flist_menu
1826 set flist_menu .flistctxmenu
1827 menu $flist_menu -tearoff 0
1828 $flist_menu add command -label [mc "Highlight this too"] \
1829 -command {flist_hl 0}
1830 $flist_menu add command -label [mc "Highlight this only"] \
1831 -command {flist_hl 1}
1834 # Windows sends all mouse wheel events to the current focused window, not
1835 # the one where the mouse hovers, so bind those events here and redirect
1836 # to the correct window
1837 proc windows_mousewheel_redirector {W X Y D} {
1838 global canv canv2 canv3
1839 set w [winfo containing -displayof $W $X $Y]
1840 if {$w ne ""} {
1841 set u [expr {$D < 0 ? 5 : -5}]
1842 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1843 allcanvs yview scroll $u units
1844 } else {
1845 catch {
1846 $w yview scroll $u units
1852 # mouse-2 makes all windows scan vertically, but only the one
1853 # the cursor is in scans horizontally
1854 proc canvscan {op w x y} {
1855 global canv canv2 canv3
1856 foreach c [list $canv $canv2 $canv3] {
1857 if {$c == $w} {
1858 $c scan $op $x $y
1859 } else {
1860 $c scan $op 0 $y
1865 proc scrollcanv {cscroll f0 f1} {
1866 $cscroll set $f0 $f1
1867 drawvisible
1868 flushhighlights
1871 # when we make a key binding for the toplevel, make sure
1872 # it doesn't get triggered when that key is pressed in the
1873 # find string entry widget.
1874 proc bindkey {ev script} {
1875 global entries
1876 bind . $ev $script
1877 set escript [bind Entry $ev]
1878 if {$escript == {}} {
1879 set escript [bind Entry <Key>]
1881 foreach e $entries {
1882 bind $e $ev "$escript; break"
1886 # set the focus back to the toplevel for any click outside
1887 # the entry widgets
1888 proc click {w} {
1889 global ctext entries
1890 foreach e [concat $entries $ctext] {
1891 if {$w == $e} return
1893 focus .
1896 # Adjust the progress bar for a change in requested extent or canvas size
1897 proc adjustprogress {} {
1898 global progresscanv progressitem progresscoords
1899 global fprogitem fprogcoord lastprogupdate progupdatepending
1900 global rprogitem rprogcoord
1902 set w [expr {[winfo width $progresscanv] - 4}]
1903 set x0 [expr {$w * [lindex $progresscoords 0]}]
1904 set x1 [expr {$w * [lindex $progresscoords 1]}]
1905 set h [winfo height $progresscanv]
1906 $progresscanv coords $progressitem $x0 0 $x1 $h
1907 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1908 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1909 set now [clock clicks -milliseconds]
1910 if {$now >= $lastprogupdate + 100} {
1911 set progupdatepending 0
1912 update
1913 } elseif {!$progupdatepending} {
1914 set progupdatepending 1
1915 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1919 proc doprogupdate {} {
1920 global lastprogupdate progupdatepending
1922 if {$progupdatepending} {
1923 set progupdatepending 0
1924 set lastprogupdate [clock clicks -milliseconds]
1925 update
1929 proc savestuff {w} {
1930 global canv canv2 canv3 mainfont textfont uifont tabstop
1931 global stuffsaved findmergefiles maxgraphpct
1932 global maxwidth showneartags showlocalchanges
1933 global viewname viewfiles viewargs viewperm nextviewnum
1934 global cmitmode wrapcomment datetimeformat limitdiffs
1935 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1937 if {$stuffsaved} return
1938 if {![winfo viewable .]} return
1939 catch {
1940 set f [open "~/.gitk-new" w]
1941 puts $f [list set mainfont $mainfont]
1942 puts $f [list set textfont $textfont]
1943 puts $f [list set uifont $uifont]
1944 puts $f [list set tabstop $tabstop]
1945 puts $f [list set findmergefiles $findmergefiles]
1946 puts $f [list set maxgraphpct $maxgraphpct]
1947 puts $f [list set maxwidth $maxwidth]
1948 puts $f [list set cmitmode $cmitmode]
1949 puts $f [list set wrapcomment $wrapcomment]
1950 puts $f [list set showneartags $showneartags]
1951 puts $f [list set showlocalchanges $showlocalchanges]
1952 puts $f [list set datetimeformat $datetimeformat]
1953 puts $f [list set limitdiffs $limitdiffs]
1954 puts $f [list set bgcolor $bgcolor]
1955 puts $f [list set fgcolor $fgcolor]
1956 puts $f [list set colors $colors]
1957 puts $f [list set diffcolors $diffcolors]
1958 puts $f [list set diffcontext $diffcontext]
1959 puts $f [list set selectbgcolor $selectbgcolor]
1961 puts $f "set geometry(main) [wm geometry .]"
1962 puts $f "set geometry(topwidth) [winfo width .tf]"
1963 puts $f "set geometry(topheight) [winfo height .tf]"
1964 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1965 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1966 puts $f "set geometry(botwidth) [winfo width .bleft]"
1967 puts $f "set geometry(botheight) [winfo height .bleft]"
1969 puts -nonewline $f "set permviews {"
1970 for {set v 0} {$v < $nextviewnum} {incr v} {
1971 if {$viewperm($v)} {
1972 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1975 puts $f "}"
1976 close $f
1977 file rename -force "~/.gitk-new" "~/.gitk"
1979 set stuffsaved 1
1982 proc resizeclistpanes {win w} {
1983 global oldwidth
1984 if {[info exists oldwidth($win)]} {
1985 set s0 [$win sash coord 0]
1986 set s1 [$win sash coord 1]
1987 if {$w < 60} {
1988 set sash0 [expr {int($w/2 - 2)}]
1989 set sash1 [expr {int($w*5/6 - 2)}]
1990 } else {
1991 set factor [expr {1.0 * $w / $oldwidth($win)}]
1992 set sash0 [expr {int($factor * [lindex $s0 0])}]
1993 set sash1 [expr {int($factor * [lindex $s1 0])}]
1994 if {$sash0 < 30} {
1995 set sash0 30
1997 if {$sash1 < $sash0 + 20} {
1998 set sash1 [expr {$sash0 + 20}]
2000 if {$sash1 > $w - 10} {
2001 set sash1 [expr {$w - 10}]
2002 if {$sash0 > $sash1 - 20} {
2003 set sash0 [expr {$sash1 - 20}]
2007 $win sash place 0 $sash0 [lindex $s0 1]
2008 $win sash place 1 $sash1 [lindex $s1 1]
2010 set oldwidth($win) $w
2013 proc resizecdetpanes {win w} {
2014 global oldwidth
2015 if {[info exists oldwidth($win)]} {
2016 set s0 [$win sash coord 0]
2017 if {$w < 60} {
2018 set sash0 [expr {int($w*3/4 - 2)}]
2019 } else {
2020 set factor [expr {1.0 * $w / $oldwidth($win)}]
2021 set sash0 [expr {int($factor * [lindex $s0 0])}]
2022 if {$sash0 < 45} {
2023 set sash0 45
2025 if {$sash0 > $w - 15} {
2026 set sash0 [expr {$w - 15}]
2029 $win sash place 0 $sash0 [lindex $s0 1]
2031 set oldwidth($win) $w
2034 proc allcanvs args {
2035 global canv canv2 canv3
2036 eval $canv $args
2037 eval $canv2 $args
2038 eval $canv3 $args
2041 proc bindall {event action} {
2042 global canv canv2 canv3
2043 bind $canv $event $action
2044 bind $canv2 $event $action
2045 bind $canv3 $event $action
2048 proc about {} {
2049 global uifont
2050 set w .about
2051 if {[winfo exists $w]} {
2052 raise $w
2053 return
2055 toplevel $w
2056 wm title $w [mc "About gitk"]
2057 message $w.m -text [mc "
2058 Gitk - a commit viewer for git
2060 Copyright © 2005-2006 Paul Mackerras
2062 Use and redistribute under the terms of the GNU General Public License"] \
2063 -justify center -aspect 400 -border 2 -bg white -relief groove
2064 pack $w.m -side top -fill x -padx 2 -pady 2
2065 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2066 pack $w.ok -side bottom
2067 bind $w <Visibility> "focus $w.ok"
2068 bind $w <Key-Escape> "destroy $w"
2069 bind $w <Key-Return> "destroy $w"
2072 proc keys {} {
2073 set w .keys
2074 if {[winfo exists $w]} {
2075 raise $w
2076 return
2078 if {[tk windowingsystem] eq {aqua}} {
2079 set M1T Cmd
2080 } else {
2081 set M1T Ctrl
2083 toplevel $w
2084 wm title $w [mc "Gitk key bindings"]
2085 message $w.m -text [mc "
2086 Gitk key bindings:
2088 <$M1T-Q> Quit
2089 <Home> Move to first commit
2090 <End> Move to last commit
2091 <Up>, p, i Move up one commit
2092 <Down>, n, k Move down one commit
2093 <Left>, z, j Go back in history list
2094 <Right>, x, l Go forward in history list
2095 <PageUp> Move up one page in commit list
2096 <PageDown> Move down one page in commit list
2097 <$M1T-Home> Scroll to top of commit list
2098 <$M1T-End> Scroll to bottom of commit list
2099 <$M1T-Up> Scroll commit list up one line
2100 <$M1T-Down> Scroll commit list down one line
2101 <$M1T-PageUp> Scroll commit list up one page
2102 <$M1T-PageDown> Scroll commit list down one page
2103 <Shift-Up> Find backwards (upwards, later commits)
2104 <Shift-Down> Find forwards (downwards, earlier commits)
2105 <Delete>, b Scroll diff view up one page
2106 <Backspace> Scroll diff view up one page
2107 <Space> Scroll diff view down one page
2108 u Scroll diff view up 18 lines
2109 d Scroll diff view down 18 lines
2110 <$M1T-F> Find
2111 <$M1T-G> Move to next find hit
2112 <Return> Move to next find hit
2113 / Move to next find hit, or redo find
2114 ? Move to previous find hit
2115 f Scroll diff view to next file
2116 <$M1T-S> Search for next hit in diff view
2117 <$M1T-R> Search for previous hit in diff view
2118 <$M1T-KP+> Increase font size
2119 <$M1T-plus> Increase font size
2120 <$M1T-KP-> Decrease font size
2121 <$M1T-minus> Decrease font size
2122 <F5> Update
2123 "] \
2124 -justify left -bg white -border 2 -relief groove
2125 pack $w.m -side top -fill both -padx 2 -pady 2
2126 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2127 pack $w.ok -side bottom
2128 bind $w <Visibility> "focus $w.ok"
2129 bind $w <Key-Escape> "destroy $w"
2130 bind $w <Key-Return> "destroy $w"
2133 # Procedures for manipulating the file list window at the
2134 # bottom right of the overall window.
2136 proc treeview {w l openlevs} {
2137 global treecontents treediropen treeheight treeparent treeindex
2139 set ix 0
2140 set treeindex() 0
2141 set lev 0
2142 set prefix {}
2143 set prefixend -1
2144 set prefendstack {}
2145 set htstack {}
2146 set ht 0
2147 set treecontents() {}
2148 $w conf -state normal
2149 foreach f $l {
2150 while {[string range $f 0 $prefixend] ne $prefix} {
2151 if {$lev <= $openlevs} {
2152 $w mark set e:$treeindex($prefix) "end -1c"
2153 $w mark gravity e:$treeindex($prefix) left
2155 set treeheight($prefix) $ht
2156 incr ht [lindex $htstack end]
2157 set htstack [lreplace $htstack end end]
2158 set prefixend [lindex $prefendstack end]
2159 set prefendstack [lreplace $prefendstack end end]
2160 set prefix [string range $prefix 0 $prefixend]
2161 incr lev -1
2163 set tail [string range $f [expr {$prefixend+1}] end]
2164 while {[set slash [string first "/" $tail]] >= 0} {
2165 lappend htstack $ht
2166 set ht 0
2167 lappend prefendstack $prefixend
2168 incr prefixend [expr {$slash + 1}]
2169 set d [string range $tail 0 $slash]
2170 lappend treecontents($prefix) $d
2171 set oldprefix $prefix
2172 append prefix $d
2173 set treecontents($prefix) {}
2174 set treeindex($prefix) [incr ix]
2175 set treeparent($prefix) $oldprefix
2176 set tail [string range $tail [expr {$slash+1}] end]
2177 if {$lev <= $openlevs} {
2178 set ht 1
2179 set treediropen($prefix) [expr {$lev < $openlevs}]
2180 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2181 $w mark set d:$ix "end -1c"
2182 $w mark gravity d:$ix left
2183 set str "\n"
2184 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2185 $w insert end $str
2186 $w image create end -align center -image $bm -padx 1 \
2187 -name a:$ix
2188 $w insert end $d [highlight_tag $prefix]
2189 $w mark set s:$ix "end -1c"
2190 $w mark gravity s:$ix left
2192 incr lev
2194 if {$tail ne {}} {
2195 if {$lev <= $openlevs} {
2196 incr ht
2197 set str "\n"
2198 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2199 $w insert end $str
2200 $w insert end $tail [highlight_tag $f]
2202 lappend treecontents($prefix) $tail
2205 while {$htstack ne {}} {
2206 set treeheight($prefix) $ht
2207 incr ht [lindex $htstack end]
2208 set htstack [lreplace $htstack end end]
2209 set prefixend [lindex $prefendstack end]
2210 set prefendstack [lreplace $prefendstack end end]
2211 set prefix [string range $prefix 0 $prefixend]
2213 $w conf -state disabled
2216 proc linetoelt {l} {
2217 global treeheight treecontents
2219 set y 2
2220 set prefix {}
2221 while {1} {
2222 foreach e $treecontents($prefix) {
2223 if {$y == $l} {
2224 return "$prefix$e"
2226 set n 1
2227 if {[string index $e end] eq "/"} {
2228 set n $treeheight($prefix$e)
2229 if {$y + $n > $l} {
2230 append prefix $e
2231 incr y
2232 break
2235 incr y $n
2240 proc highlight_tree {y prefix} {
2241 global treeheight treecontents cflist
2243 foreach e $treecontents($prefix) {
2244 set path $prefix$e
2245 if {[highlight_tag $path] ne {}} {
2246 $cflist tag add bold $y.0 "$y.0 lineend"
2248 incr y
2249 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2250 set y [highlight_tree $y $path]
2253 return $y
2256 proc treeclosedir {w dir} {
2257 global treediropen treeheight treeparent treeindex
2259 set ix $treeindex($dir)
2260 $w conf -state normal
2261 $w delete s:$ix e:$ix
2262 set treediropen($dir) 0
2263 $w image configure a:$ix -image tri-rt
2264 $w conf -state disabled
2265 set n [expr {1 - $treeheight($dir)}]
2266 while {$dir ne {}} {
2267 incr treeheight($dir) $n
2268 set dir $treeparent($dir)
2272 proc treeopendir {w dir} {
2273 global treediropen treeheight treeparent treecontents treeindex
2275 set ix $treeindex($dir)
2276 $w conf -state normal
2277 $w image configure a:$ix -image tri-dn
2278 $w mark set e:$ix s:$ix
2279 $w mark gravity e:$ix right
2280 set lev 0
2281 set str "\n"
2282 set n [llength $treecontents($dir)]
2283 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2284 incr lev
2285 append str "\t"
2286 incr treeheight($x) $n
2288 foreach e $treecontents($dir) {
2289 set de $dir$e
2290 if {[string index $e end] eq "/"} {
2291 set iy $treeindex($de)
2292 $w mark set d:$iy e:$ix
2293 $w mark gravity d:$iy left
2294 $w insert e:$ix $str
2295 set treediropen($de) 0
2296 $w image create e:$ix -align center -image tri-rt -padx 1 \
2297 -name a:$iy
2298 $w insert e:$ix $e [highlight_tag $de]
2299 $w mark set s:$iy e:$ix
2300 $w mark gravity s:$iy left
2301 set treeheight($de) 1
2302 } else {
2303 $w insert e:$ix $str
2304 $w insert e:$ix $e [highlight_tag $de]
2307 $w mark gravity e:$ix left
2308 $w conf -state disabled
2309 set treediropen($dir) 1
2310 set top [lindex [split [$w index @0,0] .] 0]
2311 set ht [$w cget -height]
2312 set l [lindex [split [$w index s:$ix] .] 0]
2313 if {$l < $top} {
2314 $w yview $l.0
2315 } elseif {$l + $n + 1 > $top + $ht} {
2316 set top [expr {$l + $n + 2 - $ht}]
2317 if {$l < $top} {
2318 set top $l
2320 $w yview $top.0
2324 proc treeclick {w x y} {
2325 global treediropen cmitmode ctext cflist cflist_top
2327 if {$cmitmode ne "tree"} return
2328 if {![info exists cflist_top]} return
2329 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2330 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2331 $cflist tag add highlight $l.0 "$l.0 lineend"
2332 set cflist_top $l
2333 if {$l == 1} {
2334 $ctext yview 1.0
2335 return
2337 set e [linetoelt $l]
2338 if {[string index $e end] ne "/"} {
2339 showfile $e
2340 } elseif {$treediropen($e)} {
2341 treeclosedir $w $e
2342 } else {
2343 treeopendir $w $e
2347 proc setfilelist {id} {
2348 global treefilelist cflist
2350 treeview $cflist $treefilelist($id) 0
2353 image create bitmap tri-rt -background black -foreground blue -data {
2354 #define tri-rt_width 13
2355 #define tri-rt_height 13
2356 static unsigned char tri-rt_bits[] = {
2357 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2358 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2359 0x00, 0x00};
2360 } -maskdata {
2361 #define tri-rt-mask_width 13
2362 #define tri-rt-mask_height 13
2363 static unsigned char tri-rt-mask_bits[] = {
2364 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2365 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2366 0x08, 0x00};
2368 image create bitmap tri-dn -background black -foreground blue -data {
2369 #define tri-dn_width 13
2370 #define tri-dn_height 13
2371 static unsigned char tri-dn_bits[] = {
2372 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2373 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2374 0x00, 0x00};
2375 } -maskdata {
2376 #define tri-dn-mask_width 13
2377 #define tri-dn-mask_height 13
2378 static unsigned char tri-dn-mask_bits[] = {
2379 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2380 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2381 0x00, 0x00};
2384 image create bitmap reficon-T -background black -foreground yellow -data {
2385 #define tagicon_width 13
2386 #define tagicon_height 9
2387 static unsigned char tagicon_bits[] = {
2388 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2389 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2390 } -maskdata {
2391 #define tagicon-mask_width 13
2392 #define tagicon-mask_height 9
2393 static unsigned char tagicon-mask_bits[] = {
2394 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2395 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2397 set rectdata {
2398 #define headicon_width 13
2399 #define headicon_height 9
2400 static unsigned char headicon_bits[] = {
2401 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2402 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2404 set rectmask {
2405 #define headicon-mask_width 13
2406 #define headicon-mask_height 9
2407 static unsigned char headicon-mask_bits[] = {
2408 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2409 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2411 image create bitmap reficon-H -background black -foreground green \
2412 -data $rectdata -maskdata $rectmask
2413 image create bitmap reficon-o -background black -foreground "#ddddff" \
2414 -data $rectdata -maskdata $rectmask
2416 proc init_flist {first} {
2417 global cflist cflist_top difffilestart
2419 $cflist conf -state normal
2420 $cflist delete 0.0 end
2421 if {$first ne {}} {
2422 $cflist insert end $first
2423 set cflist_top 1
2424 $cflist tag add highlight 1.0 "1.0 lineend"
2425 } else {
2426 catch {unset cflist_top}
2428 $cflist conf -state disabled
2429 set difffilestart {}
2432 proc highlight_tag {f} {
2433 global highlight_paths
2435 foreach p $highlight_paths {
2436 if {[string match $p $f]} {
2437 return "bold"
2440 return {}
2443 proc highlight_filelist {} {
2444 global cmitmode cflist
2446 $cflist conf -state normal
2447 if {$cmitmode ne "tree"} {
2448 set end [lindex [split [$cflist index end] .] 0]
2449 for {set l 2} {$l < $end} {incr l} {
2450 set line [$cflist get $l.0 "$l.0 lineend"]
2451 if {[highlight_tag $line] ne {}} {
2452 $cflist tag add bold $l.0 "$l.0 lineend"
2455 } else {
2456 highlight_tree 2 {}
2458 $cflist conf -state disabled
2461 proc unhighlight_filelist {} {
2462 global cflist
2464 $cflist conf -state normal
2465 $cflist tag remove bold 1.0 end
2466 $cflist conf -state disabled
2469 proc add_flist {fl} {
2470 global cflist
2472 $cflist conf -state normal
2473 foreach f $fl {
2474 $cflist insert end "\n"
2475 $cflist insert end $f [highlight_tag $f]
2477 $cflist conf -state disabled
2480 proc sel_flist {w x y} {
2481 global ctext difffilestart cflist cflist_top cmitmode
2483 if {$cmitmode eq "tree"} return
2484 if {![info exists cflist_top]} return
2485 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2486 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2487 $cflist tag add highlight $l.0 "$l.0 lineend"
2488 set cflist_top $l
2489 if {$l == 1} {
2490 $ctext yview 1.0
2491 } else {
2492 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2496 proc pop_flist_menu {w X Y x y} {
2497 global ctext cflist cmitmode flist_menu flist_menu_file
2498 global treediffs diffids
2500 stopfinding
2501 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2502 if {$l <= 1} return
2503 if {$cmitmode eq "tree"} {
2504 set e [linetoelt $l]
2505 if {[string index $e end] eq "/"} return
2506 } else {
2507 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2509 set flist_menu_file $e
2510 tk_popup $flist_menu $X $Y
2513 proc flist_hl {only} {
2514 global flist_menu_file findstring gdttype
2516 set x [shellquote $flist_menu_file]
2517 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2518 set findstring $x
2519 } else {
2520 append findstring " " $x
2522 set gdttype [mc "touching paths:"]
2525 # Functions for adding and removing shell-type quoting
2527 proc shellquote {str} {
2528 if {![string match "*\['\"\\ \t]*" $str]} {
2529 return $str
2531 if {![string match "*\['\"\\]*" $str]} {
2532 return "\"$str\""
2534 if {![string match "*'*" $str]} {
2535 return "'$str'"
2537 return "\"[string map {\" \\\" \\ \\\\} $str]\""
2540 proc shellarglist {l} {
2541 set str {}
2542 foreach a $l {
2543 if {$str ne {}} {
2544 append str " "
2546 append str [shellquote $a]
2548 return $str
2551 proc shelldequote {str} {
2552 set ret {}
2553 set used -1
2554 while {1} {
2555 incr used
2556 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2557 append ret [string range $str $used end]
2558 set used [string length $str]
2559 break
2561 set first [lindex $first 0]
2562 set ch [string index $str $first]
2563 if {$first > $used} {
2564 append ret [string range $str $used [expr {$first - 1}]]
2565 set used $first
2567 if {$ch eq " " || $ch eq "\t"} break
2568 incr used
2569 if {$ch eq "'"} {
2570 set first [string first "'" $str $used]
2571 if {$first < 0} {
2572 error "unmatched single-quote"
2574 append ret [string range $str $used [expr {$first - 1}]]
2575 set used $first
2576 continue
2578 if {$ch eq "\\"} {
2579 if {$used >= [string length $str]} {
2580 error "trailing backslash"
2582 append ret [string index $str $used]
2583 continue
2585 # here ch == "\""
2586 while {1} {
2587 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2588 error "unmatched double-quote"
2590 set first [lindex $first 0]
2591 set ch [string index $str $first]
2592 if {$first > $used} {
2593 append ret [string range $str $used [expr {$first - 1}]]
2594 set used $first
2596 if {$ch eq "\""} break
2597 incr used
2598 append ret [string index $str $used]
2599 incr used
2602 return [list $used $ret]
2605 proc shellsplit {str} {
2606 set l {}
2607 while {1} {
2608 set str [string trimleft $str]
2609 if {$str eq {}} break
2610 set dq [shelldequote $str]
2611 set n [lindex $dq 0]
2612 set word [lindex $dq 1]
2613 set str [string range $str $n end]
2614 lappend l $word
2616 return $l
2619 # Code to implement multiple views
2621 proc newview {ishighlight} {
2622 global nextviewnum newviewname newviewperm newishighlight
2623 global newviewargs revtreeargs
2625 set newishighlight $ishighlight
2626 set top .gitkview
2627 if {[winfo exists $top]} {
2628 raise $top
2629 return
2631 set newviewname($nextviewnum) "View $nextviewnum"
2632 set newviewperm($nextviewnum) 0
2633 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2634 vieweditor $top $nextviewnum [mc "Gitk view definition"]
2637 proc editview {} {
2638 global curview
2639 global viewname viewperm newviewname newviewperm
2640 global viewargs newviewargs
2642 set top .gitkvedit-$curview
2643 if {[winfo exists $top]} {
2644 raise $top
2645 return
2647 set newviewname($curview) $viewname($curview)
2648 set newviewperm($curview) $viewperm($curview)
2649 set newviewargs($curview) [shellarglist $viewargs($curview)]
2650 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2653 proc vieweditor {top n title} {
2654 global newviewname newviewperm viewfiles bgcolor
2656 toplevel $top
2657 wm title $top $title
2658 label $top.nl -text [mc "Name"]
2659 entry $top.name -width 20 -textvariable newviewname($n)
2660 grid $top.nl $top.name -sticky w -pady 5
2661 checkbutton $top.perm -text [mc "Remember this view"] \
2662 -variable newviewperm($n)
2663 grid $top.perm - -pady 5 -sticky w
2664 message $top.al -aspect 1000 \
2665 -text [mc "Commits to include (arguments to git rev-list):"]
2666 grid $top.al - -sticky w -pady 5
2667 entry $top.args -width 50 -textvariable newviewargs($n) \
2668 -background $bgcolor
2669 grid $top.args - -sticky ew -padx 5
2670 message $top.l -aspect 1000 \
2671 -text [mc "Enter files and directories to include, one per line:"]
2672 grid $top.l - -sticky w
2673 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
2674 if {[info exists viewfiles($n)]} {
2675 foreach f $viewfiles($n) {
2676 $top.t insert end $f
2677 $top.t insert end "\n"
2679 $top.t delete {end - 1c} end
2680 $top.t mark set insert 0.0
2682 grid $top.t - -sticky ew -padx 5
2683 frame $top.buts
2684 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
2685 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
2686 grid $top.buts.ok $top.buts.can
2687 grid columnconfigure $top.buts 0 -weight 1 -uniform a
2688 grid columnconfigure $top.buts 1 -weight 1 -uniform a
2689 grid $top.buts - -pady 10 -sticky ew
2690 focus $top.t
2693 proc doviewmenu {m first cmd op argv} {
2694 set nmenu [$m index end]
2695 for {set i $first} {$i <= $nmenu} {incr i} {
2696 if {[$m entrycget $i -command] eq $cmd} {
2697 eval $m $op $i $argv
2698 break
2703 proc allviewmenus {n op args} {
2704 # global viewhlmenu
2706 doviewmenu .bar.view 5 [list showview $n] $op $args
2707 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2710 proc newviewok {top n} {
2711 global nextviewnum newviewperm newviewname newishighlight
2712 global viewname viewfiles viewperm selectedview curview
2713 global viewargs newviewargs viewhlmenu
2715 if {[catch {
2716 set newargs [shellsplit $newviewargs($n)]
2717 } err]} {
2718 error_popup "[mc "Error in commit selection arguments:"] $err"
2719 wm raise $top
2720 focus $top
2721 return
2723 set files {}
2724 foreach f [split [$top.t get 0.0 end] "\n"] {
2725 set ft [string trim $f]
2726 if {$ft ne {}} {
2727 lappend files $ft
2730 if {![info exists viewfiles($n)]} {
2731 # creating a new view
2732 incr nextviewnum
2733 set viewname($n) $newviewname($n)
2734 set viewperm($n) $newviewperm($n)
2735 set viewfiles($n) $files
2736 set viewargs($n) $newargs
2737 addviewmenu $n
2738 if {!$newishighlight} {
2739 run showview $n
2740 } else {
2741 run addvhighlight $n
2743 } else {
2744 # editing an existing view
2745 set viewperm($n) $newviewperm($n)
2746 if {$newviewname($n) ne $viewname($n)} {
2747 set viewname($n) $newviewname($n)
2748 doviewmenu .bar.view 5 [list showview $n] \
2749 entryconf [list -label $viewname($n)]
2750 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2751 # entryconf [list -label $viewname($n) -value $viewname($n)]
2753 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2754 set viewfiles($n) $files
2755 set viewargs($n) $newargs
2756 if {$curview == $n} {
2757 run reloadcommits
2761 catch {destroy $top}
2764 proc delview {} {
2765 global curview viewperm hlview selectedhlview
2767 if {$curview == 0} return
2768 if {[info exists hlview] && $hlview == $curview} {
2769 set selectedhlview [mc "None"]
2770 unset hlview
2772 allviewmenus $curview delete
2773 set viewperm($curview) 0
2774 showview 0
2777 proc addviewmenu {n} {
2778 global viewname viewhlmenu
2780 .bar.view add radiobutton -label $viewname($n) \
2781 -command [list showview $n] -variable selectedview -value $n
2782 #$viewhlmenu add radiobutton -label $viewname($n) \
2783 # -command [list addvhighlight $n] -variable selectedhlview
2786 proc showview {n} {
2787 global curview viewfiles cached_commitrow ordertok
2788 global displayorder parentlist rowidlist rowisopt rowfinal
2789 global colormap rowtextx nextcolor canvxmax
2790 global numcommits viewcomplete
2791 global selectedline currentid canv canvy0
2792 global treediffs
2793 global pending_select mainheadid
2794 global commitidx
2795 global selectedview
2796 global hlview selectedhlview commitinterest
2798 if {$n == $curview} return
2799 set selid {}
2800 set ymax [lindex [$canv cget -scrollregion] 3]
2801 set span [$canv yview]
2802 set ytop [expr {[lindex $span 0] * $ymax}]
2803 set ybot [expr {[lindex $span 1] * $ymax}]
2804 set yscreen [expr {($ybot - $ytop) / 2}]
2805 if {[info exists selectedline]} {
2806 set selid $currentid
2807 set y [yc $selectedline]
2808 if {$ytop < $y && $y < $ybot} {
2809 set yscreen [expr {$y - $ytop}]
2811 } elseif {[info exists pending_select]} {
2812 set selid $pending_select
2813 unset pending_select
2815 unselectline
2816 normalline
2817 catch {unset treediffs}
2818 clear_display
2819 if {[info exists hlview] && $hlview == $n} {
2820 unset hlview
2821 set selectedhlview [mc "None"]
2823 catch {unset commitinterest}
2824 catch {unset cached_commitrow}
2825 catch {unset ordertok}
2827 set curview $n
2828 set selectedview $n
2829 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2830 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2832 run refill_reflist
2833 if {![info exists viewcomplete($n)]} {
2834 if {$selid ne {}} {
2835 set pending_select $selid
2837 getcommits
2838 return
2841 set displayorder {}
2842 set parentlist {}
2843 set rowidlist {}
2844 set rowisopt {}
2845 set rowfinal {}
2846 set numcommits $commitidx($n)
2848 catch {unset colormap}
2849 catch {unset rowtextx}
2850 set nextcolor 0
2851 set canvxmax [$canv cget -width]
2852 set curview $n
2853 set row 0
2854 setcanvscroll
2855 set yf 0
2856 set row {}
2857 if {$selid ne {} && [commitinview $selid $n]} {
2858 set row [rowofcommit $selid]
2859 # try to get the selected row in the same position on the screen
2860 set ymax [lindex [$canv cget -scrollregion] 3]
2861 set ytop [expr {[yc $row] - $yscreen}]
2862 if {$ytop < 0} {
2863 set ytop 0
2865 set yf [expr {$ytop * 1.0 / $ymax}]
2867 allcanvs yview moveto $yf
2868 drawvisible
2869 if {$row ne {}} {
2870 selectline $row 0
2871 } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
2872 selectline [rowofcommit $mainheadid] 1
2873 } elseif {!$viewcomplete($n)} {
2874 if {$selid ne {}} {
2875 set pending_select $selid
2876 } else {
2877 set pending_select $mainheadid
2879 } else {
2880 set row [first_real_row]
2881 if {$row < $numcommits} {
2882 selectline $row 0
2885 if {!$viewcomplete($n)} {
2886 if {$numcommits == 0} {
2887 show_status [mc "Reading commits..."]
2889 } elseif {$numcommits == 0} {
2890 show_status [mc "No commits selected"]
2894 # Stuff relating to the highlighting facility
2896 proc ishighlighted {id} {
2897 global vhighlights fhighlights nhighlights rhighlights
2899 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
2900 return $nhighlights($id)
2902 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
2903 return $vhighlights($id)
2905 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
2906 return $fhighlights($id)
2908 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
2909 return $rhighlights($id)
2911 return 0
2914 proc bolden {row font} {
2915 global canv linehtag selectedline boldrows
2917 lappend boldrows $row
2918 $canv itemconf $linehtag($row) -font $font
2919 if {[info exists selectedline] && $row == $selectedline} {
2920 $canv delete secsel
2921 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2922 -outline {{}} -tags secsel \
2923 -fill [$canv cget -selectbackground]]
2924 $canv lower $t
2928 proc bolden_name {row font} {
2929 global canv2 linentag selectedline boldnamerows
2931 lappend boldnamerows $row
2932 $canv2 itemconf $linentag($row) -font $font
2933 if {[info exists selectedline] && $row == $selectedline} {
2934 $canv2 delete secsel
2935 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2936 -outline {{}} -tags secsel \
2937 -fill [$canv2 cget -selectbackground]]
2938 $canv2 lower $t
2942 proc unbolden {} {
2943 global boldrows
2945 set stillbold {}
2946 foreach row $boldrows {
2947 if {![ishighlighted [commitonrow $row]]} {
2948 bolden $row mainfont
2949 } else {
2950 lappend stillbold $row
2953 set boldrows $stillbold
2956 proc addvhighlight {n} {
2957 global hlview viewcomplete curview vhl_done commitidx
2959 if {[info exists hlview]} {
2960 delvhighlight
2962 set hlview $n
2963 if {$n != $curview && ![info exists viewcomplete($n)]} {
2964 start_rev_list $n
2966 set vhl_done $commitidx($hlview)
2967 if {$vhl_done > 0} {
2968 drawvisible
2972 proc delvhighlight {} {
2973 global hlview vhighlights
2975 if {![info exists hlview]} return
2976 unset hlview
2977 catch {unset vhighlights}
2978 unbolden
2981 proc vhighlightmore {} {
2982 global hlview vhl_done commitidx vhighlights curview
2984 set max $commitidx($hlview)
2985 set vr [visiblerows]
2986 set r0 [lindex $vr 0]
2987 set r1 [lindex $vr 1]
2988 for {set i $vhl_done} {$i < $max} {incr i} {
2989 set id [commitonrow $i $hlview]
2990 if {[commitinview $id $curview]} {
2991 set row [rowofcommit $id]
2992 if {$r0 <= $row && $row <= $r1} {
2993 if {![highlighted $row]} {
2994 bolden $row mainfontbold
2996 set vhighlights($id) 1
3000 set vhl_done $max
3003 proc askvhighlight {row id} {
3004 global hlview vhighlights iddrawn
3006 if {[commitinview $id $hlview]} {
3007 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3008 bolden $row mainfontbold
3010 set vhighlights($id) 1
3011 } else {
3012 set vhighlights($id) 0
3016 proc hfiles_change {} {
3017 global highlight_files filehighlight fhighlights fh_serial
3018 global highlight_paths gdttype
3020 if {[info exists filehighlight]} {
3021 # delete previous highlights
3022 catch {close $filehighlight}
3023 unset filehighlight
3024 catch {unset fhighlights}
3025 unbolden
3026 unhighlight_filelist
3028 set highlight_paths {}
3029 after cancel do_file_hl $fh_serial
3030 incr fh_serial
3031 if {$highlight_files ne {}} {
3032 after 300 do_file_hl $fh_serial
3036 proc gdttype_change {name ix op} {
3037 global gdttype highlight_files findstring findpattern
3039 stopfinding
3040 if {$findstring ne {}} {
3041 if {$gdttype eq [mc "containing:"]} {
3042 if {$highlight_files ne {}} {
3043 set highlight_files {}
3044 hfiles_change
3046 findcom_change
3047 } else {
3048 if {$findpattern ne {}} {
3049 set findpattern {}
3050 findcom_change
3052 set highlight_files $findstring
3053 hfiles_change
3055 drawvisible
3057 # enable/disable findtype/findloc menus too
3060 proc find_change {name ix op} {
3061 global gdttype findstring highlight_files
3063 stopfinding
3064 if {$gdttype eq [mc "containing:"]} {
3065 findcom_change
3066 } else {
3067 if {$highlight_files ne $findstring} {
3068 set highlight_files $findstring
3069 hfiles_change
3072 drawvisible
3075 proc findcom_change args {
3076 global nhighlights boldnamerows
3077 global findpattern findtype findstring gdttype
3079 stopfinding
3080 # delete previous highlights, if any
3081 foreach row $boldnamerows {
3082 bolden_name $row mainfont
3084 set boldnamerows {}
3085 catch {unset nhighlights}
3086 unbolden
3087 unmarkmatches
3088 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3089 set findpattern {}
3090 } elseif {$findtype eq [mc "Regexp"]} {
3091 set findpattern $findstring
3092 } else {
3093 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3094 $findstring]
3095 set findpattern "*$e*"
3099 proc makepatterns {l} {
3100 set ret {}
3101 foreach e $l {
3102 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3103 if {[string index $ee end] eq "/"} {
3104 lappend ret "$ee*"
3105 } else {
3106 lappend ret $ee
3107 lappend ret "$ee/*"
3110 return $ret
3113 proc do_file_hl {serial} {
3114 global highlight_files filehighlight highlight_paths gdttype fhl_list
3116 if {$gdttype eq [mc "touching paths:"]} {
3117 if {[catch {set paths [shellsplit $highlight_files]}]} return
3118 set highlight_paths [makepatterns $paths]
3119 highlight_filelist
3120 set gdtargs [concat -- $paths]
3121 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3122 set gdtargs [list "-S$highlight_files"]
3123 } else {
3124 # must be "containing:", i.e. we're searching commit info
3125 return
3127 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3128 set filehighlight [open $cmd r+]
3129 fconfigure $filehighlight -blocking 0
3130 filerun $filehighlight readfhighlight
3131 set fhl_list {}
3132 drawvisible
3133 flushhighlights
3136 proc flushhighlights {} {
3137 global filehighlight fhl_list
3139 if {[info exists filehighlight]} {
3140 lappend fhl_list {}
3141 puts $filehighlight ""
3142 flush $filehighlight
3146 proc askfilehighlight {row id} {
3147 global filehighlight fhighlights fhl_list
3149 lappend fhl_list $id
3150 set fhighlights($id) -1
3151 puts $filehighlight $id
3154 proc readfhighlight {} {
3155 global filehighlight fhighlights curview iddrawn
3156 global fhl_list find_dirn
3158 if {![info exists filehighlight]} {
3159 return 0
3161 set nr 0
3162 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3163 set line [string trim $line]
3164 set i [lsearch -exact $fhl_list $line]
3165 if {$i < 0} continue
3166 for {set j 0} {$j < $i} {incr j} {
3167 set id [lindex $fhl_list $j]
3168 set fhighlights($id) 0
3170 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3171 if {$line eq {}} continue
3172 if {![commitinview $line $curview]} continue
3173 set row [rowofcommit $line]
3174 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3175 bolden $row mainfontbold
3177 set fhighlights($line) 1
3179 if {[eof $filehighlight]} {
3180 # strange...
3181 puts "oops, git diff-tree died"
3182 catch {close $filehighlight}
3183 unset filehighlight
3184 return 0
3186 if {[info exists find_dirn]} {
3187 run findmore
3189 return 1
3192 proc doesmatch {f} {
3193 global findtype findpattern
3195 if {$findtype eq [mc "Regexp"]} {
3196 return [regexp $findpattern $f]
3197 } elseif {$findtype eq [mc "IgnCase"]} {
3198 return [string match -nocase $findpattern $f]
3199 } else {
3200 return [string match $findpattern $f]
3204 proc askfindhighlight {row id} {
3205 global nhighlights commitinfo iddrawn
3206 global findloc
3207 global markingmatches
3209 if {![info exists commitinfo($id)]} {
3210 getcommit $id
3212 set info $commitinfo($id)
3213 set isbold 0
3214 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3215 foreach f $info ty $fldtypes {
3216 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3217 [doesmatch $f]} {
3218 if {$ty eq [mc "Author"]} {
3219 set isbold 2
3220 break
3222 set isbold 1
3225 if {$isbold && [info exists iddrawn($id)]} {
3226 if {![ishighlighted $id]} {
3227 bolden $row mainfontbold
3228 if {$isbold > 1} {
3229 bolden_name $row mainfontbold
3232 if {$markingmatches} {
3233 markrowmatches $row $id
3236 set nhighlights($id) $isbold
3239 proc markrowmatches {row id} {
3240 global canv canv2 linehtag linentag commitinfo findloc
3242 set headline [lindex $commitinfo($id) 0]
3243 set author [lindex $commitinfo($id) 1]
3244 $canv delete match$row
3245 $canv2 delete match$row
3246 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3247 set m [findmatches $headline]
3248 if {$m ne {}} {
3249 markmatches $canv $row $headline $linehtag($row) $m \
3250 [$canv itemcget $linehtag($row) -font] $row
3253 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3254 set m [findmatches $author]
3255 if {$m ne {}} {
3256 markmatches $canv2 $row $author $linentag($row) $m \
3257 [$canv2 itemcget $linentag($row) -font] $row
3262 proc vrel_change {name ix op} {
3263 global highlight_related
3265 rhighlight_none
3266 if {$highlight_related ne [mc "None"]} {
3267 run drawvisible
3271 # prepare for testing whether commits are descendents or ancestors of a
3272 proc rhighlight_sel {a} {
3273 global descendent desc_todo ancestor anc_todo
3274 global highlight_related
3276 catch {unset descendent}
3277 set desc_todo [list $a]
3278 catch {unset ancestor}
3279 set anc_todo [list $a]
3280 if {$highlight_related ne [mc "None"]} {
3281 rhighlight_none
3282 run drawvisible
3286 proc rhighlight_none {} {
3287 global rhighlights
3289 catch {unset rhighlights}
3290 unbolden
3293 proc is_descendent {a} {
3294 global curview children descendent desc_todo
3296 set v $curview
3297 set la [rowofcommit $a]
3298 set todo $desc_todo
3299 set leftover {}
3300 set done 0
3301 for {set i 0} {$i < [llength $todo]} {incr i} {
3302 set do [lindex $todo $i]
3303 if {[rowofcommit $do] < $la} {
3304 lappend leftover $do
3305 continue
3307 foreach nk $children($v,$do) {
3308 if {![info exists descendent($nk)]} {
3309 set descendent($nk) 1
3310 lappend todo $nk
3311 if {$nk eq $a} {
3312 set done 1
3316 if {$done} {
3317 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3318 return
3321 set descendent($a) 0
3322 set desc_todo $leftover
3325 proc is_ancestor {a} {
3326 global curview parents ancestor anc_todo
3328 set v $curview
3329 set la [rowofcommit $a]
3330 set todo $anc_todo
3331 set leftover {}
3332 set done 0
3333 for {set i 0} {$i < [llength $todo]} {incr i} {
3334 set do [lindex $todo $i]
3335 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3336 lappend leftover $do
3337 continue
3339 foreach np $parents($v,$do) {
3340 if {![info exists ancestor($np)]} {
3341 set ancestor($np) 1
3342 lappend todo $np
3343 if {$np eq $a} {
3344 set done 1
3348 if {$done} {
3349 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3350 return
3353 set ancestor($a) 0
3354 set anc_todo $leftover
3357 proc askrelhighlight {row id} {
3358 global descendent highlight_related iddrawn rhighlights
3359 global selectedline ancestor
3361 if {![info exists selectedline]} return
3362 set isbold 0
3363 if {$highlight_related eq [mc "Descendent"] ||
3364 $highlight_related eq [mc "Not descendent"]} {
3365 if {![info exists descendent($id)]} {
3366 is_descendent $id
3368 if {$descendent($id) == ($highlight_related eq [mc "Descendent"])} {
3369 set isbold 1
3371 } elseif {$highlight_related eq [mc "Ancestor"] ||
3372 $highlight_related eq [mc "Not ancestor"]} {
3373 if {![info exists ancestor($id)]} {
3374 is_ancestor $id
3376 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3377 set isbold 1
3380 if {[info exists iddrawn($id)]} {
3381 if {$isbold && ![ishighlighted $id]} {
3382 bolden $row mainfontbold
3385 set rhighlights($id) $isbold
3388 # Graph layout functions
3390 proc shortids {ids} {
3391 set res {}
3392 foreach id $ids {
3393 if {[llength $id] > 1} {
3394 lappend res [shortids $id]
3395 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3396 lappend res [string range $id 0 7]
3397 } else {
3398 lappend res $id
3401 return $res
3404 proc ntimes {n o} {
3405 set ret {}
3406 set o [list $o]
3407 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3408 if {($n & $mask) != 0} {
3409 set ret [concat $ret $o]
3411 set o [concat $o $o]
3413 return $ret
3416 proc ordertoken {id} {
3417 global ordertok curview varcid varcstart varctok curview parents children
3418 global nullid nullid2
3420 if {[info exists ordertok($id)]} {
3421 return $ordertok($id)
3423 set origid $id
3424 set todo {}
3425 while {1} {
3426 if {[info exists varcid($curview,$id)]} {
3427 set a $varcid($curview,$id)
3428 set p [lindex $varcstart($curview) $a]
3429 } else {
3430 set p [lindex $children($curview,$id) 0]
3432 if {[info exists ordertok($p)]} {
3433 set tok $ordertok($p)
3434 break
3436 set id [first_real_child $curview,$p]
3437 if {$id eq {}} {
3438 # it's a root
3439 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3440 break
3442 if {[llength $parents($curview,$id)] == 1} {
3443 lappend todo [list $p {}]
3444 } else {
3445 set j [lsearch -exact $parents($curview,$id) $p]
3446 if {$j < 0} {
3447 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3449 lappend todo [list $p [strrep $j]]
3452 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
3453 set p [lindex $todo $i 0]
3454 append tok [lindex $todo $i 1]
3455 set ordertok($p) $tok
3457 set ordertok($origid) $tok
3458 return $tok
3461 # Work out where id should go in idlist so that order-token
3462 # values increase from left to right
3463 proc idcol {idlist id {i 0}} {
3464 set t [ordertoken $id]
3465 if {$i < 0} {
3466 set i 0
3468 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
3469 if {$i > [llength $idlist]} {
3470 set i [llength $idlist]
3472 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
3473 incr i
3474 } else {
3475 if {$t > [ordertoken [lindex $idlist $i]]} {
3476 while {[incr i] < [llength $idlist] &&
3477 $t >= [ordertoken [lindex $idlist $i]]} {}
3480 return $i
3483 proc initlayout {} {
3484 global rowidlist rowisopt rowfinal displayorder parentlist
3485 global numcommits canvxmax canv
3486 global nextcolor
3487 global colormap rowtextx
3489 set numcommits 0
3490 set displayorder {}
3491 set parentlist {}
3492 set nextcolor 0
3493 set rowidlist {}
3494 set rowisopt {}
3495 set rowfinal {}
3496 set canvxmax [$canv cget -width]
3497 catch {unset colormap}
3498 catch {unset rowtextx}
3501 proc setcanvscroll {} {
3502 global canv canv2 canv3 numcommits linespc canvxmax canvy0
3504 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3505 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3506 $canv2 conf -scrollregion [list 0 0 0 $ymax]
3507 $canv3 conf -scrollregion [list 0 0 0 $ymax]
3510 proc visiblerows {} {
3511 global canv numcommits linespc
3513 set ymax [lindex [$canv cget -scrollregion] 3]
3514 if {$ymax eq {} || $ymax == 0} return
3515 set f [$canv yview]
3516 set y0 [expr {int([lindex $f 0] * $ymax)}]
3517 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3518 if {$r0 < 0} {
3519 set r0 0
3521 set y1 [expr {int([lindex $f 1] * $ymax)}]
3522 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3523 if {$r1 >= $numcommits} {
3524 set r1 [expr {$numcommits - 1}]
3526 return [list $r0 $r1]
3529 proc layoutmore {} {
3530 global commitidx viewcomplete curview
3531 global numcommits pending_select selectedline curview
3532 global lastscrollset commitinterest
3534 set canshow $commitidx($curview)
3535 if {$canshow <= $numcommits && !$viewcomplete($curview)} return
3536 if {$numcommits == 0} {
3537 allcanvs delete all
3539 set r0 $numcommits
3540 set prev $numcommits
3541 set numcommits $canshow
3542 set t [clock clicks -milliseconds]
3543 if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
3544 set lastscrollset $t
3545 setcanvscroll
3547 set rows [visiblerows]
3548 set r1 [lindex $rows 1]
3549 if {$r1 >= $canshow} {
3550 set r1 [expr {$canshow - 1}]
3552 if {$r0 <= $r1} {
3553 drawcommits $r0 $r1
3555 if {[info exists pending_select] &&
3556 [commitinview $pending_select $curview]} {
3557 selectline [rowofcommit $pending_select] 1
3561 proc doshowlocalchanges {} {
3562 global curview mainheadid
3564 if {[commitinview $mainheadid $curview]} {
3565 dodiffindex
3566 } else {
3567 lappend commitinterest($mainheadid) {dodiffindex}
3571 proc dohidelocalchanges {} {
3572 global nullid nullid2 lserial curview
3574 if {[commitinview $nullid $curview]} {
3575 removefakerow $nullid
3577 if {[commitinview $nullid2 $curview]} {
3578 removefakerow $nullid2
3580 incr lserial
3583 # spawn off a process to do git diff-index --cached HEAD
3584 proc dodiffindex {} {
3585 global lserial showlocalchanges
3587 if {!$showlocalchanges} return
3588 incr lserial
3589 set fd [open "|git diff-index --cached HEAD" r]
3590 fconfigure $fd -blocking 0
3591 filerun $fd [list readdiffindex $fd $lserial]
3594 proc readdiffindex {fd serial} {
3595 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
3597 set isdiff 1
3598 if {[gets $fd line] < 0} {
3599 if {![eof $fd]} {
3600 return 1
3602 set isdiff 0
3604 # we only need to see one line and we don't really care what it says...
3605 close $fd
3607 if {$serial != $lserial} {
3608 return 0
3611 # now see if there are any local changes not checked in to the index
3612 set fd [open "|git diff-files" r]
3613 fconfigure $fd -blocking 0
3614 filerun $fd [list readdifffiles $fd $serial]
3616 if {$isdiff && ![commitinview $nullid2 $curview]} {
3617 # add the line for the changes in the index to the graph
3618 set hl [mc "Local changes checked in to index but not committed"]
3619 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
3620 set commitdata($nullid2) "\n $hl\n"
3621 if {[commitinview $nullid $curview]} {
3622 removefakerow $nullid
3624 insertfakerow $nullid2 $mainheadid
3625 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
3626 removefakerow $nullid2
3628 return 0
3631 proc readdifffiles {fd serial} {
3632 global mainheadid nullid nullid2 curview
3633 global commitinfo commitdata lserial
3635 set isdiff 1
3636 if {[gets $fd line] < 0} {
3637 if {![eof $fd]} {
3638 return 1
3640 set isdiff 0
3642 # we only need to see one line and we don't really care what it says...
3643 close $fd
3645 if {$serial != $lserial} {
3646 return 0
3649 if {$isdiff && ![commitinview $nullid $curview]} {
3650 # add the line for the local diff to the graph
3651 set hl [mc "Local uncommitted changes, not checked in to index"]
3652 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
3653 set commitdata($nullid) "\n $hl\n"
3654 if {[commitinview $nullid2 $curview]} {
3655 set p $nullid2
3656 } else {
3657 set p $mainheadid
3659 insertfakerow $nullid $p
3660 } elseif {!$isdiff && [commitinview $nullid $curview]} {
3661 removefakerow $nullid
3663 return 0
3666 proc nextuse {id row} {
3667 global curview children
3669 if {[info exists children($curview,$id)]} {
3670 foreach kid $children($curview,$id) {
3671 if {![commitinview $kid $curview]} {
3672 return -1
3674 if {[rowofcommit $kid] > $row} {
3675 return [rowofcommit $kid]
3679 if {[commitinview $id $curview]} {
3680 return [rowofcommit $id]
3682 return -1
3685 proc prevuse {id row} {
3686 global curview children
3688 set ret -1
3689 if {[info exists children($curview,$id)]} {
3690 foreach kid $children($curview,$id) {
3691 if {![commitinview $kid $curview]} break
3692 if {[rowofcommit $kid] < $row} {
3693 set ret [rowofcommit $kid]
3697 return $ret
3700 proc make_idlist {row} {
3701 global displayorder parentlist uparrowlen downarrowlen mingaplen
3702 global commitidx curview children
3704 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3705 if {$r < 0} {
3706 set r 0
3708 set ra [expr {$row - $downarrowlen}]
3709 if {$ra < 0} {
3710 set ra 0
3712 set rb [expr {$row + $uparrowlen}]
3713 if {$rb > $commitidx($curview)} {
3714 set rb $commitidx($curview)
3716 make_disporder $r [expr {$rb + 1}]
3717 set ids {}
3718 for {} {$r < $ra} {incr r} {
3719 set nextid [lindex $displayorder [expr {$r + 1}]]
3720 foreach p [lindex $parentlist $r] {
3721 if {$p eq $nextid} continue
3722 set rn [nextuse $p $r]
3723 if {$rn >= $row &&
3724 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3725 lappend ids [list [ordertoken $p] $p]
3729 for {} {$r < $row} {incr r} {
3730 set nextid [lindex $displayorder [expr {$r + 1}]]
3731 foreach p [lindex $parentlist $r] {
3732 if {$p eq $nextid} continue
3733 set rn [nextuse $p $r]
3734 if {$rn < 0 || $rn >= $row} {
3735 lappend ids [list [ordertoken $p] $p]
3739 set id [lindex $displayorder $row]
3740 lappend ids [list [ordertoken $id] $id]
3741 while {$r < $rb} {
3742 foreach p [lindex $parentlist $r] {
3743 set firstkid [lindex $children($curview,$p) 0]
3744 if {[rowofcommit $firstkid] < $row} {
3745 lappend ids [list [ordertoken $p] $p]
3748 incr r
3749 set id [lindex $displayorder $r]
3750 if {$id ne {}} {
3751 set firstkid [lindex $children($curview,$id) 0]
3752 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3753 lappend ids [list [ordertoken $id] $id]
3757 set idlist {}
3758 foreach idx [lsort -unique $ids] {
3759 lappend idlist [lindex $idx 1]
3761 return $idlist
3764 proc rowsequal {a b} {
3765 while {[set i [lsearch -exact $a {}]] >= 0} {
3766 set a [lreplace $a $i $i]
3768 while {[set i [lsearch -exact $b {}]] >= 0} {
3769 set b [lreplace $b $i $i]
3771 return [expr {$a eq $b}]
3774 proc makeupline {id row rend col} {
3775 global rowidlist uparrowlen downarrowlen mingaplen
3777 for {set r $rend} {1} {set r $rstart} {
3778 set rstart [prevuse $id $r]
3779 if {$rstart < 0} return
3780 if {$rstart < $row} break
3782 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3783 set rstart [expr {$rend - $uparrowlen - 1}]
3785 for {set r $rstart} {[incr r] <= $row} {} {
3786 set idlist [lindex $rowidlist $r]
3787 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3788 set col [idcol $idlist $id $col]
3789 lset rowidlist $r [linsert $idlist $col $id]
3790 changedrow $r
3795 proc layoutrows {row endrow} {
3796 global rowidlist rowisopt rowfinal displayorder
3797 global uparrowlen downarrowlen maxwidth mingaplen
3798 global children parentlist
3799 global commitidx viewcomplete curview
3801 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3802 set idlist {}
3803 if {$row > 0} {
3804 set rm1 [expr {$row - 1}]
3805 foreach id [lindex $rowidlist $rm1] {
3806 if {$id ne {}} {
3807 lappend idlist $id
3810 set final [lindex $rowfinal $rm1]
3812 for {} {$row < $endrow} {incr row} {
3813 set rm1 [expr {$row - 1}]
3814 if {$rm1 < 0 || $idlist eq {}} {
3815 set idlist [make_idlist $row]
3816 set final 1
3817 } else {
3818 set id [lindex $displayorder $rm1]
3819 set col [lsearch -exact $idlist $id]
3820 set idlist [lreplace $idlist $col $col]
3821 foreach p [lindex $parentlist $rm1] {
3822 if {[lsearch -exact $idlist $p] < 0} {
3823 set col [idcol $idlist $p $col]
3824 set idlist [linsert $idlist $col $p]
3825 # if not the first child, we have to insert a line going up
3826 if {$id ne [lindex $children($curview,$p) 0]} {
3827 makeupline $p $rm1 $row $col
3831 set id [lindex $displayorder $row]
3832 if {$row > $downarrowlen} {
3833 set termrow [expr {$row - $downarrowlen - 1}]
3834 foreach p [lindex $parentlist $termrow] {
3835 set i [lsearch -exact $idlist $p]
3836 if {$i < 0} continue
3837 set nr [nextuse $p $termrow]
3838 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3839 set idlist [lreplace $idlist $i $i]
3843 set col [lsearch -exact $idlist $id]
3844 if {$col < 0} {
3845 set col [idcol $idlist $id]
3846 set idlist [linsert $idlist $col $id]
3847 if {$children($curview,$id) ne {}} {
3848 makeupline $id $rm1 $row $col
3851 set r [expr {$row + $uparrowlen - 1}]
3852 if {$r < $commitidx($curview)} {
3853 set x $col
3854 foreach p [lindex $parentlist $r] {
3855 if {[lsearch -exact $idlist $p] >= 0} continue
3856 set fk [lindex $children($curview,$p) 0]
3857 if {[rowofcommit $fk] < $row} {
3858 set x [idcol $idlist $p $x]
3859 set idlist [linsert $idlist $x $p]
3862 if {[incr r] < $commitidx($curview)} {
3863 set p [lindex $displayorder $r]
3864 if {[lsearch -exact $idlist $p] < 0} {
3865 set fk [lindex $children($curview,$p) 0]
3866 if {$fk ne {} && [rowofcommit $fk] < $row} {
3867 set x [idcol $idlist $p $x]
3868 set idlist [linsert $idlist $x $p]
3874 if {$final && !$viewcomplete($curview) &&
3875 $row + $uparrowlen + $mingaplen + $downarrowlen
3876 >= $commitidx($curview)} {
3877 set final 0
3879 set l [llength $rowidlist]
3880 if {$row == $l} {
3881 lappend rowidlist $idlist
3882 lappend rowisopt 0
3883 lappend rowfinal $final
3884 } elseif {$row < $l} {
3885 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3886 lset rowidlist $row $idlist
3887 changedrow $row
3889 lset rowfinal $row $final
3890 } else {
3891 set pad [ntimes [expr {$row - $l}] {}]
3892 set rowidlist [concat $rowidlist $pad]
3893 lappend rowidlist $idlist
3894 set rowfinal [concat $rowfinal $pad]
3895 lappend rowfinal $final
3896 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3899 return $row
3902 proc changedrow {row} {
3903 global displayorder iddrawn rowisopt need_redisplay
3905 set l [llength $rowisopt]
3906 if {$row < $l} {
3907 lset rowisopt $row 0
3908 if {$row + 1 < $l} {
3909 lset rowisopt [expr {$row + 1}] 0
3910 if {$row + 2 < $l} {
3911 lset rowisopt [expr {$row + 2}] 0
3915 set id [lindex $displayorder $row]
3916 if {[info exists iddrawn($id)]} {
3917 set need_redisplay 1
3921 proc insert_pad {row col npad} {
3922 global rowidlist
3924 set pad [ntimes $npad {}]
3925 set idlist [lindex $rowidlist $row]
3926 set bef [lrange $idlist 0 [expr {$col - 1}]]
3927 set aft [lrange $idlist $col end]
3928 set i [lsearch -exact $aft {}]
3929 if {$i > 0} {
3930 set aft [lreplace $aft $i $i]
3932 lset rowidlist $row [concat $bef $pad $aft]
3933 changedrow $row
3936 proc optimize_rows {row col endrow} {
3937 global rowidlist rowisopt displayorder curview children
3939 if {$row < 1} {
3940 set row 1
3942 for {} {$row < $endrow} {incr row; set col 0} {
3943 if {[lindex $rowisopt $row]} continue
3944 set haspad 0
3945 set y0 [expr {$row - 1}]
3946 set ym [expr {$row - 2}]
3947 set idlist [lindex $rowidlist $row]
3948 set previdlist [lindex $rowidlist $y0]
3949 if {$idlist eq {} || $previdlist eq {}} continue
3950 if {$ym >= 0} {
3951 set pprevidlist [lindex $rowidlist $ym]
3952 if {$pprevidlist eq {}} continue
3953 } else {
3954 set pprevidlist {}
3956 set x0 -1
3957 set xm -1
3958 for {} {$col < [llength $idlist]} {incr col} {
3959 set id [lindex $idlist $col]
3960 if {[lindex $previdlist $col] eq $id} continue
3961 if {$id eq {}} {
3962 set haspad 1
3963 continue
3965 set x0 [lsearch -exact $previdlist $id]
3966 if {$x0 < 0} continue
3967 set z [expr {$x0 - $col}]
3968 set isarrow 0
3969 set z0 {}
3970 if {$ym >= 0} {
3971 set xm [lsearch -exact $pprevidlist $id]
3972 if {$xm >= 0} {
3973 set z0 [expr {$xm - $x0}]
3976 if {$z0 eq {}} {
3977 # if row y0 is the first child of $id then it's not an arrow
3978 if {[lindex $children($curview,$id) 0] ne
3979 [lindex $displayorder $y0]} {
3980 set isarrow 1
3983 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3984 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3985 set isarrow 1
3987 # Looking at lines from this row to the previous row,
3988 # make them go straight up if they end in an arrow on
3989 # the previous row; otherwise make them go straight up
3990 # or at 45 degrees.
3991 if {$z < -1 || ($z < 0 && $isarrow)} {
3992 # Line currently goes left too much;
3993 # insert pads in the previous row, then optimize it
3994 set npad [expr {-1 - $z + $isarrow}]
3995 insert_pad $y0 $x0 $npad
3996 if {$y0 > 0} {
3997 optimize_rows $y0 $x0 $row
3999 set previdlist [lindex $rowidlist $y0]
4000 set x0 [lsearch -exact $previdlist $id]
4001 set z [expr {$x0 - $col}]
4002 if {$z0 ne {}} {
4003 set pprevidlist [lindex $rowidlist $ym]
4004 set xm [lsearch -exact $pprevidlist $id]
4005 set z0 [expr {$xm - $x0}]
4007 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4008 # Line currently goes right too much;
4009 # insert pads in this line
4010 set npad [expr {$z - 1 + $isarrow}]
4011 insert_pad $row $col $npad
4012 set idlist [lindex $rowidlist $row]
4013 incr col $npad
4014 set z [expr {$x0 - $col}]
4015 set haspad 1
4017 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4018 # this line links to its first child on row $row-2
4019 set id [lindex $displayorder $ym]
4020 set xc [lsearch -exact $pprevidlist $id]
4021 if {$xc >= 0} {
4022 set z0 [expr {$xc - $x0}]
4025 # avoid lines jigging left then immediately right
4026 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4027 insert_pad $y0 $x0 1
4028 incr x0
4029 optimize_rows $y0 $x0 $row
4030 set previdlist [lindex $rowidlist $y0]
4033 if {!$haspad} {
4034 # Find the first column that doesn't have a line going right
4035 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4036 set id [lindex $idlist $col]
4037 if {$id eq {}} break
4038 set x0 [lsearch -exact $previdlist $id]
4039 if {$x0 < 0} {
4040 # check if this is the link to the first child
4041 set kid [lindex $displayorder $y0]
4042 if {[lindex $children($curview,$id) 0] eq $kid} {
4043 # it is, work out offset to child
4044 set x0 [lsearch -exact $previdlist $kid]
4047 if {$x0 <= $col} break
4049 # Insert a pad at that column as long as it has a line and
4050 # isn't the last column
4051 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4052 set idlist [linsert $idlist $col {}]
4053 lset rowidlist $row $idlist
4054 changedrow $row
4060 proc xc {row col} {
4061 global canvx0 linespc
4062 return [expr {$canvx0 + $col * $linespc}]
4065 proc yc {row} {
4066 global canvy0 linespc
4067 return [expr {$canvy0 + $row * $linespc}]
4070 proc linewidth {id} {
4071 global thickerline lthickness
4073 set wid $lthickness
4074 if {[info exists thickerline] && $id eq $thickerline} {
4075 set wid [expr {2 * $lthickness}]
4077 return $wid
4080 proc rowranges {id} {
4081 global curview children uparrowlen downarrowlen
4082 global rowidlist
4084 set kids $children($curview,$id)
4085 if {$kids eq {}} {
4086 return {}
4088 set ret {}
4089 lappend kids $id
4090 foreach child $kids {
4091 if {![commitinview $child $curview]} break
4092 set row [rowofcommit $child]
4093 if {![info exists prev]} {
4094 lappend ret [expr {$row + 1}]
4095 } else {
4096 if {$row <= $prevrow} {
4097 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4099 # see if the line extends the whole way from prevrow to row
4100 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4101 [lsearch -exact [lindex $rowidlist \
4102 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4103 # it doesn't, see where it ends
4104 set r [expr {$prevrow + $downarrowlen}]
4105 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4106 while {[incr r -1] > $prevrow &&
4107 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4108 } else {
4109 while {[incr r] <= $row &&
4110 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4111 incr r -1
4113 lappend ret $r
4114 # see where it starts up again
4115 set r [expr {$row - $uparrowlen}]
4116 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4117 while {[incr r] < $row &&
4118 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4119 } else {
4120 while {[incr r -1] >= $prevrow &&
4121 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4122 incr r
4124 lappend ret $r
4127 if {$child eq $id} {
4128 lappend ret $row
4130 set prev $child
4131 set prevrow $row
4133 return $ret
4136 proc drawlineseg {id row endrow arrowlow} {
4137 global rowidlist displayorder iddrawn linesegs
4138 global canv colormap linespc curview maxlinelen parentlist
4140 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4141 set le [expr {$row + 1}]
4142 set arrowhigh 1
4143 while {1} {
4144 set c [lsearch -exact [lindex $rowidlist $le] $id]
4145 if {$c < 0} {
4146 incr le -1
4147 break
4149 lappend cols $c
4150 set x [lindex $displayorder $le]
4151 if {$x eq $id} {
4152 set arrowhigh 0
4153 break
4155 if {[info exists iddrawn($x)] || $le == $endrow} {
4156 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4157 if {$c >= 0} {
4158 lappend cols $c
4159 set arrowhigh 0
4161 break
4163 incr le
4165 if {$le <= $row} {
4166 return $row
4169 set lines {}
4170 set i 0
4171 set joinhigh 0
4172 if {[info exists linesegs($id)]} {
4173 set lines $linesegs($id)
4174 foreach li $lines {
4175 set r0 [lindex $li 0]
4176 if {$r0 > $row} {
4177 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4178 set joinhigh 1
4180 break
4182 incr i
4185 set joinlow 0
4186 if {$i > 0} {
4187 set li [lindex $lines [expr {$i-1}]]
4188 set r1 [lindex $li 1]
4189 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4190 set joinlow 1
4194 set x [lindex $cols [expr {$le - $row}]]
4195 set xp [lindex $cols [expr {$le - 1 - $row}]]
4196 set dir [expr {$xp - $x}]
4197 if {$joinhigh} {
4198 set ith [lindex $lines $i 2]
4199 set coords [$canv coords $ith]
4200 set ah [$canv itemcget $ith -arrow]
4201 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4202 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4203 if {$x2 ne {} && $x - $x2 == $dir} {
4204 set coords [lrange $coords 0 end-2]
4206 } else {
4207 set coords [list [xc $le $x] [yc $le]]
4209 if {$joinlow} {
4210 set itl [lindex $lines [expr {$i-1}] 2]
4211 set al [$canv itemcget $itl -arrow]
4212 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4213 } elseif {$arrowlow} {
4214 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4215 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4216 set arrowlow 0
4219 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4220 for {set y $le} {[incr y -1] > $row} {} {
4221 set x $xp
4222 set xp [lindex $cols [expr {$y - 1 - $row}]]
4223 set ndir [expr {$xp - $x}]
4224 if {$dir != $ndir || $xp < 0} {
4225 lappend coords [xc $y $x] [yc $y]
4227 set dir $ndir
4229 if {!$joinlow} {
4230 if {$xp < 0} {
4231 # join parent line to first child
4232 set ch [lindex $displayorder $row]
4233 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4234 if {$xc < 0} {
4235 puts "oops: drawlineseg: child $ch not on row $row"
4236 } elseif {$xc != $x} {
4237 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4238 set d [expr {int(0.5 * $linespc)}]
4239 set x1 [xc $row $x]
4240 if {$xc < $x} {
4241 set x2 [expr {$x1 - $d}]
4242 } else {
4243 set x2 [expr {$x1 + $d}]
4245 set y2 [yc $row]
4246 set y1 [expr {$y2 + $d}]
4247 lappend coords $x1 $y1 $x2 $y2
4248 } elseif {$xc < $x - 1} {
4249 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4250 } elseif {$xc > $x + 1} {
4251 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4253 set x $xc
4255 lappend coords [xc $row $x] [yc $row]
4256 } else {
4257 set xn [xc $row $xp]
4258 set yn [yc $row]
4259 lappend coords $xn $yn
4261 if {!$joinhigh} {
4262 assigncolor $id
4263 set t [$canv create line $coords -width [linewidth $id] \
4264 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4265 $canv lower $t
4266 bindline $t $id
4267 set lines [linsert $lines $i [list $row $le $t]]
4268 } else {
4269 $canv coords $ith $coords
4270 if {$arrow ne $ah} {
4271 $canv itemconf $ith -arrow $arrow
4273 lset lines $i 0 $row
4275 } else {
4276 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4277 set ndir [expr {$xo - $xp}]
4278 set clow [$canv coords $itl]
4279 if {$dir == $ndir} {
4280 set clow [lrange $clow 2 end]
4282 set coords [concat $coords $clow]
4283 if {!$joinhigh} {
4284 lset lines [expr {$i-1}] 1 $le
4285 } else {
4286 # coalesce two pieces
4287 $canv delete $ith
4288 set b [lindex $lines [expr {$i-1}] 0]
4289 set e [lindex $lines $i 1]
4290 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4292 $canv coords $itl $coords
4293 if {$arrow ne $al} {
4294 $canv itemconf $itl -arrow $arrow
4298 set linesegs($id) $lines
4299 return $le
4302 proc drawparentlinks {id row} {
4303 global rowidlist canv colormap curview parentlist
4304 global idpos linespc
4306 set rowids [lindex $rowidlist $row]
4307 set col [lsearch -exact $rowids $id]
4308 if {$col < 0} return
4309 set olds [lindex $parentlist $row]
4310 set row2 [expr {$row + 1}]
4311 set x [xc $row $col]
4312 set y [yc $row]
4313 set y2 [yc $row2]
4314 set d [expr {int(0.5 * $linespc)}]
4315 set ymid [expr {$y + $d}]
4316 set ids [lindex $rowidlist $row2]
4317 # rmx = right-most X coord used
4318 set rmx 0
4319 foreach p $olds {
4320 set i [lsearch -exact $ids $p]
4321 if {$i < 0} {
4322 puts "oops, parent $p of $id not in list"
4323 continue
4325 set x2 [xc $row2 $i]
4326 if {$x2 > $rmx} {
4327 set rmx $x2
4329 set j [lsearch -exact $rowids $p]
4330 if {$j < 0} {
4331 # drawlineseg will do this one for us
4332 continue
4334 assigncolor $p
4335 # should handle duplicated parents here...
4336 set coords [list $x $y]
4337 if {$i != $col} {
4338 # if attaching to a vertical segment, draw a smaller
4339 # slant for visual distinctness
4340 if {$i == $j} {
4341 if {$i < $col} {
4342 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4343 } else {
4344 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4346 } elseif {$i < $col && $i < $j} {
4347 # segment slants towards us already
4348 lappend coords [xc $row $j] $y
4349 } else {
4350 if {$i < $col - 1} {
4351 lappend coords [expr {$x2 + $linespc}] $y
4352 } elseif {$i > $col + 1} {
4353 lappend coords [expr {$x2 - $linespc}] $y
4355 lappend coords $x2 $y2
4357 } else {
4358 lappend coords $x2 $y2
4360 set t [$canv create line $coords -width [linewidth $p] \
4361 -fill $colormap($p) -tags lines.$p]
4362 $canv lower $t
4363 bindline $t $p
4365 if {$rmx > [lindex $idpos($id) 1]} {
4366 lset idpos($id) 1 $rmx
4367 redrawtags $id
4371 proc drawlines {id} {
4372 global canv
4374 $canv itemconf lines.$id -width [linewidth $id]
4377 proc drawcmittext {id row col} {
4378 global linespc canv canv2 canv3 fgcolor curview
4379 global cmitlisted commitinfo rowidlist parentlist
4380 global rowtextx idpos idtags idheads idotherrefs
4381 global linehtag linentag linedtag selectedline
4382 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4384 # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
4385 set listed $cmitlisted($curview,$id)
4386 if {$id eq $nullid} {
4387 set ofill red
4388 } elseif {$id eq $nullid2} {
4389 set ofill green
4390 } else {
4391 set ofill [expr {$listed != 0? "blue": "white"}]
4393 set x [xc $row $col]
4394 set y [yc $row]
4395 set orad [expr {$linespc / 3}]
4396 if {$listed <= 1} {
4397 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4398 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4399 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4400 } elseif {$listed == 2} {
4401 # triangle pointing left for left-side commits
4402 set t [$canv create polygon \
4403 [expr {$x - $orad}] $y \
4404 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4405 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4406 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4407 } else {
4408 # triangle pointing right for right-side commits
4409 set t [$canv create polygon \
4410 [expr {$x + $orad - 1}] $y \
4411 [expr {$x - $orad}] [expr {$y - $orad}] \
4412 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4413 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4415 $canv raise $t
4416 $canv bind $t <1> {selcanvline {} %x %y}
4417 set rmx [llength [lindex $rowidlist $row]]
4418 set olds [lindex $parentlist $row]
4419 if {$olds ne {}} {
4420 set nextids [lindex $rowidlist [expr {$row + 1}]]
4421 foreach p $olds {
4422 set i [lsearch -exact $nextids $p]
4423 if {$i > $rmx} {
4424 set rmx $i
4428 set xt [xc $row $rmx]
4429 set rowtextx($row) $xt
4430 set idpos($id) [list $x $xt $y]
4431 if {[info exists idtags($id)] || [info exists idheads($id)]
4432 || [info exists idotherrefs($id)]} {
4433 set xt [drawtags $id $x $xt $y]
4435 set headline [lindex $commitinfo($id) 0]
4436 set name [lindex $commitinfo($id) 1]
4437 set date [lindex $commitinfo($id) 2]
4438 set date [formatdate $date]
4439 set font mainfont
4440 set nfont mainfont
4441 set isbold [ishighlighted $id]
4442 if {$isbold > 0} {
4443 lappend boldrows $row
4444 set font mainfontbold
4445 if {$isbold > 1} {
4446 lappend boldnamerows $row
4447 set nfont mainfontbold
4450 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4451 -text $headline -font $font -tags text]
4452 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4453 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4454 -text $name -font $nfont -tags text]
4455 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4456 -text $date -font mainfont -tags text]
4457 if {[info exists selectedline] && $selectedline == $row} {
4458 make_secsel $row
4460 set xr [expr {$xt + [font measure $font $headline]}]
4461 if {$xr > $canvxmax} {
4462 set canvxmax $xr
4463 setcanvscroll
4467 proc drawcmitrow {row} {
4468 global displayorder rowidlist nrows_drawn
4469 global iddrawn markingmatches
4470 global commitinfo numcommits
4471 global filehighlight fhighlights findpattern nhighlights
4472 global hlview vhighlights
4473 global highlight_related rhighlights
4475 if {$row >= $numcommits} return
4477 set id [lindex $displayorder $row]
4478 if {[info exists hlview] && ![info exists vhighlights($id)]} {
4479 askvhighlight $row $id
4481 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
4482 askfilehighlight $row $id
4484 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
4485 askfindhighlight $row $id
4487 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
4488 askrelhighlight $row $id
4490 if {![info exists iddrawn($id)]} {
4491 set col [lsearch -exact [lindex $rowidlist $row] $id]
4492 if {$col < 0} {
4493 puts "oops, row $row id $id not in list"
4494 return
4496 if {![info exists commitinfo($id)]} {
4497 getcommit $id
4499 assigncolor $id
4500 drawcmittext $id $row $col
4501 set iddrawn($id) 1
4502 incr nrows_drawn
4504 if {$markingmatches} {
4505 markrowmatches $row $id
4509 proc drawcommits {row {endrow {}}} {
4510 global numcommits iddrawn displayorder curview need_redisplay
4511 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4513 if {$row < 0} {
4514 set row 0
4516 if {$endrow eq {}} {
4517 set endrow $row
4519 if {$endrow >= $numcommits} {
4520 set endrow [expr {$numcommits - 1}]
4523 set rl1 [expr {$row - $downarrowlen - 3}]
4524 if {$rl1 < 0} {
4525 set rl1 0
4527 set ro1 [expr {$row - 3}]
4528 if {$ro1 < 0} {
4529 set ro1 0
4531 set r2 [expr {$endrow + $uparrowlen + 3}]
4532 if {$r2 > $numcommits} {
4533 set r2 $numcommits
4535 for {set r $rl1} {$r < $r2} {incr r} {
4536 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4537 if {$rl1 < $r} {
4538 layoutrows $rl1 $r
4540 set rl1 [expr {$r + 1}]
4543 if {$rl1 < $r} {
4544 layoutrows $rl1 $r
4546 optimize_rows $ro1 0 $r2
4547 if {$need_redisplay || $nrows_drawn > 2000} {
4548 clear_display
4549 drawvisible
4552 # make the lines join to already-drawn rows either side
4553 set r [expr {$row - 1}]
4554 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4555 set r $row
4557 set er [expr {$endrow + 1}]
4558 if {$er >= $numcommits ||
4559 ![info exists iddrawn([lindex $displayorder $er])]} {
4560 set er $endrow
4562 for {} {$r <= $er} {incr r} {
4563 set id [lindex $displayorder $r]
4564 set wasdrawn [info exists iddrawn($id)]
4565 drawcmitrow $r
4566 if {$r == $er} break
4567 set nextid [lindex $displayorder [expr {$r + 1}]]
4568 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4569 drawparentlinks $id $r
4571 set rowids [lindex $rowidlist $r]
4572 foreach lid $rowids {
4573 if {$lid eq {}} continue
4574 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4575 if {$lid eq $id} {
4576 # see if this is the first child of any of its parents
4577 foreach p [lindex $parentlist $r] {
4578 if {[lsearch -exact $rowids $p] < 0} {
4579 # make this line extend up to the child
4580 set lineend($p) [drawlineseg $p $r $er 0]
4583 } else {
4584 set lineend($lid) [drawlineseg $lid $r $er 1]
4590 proc undolayout {row} {
4591 global uparrowlen mingaplen downarrowlen
4592 global rowidlist rowisopt rowfinal need_redisplay
4594 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4595 if {$r < 0} {
4596 set r 0
4598 if {[llength $rowidlist] > $r} {
4599 incr r -1
4600 set rowidlist [lrange $rowidlist 0 $r]
4601 set rowfinal [lrange $rowfinal 0 $r]
4602 set rowisopt [lrange $rowisopt 0 $r]
4603 set need_redisplay 1
4604 run drawvisible
4608 proc drawvisible {} {
4609 global canv linespc curview vrowmod selectedline targetrow targetid
4610 global need_redisplay cscroll numcommits
4612 set fs [$canv yview]
4613 set ymax [lindex [$canv cget -scrollregion] 3]
4614 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
4615 set f0 [lindex $fs 0]
4616 set f1 [lindex $fs 1]
4617 set y0 [expr {int($f0 * $ymax)}]
4618 set y1 [expr {int($f1 * $ymax)}]
4620 if {[info exists targetid]} {
4621 if {[commitinview $targetid $curview]} {
4622 set r [rowofcommit $targetid]
4623 if {$r != $targetrow} {
4624 # Fix up the scrollregion and change the scrolling position
4625 # now that our target row has moved.
4626 set diff [expr {($r - $targetrow) * $linespc}]
4627 set targetrow $r
4628 setcanvscroll
4629 set ymax [lindex [$canv cget -scrollregion] 3]
4630 incr y0 $diff
4631 incr y1 $diff
4632 set f0 [expr {$y0 / $ymax}]
4633 set f1 [expr {$y1 / $ymax}]
4634 allcanvs yview moveto $f0
4635 $cscroll set $f0 $f1
4636 set need_redisplay 1
4638 } else {
4639 unset targetid
4643 set row [expr {int(($y0 - 3) / $linespc) - 1}]
4644 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4645 if {$endrow >= $vrowmod($curview)} {
4646 update_arcrows $curview
4648 if {[info exists selectedline] &&
4649 $row <= $selectedline && $selectedline <= $endrow} {
4650 set targetrow $selectedline
4651 } else {
4652 set targetrow [expr {int(($row + $endrow) / 2)}]
4654 if {$targetrow >= $numcommits} {
4655 set targetrow [expr {$numcommits - 1}]
4657 set targetid [commitonrow $targetrow]
4658 drawcommits $row $endrow
4661 proc clear_display {} {
4662 global iddrawn linesegs need_redisplay nrows_drawn
4663 global vhighlights fhighlights nhighlights rhighlights
4665 allcanvs delete all
4666 catch {unset iddrawn}
4667 catch {unset linesegs}
4668 catch {unset vhighlights}
4669 catch {unset fhighlights}
4670 catch {unset nhighlights}
4671 catch {unset rhighlights}
4672 set need_redisplay 0
4673 set nrows_drawn 0
4676 proc findcrossings {id} {
4677 global rowidlist parentlist numcommits displayorder
4679 set cross {}
4680 set ccross {}
4681 foreach {s e} [rowranges $id] {
4682 if {$e >= $numcommits} {
4683 set e [expr {$numcommits - 1}]
4685 if {$e <= $s} continue
4686 for {set row $e} {[incr row -1] >= $s} {} {
4687 set x [lsearch -exact [lindex $rowidlist $row] $id]
4688 if {$x < 0} break
4689 set olds [lindex $parentlist $row]
4690 set kid [lindex $displayorder $row]
4691 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4692 if {$kidx < 0} continue
4693 set nextrow [lindex $rowidlist [expr {$row + 1}]]
4694 foreach p $olds {
4695 set px [lsearch -exact $nextrow $p]
4696 if {$px < 0} continue
4697 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4698 if {[lsearch -exact $ccross $p] >= 0} continue
4699 if {$x == $px + ($kidx < $px? -1: 1)} {
4700 lappend ccross $p
4701 } elseif {[lsearch -exact $cross $p] < 0} {
4702 lappend cross $p
4708 return [concat $ccross {{}} $cross]
4711 proc assigncolor {id} {
4712 global colormap colors nextcolor
4713 global parents children children curview
4715 if {[info exists colormap($id)]} return
4716 set ncolors [llength $colors]
4717 if {[info exists children($curview,$id)]} {
4718 set kids $children($curview,$id)
4719 } else {
4720 set kids {}
4722 if {[llength $kids] == 1} {
4723 set child [lindex $kids 0]
4724 if {[info exists colormap($child)]
4725 && [llength $parents($curview,$child)] == 1} {
4726 set colormap($id) $colormap($child)
4727 return
4730 set badcolors {}
4731 set origbad {}
4732 foreach x [findcrossings $id] {
4733 if {$x eq {}} {
4734 # delimiter between corner crossings and other crossings
4735 if {[llength $badcolors] >= $ncolors - 1} break
4736 set origbad $badcolors
4738 if {[info exists colormap($x)]
4739 && [lsearch -exact $badcolors $colormap($x)] < 0} {
4740 lappend badcolors $colormap($x)
4743 if {[llength $badcolors] >= $ncolors} {
4744 set badcolors $origbad
4746 set origbad $badcolors
4747 if {[llength $badcolors] < $ncolors - 1} {
4748 foreach child $kids {
4749 if {[info exists colormap($child)]
4750 && [lsearch -exact $badcolors $colormap($child)] < 0} {
4751 lappend badcolors $colormap($child)
4753 foreach p $parents($curview,$child) {
4754 if {[info exists colormap($p)]
4755 && [lsearch -exact $badcolors $colormap($p)] < 0} {
4756 lappend badcolors $colormap($p)
4760 if {[llength $badcolors] >= $ncolors} {
4761 set badcolors $origbad
4764 for {set i 0} {$i <= $ncolors} {incr i} {
4765 set c [lindex $colors $nextcolor]
4766 if {[incr nextcolor] >= $ncolors} {
4767 set nextcolor 0
4769 if {[lsearch -exact $badcolors $c]} break
4771 set colormap($id) $c
4774 proc bindline {t id} {
4775 global canv
4777 $canv bind $t <Enter> "lineenter %x %y $id"
4778 $canv bind $t <Motion> "linemotion %x %y $id"
4779 $canv bind $t <Leave> "lineleave $id"
4780 $canv bind $t <Button-1> "lineclick %x %y $id 1"
4783 proc drawtags {id x xt y1} {
4784 global idtags idheads idotherrefs mainhead
4785 global linespc lthickness
4786 global canv rowtextx curview fgcolor bgcolor
4788 set marks {}
4789 set ntags 0
4790 set nheads 0
4791 if {[info exists idtags($id)]} {
4792 set marks $idtags($id)
4793 set ntags [llength $marks]
4795 if {[info exists idheads($id)]} {
4796 set marks [concat $marks $idheads($id)]
4797 set nheads [llength $idheads($id)]
4799 if {[info exists idotherrefs($id)]} {
4800 set marks [concat $marks $idotherrefs($id)]
4802 if {$marks eq {}} {
4803 return $xt
4806 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4807 set yt [expr {$y1 - 0.5 * $linespc}]
4808 set yb [expr {$yt + $linespc - 1}]
4809 set xvals {}
4810 set wvals {}
4811 set i -1
4812 foreach tag $marks {
4813 incr i
4814 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4815 set wid [font measure mainfontbold $tag]
4816 } else {
4817 set wid [font measure mainfont $tag]
4819 lappend xvals $xt
4820 lappend wvals $wid
4821 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4823 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4824 -width $lthickness -fill black -tags tag.$id]
4825 $canv lower $t
4826 foreach tag $marks x $xvals wid $wvals {
4827 set xl [expr {$x + $delta}]
4828 set xr [expr {$x + $delta + $wid + $lthickness}]
4829 set font mainfont
4830 if {[incr ntags -1] >= 0} {
4831 # draw a tag
4832 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4833 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4834 -width 1 -outline black -fill yellow -tags tag.$id]
4835 $canv bind $t <1> [list showtag $tag 1]
4836 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4837 } else {
4838 # draw a head or other ref
4839 if {[incr nheads -1] >= 0} {
4840 set col green
4841 if {$tag eq $mainhead} {
4842 set font mainfontbold
4844 } else {
4845 set col "#ddddff"
4847 set xl [expr {$xl - $delta/2}]
4848 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4849 -width 1 -outline black -fill $col -tags tag.$id
4850 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4851 set rwid [font measure mainfont $remoteprefix]
4852 set xi [expr {$x + 1}]
4853 set yti [expr {$yt + 1}]
4854 set xri [expr {$x + $rwid}]
4855 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4856 -width 0 -fill "#ffddaa" -tags tag.$id
4859 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4860 -font $font -tags [list tag.$id text]]
4861 if {$ntags >= 0} {
4862 $canv bind $t <1> [list showtag $tag 1]
4863 } elseif {$nheads >= 0} {
4864 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4867 return $xt
4870 proc xcoord {i level ln} {
4871 global canvx0 xspc1 xspc2
4873 set x [expr {$canvx0 + $i * $xspc1($ln)}]
4874 if {$i > 0 && $i == $level} {
4875 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4876 } elseif {$i > $level} {
4877 set x [expr {$x + $xspc2 - $xspc1($ln)}]
4879 return $x
4882 proc show_status {msg} {
4883 global canv fgcolor
4885 clear_display
4886 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4887 -tags text -fill $fgcolor
4890 # Don't change the text pane cursor if it is currently the hand cursor,
4891 # showing that we are over a sha1 ID link.
4892 proc settextcursor {c} {
4893 global ctext curtextcursor
4895 if {[$ctext cget -cursor] == $curtextcursor} {
4896 $ctext config -cursor $c
4898 set curtextcursor $c
4901 proc nowbusy {what {name {}}} {
4902 global isbusy busyname statusw
4904 if {[array names isbusy] eq {}} {
4905 . config -cursor watch
4906 settextcursor watch
4908 set isbusy($what) 1
4909 set busyname($what) $name
4910 if {$name ne {}} {
4911 $statusw conf -text $name
4915 proc notbusy {what} {
4916 global isbusy maincursor textcursor busyname statusw
4918 catch {
4919 unset isbusy($what)
4920 if {$busyname($what) ne {} &&
4921 [$statusw cget -text] eq $busyname($what)} {
4922 $statusw conf -text {}
4925 if {[array names isbusy] eq {}} {
4926 . config -cursor $maincursor
4927 settextcursor $textcursor
4931 proc findmatches {f} {
4932 global findtype findstring
4933 if {$findtype == [mc "Regexp"]} {
4934 set matches [regexp -indices -all -inline $findstring $f]
4935 } else {
4936 set fs $findstring
4937 if {$findtype == [mc "IgnCase"]} {
4938 set f [string tolower $f]
4939 set fs [string tolower $fs]
4941 set matches {}
4942 set i 0
4943 set l [string length $fs]
4944 while {[set j [string first $fs $f $i]] >= 0} {
4945 lappend matches [list $j [expr {$j+$l-1}]]
4946 set i [expr {$j + $l}]
4949 return $matches
4952 proc dofind {{dirn 1} {wrap 1}} {
4953 global findstring findstartline findcurline selectedline numcommits
4954 global gdttype filehighlight fh_serial find_dirn findallowwrap
4956 if {[info exists find_dirn]} {
4957 if {$find_dirn == $dirn} return
4958 stopfinding
4960 focus .
4961 if {$findstring eq {} || $numcommits == 0} return
4962 if {![info exists selectedline]} {
4963 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4964 } else {
4965 set findstartline $selectedline
4967 set findcurline $findstartline
4968 nowbusy finding [mc "Searching"]
4969 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4970 after cancel do_file_hl $fh_serial
4971 do_file_hl $fh_serial
4973 set find_dirn $dirn
4974 set findallowwrap $wrap
4975 run findmore
4978 proc stopfinding {} {
4979 global find_dirn findcurline fprogcoord
4981 if {[info exists find_dirn]} {
4982 unset find_dirn
4983 unset findcurline
4984 notbusy finding
4985 set fprogcoord 0
4986 adjustprogress
4990 proc findmore {} {
4991 global commitdata commitinfo numcommits findpattern findloc
4992 global findstartline findcurline findallowwrap
4993 global find_dirn gdttype fhighlights fprogcoord
4994 global curview varcorder vrownum varccommits vrowmod
4996 if {![info exists find_dirn]} {
4997 return 0
4999 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5000 set l $findcurline
5001 set moretodo 0
5002 if {$find_dirn > 0} {
5003 incr l
5004 if {$l >= $numcommits} {
5005 set l 0
5007 if {$l <= $findstartline} {
5008 set lim [expr {$findstartline + 1}]
5009 } else {
5010 set lim $numcommits
5011 set moretodo $findallowwrap
5013 } else {
5014 if {$l == 0} {
5015 set l $numcommits
5017 incr l -1
5018 if {$l >= $findstartline} {
5019 set lim [expr {$findstartline - 1}]
5020 } else {
5021 set lim -1
5022 set moretodo $findallowwrap
5025 set n [expr {($lim - $l) * $find_dirn}]
5026 if {$n > 500} {
5027 set n 500
5028 set moretodo 1
5030 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5031 update_arcrows $curview
5033 set found 0
5034 set domore 1
5035 set ai [bsearch $vrownum($curview) $l]
5036 set a [lindex $varcorder($curview) $ai]
5037 set arow [lindex $vrownum($curview) $ai]
5038 set ids [lindex $varccommits($curview,$a)]
5039 set arowend [expr {$arow + [llength $ids]}]
5040 if {$gdttype eq [mc "containing:"]} {
5041 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5042 if {$l < $arow || $l >= $arowend} {
5043 incr ai $find_dirn
5044 set a [lindex $varcorder($curview) $ai]
5045 set arow [lindex $vrownum($curview) $ai]
5046 set ids [lindex $varccommits($curview,$a)]
5047 set arowend [expr {$arow + [llength $ids]}]
5049 set id [lindex $ids [expr {$l - $arow}]]
5050 # shouldn't happen unless git log doesn't give all the commits...
5051 if {![info exists commitdata($id)] ||
5052 ![doesmatch $commitdata($id)]} {
5053 continue
5055 if {![info exists commitinfo($id)]} {
5056 getcommit $id
5058 set info $commitinfo($id)
5059 foreach f $info ty $fldtypes {
5060 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5061 [doesmatch $f]} {
5062 set found 1
5063 break
5066 if {$found} break
5068 } else {
5069 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5070 if {$l < $arow || $l >= $arowend} {
5071 incr ai $find_dirn
5072 set a [lindex $varcorder($curview) $ai]
5073 set arow [lindex $vrownum($curview) $ai]
5074 set ids [lindex $varccommits($curview,$a)]
5075 set arowend [expr {$arow + [llength $ids]}]
5077 set id [lindex $ids [expr {$l - $arow}]]
5078 if {![info exists fhighlights($id)]} {
5079 # this sets fhighlights($id) to -1
5080 askfilehighlight $l $id
5082 if {$fhighlights($id) > 0} {
5083 set found $domore
5084 break
5086 if {$fhighlights($id) < 0} {
5087 if {$domore} {
5088 set domore 0
5089 set findcurline [expr {$l - $find_dirn}]
5094 if {$found || ($domore && !$moretodo)} {
5095 unset findcurline
5096 unset find_dirn
5097 notbusy finding
5098 set fprogcoord 0
5099 adjustprogress
5100 if {$found} {
5101 findselectline $l
5102 } else {
5103 bell
5105 return 0
5107 if {!$domore} {
5108 flushhighlights
5109 } else {
5110 set findcurline [expr {$l - $find_dirn}]
5112 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5113 if {$n < 0} {
5114 incr n $numcommits
5116 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5117 adjustprogress
5118 return $domore
5121 proc findselectline {l} {
5122 global findloc commentend ctext findcurline markingmatches gdttype
5124 set markingmatches 1
5125 set findcurline $l
5126 selectline $l 1
5127 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5128 # highlight the matches in the comments
5129 set f [$ctext get 1.0 $commentend]
5130 set matches [findmatches $f]
5131 foreach match $matches {
5132 set start [lindex $match 0]
5133 set end [expr {[lindex $match 1] + 1}]
5134 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5137 drawvisible
5140 # mark the bits of a headline or author that match a find string
5141 proc markmatches {canv l str tag matches font row} {
5142 global selectedline
5144 set bbox [$canv bbox $tag]
5145 set x0 [lindex $bbox 0]
5146 set y0 [lindex $bbox 1]
5147 set y1 [lindex $bbox 3]
5148 foreach match $matches {
5149 set start [lindex $match 0]
5150 set end [lindex $match 1]
5151 if {$start > $end} continue
5152 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5153 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5154 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5155 [expr {$x0+$xlen+2}] $y1 \
5156 -outline {} -tags [list match$l matches] -fill yellow]
5157 $canv lower $t
5158 if {[info exists selectedline] && $row == $selectedline} {
5159 $canv raise $t secsel
5164 proc unmarkmatches {} {
5165 global markingmatches
5167 allcanvs delete matches
5168 set markingmatches 0
5169 stopfinding
5172 proc selcanvline {w x y} {
5173 global canv canvy0 ctext linespc
5174 global rowtextx
5175 set ymax [lindex [$canv cget -scrollregion] 3]
5176 if {$ymax == {}} return
5177 set yfrac [lindex [$canv yview] 0]
5178 set y [expr {$y + $yfrac * $ymax}]
5179 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5180 if {$l < 0} {
5181 set l 0
5183 if {$w eq $canv} {
5184 set xmax [lindex [$canv cget -scrollregion] 2]
5185 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5186 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5188 unmarkmatches
5189 selectline $l 1
5192 proc commit_descriptor {p} {
5193 global commitinfo
5194 if {![info exists commitinfo($p)]} {
5195 getcommit $p
5197 set l "..."
5198 if {[llength $commitinfo($p)] > 1} {
5199 set l [lindex $commitinfo($p) 0]
5201 return "$p ($l)\n"
5204 # append some text to the ctext widget, and make any SHA1 ID
5205 # that we know about be a clickable link.
5206 proc appendwithlinks {text tags} {
5207 global ctext linknum curview pendinglinks
5209 set start [$ctext index "end - 1c"]
5210 $ctext insert end $text $tags
5211 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5212 foreach l $links {
5213 set s [lindex $l 0]
5214 set e [lindex $l 1]
5215 set linkid [string range $text $s $e]
5216 incr e
5217 $ctext tag delete link$linknum
5218 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5219 setlink $linkid link$linknum
5220 incr linknum
5224 proc setlink {id lk} {
5225 global curview ctext pendinglinks commitinterest
5227 if {[commitinview $id $curview]} {
5228 $ctext tag conf $lk -foreground blue -underline 1
5229 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5230 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5231 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5232 } else {
5233 lappend pendinglinks($id) $lk
5234 lappend commitinterest($id) {makelink %I}
5238 proc makelink {id} {
5239 global pendinglinks
5241 if {![info exists pendinglinks($id)]} return
5242 foreach lk $pendinglinks($id) {
5243 setlink $id $lk
5245 unset pendinglinks($id)
5248 proc linkcursor {w inc} {
5249 global linkentercount curtextcursor
5251 if {[incr linkentercount $inc] > 0} {
5252 $w configure -cursor hand2
5253 } else {
5254 $w configure -cursor $curtextcursor
5255 if {$linkentercount < 0} {
5256 set linkentercount 0
5261 proc viewnextline {dir} {
5262 global canv linespc
5264 $canv delete hover
5265 set ymax [lindex [$canv cget -scrollregion] 3]
5266 set wnow [$canv yview]
5267 set wtop [expr {[lindex $wnow 0] * $ymax}]
5268 set newtop [expr {$wtop + $dir * $linespc}]
5269 if {$newtop < 0} {
5270 set newtop 0
5271 } elseif {$newtop > $ymax} {
5272 set newtop $ymax
5274 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5277 # add a list of tag or branch names at position pos
5278 # returns the number of names inserted
5279 proc appendrefs {pos ids var} {
5280 global ctext linknum curview $var maxrefs
5282 if {[catch {$ctext index $pos}]} {
5283 return 0
5285 $ctext conf -state normal
5286 $ctext delete $pos "$pos lineend"
5287 set tags {}
5288 foreach id $ids {
5289 foreach tag [set $var\($id\)] {
5290 lappend tags [list $tag $id]
5293 if {[llength $tags] > $maxrefs} {
5294 $ctext insert $pos "many ([llength $tags])"
5295 } else {
5296 set tags [lsort -index 0 -decreasing $tags]
5297 set sep {}
5298 foreach ti $tags {
5299 set id [lindex $ti 1]
5300 set lk link$linknum
5301 incr linknum
5302 $ctext tag delete $lk
5303 $ctext insert $pos $sep
5304 $ctext insert $pos [lindex $ti 0] $lk
5305 setlink $id $lk
5306 set sep ", "
5309 $ctext conf -state disabled
5310 return [llength $tags]
5313 # called when we have finished computing the nearby tags
5314 proc dispneartags {delay} {
5315 global selectedline currentid showneartags tagphase
5317 if {![info exists selectedline] || !$showneartags} return
5318 after cancel dispnexttag
5319 if {$delay} {
5320 after 200 dispnexttag
5321 set tagphase -1
5322 } else {
5323 after idle dispnexttag
5324 set tagphase 0
5328 proc dispnexttag {} {
5329 global selectedline currentid showneartags tagphase ctext
5331 if {![info exists selectedline] || !$showneartags} return
5332 switch -- $tagphase {
5334 set dtags [desctags $currentid]
5335 if {$dtags ne {}} {
5336 appendrefs precedes $dtags idtags
5340 set atags [anctags $currentid]
5341 if {$atags ne {}} {
5342 appendrefs follows $atags idtags
5346 set dheads [descheads $currentid]
5347 if {$dheads ne {}} {
5348 if {[appendrefs branch $dheads idheads] > 1
5349 && [$ctext get "branch -3c"] eq "h"} {
5350 # turn "Branch" into "Branches"
5351 $ctext conf -state normal
5352 $ctext insert "branch -2c" "es"
5353 $ctext conf -state disabled
5358 if {[incr tagphase] <= 2} {
5359 after idle dispnexttag
5363 proc make_secsel {l} {
5364 global linehtag linentag linedtag canv canv2 canv3
5366 if {![info exists linehtag($l)]} return
5367 $canv delete secsel
5368 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5369 -tags secsel -fill [$canv cget -selectbackground]]
5370 $canv lower $t
5371 $canv2 delete secsel
5372 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5373 -tags secsel -fill [$canv2 cget -selectbackground]]
5374 $canv2 lower $t
5375 $canv3 delete secsel
5376 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5377 -tags secsel -fill [$canv3 cget -selectbackground]]
5378 $canv3 lower $t
5381 proc selectline {l isnew} {
5382 global canv ctext commitinfo selectedline
5383 global canvy0 linespc parents children curview
5384 global currentid sha1entry
5385 global commentend idtags linknum
5386 global mergemax numcommits pending_select
5387 global cmitmode showneartags allcommits
5388 global targetrow targetid
5390 catch {unset pending_select}
5391 $canv delete hover
5392 normalline
5393 unsel_reflist
5394 stopfinding
5395 if {$l < 0 || $l >= $numcommits} return
5396 set y [expr {$canvy0 + $l * $linespc}]
5397 set ymax [lindex [$canv cget -scrollregion] 3]
5398 set ytop [expr {$y - $linespc - 1}]
5399 set ybot [expr {$y + $linespc + 1}]
5400 set wnow [$canv yview]
5401 set wtop [expr {[lindex $wnow 0] * $ymax}]
5402 set wbot [expr {[lindex $wnow 1] * $ymax}]
5403 set wh [expr {$wbot - $wtop}]
5404 set newtop $wtop
5405 if {$ytop < $wtop} {
5406 if {$ybot < $wtop} {
5407 set newtop [expr {$y - $wh / 2.0}]
5408 } else {
5409 set newtop $ytop
5410 if {$newtop > $wtop - $linespc} {
5411 set newtop [expr {$wtop - $linespc}]
5414 } elseif {$ybot > $wbot} {
5415 if {$ytop > $wbot} {
5416 set newtop [expr {$y - $wh / 2.0}]
5417 } else {
5418 set newtop [expr {$ybot - $wh}]
5419 if {$newtop < $wtop + $linespc} {
5420 set newtop [expr {$wtop + $linespc}]
5424 if {$newtop != $wtop} {
5425 if {$newtop < 0} {
5426 set newtop 0
5428 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5429 drawvisible
5432 make_secsel $l
5434 set id [commitonrow $l]
5435 if {$isnew} {
5436 addtohistory [list selbyid $id]
5439 set selectedline $l
5440 set currentid $id
5441 set targetid $id
5442 set targetrow $l
5443 $sha1entry delete 0 end
5444 $sha1entry insert 0 $id
5445 $sha1entry selection from 0
5446 $sha1entry selection to end
5447 rhighlight_sel $id
5449 $ctext conf -state normal
5450 clear_ctext
5451 set linknum 0
5452 set info $commitinfo($id)
5453 set date [formatdate [lindex $info 2]]
5454 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5455 set date [formatdate [lindex $info 4]]
5456 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5457 if {[info exists idtags($id)]} {
5458 $ctext insert end [mc "Tags:"]
5459 foreach tag $idtags($id) {
5460 $ctext insert end " $tag"
5462 $ctext insert end "\n"
5465 set headers {}
5466 set olds $parents($curview,$id)
5467 if {[llength $olds] > 1} {
5468 set np 0
5469 foreach p $olds {
5470 if {$np >= $mergemax} {
5471 set tag mmax
5472 } else {
5473 set tag m$np
5475 $ctext insert end "[mc "Parent"]: " $tag
5476 appendwithlinks [commit_descriptor $p] {}
5477 incr np
5479 } else {
5480 foreach p $olds {
5481 append headers "[mc "Parent"]: [commit_descriptor $p]"
5485 foreach c $children($curview,$id) {
5486 append headers "[mc "Child"]: [commit_descriptor $c]"
5489 # make anything that looks like a SHA1 ID be a clickable link
5490 appendwithlinks $headers {}
5491 if {$showneartags} {
5492 if {![info exists allcommits]} {
5493 getallcommits
5495 $ctext insert end "[mc "Branch"]: "
5496 $ctext mark set branch "end -1c"
5497 $ctext mark gravity branch left
5498 $ctext insert end "\n[mc "Follows"]: "
5499 $ctext mark set follows "end -1c"
5500 $ctext mark gravity follows left
5501 $ctext insert end "\n[mc "Precedes"]: "
5502 $ctext mark set precedes "end -1c"
5503 $ctext mark gravity precedes left
5504 $ctext insert end "\n"
5505 dispneartags 1
5507 $ctext insert end "\n"
5508 set comment [lindex $info 5]
5509 if {[string first "\r" $comment] >= 0} {
5510 set comment [string map {"\r" "\n "} $comment]
5512 appendwithlinks $comment {comment}
5514 $ctext tag remove found 1.0 end
5515 $ctext conf -state disabled
5516 set commentend [$ctext index "end - 1c"]
5518 init_flist [mc "Comments"]
5519 if {$cmitmode eq "tree"} {
5520 gettree $id
5521 } elseif {[llength $olds] <= 1} {
5522 startdiff $id
5523 } else {
5524 mergediff $id
5528 proc selfirstline {} {
5529 unmarkmatches
5530 selectline 0 1
5533 proc sellastline {} {
5534 global numcommits
5535 unmarkmatches
5536 set l [expr {$numcommits - 1}]
5537 selectline $l 1
5540 proc selnextline {dir} {
5541 global selectedline
5542 focus .
5543 if {![info exists selectedline]} return
5544 set l [expr {$selectedline + $dir}]
5545 unmarkmatches
5546 selectline $l 1
5549 proc selnextpage {dir} {
5550 global canv linespc selectedline numcommits
5552 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5553 if {$lpp < 1} {
5554 set lpp 1
5556 allcanvs yview scroll [expr {$dir * $lpp}] units
5557 drawvisible
5558 if {![info exists selectedline]} return
5559 set l [expr {$selectedline + $dir * $lpp}]
5560 if {$l < 0} {
5561 set l 0
5562 } elseif {$l >= $numcommits} {
5563 set l [expr $numcommits - 1]
5565 unmarkmatches
5566 selectline $l 1
5569 proc unselectline {} {
5570 global selectedline currentid
5572 catch {unset selectedline}
5573 catch {unset currentid}
5574 allcanvs delete secsel
5575 rhighlight_none
5578 proc reselectline {} {
5579 global selectedline
5581 if {[info exists selectedline]} {
5582 selectline $selectedline 0
5586 proc addtohistory {cmd} {
5587 global history historyindex curview
5589 set elt [list $curview $cmd]
5590 if {$historyindex > 0
5591 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5592 return
5595 if {$historyindex < [llength $history]} {
5596 set history [lreplace $history $historyindex end $elt]
5597 } else {
5598 lappend history $elt
5600 incr historyindex
5601 if {$historyindex > 1} {
5602 .tf.bar.leftbut conf -state normal
5603 } else {
5604 .tf.bar.leftbut conf -state disabled
5606 .tf.bar.rightbut conf -state disabled
5609 proc godo {elt} {
5610 global curview
5612 set view [lindex $elt 0]
5613 set cmd [lindex $elt 1]
5614 if {$curview != $view} {
5615 showview $view
5617 eval $cmd
5620 proc goback {} {
5621 global history historyindex
5622 focus .
5624 if {$historyindex > 1} {
5625 incr historyindex -1
5626 godo [lindex $history [expr {$historyindex - 1}]]
5627 .tf.bar.rightbut conf -state normal
5629 if {$historyindex <= 1} {
5630 .tf.bar.leftbut conf -state disabled
5634 proc goforw {} {
5635 global history historyindex
5636 focus .
5638 if {$historyindex < [llength $history]} {
5639 set cmd [lindex $history $historyindex]
5640 incr historyindex
5641 godo $cmd
5642 .tf.bar.leftbut conf -state normal
5644 if {$historyindex >= [llength $history]} {
5645 .tf.bar.rightbut conf -state disabled
5649 proc gettree {id} {
5650 global treefilelist treeidlist diffids diffmergeid treepending
5651 global nullid nullid2
5653 set diffids $id
5654 catch {unset diffmergeid}
5655 if {![info exists treefilelist($id)]} {
5656 if {![info exists treepending]} {
5657 if {$id eq $nullid} {
5658 set cmd [list | git ls-files]
5659 } elseif {$id eq $nullid2} {
5660 set cmd [list | git ls-files --stage -t]
5661 } else {
5662 set cmd [list | git ls-tree -r $id]
5664 if {[catch {set gtf [open $cmd r]}]} {
5665 return
5667 set treepending $id
5668 set treefilelist($id) {}
5669 set treeidlist($id) {}
5670 fconfigure $gtf -blocking 0
5671 filerun $gtf [list gettreeline $gtf $id]
5673 } else {
5674 setfilelist $id
5678 proc gettreeline {gtf id} {
5679 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5681 set nl 0
5682 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5683 if {$diffids eq $nullid} {
5684 set fname $line
5685 } else {
5686 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5687 set i [string first "\t" $line]
5688 if {$i < 0} continue
5689 set sha1 [lindex $line 2]
5690 set fname [string range $line [expr {$i+1}] end]
5691 if {[string index $fname 0] eq "\""} {
5692 set fname [lindex $fname 0]
5694 lappend treeidlist($id) $sha1
5696 lappend treefilelist($id) $fname
5698 if {![eof $gtf]} {
5699 return [expr {$nl >= 1000? 2: 1}]
5701 close $gtf
5702 unset treepending
5703 if {$cmitmode ne "tree"} {
5704 if {![info exists diffmergeid]} {
5705 gettreediffs $diffids
5707 } elseif {$id ne $diffids} {
5708 gettree $diffids
5709 } else {
5710 setfilelist $id
5712 return 0
5715 proc showfile {f} {
5716 global treefilelist treeidlist diffids nullid nullid2
5717 global ctext commentend
5719 set i [lsearch -exact $treefilelist($diffids) $f]
5720 if {$i < 0} {
5721 puts "oops, $f not in list for id $diffids"
5722 return
5724 if {$diffids eq $nullid} {
5725 if {[catch {set bf [open $f r]} err]} {
5726 puts "oops, can't read $f: $err"
5727 return
5729 } else {
5730 set blob [lindex $treeidlist($diffids) $i]
5731 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5732 puts "oops, error reading blob $blob: $err"
5733 return
5736 fconfigure $bf -blocking 0
5737 filerun $bf [list getblobline $bf $diffids]
5738 $ctext config -state normal
5739 clear_ctext $commentend
5740 $ctext insert end "\n"
5741 $ctext insert end "$f\n" filesep
5742 $ctext config -state disabled
5743 $ctext yview $commentend
5744 settabs 0
5747 proc getblobline {bf id} {
5748 global diffids cmitmode ctext
5750 if {$id ne $diffids || $cmitmode ne "tree"} {
5751 catch {close $bf}
5752 return 0
5754 $ctext config -state normal
5755 set nl 0
5756 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5757 $ctext insert end "$line\n"
5759 if {[eof $bf]} {
5760 # delete last newline
5761 $ctext delete "end - 2c" "end - 1c"
5762 close $bf
5763 return 0
5765 $ctext config -state disabled
5766 return [expr {$nl >= 1000? 2: 1}]
5769 proc mergediff {id} {
5770 global diffmergeid mdifffd
5771 global diffids
5772 global parents
5773 global limitdiffs viewfiles curview
5775 set diffmergeid $id
5776 set diffids $id
5777 # this doesn't seem to actually affect anything...
5778 set cmd [concat | git diff-tree --no-commit-id --cc $id]
5779 if {$limitdiffs && $viewfiles($curview) ne {}} {
5780 set cmd [concat $cmd -- $viewfiles($curview)]
5782 if {[catch {set mdf [open $cmd r]} err]} {
5783 error_popup "[mc "Error getting merge diffs:"] $err"
5784 return
5786 fconfigure $mdf -blocking 0
5787 set mdifffd($id) $mdf
5788 set np [llength $parents($curview,$id)]
5789 settabs $np
5790 filerun $mdf [list getmergediffline $mdf $id $np]
5793 proc getmergediffline {mdf id np} {
5794 global diffmergeid ctext cflist mergemax
5795 global difffilestart mdifffd
5797 $ctext conf -state normal
5798 set nr 0
5799 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5800 if {![info exists diffmergeid] || $id != $diffmergeid
5801 || $mdf != $mdifffd($id)} {
5802 close $mdf
5803 return 0
5805 if {[regexp {^diff --cc (.*)} $line match fname]} {
5806 # start of a new file
5807 $ctext insert end "\n"
5808 set here [$ctext index "end - 1c"]
5809 lappend difffilestart $here
5810 add_flist [list $fname]
5811 set l [expr {(78 - [string length $fname]) / 2}]
5812 set pad [string range "----------------------------------------" 1 $l]
5813 $ctext insert end "$pad $fname $pad\n" filesep
5814 } elseif {[regexp {^@@} $line]} {
5815 $ctext insert end "$line\n" hunksep
5816 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5817 # do nothing
5818 } else {
5819 # parse the prefix - one ' ', '-' or '+' for each parent
5820 set spaces {}
5821 set minuses {}
5822 set pluses {}
5823 set isbad 0
5824 for {set j 0} {$j < $np} {incr j} {
5825 set c [string range $line $j $j]
5826 if {$c == " "} {
5827 lappend spaces $j
5828 } elseif {$c == "-"} {
5829 lappend minuses $j
5830 } elseif {$c == "+"} {
5831 lappend pluses $j
5832 } else {
5833 set isbad 1
5834 break
5837 set tags {}
5838 set num {}
5839 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5840 # line doesn't appear in result, parents in $minuses have the line
5841 set num [lindex $minuses 0]
5842 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5843 # line appears in result, parents in $pluses don't have the line
5844 lappend tags mresult
5845 set num [lindex $spaces 0]
5847 if {$num ne {}} {
5848 if {$num >= $mergemax} {
5849 set num "max"
5851 lappend tags m$num
5853 $ctext insert end "$line\n" $tags
5856 $ctext conf -state disabled
5857 if {[eof $mdf]} {
5858 close $mdf
5859 return 0
5861 return [expr {$nr >= 1000? 2: 1}]
5864 proc startdiff {ids} {
5865 global treediffs diffids treepending diffmergeid nullid nullid2
5867 settabs 1
5868 set diffids $ids
5869 catch {unset diffmergeid}
5870 if {![info exists treediffs($ids)] ||
5871 [lsearch -exact $ids $nullid] >= 0 ||
5872 [lsearch -exact $ids $nullid2] >= 0} {
5873 if {![info exists treepending]} {
5874 gettreediffs $ids
5876 } else {
5877 addtocflist $ids
5881 proc path_filter {filter name} {
5882 foreach p $filter {
5883 set l [string length $p]
5884 if {[string index $p end] eq "/"} {
5885 if {[string compare -length $l $p $name] == 0} {
5886 return 1
5888 } else {
5889 if {[string compare -length $l $p $name] == 0 &&
5890 ([string length $name] == $l ||
5891 [string index $name $l] eq "/")} {
5892 return 1
5896 return 0
5899 proc addtocflist {ids} {
5900 global treediffs
5902 add_flist $treediffs($ids)
5903 getblobdiffs $ids
5906 proc diffcmd {ids flags} {
5907 global nullid nullid2
5909 set i [lsearch -exact $ids $nullid]
5910 set j [lsearch -exact $ids $nullid2]
5911 if {$i >= 0} {
5912 if {[llength $ids] > 1 && $j < 0} {
5913 # comparing working directory with some specific revision
5914 set cmd [concat | git diff-index $flags]
5915 if {$i == 0} {
5916 lappend cmd -R [lindex $ids 1]
5917 } else {
5918 lappend cmd [lindex $ids 0]
5920 } else {
5921 # comparing working directory with index
5922 set cmd [concat | git diff-files $flags]
5923 if {$j == 1} {
5924 lappend cmd -R
5927 } elseif {$j >= 0} {
5928 set cmd [concat | git diff-index --cached $flags]
5929 if {[llength $ids] > 1} {
5930 # comparing index with specific revision
5931 if {$i == 0} {
5932 lappend cmd -R [lindex $ids 1]
5933 } else {
5934 lappend cmd [lindex $ids 0]
5936 } else {
5937 # comparing index with HEAD
5938 lappend cmd HEAD
5940 } else {
5941 set cmd [concat | git diff-tree -r $flags $ids]
5943 return $cmd
5946 proc gettreediffs {ids} {
5947 global treediff treepending
5949 set treepending $ids
5950 set treediff {}
5951 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5952 fconfigure $gdtf -blocking 0
5953 filerun $gdtf [list gettreediffline $gdtf $ids]
5956 proc gettreediffline {gdtf ids} {
5957 global treediff treediffs treepending diffids diffmergeid
5958 global cmitmode viewfiles curview limitdiffs
5960 set nr 0
5961 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5962 set i [string first "\t" $line]
5963 if {$i >= 0} {
5964 set file [string range $line [expr {$i+1}] end]
5965 if {[string index $file 0] eq "\""} {
5966 set file [lindex $file 0]
5968 lappend treediff $file
5971 if {![eof $gdtf]} {
5972 return [expr {$nr >= 1000? 2: 1}]
5974 close $gdtf
5975 if {$limitdiffs && $viewfiles($curview) ne {}} {
5976 set flist {}
5977 foreach f $treediff {
5978 if {[path_filter $viewfiles($curview) $f]} {
5979 lappend flist $f
5982 set treediffs($ids) $flist
5983 } else {
5984 set treediffs($ids) $treediff
5986 unset treepending
5987 if {$cmitmode eq "tree"} {
5988 gettree $diffids
5989 } elseif {$ids != $diffids} {
5990 if {![info exists diffmergeid]} {
5991 gettreediffs $diffids
5993 } else {
5994 addtocflist $ids
5996 return 0
5999 # empty string or positive integer
6000 proc diffcontextvalidate {v} {
6001 return [regexp {^(|[1-9][0-9]*)$} $v]
6004 proc diffcontextchange {n1 n2 op} {
6005 global diffcontextstring diffcontext
6007 if {[string is integer -strict $diffcontextstring]} {
6008 if {$diffcontextstring > 0} {
6009 set diffcontext $diffcontextstring
6010 reselectline
6015 proc getblobdiffs {ids} {
6016 global blobdifffd diffids env
6017 global diffinhdr treediffs
6018 global diffcontext
6019 global limitdiffs viewfiles curview
6021 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6022 if {$limitdiffs && $viewfiles($curview) ne {}} {
6023 set cmd [concat $cmd -- $viewfiles($curview)]
6025 if {[catch {set bdf [open $cmd r]} err]} {
6026 puts "error getting diffs: $err"
6027 return
6029 set diffinhdr 0
6030 fconfigure $bdf -blocking 0
6031 set blobdifffd($ids) $bdf
6032 filerun $bdf [list getblobdiffline $bdf $diffids]
6035 proc setinlist {var i val} {
6036 global $var
6038 while {[llength [set $var]] < $i} {
6039 lappend $var {}
6041 if {[llength [set $var]] == $i} {
6042 lappend $var $val
6043 } else {
6044 lset $var $i $val
6048 proc makediffhdr {fname ids} {
6049 global ctext curdiffstart treediffs
6051 set i [lsearch -exact $treediffs($ids) $fname]
6052 if {$i >= 0} {
6053 setinlist difffilestart $i $curdiffstart
6055 set l [expr {(78 - [string length $fname]) / 2}]
6056 set pad [string range "----------------------------------------" 1 $l]
6057 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6060 proc getblobdiffline {bdf ids} {
6061 global diffids blobdifffd ctext curdiffstart
6062 global diffnexthead diffnextnote difffilestart
6063 global diffinhdr treediffs
6065 set nr 0
6066 $ctext conf -state normal
6067 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6068 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6069 close $bdf
6070 return 0
6072 if {![string compare -length 11 "diff --git " $line]} {
6073 # trim off "diff --git "
6074 set line [string range $line 11 end]
6075 set diffinhdr 1
6076 # start of a new file
6077 $ctext insert end "\n"
6078 set curdiffstart [$ctext index "end - 1c"]
6079 $ctext insert end "\n" filesep
6080 # If the name hasn't changed the length will be odd,
6081 # the middle char will be a space, and the two bits either
6082 # side will be a/name and b/name, or "a/name" and "b/name".
6083 # If the name has changed we'll get "rename from" and
6084 # "rename to" or "copy from" and "copy to" lines following this,
6085 # and we'll use them to get the filenames.
6086 # This complexity is necessary because spaces in the filename(s)
6087 # don't get escaped.
6088 set l [string length $line]
6089 set i [expr {$l / 2}]
6090 if {!(($l & 1) && [string index $line $i] eq " " &&
6091 [string range $line 2 [expr {$i - 1}]] eq \
6092 [string range $line [expr {$i + 3}] end])} {
6093 continue
6095 # unescape if quoted and chop off the a/ from the front
6096 if {[string index $line 0] eq "\""} {
6097 set fname [string range [lindex $line 0] 2 end]
6098 } else {
6099 set fname [string range $line 2 [expr {$i - 1}]]
6101 makediffhdr $fname $ids
6103 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6104 $line match f1l f1c f2l f2c rest]} {
6105 $ctext insert end "$line\n" hunksep
6106 set diffinhdr 0
6108 } elseif {$diffinhdr} {
6109 if {![string compare -length 12 "rename from " $line]} {
6110 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6111 if {[string index $fname 0] eq "\""} {
6112 set fname [lindex $fname 0]
6114 set i [lsearch -exact $treediffs($ids) $fname]
6115 if {$i >= 0} {
6116 setinlist difffilestart $i $curdiffstart
6118 } elseif {![string compare -length 10 $line "rename to "] ||
6119 ![string compare -length 8 $line "copy to "]} {
6120 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6121 if {[string index $fname 0] eq "\""} {
6122 set fname [lindex $fname 0]
6124 makediffhdr $fname $ids
6125 } elseif {[string compare -length 3 $line "---"] == 0} {
6126 # do nothing
6127 continue
6128 } elseif {[string compare -length 3 $line "+++"] == 0} {
6129 set diffinhdr 0
6130 continue
6132 $ctext insert end "$line\n" filesep
6134 } else {
6135 set x [string range $line 0 0]
6136 if {$x == "-" || $x == "+"} {
6137 set tag [expr {$x == "+"}]
6138 $ctext insert end "$line\n" d$tag
6139 } elseif {$x == " "} {
6140 $ctext insert end "$line\n"
6141 } else {
6142 # "\ No newline at end of file",
6143 # or something else we don't recognize
6144 $ctext insert end "$line\n" hunksep
6148 $ctext conf -state disabled
6149 if {[eof $bdf]} {
6150 close $bdf
6151 return 0
6153 return [expr {$nr >= 1000? 2: 1}]
6156 proc changediffdisp {} {
6157 global ctext diffelide
6159 $ctext tag conf d0 -elide [lindex $diffelide 0]
6160 $ctext tag conf d1 -elide [lindex $diffelide 1]
6163 proc prevfile {} {
6164 global difffilestart ctext
6165 set prev [lindex $difffilestart 0]
6166 set here [$ctext index @0,0]
6167 foreach loc $difffilestart {
6168 if {[$ctext compare $loc >= $here]} {
6169 $ctext yview $prev
6170 return
6172 set prev $loc
6174 $ctext yview $prev
6177 proc nextfile {} {
6178 global difffilestart ctext
6179 set here [$ctext index @0,0]
6180 foreach loc $difffilestart {
6181 if {[$ctext compare $loc > $here]} {
6182 $ctext yview $loc
6183 return
6188 proc clear_ctext {{first 1.0}} {
6189 global ctext smarktop smarkbot
6190 global pendinglinks
6192 set l [lindex [split $first .] 0]
6193 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6194 set smarktop $l
6196 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6197 set smarkbot $l
6199 $ctext delete $first end
6200 if {$first eq "1.0"} {
6201 catch {unset pendinglinks}
6205 proc settabs {{firstab {}}} {
6206 global firsttabstop tabstop ctext have_tk85
6208 if {$firstab ne {} && $have_tk85} {
6209 set firsttabstop $firstab
6211 set w [font measure textfont "0"]
6212 if {$firsttabstop != 0} {
6213 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6214 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6215 } elseif {$have_tk85 || $tabstop != 8} {
6216 $ctext conf -tabs [expr {$tabstop * $w}]
6217 } else {
6218 $ctext conf -tabs {}
6222 proc incrsearch {name ix op} {
6223 global ctext searchstring searchdirn
6225 $ctext tag remove found 1.0 end
6226 if {[catch {$ctext index anchor}]} {
6227 # no anchor set, use start of selection, or of visible area
6228 set sel [$ctext tag ranges sel]
6229 if {$sel ne {}} {
6230 $ctext mark set anchor [lindex $sel 0]
6231 } elseif {$searchdirn eq "-forwards"} {
6232 $ctext mark set anchor @0,0
6233 } else {
6234 $ctext mark set anchor @0,[winfo height $ctext]
6237 if {$searchstring ne {}} {
6238 set here [$ctext search $searchdirn -- $searchstring anchor]
6239 if {$here ne {}} {
6240 $ctext see $here
6242 searchmarkvisible 1
6246 proc dosearch {} {
6247 global sstring ctext searchstring searchdirn
6249 focus $sstring
6250 $sstring icursor end
6251 set searchdirn -forwards
6252 if {$searchstring ne {}} {
6253 set sel [$ctext tag ranges sel]
6254 if {$sel ne {}} {
6255 set start "[lindex $sel 0] + 1c"
6256 } elseif {[catch {set start [$ctext index anchor]}]} {
6257 set start "@0,0"
6259 set match [$ctext search -count mlen -- $searchstring $start]
6260 $ctext tag remove sel 1.0 end
6261 if {$match eq {}} {
6262 bell
6263 return
6265 $ctext see $match
6266 set mend "$match + $mlen c"
6267 $ctext tag add sel $match $mend
6268 $ctext mark unset anchor
6272 proc dosearchback {} {
6273 global sstring ctext searchstring searchdirn
6275 focus $sstring
6276 $sstring icursor end
6277 set searchdirn -backwards
6278 if {$searchstring ne {}} {
6279 set sel [$ctext tag ranges sel]
6280 if {$sel ne {}} {
6281 set start [lindex $sel 0]
6282 } elseif {[catch {set start [$ctext index anchor]}]} {
6283 set start @0,[winfo height $ctext]
6285 set match [$ctext search -backwards -count ml -- $searchstring $start]
6286 $ctext tag remove sel 1.0 end
6287 if {$match eq {}} {
6288 bell
6289 return
6291 $ctext see $match
6292 set mend "$match + $ml c"
6293 $ctext tag add sel $match $mend
6294 $ctext mark unset anchor
6298 proc searchmark {first last} {
6299 global ctext searchstring
6301 set mend $first.0
6302 while {1} {
6303 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6304 if {$match eq {}} break
6305 set mend "$match + $mlen c"
6306 $ctext tag add found $match $mend
6310 proc searchmarkvisible {doall} {
6311 global ctext smarktop smarkbot
6313 set topline [lindex [split [$ctext index @0,0] .] 0]
6314 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6315 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6316 # no overlap with previous
6317 searchmark $topline $botline
6318 set smarktop $topline
6319 set smarkbot $botline
6320 } else {
6321 if {$topline < $smarktop} {
6322 searchmark $topline [expr {$smarktop-1}]
6323 set smarktop $topline
6325 if {$botline > $smarkbot} {
6326 searchmark [expr {$smarkbot+1}] $botline
6327 set smarkbot $botline
6332 proc scrolltext {f0 f1} {
6333 global searchstring
6335 .bleft.sb set $f0 $f1
6336 if {$searchstring ne {}} {
6337 searchmarkvisible 0
6341 proc setcoords {} {
6342 global linespc charspc canvx0 canvy0
6343 global xspc1 xspc2 lthickness
6345 set linespc [font metrics mainfont -linespace]
6346 set charspc [font measure mainfont "m"]
6347 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6348 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6349 set lthickness [expr {int($linespc / 9) + 1}]
6350 set xspc1(0) $linespc
6351 set xspc2 $linespc
6354 proc redisplay {} {
6355 global canv
6356 global selectedline
6358 set ymax [lindex [$canv cget -scrollregion] 3]
6359 if {$ymax eq {} || $ymax == 0} return
6360 set span [$canv yview]
6361 clear_display
6362 setcanvscroll
6363 allcanvs yview moveto [lindex $span 0]
6364 drawvisible
6365 if {[info exists selectedline]} {
6366 selectline $selectedline 0
6367 allcanvs yview moveto [lindex $span 0]
6371 proc parsefont {f n} {
6372 global fontattr
6374 set fontattr($f,family) [lindex $n 0]
6375 set s [lindex $n 1]
6376 if {$s eq {} || $s == 0} {
6377 set s 10
6378 } elseif {$s < 0} {
6379 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6381 set fontattr($f,size) $s
6382 set fontattr($f,weight) normal
6383 set fontattr($f,slant) roman
6384 foreach style [lrange $n 2 end] {
6385 switch -- $style {
6386 "normal" -
6387 "bold" {set fontattr($f,weight) $style}
6388 "roman" -
6389 "italic" {set fontattr($f,slant) $style}
6394 proc fontflags {f {isbold 0}} {
6395 global fontattr
6397 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6398 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6399 -slant $fontattr($f,slant)]
6402 proc fontname {f} {
6403 global fontattr
6405 set n [list $fontattr($f,family) $fontattr($f,size)]
6406 if {$fontattr($f,weight) eq "bold"} {
6407 lappend n "bold"
6409 if {$fontattr($f,slant) eq "italic"} {
6410 lappend n "italic"
6412 return $n
6415 proc incrfont {inc} {
6416 global mainfont textfont ctext canv cflist showrefstop
6417 global stopped entries fontattr
6419 unmarkmatches
6420 set s $fontattr(mainfont,size)
6421 incr s $inc
6422 if {$s < 1} {
6423 set s 1
6425 set fontattr(mainfont,size) $s
6426 font config mainfont -size $s
6427 font config mainfontbold -size $s
6428 set mainfont [fontname mainfont]
6429 set s $fontattr(textfont,size)
6430 incr s $inc
6431 if {$s < 1} {
6432 set s 1
6434 set fontattr(textfont,size) $s
6435 font config textfont -size $s
6436 font config textfontbold -size $s
6437 set textfont [fontname textfont]
6438 setcoords
6439 settabs
6440 redisplay
6443 proc clearsha1 {} {
6444 global sha1entry sha1string
6445 if {[string length $sha1string] == 40} {
6446 $sha1entry delete 0 end
6450 proc sha1change {n1 n2 op} {
6451 global sha1string currentid sha1but
6452 if {$sha1string == {}
6453 || ([info exists currentid] && $sha1string == $currentid)} {
6454 set state disabled
6455 } else {
6456 set state normal
6458 if {[$sha1but cget -state] == $state} return
6459 if {$state == "normal"} {
6460 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6461 } else {
6462 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6466 proc gotocommit {} {
6467 global sha1string tagids headids curview varcid
6469 if {$sha1string == {}
6470 || ([info exists currentid] && $sha1string == $currentid)} return
6471 if {[info exists tagids($sha1string)]} {
6472 set id $tagids($sha1string)
6473 } elseif {[info exists headids($sha1string)]} {
6474 set id $headids($sha1string)
6475 } else {
6476 set id [string tolower $sha1string]
6477 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6478 set matches [array names varcid "$curview,$id*"]
6479 if {$matches ne {}} {
6480 if {[llength $matches] > 1} {
6481 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6482 return
6484 set id [lindex [split [lindex $matches 0] ","] 1]
6488 if {[commitinview $id $curview]} {
6489 selectline [rowofcommit $id] 1
6490 return
6492 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6493 set msg [mc "SHA1 id %s is not known" $sha1string]
6494 } else {
6495 set msg [mc "Tag/Head %s is not known" $sha1string]
6497 error_popup $msg
6500 proc lineenter {x y id} {
6501 global hoverx hovery hoverid hovertimer
6502 global commitinfo canv
6504 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6505 set hoverx $x
6506 set hovery $y
6507 set hoverid $id
6508 if {[info exists hovertimer]} {
6509 after cancel $hovertimer
6511 set hovertimer [after 500 linehover]
6512 $canv delete hover
6515 proc linemotion {x y id} {
6516 global hoverx hovery hoverid hovertimer
6518 if {[info exists hoverid] && $id == $hoverid} {
6519 set hoverx $x
6520 set hovery $y
6521 if {[info exists hovertimer]} {
6522 after cancel $hovertimer
6524 set hovertimer [after 500 linehover]
6528 proc lineleave {id} {
6529 global hoverid hovertimer canv
6531 if {[info exists hoverid] && $id == $hoverid} {
6532 $canv delete hover
6533 if {[info exists hovertimer]} {
6534 after cancel $hovertimer
6535 unset hovertimer
6537 unset hoverid
6541 proc linehover {} {
6542 global hoverx hovery hoverid hovertimer
6543 global canv linespc lthickness
6544 global commitinfo
6546 set text [lindex $commitinfo($hoverid) 0]
6547 set ymax [lindex [$canv cget -scrollregion] 3]
6548 if {$ymax == {}} return
6549 set yfrac [lindex [$canv yview] 0]
6550 set x [expr {$hoverx + 2 * $linespc}]
6551 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6552 set x0 [expr {$x - 2 * $lthickness}]
6553 set y0 [expr {$y - 2 * $lthickness}]
6554 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6555 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6556 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6557 -fill \#ffff80 -outline black -width 1 -tags hover]
6558 $canv raise $t
6559 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6560 -font mainfont]
6561 $canv raise $t
6564 proc clickisonarrow {id y} {
6565 global lthickness
6567 set ranges [rowranges $id]
6568 set thresh [expr {2 * $lthickness + 6}]
6569 set n [expr {[llength $ranges] - 1}]
6570 for {set i 1} {$i < $n} {incr i} {
6571 set row [lindex $ranges $i]
6572 if {abs([yc $row] - $y) < $thresh} {
6573 return $i
6576 return {}
6579 proc arrowjump {id n y} {
6580 global canv
6582 # 1 <-> 2, 3 <-> 4, etc...
6583 set n [expr {(($n - 1) ^ 1) + 1}]
6584 set row [lindex [rowranges $id] $n]
6585 set yt [yc $row]
6586 set ymax [lindex [$canv cget -scrollregion] 3]
6587 if {$ymax eq {} || $ymax <= 0} return
6588 set view [$canv yview]
6589 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6590 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6591 if {$yfrac < 0} {
6592 set yfrac 0
6594 allcanvs yview moveto $yfrac
6597 proc lineclick {x y id isnew} {
6598 global ctext commitinfo children canv thickerline curview
6600 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6601 unmarkmatches
6602 unselectline
6603 normalline
6604 $canv delete hover
6605 # draw this line thicker than normal
6606 set thickerline $id
6607 drawlines $id
6608 if {$isnew} {
6609 set ymax [lindex [$canv cget -scrollregion] 3]
6610 if {$ymax eq {}} return
6611 set yfrac [lindex [$canv yview] 0]
6612 set y [expr {$y + $yfrac * $ymax}]
6614 set dirn [clickisonarrow $id $y]
6615 if {$dirn ne {}} {
6616 arrowjump $id $dirn $y
6617 return
6620 if {$isnew} {
6621 addtohistory [list lineclick $x $y $id 0]
6623 # fill the details pane with info about this line
6624 $ctext conf -state normal
6625 clear_ctext
6626 settabs 0
6627 $ctext insert end "[mc "Parent"]:\t"
6628 $ctext insert end $id link0
6629 setlink $id link0
6630 set info $commitinfo($id)
6631 $ctext insert end "\n\t[lindex $info 0]\n"
6632 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6633 set date [formatdate [lindex $info 2]]
6634 $ctext insert end "\t[mc "Date"]:\t$date\n"
6635 set kids $children($curview,$id)
6636 if {$kids ne {}} {
6637 $ctext insert end "\n[mc "Children"]:"
6638 set i 0
6639 foreach child $kids {
6640 incr i
6641 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6642 set info $commitinfo($child)
6643 $ctext insert end "\n\t"
6644 $ctext insert end $child link$i
6645 setlink $child link$i
6646 $ctext insert end "\n\t[lindex $info 0]"
6647 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6648 set date [formatdate [lindex $info 2]]
6649 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6652 $ctext conf -state disabled
6653 init_flist {}
6656 proc normalline {} {
6657 global thickerline
6658 if {[info exists thickerline]} {
6659 set id $thickerline
6660 unset thickerline
6661 drawlines $id
6665 proc selbyid {id} {
6666 global curview
6667 if {[commitinview $id $curview]} {
6668 selectline [rowofcommit $id] 1
6672 proc mstime {} {
6673 global startmstime
6674 if {![info exists startmstime]} {
6675 set startmstime [clock clicks -milliseconds]
6677 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6680 proc rowmenu {x y id} {
6681 global rowctxmenu selectedline rowmenuid curview
6682 global nullid nullid2 fakerowmenu mainhead
6684 stopfinding
6685 set rowmenuid $id
6686 if {![info exists selectedline]
6687 || [rowofcommit $id] eq $selectedline} {
6688 set state disabled
6689 } else {
6690 set state normal
6692 if {$id ne $nullid && $id ne $nullid2} {
6693 set menu $rowctxmenu
6694 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6695 } else {
6696 set menu $fakerowmenu
6698 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6699 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6700 $menu entryconfigure [mc "Make patch"] -state $state
6701 tk_popup $menu $x $y
6704 proc diffvssel {dirn} {
6705 global rowmenuid selectedline
6707 if {![info exists selectedline]} return
6708 if {$dirn} {
6709 set oldid [commitonrow $selectedline]
6710 set newid $rowmenuid
6711 } else {
6712 set oldid $rowmenuid
6713 set newid [commitonrow $selectedline]
6715 addtohistory [list doseldiff $oldid $newid]
6716 doseldiff $oldid $newid
6719 proc doseldiff {oldid newid} {
6720 global ctext
6721 global commitinfo
6723 $ctext conf -state normal
6724 clear_ctext
6725 init_flist [mc "Top"]
6726 $ctext insert end "[mc "From"] "
6727 $ctext insert end $oldid link0
6728 setlink $oldid link0
6729 $ctext insert end "\n "
6730 $ctext insert end [lindex $commitinfo($oldid) 0]
6731 $ctext insert end "\n\n[mc "To"] "
6732 $ctext insert end $newid link1
6733 setlink $newid link1
6734 $ctext insert end "\n "
6735 $ctext insert end [lindex $commitinfo($newid) 0]
6736 $ctext insert end "\n"
6737 $ctext conf -state disabled
6738 $ctext tag remove found 1.0 end
6739 startdiff [list $oldid $newid]
6742 proc mkpatch {} {
6743 global rowmenuid currentid commitinfo patchtop patchnum
6745 if {![info exists currentid]} return
6746 set oldid $currentid
6747 set oldhead [lindex $commitinfo($oldid) 0]
6748 set newid $rowmenuid
6749 set newhead [lindex $commitinfo($newid) 0]
6750 set top .patch
6751 set patchtop $top
6752 catch {destroy $top}
6753 toplevel $top
6754 label $top.title -text [mc "Generate patch"]
6755 grid $top.title - -pady 10
6756 label $top.from -text [mc "From:"]
6757 entry $top.fromsha1 -width 40 -relief flat
6758 $top.fromsha1 insert 0 $oldid
6759 $top.fromsha1 conf -state readonly
6760 grid $top.from $top.fromsha1 -sticky w
6761 entry $top.fromhead -width 60 -relief flat
6762 $top.fromhead insert 0 $oldhead
6763 $top.fromhead conf -state readonly
6764 grid x $top.fromhead -sticky w
6765 label $top.to -text [mc "To:"]
6766 entry $top.tosha1 -width 40 -relief flat
6767 $top.tosha1 insert 0 $newid
6768 $top.tosha1 conf -state readonly
6769 grid $top.to $top.tosha1 -sticky w
6770 entry $top.tohead -width 60 -relief flat
6771 $top.tohead insert 0 $newhead
6772 $top.tohead conf -state readonly
6773 grid x $top.tohead -sticky w
6774 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6775 grid $top.rev x -pady 10
6776 label $top.flab -text [mc "Output file:"]
6777 entry $top.fname -width 60
6778 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6779 incr patchnum
6780 grid $top.flab $top.fname -sticky w
6781 frame $top.buts
6782 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6783 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6784 grid $top.buts.gen $top.buts.can
6785 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6786 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6787 grid $top.buts - -pady 10 -sticky ew
6788 focus $top.fname
6791 proc mkpatchrev {} {
6792 global patchtop
6794 set oldid [$patchtop.fromsha1 get]
6795 set oldhead [$patchtop.fromhead get]
6796 set newid [$patchtop.tosha1 get]
6797 set newhead [$patchtop.tohead get]
6798 foreach e [list fromsha1 fromhead tosha1 tohead] \
6799 v [list $newid $newhead $oldid $oldhead] {
6800 $patchtop.$e conf -state normal
6801 $patchtop.$e delete 0 end
6802 $patchtop.$e insert 0 $v
6803 $patchtop.$e conf -state readonly
6807 proc mkpatchgo {} {
6808 global patchtop nullid nullid2
6810 set oldid [$patchtop.fromsha1 get]
6811 set newid [$patchtop.tosha1 get]
6812 set fname [$patchtop.fname get]
6813 set cmd [diffcmd [list $oldid $newid] -p]
6814 # trim off the initial "|"
6815 set cmd [lrange $cmd 1 end]
6816 lappend cmd >$fname &
6817 if {[catch {eval exec $cmd} err]} {
6818 error_popup "[mc "Error creating patch:"] $err"
6820 catch {destroy $patchtop}
6821 unset patchtop
6824 proc mkpatchcan {} {
6825 global patchtop
6827 catch {destroy $patchtop}
6828 unset patchtop
6831 proc mktag {} {
6832 global rowmenuid mktagtop commitinfo
6834 set top .maketag
6835 set mktagtop $top
6836 catch {destroy $top}
6837 toplevel $top
6838 label $top.title -text [mc "Create tag"]
6839 grid $top.title - -pady 10
6840 label $top.id -text [mc "ID:"]
6841 entry $top.sha1 -width 40 -relief flat
6842 $top.sha1 insert 0 $rowmenuid
6843 $top.sha1 conf -state readonly
6844 grid $top.id $top.sha1 -sticky w
6845 entry $top.head -width 60 -relief flat
6846 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6847 $top.head conf -state readonly
6848 grid x $top.head -sticky w
6849 label $top.tlab -text [mc "Tag name:"]
6850 entry $top.tag -width 60
6851 grid $top.tlab $top.tag -sticky w
6852 frame $top.buts
6853 button $top.buts.gen -text [mc "Create"] -command mktaggo
6854 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6855 grid $top.buts.gen $top.buts.can
6856 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6857 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6858 grid $top.buts - -pady 10 -sticky ew
6859 focus $top.tag
6862 proc domktag {} {
6863 global mktagtop env tagids idtags
6865 set id [$mktagtop.sha1 get]
6866 set tag [$mktagtop.tag get]
6867 if {$tag == {}} {
6868 error_popup [mc "No tag name specified"]
6869 return
6871 if {[info exists tagids($tag)]} {
6872 error_popup [mc "Tag \"%s\" already exists" $tag]
6873 return
6875 if {[catch {
6876 set dir [gitdir]
6877 set fname [file join $dir "refs/tags" $tag]
6878 set f [open $fname w]
6879 puts $f $id
6880 close $f
6881 } err]} {
6882 error_popup "[mc "Error creating tag:"] $err"
6883 return
6886 set tagids($tag) $id
6887 lappend idtags($id) $tag
6888 redrawtags $id
6889 addedtag $id
6890 dispneartags 0
6891 run refill_reflist
6894 proc redrawtags {id} {
6895 global canv linehtag idpos currentid curview
6896 global canvxmax iddrawn
6898 if {![commitinview $id $curview]} return
6899 if {![info exists iddrawn($id)]} return
6900 set row [rowofcommit $id]
6901 $canv delete tag.$id
6902 set xt [eval drawtags $id $idpos($id)]
6903 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6904 set text [$canv itemcget $linehtag($row) -text]
6905 set font [$canv itemcget $linehtag($row) -font]
6906 set xr [expr {$xt + [font measure $font $text]}]
6907 if {$xr > $canvxmax} {
6908 set canvxmax $xr
6909 setcanvscroll
6911 if {[info exists currentid] && $currentid == $id} {
6912 make_secsel $row
6916 proc mktagcan {} {
6917 global mktagtop
6919 catch {destroy $mktagtop}
6920 unset mktagtop
6923 proc mktaggo {} {
6924 domktag
6925 mktagcan
6928 proc writecommit {} {
6929 global rowmenuid wrcomtop commitinfo wrcomcmd
6931 set top .writecommit
6932 set wrcomtop $top
6933 catch {destroy $top}
6934 toplevel $top
6935 label $top.title -text [mc "Write commit to file"]
6936 grid $top.title - -pady 10
6937 label $top.id -text [mc "ID:"]
6938 entry $top.sha1 -width 40 -relief flat
6939 $top.sha1 insert 0 $rowmenuid
6940 $top.sha1 conf -state readonly
6941 grid $top.id $top.sha1 -sticky w
6942 entry $top.head -width 60 -relief flat
6943 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6944 $top.head conf -state readonly
6945 grid x $top.head -sticky w
6946 label $top.clab -text [mc "Command:"]
6947 entry $top.cmd -width 60 -textvariable wrcomcmd
6948 grid $top.clab $top.cmd -sticky w -pady 10
6949 label $top.flab -text [mc "Output file:"]
6950 entry $top.fname -width 60
6951 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6952 grid $top.flab $top.fname -sticky w
6953 frame $top.buts
6954 button $top.buts.gen -text [mc "Write"] -command wrcomgo
6955 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6956 grid $top.buts.gen $top.buts.can
6957 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6958 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6959 grid $top.buts - -pady 10 -sticky ew
6960 focus $top.fname
6963 proc wrcomgo {} {
6964 global wrcomtop
6966 set id [$wrcomtop.sha1 get]
6967 set cmd "echo $id | [$wrcomtop.cmd get]"
6968 set fname [$wrcomtop.fname get]
6969 if {[catch {exec sh -c $cmd >$fname &} err]} {
6970 error_popup "[mc "Error writing commit:"] $err"
6972 catch {destroy $wrcomtop}
6973 unset wrcomtop
6976 proc wrcomcan {} {
6977 global wrcomtop
6979 catch {destroy $wrcomtop}
6980 unset wrcomtop
6983 proc mkbranch {} {
6984 global rowmenuid mkbrtop
6986 set top .makebranch
6987 catch {destroy $top}
6988 toplevel $top
6989 label $top.title -text [mc "Create new branch"]
6990 grid $top.title - -pady 10
6991 label $top.id -text [mc "ID:"]
6992 entry $top.sha1 -width 40 -relief flat
6993 $top.sha1 insert 0 $rowmenuid
6994 $top.sha1 conf -state readonly
6995 grid $top.id $top.sha1 -sticky w
6996 label $top.nlab -text [mc "Name:"]
6997 entry $top.name -width 40
6998 grid $top.nlab $top.name -sticky w
6999 frame $top.buts
7000 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7001 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7002 grid $top.buts.go $top.buts.can
7003 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7004 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7005 grid $top.buts - -pady 10 -sticky ew
7006 focus $top.name
7009 proc mkbrgo {top} {
7010 global headids idheads
7012 set name [$top.name get]
7013 set id [$top.sha1 get]
7014 if {$name eq {}} {
7015 error_popup [mc "Please specify a name for the new branch"]
7016 return
7018 catch {destroy $top}
7019 nowbusy newbranch
7020 update
7021 if {[catch {
7022 exec git branch $name $id
7023 } err]} {
7024 notbusy newbranch
7025 error_popup $err
7026 } else {
7027 set headids($name) $id
7028 lappend idheads($id) $name
7029 addedhead $id $name
7030 notbusy newbranch
7031 redrawtags $id
7032 dispneartags 0
7033 run refill_reflist
7037 proc cherrypick {} {
7038 global rowmenuid curview
7039 global mainhead mainheadid
7041 set oldhead [exec git rev-parse HEAD]
7042 set dheads [descheads $rowmenuid]
7043 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7044 set ok [confirm_popup [mc "Commit %s is already\
7045 included in branch %s -- really re-apply it?" \
7046 [string range $rowmenuid 0 7] $mainhead]]
7047 if {!$ok} return
7049 nowbusy cherrypick [mc "Cherry-picking"]
7050 update
7051 # Unfortunately git-cherry-pick writes stuff to stderr even when
7052 # no error occurs, and exec takes that as an indication of error...
7053 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7054 notbusy cherrypick
7055 error_popup $err
7056 return
7058 set newhead [exec git rev-parse HEAD]
7059 if {$newhead eq $oldhead} {
7060 notbusy cherrypick
7061 error_popup [mc "No changes committed"]
7062 return
7064 addnewchild $newhead $oldhead
7065 if {[commitinview $oldhead $curview]} {
7066 insertrow $newhead $oldhead $curview
7067 if {$mainhead ne {}} {
7068 movehead $newhead $mainhead
7069 movedhead $newhead $mainhead
7070 set mainheadid $newhead
7072 redrawtags $oldhead
7073 redrawtags $newhead
7074 selbyid $newhead
7076 notbusy cherrypick
7079 proc resethead {} {
7080 global mainhead rowmenuid confirm_ok resettype
7082 set confirm_ok 0
7083 set w ".confirmreset"
7084 toplevel $w
7085 wm transient $w .
7086 wm title $w [mc "Confirm reset"]
7087 message $w.m -text \
7088 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7089 -justify center -aspect 1000
7090 pack $w.m -side top -fill x -padx 20 -pady 20
7091 frame $w.f -relief sunken -border 2
7092 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7093 grid $w.f.rt -sticky w
7094 set resettype mixed
7095 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7096 -text [mc "Soft: Leave working tree and index untouched"]
7097 grid $w.f.soft -sticky w
7098 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7099 -text [mc "Mixed: Leave working tree untouched, reset index"]
7100 grid $w.f.mixed -sticky w
7101 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7102 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7103 grid $w.f.hard -sticky w
7104 pack $w.f -side top -fill x
7105 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7106 pack $w.ok -side left -fill x -padx 20 -pady 20
7107 button $w.cancel -text [mc Cancel] -command "destroy $w"
7108 pack $w.cancel -side right -fill x -padx 20 -pady 20
7109 bind $w <Visibility> "grab $w; focus $w"
7110 tkwait window $w
7111 if {!$confirm_ok} return
7112 if {[catch {set fd [open \
7113 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7114 error_popup $err
7115 } else {
7116 dohidelocalchanges
7117 filerun $fd [list readresetstat $fd]
7118 nowbusy reset [mc "Resetting"]
7119 selbyid $rowmenuid
7123 proc readresetstat {fd} {
7124 global mainhead mainheadid showlocalchanges rprogcoord
7126 if {[gets $fd line] >= 0} {
7127 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7128 set rprogcoord [expr {1.0 * $m / $n}]
7129 adjustprogress
7131 return 1
7133 set rprogcoord 0
7134 adjustprogress
7135 notbusy reset
7136 if {[catch {close $fd} err]} {
7137 error_popup $err
7139 set oldhead $mainheadid
7140 set newhead [exec git rev-parse HEAD]
7141 if {$newhead ne $oldhead} {
7142 movehead $newhead $mainhead
7143 movedhead $newhead $mainhead
7144 set mainheadid $newhead
7145 redrawtags $oldhead
7146 redrawtags $newhead
7148 if {$showlocalchanges} {
7149 doshowlocalchanges
7151 return 0
7154 # context menu for a head
7155 proc headmenu {x y id head} {
7156 global headmenuid headmenuhead headctxmenu mainhead
7158 stopfinding
7159 set headmenuid $id
7160 set headmenuhead $head
7161 set state normal
7162 if {$head eq $mainhead} {
7163 set state disabled
7165 $headctxmenu entryconfigure 0 -state $state
7166 $headctxmenu entryconfigure 1 -state $state
7167 tk_popup $headctxmenu $x $y
7170 proc cobranch {} {
7171 global headmenuid headmenuhead mainhead headids
7172 global showlocalchanges mainheadid
7174 # check the tree is clean first??
7175 set oldmainhead $mainhead
7176 nowbusy checkout [mc "Checking out"]
7177 update
7178 dohidelocalchanges
7179 if {[catch {
7180 exec git checkout -q $headmenuhead
7181 } err]} {
7182 notbusy checkout
7183 error_popup $err
7184 } else {
7185 notbusy checkout
7186 set mainhead $headmenuhead
7187 set mainheadid $headmenuid
7188 if {[info exists headids($oldmainhead)]} {
7189 redrawtags $headids($oldmainhead)
7191 redrawtags $headmenuid
7192 selbyid $headmenuid
7194 if {$showlocalchanges} {
7195 dodiffindex
7199 proc rmbranch {} {
7200 global headmenuid headmenuhead mainhead
7201 global idheads
7203 set head $headmenuhead
7204 set id $headmenuid
7205 # this check shouldn't be needed any more...
7206 if {$head eq $mainhead} {
7207 error_popup [mc "Cannot delete the currently checked-out branch"]
7208 return
7210 set dheads [descheads $id]
7211 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7212 # the stuff on this branch isn't on any other branch
7213 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7214 branch.\nReally delete branch %s?" $head $head]]} return
7216 nowbusy rmbranch
7217 update
7218 if {[catch {exec git branch -D $head} err]} {
7219 notbusy rmbranch
7220 error_popup $err
7221 return
7223 removehead $id $head
7224 removedhead $id $head
7225 redrawtags $id
7226 notbusy rmbranch
7227 dispneartags 0
7228 run refill_reflist
7231 # Display a list of tags and heads
7232 proc showrefs {} {
7233 global showrefstop bgcolor fgcolor selectbgcolor
7234 global bglist fglist reflistfilter reflist maincursor
7236 set top .showrefs
7237 set showrefstop $top
7238 if {[winfo exists $top]} {
7239 raise $top
7240 refill_reflist
7241 return
7243 toplevel $top
7244 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7245 text $top.list -background $bgcolor -foreground $fgcolor \
7246 -selectbackground $selectbgcolor -font mainfont \
7247 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7248 -width 30 -height 20 -cursor $maincursor \
7249 -spacing1 1 -spacing3 1 -state disabled
7250 $top.list tag configure highlight -background $selectbgcolor
7251 lappend bglist $top.list
7252 lappend fglist $top.list
7253 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7254 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7255 grid $top.list $top.ysb -sticky nsew
7256 grid $top.xsb x -sticky ew
7257 frame $top.f
7258 label $top.f.l -text "[mc "Filter"]: "
7259 entry $top.f.e -width 20 -textvariable reflistfilter
7260 set reflistfilter "*"
7261 trace add variable reflistfilter write reflistfilter_change
7262 pack $top.f.e -side right -fill x -expand 1
7263 pack $top.f.l -side left
7264 grid $top.f - -sticky ew -pady 2
7265 button $top.close -command [list destroy $top] -text [mc "Close"]
7266 grid $top.close -
7267 grid columnconfigure $top 0 -weight 1
7268 grid rowconfigure $top 0 -weight 1
7269 bind $top.list <1> {break}
7270 bind $top.list <B1-Motion> {break}
7271 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7272 set reflist {}
7273 refill_reflist
7276 proc sel_reflist {w x y} {
7277 global showrefstop reflist headids tagids otherrefids
7279 if {![winfo exists $showrefstop]} return
7280 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7281 set ref [lindex $reflist [expr {$l-1}]]
7282 set n [lindex $ref 0]
7283 switch -- [lindex $ref 1] {
7284 "H" {selbyid $headids($n)}
7285 "T" {selbyid $tagids($n)}
7286 "o" {selbyid $otherrefids($n)}
7288 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7291 proc unsel_reflist {} {
7292 global showrefstop
7294 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7295 $showrefstop.list tag remove highlight 0.0 end
7298 proc reflistfilter_change {n1 n2 op} {
7299 global reflistfilter
7301 after cancel refill_reflist
7302 after 200 refill_reflist
7305 proc refill_reflist {} {
7306 global reflist reflistfilter showrefstop headids tagids otherrefids
7307 global curview commitinterest
7309 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7310 set refs {}
7311 foreach n [array names headids] {
7312 if {[string match $reflistfilter $n]} {
7313 if {[commitinview $headids($n) $curview]} {
7314 lappend refs [list $n H]
7315 } else {
7316 set commitinterest($headids($n)) {run refill_reflist}
7320 foreach n [array names tagids] {
7321 if {[string match $reflistfilter $n]} {
7322 if {[commitinview $tagids($n) $curview]} {
7323 lappend refs [list $n T]
7324 } else {
7325 set commitinterest($tagids($n)) {run refill_reflist}
7329 foreach n [array names otherrefids] {
7330 if {[string match $reflistfilter $n]} {
7331 if {[commitinview $otherrefids($n) $curview]} {
7332 lappend refs [list $n o]
7333 } else {
7334 set commitinterest($otherrefids($n)) {run refill_reflist}
7338 set refs [lsort -index 0 $refs]
7339 if {$refs eq $reflist} return
7341 # Update the contents of $showrefstop.list according to the
7342 # differences between $reflist (old) and $refs (new)
7343 $showrefstop.list conf -state normal
7344 $showrefstop.list insert end "\n"
7345 set i 0
7346 set j 0
7347 while {$i < [llength $reflist] || $j < [llength $refs]} {
7348 if {$i < [llength $reflist]} {
7349 if {$j < [llength $refs]} {
7350 set cmp [string compare [lindex $reflist $i 0] \
7351 [lindex $refs $j 0]]
7352 if {$cmp == 0} {
7353 set cmp [string compare [lindex $reflist $i 1] \
7354 [lindex $refs $j 1]]
7356 } else {
7357 set cmp -1
7359 } else {
7360 set cmp 1
7362 switch -- $cmp {
7363 -1 {
7364 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7365 incr i
7368 incr i
7369 incr j
7372 set l [expr {$j + 1}]
7373 $showrefstop.list image create $l.0 -align baseline \
7374 -image reficon-[lindex $refs $j 1] -padx 2
7375 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7376 incr j
7380 set reflist $refs
7381 # delete last newline
7382 $showrefstop.list delete end-2c end-1c
7383 $showrefstop.list conf -state disabled
7386 # Stuff for finding nearby tags
7387 proc getallcommits {} {
7388 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7389 global idheads idtags idotherrefs allparents tagobjid
7391 if {![info exists allcommits]} {
7392 set nextarc 0
7393 set allcommits 0
7394 set seeds {}
7395 set allcwait 0
7396 set cachedarcs 0
7397 set allccache [file join [gitdir] "gitk.cache"]
7398 if {![catch {
7399 set f [open $allccache r]
7400 set allcwait 1
7401 getcache $f
7402 }]} return
7405 if {$allcwait} {
7406 return
7408 set cmd [list | git rev-list --parents]
7409 set allcupdate [expr {$seeds ne {}}]
7410 if {!$allcupdate} {
7411 set ids "--all"
7412 } else {
7413 set refs [concat [array names idheads] [array names idtags] \
7414 [array names idotherrefs]]
7415 set ids {}
7416 set tagobjs {}
7417 foreach name [array names tagobjid] {
7418 lappend tagobjs $tagobjid($name)
7420 foreach id [lsort -unique $refs] {
7421 if {![info exists allparents($id)] &&
7422 [lsearch -exact $tagobjs $id] < 0} {
7423 lappend ids $id
7426 if {$ids ne {}} {
7427 foreach id $seeds {
7428 lappend ids "^$id"
7432 if {$ids ne {}} {
7433 set fd [open [concat $cmd $ids] r]
7434 fconfigure $fd -blocking 0
7435 incr allcommits
7436 nowbusy allcommits
7437 filerun $fd [list getallclines $fd]
7438 } else {
7439 dispneartags 0
7443 # Since most commits have 1 parent and 1 child, we group strings of
7444 # such commits into "arcs" joining branch/merge points (BMPs), which
7445 # are commits that either don't have 1 parent or don't have 1 child.
7447 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7448 # arcout(id) - outgoing arcs for BMP
7449 # arcids(a) - list of IDs on arc including end but not start
7450 # arcstart(a) - BMP ID at start of arc
7451 # arcend(a) - BMP ID at end of arc
7452 # growing(a) - arc a is still growing
7453 # arctags(a) - IDs out of arcids (excluding end) that have tags
7454 # archeads(a) - IDs out of arcids (excluding end) that have heads
7455 # The start of an arc is at the descendent end, so "incoming" means
7456 # coming from descendents, and "outgoing" means going towards ancestors.
7458 proc getallclines {fd} {
7459 global allparents allchildren idtags idheads nextarc
7460 global arcnos arcids arctags arcout arcend arcstart archeads growing
7461 global seeds allcommits cachedarcs allcupdate
7463 set nid 0
7464 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7465 set id [lindex $line 0]
7466 if {[info exists allparents($id)]} {
7467 # seen it already
7468 continue
7470 set cachedarcs 0
7471 set olds [lrange $line 1 end]
7472 set allparents($id) $olds
7473 if {![info exists allchildren($id)]} {
7474 set allchildren($id) {}
7475 set arcnos($id) {}
7476 lappend seeds $id
7477 } else {
7478 set a $arcnos($id)
7479 if {[llength $olds] == 1 && [llength $a] == 1} {
7480 lappend arcids($a) $id
7481 if {[info exists idtags($id)]} {
7482 lappend arctags($a) $id
7484 if {[info exists idheads($id)]} {
7485 lappend archeads($a) $id
7487 if {[info exists allparents($olds)]} {
7488 # seen parent already
7489 if {![info exists arcout($olds)]} {
7490 splitarc $olds
7492 lappend arcids($a) $olds
7493 set arcend($a) $olds
7494 unset growing($a)
7496 lappend allchildren($olds) $id
7497 lappend arcnos($olds) $a
7498 continue
7501 foreach a $arcnos($id) {
7502 lappend arcids($a) $id
7503 set arcend($a) $id
7504 unset growing($a)
7507 set ao {}
7508 foreach p $olds {
7509 lappend allchildren($p) $id
7510 set a [incr nextarc]
7511 set arcstart($a) $id
7512 set archeads($a) {}
7513 set arctags($a) {}
7514 set archeads($a) {}
7515 set arcids($a) {}
7516 lappend ao $a
7517 set growing($a) 1
7518 if {[info exists allparents($p)]} {
7519 # seen it already, may need to make a new branch
7520 if {![info exists arcout($p)]} {
7521 splitarc $p
7523 lappend arcids($a) $p
7524 set arcend($a) $p
7525 unset growing($a)
7527 lappend arcnos($p) $a
7529 set arcout($id) $ao
7531 if {$nid > 0} {
7532 global cached_dheads cached_dtags cached_atags
7533 catch {unset cached_dheads}
7534 catch {unset cached_dtags}
7535 catch {unset cached_atags}
7537 if {![eof $fd]} {
7538 return [expr {$nid >= 1000? 2: 1}]
7540 set cacheok 1
7541 if {[catch {
7542 fconfigure $fd -blocking 1
7543 close $fd
7544 } err]} {
7545 # got an error reading the list of commits
7546 # if we were updating, try rereading the whole thing again
7547 if {$allcupdate} {
7548 incr allcommits -1
7549 dropcache $err
7550 return
7552 error_popup "[mc "Error reading commit topology information;\
7553 branch and preceding/following tag information\
7554 will be incomplete."]\n($err)"
7555 set cacheok 0
7557 if {[incr allcommits -1] == 0} {
7558 notbusy allcommits
7559 if {$cacheok} {
7560 run savecache
7563 dispneartags 0
7564 return 0
7567 proc recalcarc {a} {
7568 global arctags archeads arcids idtags idheads
7570 set at {}
7571 set ah {}
7572 foreach id [lrange $arcids($a) 0 end-1] {
7573 if {[info exists idtags($id)]} {
7574 lappend at $id
7576 if {[info exists idheads($id)]} {
7577 lappend ah $id
7580 set arctags($a) $at
7581 set archeads($a) $ah
7584 proc splitarc {p} {
7585 global arcnos arcids nextarc arctags archeads idtags idheads
7586 global arcstart arcend arcout allparents growing
7588 set a $arcnos($p)
7589 if {[llength $a] != 1} {
7590 puts "oops splitarc called but [llength $a] arcs already"
7591 return
7593 set a [lindex $a 0]
7594 set i [lsearch -exact $arcids($a) $p]
7595 if {$i < 0} {
7596 puts "oops splitarc $p not in arc $a"
7597 return
7599 set na [incr nextarc]
7600 if {[info exists arcend($a)]} {
7601 set arcend($na) $arcend($a)
7602 } else {
7603 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7604 set j [lsearch -exact $arcnos($l) $a]
7605 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7607 set tail [lrange $arcids($a) [expr {$i+1}] end]
7608 set arcids($a) [lrange $arcids($a) 0 $i]
7609 set arcend($a) $p
7610 set arcstart($na) $p
7611 set arcout($p) $na
7612 set arcids($na) $tail
7613 if {[info exists growing($a)]} {
7614 set growing($na) 1
7615 unset growing($a)
7618 foreach id $tail {
7619 if {[llength $arcnos($id)] == 1} {
7620 set arcnos($id) $na
7621 } else {
7622 set j [lsearch -exact $arcnos($id) $a]
7623 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7627 # reconstruct tags and heads lists
7628 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7629 recalcarc $a
7630 recalcarc $na
7631 } else {
7632 set arctags($na) {}
7633 set archeads($na) {}
7637 # Update things for a new commit added that is a child of one
7638 # existing commit. Used when cherry-picking.
7639 proc addnewchild {id p} {
7640 global allparents allchildren idtags nextarc
7641 global arcnos arcids arctags arcout arcend arcstart archeads growing
7642 global seeds allcommits
7644 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7645 set allparents($id) [list $p]
7646 set allchildren($id) {}
7647 set arcnos($id) {}
7648 lappend seeds $id
7649 lappend allchildren($p) $id
7650 set a [incr nextarc]
7651 set arcstart($a) $id
7652 set archeads($a) {}
7653 set arctags($a) {}
7654 set arcids($a) [list $p]
7655 set arcend($a) $p
7656 if {![info exists arcout($p)]} {
7657 splitarc $p
7659 lappend arcnos($p) $a
7660 set arcout($id) [list $a]
7663 # This implements a cache for the topology information.
7664 # The cache saves, for each arc, the start and end of the arc,
7665 # the ids on the arc, and the outgoing arcs from the end.
7666 proc readcache {f} {
7667 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7668 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7669 global allcwait
7671 set a $nextarc
7672 set lim $cachedarcs
7673 if {$lim - $a > 500} {
7674 set lim [expr {$a + 500}]
7676 if {[catch {
7677 if {$a == $lim} {
7678 # finish reading the cache and setting up arctags, etc.
7679 set line [gets $f]
7680 if {$line ne "1"} {error "bad final version"}
7681 close $f
7682 foreach id [array names idtags] {
7683 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7684 [llength $allparents($id)] == 1} {
7685 set a [lindex $arcnos($id) 0]
7686 if {$arctags($a) eq {}} {
7687 recalcarc $a
7691 foreach id [array names idheads] {
7692 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7693 [llength $allparents($id)] == 1} {
7694 set a [lindex $arcnos($id) 0]
7695 if {$archeads($a) eq {}} {
7696 recalcarc $a
7700 foreach id [lsort -unique $possible_seeds] {
7701 if {$arcnos($id) eq {}} {
7702 lappend seeds $id
7705 set allcwait 0
7706 } else {
7707 while {[incr a] <= $lim} {
7708 set line [gets $f]
7709 if {[llength $line] != 3} {error "bad line"}
7710 set s [lindex $line 0]
7711 set arcstart($a) $s
7712 lappend arcout($s) $a
7713 if {![info exists arcnos($s)]} {
7714 lappend possible_seeds $s
7715 set arcnos($s) {}
7717 set e [lindex $line 1]
7718 if {$e eq {}} {
7719 set growing($a) 1
7720 } else {
7721 set arcend($a) $e
7722 if {![info exists arcout($e)]} {
7723 set arcout($e) {}
7726 set arcids($a) [lindex $line 2]
7727 foreach id $arcids($a) {
7728 lappend allparents($s) $id
7729 set s $id
7730 lappend arcnos($id) $a
7732 if {![info exists allparents($s)]} {
7733 set allparents($s) {}
7735 set arctags($a) {}
7736 set archeads($a) {}
7738 set nextarc [expr {$a - 1}]
7740 } err]} {
7741 dropcache $err
7742 return 0
7744 if {!$allcwait} {
7745 getallcommits
7747 return $allcwait
7750 proc getcache {f} {
7751 global nextarc cachedarcs possible_seeds
7753 if {[catch {
7754 set line [gets $f]
7755 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7756 # make sure it's an integer
7757 set cachedarcs [expr {int([lindex $line 1])}]
7758 if {$cachedarcs < 0} {error "bad number of arcs"}
7759 set nextarc 0
7760 set possible_seeds {}
7761 run readcache $f
7762 } err]} {
7763 dropcache $err
7765 return 0
7768 proc dropcache {err} {
7769 global allcwait nextarc cachedarcs seeds
7771 #puts "dropping cache ($err)"
7772 foreach v {arcnos arcout arcids arcstart arcend growing \
7773 arctags archeads allparents allchildren} {
7774 global $v
7775 catch {unset $v}
7777 set allcwait 0
7778 set nextarc 0
7779 set cachedarcs 0
7780 set seeds {}
7781 getallcommits
7784 proc writecache {f} {
7785 global cachearc cachedarcs allccache
7786 global arcstart arcend arcnos arcids arcout
7788 set a $cachearc
7789 set lim $cachedarcs
7790 if {$lim - $a > 1000} {
7791 set lim [expr {$a + 1000}]
7793 if {[catch {
7794 while {[incr a] <= $lim} {
7795 if {[info exists arcend($a)]} {
7796 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7797 } else {
7798 puts $f [list $arcstart($a) {} $arcids($a)]
7801 } err]} {
7802 catch {close $f}
7803 catch {file delete $allccache}
7804 #puts "writing cache failed ($err)"
7805 return 0
7807 set cachearc [expr {$a - 1}]
7808 if {$a > $cachedarcs} {
7809 puts $f "1"
7810 close $f
7811 return 0
7813 return 1
7816 proc savecache {} {
7817 global nextarc cachedarcs cachearc allccache
7819 if {$nextarc == $cachedarcs} return
7820 set cachearc 0
7821 set cachedarcs $nextarc
7822 catch {
7823 set f [open $allccache w]
7824 puts $f [list 1 $cachedarcs]
7825 run writecache $f
7829 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7830 # or 0 if neither is true.
7831 proc anc_or_desc {a b} {
7832 global arcout arcstart arcend arcnos cached_isanc
7834 if {$arcnos($a) eq $arcnos($b)} {
7835 # Both are on the same arc(s); either both are the same BMP,
7836 # or if one is not a BMP, the other is also not a BMP or is
7837 # the BMP at end of the arc (and it only has 1 incoming arc).
7838 # Or both can be BMPs with no incoming arcs.
7839 if {$a eq $b || $arcnos($a) eq {}} {
7840 return 0
7842 # assert {[llength $arcnos($a)] == 1}
7843 set arc [lindex $arcnos($a) 0]
7844 set i [lsearch -exact $arcids($arc) $a]
7845 set j [lsearch -exact $arcids($arc) $b]
7846 if {$i < 0 || $i > $j} {
7847 return 1
7848 } else {
7849 return -1
7853 if {![info exists arcout($a)]} {
7854 set arc [lindex $arcnos($a) 0]
7855 if {[info exists arcend($arc)]} {
7856 set aend $arcend($arc)
7857 } else {
7858 set aend {}
7860 set a $arcstart($arc)
7861 } else {
7862 set aend $a
7864 if {![info exists arcout($b)]} {
7865 set arc [lindex $arcnos($b) 0]
7866 if {[info exists arcend($arc)]} {
7867 set bend $arcend($arc)
7868 } else {
7869 set bend {}
7871 set b $arcstart($arc)
7872 } else {
7873 set bend $b
7875 if {$a eq $bend} {
7876 return 1
7878 if {$b eq $aend} {
7879 return -1
7881 if {[info exists cached_isanc($a,$bend)]} {
7882 if {$cached_isanc($a,$bend)} {
7883 return 1
7886 if {[info exists cached_isanc($b,$aend)]} {
7887 if {$cached_isanc($b,$aend)} {
7888 return -1
7890 if {[info exists cached_isanc($a,$bend)]} {
7891 return 0
7895 set todo [list $a $b]
7896 set anc($a) a
7897 set anc($b) b
7898 for {set i 0} {$i < [llength $todo]} {incr i} {
7899 set x [lindex $todo $i]
7900 if {$anc($x) eq {}} {
7901 continue
7903 foreach arc $arcnos($x) {
7904 set xd $arcstart($arc)
7905 if {$xd eq $bend} {
7906 set cached_isanc($a,$bend) 1
7907 set cached_isanc($b,$aend) 0
7908 return 1
7909 } elseif {$xd eq $aend} {
7910 set cached_isanc($b,$aend) 1
7911 set cached_isanc($a,$bend) 0
7912 return -1
7914 if {![info exists anc($xd)]} {
7915 set anc($xd) $anc($x)
7916 lappend todo $xd
7917 } elseif {$anc($xd) ne $anc($x)} {
7918 set anc($xd) {}
7922 set cached_isanc($a,$bend) 0
7923 set cached_isanc($b,$aend) 0
7924 return 0
7927 # This identifies whether $desc has an ancestor that is
7928 # a growing tip of the graph and which is not an ancestor of $anc
7929 # and returns 0 if so and 1 if not.
7930 # If we subsequently discover a tag on such a growing tip, and that
7931 # turns out to be a descendent of $anc (which it could, since we
7932 # don't necessarily see children before parents), then $desc
7933 # isn't a good choice to display as a descendent tag of
7934 # $anc (since it is the descendent of another tag which is
7935 # a descendent of $anc). Similarly, $anc isn't a good choice to
7936 # display as a ancestor tag of $desc.
7938 proc is_certain {desc anc} {
7939 global arcnos arcout arcstart arcend growing problems
7941 set certain {}
7942 if {[llength $arcnos($anc)] == 1} {
7943 # tags on the same arc are certain
7944 if {$arcnos($desc) eq $arcnos($anc)} {
7945 return 1
7947 if {![info exists arcout($anc)]} {
7948 # if $anc is partway along an arc, use the start of the arc instead
7949 set a [lindex $arcnos($anc) 0]
7950 set anc $arcstart($a)
7953 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7954 set x $desc
7955 } else {
7956 set a [lindex $arcnos($desc) 0]
7957 set x $arcend($a)
7959 if {$x == $anc} {
7960 return 1
7962 set anclist [list $x]
7963 set dl($x) 1
7964 set nnh 1
7965 set ngrowanc 0
7966 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7967 set x [lindex $anclist $i]
7968 if {$dl($x)} {
7969 incr nnh -1
7971 set done($x) 1
7972 foreach a $arcout($x) {
7973 if {[info exists growing($a)]} {
7974 if {![info exists growanc($x)] && $dl($x)} {
7975 set growanc($x) 1
7976 incr ngrowanc
7978 } else {
7979 set y $arcend($a)
7980 if {[info exists dl($y)]} {
7981 if {$dl($y)} {
7982 if {!$dl($x)} {
7983 set dl($y) 0
7984 if {![info exists done($y)]} {
7985 incr nnh -1
7987 if {[info exists growanc($x)]} {
7988 incr ngrowanc -1
7990 set xl [list $y]
7991 for {set k 0} {$k < [llength $xl]} {incr k} {
7992 set z [lindex $xl $k]
7993 foreach c $arcout($z) {
7994 if {[info exists arcend($c)]} {
7995 set v $arcend($c)
7996 if {[info exists dl($v)] && $dl($v)} {
7997 set dl($v) 0
7998 if {![info exists done($v)]} {
7999 incr nnh -1
8001 if {[info exists growanc($v)]} {
8002 incr ngrowanc -1
8004 lappend xl $v
8011 } elseif {$y eq $anc || !$dl($x)} {
8012 set dl($y) 0
8013 lappend anclist $y
8014 } else {
8015 set dl($y) 1
8016 lappend anclist $y
8017 incr nnh
8022 foreach x [array names growanc] {
8023 if {$dl($x)} {
8024 return 0
8026 return 0
8028 return 1
8031 proc validate_arctags {a} {
8032 global arctags idtags
8034 set i -1
8035 set na $arctags($a)
8036 foreach id $arctags($a) {
8037 incr i
8038 if {![info exists idtags($id)]} {
8039 set na [lreplace $na $i $i]
8040 incr i -1
8043 set arctags($a) $na
8046 proc validate_archeads {a} {
8047 global archeads idheads
8049 set i -1
8050 set na $archeads($a)
8051 foreach id $archeads($a) {
8052 incr i
8053 if {![info exists idheads($id)]} {
8054 set na [lreplace $na $i $i]
8055 incr i -1
8058 set archeads($a) $na
8061 # Return the list of IDs that have tags that are descendents of id,
8062 # ignoring IDs that are descendents of IDs already reported.
8063 proc desctags {id} {
8064 global arcnos arcstart arcids arctags idtags allparents
8065 global growing cached_dtags
8067 if {![info exists allparents($id)]} {
8068 return {}
8070 set t1 [clock clicks -milliseconds]
8071 set argid $id
8072 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8073 # part-way along an arc; check that arc first
8074 set a [lindex $arcnos($id) 0]
8075 if {$arctags($a) ne {}} {
8076 validate_arctags $a
8077 set i [lsearch -exact $arcids($a) $id]
8078 set tid {}
8079 foreach t $arctags($a) {
8080 set j [lsearch -exact $arcids($a) $t]
8081 if {$j >= $i} break
8082 set tid $t
8084 if {$tid ne {}} {
8085 return $tid
8088 set id $arcstart($a)
8089 if {[info exists idtags($id)]} {
8090 return $id
8093 if {[info exists cached_dtags($id)]} {
8094 return $cached_dtags($id)
8097 set origid $id
8098 set todo [list $id]
8099 set queued($id) 1
8100 set nc 1
8101 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8102 set id [lindex $todo $i]
8103 set done($id) 1
8104 set ta [info exists hastaggedancestor($id)]
8105 if {!$ta} {
8106 incr nc -1
8108 # ignore tags on starting node
8109 if {!$ta && $i > 0} {
8110 if {[info exists idtags($id)]} {
8111 set tagloc($id) $id
8112 set ta 1
8113 } elseif {[info exists cached_dtags($id)]} {
8114 set tagloc($id) $cached_dtags($id)
8115 set ta 1
8118 foreach a $arcnos($id) {
8119 set d $arcstart($a)
8120 if {!$ta && $arctags($a) ne {}} {
8121 validate_arctags $a
8122 if {$arctags($a) ne {}} {
8123 lappend tagloc($id) [lindex $arctags($a) end]
8126 if {$ta || $arctags($a) ne {}} {
8127 set tomark [list $d]
8128 for {set j 0} {$j < [llength $tomark]} {incr j} {
8129 set dd [lindex $tomark $j]
8130 if {![info exists hastaggedancestor($dd)]} {
8131 if {[info exists done($dd)]} {
8132 foreach b $arcnos($dd) {
8133 lappend tomark $arcstart($b)
8135 if {[info exists tagloc($dd)]} {
8136 unset tagloc($dd)
8138 } elseif {[info exists queued($dd)]} {
8139 incr nc -1
8141 set hastaggedancestor($dd) 1
8145 if {![info exists queued($d)]} {
8146 lappend todo $d
8147 set queued($d) 1
8148 if {![info exists hastaggedancestor($d)]} {
8149 incr nc
8154 set tags {}
8155 foreach id [array names tagloc] {
8156 if {![info exists hastaggedancestor($id)]} {
8157 foreach t $tagloc($id) {
8158 if {[lsearch -exact $tags $t] < 0} {
8159 lappend tags $t
8164 set t2 [clock clicks -milliseconds]
8165 set loopix $i
8167 # remove tags that are descendents of other tags
8168 for {set i 0} {$i < [llength $tags]} {incr i} {
8169 set a [lindex $tags $i]
8170 for {set j 0} {$j < $i} {incr j} {
8171 set b [lindex $tags $j]
8172 set r [anc_or_desc $a $b]
8173 if {$r == 1} {
8174 set tags [lreplace $tags $j $j]
8175 incr j -1
8176 incr i -1
8177 } elseif {$r == -1} {
8178 set tags [lreplace $tags $i $i]
8179 incr i -1
8180 break
8185 if {[array names growing] ne {}} {
8186 # graph isn't finished, need to check if any tag could get
8187 # eclipsed by another tag coming later. Simply ignore any
8188 # tags that could later get eclipsed.
8189 set ctags {}
8190 foreach t $tags {
8191 if {[is_certain $t $origid]} {
8192 lappend ctags $t
8195 if {$tags eq $ctags} {
8196 set cached_dtags($origid) $tags
8197 } else {
8198 set tags $ctags
8200 } else {
8201 set cached_dtags($origid) $tags
8203 set t3 [clock clicks -milliseconds]
8204 if {0 && $t3 - $t1 >= 100} {
8205 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8206 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8208 return $tags
8211 proc anctags {id} {
8212 global arcnos arcids arcout arcend arctags idtags allparents
8213 global growing cached_atags
8215 if {![info exists allparents($id)]} {
8216 return {}
8218 set t1 [clock clicks -milliseconds]
8219 set argid $id
8220 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8221 # part-way along an arc; check that arc first
8222 set a [lindex $arcnos($id) 0]
8223 if {$arctags($a) ne {}} {
8224 validate_arctags $a
8225 set i [lsearch -exact $arcids($a) $id]
8226 foreach t $arctags($a) {
8227 set j [lsearch -exact $arcids($a) $t]
8228 if {$j > $i} {
8229 return $t
8233 if {![info exists arcend($a)]} {
8234 return {}
8236 set id $arcend($a)
8237 if {[info exists idtags($id)]} {
8238 return $id
8241 if {[info exists cached_atags($id)]} {
8242 return $cached_atags($id)
8245 set origid $id
8246 set todo [list $id]
8247 set queued($id) 1
8248 set taglist {}
8249 set nc 1
8250 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8251 set id [lindex $todo $i]
8252 set done($id) 1
8253 set td [info exists hastaggeddescendent($id)]
8254 if {!$td} {
8255 incr nc -1
8257 # ignore tags on starting node
8258 if {!$td && $i > 0} {
8259 if {[info exists idtags($id)]} {
8260 set tagloc($id) $id
8261 set td 1
8262 } elseif {[info exists cached_atags($id)]} {
8263 set tagloc($id) $cached_atags($id)
8264 set td 1
8267 foreach a $arcout($id) {
8268 if {!$td && $arctags($a) ne {}} {
8269 validate_arctags $a
8270 if {$arctags($a) ne {}} {
8271 lappend tagloc($id) [lindex $arctags($a) 0]
8274 if {![info exists arcend($a)]} continue
8275 set d $arcend($a)
8276 if {$td || $arctags($a) ne {}} {
8277 set tomark [list $d]
8278 for {set j 0} {$j < [llength $tomark]} {incr j} {
8279 set dd [lindex $tomark $j]
8280 if {![info exists hastaggeddescendent($dd)]} {
8281 if {[info exists done($dd)]} {
8282 foreach b $arcout($dd) {
8283 if {[info exists arcend($b)]} {
8284 lappend tomark $arcend($b)
8287 if {[info exists tagloc($dd)]} {
8288 unset tagloc($dd)
8290 } elseif {[info exists queued($dd)]} {
8291 incr nc -1
8293 set hastaggeddescendent($dd) 1
8297 if {![info exists queued($d)]} {
8298 lappend todo $d
8299 set queued($d) 1
8300 if {![info exists hastaggeddescendent($d)]} {
8301 incr nc
8306 set t2 [clock clicks -milliseconds]
8307 set loopix $i
8308 set tags {}
8309 foreach id [array names tagloc] {
8310 if {![info exists hastaggeddescendent($id)]} {
8311 foreach t $tagloc($id) {
8312 if {[lsearch -exact $tags $t] < 0} {
8313 lappend tags $t
8319 # remove tags that are ancestors of other tags
8320 for {set i 0} {$i < [llength $tags]} {incr i} {
8321 set a [lindex $tags $i]
8322 for {set j 0} {$j < $i} {incr j} {
8323 set b [lindex $tags $j]
8324 set r [anc_or_desc $a $b]
8325 if {$r == -1} {
8326 set tags [lreplace $tags $j $j]
8327 incr j -1
8328 incr i -1
8329 } elseif {$r == 1} {
8330 set tags [lreplace $tags $i $i]
8331 incr i -1
8332 break
8337 if {[array names growing] ne {}} {
8338 # graph isn't finished, need to check if any tag could get
8339 # eclipsed by another tag coming later. Simply ignore any
8340 # tags that could later get eclipsed.
8341 set ctags {}
8342 foreach t $tags {
8343 if {[is_certain $origid $t]} {
8344 lappend ctags $t
8347 if {$tags eq $ctags} {
8348 set cached_atags($origid) $tags
8349 } else {
8350 set tags $ctags
8352 } else {
8353 set cached_atags($origid) $tags
8355 set t3 [clock clicks -milliseconds]
8356 if {0 && $t3 - $t1 >= 100} {
8357 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8358 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8360 return $tags
8363 # Return the list of IDs that have heads that are descendents of id,
8364 # including id itself if it has a head.
8365 proc descheads {id} {
8366 global arcnos arcstart arcids archeads idheads cached_dheads
8367 global allparents
8369 if {![info exists allparents($id)]} {
8370 return {}
8372 set aret {}
8373 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8374 # part-way along an arc; check it first
8375 set a [lindex $arcnos($id) 0]
8376 if {$archeads($a) ne {}} {
8377 validate_archeads $a
8378 set i [lsearch -exact $arcids($a) $id]
8379 foreach t $archeads($a) {
8380 set j [lsearch -exact $arcids($a) $t]
8381 if {$j > $i} break
8382 lappend aret $t
8385 set id $arcstart($a)
8387 set origid $id
8388 set todo [list $id]
8389 set seen($id) 1
8390 set ret {}
8391 for {set i 0} {$i < [llength $todo]} {incr i} {
8392 set id [lindex $todo $i]
8393 if {[info exists cached_dheads($id)]} {
8394 set ret [concat $ret $cached_dheads($id)]
8395 } else {
8396 if {[info exists idheads($id)]} {
8397 lappend ret $id
8399 foreach a $arcnos($id) {
8400 if {$archeads($a) ne {}} {
8401 validate_archeads $a
8402 if {$archeads($a) ne {}} {
8403 set ret [concat $ret $archeads($a)]
8406 set d $arcstart($a)
8407 if {![info exists seen($d)]} {
8408 lappend todo $d
8409 set seen($d) 1
8414 set ret [lsort -unique $ret]
8415 set cached_dheads($origid) $ret
8416 return [concat $ret $aret]
8419 proc addedtag {id} {
8420 global arcnos arcout cached_dtags cached_atags
8422 if {![info exists arcnos($id)]} return
8423 if {![info exists arcout($id)]} {
8424 recalcarc [lindex $arcnos($id) 0]
8426 catch {unset cached_dtags}
8427 catch {unset cached_atags}
8430 proc addedhead {hid head} {
8431 global arcnos arcout cached_dheads
8433 if {![info exists arcnos($hid)]} return
8434 if {![info exists arcout($hid)]} {
8435 recalcarc [lindex $arcnos($hid) 0]
8437 catch {unset cached_dheads}
8440 proc removedhead {hid head} {
8441 global cached_dheads
8443 catch {unset cached_dheads}
8446 proc movedhead {hid head} {
8447 global arcnos arcout cached_dheads
8449 if {![info exists arcnos($hid)]} return
8450 if {![info exists arcout($hid)]} {
8451 recalcarc [lindex $arcnos($hid) 0]
8453 catch {unset cached_dheads}
8456 proc changedrefs {} {
8457 global cached_dheads cached_dtags cached_atags
8458 global arctags archeads arcnos arcout idheads idtags
8460 foreach id [concat [array names idheads] [array names idtags]] {
8461 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8462 set a [lindex $arcnos($id) 0]
8463 if {![info exists donearc($a)]} {
8464 recalcarc $a
8465 set donearc($a) 1
8469 catch {unset cached_dtags}
8470 catch {unset cached_atags}
8471 catch {unset cached_dheads}
8474 proc rereadrefs {} {
8475 global idtags idheads idotherrefs mainheadid
8477 set refids [concat [array names idtags] \
8478 [array names idheads] [array names idotherrefs]]
8479 foreach id $refids {
8480 if {![info exists ref($id)]} {
8481 set ref($id) [listrefs $id]
8484 set oldmainhead $mainheadid
8485 readrefs
8486 changedrefs
8487 set refids [lsort -unique [concat $refids [array names idtags] \
8488 [array names idheads] [array names idotherrefs]]]
8489 foreach id $refids {
8490 set v [listrefs $id]
8491 if {![info exists ref($id)] || $ref($id) != $v ||
8492 ($id eq $oldmainhead && $id ne $mainheadid) ||
8493 ($id eq $mainheadid && $id ne $oldmainhead)} {
8494 redrawtags $id
8497 run refill_reflist
8500 proc listrefs {id} {
8501 global idtags idheads idotherrefs
8503 set x {}
8504 if {[info exists idtags($id)]} {
8505 set x $idtags($id)
8507 set y {}
8508 if {[info exists idheads($id)]} {
8509 set y $idheads($id)
8511 set z {}
8512 if {[info exists idotherrefs($id)]} {
8513 set z $idotherrefs($id)
8515 return [list $x $y $z]
8518 proc showtag {tag isnew} {
8519 global ctext tagcontents tagids linknum tagobjid
8521 if {$isnew} {
8522 addtohistory [list showtag $tag 0]
8524 $ctext conf -state normal
8525 clear_ctext
8526 settabs 0
8527 set linknum 0
8528 if {![info exists tagcontents($tag)]} {
8529 catch {
8530 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8533 if {[info exists tagcontents($tag)]} {
8534 set text $tagcontents($tag)
8535 } else {
8536 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8538 appendwithlinks $text {}
8539 $ctext conf -state disabled
8540 init_flist {}
8543 proc doquit {} {
8544 global stopped
8545 set stopped 100
8546 savestuff .
8547 destroy .
8550 proc mkfontdisp {font top which} {
8551 global fontattr fontpref $font
8553 set fontpref($font) [set $font]
8554 button $top.${font}but -text $which -font optionfont \
8555 -command [list choosefont $font $which]
8556 label $top.$font -relief flat -font $font \
8557 -text $fontattr($font,family) -justify left
8558 grid x $top.${font}but $top.$font -sticky w
8561 proc choosefont {font which} {
8562 global fontparam fontlist fonttop fontattr
8564 set fontparam(which) $which
8565 set fontparam(font) $font
8566 set fontparam(family) [font actual $font -family]
8567 set fontparam(size) $fontattr($font,size)
8568 set fontparam(weight) $fontattr($font,weight)
8569 set fontparam(slant) $fontattr($font,slant)
8570 set top .gitkfont
8571 set fonttop $top
8572 if {![winfo exists $top]} {
8573 font create sample
8574 eval font config sample [font actual $font]
8575 toplevel $top
8576 wm title $top [mc "Gitk font chooser"]
8577 label $top.l -textvariable fontparam(which)
8578 pack $top.l -side top
8579 set fontlist [lsort [font families]]
8580 frame $top.f
8581 listbox $top.f.fam -listvariable fontlist \
8582 -yscrollcommand [list $top.f.sb set]
8583 bind $top.f.fam <<ListboxSelect>> selfontfam
8584 scrollbar $top.f.sb -command [list $top.f.fam yview]
8585 pack $top.f.sb -side right -fill y
8586 pack $top.f.fam -side left -fill both -expand 1
8587 pack $top.f -side top -fill both -expand 1
8588 frame $top.g
8589 spinbox $top.g.size -from 4 -to 40 -width 4 \
8590 -textvariable fontparam(size) \
8591 -validatecommand {string is integer -strict %s}
8592 checkbutton $top.g.bold -padx 5 \
8593 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8594 -variable fontparam(weight) -onvalue bold -offvalue normal
8595 checkbutton $top.g.ital -padx 5 \
8596 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8597 -variable fontparam(slant) -onvalue italic -offvalue roman
8598 pack $top.g.size $top.g.bold $top.g.ital -side left
8599 pack $top.g -side top
8600 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8601 -background white
8602 $top.c create text 100 25 -anchor center -text $which -font sample \
8603 -fill black -tags text
8604 bind $top.c <Configure> [list centertext $top.c]
8605 pack $top.c -side top -fill x
8606 frame $top.buts
8607 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8608 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8609 grid $top.buts.ok $top.buts.can
8610 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8611 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8612 pack $top.buts -side bottom -fill x
8613 trace add variable fontparam write chg_fontparam
8614 } else {
8615 raise $top
8616 $top.c itemconf text -text $which
8618 set i [lsearch -exact $fontlist $fontparam(family)]
8619 if {$i >= 0} {
8620 $top.f.fam selection set $i
8621 $top.f.fam see $i
8625 proc centertext {w} {
8626 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8629 proc fontok {} {
8630 global fontparam fontpref prefstop
8632 set f $fontparam(font)
8633 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8634 if {$fontparam(weight) eq "bold"} {
8635 lappend fontpref($f) "bold"
8637 if {$fontparam(slant) eq "italic"} {
8638 lappend fontpref($f) "italic"
8640 set w $prefstop.$f
8641 $w conf -text $fontparam(family) -font $fontpref($f)
8643 fontcan
8646 proc fontcan {} {
8647 global fonttop fontparam
8649 if {[info exists fonttop]} {
8650 catch {destroy $fonttop}
8651 catch {font delete sample}
8652 unset fonttop
8653 unset fontparam
8657 proc selfontfam {} {
8658 global fonttop fontparam
8660 set i [$fonttop.f.fam curselection]
8661 if {$i ne {}} {
8662 set fontparam(family) [$fonttop.f.fam get $i]
8666 proc chg_fontparam {v sub op} {
8667 global fontparam
8669 font config sample -$sub $fontparam($sub)
8672 proc doprefs {} {
8673 global maxwidth maxgraphpct
8674 global oldprefs prefstop showneartags showlocalchanges
8675 global bgcolor fgcolor ctext diffcolors selectbgcolor
8676 global tabstop limitdiffs
8678 set top .gitkprefs
8679 set prefstop $top
8680 if {[winfo exists $top]} {
8681 raise $top
8682 return
8684 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8685 limitdiffs tabstop} {
8686 set oldprefs($v) [set $v]
8688 toplevel $top
8689 wm title $top [mc "Gitk preferences"]
8690 label $top.ldisp -text [mc "Commit list display options"]
8691 grid $top.ldisp - -sticky w -pady 10
8692 label $top.spacer -text " "
8693 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8694 -font optionfont
8695 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8696 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8697 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8698 -font optionfont
8699 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8700 grid x $top.maxpctl $top.maxpct -sticky w
8701 frame $top.showlocal
8702 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8703 checkbutton $top.showlocal.b -variable showlocalchanges
8704 pack $top.showlocal.b $top.showlocal.l -side left
8705 grid x $top.showlocal -sticky w
8707 label $top.ddisp -text [mc "Diff display options"]
8708 grid $top.ddisp - -sticky w -pady 10
8709 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8710 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8711 grid x $top.tabstopl $top.tabstop -sticky w
8712 frame $top.ntag
8713 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8714 checkbutton $top.ntag.b -variable showneartags
8715 pack $top.ntag.b $top.ntag.l -side left
8716 grid x $top.ntag -sticky w
8717 frame $top.ldiff
8718 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8719 checkbutton $top.ldiff.b -variable limitdiffs
8720 pack $top.ldiff.b $top.ldiff.l -side left
8721 grid x $top.ldiff -sticky w
8723 label $top.cdisp -text [mc "Colors: press to choose"]
8724 grid $top.cdisp - -sticky w -pady 10
8725 label $top.bg -padx 40 -relief sunk -background $bgcolor
8726 button $top.bgbut -text [mc "Background"] -font optionfont \
8727 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8728 grid x $top.bgbut $top.bg -sticky w
8729 label $top.fg -padx 40 -relief sunk -background $fgcolor
8730 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8731 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8732 grid x $top.fgbut $top.fg -sticky w
8733 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8734 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8735 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8736 [list $ctext tag conf d0 -foreground]]
8737 grid x $top.diffoldbut $top.diffold -sticky w
8738 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8739 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8740 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8741 [list $ctext tag conf d1 -foreground]]
8742 grid x $top.diffnewbut $top.diffnew -sticky w
8743 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8744 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8745 -command [list choosecolor diffcolors 2 $top.hunksep \
8746 "diff hunk header" \
8747 [list $ctext tag conf hunksep -foreground]]
8748 grid x $top.hunksepbut $top.hunksep -sticky w
8749 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8750 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8751 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8752 grid x $top.selbgbut $top.selbgsep -sticky w
8754 label $top.cfont -text [mc "Fonts: press to choose"]
8755 grid $top.cfont - -sticky w -pady 10
8756 mkfontdisp mainfont $top [mc "Main font"]
8757 mkfontdisp textfont $top [mc "Diff display font"]
8758 mkfontdisp uifont $top [mc "User interface font"]
8760 frame $top.buts
8761 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8762 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8763 grid $top.buts.ok $top.buts.can
8764 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8765 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8766 grid $top.buts - - -pady 10 -sticky ew
8767 bind $top <Visibility> "focus $top.buts.ok"
8770 proc choosecolor {v vi w x cmd} {
8771 global $v
8773 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8774 -title [mc "Gitk: choose color for %s" $x]]
8775 if {$c eq {}} return
8776 $w conf -background $c
8777 lset $v $vi $c
8778 eval $cmd $c
8781 proc setselbg {c} {
8782 global bglist cflist
8783 foreach w $bglist {
8784 $w configure -selectbackground $c
8786 $cflist tag configure highlight \
8787 -background [$cflist cget -selectbackground]
8788 allcanvs itemconf secsel -fill $c
8791 proc setbg {c} {
8792 global bglist
8794 foreach w $bglist {
8795 $w conf -background $c
8799 proc setfg {c} {
8800 global fglist canv
8802 foreach w $fglist {
8803 $w conf -foreground $c
8805 allcanvs itemconf text -fill $c
8806 $canv itemconf circle -outline $c
8809 proc prefscan {} {
8810 global oldprefs prefstop
8812 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8813 limitdiffs tabstop} {
8814 global $v
8815 set $v $oldprefs($v)
8817 catch {destroy $prefstop}
8818 unset prefstop
8819 fontcan
8822 proc prefsok {} {
8823 global maxwidth maxgraphpct
8824 global oldprefs prefstop showneartags showlocalchanges
8825 global fontpref mainfont textfont uifont
8826 global limitdiffs treediffs
8828 catch {destroy $prefstop}
8829 unset prefstop
8830 fontcan
8831 set fontchanged 0
8832 if {$mainfont ne $fontpref(mainfont)} {
8833 set mainfont $fontpref(mainfont)
8834 parsefont mainfont $mainfont
8835 eval font configure mainfont [fontflags mainfont]
8836 eval font configure mainfontbold [fontflags mainfont 1]
8837 setcoords
8838 set fontchanged 1
8840 if {$textfont ne $fontpref(textfont)} {
8841 set textfont $fontpref(textfont)
8842 parsefont textfont $textfont
8843 eval font configure textfont [fontflags textfont]
8844 eval font configure textfontbold [fontflags textfont 1]
8846 if {$uifont ne $fontpref(uifont)} {
8847 set uifont $fontpref(uifont)
8848 parsefont uifont $uifont
8849 eval font configure uifont [fontflags uifont]
8851 settabs
8852 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8853 if {$showlocalchanges} {
8854 doshowlocalchanges
8855 } else {
8856 dohidelocalchanges
8859 if {$limitdiffs != $oldprefs(limitdiffs)} {
8860 # treediffs elements are limited by path
8861 catch {unset treediffs}
8863 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8864 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8865 redisplay
8866 } elseif {$showneartags != $oldprefs(showneartags) ||
8867 $limitdiffs != $oldprefs(limitdiffs)} {
8868 reselectline
8872 proc formatdate {d} {
8873 global datetimeformat
8874 if {$d ne {}} {
8875 set d [clock format $d -format $datetimeformat]
8877 return $d
8880 # This list of encoding names and aliases is distilled from
8881 # http://www.iana.org/assignments/character-sets.
8882 # Not all of them are supported by Tcl.
8883 set encoding_aliases {
8884 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8885 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8886 { ISO-10646-UTF-1 csISO10646UTF1 }
8887 { ISO_646.basic:1983 ref csISO646basic1983 }
8888 { INVARIANT csINVARIANT }
8889 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8890 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8891 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8892 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8893 { NATS-DANO iso-ir-9-1 csNATSDANO }
8894 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8895 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8896 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8897 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8898 { ISO-2022-KR csISO2022KR }
8899 { EUC-KR csEUCKR }
8900 { ISO-2022-JP csISO2022JP }
8901 { ISO-2022-JP-2 csISO2022JP2 }
8902 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8903 csISO13JISC6220jp }
8904 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8905 { IT iso-ir-15 ISO646-IT csISO15Italian }
8906 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8907 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8908 { greek7-old iso-ir-18 csISO18Greek7Old }
8909 { latin-greek iso-ir-19 csISO19LatinGreek }
8910 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8911 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8912 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8913 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8914 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8915 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8916 { INIS iso-ir-49 csISO49INIS }
8917 { INIS-8 iso-ir-50 csISO50INIS8 }
8918 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8919 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8920 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8921 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8922 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8923 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8924 csISO60Norwegian1 }
8925 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8926 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8927 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8928 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8929 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8930 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8931 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8932 { greek7 iso-ir-88 csISO88Greek7 }
8933 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8934 { iso-ir-90 csISO90 }
8935 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8936 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8937 csISO92JISC62991984b }
8938 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8939 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8940 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8941 csISO95JIS62291984handadd }
8942 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8943 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8944 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8945 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8946 CP819 csISOLatin1 }
8947 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8948 { T.61-7bit iso-ir-102 csISO102T617bit }
8949 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8950 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8951 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8952 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8953 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8954 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8955 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8956 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8957 arabic csISOLatinArabic }
8958 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8959 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8960 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8961 greek greek8 csISOLatinGreek }
8962 { T.101-G2 iso-ir-128 csISO128T101G2 }
8963 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8964 csISOLatinHebrew }
8965 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8966 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8967 { CSN_369103 iso-ir-139 csISO139CSN369103 }
8968 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8969 { ISO_6937-2-add iso-ir-142 csISOTextComm }
8970 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8971 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8972 csISOLatinCyrillic }
8973 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8974 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8975 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8976 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8977 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8978 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8979 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8980 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8981 { ISO_10367-box iso-ir-155 csISO10367Box }
8982 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8983 { latin-lap lap iso-ir-158 csISO158Lap }
8984 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8985 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8986 { us-dk csUSDK }
8987 { dk-us csDKUS }
8988 { JIS_X0201 X0201 csHalfWidthKatakana }
8989 { KSC5636 ISO646-KR csKSC5636 }
8990 { ISO-10646-UCS-2 csUnicode }
8991 { ISO-10646-UCS-4 csUCS4 }
8992 { DEC-MCS dec csDECMCS }
8993 { hp-roman8 roman8 r8 csHPRoman8 }
8994 { macintosh mac csMacintosh }
8995 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8996 csIBM037 }
8997 { IBM038 EBCDIC-INT cp038 csIBM038 }
8998 { IBM273 CP273 csIBM273 }
8999 { IBM274 EBCDIC-BE CP274 csIBM274 }
9000 { IBM275 EBCDIC-BR cp275 csIBM275 }
9001 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9002 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9003 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9004 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9005 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9006 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9007 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9008 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9009 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9010 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9011 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9012 { IBM437 cp437 437 csPC8CodePage437 }
9013 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9014 { IBM775 cp775 csPC775Baltic }
9015 { IBM850 cp850 850 csPC850Multilingual }
9016 { IBM851 cp851 851 csIBM851 }
9017 { IBM852 cp852 852 csPCp852 }
9018 { IBM855 cp855 855 csIBM855 }
9019 { IBM857 cp857 857 csIBM857 }
9020 { IBM860 cp860 860 csIBM860 }
9021 { IBM861 cp861 861 cp-is csIBM861 }
9022 { IBM862 cp862 862 csPC862LatinHebrew }
9023 { IBM863 cp863 863 csIBM863 }
9024 { IBM864 cp864 csIBM864 }
9025 { IBM865 cp865 865 csIBM865 }
9026 { IBM866 cp866 866 csIBM866 }
9027 { IBM868 CP868 cp-ar csIBM868 }
9028 { IBM869 cp869 869 cp-gr csIBM869 }
9029 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9030 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9031 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9032 { IBM891 cp891 csIBM891 }
9033 { IBM903 cp903 csIBM903 }
9034 { IBM904 cp904 904 csIBBM904 }
9035 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9036 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9037 { IBM1026 CP1026 csIBM1026 }
9038 { EBCDIC-AT-DE csIBMEBCDICATDE }
9039 { EBCDIC-AT-DE-A csEBCDICATDEA }
9040 { EBCDIC-CA-FR csEBCDICCAFR }
9041 { EBCDIC-DK-NO csEBCDICDKNO }
9042 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9043 { EBCDIC-FI-SE csEBCDICFISE }
9044 { EBCDIC-FI-SE-A csEBCDICFISEA }
9045 { EBCDIC-FR csEBCDICFR }
9046 { EBCDIC-IT csEBCDICIT }
9047 { EBCDIC-PT csEBCDICPT }
9048 { EBCDIC-ES csEBCDICES }
9049 { EBCDIC-ES-A csEBCDICESA }
9050 { EBCDIC-ES-S csEBCDICESS }
9051 { EBCDIC-UK csEBCDICUK }
9052 { EBCDIC-US csEBCDICUS }
9053 { UNKNOWN-8BIT csUnknown8BiT }
9054 { MNEMONIC csMnemonic }
9055 { MNEM csMnem }
9056 { VISCII csVISCII }
9057 { VIQR csVIQR }
9058 { KOI8-R csKOI8R }
9059 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9060 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9061 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9062 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9063 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9064 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9065 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9066 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9067 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9068 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9069 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9070 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9071 { IBM1047 IBM-1047 }
9072 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9073 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9074 { UNICODE-1-1 csUnicode11 }
9075 { CESU-8 csCESU-8 }
9076 { BOCU-1 csBOCU-1 }
9077 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9078 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9079 l8 }
9080 { ISO-8859-15 ISO_8859-15 Latin-9 }
9081 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9082 { GBK CP936 MS936 windows-936 }
9083 { JIS_Encoding csJISEncoding }
9084 { Shift_JIS MS_Kanji csShiftJIS }
9085 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9086 EUC-JP }
9087 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9088 { ISO-10646-UCS-Basic csUnicodeASCII }
9089 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9090 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9091 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9092 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9093 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9094 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9095 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9096 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9097 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9098 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9099 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9100 { Ventura-US csVenturaUS }
9101 { Ventura-International csVenturaInternational }
9102 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9103 { PC8-Turkish csPC8Turkish }
9104 { IBM-Symbols csIBMSymbols }
9105 { IBM-Thai csIBMThai }
9106 { HP-Legal csHPLegal }
9107 { HP-Pi-font csHPPiFont }
9108 { HP-Math8 csHPMath8 }
9109 { Adobe-Symbol-Encoding csHPPSMath }
9110 { HP-DeskTop csHPDesktop }
9111 { Ventura-Math csVenturaMath }
9112 { Microsoft-Publishing csMicrosoftPublishing }
9113 { Windows-31J csWindows31J }
9114 { GB2312 csGB2312 }
9115 { Big5 csBig5 }
9118 proc tcl_encoding {enc} {
9119 global encoding_aliases
9120 set names [encoding names]
9121 set lcnames [string tolower $names]
9122 set enc [string tolower $enc]
9123 set i [lsearch -exact $lcnames $enc]
9124 if {$i < 0} {
9125 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9126 if {[regsub {^iso[-_]} $enc iso encx]} {
9127 set i [lsearch -exact $lcnames $encx]
9130 if {$i < 0} {
9131 foreach l $encoding_aliases {
9132 set ll [string tolower $l]
9133 if {[lsearch -exact $ll $enc] < 0} continue
9134 # look through the aliases for one that tcl knows about
9135 foreach e $ll {
9136 set i [lsearch -exact $lcnames $e]
9137 if {$i < 0} {
9138 if {[regsub {^iso[-_]} $e iso ex]} {
9139 set i [lsearch -exact $lcnames $ex]
9142 if {$i >= 0} break
9144 break
9147 if {$i >= 0} {
9148 return [lindex $names $i]
9150 return {}
9153 # First check that Tcl/Tk is recent enough
9154 if {[catch {package require Tk 8.4} err]} {
9155 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9156 Gitk requires at least Tcl/Tk 8.4."]
9157 exit 1
9160 # defaults...
9161 set datemode 0
9162 set wrcomcmd "git diff-tree --stdin -p --pretty"
9164 set gitencoding {}
9165 catch {
9166 set gitencoding [exec git config --get i18n.commitencoding]
9168 if {$gitencoding == ""} {
9169 set gitencoding "utf-8"
9171 set tclencoding [tcl_encoding $gitencoding]
9172 if {$tclencoding == {}} {
9173 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9176 set mainfont {Helvetica 9}
9177 set textfont {Courier 9}
9178 set uifont {Helvetica 9 bold}
9179 set tabstop 8
9180 set findmergefiles 0
9181 set maxgraphpct 50
9182 set maxwidth 16
9183 set revlistorder 0
9184 set fastdate 0
9185 set uparrowlen 5
9186 set downarrowlen 5
9187 set mingaplen 100
9188 set cmitmode "patch"
9189 set wrapcomment "none"
9190 set showneartags 1
9191 set maxrefs 20
9192 set maxlinelen 200
9193 set showlocalchanges 1
9194 set limitdiffs 1
9195 set datetimeformat "%Y-%m-%d %H:%M:%S"
9197 set colors {green red blue magenta darkgrey brown orange}
9198 set bgcolor white
9199 set fgcolor black
9200 set diffcolors {red "#00a000" blue}
9201 set diffcontext 3
9202 set selectbgcolor gray85
9204 ## For msgcat loading, first locate the installation location.
9205 if { [info exists ::env(GITK_MSGSDIR)] } {
9206 ## Msgsdir was manually set in the environment.
9207 set gitk_msgsdir $::env(GITK_MSGSDIR)
9208 } else {
9209 ## Let's guess the prefix from argv0.
9210 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9211 set gitk_libdir [file join $gitk_prefix share gitk lib]
9212 set gitk_msgsdir [file join $gitk_libdir msgs]
9213 unset gitk_prefix
9216 ## Internationalization (i18n) through msgcat and gettext. See
9217 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9218 package require msgcat
9219 namespace import ::msgcat::mc
9220 ## And eventually load the actual message catalog
9221 ::msgcat::mcload $gitk_msgsdir
9223 catch {source ~/.gitk}
9225 font create optionfont -family sans-serif -size -12
9227 parsefont mainfont $mainfont
9228 eval font create mainfont [fontflags mainfont]
9229 eval font create mainfontbold [fontflags mainfont 1]
9231 parsefont textfont $textfont
9232 eval font create textfont [fontflags textfont]
9233 eval font create textfontbold [fontflags textfont 1]
9235 parsefont uifont $uifont
9236 eval font create uifont [fontflags uifont]
9238 setoptions
9240 # check that we can find a .git directory somewhere...
9241 if {[catch {set gitdir [gitdir]}]} {
9242 show_error {} . [mc "Cannot find a git repository here."]
9243 exit 1
9245 if {![file isdirectory $gitdir]} {
9246 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9247 exit 1
9250 set mergeonly 0
9251 set revtreeargs {}
9252 set cmdline_files {}
9253 set i 0
9254 foreach arg $argv {
9255 switch -- $arg {
9256 "" { }
9257 "-d" { set datemode 1 }
9258 "--merge" {
9259 set mergeonly 1
9260 lappend revtreeargs $arg
9262 "--" {
9263 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9264 break
9266 default {
9267 lappend revtreeargs $arg
9270 incr i
9273 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9274 # no -- on command line, but some arguments (other than -d)
9275 if {[catch {
9276 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9277 set cmdline_files [split $f "\n"]
9278 set n [llength $cmdline_files]
9279 set revtreeargs [lrange $revtreeargs 0 end-$n]
9280 # Unfortunately git rev-parse doesn't produce an error when
9281 # something is both a revision and a filename. To be consistent
9282 # with git log and git rev-list, check revtreeargs for filenames.
9283 foreach arg $revtreeargs {
9284 if {[file exists $arg]} {
9285 show_error {} . [mc "Ambiguous argument '%s': both revision\
9286 and filename" $arg]
9287 exit 1
9290 } err]} {
9291 # unfortunately we get both stdout and stderr in $err,
9292 # so look for "fatal:".
9293 set i [string first "fatal:" $err]
9294 if {$i > 0} {
9295 set err [string range $err [expr {$i + 6}] end]
9297 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9298 exit 1
9302 if {$mergeonly} {
9303 # find the list of unmerged files
9304 set mlist {}
9305 set nr_unmerged 0
9306 if {[catch {
9307 set fd [open "| git ls-files -u" r]
9308 } err]} {
9309 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9310 exit 1
9312 while {[gets $fd line] >= 0} {
9313 set i [string first "\t" $line]
9314 if {$i < 0} continue
9315 set fname [string range $line [expr {$i+1}] end]
9316 if {[lsearch -exact $mlist $fname] >= 0} continue
9317 incr nr_unmerged
9318 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9319 lappend mlist $fname
9322 catch {close $fd}
9323 if {$mlist eq {}} {
9324 if {$nr_unmerged == 0} {
9325 show_error {} . [mc "No files selected: --merge specified but\
9326 no files are unmerged."]
9327 } else {
9328 show_error {} . [mc "No files selected: --merge specified but\
9329 no unmerged files are within file limit."]
9331 exit 1
9333 set cmdline_files $mlist
9336 set nullid "0000000000000000000000000000000000000000"
9337 set nullid2 "0000000000000000000000000000000000000001"
9339 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9341 set runq {}
9342 set history {}
9343 set historyindex 0
9344 set fh_serial 0
9345 set nhl_names {}
9346 set highlight_paths {}
9347 set findpattern {}
9348 set searchdirn -forwards
9349 set boldrows {}
9350 set boldnamerows {}
9351 set diffelide {0 0}
9352 set markingmatches 0
9353 set linkentercount 0
9354 set need_redisplay 0
9355 set nrows_drawn 0
9356 set firsttabstop 0
9358 set nextviewnum 1
9359 set curview 0
9360 set selectedview 0
9361 set selectedhlview [mc "None"]
9362 set highlight_related [mc "None"]
9363 set highlight_files {}
9364 set viewfiles(0) {}
9365 set viewperm(0) 0
9366 set viewargs(0) {}
9368 set loginstance 0
9369 set cmdlineok 0
9370 set stopped 0
9371 set stuffsaved 0
9372 set patchnum 0
9373 set lserial 0
9374 setcoords
9375 makewindow
9376 # wait for the window to become visible
9377 tkwait visibility .
9378 wm title . "[file tail $argv0]: [file tail [pwd]]"
9379 readrefs
9381 if {$cmdline_files ne {} || $revtreeargs ne {}} {
9382 # create a view for the files/dirs specified on the command line
9383 set curview 1
9384 set selectedview 1
9385 set nextviewnum 2
9386 set viewname(1) [mc "Command line"]
9387 set viewfiles(1) $cmdline_files
9388 set viewargs(1) $revtreeargs
9389 set viewperm(1) 0
9390 addviewmenu 1
9391 .bar.view entryconf [mc "Edit view..."] -state normal
9392 .bar.view entryconf [mc "Delete view"] -state normal
9395 if {[info exists permviews]} {
9396 foreach v $permviews {
9397 set n $nextviewnum
9398 incr nextviewnum
9399 set viewname($n) [lindex $v 0]
9400 set viewfiles($n) [lindex $v 1]
9401 set viewargs($n) [lindex $v 2]
9402 set viewperm($n) 1
9403 addviewmenu $n
9406 getcommits