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