19325086bf68951df6a85d17beb1a513cbd8d64a
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
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
5444 set y [expr {$canvy0 + $l * $linespc}]
5445 set ymax [lindex [$canv cget -scrollregion] 3]
5446 set ytop [expr {$y - $linespc - 1}]
5447 set ybot [expr {$y + $linespc + 1}]
5448 set wnow [$canv yview]
5449 set wtop [expr {[lindex $wnow 0] * $ymax}]
5450 set wbot [expr {[lindex $wnow 1] * $ymax}]
5451 set wh [expr {$wbot - $wtop}]
5452 set newtop $wtop
5453 if {$ytop < $wtop} {
5454 if {$ybot < $wtop} {
5455 set newtop [expr {$y - $wh / 2.0}]
5456 } else {
5457 set newtop $ytop
5458 if {$newtop > $wtop - $linespc} {
5459 set newtop [expr {$wtop - $linespc}]
5460 }
5461 }
5462 } elseif {$ybot > $wbot} {
5463 if {$ytop > $wbot} {
5464 set newtop [expr {$y - $wh / 2.0}]
5465 } else {
5466 set newtop [expr {$ybot - $wh}]
5467 if {$newtop < $wtop + $linespc} {
5468 set newtop [expr {$wtop + $linespc}]
5469 }
5470 }
5471 }
5472 if {$newtop != $wtop} {
5473 if {$newtop < 0} {
5474 set newtop 0
5475 }
5476 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5477 drawvisible
5478 }
5479
5480 make_secsel $l
5481
5482 if {$isnew} {
5483 addtohistory [list selbyid $id]
5484 }
5485
5486 set selectedline $l
5487 set currentid $id
5488 $sha1entry delete 0 end
5489 $sha1entry insert 0 $id
5490 $sha1entry selection from 0
5491 $sha1entry selection to end
5492 rhighlight_sel $id
5493
5494 $ctext conf -state normal
5495 clear_ctext
5496 set linknum 0
5497 if {![info exists commitinfo($id)]} {
5498 getcommit $id
5499 }
5500 set info $commitinfo($id)
5501 set date [formatdate [lindex $info 2]]
5502 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
5503 set date [formatdate [lindex $info 4]]
5504 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
5505 if {[info exists idtags($id)]} {
5506 $ctext insert end [mc "Tags:"]
5507 foreach tag $idtags($id) {
5508 $ctext insert end " $tag"
5509 }
5510 $ctext insert end "\n"
5511 }
5512
5513 set headers {}
5514 set olds $parents($curview,$id)
5515 if {[llength $olds] > 1} {
5516 set np 0
5517 foreach p $olds {
5518 if {$np >= $mergemax} {
5519 set tag mmax
5520 } else {
5521 set tag m$np
5522 }
5523 $ctext insert end "[mc "Parent"]: " $tag
5524 appendwithlinks [commit_descriptor $p] {}
5525 incr np
5526 }
5527 } else {
5528 foreach p $olds {
5529 append headers "[mc "Parent"]: [commit_descriptor $p]"
5530 }
5531 }
5532
5533 foreach c $children($curview,$id) {
5534 append headers "[mc "Child"]: [commit_descriptor $c]"
5535 }
5536
5537 # make anything that looks like a SHA1 ID be a clickable link
5538 appendwithlinks $headers {}
5539 if {$showneartags} {
5540 if {![info exists allcommits]} {
5541 getallcommits
5542 }
5543 $ctext insert end "[mc "Branch"]: "
5544 $ctext mark set branch "end -1c"
5545 $ctext mark gravity branch left
5546 $ctext insert end "\n[mc "Follows"]: "
5547 $ctext mark set follows "end -1c"
5548 $ctext mark gravity follows left
5549 $ctext insert end "\n[mc "Precedes"]: "
5550 $ctext mark set precedes "end -1c"
5551 $ctext mark gravity precedes left
5552 $ctext insert end "\n"
5553 dispneartags 1
5554 }
5555 $ctext insert end "\n"
5556 set comment [lindex $info 5]
5557 if {[string first "\r" $comment] >= 0} {
5558 set comment [string map {"\r" "\n "} $comment]
5559 }
5560 appendwithlinks $comment {comment}
5561
5562 $ctext tag remove found 1.0 end
5563 $ctext conf -state disabled
5564 set commentend [$ctext index "end - 1c"]
5565
5566 init_flist [mc "Comments"]
5567 if {$cmitmode eq "tree"} {
5568 gettree $id
5569 } elseif {[llength $olds] <= 1} {
5570 startdiff $id
5571 } else {
5572 mergediff $id
5573 }
5574}
5575
5576proc selfirstline {} {
5577 unmarkmatches
5578 selectline 0 1
5579}
5580
5581proc sellastline {} {
5582 global numcommits
5583 unmarkmatches
5584 set l [expr {$numcommits - 1}]
5585 selectline $l 1
5586}
5587
5588proc selnextline {dir} {
5589 global selectedline
5590 focus .
5591 if {![info exists selectedline]} return
5592 set l [expr {$selectedline + $dir}]
5593 unmarkmatches
5594 selectline $l 1
5595}
5596
5597proc selnextpage {dir} {
5598 global canv linespc selectedline numcommits
5599
5600 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5601 if {$lpp < 1} {
5602 set lpp 1
5603 }
5604 allcanvs yview scroll [expr {$dir * $lpp}] units
5605 drawvisible
5606 if {![info exists selectedline]} return
5607 set l [expr {$selectedline + $dir * $lpp}]
5608 if {$l < 0} {
5609 set l 0
5610 } elseif {$l >= $numcommits} {
5611 set l [expr $numcommits - 1]
5612 }
5613 unmarkmatches
5614 selectline $l 1
5615}
5616
5617proc unselectline {} {
5618 global selectedline currentid
5619
5620 catch {unset selectedline}
5621 catch {unset currentid}
5622 allcanvs delete secsel
5623 rhighlight_none
5624}
5625
5626proc reselectline {} {
5627 global selectedline
5628
5629 if {[info exists selectedline]} {
5630 selectline $selectedline 0
5631 }
5632}
5633
5634proc addtohistory {cmd} {
5635 global history historyindex curview
5636
5637 set elt [list $curview $cmd]
5638 if {$historyindex > 0
5639 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5640 return
5641 }
5642
5643 if {$historyindex < [llength $history]} {
5644 set history [lreplace $history $historyindex end $elt]
5645 } else {
5646 lappend history $elt
5647 }
5648 incr historyindex
5649 if {$historyindex > 1} {
5650 .tf.bar.leftbut conf -state normal
5651 } else {
5652 .tf.bar.leftbut conf -state disabled
5653 }
5654 .tf.bar.rightbut conf -state disabled
5655}
5656
5657proc godo {elt} {
5658 global curview
5659
5660 set view [lindex $elt 0]
5661 set cmd [lindex $elt 1]
5662 if {$curview != $view} {
5663 showview $view
5664 }
5665 eval $cmd
5666}
5667
5668proc goback {} {
5669 global history historyindex
5670 focus .
5671
5672 if {$historyindex > 1} {
5673 incr historyindex -1
5674 godo [lindex $history [expr {$historyindex - 1}]]
5675 .tf.bar.rightbut conf -state normal
5676 }
5677 if {$historyindex <= 1} {
5678 .tf.bar.leftbut conf -state disabled
5679 }
5680}
5681
5682proc goforw {} {
5683 global history historyindex
5684 focus .
5685
5686 if {$historyindex < [llength $history]} {
5687 set cmd [lindex $history $historyindex]
5688 incr historyindex
5689 godo $cmd
5690 .tf.bar.leftbut conf -state normal
5691 }
5692 if {$historyindex >= [llength $history]} {
5693 .tf.bar.rightbut conf -state disabled
5694 }
5695}
5696
5697proc gettree {id} {
5698 global treefilelist treeidlist diffids diffmergeid treepending
5699 global nullid nullid2
5700
5701 set diffids $id
5702 catch {unset diffmergeid}
5703 if {![info exists treefilelist($id)]} {
5704 if {![info exists treepending]} {
5705 if {$id eq $nullid} {
5706 set cmd [list | git ls-files]
5707 } elseif {$id eq $nullid2} {
5708 set cmd [list | git ls-files --stage -t]
5709 } else {
5710 set cmd [list | git ls-tree -r $id]
5711 }
5712 if {[catch {set gtf [open $cmd r]}]} {
5713 return
5714 }
5715 set treepending $id
5716 set treefilelist($id) {}
5717 set treeidlist($id) {}
5718 fconfigure $gtf -blocking 0
5719 filerun $gtf [list gettreeline $gtf $id]
5720 }
5721 } else {
5722 setfilelist $id
5723 }
5724}
5725
5726proc gettreeline {gtf id} {
5727 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5728
5729 set nl 0
5730 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5731 if {$diffids eq $nullid} {
5732 set fname $line
5733 } else {
5734 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5735 set i [string first "\t" $line]
5736 if {$i < 0} continue
5737 set sha1 [lindex $line 2]
5738 set fname [string range $line [expr {$i+1}] end]
5739 if {[string index $fname 0] eq "\""} {
5740 set fname [lindex $fname 0]
5741 }
5742 lappend treeidlist($id) $sha1
5743 }
5744 lappend treefilelist($id) $fname
5745 }
5746 if {![eof $gtf]} {
5747 return [expr {$nl >= 1000? 2: 1}]
5748 }
5749 close $gtf
5750 unset treepending
5751 if {$cmitmode ne "tree"} {
5752 if {![info exists diffmergeid]} {
5753 gettreediffs $diffids
5754 }
5755 } elseif {$id ne $diffids} {
5756 gettree $diffids
5757 } else {
5758 setfilelist $id
5759 }
5760 return 0
5761}
5762
5763proc showfile {f} {
5764 global treefilelist treeidlist diffids nullid nullid2
5765 global ctext commentend
5766
5767 set i [lsearch -exact $treefilelist($diffids) $f]
5768 if {$i < 0} {
5769 puts "oops, $f not in list for id $diffids"
5770 return
5771 }
5772 if {$diffids eq $nullid} {
5773 if {[catch {set bf [open $f r]} err]} {
5774 puts "oops, can't read $f: $err"
5775 return
5776 }
5777 } else {
5778 set blob [lindex $treeidlist($diffids) $i]
5779 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5780 puts "oops, error reading blob $blob: $err"
5781 return
5782 }
5783 }
5784 fconfigure $bf -blocking 0
5785 filerun $bf [list getblobline $bf $diffids]
5786 $ctext config -state normal
5787 clear_ctext $commentend
5788 $ctext insert end "\n"
5789 $ctext insert end "$f\n" filesep
5790 $ctext config -state disabled
5791 $ctext yview $commentend
5792 settabs 0
5793}
5794
5795proc getblobline {bf id} {
5796 global diffids cmitmode ctext
5797
5798 if {$id ne $diffids || $cmitmode ne "tree"} {
5799 catch {close $bf}
5800 return 0
5801 }
5802 $ctext config -state normal
5803 set nl 0
5804 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5805 $ctext insert end "$line\n"
5806 }
5807 if {[eof $bf]} {
5808 # delete last newline
5809 $ctext delete "end - 2c" "end - 1c"
5810 close $bf
5811 return 0
5812 }
5813 $ctext config -state disabled
5814 return [expr {$nl >= 1000? 2: 1}]
5815}
5816
5817proc mergediff {id} {
5818 global diffmergeid mdifffd
5819 global diffids
5820 global parents
5821 global diffcontext
5822 global limitdiffs viewfiles curview
5823
5824 set diffmergeid $id
5825 set diffids $id
5826 # this doesn't seem to actually affect anything...
5827 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5828 if {$limitdiffs && $viewfiles($curview) ne {}} {
5829 set cmd [concat $cmd -- $viewfiles($curview)]
5830 }
5831 if {[catch {set mdf [open $cmd r]} err]} {
5832 error_popup "[mc "Error getting merge diffs:"] $err"
5833 return
5834 }
5835 fconfigure $mdf -blocking 0
5836 set mdifffd($id) $mdf
5837 set np [llength $parents($curview,$id)]
5838 settabs $np
5839 filerun $mdf [list getmergediffline $mdf $id $np]
5840}
5841
5842proc getmergediffline {mdf id np} {
5843 global diffmergeid ctext cflist mergemax
5844 global difffilestart mdifffd
5845
5846 $ctext conf -state normal
5847 set nr 0
5848 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5849 if {![info exists diffmergeid] || $id != $diffmergeid
5850 || $mdf != $mdifffd($id)} {
5851 close $mdf
5852 return 0
5853 }
5854 if {[regexp {^diff --cc (.*)} $line match fname]} {
5855 # start of a new file
5856 $ctext insert end "\n"
5857 set here [$ctext index "end - 1c"]
5858 lappend difffilestart $here
5859 add_flist [list $fname]
5860 set l [expr {(78 - [string length $fname]) / 2}]
5861 set pad [string range "----------------------------------------" 1 $l]
5862 $ctext insert end "$pad $fname $pad\n" filesep
5863 } elseif {[regexp {^@@} $line]} {
5864 $ctext insert end "$line\n" hunksep
5865 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5866 # do nothing
5867 } else {
5868 # parse the prefix - one ' ', '-' or '+' for each parent
5869 set spaces {}
5870 set minuses {}
5871 set pluses {}
5872 set isbad 0
5873 for {set j 0} {$j < $np} {incr j} {
5874 set c [string range $line $j $j]
5875 if {$c == " "} {
5876 lappend spaces $j
5877 } elseif {$c == "-"} {
5878 lappend minuses $j
5879 } elseif {$c == "+"} {
5880 lappend pluses $j
5881 } else {
5882 set isbad 1
5883 break
5884 }
5885 }
5886 set tags {}
5887 set num {}
5888 if {!$isbad && $minuses ne {} && $pluses eq {}} {
5889 # line doesn't appear in result, parents in $minuses have the line
5890 set num [lindex $minuses 0]
5891 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5892 # line appears in result, parents in $pluses don't have the line
5893 lappend tags mresult
5894 set num [lindex $spaces 0]
5895 }
5896 if {$num ne {}} {
5897 if {$num >= $mergemax} {
5898 set num "max"
5899 }
5900 lappend tags m$num
5901 }
5902 $ctext insert end "$line\n" $tags
5903 }
5904 }
5905 $ctext conf -state disabled
5906 if {[eof $mdf]} {
5907 close $mdf
5908 return 0
5909 }
5910 return [expr {$nr >= 1000? 2: 1}]
5911}
5912
5913proc startdiff {ids} {
5914 global treediffs diffids treepending diffmergeid nullid nullid2
5915
5916 settabs 1
5917 set diffids $ids
5918 catch {unset diffmergeid}
5919 if {![info exists treediffs($ids)] ||
5920 [lsearch -exact $ids $nullid] >= 0 ||
5921 [lsearch -exact $ids $nullid2] >= 0} {
5922 if {![info exists treepending]} {
5923 gettreediffs $ids
5924 }
5925 } else {
5926 addtocflist $ids
5927 }
5928}
5929
5930proc path_filter {filter name} {
5931 foreach p $filter {
5932 set l [string length $p]
5933 if {[string index $p end] eq "/"} {
5934 if {[string compare -length $l $p $name] == 0} {
5935 return 1
5936 }
5937 } else {
5938 if {[string compare -length $l $p $name] == 0 &&
5939 ([string length $name] == $l ||
5940 [string index $name $l] eq "/")} {
5941 return 1
5942 }
5943 }
5944 }
5945 return 0
5946}
5947
5948proc addtocflist {ids} {
5949 global treediffs
5950
5951 add_flist $treediffs($ids)
5952 getblobdiffs $ids
5953}
5954
5955proc diffcmd {ids flags} {
5956 global nullid nullid2
5957
5958 set i [lsearch -exact $ids $nullid]
5959 set j [lsearch -exact $ids $nullid2]
5960 if {$i >= 0} {
5961 if {[llength $ids] > 1 && $j < 0} {
5962 # comparing working directory with some specific revision
5963 set cmd [concat | git diff-index $flags]
5964 if {$i == 0} {
5965 lappend cmd -R [lindex $ids 1]
5966 } else {
5967 lappend cmd [lindex $ids 0]
5968 }
5969 } else {
5970 # comparing working directory with index
5971 set cmd [concat | git diff-files $flags]
5972 if {$j == 1} {
5973 lappend cmd -R
5974 }
5975 }
5976 } elseif {$j >= 0} {
5977 set cmd [concat | git diff-index --cached $flags]
5978 if {[llength $ids] > 1} {
5979 # comparing index with specific revision
5980 if {$i == 0} {
5981 lappend cmd -R [lindex $ids 1]
5982 } else {
5983 lappend cmd [lindex $ids 0]
5984 }
5985 } else {
5986 # comparing index with HEAD
5987 lappend cmd HEAD
5988 }
5989 } else {
5990 set cmd [concat | git diff-tree -r $flags $ids]
5991 }
5992 return $cmd
5993}
5994
5995proc gettreediffs {ids} {
5996 global treediff treepending
5997
5998 set treepending $ids
5999 set treediff {}
6000 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6001 fconfigure $gdtf -blocking 0
6002 filerun $gdtf [list gettreediffline $gdtf $ids]
6003}
6004
6005proc gettreediffline {gdtf ids} {
6006 global treediff treediffs treepending diffids diffmergeid
6007 global cmitmode viewfiles curview limitdiffs
6008
6009 set nr 0
6010 while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6011 set i [string first "\t" $line]
6012 if {$i >= 0} {
6013 set file [string range $line [expr {$i+1}] end]
6014 if {[string index $file 0] eq "\""} {
6015 set file [lindex $file 0]
6016 }
6017 lappend treediff $file
6018 }
6019 }
6020 if {![eof $gdtf]} {
6021 return [expr {$nr >= 1000? 2: 1}]
6022 }
6023 close $gdtf
6024 if {$limitdiffs && $viewfiles($curview) ne {}} {
6025 set flist {}
6026 foreach f $treediff {
6027 if {[path_filter $viewfiles($curview) $f]} {
6028 lappend flist $f
6029 }
6030 }
6031 set treediffs($ids) $flist
6032 } else {
6033 set treediffs($ids) $treediff
6034 }
6035 unset treepending
6036 if {$cmitmode eq "tree"} {
6037 gettree $diffids
6038 } elseif {$ids != $diffids} {
6039 if {![info exists diffmergeid]} {
6040 gettreediffs $diffids
6041 }
6042 } else {
6043 addtocflist $ids
6044 }
6045 return 0
6046}
6047
6048# empty string or positive integer
6049proc diffcontextvalidate {v} {
6050 return [regexp {^(|[1-9][0-9]*)$} $v]
6051}
6052
6053proc diffcontextchange {n1 n2 op} {
6054 global diffcontextstring diffcontext
6055
6056 if {[string is integer -strict $diffcontextstring]} {
6057 if {$diffcontextstring > 0} {
6058 set diffcontext $diffcontextstring
6059 reselectline
6060 }
6061 }
6062}
6063
6064proc changeignorespace {} {
6065 reselectline
6066}
6067
6068proc getblobdiffs {ids} {
6069 global blobdifffd diffids env
6070 global diffinhdr treediffs
6071 global diffcontext
6072 global ignorespace
6073 global limitdiffs viewfiles curview
6074
6075 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6076 if {$ignorespace} {
6077 append cmd " -w"
6078 }
6079 if {$limitdiffs && $viewfiles($curview) ne {}} {
6080 set cmd [concat $cmd -- $viewfiles($curview)]
6081 }
6082 if {[catch {set bdf [open $cmd r]} err]} {
6083 puts "error getting diffs: $err"
6084 return
6085 }
6086 set diffinhdr 0
6087 fconfigure $bdf -blocking 0
6088 set blobdifffd($ids) $bdf
6089 filerun $bdf [list getblobdiffline $bdf $diffids]
6090}
6091
6092proc setinlist {var i val} {
6093 global $var
6094
6095 while {[llength [set $var]] < $i} {
6096 lappend $var {}
6097 }
6098 if {[llength [set $var]] == $i} {
6099 lappend $var $val
6100 } else {
6101 lset $var $i $val
6102 }
6103}
6104
6105proc makediffhdr {fname ids} {
6106 global ctext curdiffstart treediffs
6107
6108 set i [lsearch -exact $treediffs($ids) $fname]
6109 if {$i >= 0} {
6110 setinlist difffilestart $i $curdiffstart
6111 }
6112 set l [expr {(78 - [string length $fname]) / 2}]
6113 set pad [string range "----------------------------------------" 1 $l]
6114 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6115}
6116
6117proc getblobdiffline {bdf ids} {
6118 global diffids blobdifffd ctext curdiffstart
6119 global diffnexthead diffnextnote difffilestart
6120 global diffinhdr treediffs
6121
6122 set nr 0
6123 $ctext conf -state normal
6124 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6125 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6126 close $bdf
6127 return 0
6128 }
6129 if {![string compare -length 11 "diff --git " $line]} {
6130 # trim off "diff --git "
6131 set line [string range $line 11 end]
6132 set diffinhdr 1
6133 # start of a new file
6134 $ctext insert end "\n"
6135 set curdiffstart [$ctext index "end - 1c"]
6136 $ctext insert end "\n" filesep
6137 # If the name hasn't changed the length will be odd,
6138 # the middle char will be a space, and the two bits either
6139 # side will be a/name and b/name, or "a/name" and "b/name".
6140 # If the name has changed we'll get "rename from" and
6141 # "rename to" or "copy from" and "copy to" lines following this,
6142 # and we'll use them to get the filenames.
6143 # This complexity is necessary because spaces in the filename(s)
6144 # don't get escaped.
6145 set l [string length $line]
6146 set i [expr {$l / 2}]
6147 if {!(($l & 1) && [string index $line $i] eq " " &&
6148 [string range $line 2 [expr {$i - 1}]] eq \
6149 [string range $line [expr {$i + 3}] end])} {
6150 continue
6151 }
6152 # unescape if quoted and chop off the a/ from the front
6153 if {[string index $line 0] eq "\""} {
6154 set fname [string range [lindex $line 0] 2 end]
6155 } else {
6156 set fname [string range $line 2 [expr {$i - 1}]]
6157 }
6158 makediffhdr $fname $ids
6159
6160 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6161 $line match f1l f1c f2l f2c rest]} {
6162 $ctext insert end "$line\n" hunksep
6163 set diffinhdr 0
6164
6165 } elseif {$diffinhdr} {
6166 if {![string compare -length 12 "rename from " $line]} {
6167 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6168 if {[string index $fname 0] eq "\""} {
6169 set fname [lindex $fname 0]
6170 }
6171 set i [lsearch -exact $treediffs($ids) $fname]
6172 if {$i >= 0} {
6173 setinlist difffilestart $i $curdiffstart
6174 }
6175 } elseif {![string compare -length 10 $line "rename to "] ||
6176 ![string compare -length 8 $line "copy to "]} {
6177 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6178 if {[string index $fname 0] eq "\""} {
6179 set fname [lindex $fname 0]
6180 }
6181 makediffhdr $fname $ids
6182 } elseif {[string compare -length 3 $line "---"] == 0} {
6183 # do nothing
6184 continue
6185 } elseif {[string compare -length 3 $line "+++"] == 0} {
6186 set diffinhdr 0
6187 continue
6188 }
6189 $ctext insert end "$line\n" filesep
6190
6191 } else {
6192 set x [string range $line 0 0]
6193 if {$x == "-" || $x == "+"} {
6194 set tag [expr {$x == "+"}]
6195 $ctext insert end "$line\n" d$tag
6196 } elseif {$x == " "} {
6197 $ctext insert end "$line\n"
6198 } else {
6199 # "\ No newline at end of file",
6200 # or something else we don't recognize
6201 $ctext insert end "$line\n" hunksep
6202 }
6203 }
6204 }
6205 $ctext conf -state disabled
6206 if {[eof $bdf]} {
6207 close $bdf
6208 return 0
6209 }
6210 return [expr {$nr >= 1000? 2: 1}]
6211}
6212
6213proc changediffdisp {} {
6214 global ctext diffelide
6215
6216 $ctext tag conf d0 -elide [lindex $diffelide 0]
6217 $ctext tag conf d1 -elide [lindex $diffelide 1]
6218}
6219
6220proc prevfile {} {
6221 global difffilestart ctext
6222 set prev [lindex $difffilestart 0]
6223 set here [$ctext index @0,0]
6224 foreach loc $difffilestart {
6225 if {[$ctext compare $loc >= $here]} {
6226 $ctext yview $prev
6227 return
6228 }
6229 set prev $loc
6230 }
6231 $ctext yview $prev
6232}
6233
6234proc nextfile {} {
6235 global difffilestart ctext
6236 set here [$ctext index @0,0]
6237 foreach loc $difffilestart {
6238 if {[$ctext compare $loc > $here]} {
6239 $ctext yview $loc
6240 return
6241 }
6242 }
6243}
6244
6245proc clear_ctext {{first 1.0}} {
6246 global ctext smarktop smarkbot
6247 global pendinglinks
6248
6249 set l [lindex [split $first .] 0]
6250 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6251 set smarktop $l
6252 }
6253 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6254 set smarkbot $l
6255 }
6256 $ctext delete $first end
6257 if {$first eq "1.0"} {
6258 catch {unset pendinglinks}
6259 }
6260}
6261
6262proc settabs {{firstab {}}} {
6263 global firsttabstop tabstop ctext have_tk85
6264
6265 if {$firstab ne {} && $have_tk85} {
6266 set firsttabstop $firstab
6267 }
6268 set w [font measure textfont "0"]
6269 if {$firsttabstop != 0} {
6270 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6271 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6272 } elseif {$have_tk85 || $tabstop != 8} {
6273 $ctext conf -tabs [expr {$tabstop * $w}]
6274 } else {
6275 $ctext conf -tabs {}
6276 }
6277}
6278
6279proc incrsearch {name ix op} {
6280 global ctext searchstring searchdirn
6281
6282 $ctext tag remove found 1.0 end
6283 if {[catch {$ctext index anchor}]} {
6284 # no anchor set, use start of selection, or of visible area
6285 set sel [$ctext tag ranges sel]
6286 if {$sel ne {}} {
6287 $ctext mark set anchor [lindex $sel 0]
6288 } elseif {$searchdirn eq "-forwards"} {
6289 $ctext mark set anchor @0,0
6290 } else {
6291 $ctext mark set anchor @0,[winfo height $ctext]
6292 }
6293 }
6294 if {$searchstring ne {}} {
6295 set here [$ctext search $searchdirn -- $searchstring anchor]
6296 if {$here ne {}} {
6297 $ctext see $here
6298 }
6299 searchmarkvisible 1
6300 }
6301}
6302
6303proc dosearch {} {
6304 global sstring ctext searchstring searchdirn
6305
6306 focus $sstring
6307 $sstring icursor end
6308 set searchdirn -forwards
6309 if {$searchstring ne {}} {
6310 set sel [$ctext tag ranges sel]
6311 if {$sel ne {}} {
6312 set start "[lindex $sel 0] + 1c"
6313 } elseif {[catch {set start [$ctext index anchor]}]} {
6314 set start "@0,0"
6315 }
6316 set match [$ctext search -count mlen -- $searchstring $start]
6317 $ctext tag remove sel 1.0 end
6318 if {$match eq {}} {
6319 bell
6320 return
6321 }
6322 $ctext see $match
6323 set mend "$match + $mlen c"
6324 $ctext tag add sel $match $mend
6325 $ctext mark unset anchor
6326 }
6327}
6328
6329proc dosearchback {} {
6330 global sstring ctext searchstring searchdirn
6331
6332 focus $sstring
6333 $sstring icursor end
6334 set searchdirn -backwards
6335 if {$searchstring ne {}} {
6336 set sel [$ctext tag ranges sel]
6337 if {$sel ne {}} {
6338 set start [lindex $sel 0]
6339 } elseif {[catch {set start [$ctext index anchor]}]} {
6340 set start @0,[winfo height $ctext]
6341 }
6342 set match [$ctext search -backwards -count ml -- $searchstring $start]
6343 $ctext tag remove sel 1.0 end
6344 if {$match eq {}} {
6345 bell
6346 return
6347 }
6348 $ctext see $match
6349 set mend "$match + $ml c"
6350 $ctext tag add sel $match $mend
6351 $ctext mark unset anchor
6352 }
6353}
6354
6355proc searchmark {first last} {
6356 global ctext searchstring
6357
6358 set mend $first.0
6359 while {1} {
6360 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6361 if {$match eq {}} break
6362 set mend "$match + $mlen c"
6363 $ctext tag add found $match $mend
6364 }
6365}
6366
6367proc searchmarkvisible {doall} {
6368 global ctext smarktop smarkbot
6369
6370 set topline [lindex [split [$ctext index @0,0] .] 0]
6371 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6372 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6373 # no overlap with previous
6374 searchmark $topline $botline
6375 set smarktop $topline
6376 set smarkbot $botline
6377 } else {
6378 if {$topline < $smarktop} {
6379 searchmark $topline [expr {$smarktop-1}]
6380 set smarktop $topline
6381 }
6382 if {$botline > $smarkbot} {
6383 searchmark [expr {$smarkbot+1}] $botline
6384 set smarkbot $botline
6385 }
6386 }
6387}
6388
6389proc scrolltext {f0 f1} {
6390 global searchstring
6391
6392 .bleft.sb set $f0 $f1
6393 if {$searchstring ne {}} {
6394 searchmarkvisible 0
6395 }
6396}
6397
6398proc setcoords {} {
6399 global linespc charspc canvx0 canvy0
6400 global xspc1 xspc2 lthickness
6401
6402 set linespc [font metrics mainfont -linespace]
6403 set charspc [font measure mainfont "m"]
6404 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6405 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6406 set lthickness [expr {int($linespc / 9) + 1}]
6407 set xspc1(0) $linespc
6408 set xspc2 $linespc
6409}
6410
6411proc redisplay {} {
6412 global canv
6413 global selectedline
6414
6415 set ymax [lindex [$canv cget -scrollregion] 3]
6416 if {$ymax eq {} || $ymax == 0} return
6417 set span [$canv yview]
6418 clear_display
6419 setcanvscroll
6420 allcanvs yview moveto [lindex $span 0]
6421 drawvisible
6422 if {[info exists selectedline]} {
6423 selectline $selectedline 0
6424 allcanvs yview moveto [lindex $span 0]
6425 }
6426}
6427
6428proc parsefont {f n} {
6429 global fontattr
6430
6431 set fontattr($f,family) [lindex $n 0]
6432 set s [lindex $n 1]
6433 if {$s eq {} || $s == 0} {
6434 set s 10
6435 } elseif {$s < 0} {
6436 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6437 }
6438 set fontattr($f,size) $s
6439 set fontattr($f,weight) normal
6440 set fontattr($f,slant) roman
6441 foreach style [lrange $n 2 end] {
6442 switch -- $style {
6443 "normal" -
6444 "bold" {set fontattr($f,weight) $style}
6445 "roman" -
6446 "italic" {set fontattr($f,slant) $style}
6447 }
6448 }
6449}
6450
6451proc fontflags {f {isbold 0}} {
6452 global fontattr
6453
6454 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6455 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6456 -slant $fontattr($f,slant)]
6457}
6458
6459proc fontname {f} {
6460 global fontattr
6461
6462 set n [list $fontattr($f,family) $fontattr($f,size)]
6463 if {$fontattr($f,weight) eq "bold"} {
6464 lappend n "bold"
6465 }
6466 if {$fontattr($f,slant) eq "italic"} {
6467 lappend n "italic"
6468 }
6469 return $n
6470}
6471
6472proc incrfont {inc} {
6473 global mainfont textfont ctext canv cflist showrefstop
6474 global stopped entries fontattr
6475
6476 unmarkmatches
6477 set s $fontattr(mainfont,size)
6478 incr s $inc
6479 if {$s < 1} {
6480 set s 1
6481 }
6482 set fontattr(mainfont,size) $s
6483 font config mainfont -size $s
6484 font config mainfontbold -size $s
6485 set mainfont [fontname mainfont]
6486 set s $fontattr(textfont,size)
6487 incr s $inc
6488 if {$s < 1} {
6489 set s 1
6490 }
6491 set fontattr(textfont,size) $s
6492 font config textfont -size $s
6493 font config textfontbold -size $s
6494 set textfont [fontname textfont]
6495 setcoords
6496 settabs
6497 redisplay
6498}
6499
6500proc clearsha1 {} {
6501 global sha1entry sha1string
6502 if {[string length $sha1string] == 40} {
6503 $sha1entry delete 0 end
6504 }
6505}
6506
6507proc sha1change {n1 n2 op} {
6508 global sha1string currentid sha1but
6509 if {$sha1string == {}
6510 || ([info exists currentid] && $sha1string == $currentid)} {
6511 set state disabled
6512 } else {
6513 set state normal
6514 }
6515 if {[$sha1but cget -state] == $state} return
6516 if {$state == "normal"} {
6517 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6518 } else {
6519 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6520 }
6521}
6522
6523proc gotocommit {} {
6524 global sha1string tagids headids curview varcid
6525
6526 if {$sha1string == {}
6527 || ([info exists currentid] && $sha1string == $currentid)} return
6528 if {[info exists tagids($sha1string)]} {
6529 set id $tagids($sha1string)
6530 } elseif {[info exists headids($sha1string)]} {
6531 set id $headids($sha1string)
6532 } else {
6533 set id [string tolower $sha1string]
6534 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6535 set matches [array names varcid "$curview,$id*"]
6536 if {$matches ne {}} {
6537 if {[llength $matches] > 1} {
6538 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6539 return
6540 }
6541 set id [lindex [split [lindex $matches 0] ","] 1]
6542 }
6543 }
6544 }
6545 if {[commitinview $id $curview]} {
6546 selectline [rowofcommit $id] 1
6547 return
6548 }
6549 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6550 set msg [mc "SHA1 id %s is not known" $sha1string]
6551 } else {
6552 set msg [mc "Tag/Head %s is not known" $sha1string]
6553 }
6554 error_popup $msg
6555}
6556
6557proc lineenter {x y id} {
6558 global hoverx hovery hoverid hovertimer
6559 global commitinfo canv
6560
6561 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6562 set hoverx $x
6563 set hovery $y
6564 set hoverid $id
6565 if {[info exists hovertimer]} {
6566 after cancel $hovertimer
6567 }
6568 set hovertimer [after 500 linehover]
6569 $canv delete hover
6570}
6571
6572proc linemotion {x y id} {
6573 global hoverx hovery hoverid hovertimer
6574
6575 if {[info exists hoverid] && $id == $hoverid} {
6576 set hoverx $x
6577 set hovery $y
6578 if {[info exists hovertimer]} {
6579 after cancel $hovertimer
6580 }
6581 set hovertimer [after 500 linehover]
6582 }
6583}
6584
6585proc lineleave {id} {
6586 global hoverid hovertimer canv
6587
6588 if {[info exists hoverid] && $id == $hoverid} {
6589 $canv delete hover
6590 if {[info exists hovertimer]} {
6591 after cancel $hovertimer
6592 unset hovertimer
6593 }
6594 unset hoverid
6595 }
6596}
6597
6598proc linehover {} {
6599 global hoverx hovery hoverid hovertimer
6600 global canv linespc lthickness
6601 global commitinfo
6602
6603 set text [lindex $commitinfo($hoverid) 0]
6604 set ymax [lindex [$canv cget -scrollregion] 3]
6605 if {$ymax == {}} return
6606 set yfrac [lindex [$canv yview] 0]
6607 set x [expr {$hoverx + 2 * $linespc}]
6608 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6609 set x0 [expr {$x - 2 * $lthickness}]
6610 set y0 [expr {$y - 2 * $lthickness}]
6611 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6612 set y1 [expr {$y + $linespc + 2 * $lthickness}]
6613 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6614 -fill \#ffff80 -outline black -width 1 -tags hover]
6615 $canv raise $t
6616 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6617 -font mainfont]
6618 $canv raise $t
6619}
6620
6621proc clickisonarrow {id y} {
6622 global lthickness
6623
6624 set ranges [rowranges $id]
6625 set thresh [expr {2 * $lthickness + 6}]
6626 set n [expr {[llength $ranges] - 1}]
6627 for {set i 1} {$i < $n} {incr i} {
6628 set row [lindex $ranges $i]
6629 if {abs([yc $row] - $y) < $thresh} {
6630 return $i
6631 }
6632 }
6633 return {}
6634}
6635
6636proc arrowjump {id n y} {
6637 global canv
6638
6639 # 1 <-> 2, 3 <-> 4, etc...
6640 set n [expr {(($n - 1) ^ 1) + 1}]
6641 set row [lindex [rowranges $id] $n]
6642 set yt [yc $row]
6643 set ymax [lindex [$canv cget -scrollregion] 3]
6644 if {$ymax eq {} || $ymax <= 0} return
6645 set view [$canv yview]
6646 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6647 set yfrac [expr {$yt / $ymax - $yspan / 2}]
6648 if {$yfrac < 0} {
6649 set yfrac 0
6650 }
6651 allcanvs yview moveto $yfrac
6652}
6653
6654proc lineclick {x y id isnew} {
6655 global ctext commitinfo children canv thickerline curview
6656
6657 if {![info exists commitinfo($id)] && ![getcommit $id]} return
6658 unmarkmatches
6659 unselectline
6660 normalline
6661 $canv delete hover
6662 # draw this line thicker than normal
6663 set thickerline $id
6664 drawlines $id
6665 if {$isnew} {
6666 set ymax [lindex [$canv cget -scrollregion] 3]
6667 if {$ymax eq {}} return
6668 set yfrac [lindex [$canv yview] 0]
6669 set y [expr {$y + $yfrac * $ymax}]
6670 }
6671 set dirn [clickisonarrow $id $y]
6672 if {$dirn ne {}} {
6673 arrowjump $id $dirn $y
6674 return
6675 }
6676
6677 if {$isnew} {
6678 addtohistory [list lineclick $x $y $id 0]
6679 }
6680 # fill the details pane with info about this line
6681 $ctext conf -state normal
6682 clear_ctext
6683 settabs 0
6684 $ctext insert end "[mc "Parent"]:\t"
6685 $ctext insert end $id link0
6686 setlink $id link0
6687 set info $commitinfo($id)
6688 $ctext insert end "\n\t[lindex $info 0]\n"
6689 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6690 set date [formatdate [lindex $info 2]]
6691 $ctext insert end "\t[mc "Date"]:\t$date\n"
6692 set kids $children($curview,$id)
6693 if {$kids ne {}} {
6694 $ctext insert end "\n[mc "Children"]:"
6695 set i 0
6696 foreach child $kids {
6697 incr i
6698 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6699 set info $commitinfo($child)
6700 $ctext insert end "\n\t"
6701 $ctext insert end $child link$i
6702 setlink $child link$i
6703 $ctext insert end "\n\t[lindex $info 0]"
6704 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6705 set date [formatdate [lindex $info 2]]
6706 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6707 }
6708 }
6709 $ctext conf -state disabled
6710 init_flist {}
6711}
6712
6713proc normalline {} {
6714 global thickerline
6715 if {[info exists thickerline]} {
6716 set id $thickerline
6717 unset thickerline
6718 drawlines $id
6719 }
6720}
6721
6722proc selbyid {id} {
6723 global curview
6724 if {[commitinview $id $curview]} {
6725 selectline [rowofcommit $id] 1
6726 }
6727}
6728
6729proc mstime {} {
6730 global startmstime
6731 if {![info exists startmstime]} {
6732 set startmstime [clock clicks -milliseconds]
6733 }
6734 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6735}
6736
6737proc rowmenu {x y id} {
6738 global rowctxmenu selectedline rowmenuid curview
6739 global nullid nullid2 fakerowmenu mainhead
6740
6741 stopfinding
6742 set rowmenuid $id
6743 if {![info exists selectedline]
6744 || [rowofcommit $id] eq $selectedline} {
6745 set state disabled
6746 } else {
6747 set state normal
6748 }
6749 if {$id ne $nullid && $id ne $nullid2} {
6750 set menu $rowctxmenu
6751 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6752 } else {
6753 set menu $fakerowmenu
6754 }
6755 $menu entryconfigure [mc "Diff this -> selected"] -state $state
6756 $menu entryconfigure [mc "Diff selected -> this"] -state $state
6757 $menu entryconfigure [mc "Make patch"] -state $state
6758 tk_popup $menu $x $y
6759}
6760
6761proc diffvssel {dirn} {
6762 global rowmenuid selectedline
6763
6764 if {![info exists selectedline]} return
6765 if {$dirn} {
6766 set oldid [commitonrow $selectedline]
6767 set newid $rowmenuid
6768 } else {
6769 set oldid $rowmenuid
6770 set newid [commitonrow $selectedline]
6771 }
6772 addtohistory [list doseldiff $oldid $newid]
6773 doseldiff $oldid $newid
6774}
6775
6776proc doseldiff {oldid newid} {
6777 global ctext
6778 global commitinfo
6779
6780 $ctext conf -state normal
6781 clear_ctext
6782 init_flist [mc "Top"]
6783 $ctext insert end "[mc "From"] "
6784 $ctext insert end $oldid link0
6785 setlink $oldid link0
6786 $ctext insert end "\n "
6787 $ctext insert end [lindex $commitinfo($oldid) 0]
6788 $ctext insert end "\n\n[mc "To"] "
6789 $ctext insert end $newid link1
6790 setlink $newid link1
6791 $ctext insert end "\n "
6792 $ctext insert end [lindex $commitinfo($newid) 0]
6793 $ctext insert end "\n"
6794 $ctext conf -state disabled
6795 $ctext tag remove found 1.0 end
6796 startdiff [list $oldid $newid]
6797}
6798
6799proc mkpatch {} {
6800 global rowmenuid currentid commitinfo patchtop patchnum
6801
6802 if {![info exists currentid]} return
6803 set oldid $currentid
6804 set oldhead [lindex $commitinfo($oldid) 0]
6805 set newid $rowmenuid
6806 set newhead [lindex $commitinfo($newid) 0]
6807 set top .patch
6808 set patchtop $top
6809 catch {destroy $top}
6810 toplevel $top
6811 label $top.title -text [mc "Generate patch"]
6812 grid $top.title - -pady 10
6813 label $top.from -text [mc "From:"]
6814 entry $top.fromsha1 -width 40 -relief flat
6815 $top.fromsha1 insert 0 $oldid
6816 $top.fromsha1 conf -state readonly
6817 grid $top.from $top.fromsha1 -sticky w
6818 entry $top.fromhead -width 60 -relief flat
6819 $top.fromhead insert 0 $oldhead
6820 $top.fromhead conf -state readonly
6821 grid x $top.fromhead -sticky w
6822 label $top.to -text [mc "To:"]
6823 entry $top.tosha1 -width 40 -relief flat
6824 $top.tosha1 insert 0 $newid
6825 $top.tosha1 conf -state readonly
6826 grid $top.to $top.tosha1 -sticky w
6827 entry $top.tohead -width 60 -relief flat
6828 $top.tohead insert 0 $newhead
6829 $top.tohead conf -state readonly
6830 grid x $top.tohead -sticky w
6831 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6832 grid $top.rev x -pady 10
6833 label $top.flab -text [mc "Output file:"]
6834 entry $top.fname -width 60
6835 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6836 incr patchnum
6837 grid $top.flab $top.fname -sticky w
6838 frame $top.buts
6839 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6840 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6841 grid $top.buts.gen $top.buts.can
6842 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6843 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6844 grid $top.buts - -pady 10 -sticky ew
6845 focus $top.fname
6846}
6847
6848proc mkpatchrev {} {
6849 global patchtop
6850
6851 set oldid [$patchtop.fromsha1 get]
6852 set oldhead [$patchtop.fromhead get]
6853 set newid [$patchtop.tosha1 get]
6854 set newhead [$patchtop.tohead get]
6855 foreach e [list fromsha1 fromhead tosha1 tohead] \
6856 v [list $newid $newhead $oldid $oldhead] {
6857 $patchtop.$e conf -state normal
6858 $patchtop.$e delete 0 end
6859 $patchtop.$e insert 0 $v
6860 $patchtop.$e conf -state readonly
6861 }
6862}
6863
6864proc mkpatchgo {} {
6865 global patchtop nullid nullid2
6866
6867 set oldid [$patchtop.fromsha1 get]
6868 set newid [$patchtop.tosha1 get]
6869 set fname [$patchtop.fname get]
6870 set cmd [diffcmd [list $oldid $newid] -p]
6871 # trim off the initial "|"
6872 set cmd [lrange $cmd 1 end]
6873 lappend cmd >$fname &
6874 if {[catch {eval exec $cmd} err]} {
6875 error_popup "[mc "Error creating patch:"] $err"
6876 }
6877 catch {destroy $patchtop}
6878 unset patchtop
6879}
6880
6881proc mkpatchcan {} {
6882 global patchtop
6883
6884 catch {destroy $patchtop}
6885 unset patchtop
6886}
6887
6888proc mktag {} {
6889 global rowmenuid mktagtop commitinfo
6890
6891 set top .maketag
6892 set mktagtop $top
6893 catch {destroy $top}
6894 toplevel $top
6895 label $top.title -text [mc "Create tag"]
6896 grid $top.title - -pady 10
6897 label $top.id -text [mc "ID:"]
6898 entry $top.sha1 -width 40 -relief flat
6899 $top.sha1 insert 0 $rowmenuid
6900 $top.sha1 conf -state readonly
6901 grid $top.id $top.sha1 -sticky w
6902 entry $top.head -width 60 -relief flat
6903 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6904 $top.head conf -state readonly
6905 grid x $top.head -sticky w
6906 label $top.tlab -text [mc "Tag name:"]
6907 entry $top.tag -width 60
6908 grid $top.tlab $top.tag -sticky w
6909 frame $top.buts
6910 button $top.buts.gen -text [mc "Create"] -command mktaggo
6911 button $top.buts.can -text [mc "Cancel"] -command mktagcan
6912 grid $top.buts.gen $top.buts.can
6913 grid columnconfigure $top.buts 0 -weight 1 -uniform a
6914 grid columnconfigure $top.buts 1 -weight 1 -uniform a
6915 grid $top.buts - -pady 10 -sticky ew
6916 focus $top.tag
6917}
6918
6919proc domktag {} {
6920 global mktagtop env tagids idtags
6921
6922 set id [$mktagtop.sha1 get]
6923 set tag [$mktagtop.tag get]
6924 if {$tag == {}} {
6925 error_popup [mc "No tag name specified"]
6926 return
6927 }
6928 if {[info exists tagids($tag)]} {
6929 error_popup [mc "Tag \"%s\" already exists" $tag]
6930 return
6931 }
6932 if {[catch {
6933 exec git tag $tag $id
6934 } err]} {
6935 error_popup "[mc "Error creating tag:"] $err"
6936 return
6937 }
6938
6939 set tagids($tag) $id
6940 lappend idtags($id) $tag
6941 redrawtags $id
6942 addedtag $id
6943 dispneartags 0
6944 run refill_reflist
6945}
6946
6947proc redrawtags {id} {
6948 global canv linehtag idpos currentid curview
6949 global canvxmax iddrawn
6950
6951 if {![commitinview $id $curview]} return
6952 if {![info exists iddrawn($id)]} return
6953 set row [rowofcommit $id]
6954 $canv delete tag.$id
6955 set xt [eval drawtags $id $idpos($id)]
6956 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6957 set text [$canv itemcget $linehtag($row) -text]
6958 set font [$canv itemcget $linehtag($row) -font]
6959 set xr [expr {$xt + [font measure $font $text]}]
6960 if {$xr > $canvxmax} {
6961 set canvxmax $xr
6962 setcanvscroll
6963 }
6964 if {[info exists currentid] && $currentid == $id} {
6965 make_secsel $row
6966 }
6967}
6968
6969proc mktagcan {} {
6970 global mktagtop
6971
6972 catch {destroy $mktagtop}
6973 unset mktagtop
6974}
6975
6976proc mktaggo {} {
6977 domktag
6978 mktagcan
6979}
6980
6981proc writecommit {} {
6982 global rowmenuid wrcomtop commitinfo wrcomcmd
6983
6984 set top .writecommit
6985 set wrcomtop $top
6986 catch {destroy $top}
6987 toplevel $top
6988 label $top.title -text [mc "Write commit to file"]
6989 grid $top.title - -pady 10
6990 label $top.id -text [mc "ID:"]
6991 entry $top.sha1 -width 40 -relief flat
6992 $top.sha1 insert 0 $rowmenuid
6993 $top.sha1 conf -state readonly
6994 grid $top.id $top.sha1 -sticky w
6995 entry $top.head -width 60 -relief flat
6996 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6997 $top.head conf -state readonly
6998 grid x $top.head -sticky w
6999 label $top.clab -text [mc "Command:"]
7000 entry $top.cmd -width 60 -textvariable wrcomcmd
7001 grid $top.clab $top.cmd -sticky w -pady 10
7002 label $top.flab -text [mc "Output file:"]
7003 entry $top.fname -width 60
7004 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7005 grid $top.flab $top.fname -sticky w
7006 frame $top.buts
7007 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7008 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7009 grid $top.buts.gen $top.buts.can
7010 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7011 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7012 grid $top.buts - -pady 10 -sticky ew
7013 focus $top.fname
7014}
7015
7016proc wrcomgo {} {
7017 global wrcomtop
7018
7019 set id [$wrcomtop.sha1 get]
7020 set cmd "echo $id | [$wrcomtop.cmd get]"
7021 set fname [$wrcomtop.fname get]
7022 if {[catch {exec sh -c $cmd >$fname &} err]} {
7023 error_popup "[mc "Error writing commit:"] $err"
7024 }
7025 catch {destroy $wrcomtop}
7026 unset wrcomtop
7027}
7028
7029proc wrcomcan {} {
7030 global wrcomtop
7031
7032 catch {destroy $wrcomtop}
7033 unset wrcomtop
7034}
7035
7036proc mkbranch {} {
7037 global rowmenuid mkbrtop
7038
7039 set top .makebranch
7040 catch {destroy $top}
7041 toplevel $top
7042 label $top.title -text [mc "Create new branch"]
7043 grid $top.title - -pady 10
7044 label $top.id -text [mc "ID:"]
7045 entry $top.sha1 -width 40 -relief flat
7046 $top.sha1 insert 0 $rowmenuid
7047 $top.sha1 conf -state readonly
7048 grid $top.id $top.sha1 -sticky w
7049 label $top.nlab -text [mc "Name:"]
7050 entry $top.name -width 40
7051 grid $top.nlab $top.name -sticky w
7052 frame $top.buts
7053 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7054 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7055 grid $top.buts.go $top.buts.can
7056 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7057 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7058 grid $top.buts - -pady 10 -sticky ew
7059 focus $top.name
7060}
7061
7062proc mkbrgo {top} {
7063 global headids idheads
7064
7065 set name [$top.name get]
7066 set id [$top.sha1 get]
7067 if {$name eq {}} {
7068 error_popup [mc "Please specify a name for the new branch"]
7069 return
7070 }
7071 catch {destroy $top}
7072 nowbusy newbranch
7073 update
7074 if {[catch {
7075 exec git branch $name $id
7076 } err]} {
7077 notbusy newbranch
7078 error_popup $err
7079 } else {
7080 set headids($name) $id
7081 lappend idheads($id) $name
7082 addedhead $id $name
7083 notbusy newbranch
7084 redrawtags $id
7085 dispneartags 0
7086 run refill_reflist
7087 }
7088}
7089
7090proc cherrypick {} {
7091 global rowmenuid curview
7092 global mainhead mainheadid
7093
7094 set oldhead [exec git rev-parse HEAD]
7095 set dheads [descheads $rowmenuid]
7096 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7097 set ok [confirm_popup [mc "Commit %s is already\
7098 included in branch %s -- really re-apply it?" \
7099 [string range $rowmenuid 0 7] $mainhead]]
7100 if {!$ok} return
7101 }
7102 nowbusy cherrypick [mc "Cherry-picking"]
7103 update
7104 # Unfortunately git-cherry-pick writes stuff to stderr even when
7105 # no error occurs, and exec takes that as an indication of error...
7106 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7107 notbusy cherrypick
7108 error_popup $err
7109 return
7110 }
7111 set newhead [exec git rev-parse HEAD]
7112 if {$newhead eq $oldhead} {
7113 notbusy cherrypick
7114 error_popup [mc "No changes committed"]
7115 return
7116 }
7117 addnewchild $newhead $oldhead
7118 if {[commitinview $oldhead $curview]} {
7119 insertrow $newhead $oldhead $curview
7120 if {$mainhead ne {}} {
7121 movehead $newhead $mainhead
7122 movedhead $newhead $mainhead
7123 set mainheadid $newhead
7124 }
7125 redrawtags $oldhead
7126 redrawtags $newhead
7127 selbyid $newhead
7128 }
7129 notbusy cherrypick
7130}
7131
7132proc resethead {} {
7133 global mainhead rowmenuid confirm_ok resettype
7134
7135 set confirm_ok 0
7136 set w ".confirmreset"
7137 toplevel $w
7138 wm transient $w .
7139 wm title $w [mc "Confirm reset"]
7140 message $w.m -text \
7141 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7142 -justify center -aspect 1000
7143 pack $w.m -side top -fill x -padx 20 -pady 20
7144 frame $w.f -relief sunken -border 2
7145 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7146 grid $w.f.rt -sticky w
7147 set resettype mixed
7148 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7149 -text [mc "Soft: Leave working tree and index untouched"]
7150 grid $w.f.soft -sticky w
7151 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7152 -text [mc "Mixed: Leave working tree untouched, reset index"]
7153 grid $w.f.mixed -sticky w
7154 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7155 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7156 grid $w.f.hard -sticky w
7157 pack $w.f -side top -fill x
7158 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7159 pack $w.ok -side left -fill x -padx 20 -pady 20
7160 button $w.cancel -text [mc Cancel] -command "destroy $w"
7161 pack $w.cancel -side right -fill x -padx 20 -pady 20
7162 bind $w <Visibility> "grab $w; focus $w"
7163 tkwait window $w
7164 if {!$confirm_ok} return
7165 if {[catch {set fd [open \
7166 [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7167 error_popup $err
7168 } else {
7169 dohidelocalchanges
7170 filerun $fd [list readresetstat $fd]
7171 nowbusy reset [mc "Resetting"]
7172 selbyid $rowmenuid
7173 }
7174}
7175
7176proc readresetstat {fd} {
7177 global mainhead mainheadid showlocalchanges rprogcoord
7178
7179 if {[gets $fd line] >= 0} {
7180 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7181 set rprogcoord [expr {1.0 * $m / $n}]
7182 adjustprogress
7183 }
7184 return 1
7185 }
7186 set rprogcoord 0
7187 adjustprogress
7188 notbusy reset
7189 if {[catch {close $fd} err]} {
7190 error_popup $err
7191 }
7192 set oldhead $mainheadid
7193 set newhead [exec git rev-parse HEAD]
7194 if {$newhead ne $oldhead} {
7195 movehead $newhead $mainhead
7196 movedhead $newhead $mainhead
7197 set mainheadid $newhead
7198 redrawtags $oldhead
7199 redrawtags $newhead
7200 }
7201 if {$showlocalchanges} {
7202 doshowlocalchanges
7203 }
7204 return 0
7205}
7206
7207# context menu for a head
7208proc headmenu {x y id head} {
7209 global headmenuid headmenuhead headctxmenu mainhead
7210
7211 stopfinding
7212 set headmenuid $id
7213 set headmenuhead $head
7214 set state normal
7215 if {$head eq $mainhead} {
7216 set state disabled
7217 }
7218 $headctxmenu entryconfigure 0 -state $state
7219 $headctxmenu entryconfigure 1 -state $state
7220 tk_popup $headctxmenu $x $y
7221}
7222
7223proc cobranch {} {
7224 global headmenuid headmenuhead mainhead headids
7225 global showlocalchanges mainheadid
7226
7227 # check the tree is clean first??
7228 set oldmainhead $mainhead
7229 nowbusy checkout [mc "Checking out"]
7230 update
7231 dohidelocalchanges
7232 if {[catch {
7233 exec git checkout -q $headmenuhead
7234 } err]} {
7235 notbusy checkout
7236 error_popup $err
7237 } else {
7238 notbusy checkout
7239 set mainhead $headmenuhead
7240 set mainheadid $headmenuid
7241 if {[info exists headids($oldmainhead)]} {
7242 redrawtags $headids($oldmainhead)
7243 }
7244 redrawtags $headmenuid
7245 selbyid $headmenuid
7246 }
7247 if {$showlocalchanges} {
7248 dodiffindex
7249 }
7250}
7251
7252proc rmbranch {} {
7253 global headmenuid headmenuhead mainhead
7254 global idheads
7255
7256 set head $headmenuhead
7257 set id $headmenuid
7258 # this check shouldn't be needed any more...
7259 if {$head eq $mainhead} {
7260 error_popup [mc "Cannot delete the currently checked-out branch"]
7261 return
7262 }
7263 set dheads [descheads $id]
7264 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7265 # the stuff on this branch isn't on any other branch
7266 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7267 branch.\nReally delete branch %s?" $head $head]]} return
7268 }
7269 nowbusy rmbranch
7270 update
7271 if {[catch {exec git branch -D $head} err]} {
7272 notbusy rmbranch
7273 error_popup $err
7274 return
7275 }
7276 removehead $id $head
7277 removedhead $id $head
7278 redrawtags $id
7279 notbusy rmbranch
7280 dispneartags 0
7281 run refill_reflist
7282}
7283
7284# Display a list of tags and heads
7285proc showrefs {} {
7286 global showrefstop bgcolor fgcolor selectbgcolor
7287 global bglist fglist reflistfilter reflist maincursor
7288
7289 set top .showrefs
7290 set showrefstop $top
7291 if {[winfo exists $top]} {
7292 raise $top
7293 refill_reflist
7294 return
7295 }
7296 toplevel $top
7297 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7298 text $top.list -background $bgcolor -foreground $fgcolor \
7299 -selectbackground $selectbgcolor -font mainfont \
7300 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7301 -width 30 -height 20 -cursor $maincursor \
7302 -spacing1 1 -spacing3 1 -state disabled
7303 $top.list tag configure highlight -background $selectbgcolor
7304 lappend bglist $top.list
7305 lappend fglist $top.list
7306 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7307 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7308 grid $top.list $top.ysb -sticky nsew
7309 grid $top.xsb x -sticky ew
7310 frame $top.f
7311 label $top.f.l -text "[mc "Filter"]: "
7312 entry $top.f.e -width 20 -textvariable reflistfilter
7313 set reflistfilter "*"
7314 trace add variable reflistfilter write reflistfilter_change
7315 pack $top.f.e -side right -fill x -expand 1
7316 pack $top.f.l -side left
7317 grid $top.f - -sticky ew -pady 2
7318 button $top.close -command [list destroy $top] -text [mc "Close"]
7319 grid $top.close -
7320 grid columnconfigure $top 0 -weight 1
7321 grid rowconfigure $top 0 -weight 1
7322 bind $top.list <1> {break}
7323 bind $top.list <B1-Motion> {break}
7324 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7325 set reflist {}
7326 refill_reflist
7327}
7328
7329proc sel_reflist {w x y} {
7330 global showrefstop reflist headids tagids otherrefids
7331
7332 if {![winfo exists $showrefstop]} return
7333 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7334 set ref [lindex $reflist [expr {$l-1}]]
7335 set n [lindex $ref 0]
7336 switch -- [lindex $ref 1] {
7337 "H" {selbyid $headids($n)}
7338 "T" {selbyid $tagids($n)}
7339 "o" {selbyid $otherrefids($n)}
7340 }
7341 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7342}
7343
7344proc unsel_reflist {} {
7345 global showrefstop
7346
7347 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7348 $showrefstop.list tag remove highlight 0.0 end
7349}
7350
7351proc reflistfilter_change {n1 n2 op} {
7352 global reflistfilter
7353
7354 after cancel refill_reflist
7355 after 200 refill_reflist
7356}
7357
7358proc refill_reflist {} {
7359 global reflist reflistfilter showrefstop headids tagids otherrefids
7360 global curview commitinterest
7361
7362 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7363 set refs {}
7364 foreach n [array names headids] {
7365 if {[string match $reflistfilter $n]} {
7366 if {[commitinview $headids($n) $curview]} {
7367 lappend refs [list $n H]
7368 } else {
7369 set commitinterest($headids($n)) {run refill_reflist}
7370 }
7371 }
7372 }
7373 foreach n [array names tagids] {
7374 if {[string match $reflistfilter $n]} {
7375 if {[commitinview $tagids($n) $curview]} {
7376 lappend refs [list $n T]
7377 } else {
7378 set commitinterest($tagids($n)) {run refill_reflist}
7379 }
7380 }
7381 }
7382 foreach n [array names otherrefids] {
7383 if {[string match $reflistfilter $n]} {
7384 if {[commitinview $otherrefids($n) $curview]} {
7385 lappend refs [list $n o]
7386 } else {
7387 set commitinterest($otherrefids($n)) {run refill_reflist}
7388 }
7389 }
7390 }
7391 set refs [lsort -index 0 $refs]
7392 if {$refs eq $reflist} return
7393
7394 # Update the contents of $showrefstop.list according to the
7395 # differences between $reflist (old) and $refs (new)
7396 $showrefstop.list conf -state normal
7397 $showrefstop.list insert end "\n"
7398 set i 0
7399 set j 0
7400 while {$i < [llength $reflist] || $j < [llength $refs]} {
7401 if {$i < [llength $reflist]} {
7402 if {$j < [llength $refs]} {
7403 set cmp [string compare [lindex $reflist $i 0] \
7404 [lindex $refs $j 0]]
7405 if {$cmp == 0} {
7406 set cmp [string compare [lindex $reflist $i 1] \
7407 [lindex $refs $j 1]]
7408 }
7409 } else {
7410 set cmp -1
7411 }
7412 } else {
7413 set cmp 1
7414 }
7415 switch -- $cmp {
7416 -1 {
7417 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7418 incr i
7419 }
7420 0 {
7421 incr i
7422 incr j
7423 }
7424 1 {
7425 set l [expr {$j + 1}]
7426 $showrefstop.list image create $l.0 -align baseline \
7427 -image reficon-[lindex $refs $j 1] -padx 2
7428 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7429 incr j
7430 }
7431 }
7432 }
7433 set reflist $refs
7434 # delete last newline
7435 $showrefstop.list delete end-2c end-1c
7436 $showrefstop.list conf -state disabled
7437}
7438
7439# Stuff for finding nearby tags
7440proc getallcommits {} {
7441 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7442 global idheads idtags idotherrefs allparents tagobjid
7443
7444 if {![info exists allcommits]} {
7445 set nextarc 0
7446 set allcommits 0
7447 set seeds {}
7448 set allcwait 0
7449 set cachedarcs 0
7450 set allccache [file join [gitdir] "gitk.cache"]
7451 if {![catch {
7452 set f [open $allccache r]
7453 set allcwait 1
7454 getcache $f
7455 }]} return
7456 }
7457
7458 if {$allcwait} {
7459 return
7460 }
7461 set cmd [list | git rev-list --parents]
7462 set allcupdate [expr {$seeds ne {}}]
7463 if {!$allcupdate} {
7464 set ids "--all"
7465 } else {
7466 set refs [concat [array names idheads] [array names idtags] \
7467 [array names idotherrefs]]
7468 set ids {}
7469 set tagobjs {}
7470 foreach name [array names tagobjid] {
7471 lappend tagobjs $tagobjid($name)
7472 }
7473 foreach id [lsort -unique $refs] {
7474 if {![info exists allparents($id)] &&
7475 [lsearch -exact $tagobjs $id] < 0} {
7476 lappend ids $id
7477 }
7478 }
7479 if {$ids ne {}} {
7480 foreach id $seeds {
7481 lappend ids "^$id"
7482 }
7483 }
7484 }
7485 if {$ids ne {}} {
7486 set fd [open [concat $cmd $ids] r]
7487 fconfigure $fd -blocking 0
7488 incr allcommits
7489 nowbusy allcommits
7490 filerun $fd [list getallclines $fd]
7491 } else {
7492 dispneartags 0
7493 }
7494}
7495
7496# Since most commits have 1 parent and 1 child, we group strings of
7497# such commits into "arcs" joining branch/merge points (BMPs), which
7498# are commits that either don't have 1 parent or don't have 1 child.
7499#
7500# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7501# arcout(id) - outgoing arcs for BMP
7502# arcids(a) - list of IDs on arc including end but not start
7503# arcstart(a) - BMP ID at start of arc
7504# arcend(a) - BMP ID at end of arc
7505# growing(a) - arc a is still growing
7506# arctags(a) - IDs out of arcids (excluding end) that have tags
7507# archeads(a) - IDs out of arcids (excluding end) that have heads
7508# The start of an arc is at the descendent end, so "incoming" means
7509# coming from descendents, and "outgoing" means going towards ancestors.
7510
7511proc getallclines {fd} {
7512 global allparents allchildren idtags idheads nextarc
7513 global arcnos arcids arctags arcout arcend arcstart archeads growing
7514 global seeds allcommits cachedarcs allcupdate
7515
7516 set nid 0
7517 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7518 set id [lindex $line 0]
7519 if {[info exists allparents($id)]} {
7520 # seen it already
7521 continue
7522 }
7523 set cachedarcs 0
7524 set olds [lrange $line 1 end]
7525 set allparents($id) $olds
7526 if {![info exists allchildren($id)]} {
7527 set allchildren($id) {}
7528 set arcnos($id) {}
7529 lappend seeds $id
7530 } else {
7531 set a $arcnos($id)
7532 if {[llength $olds] == 1 && [llength $a] == 1} {
7533 lappend arcids($a) $id
7534 if {[info exists idtags($id)]} {
7535 lappend arctags($a) $id
7536 }
7537 if {[info exists idheads($id)]} {
7538 lappend archeads($a) $id
7539 }
7540 if {[info exists allparents($olds)]} {
7541 # seen parent already
7542 if {![info exists arcout($olds)]} {
7543 splitarc $olds
7544 }
7545 lappend arcids($a) $olds
7546 set arcend($a) $olds
7547 unset growing($a)
7548 }
7549 lappend allchildren($olds) $id
7550 lappend arcnos($olds) $a
7551 continue
7552 }
7553 }
7554 foreach a $arcnos($id) {
7555 lappend arcids($a) $id
7556 set arcend($a) $id
7557 unset growing($a)
7558 }
7559
7560 set ao {}
7561 foreach p $olds {
7562 lappend allchildren($p) $id
7563 set a [incr nextarc]
7564 set arcstart($a) $id
7565 set archeads($a) {}
7566 set arctags($a) {}
7567 set archeads($a) {}
7568 set arcids($a) {}
7569 lappend ao $a
7570 set growing($a) 1
7571 if {[info exists allparents($p)]} {
7572 # seen it already, may need to make a new branch
7573 if {![info exists arcout($p)]} {
7574 splitarc $p
7575 }
7576 lappend arcids($a) $p
7577 set arcend($a) $p
7578 unset growing($a)
7579 }
7580 lappend arcnos($p) $a
7581 }
7582 set arcout($id) $ao
7583 }
7584 if {$nid > 0} {
7585 global cached_dheads cached_dtags cached_atags
7586 catch {unset cached_dheads}
7587 catch {unset cached_dtags}
7588 catch {unset cached_atags}
7589 }
7590 if {![eof $fd]} {
7591 return [expr {$nid >= 1000? 2: 1}]
7592 }
7593 set cacheok 1
7594 if {[catch {
7595 fconfigure $fd -blocking 1
7596 close $fd
7597 } err]} {
7598 # got an error reading the list of commits
7599 # if we were updating, try rereading the whole thing again
7600 if {$allcupdate} {
7601 incr allcommits -1
7602 dropcache $err
7603 return
7604 }
7605 error_popup "[mc "Error reading commit topology information;\
7606 branch and preceding/following tag information\
7607 will be incomplete."]\n($err)"
7608 set cacheok 0
7609 }
7610 if {[incr allcommits -1] == 0} {
7611 notbusy allcommits
7612 if {$cacheok} {
7613 run savecache
7614 }
7615 }
7616 dispneartags 0
7617 return 0
7618}
7619
7620proc recalcarc {a} {
7621 global arctags archeads arcids idtags idheads
7622
7623 set at {}
7624 set ah {}
7625 foreach id [lrange $arcids($a) 0 end-1] {
7626 if {[info exists idtags($id)]} {
7627 lappend at $id
7628 }
7629 if {[info exists idheads($id)]} {
7630 lappend ah $id
7631 }
7632 }
7633 set arctags($a) $at
7634 set archeads($a) $ah
7635}
7636
7637proc splitarc {p} {
7638 global arcnos arcids nextarc arctags archeads idtags idheads
7639 global arcstart arcend arcout allparents growing
7640
7641 set a $arcnos($p)
7642 if {[llength $a] != 1} {
7643 puts "oops splitarc called but [llength $a] arcs already"
7644 return
7645 }
7646 set a [lindex $a 0]
7647 set i [lsearch -exact $arcids($a) $p]
7648 if {$i < 0} {
7649 puts "oops splitarc $p not in arc $a"
7650 return
7651 }
7652 set na [incr nextarc]
7653 if {[info exists arcend($a)]} {
7654 set arcend($na) $arcend($a)
7655 } else {
7656 set l [lindex $allparents([lindex $arcids($a) end]) 0]
7657 set j [lsearch -exact $arcnos($l) $a]
7658 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7659 }
7660 set tail [lrange $arcids($a) [expr {$i+1}] end]
7661 set arcids($a) [lrange $arcids($a) 0 $i]
7662 set arcend($a) $p
7663 set arcstart($na) $p
7664 set arcout($p) $na
7665 set arcids($na) $tail
7666 if {[info exists growing($a)]} {
7667 set growing($na) 1
7668 unset growing($a)
7669 }
7670
7671 foreach id $tail {
7672 if {[llength $arcnos($id)] == 1} {
7673 set arcnos($id) $na
7674 } else {
7675 set j [lsearch -exact $arcnos($id) $a]
7676 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7677 }
7678 }
7679
7680 # reconstruct tags and heads lists
7681 if {$arctags($a) ne {} || $archeads($a) ne {}} {
7682 recalcarc $a
7683 recalcarc $na
7684 } else {
7685 set arctags($na) {}
7686 set archeads($na) {}
7687 }
7688}
7689
7690# Update things for a new commit added that is a child of one
7691# existing commit. Used when cherry-picking.
7692proc addnewchild {id p} {
7693 global allparents allchildren idtags nextarc
7694 global arcnos arcids arctags arcout arcend arcstart archeads growing
7695 global seeds allcommits
7696
7697 if {![info exists allcommits] || ![info exists arcnos($p)]} return
7698 set allparents($id) [list $p]
7699 set allchildren($id) {}
7700 set arcnos($id) {}
7701 lappend seeds $id
7702 lappend allchildren($p) $id
7703 set a [incr nextarc]
7704 set arcstart($a) $id
7705 set archeads($a) {}
7706 set arctags($a) {}
7707 set arcids($a) [list $p]
7708 set arcend($a) $p
7709 if {![info exists arcout($p)]} {
7710 splitarc $p
7711 }
7712 lappend arcnos($p) $a
7713 set arcout($id) [list $a]
7714}
7715
7716# This implements a cache for the topology information.
7717# The cache saves, for each arc, the start and end of the arc,
7718# the ids on the arc, and the outgoing arcs from the end.
7719proc readcache {f} {
7720 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7721 global idtags idheads allparents cachedarcs possible_seeds seeds growing
7722 global allcwait
7723
7724 set a $nextarc
7725 set lim $cachedarcs
7726 if {$lim - $a > 500} {
7727 set lim [expr {$a + 500}]
7728 }
7729 if {[catch {
7730 if {$a == $lim} {
7731 # finish reading the cache and setting up arctags, etc.
7732 set line [gets $f]
7733 if {$line ne "1"} {error "bad final version"}
7734 close $f
7735 foreach id [array names idtags] {
7736 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7737 [llength $allparents($id)] == 1} {
7738 set a [lindex $arcnos($id) 0]
7739 if {$arctags($a) eq {}} {
7740 recalcarc $a
7741 }
7742 }
7743 }
7744 foreach id [array names idheads] {
7745 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7746 [llength $allparents($id)] == 1} {
7747 set a [lindex $arcnos($id) 0]
7748 if {$archeads($a) eq {}} {
7749 recalcarc $a
7750 }
7751 }
7752 }
7753 foreach id [lsort -unique $possible_seeds] {
7754 if {$arcnos($id) eq {}} {
7755 lappend seeds $id
7756 }
7757 }
7758 set allcwait 0
7759 } else {
7760 while {[incr a] <= $lim} {
7761 set line [gets $f]
7762 if {[llength $line] != 3} {error "bad line"}
7763 set s [lindex $line 0]
7764 set arcstart($a) $s
7765 lappend arcout($s) $a
7766 if {![info exists arcnos($s)]} {
7767 lappend possible_seeds $s
7768 set arcnos($s) {}
7769 }
7770 set e [lindex $line 1]
7771 if {$e eq {}} {
7772 set growing($a) 1
7773 } else {
7774 set arcend($a) $e
7775 if {![info exists arcout($e)]} {
7776 set arcout($e) {}
7777 }
7778 }
7779 set arcids($a) [lindex $line 2]
7780 foreach id $arcids($a) {
7781 lappend allparents($s) $id
7782 set s $id
7783 lappend arcnos($id) $a
7784 }
7785 if {![info exists allparents($s)]} {
7786 set allparents($s) {}
7787 }
7788 set arctags($a) {}
7789 set archeads($a) {}
7790 }
7791 set nextarc [expr {$a - 1}]
7792 }
7793 } err]} {
7794 dropcache $err
7795 return 0
7796 }
7797 if {!$allcwait} {
7798 getallcommits
7799 }
7800 return $allcwait
7801}
7802
7803proc getcache {f} {
7804 global nextarc cachedarcs possible_seeds
7805
7806 if {[catch {
7807 set line [gets $f]
7808 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7809 # make sure it's an integer
7810 set cachedarcs [expr {int([lindex $line 1])}]
7811 if {$cachedarcs < 0} {error "bad number of arcs"}
7812 set nextarc 0
7813 set possible_seeds {}
7814 run readcache $f
7815 } err]} {
7816 dropcache $err
7817 }
7818 return 0
7819}
7820
7821proc dropcache {err} {
7822 global allcwait nextarc cachedarcs seeds
7823
7824 #puts "dropping cache ($err)"
7825 foreach v {arcnos arcout arcids arcstart arcend growing \
7826 arctags archeads allparents allchildren} {
7827 global $v
7828 catch {unset $v}
7829 }
7830 set allcwait 0
7831 set nextarc 0
7832 set cachedarcs 0
7833 set seeds {}
7834 getallcommits
7835}
7836
7837proc writecache {f} {
7838 global cachearc cachedarcs allccache
7839 global arcstart arcend arcnos arcids arcout
7840
7841 set a $cachearc
7842 set lim $cachedarcs
7843 if {$lim - $a > 1000} {
7844 set lim [expr {$a + 1000}]
7845 }
7846 if {[catch {
7847 while {[incr a] <= $lim} {
7848 if {[info exists arcend($a)]} {
7849 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7850 } else {
7851 puts $f [list $arcstart($a) {} $arcids($a)]
7852 }
7853 }
7854 } err]} {
7855 catch {close $f}
7856 catch {file delete $allccache}
7857 #puts "writing cache failed ($err)"
7858 return 0
7859 }
7860 set cachearc [expr {$a - 1}]
7861 if {$a > $cachedarcs} {
7862 puts $f "1"
7863 close $f
7864 return 0
7865 }
7866 return 1
7867}
7868
7869proc savecache {} {
7870 global nextarc cachedarcs cachearc allccache
7871
7872 if {$nextarc == $cachedarcs} return
7873 set cachearc 0
7874 set cachedarcs $nextarc
7875 catch {
7876 set f [open $allccache w]
7877 puts $f [list 1 $cachedarcs]
7878 run writecache $f
7879 }
7880}
7881
7882# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7883# or 0 if neither is true.
7884proc anc_or_desc {a b} {
7885 global arcout arcstart arcend arcnos cached_isanc
7886
7887 if {$arcnos($a) eq $arcnos($b)} {
7888 # Both are on the same arc(s); either both are the same BMP,
7889 # or if one is not a BMP, the other is also not a BMP or is
7890 # the BMP at end of the arc (and it only has 1 incoming arc).
7891 # Or both can be BMPs with no incoming arcs.
7892 if {$a eq $b || $arcnos($a) eq {}} {
7893 return 0
7894 }
7895 # assert {[llength $arcnos($a)] == 1}
7896 set arc [lindex $arcnos($a) 0]
7897 set i [lsearch -exact $arcids($arc) $a]
7898 set j [lsearch -exact $arcids($arc) $b]
7899 if {$i < 0 || $i > $j} {
7900 return 1
7901 } else {
7902 return -1
7903 }
7904 }
7905
7906 if {![info exists arcout($a)]} {
7907 set arc [lindex $arcnos($a) 0]
7908 if {[info exists arcend($arc)]} {
7909 set aend $arcend($arc)
7910 } else {
7911 set aend {}
7912 }
7913 set a $arcstart($arc)
7914 } else {
7915 set aend $a
7916 }
7917 if {![info exists arcout($b)]} {
7918 set arc [lindex $arcnos($b) 0]
7919 if {[info exists arcend($arc)]} {
7920 set bend $arcend($arc)
7921 } else {
7922 set bend {}
7923 }
7924 set b $arcstart($arc)
7925 } else {
7926 set bend $b
7927 }
7928 if {$a eq $bend} {
7929 return 1
7930 }
7931 if {$b eq $aend} {
7932 return -1
7933 }
7934 if {[info exists cached_isanc($a,$bend)]} {
7935 if {$cached_isanc($a,$bend)} {
7936 return 1
7937 }
7938 }
7939 if {[info exists cached_isanc($b,$aend)]} {
7940 if {$cached_isanc($b,$aend)} {
7941 return -1
7942 }
7943 if {[info exists cached_isanc($a,$bend)]} {
7944 return 0
7945 }
7946 }
7947
7948 set todo [list $a $b]
7949 set anc($a) a
7950 set anc($b) b
7951 for {set i 0} {$i < [llength $todo]} {incr i} {
7952 set x [lindex $todo $i]
7953 if {$anc($x) eq {}} {
7954 continue
7955 }
7956 foreach arc $arcnos($x) {
7957 set xd $arcstart($arc)
7958 if {$xd eq $bend} {
7959 set cached_isanc($a,$bend) 1
7960 set cached_isanc($b,$aend) 0
7961 return 1
7962 } elseif {$xd eq $aend} {
7963 set cached_isanc($b,$aend) 1
7964 set cached_isanc($a,$bend) 0
7965 return -1
7966 }
7967 if {![info exists anc($xd)]} {
7968 set anc($xd) $anc($x)
7969 lappend todo $xd
7970 } elseif {$anc($xd) ne $anc($x)} {
7971 set anc($xd) {}
7972 }
7973 }
7974 }
7975 set cached_isanc($a,$bend) 0
7976 set cached_isanc($b,$aend) 0
7977 return 0
7978}
7979
7980# This identifies whether $desc has an ancestor that is
7981# a growing tip of the graph and which is not an ancestor of $anc
7982# and returns 0 if so and 1 if not.
7983# If we subsequently discover a tag on such a growing tip, and that
7984# turns out to be a descendent of $anc (which it could, since we
7985# don't necessarily see children before parents), then $desc
7986# isn't a good choice to display as a descendent tag of
7987# $anc (since it is the descendent of another tag which is
7988# a descendent of $anc). Similarly, $anc isn't a good choice to
7989# display as a ancestor tag of $desc.
7990#
7991proc is_certain {desc anc} {
7992 global arcnos arcout arcstart arcend growing problems
7993
7994 set certain {}
7995 if {[llength $arcnos($anc)] == 1} {
7996 # tags on the same arc are certain
7997 if {$arcnos($desc) eq $arcnos($anc)} {
7998 return 1
7999 }
8000 if {![info exists arcout($anc)]} {
8001 # if $anc is partway along an arc, use the start of the arc instead
8002 set a [lindex $arcnos($anc) 0]
8003 set anc $arcstart($a)
8004 }
8005 }
8006 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8007 set x $desc
8008 } else {
8009 set a [lindex $arcnos($desc) 0]
8010 set x $arcend($a)
8011 }
8012 if {$x == $anc} {
8013 return 1
8014 }
8015 set anclist [list $x]
8016 set dl($x) 1
8017 set nnh 1
8018 set ngrowanc 0
8019 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8020 set x [lindex $anclist $i]
8021 if {$dl($x)} {
8022 incr nnh -1
8023 }
8024 set done($x) 1
8025 foreach a $arcout($x) {
8026 if {[info exists growing($a)]} {
8027 if {![info exists growanc($x)] && $dl($x)} {
8028 set growanc($x) 1
8029 incr ngrowanc
8030 }
8031 } else {
8032 set y $arcend($a)
8033 if {[info exists dl($y)]} {
8034 if {$dl($y)} {
8035 if {!$dl($x)} {
8036 set dl($y) 0
8037 if {![info exists done($y)]} {
8038 incr nnh -1
8039 }
8040 if {[info exists growanc($x)]} {
8041 incr ngrowanc -1
8042 }
8043 set xl [list $y]
8044 for {set k 0} {$k < [llength $xl]} {incr k} {
8045 set z [lindex $xl $k]
8046 foreach c $arcout($z) {
8047 if {[info exists arcend($c)]} {
8048 set v $arcend($c)
8049 if {[info exists dl($v)] && $dl($v)} {
8050 set dl($v) 0
8051 if {![info exists done($v)]} {
8052 incr nnh -1
8053 }
8054 if {[info exists growanc($v)]} {
8055 incr ngrowanc -1
8056 }
8057 lappend xl $v
8058 }
8059 }
8060 }
8061 }
8062 }
8063 }
8064 } elseif {$y eq $anc || !$dl($x)} {
8065 set dl($y) 0
8066 lappend anclist $y
8067 } else {
8068 set dl($y) 1
8069 lappend anclist $y
8070 incr nnh
8071 }
8072 }
8073 }
8074 }
8075 foreach x [array names growanc] {
8076 if {$dl($x)} {
8077 return 0
8078 }
8079 return 0
8080 }
8081 return 1
8082}
8083
8084proc validate_arctags {a} {
8085 global arctags idtags
8086
8087 set i -1
8088 set na $arctags($a)
8089 foreach id $arctags($a) {
8090 incr i
8091 if {![info exists idtags($id)]} {
8092 set na [lreplace $na $i $i]
8093 incr i -1
8094 }
8095 }
8096 set arctags($a) $na
8097}
8098
8099proc validate_archeads {a} {
8100 global archeads idheads
8101
8102 set i -1
8103 set na $archeads($a)
8104 foreach id $archeads($a) {
8105 incr i
8106 if {![info exists idheads($id)]} {
8107 set na [lreplace $na $i $i]
8108 incr i -1
8109 }
8110 }
8111 set archeads($a) $na
8112}
8113
8114# Return the list of IDs that have tags that are descendents of id,
8115# ignoring IDs that are descendents of IDs already reported.
8116proc desctags {id} {
8117 global arcnos arcstart arcids arctags idtags allparents
8118 global growing cached_dtags
8119
8120 if {![info exists allparents($id)]} {
8121 return {}
8122 }
8123 set t1 [clock clicks -milliseconds]
8124 set argid $id
8125 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8126 # part-way along an arc; check that arc first
8127 set a [lindex $arcnos($id) 0]
8128 if {$arctags($a) ne {}} {
8129 validate_arctags $a
8130 set i [lsearch -exact $arcids($a) $id]
8131 set tid {}
8132 foreach t $arctags($a) {
8133 set j [lsearch -exact $arcids($a) $t]
8134 if {$j >= $i} break
8135 set tid $t
8136 }
8137 if {$tid ne {}} {
8138 return $tid
8139 }
8140 }
8141 set id $arcstart($a)
8142 if {[info exists idtags($id)]} {
8143 return $id
8144 }
8145 }
8146 if {[info exists cached_dtags($id)]} {
8147 return $cached_dtags($id)
8148 }
8149
8150 set origid $id
8151 set todo [list $id]
8152 set queued($id) 1
8153 set nc 1
8154 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8155 set id [lindex $todo $i]
8156 set done($id) 1
8157 set ta [info exists hastaggedancestor($id)]
8158 if {!$ta} {
8159 incr nc -1
8160 }
8161 # ignore tags on starting node
8162 if {!$ta && $i > 0} {
8163 if {[info exists idtags($id)]} {
8164 set tagloc($id) $id
8165 set ta 1
8166 } elseif {[info exists cached_dtags($id)]} {
8167 set tagloc($id) $cached_dtags($id)
8168 set ta 1
8169 }
8170 }
8171 foreach a $arcnos($id) {
8172 set d $arcstart($a)
8173 if {!$ta && $arctags($a) ne {}} {
8174 validate_arctags $a
8175 if {$arctags($a) ne {}} {
8176 lappend tagloc($id) [lindex $arctags($a) end]
8177 }
8178 }
8179 if {$ta || $arctags($a) ne {}} {
8180 set tomark [list $d]
8181 for {set j 0} {$j < [llength $tomark]} {incr j} {
8182 set dd [lindex $tomark $j]
8183 if {![info exists hastaggedancestor($dd)]} {
8184 if {[info exists done($dd)]} {
8185 foreach b $arcnos($dd) {
8186 lappend tomark $arcstart($b)
8187 }
8188 if {[info exists tagloc($dd)]} {
8189 unset tagloc($dd)
8190 }
8191 } elseif {[info exists queued($dd)]} {
8192 incr nc -1
8193 }
8194 set hastaggedancestor($dd) 1
8195 }
8196 }
8197 }
8198 if {![info exists queued($d)]} {
8199 lappend todo $d
8200 set queued($d) 1
8201 if {![info exists hastaggedancestor($d)]} {
8202 incr nc
8203 }
8204 }
8205 }
8206 }
8207 set tags {}
8208 foreach id [array names tagloc] {
8209 if {![info exists hastaggedancestor($id)]} {
8210 foreach t $tagloc($id) {
8211 if {[lsearch -exact $tags $t] < 0} {
8212 lappend tags $t
8213 }
8214 }
8215 }
8216 }
8217 set t2 [clock clicks -milliseconds]
8218 set loopix $i
8219
8220 # remove tags that are descendents of other tags
8221 for {set i 0} {$i < [llength $tags]} {incr i} {
8222 set a [lindex $tags $i]
8223 for {set j 0} {$j < $i} {incr j} {
8224 set b [lindex $tags $j]
8225 set r [anc_or_desc $a $b]
8226 if {$r == 1} {
8227 set tags [lreplace $tags $j $j]
8228 incr j -1
8229 incr i -1
8230 } elseif {$r == -1} {
8231 set tags [lreplace $tags $i $i]
8232 incr i -1
8233 break
8234 }
8235 }
8236 }
8237
8238 if {[array names growing] ne {}} {
8239 # graph isn't finished, need to check if any tag could get
8240 # eclipsed by another tag coming later. Simply ignore any
8241 # tags that could later get eclipsed.
8242 set ctags {}
8243 foreach t $tags {
8244 if {[is_certain $t $origid]} {
8245 lappend ctags $t
8246 }
8247 }
8248 if {$tags eq $ctags} {
8249 set cached_dtags($origid) $tags
8250 } else {
8251 set tags $ctags
8252 }
8253 } else {
8254 set cached_dtags($origid) $tags
8255 }
8256 set t3 [clock clicks -milliseconds]
8257 if {0 && $t3 - $t1 >= 100} {
8258 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8259 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8260 }
8261 return $tags
8262}
8263
8264proc anctags {id} {
8265 global arcnos arcids arcout arcend arctags idtags allparents
8266 global growing cached_atags
8267
8268 if {![info exists allparents($id)]} {
8269 return {}
8270 }
8271 set t1 [clock clicks -milliseconds]
8272 set argid $id
8273 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8274 # part-way along an arc; check that arc first
8275 set a [lindex $arcnos($id) 0]
8276 if {$arctags($a) ne {}} {
8277 validate_arctags $a
8278 set i [lsearch -exact $arcids($a) $id]
8279 foreach t $arctags($a) {
8280 set j [lsearch -exact $arcids($a) $t]
8281 if {$j > $i} {
8282 return $t
8283 }
8284 }
8285 }
8286 if {![info exists arcend($a)]} {
8287 return {}
8288 }
8289 set id $arcend($a)
8290 if {[info exists idtags($id)]} {
8291 return $id
8292 }
8293 }
8294 if {[info exists cached_atags($id)]} {
8295 return $cached_atags($id)
8296 }
8297
8298 set origid $id
8299 set todo [list $id]
8300 set queued($id) 1
8301 set taglist {}
8302 set nc 1
8303 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8304 set id [lindex $todo $i]
8305 set done($id) 1
8306 set td [info exists hastaggeddescendent($id)]
8307 if {!$td} {
8308 incr nc -1
8309 }
8310 # ignore tags on starting node
8311 if {!$td && $i > 0} {
8312 if {[info exists idtags($id)]} {
8313 set tagloc($id) $id
8314 set td 1
8315 } elseif {[info exists cached_atags($id)]} {
8316 set tagloc($id) $cached_atags($id)
8317 set td 1
8318 }
8319 }
8320 foreach a $arcout($id) {
8321 if {!$td && $arctags($a) ne {}} {
8322 validate_arctags $a
8323 if {$arctags($a) ne {}} {
8324 lappend tagloc($id) [lindex $arctags($a) 0]
8325 }
8326 }
8327 if {![info exists arcend($a)]} continue
8328 set d $arcend($a)
8329 if {$td || $arctags($a) ne {}} {
8330 set tomark [list $d]
8331 for {set j 0} {$j < [llength $tomark]} {incr j} {
8332 set dd [lindex $tomark $j]
8333 if {![info exists hastaggeddescendent($dd)]} {
8334 if {[info exists done($dd)]} {
8335 foreach b $arcout($dd) {
8336 if {[info exists arcend($b)]} {
8337 lappend tomark $arcend($b)
8338 }
8339 }
8340 if {[info exists tagloc($dd)]} {
8341 unset tagloc($dd)
8342 }
8343 } elseif {[info exists queued($dd)]} {
8344 incr nc -1
8345 }
8346 set hastaggeddescendent($dd) 1
8347 }
8348 }
8349 }
8350 if {![info exists queued($d)]} {
8351 lappend todo $d
8352 set queued($d) 1
8353 if {![info exists hastaggeddescendent($d)]} {
8354 incr nc
8355 }
8356 }
8357 }
8358 }
8359 set t2 [clock clicks -milliseconds]
8360 set loopix $i
8361 set tags {}
8362 foreach id [array names tagloc] {
8363 if {![info exists hastaggeddescendent($id)]} {
8364 foreach t $tagloc($id) {
8365 if {[lsearch -exact $tags $t] < 0} {
8366 lappend tags $t
8367 }
8368 }
8369 }
8370 }
8371
8372 # remove tags that are ancestors of other tags
8373 for {set i 0} {$i < [llength $tags]} {incr i} {
8374 set a [lindex $tags $i]
8375 for {set j 0} {$j < $i} {incr j} {
8376 set b [lindex $tags $j]
8377 set r [anc_or_desc $a $b]
8378 if {$r == -1} {
8379 set tags [lreplace $tags $j $j]
8380 incr j -1
8381 incr i -1
8382 } elseif {$r == 1} {
8383 set tags [lreplace $tags $i $i]
8384 incr i -1
8385 break
8386 }
8387 }
8388 }
8389
8390 if {[array names growing] ne {}} {
8391 # graph isn't finished, need to check if any tag could get
8392 # eclipsed by another tag coming later. Simply ignore any
8393 # tags that could later get eclipsed.
8394 set ctags {}
8395 foreach t $tags {
8396 if {[is_certain $origid $t]} {
8397 lappend ctags $t
8398 }
8399 }
8400 if {$tags eq $ctags} {
8401 set cached_atags($origid) $tags
8402 } else {
8403 set tags $ctags
8404 }
8405 } else {
8406 set cached_atags($origid) $tags
8407 }
8408 set t3 [clock clicks -milliseconds]
8409 if {0 && $t3 - $t1 >= 100} {
8410 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8411 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8412 }
8413 return $tags
8414}
8415
8416# Return the list of IDs that have heads that are descendents of id,
8417# including id itself if it has a head.
8418proc descheads {id} {
8419 global arcnos arcstart arcids archeads idheads cached_dheads
8420 global allparents
8421
8422 if {![info exists allparents($id)]} {
8423 return {}
8424 }
8425 set aret {}
8426 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8427 # part-way along an arc; check it first
8428 set a [lindex $arcnos($id) 0]
8429 if {$archeads($a) ne {}} {
8430 validate_archeads $a
8431 set i [lsearch -exact $arcids($a) $id]
8432 foreach t $archeads($a) {
8433 set j [lsearch -exact $arcids($a) $t]
8434 if {$j > $i} break
8435 lappend aret $t
8436 }
8437 }
8438 set id $arcstart($a)
8439 }
8440 set origid $id
8441 set todo [list $id]
8442 set seen($id) 1
8443 set ret {}
8444 for {set i 0} {$i < [llength $todo]} {incr i} {
8445 set id [lindex $todo $i]
8446 if {[info exists cached_dheads($id)]} {
8447 set ret [concat $ret $cached_dheads($id)]
8448 } else {
8449 if {[info exists idheads($id)]} {
8450 lappend ret $id
8451 }
8452 foreach a $arcnos($id) {
8453 if {$archeads($a) ne {}} {
8454 validate_archeads $a
8455 if {$archeads($a) ne {}} {
8456 set ret [concat $ret $archeads($a)]
8457 }
8458 }
8459 set d $arcstart($a)
8460 if {![info exists seen($d)]} {
8461 lappend todo $d
8462 set seen($d) 1
8463 }
8464 }
8465 }
8466 }
8467 set ret [lsort -unique $ret]
8468 set cached_dheads($origid) $ret
8469 return [concat $ret $aret]
8470}
8471
8472proc addedtag {id} {
8473 global arcnos arcout cached_dtags cached_atags
8474
8475 if {![info exists arcnos($id)]} return
8476 if {![info exists arcout($id)]} {
8477 recalcarc [lindex $arcnos($id) 0]
8478 }
8479 catch {unset cached_dtags}
8480 catch {unset cached_atags}
8481}
8482
8483proc addedhead {hid head} {
8484 global arcnos arcout cached_dheads
8485
8486 if {![info exists arcnos($hid)]} return
8487 if {![info exists arcout($hid)]} {
8488 recalcarc [lindex $arcnos($hid) 0]
8489 }
8490 catch {unset cached_dheads}
8491}
8492
8493proc removedhead {hid head} {
8494 global cached_dheads
8495
8496 catch {unset cached_dheads}
8497}
8498
8499proc movedhead {hid head} {
8500 global arcnos arcout cached_dheads
8501
8502 if {![info exists arcnos($hid)]} return
8503 if {![info exists arcout($hid)]} {
8504 recalcarc [lindex $arcnos($hid) 0]
8505 }
8506 catch {unset cached_dheads}
8507}
8508
8509proc changedrefs {} {
8510 global cached_dheads cached_dtags cached_atags
8511 global arctags archeads arcnos arcout idheads idtags
8512
8513 foreach id [concat [array names idheads] [array names idtags]] {
8514 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8515 set a [lindex $arcnos($id) 0]
8516 if {![info exists donearc($a)]} {
8517 recalcarc $a
8518 set donearc($a) 1
8519 }
8520 }
8521 }
8522 catch {unset cached_dtags}
8523 catch {unset cached_atags}
8524 catch {unset cached_dheads}
8525}
8526
8527proc rereadrefs {} {
8528 global idtags idheads idotherrefs mainheadid
8529
8530 set refids [concat [array names idtags] \
8531 [array names idheads] [array names idotherrefs]]
8532 foreach id $refids {
8533 if {![info exists ref($id)]} {
8534 set ref($id) [listrefs $id]
8535 }
8536 }
8537 set oldmainhead $mainheadid
8538 readrefs
8539 changedrefs
8540 set refids [lsort -unique [concat $refids [array names idtags] \
8541 [array names idheads] [array names idotherrefs]]]
8542 foreach id $refids {
8543 set v [listrefs $id]
8544 if {![info exists ref($id)] || $ref($id) != $v ||
8545 ($id eq $oldmainhead && $id ne $mainheadid) ||
8546 ($id eq $mainheadid && $id ne $oldmainhead)} {
8547 redrawtags $id
8548 }
8549 }
8550 run refill_reflist
8551}
8552
8553proc listrefs {id} {
8554 global idtags idheads idotherrefs
8555
8556 set x {}
8557 if {[info exists idtags($id)]} {
8558 set x $idtags($id)
8559 }
8560 set y {}
8561 if {[info exists idheads($id)]} {
8562 set y $idheads($id)
8563 }
8564 set z {}
8565 if {[info exists idotherrefs($id)]} {
8566 set z $idotherrefs($id)
8567 }
8568 return [list $x $y $z]
8569}
8570
8571proc showtag {tag isnew} {
8572 global ctext tagcontents tagids linknum tagobjid
8573
8574 if {$isnew} {
8575 addtohistory [list showtag $tag 0]
8576 }
8577 $ctext conf -state normal
8578 clear_ctext
8579 settabs 0
8580 set linknum 0
8581 if {![info exists tagcontents($tag)]} {
8582 catch {
8583 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8584 }
8585 }
8586 if {[info exists tagcontents($tag)]} {
8587 set text $tagcontents($tag)
8588 } else {
8589 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
8590 }
8591 appendwithlinks $text {}
8592 $ctext conf -state disabled
8593 init_flist {}
8594}
8595
8596proc doquit {} {
8597 global stopped
8598 set stopped 100
8599 savestuff .
8600 destroy .
8601}
8602
8603proc mkfontdisp {font top which} {
8604 global fontattr fontpref $font
8605
8606 set fontpref($font) [set $font]
8607 button $top.${font}but -text $which -font optionfont \
8608 -command [list choosefont $font $which]
8609 label $top.$font -relief flat -font $font \
8610 -text $fontattr($font,family) -justify left
8611 grid x $top.${font}but $top.$font -sticky w
8612}
8613
8614proc choosefont {font which} {
8615 global fontparam fontlist fonttop fontattr
8616
8617 set fontparam(which) $which
8618 set fontparam(font) $font
8619 set fontparam(family) [font actual $font -family]
8620 set fontparam(size) $fontattr($font,size)
8621 set fontparam(weight) $fontattr($font,weight)
8622 set fontparam(slant) $fontattr($font,slant)
8623 set top .gitkfont
8624 set fonttop $top
8625 if {![winfo exists $top]} {
8626 font create sample
8627 eval font config sample [font actual $font]
8628 toplevel $top
8629 wm title $top [mc "Gitk font chooser"]
8630 label $top.l -textvariable fontparam(which)
8631 pack $top.l -side top
8632 set fontlist [lsort [font families]]
8633 frame $top.f
8634 listbox $top.f.fam -listvariable fontlist \
8635 -yscrollcommand [list $top.f.sb set]
8636 bind $top.f.fam <<ListboxSelect>> selfontfam
8637 scrollbar $top.f.sb -command [list $top.f.fam yview]
8638 pack $top.f.sb -side right -fill y
8639 pack $top.f.fam -side left -fill both -expand 1
8640 pack $top.f -side top -fill both -expand 1
8641 frame $top.g
8642 spinbox $top.g.size -from 4 -to 40 -width 4 \
8643 -textvariable fontparam(size) \
8644 -validatecommand {string is integer -strict %s}
8645 checkbutton $top.g.bold -padx 5 \
8646 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8647 -variable fontparam(weight) -onvalue bold -offvalue normal
8648 checkbutton $top.g.ital -padx 5 \
8649 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
8650 -variable fontparam(slant) -onvalue italic -offvalue roman
8651 pack $top.g.size $top.g.bold $top.g.ital -side left
8652 pack $top.g -side top
8653 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8654 -background white
8655 $top.c create text 100 25 -anchor center -text $which -font sample \
8656 -fill black -tags text
8657 bind $top.c <Configure> [list centertext $top.c]
8658 pack $top.c -side top -fill x
8659 frame $top.buts
8660 button $top.buts.ok -text [mc "OK"] -command fontok -default active
8661 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8662 grid $top.buts.ok $top.buts.can
8663 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8664 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8665 pack $top.buts -side bottom -fill x
8666 trace add variable fontparam write chg_fontparam
8667 } else {
8668 raise $top
8669 $top.c itemconf text -text $which
8670 }
8671 set i [lsearch -exact $fontlist $fontparam(family)]
8672 if {$i >= 0} {
8673 $top.f.fam selection set $i
8674 $top.f.fam see $i
8675 }
8676}
8677
8678proc centertext {w} {
8679 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8680}
8681
8682proc fontok {} {
8683 global fontparam fontpref prefstop
8684
8685 set f $fontparam(font)
8686 set fontpref($f) [list $fontparam(family) $fontparam(size)]
8687 if {$fontparam(weight) eq "bold"} {
8688 lappend fontpref($f) "bold"
8689 }
8690 if {$fontparam(slant) eq "italic"} {
8691 lappend fontpref($f) "italic"
8692 }
8693 set w $prefstop.$f
8694 $w conf -text $fontparam(family) -font $fontpref($f)
8695
8696 fontcan
8697}
8698
8699proc fontcan {} {
8700 global fonttop fontparam
8701
8702 if {[info exists fonttop]} {
8703 catch {destroy $fonttop}
8704 catch {font delete sample}
8705 unset fonttop
8706 unset fontparam
8707 }
8708}
8709
8710proc selfontfam {} {
8711 global fonttop fontparam
8712
8713 set i [$fonttop.f.fam curselection]
8714 if {$i ne {}} {
8715 set fontparam(family) [$fonttop.f.fam get $i]
8716 }
8717}
8718
8719proc chg_fontparam {v sub op} {
8720 global fontparam
8721
8722 font config sample -$sub $fontparam($sub)
8723}
8724
8725proc doprefs {} {
8726 global maxwidth maxgraphpct
8727 global oldprefs prefstop showneartags showlocalchanges
8728 global bgcolor fgcolor ctext diffcolors selectbgcolor
8729 global tabstop limitdiffs
8730
8731 set top .gitkprefs
8732 set prefstop $top
8733 if {[winfo exists $top]} {
8734 raise $top
8735 return
8736 }
8737 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8738 limitdiffs tabstop} {
8739 set oldprefs($v) [set $v]
8740 }
8741 toplevel $top
8742 wm title $top [mc "Gitk preferences"]
8743 label $top.ldisp -text [mc "Commit list display options"]
8744 grid $top.ldisp - -sticky w -pady 10
8745 label $top.spacer -text " "
8746 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8747 -font optionfont
8748 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8749 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8750 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8751 -font optionfont
8752 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8753 grid x $top.maxpctl $top.maxpct -sticky w
8754 frame $top.showlocal
8755 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8756 checkbutton $top.showlocal.b -variable showlocalchanges
8757 pack $top.showlocal.b $top.showlocal.l -side left
8758 grid x $top.showlocal -sticky w
8759
8760 label $top.ddisp -text [mc "Diff display options"]
8761 grid $top.ddisp - -sticky w -pady 10
8762 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8763 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8764 grid x $top.tabstopl $top.tabstop -sticky w
8765 frame $top.ntag
8766 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8767 checkbutton $top.ntag.b -variable showneartags
8768 pack $top.ntag.b $top.ntag.l -side left
8769 grid x $top.ntag -sticky w
8770 frame $top.ldiff
8771 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8772 checkbutton $top.ldiff.b -variable limitdiffs
8773 pack $top.ldiff.b $top.ldiff.l -side left
8774 grid x $top.ldiff -sticky w
8775
8776 label $top.cdisp -text [mc "Colors: press to choose"]
8777 grid $top.cdisp - -sticky w -pady 10
8778 label $top.bg -padx 40 -relief sunk -background $bgcolor
8779 button $top.bgbut -text [mc "Background"] -font optionfont \
8780 -command [list choosecolor bgcolor 0 $top.bg background setbg]
8781 grid x $top.bgbut $top.bg -sticky w
8782 label $top.fg -padx 40 -relief sunk -background $fgcolor
8783 button $top.fgbut -text [mc "Foreground"] -font optionfont \
8784 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8785 grid x $top.fgbut $top.fg -sticky w
8786 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8787 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8788 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8789 [list $ctext tag conf d0 -foreground]]
8790 grid x $top.diffoldbut $top.diffold -sticky w
8791 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8792 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8793 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8794 [list $ctext tag conf d1 -foreground]]
8795 grid x $top.diffnewbut $top.diffnew -sticky w
8796 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8797 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8798 -command [list choosecolor diffcolors 2 $top.hunksep \
8799 "diff hunk header" \
8800 [list $ctext tag conf hunksep -foreground]]
8801 grid x $top.hunksepbut $top.hunksep -sticky w
8802 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8803 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8804 -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8805 grid x $top.selbgbut $top.selbgsep -sticky w
8806
8807 label $top.cfont -text [mc "Fonts: press to choose"]
8808 grid $top.cfont - -sticky w -pady 10
8809 mkfontdisp mainfont $top [mc "Main font"]
8810 mkfontdisp textfont $top [mc "Diff display font"]
8811 mkfontdisp uifont $top [mc "User interface font"]
8812
8813 frame $top.buts
8814 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8815 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8816 grid $top.buts.ok $top.buts.can
8817 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8818 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8819 grid $top.buts - - -pady 10 -sticky ew
8820 bind $top <Visibility> "focus $top.buts.ok"
8821}
8822
8823proc choosecolor {v vi w x cmd} {
8824 global $v
8825
8826 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8827 -title [mc "Gitk: choose color for %s" $x]]
8828 if {$c eq {}} return
8829 $w conf -background $c
8830 lset $v $vi $c
8831 eval $cmd $c
8832}
8833
8834proc setselbg {c} {
8835 global bglist cflist
8836 foreach w $bglist {
8837 $w configure -selectbackground $c
8838 }
8839 $cflist tag configure highlight \
8840 -background [$cflist cget -selectbackground]
8841 allcanvs itemconf secsel -fill $c
8842}
8843
8844proc setbg {c} {
8845 global bglist
8846
8847 foreach w $bglist {
8848 $w conf -background $c
8849 }
8850}
8851
8852proc setfg {c} {
8853 global fglist canv
8854
8855 foreach w $fglist {
8856 $w conf -foreground $c
8857 }
8858 allcanvs itemconf text -fill $c
8859 $canv itemconf circle -outline $c
8860}
8861
8862proc prefscan {} {
8863 global oldprefs prefstop
8864
8865 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8866 limitdiffs tabstop} {
8867 global $v
8868 set $v $oldprefs($v)
8869 }
8870 catch {destroy $prefstop}
8871 unset prefstop
8872 fontcan
8873}
8874
8875proc prefsok {} {
8876 global maxwidth maxgraphpct
8877 global oldprefs prefstop showneartags showlocalchanges
8878 global fontpref mainfont textfont uifont
8879 global limitdiffs treediffs
8880
8881 catch {destroy $prefstop}
8882 unset prefstop
8883 fontcan
8884 set fontchanged 0
8885 if {$mainfont ne $fontpref(mainfont)} {
8886 set mainfont $fontpref(mainfont)
8887 parsefont mainfont $mainfont
8888 eval font configure mainfont [fontflags mainfont]
8889 eval font configure mainfontbold [fontflags mainfont 1]
8890 setcoords
8891 set fontchanged 1
8892 }
8893 if {$textfont ne $fontpref(textfont)} {
8894 set textfont $fontpref(textfont)
8895 parsefont textfont $textfont
8896 eval font configure textfont [fontflags textfont]
8897 eval font configure textfontbold [fontflags textfont 1]
8898 }
8899 if {$uifont ne $fontpref(uifont)} {
8900 set uifont $fontpref(uifont)
8901 parsefont uifont $uifont
8902 eval font configure uifont [fontflags uifont]
8903 }
8904 settabs
8905 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8906 if {$showlocalchanges} {
8907 doshowlocalchanges
8908 } else {
8909 dohidelocalchanges
8910 }
8911 }
8912 if {$limitdiffs != $oldprefs(limitdiffs)} {
8913 # treediffs elements are limited by path
8914 catch {unset treediffs}
8915 }
8916 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8917 || $maxgraphpct != $oldprefs(maxgraphpct)} {
8918 redisplay
8919 } elseif {$showneartags != $oldprefs(showneartags) ||
8920 $limitdiffs != $oldprefs(limitdiffs)} {
8921 reselectline
8922 }
8923}
8924
8925proc formatdate {d} {
8926 global datetimeformat
8927 if {$d ne {}} {
8928 set d [clock format $d -format $datetimeformat]
8929 }
8930 return $d
8931}
8932
8933# This list of encoding names and aliases is distilled from
8934# http://www.iana.org/assignments/character-sets.
8935# Not all of them are supported by Tcl.
8936set encoding_aliases {
8937 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8938 ISO646-US US-ASCII us IBM367 cp367 csASCII }
8939 { ISO-10646-UTF-1 csISO10646UTF1 }
8940 { ISO_646.basic:1983 ref csISO646basic1983 }
8941 { INVARIANT csINVARIANT }
8942 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8943 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8944 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8945 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8946 { NATS-DANO iso-ir-9-1 csNATSDANO }
8947 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8948 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8949 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8950 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8951 { ISO-2022-KR csISO2022KR }
8952 { EUC-KR csEUCKR }
8953 { ISO-2022-JP csISO2022JP }
8954 { ISO-2022-JP-2 csISO2022JP2 }
8955 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8956 csISO13JISC6220jp }
8957 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8958 { IT iso-ir-15 ISO646-IT csISO15Italian }
8959 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8960 { ES iso-ir-17 ISO646-ES csISO17Spanish }
8961 { greek7-old iso-ir-18 csISO18Greek7Old }
8962 { latin-greek iso-ir-19 csISO19LatinGreek }
8963 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8964 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8965 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8966 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8967 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8968 { BS_viewdata iso-ir-47 csISO47BSViewdata }
8969 { INIS iso-ir-49 csISO49INIS }
8970 { INIS-8 iso-ir-50 csISO50INIS8 }
8971 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8972 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8973 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8974 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8975 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8976 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8977 csISO60Norwegian1 }
8978 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8979 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8980 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8981 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8982 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8983 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8984 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8985 { greek7 iso-ir-88 csISO88Greek7 }
8986 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8987 { iso-ir-90 csISO90 }
8988 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8989 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8990 csISO92JISC62991984b }
8991 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8992 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8993 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8994 csISO95JIS62291984handadd }
8995 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8996 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8997 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8998 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8999 CP819 csISOLatin1 }
9000 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9001 { T.61-7bit iso-ir-102 csISO102T617bit }
9002 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9003 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9004 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9005 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9006 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9007 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9008 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9009 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9010 arabic csISOLatinArabic }
9011 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9012 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9013 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9014 greek greek8 csISOLatinGreek }
9015 { T.101-G2 iso-ir-128 csISO128T101G2 }
9016 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9017 csISOLatinHebrew }
9018 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9019 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9020 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9021 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9022 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9023 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9024 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9025 csISOLatinCyrillic }
9026 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9027 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9028 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9029 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9030 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9031 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9032 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9033 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9034 { ISO_10367-box iso-ir-155 csISO10367Box }
9035 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9036 { latin-lap lap iso-ir-158 csISO158Lap }
9037 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9038 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9039 { us-dk csUSDK }
9040 { dk-us csDKUS }
9041 { JIS_X0201 X0201 csHalfWidthKatakana }
9042 { KSC5636 ISO646-KR csKSC5636 }
9043 { ISO-10646-UCS-2 csUnicode }
9044 { ISO-10646-UCS-4 csUCS4 }
9045 { DEC-MCS dec csDECMCS }
9046 { hp-roman8 roman8 r8 csHPRoman8 }
9047 { macintosh mac csMacintosh }
9048 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9049 csIBM037 }
9050 { IBM038 EBCDIC-INT cp038 csIBM038 }
9051 { IBM273 CP273 csIBM273 }
9052 { IBM274 EBCDIC-BE CP274 csIBM274 }
9053 { IBM275 EBCDIC-BR cp275 csIBM275 }
9054 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9055 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9056 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9057 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9058 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9059 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9060 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9061 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9062 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9063 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9064 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9065 { IBM437 cp437 437 csPC8CodePage437 }
9066 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9067 { IBM775 cp775 csPC775Baltic }
9068 { IBM850 cp850 850 csPC850Multilingual }
9069 { IBM851 cp851 851 csIBM851 }
9070 { IBM852 cp852 852 csPCp852 }
9071 { IBM855 cp855 855 csIBM855 }
9072 { IBM857 cp857 857 csIBM857 }
9073 { IBM860 cp860 860 csIBM860 }
9074 { IBM861 cp861 861 cp-is csIBM861 }
9075 { IBM862 cp862 862 csPC862LatinHebrew }
9076 { IBM863 cp863 863 csIBM863 }
9077 { IBM864 cp864 csIBM864 }
9078 { IBM865 cp865 865 csIBM865 }
9079 { IBM866 cp866 866 csIBM866 }
9080 { IBM868 CP868 cp-ar csIBM868 }
9081 { IBM869 cp869 869 cp-gr csIBM869 }
9082 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9083 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9084 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9085 { IBM891 cp891 csIBM891 }
9086 { IBM903 cp903 csIBM903 }
9087 { IBM904 cp904 904 csIBBM904 }
9088 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9089 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9090 { IBM1026 CP1026 csIBM1026 }
9091 { EBCDIC-AT-DE csIBMEBCDICATDE }
9092 { EBCDIC-AT-DE-A csEBCDICATDEA }
9093 { EBCDIC-CA-FR csEBCDICCAFR }
9094 { EBCDIC-DK-NO csEBCDICDKNO }
9095 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9096 { EBCDIC-FI-SE csEBCDICFISE }
9097 { EBCDIC-FI-SE-A csEBCDICFISEA }
9098 { EBCDIC-FR csEBCDICFR }
9099 { EBCDIC-IT csEBCDICIT }
9100 { EBCDIC-PT csEBCDICPT }
9101 { EBCDIC-ES csEBCDICES }
9102 { EBCDIC-ES-A csEBCDICESA }
9103 { EBCDIC-ES-S csEBCDICESS }
9104 { EBCDIC-UK csEBCDICUK }
9105 { EBCDIC-US csEBCDICUS }
9106 { UNKNOWN-8BIT csUnknown8BiT }
9107 { MNEMONIC csMnemonic }
9108 { MNEM csMnem }
9109 { VISCII csVISCII }
9110 { VIQR csVIQR }
9111 { KOI8-R csKOI8R }
9112 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9113 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9114 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9115 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9116 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9117 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9118 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9119 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9120 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9121 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9122 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9123 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9124 { IBM1047 IBM-1047 }
9125 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9126 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9127 { UNICODE-1-1 csUnicode11 }
9128 { CESU-8 csCESU-8 }
9129 { BOCU-1 csBOCU-1 }
9130 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9131 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9132 l8 }
9133 { ISO-8859-15 ISO_8859-15 Latin-9 }
9134 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9135 { GBK CP936 MS936 windows-936 }
9136 { JIS_Encoding csJISEncoding }
9137 { Shift_JIS MS_Kanji csShiftJIS }
9138 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9139 EUC-JP }
9140 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9141 { ISO-10646-UCS-Basic csUnicodeASCII }
9142 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9143 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9144 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9145 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9146 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9147 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9148 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9149 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9150 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9151 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9152 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9153 { Ventura-US csVenturaUS }
9154 { Ventura-International csVenturaInternational }
9155 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9156 { PC8-Turkish csPC8Turkish }
9157 { IBM-Symbols csIBMSymbols }
9158 { IBM-Thai csIBMThai }
9159 { HP-Legal csHPLegal }
9160 { HP-Pi-font csHPPiFont }
9161 { HP-Math8 csHPMath8 }
9162 { Adobe-Symbol-Encoding csHPPSMath }
9163 { HP-DeskTop csHPDesktop }
9164 { Ventura-Math csVenturaMath }
9165 { Microsoft-Publishing csMicrosoftPublishing }
9166 { Windows-31J csWindows31J }
9167 { GB2312 csGB2312 }
9168 { Big5 csBig5 }
9169}
9170
9171proc tcl_encoding {enc} {
9172 global encoding_aliases
9173 set names [encoding names]
9174 set lcnames [string tolower $names]
9175 set enc [string tolower $enc]
9176 set i [lsearch -exact $lcnames $enc]
9177 if {$i < 0} {
9178 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9179 if {[regsub {^iso[-_]} $enc iso encx]} {
9180 set i [lsearch -exact $lcnames $encx]
9181 }
9182 }
9183 if {$i < 0} {
9184 foreach l $encoding_aliases {
9185 set ll [string tolower $l]
9186 if {[lsearch -exact $ll $enc] < 0} continue
9187 # look through the aliases for one that tcl knows about
9188 foreach e $ll {
9189 set i [lsearch -exact $lcnames $e]
9190 if {$i < 0} {
9191 if {[regsub {^iso[-_]} $e iso ex]} {
9192 set i [lsearch -exact $lcnames $ex]
9193 }
9194 }
9195 if {$i >= 0} break
9196 }
9197 break
9198 }
9199 }
9200 if {$i >= 0} {
9201 return [lindex $names $i]
9202 }
9203 return {}
9204}
9205
9206# First check that Tcl/Tk is recent enough
9207if {[catch {package require Tk 8.4} err]} {
9208 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9209 Gitk requires at least Tcl/Tk 8.4."]
9210 exit 1
9211}
9212
9213# defaults...
9214set datemode 0
9215set wrcomcmd "git diff-tree --stdin -p --pretty"
9216
9217set gitencoding {}
9218catch {
9219 set gitencoding [exec git config --get i18n.commitencoding]
9220}
9221if {$gitencoding == ""} {
9222 set gitencoding "utf-8"
9223}
9224set tclencoding [tcl_encoding $gitencoding]
9225if {$tclencoding == {}} {
9226 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9227}
9228
9229set mainfont {Helvetica 9}
9230set textfont {Courier 9}
9231set uifont {Helvetica 9 bold}
9232set tabstop 8
9233set findmergefiles 0
9234set maxgraphpct 50
9235set maxwidth 16
9236set revlistorder 0
9237set fastdate 0
9238set uparrowlen 5
9239set downarrowlen 5
9240set mingaplen 100
9241set cmitmode "patch"
9242set wrapcomment "none"
9243set showneartags 1
9244set maxrefs 20
9245set maxlinelen 200
9246set showlocalchanges 1
9247set limitdiffs 1
9248set datetimeformat "%Y-%m-%d %H:%M:%S"
9249
9250set colors {green red blue magenta darkgrey brown orange}
9251set bgcolor white
9252set fgcolor black
9253set diffcolors {red "#00a000" blue}
9254set diffcontext 3
9255set ignorespace 0
9256set selectbgcolor gray85
9257
9258## For msgcat loading, first locate the installation location.
9259if { [info exists ::env(GITK_MSGSDIR)] } {
9260 ## Msgsdir was manually set in the environment.
9261 set gitk_msgsdir $::env(GITK_MSGSDIR)
9262} else {
9263 ## Let's guess the prefix from argv0.
9264 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9265 set gitk_libdir [file join $gitk_prefix share gitk lib]
9266 set gitk_msgsdir [file join $gitk_libdir msgs]
9267 unset gitk_prefix
9268}
9269
9270## Internationalization (i18n) through msgcat and gettext. See
9271## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9272package require msgcat
9273namespace import ::msgcat::mc
9274## And eventually load the actual message catalog
9275::msgcat::mcload $gitk_msgsdir
9276
9277catch {source ~/.gitk}
9278
9279font create optionfont -family sans-serif -size -12
9280
9281parsefont mainfont $mainfont
9282eval font create mainfont [fontflags mainfont]
9283eval font create mainfontbold [fontflags mainfont 1]
9284
9285parsefont textfont $textfont
9286eval font create textfont [fontflags textfont]
9287eval font create textfontbold [fontflags textfont 1]
9288
9289parsefont uifont $uifont
9290eval font create uifont [fontflags uifont]
9291
9292setoptions
9293
9294# check that we can find a .git directory somewhere...
9295if {[catch {set gitdir [gitdir]}]} {
9296 show_error {} . [mc "Cannot find a git repository here."]
9297 exit 1
9298}
9299if {![file isdirectory $gitdir]} {
9300 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9301 exit 1
9302}
9303
9304set mergeonly 0
9305set revtreeargs {}
9306set cmdline_files {}
9307set i 0
9308foreach arg $argv {
9309 switch -- $arg {
9310 "" { }
9311 "-d" { set datemode 1 }
9312 "--merge" {
9313 set mergeonly 1
9314 lappend revtreeargs $arg
9315 }
9316 "--" {
9317 set cmdline_files [lrange $argv [expr {$i + 1}] end]
9318 break
9319 }
9320 default {
9321 lappend revtreeargs $arg
9322 }
9323 }
9324 incr i
9325}
9326
9327if {$i >= [llength $argv] && $revtreeargs ne {}} {
9328 # no -- on command line, but some arguments (other than -d)
9329 if {[catch {
9330 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9331 set cmdline_files [split $f "\n"]
9332 set n [llength $cmdline_files]
9333 set revtreeargs [lrange $revtreeargs 0 end-$n]
9334 # Unfortunately git rev-parse doesn't produce an error when
9335 # something is both a revision and a filename. To be consistent
9336 # with git log and git rev-list, check revtreeargs for filenames.
9337 foreach arg $revtreeargs {
9338 if {[file exists $arg]} {
9339 show_error {} . [mc "Ambiguous argument '%s': both revision\
9340 and filename" $arg]
9341 exit 1
9342 }
9343 }
9344 } err]} {
9345 # unfortunately we get both stdout and stderr in $err,
9346 # so look for "fatal:".
9347 set i [string first "fatal:" $err]
9348 if {$i > 0} {
9349 set err [string range $err [expr {$i + 6}] end]
9350 }
9351 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9352 exit 1
9353 }
9354}
9355
9356if {$mergeonly} {
9357 # find the list of unmerged files
9358 set mlist {}
9359 set nr_unmerged 0
9360 if {[catch {
9361 set fd [open "| git ls-files -u" r]
9362 } err]} {
9363 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9364 exit 1
9365 }
9366 while {[gets $fd line] >= 0} {
9367 set i [string first "\t" $line]
9368 if {$i < 0} continue
9369 set fname [string range $line [expr {$i+1}] end]
9370 if {[lsearch -exact $mlist $fname] >= 0} continue
9371 incr nr_unmerged
9372 if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9373 lappend mlist $fname
9374 }
9375 }
9376 catch {close $fd}
9377 if {$mlist eq {}} {
9378 if {$nr_unmerged == 0} {
9379 show_error {} . [mc "No files selected: --merge specified but\
9380 no files are unmerged."]
9381 } else {
9382 show_error {} . [mc "No files selected: --merge specified but\
9383 no unmerged files are within file limit."]
9384 }
9385 exit 1
9386 }
9387 set cmdline_files $mlist
9388}
9389
9390set nullid "0000000000000000000000000000000000000000"
9391set nullid2 "0000000000000000000000000000000000000001"
9392
9393set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9394
9395set runq {}
9396set history {}
9397set historyindex 0
9398set fh_serial 0
9399set nhl_names {}
9400set highlight_paths {}
9401set findpattern {}
9402set searchdirn -forwards
9403set boldrows {}
9404set boldnamerows {}
9405set diffelide {0 0}
9406set markingmatches 0
9407set linkentercount 0
9408set need_redisplay 0
9409set nrows_drawn 0
9410set firsttabstop 0
9411
9412set nextviewnum 1
9413set curview 0
9414set selectedview 0
9415set selectedhlview [mc "None"]
9416set highlight_related [mc "None"]
9417set highlight_files {}
9418set viewfiles(0) {}
9419set viewperm(0) 0
9420set viewargs(0) {}
9421
9422set loginstance 0
9423set cmdlineok 0
9424set stopped 0
9425set stuffsaved 0
9426set patchnum 0
9427set lserial 0
9428setcoords
9429makewindow
9430# wait for the window to become visible
9431tkwait visibility .
9432wm title . "[file tail $argv0]: [file tail [pwd]]"
9433readrefs
9434
9435if {$cmdline_files ne {} || $revtreeargs ne {}} {
9436 # create a view for the files/dirs specified on the command line
9437 set curview 1
9438 set selectedview 1
9439 set nextviewnum 2
9440 set viewname(1) [mc "Command line"]
9441 set viewfiles(1) $cmdline_files
9442 set viewargs(1) $revtreeargs
9443 set viewperm(1) 0
9444 addviewmenu 1
9445 .bar.view entryconf [mc "Edit view..."] -state normal
9446 .bar.view entryconf [mc "Delete view"] -state normal
9447}
9448
9449if {[info exists permviews]} {
9450 foreach v $permviews {
9451 set n $nextviewnum
9452 incr nextviewnum
9453 set viewname($n) [lindex $v 0]
9454 set viewfiles($n) [lindex $v 1]
9455 set viewargs($n) [lindex $v 2]
9456 set viewperm($n) 1
9457 addviewmenu $n
9458 }
9459}
9460getcommits