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