[PATCH] gitk: Don't show local changes when we there is no work tree
[git/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
50proc dorunq {} {
51 global isonrunq runq
52
53 set tstart [clock clicks -milliseconds]
54 set t0 $tstart
55 while {$runq ne {}} {
56 set fd [lindex $runq 0 0]
57 set script [lindex $runq 0 1]
58 set repeat [eval $script]
59 set t1 [clock clicks -milliseconds]
60 set t [expr {$t1 - $t0}]
61 set runq [lrange $runq 1 end]
62 if {$repeat ne {} && $repeat} {
63 if {$fd eq {} || $repeat == 2} {
64 # script returns 1 if it wants to be readded
65 # file readers return 2 if they could do more straight away
66 lappend runq [list $fd $script]
67 } else {
68 fileevent $fd readable [list filereadable $fd $script]
69 }
70 } elseif {$fd eq {}} {
71 unset isonrunq($script)
72 }
73 set t0 $t1
74 if {$t1 - $tstart >= 80} break
75 }
76 if {$runq ne {}} {
77 after idle dorunq
78 }
79}
80
81# Start off a git rev-list process and arrange to read its output
da7c24dd 82proc start_rev_list {view} {
7eb3cb9c 83 global startmsecs
9f1afe05 84 global commfd leftover tclencoding datemode
2d480856 85 global viewargs viewargscmd viewfiles commitidx viewcomplete vnextroot
3e6b893f 86 global showlocalchanges commitinterest mainheadid
bb3edc8b 87 global progressdirn progresscoords proglastnc curview
9ccbdfbf 88
9ccbdfbf 89 set startmsecs [clock clicks -milliseconds]
da7c24dd 90 set commitidx($view) 0
f5f3c2e2 91 set viewcomplete($view) 0
6e8c8707 92 set vnextroot($view) 0
2d480856
YD
93 set args $viewargs($view)
94 if {$viewargscmd($view) ne {}} {
95 if {[catch {
96 set str [exec sh -c $viewargscmd($view)]
97 } err]} {
98 error_popup "Error executing --argscmd command: $err"
99 exit 1
100 }
101 set args [concat $args [split $str "\n"]]
102 }
9f1afe05
PM
103 set order "--topo-order"
104 if {$datemode} {
105 set order "--date-order"
106 }
418c4c7b 107 if {[catch {
0166419a 108 set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \
2d480856 109 --boundary $args "--" $viewfiles($view)] r]
418c4c7b 110 } err]} {
d990cedf 111 error_popup "[mc "Error executing git rev-list:"] $err"
1d10f36d
PM
112 exit 1
113 }
da7c24dd
PM
114 set commfd($view) $fd
115 set leftover($view) {}
3e6b893f
PM
116 if {$showlocalchanges} {
117 lappend commitinterest($mainheadid) {dodiffindex}
118 }
86da5b6c 119 fconfigure $fd -blocking 0 -translation lf -eofchar {}
fd8ccbec 120 if {$tclencoding != {}} {
da7c24dd 121 fconfigure $fd -encoding $tclencoding
fd8ccbec 122 }
7eb3cb9c 123 filerun $fd [list getcommitlines $fd $view]
d990cedf 124 nowbusy $view [mc "Reading"]
bb3edc8b
PM
125 if {$view == $curview} {
126 set progressdirn 1
127 set progresscoords {0 0}
128 set proglastnc 0
129 }
38ad0910
PM
130}
131
22626ef4 132proc stop_rev_list {} {
da7c24dd 133 global commfd curview
22626ef4 134
da7c24dd
PM
135 if {![info exists commfd($curview)]} return
136 set fd $commfd($curview)
22626ef4 137 catch {
da7c24dd 138 set pid [pid $fd]
22626ef4
PM
139 exec kill $pid
140 }
da7c24dd
PM
141 catch {close $fd}
142 unset commfd($curview)
22626ef4
PM
143}
144
a8aaf19c 145proc getcommits {} {
9c311b32 146 global phase canv curview
38ad0910 147
38ad0910 148 set phase getcommits
da7c24dd
PM
149 initlayout
150 start_rev_list $curview
d990cedf 151 show_status [mc "Reading commits..."]
1d10f36d
PM
152}
153
6e8c8707
PM
154# This makes a string representation of a positive integer which
155# sorts as a string in numerical order
156proc strrep {n} {
157 if {$n < 16} {
158 return [format "%x" $n]
159 } elseif {$n < 256} {
160 return [format "x%.2x" $n]
161 } elseif {$n < 65536} {
162 return [format "y%.4x" $n]
163 }
164 return [format "z%.8x" $n]
165}
166
da7c24dd 167proc getcommitlines {fd view} {
3e6b893f 168 global commitlisted commitinterest
da7c24dd 169 global leftover commfd
f5f3c2e2 170 global displayorder commitidx viewcomplete commitrow commitdata
6a90bff1
PM
171 global parentlist children curview hlview
172 global vparentlist vdisporder vcmitlisted
b0cdca99 173 global ordertok vnextroot idpending
9ccbdfbf 174
d1e46756 175 set stuff [read $fd 500000]
005a2f4e
PM
176 # git log doesn't terminate the last commit with a null...
177 if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
178 set stuff "\0"
179 }
b490a991 180 if {$stuff == {}} {
7eb3cb9c
PM
181 if {![eof $fd]} {
182 return 1
183 }
b0cdca99
PM
184 # Check if we have seen any ids listed as parents that haven't
185 # appeared in the list
186 foreach vid [array names idpending "$view,*"] {
187 # should only get here if git log is buggy
188 set id [lindex [split $vid ","] 1]
189 set commitrow($vid) $commitidx($view)
190 incr commitidx($view)
191 if {$view == $curview} {
192 lappend parentlist {}
193 lappend displayorder $id
194 lappend commitlisted 0
195 } else {
196 lappend vparentlist($view) {}
197 lappend vdisporder($view) $id
198 lappend vcmitlisted($view) 0
199 }
200 }
f5f3c2e2 201 set viewcomplete($view) 1
bb3edc8b 202 global viewname progresscoords
da7c24dd 203 unset commfd($view)
098dd8a3 204 notbusy $view
bb3edc8b
PM
205 set progresscoords {0 0}
206 adjustprogress
f0654861 207 # set it blocking so we wait for the process to terminate
da7c24dd 208 fconfigure $fd -blocking 1
098dd8a3
PM
209 if {[catch {close $fd} err]} {
210 set fv {}
211 if {$view != $curview} {
212 set fv " for the \"$viewname($view)\" view"
da7c24dd 213 }
098dd8a3
PM
214 if {[string range $err 0 4] == "usage"} {
215 set err "Gitk: error reading commits$fv:\
8974c6f9 216 bad arguments to git rev-list."
098dd8a3
PM
217 if {$viewname($view) eq "Command line"} {
218 append err \
8974c6f9 219 " (Note: arguments to gitk are passed to git rev-list\
098dd8a3
PM
220 to allow selection of commits to be displayed.)"
221 }
222 } else {
223 set err "Error reading commits$fv: $err"
224 }
225 error_popup $err
1d10f36d 226 }
098dd8a3 227 if {$view == $curview} {
7eb3cb9c 228 run chewcommits $view
9a40c50c 229 }
7eb3cb9c 230 return 0
9a40c50c 231 }
b490a991 232 set start 0
8f7d0cec 233 set gotsome 0
b490a991
PM
234 while 1 {
235 set i [string first "\0" $stuff $start]
236 if {$i < 0} {
da7c24dd 237 append leftover($view) [string range $stuff $start end]
9f1afe05 238 break
9ccbdfbf 239 }
b490a991 240 if {$start == 0} {
da7c24dd 241 set cmit $leftover($view)
8f7d0cec 242 append cmit [string range $stuff 0 [expr {$i - 1}]]
da7c24dd 243 set leftover($view) {}
8f7d0cec
PM
244 } else {
245 set cmit [string range $stuff $start [expr {$i - 1}]]
b490a991
PM
246 }
247 set start [expr {$i + 1}]
e5ea701b
PM
248 set j [string first "\n" $cmit]
249 set ok 0
16c1ff96 250 set listed 1
c961b228
PM
251 if {$j >= 0 && [string match "commit *" $cmit]} {
252 set ids [string range $cmit 7 [expr {$j - 1}]]
1407ade9 253 if {[string match {[-^<>]*} $ids]} {
c961b228
PM
254 switch -- [string index $ids 0] {
255 "-" {set listed 0}
1407ade9
LT
256 "^" {set listed 2}
257 "<" {set listed 3}
258 ">" {set listed 4}
c961b228 259 }
16c1ff96
PM
260 set ids [string range $ids 1 end]
261 }
e5ea701b
PM
262 set ok 1
263 foreach id $ids {
8f7d0cec 264 if {[string length $id] != 40} {
e5ea701b
PM
265 set ok 0
266 break
267 }
268 }
269 }
270 if {!$ok} {
7e952e79
PM
271 set shortcmit $cmit
272 if {[string length $shortcmit] > 80} {
273 set shortcmit "[string range $shortcmit 0 80]..."
274 }
d990cedf 275 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
b490a991
PM
276 exit 1
277 }
e5ea701b 278 set id [lindex $ids 0]
6e8c8707
PM
279 if {![info exists ordertok($view,$id)]} {
280 set otok "o[strrep $vnextroot($view)]"
281 incr vnextroot($view)
282 set ordertok($view,$id) $otok
283 } else {
284 set otok $ordertok($view,$id)
b0cdca99 285 unset idpending($view,$id)
6e8c8707 286 }
16c1ff96
PM
287 if {$listed} {
288 set olds [lrange $ids 1 end]
6e8c8707
PM
289 if {[llength $olds] == 1} {
290 set p [lindex $olds 0]
291 lappend children($view,$p) $id
292 if {![info exists ordertok($view,$p)]} {
293 set ordertok($view,$p) $ordertok($view,$id)
b0cdca99 294 set idpending($view,$p) 1
6e8c8707
PM
295 }
296 } else {
297 set i 0
298 foreach p $olds {
299 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
300 lappend children($view,$p) $id
301 }
302 if {![info exists ordertok($view,$p)]} {
303 set ordertok($view,$p) "$otok[strrep $i]]"
b0cdca99 304 set idpending($view,$p) 1
6e8c8707
PM
305 }
306 incr i
50b44ece 307 }
79b2c75e 308 }
16c1ff96
PM
309 } else {
310 set olds {}
311 }
da7c24dd
PM
312 if {![info exists children($view,$id)]} {
313 set children($view,$id) {}
79b2c75e 314 }
f7a3e8d2 315 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
da7c24dd
PM
316 set commitrow($view,$id) $commitidx($view)
317 incr commitidx($view)
318 if {$view == $curview} {
319 lappend parentlist $olds
da7c24dd
PM
320 lappend displayorder $id
321 lappend commitlisted $listed
322 } else {
323 lappend vparentlist($view) $olds
da7c24dd
PM
324 lappend vdisporder($view) $id
325 lappend vcmitlisted($view) $listed
326 }
3e6b893f
PM
327 if {[info exists commitinterest($id)]} {
328 foreach script $commitinterest($id) {
329 eval [string map [list "%I" $id] $script]
330 }
331 unset commitinterest($id)
332 }
8f7d0cec
PM
333 set gotsome 1
334 }
335 if {$gotsome} {
7eb3cb9c 336 run chewcommits $view
bb3edc8b
PM
337 if {$view == $curview} {
338 # update progress bar
339 global progressdirn progresscoords proglastnc
340 set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
341 set proglastnc $commitidx($view)
342 set l [lindex $progresscoords 0]
343 set r [lindex $progresscoords 1]
344 if {$progressdirn} {
345 set r [expr {$r + $inc}]
346 if {$r >= 1.0} {
347 set r 1.0
348 set progressdirn 0
349 }
350 if {$r > 0.2} {
351 set l [expr {$r - 0.2}]
352 }
353 } else {
354 set l [expr {$l - $inc}]
355 if {$l <= 0.0} {
356 set l 0.0
357 set progressdirn 1
358 }
359 set r [expr {$l + 0.2}]
360 }
361 set progresscoords [list $l $r]
362 adjustprogress
363 }
9ccbdfbf 364 }
7eb3cb9c 365 return 2
9ccbdfbf
PM
366}
367
7eb3cb9c 368proc chewcommits {view} {
f5f3c2e2 369 global curview hlview viewcomplete
7eb3cb9c
PM
370 global selectedline pending_select
371
7eb3cb9c 372 if {$view == $curview} {
f5f3c2e2
PM
373 layoutmore
374 if {$viewcomplete($view)} {
8f489363 375 global displayorder commitidx phase
7eb3cb9c 376 global numcommits startmsecs
9ccbdfbf 377
7eb3cb9c 378 if {[info exists pending_select]} {
8f489363 379 set row [first_real_row]
7eb3cb9c
PM
380 selectline $row 1
381 }
382 if {$commitidx($curview) > 0} {
383 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
384 #puts "overall $ms ms for $numcommits commits"
385 } else {
d990cedf 386 show_status [mc "No commits selected"]
7eb3cb9c
PM
387 }
388 notbusy layout
389 set phase {}
390 }
b664550c 391 }
7eb3cb9c
PM
392 if {[info exists hlview] && $view == $hlview} {
393 vhighlightmore
b664550c 394 }
f5f3c2e2 395 return 0
1db95b00
PM
396}
397
398proc readcommit {id} {
8974c6f9 399 if {[catch {set contents [exec git cat-file commit $id]}]} return
8f7d0cec 400 parsecommit $id $contents 0
b490a991
PM
401}
402
50b44ece 403proc updatecommits {} {
b0cdca99 404 global viewdata curview phase displayorder ordertok idpending
a69b2d1a 405 global children commitrow selectedline thickerline showneartags
cb8329aa
DA
406 global isworktree
407
408 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
50b44ece 409
22626ef4
PM
410 if {$phase ne {}} {
411 stop_rev_list
412 set phase {}
fd8ccbec 413 }
d94f8cd6 414 set n $curview
da7c24dd
PM
415 foreach id $displayorder {
416 catch {unset children($n,$id)}
417 catch {unset commitrow($n,$id)}
b0cdca99
PM
418 catch {unset ordertok($n,$id)}
419 }
420 foreach vid [array names idpending "$n,*"] {
421 unset idpending($vid)
da7c24dd 422 }
d94f8cd6 423 set curview -1
908c3585
PM
424 catch {unset selectedline}
425 catch {unset thickerline}
d94f8cd6 426 catch {unset viewdata($n)}
fd8ccbec 427 readrefs
e11f1233 428 changedrefs
a69b2d1a
PM
429 if {$showneartags} {
430 getallcommits
431 }
d94f8cd6 432 showview $n
fd8ccbec
PM
433}
434
8f7d0cec 435proc parsecommit {id contents listed} {
b5c2f306
SV
436 global commitinfo cdate
437
438 set inhdr 1
439 set comment {}
440 set headline {}
441 set auname {}
442 set audate {}
443 set comname {}
444 set comdate {}
232475d3
PM
445 set hdrend [string first "\n\n" $contents]
446 if {$hdrend < 0} {
447 # should never happen...
448 set hdrend [string length $contents]
449 }
450 set header [string range $contents 0 [expr {$hdrend - 1}]]
451 set comment [string range $contents [expr {$hdrend + 2}] end]
452 foreach line [split $header "\n"] {
453 set tag [lindex $line 0]
454 if {$tag == "author"} {
455 set audate [lindex $line end-1]
456 set auname [lrange $line 1 end-2]
457 } elseif {$tag == "committer"} {
458 set comdate [lindex $line end-1]
459 set comname [lrange $line 1 end-2]
1db95b00
PM
460 }
461 }
232475d3 462 set headline {}
43c25074
PM
463 # take the first non-blank line of the comment as the headline
464 set headline [string trimleft $comment]
465 set i [string first "\n" $headline]
232475d3 466 if {$i >= 0} {
43c25074
PM
467 set headline [string range $headline 0 $i]
468 }
469 set headline [string trimright $headline]
470 set i [string first "\r" $headline]
471 if {$i >= 0} {
472 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
473 }
474 if {!$listed} {
8974c6f9
TH
475 # git rev-list indents the comment by 4 spaces;
476 # if we got this via git cat-file, add the indentation
232475d3
PM
477 set newcomment {}
478 foreach line [split $comment "\n"] {
479 append newcomment " "
480 append newcomment $line
f6e2869f 481 append newcomment "\n"
232475d3
PM
482 }
483 set comment $newcomment
1db95b00
PM
484 }
485 if {$comdate != {}} {
cfb4563c 486 set cdate($id) $comdate
1db95b00 487 }
e5c2d856
PM
488 set commitinfo($id) [list $headline $auname $audate \
489 $comname $comdate $comment]
1db95b00
PM
490}
491
f7a3e8d2 492proc getcommit {id} {
79b2c75e 493 global commitdata commitinfo
8ed16484 494
f7a3e8d2
PM
495 if {[info exists commitdata($id)]} {
496 parsecommit $id $commitdata($id) 1
8ed16484
PM
497 } else {
498 readcommit $id
499 if {![info exists commitinfo($id)]} {
d990cedf 500 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
501 }
502 }
503 return 1
504}
505
887fe3c4 506proc readrefs {} {
62d3ea65 507 global tagids idtags headids idheads tagobjid
219ea3a9 508 global otherrefids idotherrefs mainhead mainheadid
106288cb 509
b5c2f306
SV
510 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
511 catch {unset $v}
512 }
62d3ea65
PM
513 set refd [open [list | git show-ref -d] r]
514 while {[gets $refd line] >= 0} {
515 if {[string index $line 40] ne " "} continue
516 set id [string range $line 0 39]
517 set ref [string range $line 41 end]
518 if {![string match "refs/*" $ref]} continue
519 set name [string range $ref 5 end]
520 if {[string match "remotes/*" $name]} {
521 if {![string match "*/HEAD" $name]} {
522 set headids($name) $id
523 lappend idheads($id) $name
f1d83ba3 524 }
62d3ea65
PM
525 } elseif {[string match "heads/*" $name]} {
526 set name [string range $name 6 end]
36a7cad6
JH
527 set headids($name) $id
528 lappend idheads($id) $name
62d3ea65
PM
529 } elseif {[string match "tags/*" $name]} {
530 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
531 # which is what we want since the former is the commit ID
532 set name [string range $name 5 end]
533 if {[string match "*^{}" $name]} {
534 set name [string range $name 0 end-3]
535 } else {
536 set tagobjid($name) $id
537 }
538 set tagids($name) $id
539 lappend idtags($id) $name
36a7cad6
JH
540 } else {
541 set otherrefids($name) $id
542 lappend idotherrefs($id) $name
f1d83ba3
PM
543 }
544 }
062d671f 545 catch {close $refd}
8a48571c 546 set mainhead {}
219ea3a9 547 set mainheadid {}
8a48571c
PM
548 catch {
549 set thehead [exec git symbolic-ref HEAD]
550 if {[string match "refs/heads/*" $thehead]} {
551 set mainhead [string range $thehead 11 end]
219ea3a9
PM
552 if {[info exists headids($mainhead)]} {
553 set mainheadid $headids($mainhead)
554 }
8a48571c
PM
555 }
556 }
887fe3c4
PM
557}
558
8f489363
PM
559# skip over fake commits
560proc first_real_row {} {
561 global nullid nullid2 displayorder numcommits
562
563 for {set row 0} {$row < $numcommits} {incr row} {
564 set id [lindex $displayorder $row]
565 if {$id ne $nullid && $id ne $nullid2} {
566 break
567 }
568 }
569 return $row
570}
571
e11f1233
PM
572# update things for a head moved to a child of its previous location
573proc movehead {id name} {
574 global headids idheads
575
576 removehead $headids($name) $name
577 set headids($name) $id
578 lappend idheads($id) $name
579}
580
581# update things when a head has been removed
582proc removehead {id name} {
583 global headids idheads
584
585 if {$idheads($id) eq $name} {
586 unset idheads($id)
587 } else {
588 set i [lsearch -exact $idheads($id) $name]
589 if {$i >= 0} {
590 set idheads($id) [lreplace $idheads($id) $i $i]
591 }
592 }
593 unset headids($name)
594}
595
e54be9e3 596proc show_error {w top msg} {
df3d83b1
PM
597 message $w.m -text $msg -justify center -aspect 400
598 pack $w.m -side top -fill x -padx 20 -pady 20
d990cedf 599 button $w.ok -text [mc OK] -command "destroy $top"
df3d83b1 600 pack $w.ok -side bottom -fill x
e54be9e3
PM
601 bind $top <Visibility> "grab $top; focus $top"
602 bind $top <Key-Return> "destroy $top"
603 tkwait window $top
df3d83b1
PM
604}
605
098dd8a3
PM
606proc error_popup msg {
607 set w .error
608 toplevel $w
609 wm transient $w .
e54be9e3 610 show_error $w $w $msg
098dd8a3
PM
611}
612
10299152
PM
613proc confirm_popup msg {
614 global confirm_ok
615 set confirm_ok 0
616 set w .confirm
617 toplevel $w
618 wm transient $w .
619 message $w.m -text $msg -justify center -aspect 400
620 pack $w.m -side top -fill x -padx 20 -pady 20
d990cedf 621 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 622 pack $w.ok -side left -fill x
d990cedf 623 button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
624 pack $w.cancel -side right -fill x
625 bind $w <Visibility> "grab $w; focus $w"
626 tkwait window $w
627 return $confirm_ok
628}
629
b039f0a6
PM
630proc setoptions {} {
631 option add *Panedwindow.showHandle 1 startupFile
632 option add *Panedwindow.sashRelief raised startupFile
633 option add *Button.font uifont startupFile
634 option add *Checkbutton.font uifont startupFile
635 option add *Radiobutton.font uifont startupFile
636 option add *Menu.font uifont startupFile
637 option add *Menubutton.font uifont startupFile
638 option add *Label.font uifont startupFile
639 option add *Message.font uifont startupFile
640 option add *Entry.font uifont startupFile
641}
642
d94f8cd6 643proc makewindow {} {
fdedbcfb 644 global canv canv2 canv3 linespc charspc ctext cflist
9c311b32 645 global tabstop
b74fd579 646 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 647 global entries sha1entry sha1string sha1but
890fae70 648 global diffcontextstring diffcontext
b9b86007 649 global ignorespace
94a2eede 650 global maincursor textcursor curtextcursor
219ea3a9 651 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 652 global highlight_files gdttype
3ea06f9f 653 global searchstring sstring
60378c0c 654 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
bb3edc8b
PM
655 global headctxmenu progresscanv progressitem progresscoords statusw
656 global fprogitem fprogcoord lastprogupdate progupdatepending
a137a90f 657 global rprogitem rprogcoord
32f1b3e4 658 global have_tk85
9a40c50c
PM
659
660 menu .bar
d990cedf 661 .bar add cascade -label [mc "File"] -menu .bar.file
9a40c50c 662 menu .bar.file
d990cedf
CS
663 .bar.file add command -label [mc "Update"] -command updatecommits
664 .bar.file add command -label [mc "Reread references"] -command rereadrefs
665 .bar.file add command -label [mc "List references"] -command showrefs
666 .bar.file add command -label [mc "Quit"] -command doquit
712fcc08 667 menu .bar.edit
d990cedf
CS
668 .bar add cascade -label [mc "Edit"] -menu .bar.edit
669 .bar.edit add command -label [mc "Preferences"] -command doprefs
da7c24dd 670
b039f0a6 671 menu .bar.view
d990cedf
CS
672 .bar add cascade -label [mc "View"] -menu .bar.view
673 .bar.view add command -label [mc "New view..."] -command {newview 0}
674 .bar.view add command -label [mc "Edit view..."] -command editview \
da7c24dd 675 -state disabled
d990cedf 676 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
50b44ece 677 .bar.view add separator
d990cedf 678 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
a90a6d24 679 -variable selectedview -value 0
40b87ff8 680
9a40c50c 681 menu .bar.help
d990cedf
CS
682 .bar add cascade -label [mc "Help"] -menu .bar.help
683 .bar.help add command -label [mc "About gitk"] -command about
684 .bar.help add command -label [mc "Key bindings"] -command keys
b039f0a6 685 .bar.help configure
9a40c50c
PM
686 . configure -menu .bar
687
e9937d2a 688 # the gui has upper and lower half, parts of a paned window.
0327d27a 689 panedwindow .ctop -orient vertical
e9937d2a
JH
690
691 # possibly use assumed geometry
9ca72f4f 692 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
693 set geometry(topheight) [expr {15 * $linespc}]
694 set geometry(topwidth) [expr {80 * $charspc}]
695 set geometry(botheight) [expr {15 * $linespc}]
696 set geometry(botwidth) [expr {50 * $charspc}]
9ca72f4f
ML
697 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
698 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
e9937d2a
JH
699 }
700
701 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
702 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
703 frame .tf.histframe
704 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
705
706 # create three canvases
707 set cscroll .tf.histframe.csb
708 set canv .tf.histframe.pwclist.canv
9ca72f4f 709 canvas $canv \
60378c0c 710 -selectbackground $selectbgcolor \
f8a2c0d1 711 -background $bgcolor -bd 0 \
9f1afe05 712 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
713 .tf.histframe.pwclist add $canv
714 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 715 canvas $canv2 \
60378c0c 716 -selectbackground $selectbgcolor \
f8a2c0d1 717 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
718 .tf.histframe.pwclist add $canv2
719 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 720 canvas $canv3 \
60378c0c 721 -selectbackground $selectbgcolor \
f8a2c0d1 722 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 723 .tf.histframe.pwclist add $canv3
9ca72f4f
ML
724 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
725 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
e9937d2a
JH
726
727 # a scroll bar to rule them
728 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
729 pack $cscroll -side right -fill y
730 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 731 lappend bglist $canv $canv2 $canv3
e9937d2a 732 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 733
e9937d2a
JH
734 # we have two button bars at bottom of top frame. Bar 1
735 frame .tf.bar
736 frame .tf.lbar -height 15
737
738 set sha1entry .tf.bar.sha1
887fe3c4 739 set entries $sha1entry
e9937d2a 740 set sha1but .tf.bar.sha1label
d990cedf 741 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
b039f0a6 742 -command gotocommit -width 8
887fe3c4 743 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 744 pack .tf.bar.sha1label -side left
9c311b32 745 entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 746 trace add variable sha1string write sha1change
98f350e5 747 pack $sha1entry -side left -pady 2
d698206c
PM
748
749 image create bitmap bm-left -data {
750 #define left_width 16
751 #define left_height 16
752 static unsigned char left_bits[] = {
753 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
754 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
755 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
756 }
757 image create bitmap bm-right -data {
758 #define right_width 16
759 #define right_height 16
760 static unsigned char right_bits[] = {
761 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
762 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
763 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
764 }
e9937d2a 765 button .tf.bar.leftbut -image bm-left -command goback \
d698206c 766 -state disabled -width 26
e9937d2a
JH
767 pack .tf.bar.leftbut -side left -fill y
768 button .tf.bar.rightbut -image bm-right -command goforw \
d698206c 769 -state disabled -width 26
e9937d2a 770 pack .tf.bar.rightbut -side left -fill y
d698206c 771
bb3edc8b
PM
772 # Status label and progress bar
773 set statusw .tf.bar.status
b039f0a6 774 label $statusw -width 15 -relief sunken
bb3edc8b 775 pack $statusw -side left -padx 5
9c311b32 776 set h [expr {[font metrics uifont -linespace] + 2}]
bb3edc8b
PM
777 set progresscanv .tf.bar.progress
778 canvas $progresscanv -relief sunken -height $h -borderwidth 2
779 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
780 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
a137a90f 781 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
bb3edc8b
PM
782 pack $progresscanv -side right -expand 1 -fill x
783 set progresscoords {0 0}
784 set fprogcoord 0
a137a90f 785 set rprogcoord 0
bb3edc8b
PM
786 bind $progresscanv <Configure> adjustprogress
787 set lastprogupdate [clock clicks -milliseconds]
788 set progupdatepending 0
789
687c8765 790 # build up the bottom bar of upper window
b039f0a6
PM
791 label .tf.lbar.flabel -text "[mc "Find"] "
792 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
793 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
794 label .tf.lbar.flab2 -text " [mc "commit"] "
687c8765
PM
795 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
796 -side left -fill y
b007ee20 797 set gdttype [mc "containing:"]
687c8765 798 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
b007ee20
CS
799 [mc "containing:"] \
800 [mc "touching paths:"] \
801 [mc "adding/removing string:"]]
687c8765 802 trace add variable gdttype write gdttype_change
687c8765
PM
803 pack .tf.lbar.gdttype -side left -fill y
804
98f350e5 805 set findstring {}
687c8765 806 set fstring .tf.lbar.findstring
887fe3c4 807 lappend entries $fstring
9c311b32 808 entry $fstring -width 30 -font textfont -textvariable findstring
60f7a7dc 809 trace add variable findstring write find_change
b007ee20 810 set findtype [mc "Exact"]
687c8765 811 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
b007ee20 812 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 813 trace add variable findtype write findcom_change
b007ee20
CS
814 set findloc [mc "All fields"]
815 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
816 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 817 trace add variable findloc write find_change
687c8765
PM
818 pack .tf.lbar.findloc -side right
819 pack .tf.lbar.findtype -side right
820 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
821
822 # Finish putting the upper half of the viewer together
823 pack .tf.lbar -in .tf -side bottom -fill x
824 pack .tf.bar -in .tf -side bottom -fill x
825 pack .tf.histframe -fill both -side top -expand 1
826 .ctop add .tf
9ca72f4f
ML
827 .ctop paneconfigure .tf -height $geometry(topheight)
828 .ctop paneconfigure .tf -width $geometry(topwidth)
e9937d2a
JH
829
830 # now build up the bottom
831 panedwindow .pwbottom -orient horizontal
832
833 # lower left, a text box over search bar, scroll bar to the right
834 # if we know window height, then that will set the lower text height, otherwise
835 # we set lower text height which will drive window height
836 if {[info exists geometry(main)]} {
837 frame .bleft -width $geometry(botwidth)
838 } else {
839 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
840 }
841 frame .bleft.top
a8d610a2 842 frame .bleft.mid
8809d691 843 frame .bleft.bottom
e9937d2a 844
b039f0a6 845 button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
846 pack .bleft.top.search -side left -padx 5
847 set sstring .bleft.top.sstring
9c311b32 848 entry $sstring -width 20 -font textfont -textvariable searchstring
3ea06f9f
PM
849 lappend entries $sstring
850 trace add variable searchstring write incrsearch
851 pack $sstring -side left -expand 1 -fill x
b039f0a6 852 radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 853 -command changediffdisp -variable diffelide -value {0 0}
b039f0a6 854 radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 855 -command changediffdisp -variable diffelide -value {0 1}
b039f0a6 856 radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 857 -command changediffdisp -variable diffelide -value {1 0}
b039f0a6 858 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
a8d610a2 859 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
9c311b32 860 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
890fae70
SP
861 -from 1 -increment 1 -to 10000000 \
862 -validate all -validatecommand "diffcontextvalidate %P" \
863 -textvariable diffcontextstring
864 .bleft.mid.diffcontext set $diffcontext
865 trace add variable diffcontextstring write diffcontextchange
866 lappend entries .bleft.mid.diffcontext
867 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
b9b86007
SP
868 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
869 -command changeignorespace -variable ignorespace
870 pack .bleft.mid.ignspace -side left -padx 5
8809d691 871 set ctext .bleft.bottom.ctext
f8a2c0d1 872 text $ctext -background $bgcolor -foreground $fgcolor \
9c311b32 873 -state disabled -font textfont \
8809d691
PK
874 -yscrollcommand scrolltext -wrap none \
875 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4
PM
876 if {$have_tk85} {
877 $ctext conf -tabstyle wordprocessor
878 }
8809d691
PK
879 scrollbar .bleft.bottom.sb -command "$ctext yview"
880 scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
881 -width 10
e9937d2a 882 pack .bleft.top -side top -fill x
a8d610a2 883 pack .bleft.mid -side top -fill x
8809d691
PK
884 grid $ctext .bleft.bottom.sb -sticky nsew
885 grid .bleft.bottom.sbhorizontal -sticky ew
886 grid columnconfigure .bleft.bottom 0 -weight 1
887 grid rowconfigure .bleft.bottom 0 -weight 1
888 grid rowconfigure .bleft.bottom 1 -weight 0
889 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
890 lappend bglist $ctext
891 lappend fglist $ctext
d2610d11 892
f1b86294 893 $ctext tag conf comment -wrap $wrapcomment
9c311b32 894 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
f8a2c0d1
PM
895 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
896 $ctext tag conf d0 -fore [lindex $diffcolors 0]
897 $ctext tag conf d1 -fore [lindex $diffcolors 1]
712fcc08
PM
898 $ctext tag conf m0 -fore red
899 $ctext tag conf m1 -fore blue
900 $ctext tag conf m2 -fore green
901 $ctext tag conf m3 -fore purple
902 $ctext tag conf m4 -fore brown
b77b0278
PM
903 $ctext tag conf m5 -fore "#009090"
904 $ctext tag conf m6 -fore magenta
905 $ctext tag conf m7 -fore "#808000"
906 $ctext tag conf m8 -fore "#009000"
907 $ctext tag conf m9 -fore "#ff0080"
908 $ctext tag conf m10 -fore cyan
909 $ctext tag conf m11 -fore "#b07070"
910 $ctext tag conf m12 -fore "#70b0f0"
911 $ctext tag conf m13 -fore "#70f0b0"
912 $ctext tag conf m14 -fore "#f0b070"
913 $ctext tag conf m15 -fore "#ff70b0"
712fcc08 914 $ctext tag conf mmax -fore darkgrey
b77b0278 915 set mergemax 16
9c311b32
PM
916 $ctext tag conf mresult -font textfontbold
917 $ctext tag conf msep -font textfontbold
712fcc08 918 $ctext tag conf found -back yellow
e5c2d856 919
e9937d2a 920 .pwbottom add .bleft
9ca72f4f 921 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
e9937d2a
JH
922
923 # lower right
924 frame .bright
925 frame .bright.mode
d990cedf 926 radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 927 -command reselectline -variable cmitmode -value "patch"
d990cedf 928 radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 929 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
930 grid .bright.mode.patch .bright.mode.tree -sticky ew
931 pack .bright.mode -side top -fill x
932 set cflist .bright.cfiles
9c311b32 933 set indent [font measure mainfont "nn"]
e9937d2a 934 text $cflist \
60378c0c 935 -selectbackground $selectbgcolor \
f8a2c0d1 936 -background $bgcolor -foreground $fgcolor \
9c311b32 937 -font mainfont \
7fcceed7 938 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 939 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
940 -cursor [. cget -cursor] \
941 -spacing1 1 -spacing3 1
f8a2c0d1
PM
942 lappend bglist $cflist
943 lappend fglist $cflist
e9937d2a
JH
944 scrollbar .bright.sb -command "$cflist yview"
945 pack .bright.sb -side right -fill y
d2610d11 946 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
947 $cflist tag configure highlight \
948 -background [$cflist cget -selectbackground]
9c311b32 949 $cflist tag configure bold -font mainfontbold
d2610d11 950
e9937d2a
JH
951 .pwbottom add .bright
952 .ctop add .pwbottom
1db95b00 953
b9bee115 954 # restore window width & height if known
e9937d2a 955 if {[info exists geometry(main)]} {
b9bee115
PM
956 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
957 if {$w > [winfo screenwidth .]} {
958 set w [winfo screenwidth .]
959 }
960 if {$h > [winfo screenheight .]} {
961 set h [winfo screenheight .]
962 }
963 wm geometry . "${w}x$h"
964 }
e9937d2a
JH
965 }
966
d23d98d3
SP
967 if {[tk windowingsystem] eq {aqua}} {
968 set M1B M1
969 } else {
970 set M1B Control
971 }
972
e9937d2a
JH
973 bind .pwbottom <Configure> {resizecdetpanes %W %w}
974 pack .ctop -fill both -expand 1
c8dfbcf9
PM
975 bindall <1> {selcanvline %W %x %y}
976 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
977 if {[tk windowingsystem] == "win32"} {
978 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
979 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
980 } else {
981 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
982 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
5dd57d51
JS
983 if {[tk windowingsystem] eq "aqua"} {
984 bindall <MouseWheel> {
985 set delta [expr {- (%D)}]
986 allcanvs yview scroll $delta units
987 }
988 }
314c3093 989 }
be0cd098
PM
990 bindall <2> "canvscan mark %W %x %y"
991 bindall <B2-Motion> "canvscan dragto %W %x %y"
6e5f7203
RN
992 bindkey <Home> selfirstline
993 bindkey <End> sellastline
17386066
PM
994 bind . <Key-Up> "selnextline -1"
995 bind . <Key-Down> "selnextline 1"
cca5d946
PM
996 bind . <Shift-Key-Up> "dofind -1 0"
997 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
998 bindkey <Key-Right> "goforw"
999 bindkey <Key-Left> "goback"
1000 bind . <Key-Prior> "selnextpage -1"
1001 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
1002 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1003 bind . <$M1B-End> "allcanvs yview moveto 1.0"
1004 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1005 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1006 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1007 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
1008 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1009 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1010 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
1011 bindkey p "selnextline -1"
1012 bindkey n "selnextline 1"
6e2dda35
RS
1013 bindkey z "goback"
1014 bindkey x "goforw"
1015 bindkey i "selnextline -1"
1016 bindkey k "selnextline 1"
1017 bindkey j "goback"
1018 bindkey l "goforw"
cfb4563c
PM
1019 bindkey b "$ctext yview scroll -1 pages"
1020 bindkey d "$ctext yview scroll 18 units"
1021 bindkey u "$ctext yview scroll -18 units"
cca5d946
PM
1022 bindkey / {dofind 1 1}
1023 bindkey <Key-Return> {dofind 1 1}
1024 bindkey ? {dofind -1 1}
39ad8570 1025 bindkey f nextfile
e7a09191 1026 bindkey <F5> updatecommits
d23d98d3 1027 bind . <$M1B-q> doquit
cca5d946
PM
1028 bind . <$M1B-f> {dofind 1 1}
1029 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
1030 bind . <$M1B-r> dosearchback
1031 bind . <$M1B-s> dosearch
1032 bind . <$M1B-equal> {incrfont 1}
646f3a14 1033 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
1034 bind . <$M1B-KP_Add> {incrfont 1}
1035 bind . <$M1B-minus> {incrfont -1}
1036 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 1037 wm protocol . WM_DELETE_WINDOW doquit
df3d83b1 1038 bind . <Button-1> "click %W"
cca5d946 1039 bind $fstring <Key-Return> {dofind 1 1}
887fe3c4 1040 bind $sha1entry <Key-Return> gotocommit
ee3dc72e 1041 bind $sha1entry <<PasteSelection>> clearsha1
7fcceed7
PM
1042 bind $cflist <1> {sel_flist %W %x %y; break}
1043 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 1044 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
3244729a 1045 bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
ea13cba1
PM
1046
1047 set maincursor [. cget -cursor]
1048 set textcursor [$ctext cget -cursor]
94a2eede 1049 set curtextcursor $textcursor
84ba7345 1050
c8dfbcf9
PM
1051 set rowctxmenu .rowctxmenu
1052 menu $rowctxmenu -tearoff 0
d990cedf 1053 $rowctxmenu add command -label [mc "Diff this -> selected"] \
c8dfbcf9 1054 -command {diffvssel 0}
d990cedf 1055 $rowctxmenu add command -label [mc "Diff selected -> this"] \
c8dfbcf9 1056 -command {diffvssel 1}
d990cedf
CS
1057 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
1058 $rowctxmenu add command -label [mc "Create tag"] -command mktag
1059 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
1060 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
1061 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
ca6d8f58 1062 -command cherrypick
d990cedf 1063 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
6fb735ae 1064 -command resethead
10299152 1065
219ea3a9
PM
1066 set fakerowmenu .fakerowmenu
1067 menu $fakerowmenu -tearoff 0
d990cedf 1068 $fakerowmenu add command -label [mc "Diff this -> selected"] \
219ea3a9 1069 -command {diffvssel 0}
d990cedf 1070 $fakerowmenu add command -label [mc "Diff selected -> this"] \
219ea3a9 1071 -command {diffvssel 1}
d990cedf
CS
1072 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
1073# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
1074# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
1075# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
219ea3a9 1076
10299152
PM
1077 set headctxmenu .headctxmenu
1078 menu $headctxmenu -tearoff 0
d990cedf 1079 $headctxmenu add command -label [mc "Check out this branch"] \
10299152 1080 -command cobranch
d990cedf 1081 $headctxmenu add command -label [mc "Remove this branch"] \
10299152 1082 -command rmbranch
3244729a
PM
1083
1084 global flist_menu
1085 set flist_menu .flistctxmenu
1086 menu $flist_menu -tearoff 0
d990cedf 1087 $flist_menu add command -label [mc "Highlight this too"] \
3244729a 1088 -command {flist_hl 0}
d990cedf 1089 $flist_menu add command -label [mc "Highlight this only"] \
3244729a 1090 -command {flist_hl 1}
df3d83b1
PM
1091}
1092
314c3093
ML
1093# Windows sends all mouse wheel events to the current focused window, not
1094# the one where the mouse hovers, so bind those events here and redirect
1095# to the correct window
1096proc windows_mousewheel_redirector {W X Y D} {
1097 global canv canv2 canv3
1098 set w [winfo containing -displayof $W $X $Y]
1099 if {$w ne ""} {
1100 set u [expr {$D < 0 ? 5 : -5}]
1101 if {$w == $canv || $w == $canv2 || $w == $canv3} {
1102 allcanvs yview scroll $u units
1103 } else {
1104 catch {
1105 $w yview scroll $u units
1106 }
1107 }
1108 }
1109}
1110
be0cd098
PM
1111# mouse-2 makes all windows scan vertically, but only the one
1112# the cursor is in scans horizontally
1113proc canvscan {op w x y} {
1114 global canv canv2 canv3
1115 foreach c [list $canv $canv2 $canv3] {
1116 if {$c == $w} {
1117 $c scan $op $x $y
1118 } else {
1119 $c scan $op 0 $y
1120 }
1121 }
1122}
1123
9f1afe05
PM
1124proc scrollcanv {cscroll f0 f1} {
1125 $cscroll set $f0 $f1
1126 drawfrac $f0 $f1
908c3585 1127 flushhighlights
9f1afe05
PM
1128}
1129
df3d83b1
PM
1130# when we make a key binding for the toplevel, make sure
1131# it doesn't get triggered when that key is pressed in the
1132# find string entry widget.
1133proc bindkey {ev script} {
887fe3c4 1134 global entries
df3d83b1
PM
1135 bind . $ev $script
1136 set escript [bind Entry $ev]
1137 if {$escript == {}} {
1138 set escript [bind Entry <Key>]
1139 }
887fe3c4
PM
1140 foreach e $entries {
1141 bind $e $ev "$escript; break"
1142 }
df3d83b1
PM
1143}
1144
1145# set the focus back to the toplevel for any click outside
887fe3c4 1146# the entry widgets
df3d83b1 1147proc click {w} {
bd441de4
ML
1148 global ctext entries
1149 foreach e [concat $entries $ctext] {
887fe3c4 1150 if {$w == $e} return
df3d83b1 1151 }
887fe3c4 1152 focus .
0fba86b3
PM
1153}
1154
bb3edc8b
PM
1155# Adjust the progress bar for a change in requested extent or canvas size
1156proc adjustprogress {} {
1157 global progresscanv progressitem progresscoords
1158 global fprogitem fprogcoord lastprogupdate progupdatepending
a137a90f 1159 global rprogitem rprogcoord
bb3edc8b
PM
1160
1161 set w [expr {[winfo width $progresscanv] - 4}]
1162 set x0 [expr {$w * [lindex $progresscoords 0]}]
1163 set x1 [expr {$w * [lindex $progresscoords 1]}]
1164 set h [winfo height $progresscanv]
1165 $progresscanv coords $progressitem $x0 0 $x1 $h
1166 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 1167 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
1168 set now [clock clicks -milliseconds]
1169 if {$now >= $lastprogupdate + 100} {
1170 set progupdatepending 0
1171 update
1172 } elseif {!$progupdatepending} {
1173 set progupdatepending 1
1174 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1175 }
1176}
1177
1178proc doprogupdate {} {
1179 global lastprogupdate progupdatepending
1180
1181 if {$progupdatepending} {
1182 set progupdatepending 0
1183 set lastprogupdate [clock clicks -milliseconds]
1184 update
1185 }
1186}
1187
0fba86b3 1188proc savestuff {w} {
32f1b3e4 1189 global canv canv2 canv3 mainfont textfont uifont tabstop
712fcc08 1190 global stuffsaved findmergefiles maxgraphpct
219ea3a9 1191 global maxwidth showneartags showlocalchanges
2d480856 1192 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
7a39a17a 1193 global cmitmode wrapcomment datetimeformat limitdiffs
890fae70 1194 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
95293b58 1195 global autoselect
4ef17537 1196
0fba86b3 1197 if {$stuffsaved} return
df3d83b1 1198 if {![winfo viewable .]} return
0fba86b3
PM
1199 catch {
1200 set f [open "~/.gitk-new" w]
f0654861
PM
1201 puts $f [list set mainfont $mainfont]
1202 puts $f [list set textfont $textfont]
4840be66 1203 puts $f [list set uifont $uifont]
7e12f1a6 1204 puts $f [list set tabstop $tabstop]
f0654861 1205 puts $f [list set findmergefiles $findmergefiles]
8d858d1a 1206 puts $f [list set maxgraphpct $maxgraphpct]
04c13d38 1207 puts $f [list set maxwidth $maxwidth]
f8b28a40 1208 puts $f [list set cmitmode $cmitmode]
f1b86294 1209 puts $f [list set wrapcomment $wrapcomment]
95293b58 1210 puts $f [list set autoselect $autoselect]
b8ab2e17 1211 puts $f [list set showneartags $showneartags]
219ea3a9 1212 puts $f [list set showlocalchanges $showlocalchanges]
e8b5f4be 1213 puts $f [list set datetimeformat $datetimeformat]
7a39a17a 1214 puts $f [list set limitdiffs $limitdiffs]
f8a2c0d1
PM
1215 puts $f [list set bgcolor $bgcolor]
1216 puts $f [list set fgcolor $fgcolor]
1217 puts $f [list set colors $colors]
1218 puts $f [list set diffcolors $diffcolors]
890fae70 1219 puts $f [list set diffcontext $diffcontext]
60378c0c 1220 puts $f [list set selectbgcolor $selectbgcolor]
e9937d2a 1221
b6047c5a 1222 puts $f "set geometry(main) [wm geometry .]"
e9937d2a
JH
1223 puts $f "set geometry(topwidth) [winfo width .tf]"
1224 puts $f "set geometry(topheight) [winfo height .tf]"
9ca72f4f
ML
1225 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1226 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
e9937d2a
JH
1227 puts $f "set geometry(botwidth) [winfo width .bleft]"
1228 puts $f "set geometry(botheight) [winfo height .bleft]"
1229
a90a6d24
PM
1230 puts -nonewline $f "set permviews {"
1231 for {set v 0} {$v < $nextviewnum} {incr v} {
1232 if {$viewperm($v)} {
2d480856 1233 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
a90a6d24
PM
1234 }
1235 }
1236 puts $f "}"
0fba86b3
PM
1237 close $f
1238 file rename -force "~/.gitk-new" "~/.gitk"
1239 }
1240 set stuffsaved 1
1db95b00
PM
1241}
1242
43bddeb4
PM
1243proc resizeclistpanes {win w} {
1244 global oldwidth
418c4c7b 1245 if {[info exists oldwidth($win)]} {
43bddeb4
PM
1246 set s0 [$win sash coord 0]
1247 set s1 [$win sash coord 1]
1248 if {$w < 60} {
1249 set sash0 [expr {int($w/2 - 2)}]
1250 set sash1 [expr {int($w*5/6 - 2)}]
1251 } else {
1252 set factor [expr {1.0 * $w / $oldwidth($win)}]
1253 set sash0 [expr {int($factor * [lindex $s0 0])}]
1254 set sash1 [expr {int($factor * [lindex $s1 0])}]
1255 if {$sash0 < 30} {
1256 set sash0 30
1257 }
1258 if {$sash1 < $sash0 + 20} {
2ed49d54 1259 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
1260 }
1261 if {$sash1 > $w - 10} {
2ed49d54 1262 set sash1 [expr {$w - 10}]
43bddeb4 1263 if {$sash0 > $sash1 - 20} {
2ed49d54 1264 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
1265 }
1266 }
1267 }
1268 $win sash place 0 $sash0 [lindex $s0 1]
1269 $win sash place 1 $sash1 [lindex $s1 1]
1270 }
1271 set oldwidth($win) $w
1272}
1273
1274proc resizecdetpanes {win w} {
1275 global oldwidth
418c4c7b 1276 if {[info exists oldwidth($win)]} {
43bddeb4
PM
1277 set s0 [$win sash coord 0]
1278 if {$w < 60} {
1279 set sash0 [expr {int($w*3/4 - 2)}]
1280 } else {
1281 set factor [expr {1.0 * $w / $oldwidth($win)}]
1282 set sash0 [expr {int($factor * [lindex $s0 0])}]
1283 if {$sash0 < 45} {
1284 set sash0 45
1285 }
1286 if {$sash0 > $w - 15} {
2ed49d54 1287 set sash0 [expr {$w - 15}]
43bddeb4
PM
1288 }
1289 }
1290 $win sash place 0 $sash0 [lindex $s0 1]
1291 }
1292 set oldwidth($win) $w
1293}
1294
b5721c72
PM
1295proc allcanvs args {
1296 global canv canv2 canv3
1297 eval $canv $args
1298 eval $canv2 $args
1299 eval $canv3 $args
1300}
1301
1302proc bindall {event action} {
1303 global canv canv2 canv3
1304 bind $canv $event $action
1305 bind $canv2 $event $action
1306 bind $canv3 $event $action
1307}
1308
9a40c50c 1309proc about {} {
d59c4b6f 1310 global uifont
9a40c50c
PM
1311 set w .about
1312 if {[winfo exists $w]} {
1313 raise $w
1314 return
1315 }
1316 toplevel $w
d990cedf
CS
1317 wm title $w [mc "About gitk"]
1318 message $w.m -text [mc "
9f1afe05 1319Gitk - a commit viewer for git
9a40c50c 1320
eadcac92 1321Copyright © 2005-2006 Paul Mackerras
9a40c50c 1322
d990cedf 1323Use and redistribute under the terms of the GNU General Public License"] \
3a950e9a
ER
1324 -justify center -aspect 400 -border 2 -bg white -relief groove
1325 pack $w.m -side top -fill x -padx 2 -pady 2
d990cedf 1326 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 1327 pack $w.ok -side bottom
3a950e9a
ER
1328 bind $w <Visibility> "focus $w.ok"
1329 bind $w <Key-Escape> "destroy $w"
1330 bind $w <Key-Return> "destroy $w"
9a40c50c
PM
1331}
1332
4e95e1f7
PM
1333proc keys {} {
1334 set w .keys
1335 if {[winfo exists $w]} {
1336 raise $w
1337 return
1338 }
d23d98d3
SP
1339 if {[tk windowingsystem] eq {aqua}} {
1340 set M1T Cmd
1341 } else {
1342 set M1T Ctrl
1343 }
4e95e1f7 1344 toplevel $w
d990cedf 1345 wm title $w [mc "Gitk key bindings"]
3d2c998e
MB
1346 message $w.m -text "
1347[mc "Gitk key bindings:"]
1348
1349[mc "<%s-Q> Quit" $M1T]
1350[mc "<Home> Move to first commit"]
1351[mc "<End> Move to last commit"]
1352[mc "<Up>, p, i Move up one commit"]
1353[mc "<Down>, n, k Move down one commit"]
1354[mc "<Left>, z, j Go back in history list"]
1355[mc "<Right>, x, l Go forward in history list"]
1356[mc "<PageUp> Move up one page in commit list"]
1357[mc "<PageDown> Move down one page in commit list"]
1358[mc "<%s-Home> Scroll to top of commit list" $M1T]
1359[mc "<%s-End> Scroll to bottom of commit list" $M1T]
1360[mc "<%s-Up> Scroll commit list up one line" $M1T]
1361[mc "<%s-Down> Scroll commit list down one line" $M1T]
1362[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
1363[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
1364[mc "<Shift-Up> Find backwards (upwards, later commits)"]
1365[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
1366[mc "<Delete>, b Scroll diff view up one page"]
1367[mc "<Backspace> Scroll diff view up one page"]
1368[mc "<Space> Scroll diff view down one page"]
1369[mc "u Scroll diff view up 18 lines"]
1370[mc "d Scroll diff view down 18 lines"]
1371[mc "<%s-F> Find" $M1T]
1372[mc "<%s-G> Move to next find hit" $M1T]
1373[mc "<Return> Move to next find hit"]
1374[mc "/ Move to next find hit, or redo find"]
1375[mc "? Move to previous find hit"]
1376[mc "f Scroll diff view to next file"]
1377[mc "<%s-S> Search for next hit in diff view" $M1T]
1378[mc "<%s-R> Search for previous hit in diff view" $M1T]
1379[mc "<%s-KP+> Increase font size" $M1T]
1380[mc "<%s-plus> Increase font size" $M1T]
1381[mc "<%s-KP-> Decrease font size" $M1T]
1382[mc "<%s-minus> Decrease font size" $M1T]
1383[mc "<F5> Update"]
1384" \
3a950e9a
ER
1385 -justify left -bg white -border 2 -relief groove
1386 pack $w.m -side top -fill both -padx 2 -pady 2
d990cedf 1387 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
4e95e1f7 1388 pack $w.ok -side bottom
3a950e9a
ER
1389 bind $w <Visibility> "focus $w.ok"
1390 bind $w <Key-Escape> "destroy $w"
1391 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
1392}
1393
7fcceed7
PM
1394# Procedures for manipulating the file list window at the
1395# bottom right of the overall window.
f8b28a40
PM
1396
1397proc treeview {w l openlevs} {
1398 global treecontents treediropen treeheight treeparent treeindex
1399
1400 set ix 0
1401 set treeindex() 0
1402 set lev 0
1403 set prefix {}
1404 set prefixend -1
1405 set prefendstack {}
1406 set htstack {}
1407 set ht 0
1408 set treecontents() {}
1409 $w conf -state normal
1410 foreach f $l {
1411 while {[string range $f 0 $prefixend] ne $prefix} {
1412 if {$lev <= $openlevs} {
1413 $w mark set e:$treeindex($prefix) "end -1c"
1414 $w mark gravity e:$treeindex($prefix) left
1415 }
1416 set treeheight($prefix) $ht
1417 incr ht [lindex $htstack end]
1418 set htstack [lreplace $htstack end end]
1419 set prefixend [lindex $prefendstack end]
1420 set prefendstack [lreplace $prefendstack end end]
1421 set prefix [string range $prefix 0 $prefixend]
1422 incr lev -1
1423 }
1424 set tail [string range $f [expr {$prefixend+1}] end]
1425 while {[set slash [string first "/" $tail]] >= 0} {
1426 lappend htstack $ht
1427 set ht 0
1428 lappend prefendstack $prefixend
1429 incr prefixend [expr {$slash + 1}]
1430 set d [string range $tail 0 $slash]
1431 lappend treecontents($prefix) $d
1432 set oldprefix $prefix
1433 append prefix $d
1434 set treecontents($prefix) {}
1435 set treeindex($prefix) [incr ix]
1436 set treeparent($prefix) $oldprefix
1437 set tail [string range $tail [expr {$slash+1}] end]
1438 if {$lev <= $openlevs} {
1439 set ht 1
1440 set treediropen($prefix) [expr {$lev < $openlevs}]
1441 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1442 $w mark set d:$ix "end -1c"
1443 $w mark gravity d:$ix left
1444 set str "\n"
1445 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1446 $w insert end $str
1447 $w image create end -align center -image $bm -padx 1 \
1448 -name a:$ix
45a9d505 1449 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
1450 $w mark set s:$ix "end -1c"
1451 $w mark gravity s:$ix left
1452 }
1453 incr lev
1454 }
1455 if {$tail ne {}} {
1456 if {$lev <= $openlevs} {
1457 incr ht
1458 set str "\n"
1459 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1460 $w insert end $str
45a9d505 1461 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
1462 }
1463 lappend treecontents($prefix) $tail
1464 }
1465 }
1466 while {$htstack ne {}} {
1467 set treeheight($prefix) $ht
1468 incr ht [lindex $htstack end]
1469 set htstack [lreplace $htstack end end]
096e96b4
BD
1470 set prefixend [lindex $prefendstack end]
1471 set prefendstack [lreplace $prefendstack end end]
1472 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
1473 }
1474 $w conf -state disabled
1475}
1476
1477proc linetoelt {l} {
1478 global treeheight treecontents
1479
1480 set y 2
1481 set prefix {}
1482 while {1} {
1483 foreach e $treecontents($prefix) {
1484 if {$y == $l} {
1485 return "$prefix$e"
1486 }
1487 set n 1
1488 if {[string index $e end] eq "/"} {
1489 set n $treeheight($prefix$e)
1490 if {$y + $n > $l} {
1491 append prefix $e
1492 incr y
1493 break
1494 }
1495 }
1496 incr y $n
1497 }
1498 }
1499}
1500
45a9d505
PM
1501proc highlight_tree {y prefix} {
1502 global treeheight treecontents cflist
1503
1504 foreach e $treecontents($prefix) {
1505 set path $prefix$e
1506 if {[highlight_tag $path] ne {}} {
1507 $cflist tag add bold $y.0 "$y.0 lineend"
1508 }
1509 incr y
1510 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1511 set y [highlight_tree $y $path]
1512 }
1513 }
1514 return $y
1515}
1516
f8b28a40
PM
1517proc treeclosedir {w dir} {
1518 global treediropen treeheight treeparent treeindex
1519
1520 set ix $treeindex($dir)
1521 $w conf -state normal
1522 $w delete s:$ix e:$ix
1523 set treediropen($dir) 0
1524 $w image configure a:$ix -image tri-rt
1525 $w conf -state disabled
1526 set n [expr {1 - $treeheight($dir)}]
1527 while {$dir ne {}} {
1528 incr treeheight($dir) $n
1529 set dir $treeparent($dir)
1530 }
1531}
1532
1533proc treeopendir {w dir} {
1534 global treediropen treeheight treeparent treecontents treeindex
1535
1536 set ix $treeindex($dir)
1537 $w conf -state normal
1538 $w image configure a:$ix -image tri-dn
1539 $w mark set e:$ix s:$ix
1540 $w mark gravity e:$ix right
1541 set lev 0
1542 set str "\n"
1543 set n [llength $treecontents($dir)]
1544 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1545 incr lev
1546 append str "\t"
1547 incr treeheight($x) $n
1548 }
1549 foreach e $treecontents($dir) {
45a9d505 1550 set de $dir$e
f8b28a40 1551 if {[string index $e end] eq "/"} {
f8b28a40
PM
1552 set iy $treeindex($de)
1553 $w mark set d:$iy e:$ix
1554 $w mark gravity d:$iy left
1555 $w insert e:$ix $str
1556 set treediropen($de) 0
1557 $w image create e:$ix -align center -image tri-rt -padx 1 \
1558 -name a:$iy
45a9d505 1559 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
1560 $w mark set s:$iy e:$ix
1561 $w mark gravity s:$iy left
1562 set treeheight($de) 1
1563 } else {
1564 $w insert e:$ix $str
45a9d505 1565 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
1566 }
1567 }
1568 $w mark gravity e:$ix left
1569 $w conf -state disabled
1570 set treediropen($dir) 1
1571 set top [lindex [split [$w index @0,0] .] 0]
1572 set ht [$w cget -height]
1573 set l [lindex [split [$w index s:$ix] .] 0]
1574 if {$l < $top} {
1575 $w yview $l.0
1576 } elseif {$l + $n + 1 > $top + $ht} {
1577 set top [expr {$l + $n + 2 - $ht}]
1578 if {$l < $top} {
1579 set top $l
1580 }
1581 $w yview $top.0
1582 }
1583}
1584
1585proc treeclick {w x y} {
1586 global treediropen cmitmode ctext cflist cflist_top
1587
1588 if {$cmitmode ne "tree"} return
1589 if {![info exists cflist_top]} return
1590 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1591 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1592 $cflist tag add highlight $l.0 "$l.0 lineend"
1593 set cflist_top $l
1594 if {$l == 1} {
1595 $ctext yview 1.0
1596 return
1597 }
1598 set e [linetoelt $l]
1599 if {[string index $e end] ne "/"} {
1600 showfile $e
1601 } elseif {$treediropen($e)} {
1602 treeclosedir $w $e
1603 } else {
1604 treeopendir $w $e
1605 }
1606}
1607
1608proc setfilelist {id} {
1609 global treefilelist cflist
1610
1611 treeview $cflist $treefilelist($id) 0
1612}
1613
1614image create bitmap tri-rt -background black -foreground blue -data {
1615 #define tri-rt_width 13
1616 #define tri-rt_height 13
1617 static unsigned char tri-rt_bits[] = {
1618 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1619 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1620 0x00, 0x00};
1621} -maskdata {
1622 #define tri-rt-mask_width 13
1623 #define tri-rt-mask_height 13
1624 static unsigned char tri-rt-mask_bits[] = {
1625 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1626 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1627 0x08, 0x00};
1628}
1629image create bitmap tri-dn -background black -foreground blue -data {
1630 #define tri-dn_width 13
1631 #define tri-dn_height 13
1632 static unsigned char tri-dn_bits[] = {
1633 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1634 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1635 0x00, 0x00};
1636} -maskdata {
1637 #define tri-dn-mask_width 13
1638 #define tri-dn-mask_height 13
1639 static unsigned char tri-dn-mask_bits[] = {
1640 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1641 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1642 0x00, 0x00};
1643}
1644
887c996e
PM
1645image create bitmap reficon-T -background black -foreground yellow -data {
1646 #define tagicon_width 13
1647 #define tagicon_height 9
1648 static unsigned char tagicon_bits[] = {
1649 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1650 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1651} -maskdata {
1652 #define tagicon-mask_width 13
1653 #define tagicon-mask_height 9
1654 static unsigned char tagicon-mask_bits[] = {
1655 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1656 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1657}
1658set rectdata {
1659 #define headicon_width 13
1660 #define headicon_height 9
1661 static unsigned char headicon_bits[] = {
1662 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1663 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1664}
1665set rectmask {
1666 #define headicon-mask_width 13
1667 #define headicon-mask_height 9
1668 static unsigned char headicon-mask_bits[] = {
1669 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1670 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1671}
1672image create bitmap reficon-H -background black -foreground green \
1673 -data $rectdata -maskdata $rectmask
1674image create bitmap reficon-o -background black -foreground "#ddddff" \
1675 -data $rectdata -maskdata $rectmask
1676
7fcceed7 1677proc init_flist {first} {
89b11d3b 1678 global cflist cflist_top selectedline difffilestart
7fcceed7
PM
1679
1680 $cflist conf -state normal
1681 $cflist delete 0.0 end
1682 if {$first ne {}} {
1683 $cflist insert end $first
1684 set cflist_top 1
7fcceed7
PM
1685 $cflist tag add highlight 1.0 "1.0 lineend"
1686 } else {
1687 catch {unset cflist_top}
1688 }
1689 $cflist conf -state disabled
1690 set difffilestart {}
1691}
1692
63b79191
PM
1693proc highlight_tag {f} {
1694 global highlight_paths
1695
1696 foreach p $highlight_paths {
1697 if {[string match $p $f]} {
1698 return "bold"
1699 }
1700 }
1701 return {}
1702}
1703
1704proc highlight_filelist {} {
45a9d505 1705 global cmitmode cflist
63b79191 1706
45a9d505
PM
1707 $cflist conf -state normal
1708 if {$cmitmode ne "tree"} {
63b79191
PM
1709 set end [lindex [split [$cflist index end] .] 0]
1710 for {set l 2} {$l < $end} {incr l} {
1711 set line [$cflist get $l.0 "$l.0 lineend"]
1712 if {[highlight_tag $line] ne {}} {
1713 $cflist tag add bold $l.0 "$l.0 lineend"
1714 }
1715 }
45a9d505
PM
1716 } else {
1717 highlight_tree 2 {}
63b79191 1718 }
45a9d505 1719 $cflist conf -state disabled
63b79191
PM
1720}
1721
1722proc unhighlight_filelist {} {
45a9d505 1723 global cflist
63b79191 1724
45a9d505
PM
1725 $cflist conf -state normal
1726 $cflist tag remove bold 1.0 end
1727 $cflist conf -state disabled
63b79191
PM
1728}
1729
f8b28a40 1730proc add_flist {fl} {
45a9d505 1731 global cflist
7fcceed7 1732
45a9d505
PM
1733 $cflist conf -state normal
1734 foreach f $fl {
1735 $cflist insert end "\n"
1736 $cflist insert end $f [highlight_tag $f]
7fcceed7 1737 }
45a9d505 1738 $cflist conf -state disabled
7fcceed7
PM
1739}
1740
1741proc sel_flist {w x y} {
45a9d505 1742 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 1743
f8b28a40 1744 if {$cmitmode eq "tree"} return
7fcceed7
PM
1745 if {![info exists cflist_top]} return
1746 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
1747 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1748 $cflist tag add highlight $l.0 "$l.0 lineend"
1749 set cflist_top $l
f8b28a40
PM
1750 if {$l == 1} {
1751 $ctext yview 1.0
1752 } else {
1753 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 1754 }
7fcceed7
PM
1755}
1756
3244729a
PM
1757proc pop_flist_menu {w X Y x y} {
1758 global ctext cflist cmitmode flist_menu flist_menu_file
1759 global treediffs diffids
1760
bb3edc8b 1761 stopfinding
3244729a
PM
1762 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1763 if {$l <= 1} return
1764 if {$cmitmode eq "tree"} {
1765 set e [linetoelt $l]
1766 if {[string index $e end] eq "/"} return
1767 } else {
1768 set e [lindex $treediffs($diffids) [expr {$l-2}]]
1769 }
1770 set flist_menu_file $e
1771 tk_popup $flist_menu $X $Y
1772}
1773
1774proc flist_hl {only} {
bb3edc8b 1775 global flist_menu_file findstring gdttype
3244729a
PM
1776
1777 set x [shellquote $flist_menu_file]
b007ee20 1778 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 1779 set findstring $x
3244729a 1780 } else {
bb3edc8b 1781 append findstring " " $x
3244729a 1782 }
b007ee20 1783 set gdttype [mc "touching paths:"]
3244729a
PM
1784}
1785
098dd8a3
PM
1786# Functions for adding and removing shell-type quoting
1787
1788proc shellquote {str} {
1789 if {![string match "*\['\"\\ \t]*" $str]} {
1790 return $str
1791 }
1792 if {![string match "*\['\"\\]*" $str]} {
1793 return "\"$str\""
1794 }
1795 if {![string match "*'*" $str]} {
1796 return "'$str'"
1797 }
1798 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1799}
1800
1801proc shellarglist {l} {
1802 set str {}
1803 foreach a $l {
1804 if {$str ne {}} {
1805 append str " "
1806 }
1807 append str [shellquote $a]
1808 }
1809 return $str
1810}
1811
1812proc shelldequote {str} {
1813 set ret {}
1814 set used -1
1815 while {1} {
1816 incr used
1817 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1818 append ret [string range $str $used end]
1819 set used [string length $str]
1820 break
1821 }
1822 set first [lindex $first 0]
1823 set ch [string index $str $first]
1824 if {$first > $used} {
1825 append ret [string range $str $used [expr {$first - 1}]]
1826 set used $first
1827 }
1828 if {$ch eq " " || $ch eq "\t"} break
1829 incr used
1830 if {$ch eq "'"} {
1831 set first [string first "'" $str $used]
1832 if {$first < 0} {
1833 error "unmatched single-quote"
1834 }
1835 append ret [string range $str $used [expr {$first - 1}]]
1836 set used $first
1837 continue
1838 }
1839 if {$ch eq "\\"} {
1840 if {$used >= [string length $str]} {
1841 error "trailing backslash"
1842 }
1843 append ret [string index $str $used]
1844 continue
1845 }
1846 # here ch == "\""
1847 while {1} {
1848 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1849 error "unmatched double-quote"
1850 }
1851 set first [lindex $first 0]
1852 set ch [string index $str $first]
1853 if {$first > $used} {
1854 append ret [string range $str $used [expr {$first - 1}]]
1855 set used $first
1856 }
1857 if {$ch eq "\""} break
1858 incr used
1859 append ret [string index $str $used]
1860 incr used
1861 }
1862 }
1863 return [list $used $ret]
1864}
1865
1866proc shellsplit {str} {
1867 set l {}
1868 while {1} {
1869 set str [string trimleft $str]
1870 if {$str eq {}} break
1871 set dq [shelldequote $str]
1872 set n [lindex $dq 0]
1873 set word [lindex $dq 1]
1874 set str [string range $str $n end]
1875 lappend l $word
1876 }
1877 return $l
1878}
1879
7fcceed7
PM
1880# Code to implement multiple views
1881
da7c24dd 1882proc newview {ishighlight} {
b039f0a6 1883 global nextviewnum newviewname newviewperm newishighlight
2d480856 1884 global newviewargs revtreeargs viewargscmd newviewargscmd curview
50b44ece 1885
da7c24dd 1886 set newishighlight $ishighlight
50b44ece
PM
1887 set top .gitkview
1888 if {[winfo exists $top]} {
1889 raise $top
1890 return
1891 }
a3a1f579 1892 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
d16c0812 1893 set newviewperm($nextviewnum) 0
098dd8a3 1894 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2d480856 1895 set newviewargscmd($nextviewnum) $viewargscmd($curview)
d990cedf 1896 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
1897}
1898
1899proc editview {} {
1900 global curview
1901 global viewname viewperm newviewname newviewperm
2d480856 1902 global viewargs newviewargs viewargscmd newviewargscmd
d16c0812
PM
1903
1904 set top .gitkvedit-$curview
1905 if {[winfo exists $top]} {
1906 raise $top
1907 return
1908 }
1909 set newviewname($curview) $viewname($curview)
1910 set newviewperm($curview) $viewperm($curview)
098dd8a3 1911 set newviewargs($curview) [shellarglist $viewargs($curview)]
2d480856 1912 set newviewargscmd($curview) $viewargscmd($curview)
d16c0812
PM
1913 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1914}
1915
1916proc vieweditor {top n title} {
f0c84268 1917 global newviewname newviewperm viewfiles bgcolor
d16c0812 1918
50b44ece 1919 toplevel $top
d16c0812 1920 wm title $top $title
b039f0a6
PM
1921 label $top.nl -text [mc "Name"]
1922 entry $top.name -width 20 -textvariable newviewname($n)
a90a6d24 1923 grid $top.nl $top.name -sticky w -pady 5
b039f0a6
PM
1924 checkbutton $top.perm -text [mc "Remember this view"] \
1925 -variable newviewperm($n)
a90a6d24 1926 grid $top.perm - -pady 5 -sticky w
b039f0a6 1927 message $top.al -aspect 1000 \
d990cedf 1928 -text [mc "Commits to include (arguments to git rev-list):"]
098dd8a3
PM
1929 grid $top.al - -sticky w -pady 5
1930 entry $top.args -width 50 -textvariable newviewargs($n) \
f0c84268 1931 -background $bgcolor
098dd8a3 1932 grid $top.args - -sticky ew -padx 5
2d480856
YD
1933
1934 message $top.ac -aspect 1000 \
1935 -text [mc "Command to generate more commits to include:"]
1936 grid $top.ac - -sticky w -pady 5
1937 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
1938 -background white
1939 grid $top.argscmd - -sticky ew -padx 5
1940
b039f0a6 1941 message $top.l -aspect 1000 \
d990cedf 1942 -text [mc "Enter files and directories to include, one per line:"]
a90a6d24 1943 grid $top.l - -sticky w
f0c84268 1944 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
d16c0812
PM
1945 if {[info exists viewfiles($n)]} {
1946 foreach f $viewfiles($n) {
1947 $top.t insert end $f
1948 $top.t insert end "\n"
1949 }
1950 $top.t delete {end - 1c} end
1951 $top.t mark set insert 0.0
1952 }
098dd8a3 1953 grid $top.t - -sticky ew -padx 5
50b44ece 1954 frame $top.buts
b039f0a6
PM
1955 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
1956 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
50b44ece
PM
1957 grid $top.buts.ok $top.buts.can
1958 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1959 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1960 grid $top.buts - -pady 10 -sticky ew
1961 focus $top.t
1962}
1963
908c3585 1964proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
1965 set nmenu [$m index end]
1966 for {set i $first} {$i <= $nmenu} {incr i} {
1967 if {[$m entrycget $i -command] eq $cmd} {
908c3585 1968 eval $m $op $i $argv
da7c24dd 1969 break
d16c0812
PM
1970 }
1971 }
da7c24dd
PM
1972}
1973
1974proc allviewmenus {n op args} {
687c8765 1975 # global viewhlmenu
908c3585 1976
3cd204e5 1977 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 1978 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
1979}
1980
1981proc newviewok {top n} {
da7c24dd 1982 global nextviewnum newviewperm newviewname newishighlight
d16c0812 1983 global viewname viewfiles viewperm selectedview curview
2d480856 1984 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
50b44ece 1985
098dd8a3
PM
1986 if {[catch {
1987 set newargs [shellsplit $newviewargs($n)]
1988 } err]} {
d990cedf 1989 error_popup "[mc "Error in commit selection arguments:"] $err"
098dd8a3
PM
1990 wm raise $top
1991 focus $top
1992 return
1993 }
50b44ece 1994 set files {}
d16c0812 1995 foreach f [split [$top.t get 0.0 end] "\n"] {
50b44ece
PM
1996 set ft [string trim $f]
1997 if {$ft ne {}} {
1998 lappend files $ft
1999 }
2000 }
d16c0812
PM
2001 if {![info exists viewfiles($n)]} {
2002 # creating a new view
2003 incr nextviewnum
2004 set viewname($n) $newviewname($n)
2005 set viewperm($n) $newviewperm($n)
2006 set viewfiles($n) $files
098dd8a3 2007 set viewargs($n) $newargs
2d480856 2008 set viewargscmd($n) $newviewargscmd($n)
da7c24dd
PM
2009 addviewmenu $n
2010 if {!$newishighlight} {
7eb3cb9c 2011 run showview $n
da7c24dd 2012 } else {
7eb3cb9c 2013 run addvhighlight $n
da7c24dd 2014 }
d16c0812
PM
2015 } else {
2016 # editing an existing view
2017 set viewperm($n) $newviewperm($n)
2018 if {$newviewname($n) ne $viewname($n)} {
2019 set viewname($n) $newviewname($n)
3cd204e5 2020 doviewmenu .bar.view 5 [list showview $n] \
908c3585 2021 entryconf [list -label $viewname($n)]
687c8765
PM
2022 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2023 # entryconf [list -label $viewname($n) -value $viewname($n)]
d16c0812 2024 }
2d480856
YD
2025 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
2026 $newviewargscmd($n) ne $viewargscmd($n)} {
d16c0812 2027 set viewfiles($n) $files
098dd8a3 2028 set viewargs($n) $newargs
2d480856 2029 set viewargscmd($n) $newviewargscmd($n)
d16c0812 2030 if {$curview == $n} {
7eb3cb9c 2031 run updatecommits
d16c0812
PM
2032 }
2033 }
2034 }
2035 catch {destroy $top}
50b44ece
PM
2036}
2037
2038proc delview {} {
908c3585 2039 global curview viewdata viewperm hlview selectedhlview
50b44ece
PM
2040
2041 if {$curview == 0} return
908c3585 2042 if {[info exists hlview] && $hlview == $curview} {
b007ee20 2043 set selectedhlview [mc "None"]
908c3585
PM
2044 unset hlview
2045 }
da7c24dd 2046 allviewmenus $curview delete
50b44ece 2047 set viewdata($curview) {}
a90a6d24 2048 set viewperm($curview) 0
50b44ece
PM
2049 showview 0
2050}
2051
da7c24dd 2052proc addviewmenu {n} {
908c3585 2053 global viewname viewhlmenu
da7c24dd
PM
2054
2055 .bar.view add radiobutton -label $viewname($n) \
2056 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
2057 #$viewhlmenu add radiobutton -label $viewname($n) \
2058 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
2059}
2060
22626ef4
PM
2061proc flatten {var} {
2062 global $var
2063
2064 set ret {}
2065 foreach i [array names $var] {
2066 lappend ret $i [set $var\($i\)]
2067 }
2068 return $ret
2069}
2070
2071proc unflatten {var l} {
2072 global $var
2073
2074 catch {unset $var}
2075 foreach {i v} $l {
2076 set $var\($i\) $v
2077 }
2078}
2079
50b44ece
PM
2080proc showview {n} {
2081 global curview viewdata viewfiles
f5f3c2e2 2082 global displayorder parentlist rowidlist rowisopt rowfinal
da7c24dd 2083 global colormap rowtextx commitrow nextcolor canvxmax
8f0bc7e9 2084 global numcommits commitlisted
50b44ece 2085 global selectedline currentid canv canvy0
4fb0fa19 2086 global treediffs
d94f8cd6 2087 global pending_select phase
0380081c 2088 global commitidx
7eb3cb9c 2089 global commfd
e507fd48 2090 global selectedview selectfirst
6a90bff1 2091 global vparentlist vdisporder vcmitlisted
97645683 2092 global hlview selectedhlview commitinterest
50b44ece
PM
2093
2094 if {$n == $curview} return
2095 set selid {}
2096 if {[info exists selectedline]} {
2097 set selid $currentid
2098 set y [yc $selectedline]
2099 set ymax [lindex [$canv cget -scrollregion] 3]
2100 set span [$canv yview]
2101 set ytop [expr {[lindex $span 0] * $ymax}]
2102 set ybot [expr {[lindex $span 1] * $ymax}]
2103 if {$ytop < $y && $y < $ybot} {
2104 set yscreen [expr {$y - $ytop}]
2105 } else {
2106 set yscreen [expr {($ybot - $ytop) / 2}]
2107 }
e507fd48
PM
2108 } elseif {[info exists pending_select]} {
2109 set selid $pending_select
2110 unset pending_select
50b44ece
PM
2111 }
2112 unselectline
fdedbcfb 2113 normalline
22626ef4 2114 if {$curview >= 0} {
da7c24dd 2115 set vparentlist($curview) $parentlist
da7c24dd
PM
2116 set vdisporder($curview) $displayorder
2117 set vcmitlisted($curview) $commitlisted
f5f3c2e2
PM
2118 if {$phase ne {} ||
2119 ![info exists viewdata($curview)] ||
2120 [lindex $viewdata($curview) 0] ne {}} {
22626ef4 2121 set viewdata($curview) \
f5f3c2e2 2122 [list $phase $rowidlist $rowisopt $rowfinal]
22626ef4 2123 }
50b44ece 2124 }
50b44ece
PM
2125 catch {unset treediffs}
2126 clear_display
908c3585
PM
2127 if {[info exists hlview] && $hlview == $n} {
2128 unset hlview
b007ee20 2129 set selectedhlview [mc "None"]
908c3585 2130 }
97645683 2131 catch {unset commitinterest}
50b44ece
PM
2132
2133 set curview $n
a90a6d24 2134 set selectedview $n
d990cedf
CS
2135 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2136 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 2137
df904497 2138 run refill_reflist
50b44ece 2139 if {![info exists viewdata($n)]} {
e507fd48
PM
2140 if {$selid ne {}} {
2141 set pending_select $selid
2142 }
a8aaf19c 2143 getcommits
50b44ece
PM
2144 return
2145 }
2146
22626ef4
PM
2147 set v $viewdata($n)
2148 set phase [lindex $v 0]
da7c24dd
PM
2149 set displayorder $vdisporder($n)
2150 set parentlist $vparentlist($n)
da7c24dd
PM
2151 set commitlisted $vcmitlisted($n)
2152 set rowidlist [lindex $v 1]
0380081c 2153 set rowisopt [lindex $v 2]
f5f3c2e2
PM
2154 set rowfinal [lindex $v 3]
2155 set numcommits $commitidx($n)
22626ef4 2156
50b44ece
PM
2157 catch {unset colormap}
2158 catch {unset rowtextx}
da7c24dd
PM
2159 set nextcolor 0
2160 set canvxmax [$canv cget -width]
50b44ece
PM
2161 set curview $n
2162 set row 0
50b44ece
PM
2163 setcanvscroll
2164 set yf 0
e507fd48
PM
2165 set row {}
2166 set selectfirst 0
da7c24dd
PM
2167 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2168 set row $commitrow($n,$selid)
50b44ece
PM
2169 # try to get the selected row in the same position on the screen
2170 set ymax [lindex [$canv cget -scrollregion] 3]
2171 set ytop [expr {[yc $row] - $yscreen}]
2172 if {$ytop < 0} {
2173 set ytop 0
2174 }
2175 set yf [expr {$ytop * 1.0 / $ymax}]
2176 }
2177 allcanvs yview moveto $yf
2178 drawvisible
e507fd48
PM
2179 if {$row ne {}} {
2180 selectline $row 0
2181 } elseif {$selid ne {}} {
2182 set pending_select $selid
2183 } else {
8f489363 2184 set row [first_real_row]
219ea3a9
PM
2185 if {$row < $numcommits} {
2186 selectline $row 0
e507fd48
PM
2187 } else {
2188 set selectfirst 1
2189 }
2190 }
da7c24dd 2191 if {$phase ne {}} {
d16c0812 2192 if {$phase eq "getcommits"} {
d990cedf 2193 show_status [mc "Reading commits..."]
d16c0812 2194 }
7eb3cb9c 2195 run chewcommits $n
098dd8a3 2196 } elseif {$numcommits == 0} {
d990cedf 2197 show_status [mc "No commits selected"]
2516dae2 2198 }
50b44ece
PM
2199}
2200
908c3585
PM
2201# Stuff relating to the highlighting facility
2202
2203proc ishighlighted {row} {
164ff275 2204 global vhighlights fhighlights nhighlights rhighlights
908c3585
PM
2205
2206 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2207 return $nhighlights($row)
2208 }
2209 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2210 return $vhighlights($row)
2211 }
2212 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2213 return $fhighlights($row)
2214 }
164ff275
PM
2215 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2216 return $rhighlights($row)
2217 }
908c3585
PM
2218 return 0
2219}
2220
2221proc bolden {row font} {
4e7d6779 2222 global canv linehtag selectedline boldrows
908c3585 2223
4e7d6779 2224 lappend boldrows $row
908c3585 2225 $canv itemconf $linehtag($row) -font $font
5864c08f 2226 if {[info exists selectedline] && $row == $selectedline} {
908c3585
PM
2227 $canv delete secsel
2228 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2229 -outline {{}} -tags secsel \
2230 -fill [$canv cget -selectbackground]]
2231 $canv lower $t
2232 }
2233}
2234
2235proc bolden_name {row font} {
4e7d6779 2236 global canv2 linentag selectedline boldnamerows
908c3585 2237
4e7d6779 2238 lappend boldnamerows $row
908c3585 2239 $canv2 itemconf $linentag($row) -font $font
5864c08f 2240 if {[info exists selectedline] && $row == $selectedline} {
908c3585
PM
2241 $canv2 delete secsel
2242 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2243 -outline {{}} -tags secsel \
2244 -fill [$canv2 cget -selectbackground]]
2245 $canv2 lower $t
2246 }
2247}
2248
4e7d6779 2249proc unbolden {} {
9c311b32 2250 global boldrows
908c3585 2251
4e7d6779
PM
2252 set stillbold {}
2253 foreach row $boldrows {
908c3585 2254 if {![ishighlighted $row]} {
9c311b32 2255 bolden $row mainfont
4e7d6779
PM
2256 } else {
2257 lappend stillbold $row
908c3585
PM
2258 }
2259 }
4e7d6779 2260 set boldrows $stillbold
908c3585
PM
2261}
2262
2263proc addvhighlight {n} {
2264 global hlview curview viewdata vhl_done vhighlights commitidx
da7c24dd
PM
2265
2266 if {[info exists hlview]} {
908c3585 2267 delvhighlight
da7c24dd
PM
2268 }
2269 set hlview $n
da7c24dd 2270 if {$n != $curview && ![info exists viewdata($n)]} {
b0cdca99 2271 set viewdata($n) [list getcommits {{}} 0 0 0]
da7c24dd 2272 set vparentlist($n) {}
da7c24dd
PM
2273 set vdisporder($n) {}
2274 set vcmitlisted($n) {}
2275 start_rev_list $n
908c3585
PM
2276 }
2277 set vhl_done $commitidx($hlview)
2278 if {$vhl_done > 0} {
2279 drawvisible
da7c24dd
PM
2280 }
2281}
2282
908c3585
PM
2283proc delvhighlight {} {
2284 global hlview vhighlights
da7c24dd
PM
2285
2286 if {![info exists hlview]} return
2287 unset hlview
4e7d6779
PM
2288 catch {unset vhighlights}
2289 unbolden
da7c24dd
PM
2290}
2291
908c3585
PM
2292proc vhighlightmore {} {
2293 global hlview vhl_done commitidx vhighlights
9c311b32 2294 global displayorder vdisporder curview
da7c24dd 2295
da7c24dd
PM
2296 set max $commitidx($hlview)
2297 if {$hlview == $curview} {
2298 set disp $displayorder
2299 } else {
2300 set disp $vdisporder($hlview)
2301 }
908c3585
PM
2302 set vr [visiblerows]
2303 set r0 [lindex $vr 0]
2304 set r1 [lindex $vr 1]
2305 for {set i $vhl_done} {$i < $max} {incr i} {
da7c24dd
PM
2306 set id [lindex $disp $i]
2307 if {[info exists commitrow($curview,$id)]} {
2308 set row $commitrow($curview,$id)
908c3585
PM
2309 if {$r0 <= $row && $row <= $r1} {
2310 if {![highlighted $row]} {
9c311b32 2311 bolden $row mainfontbold
da7c24dd 2312 }
908c3585 2313 set vhighlights($row) 1
da7c24dd
PM
2314 }
2315 }
2316 }
908c3585
PM
2317 set vhl_done $max
2318}
2319
2320proc askvhighlight {row id} {
9c311b32 2321 global hlview vhighlights commitrow iddrawn
908c3585
PM
2322
2323 if {[info exists commitrow($hlview,$id)]} {
2324 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
9c311b32 2325 bolden $row mainfontbold
908c3585
PM
2326 }
2327 set vhighlights($row) 1
2328 } else {
2329 set vhighlights($row) 0
2330 }
2331}
2332
687c8765 2333proc hfiles_change {} {
908c3585 2334 global highlight_files filehighlight fhighlights fh_serial
9c311b32 2335 global highlight_paths gdttype
908c3585
PM
2336
2337 if {[info exists filehighlight]} {
2338 # delete previous highlights
2339 catch {close $filehighlight}
2340 unset filehighlight
4e7d6779
PM
2341 catch {unset fhighlights}
2342 unbolden
63b79191 2343 unhighlight_filelist
908c3585 2344 }
63b79191 2345 set highlight_paths {}
908c3585
PM
2346 after cancel do_file_hl $fh_serial
2347 incr fh_serial
2348 if {$highlight_files ne {}} {
2349 after 300 do_file_hl $fh_serial
2350 }
2351}
2352
687c8765
PM
2353proc gdttype_change {name ix op} {
2354 global gdttype highlight_files findstring findpattern
2355
bb3edc8b 2356 stopfinding
687c8765 2357 if {$findstring ne {}} {
b007ee20 2358 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
2359 if {$highlight_files ne {}} {
2360 set highlight_files {}
2361 hfiles_change
2362 }
2363 findcom_change
2364 } else {
2365 if {$findpattern ne {}} {
2366 set findpattern {}
2367 findcom_change
2368 }
2369 set highlight_files $findstring
2370 hfiles_change
2371 }
2372 drawvisible
2373 }
2374 # enable/disable findtype/findloc menus too
2375}
2376
2377proc find_change {name ix op} {
2378 global gdttype findstring highlight_files
2379
bb3edc8b 2380 stopfinding
b007ee20 2381 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
2382 findcom_change
2383 } else {
2384 if {$highlight_files ne $findstring} {
2385 set highlight_files $findstring
2386 hfiles_change
2387 }
2388 }
2389 drawvisible
2390}
2391
64b5f146 2392proc findcom_change args {
9c311b32 2393 global nhighlights boldnamerows
687c8765
PM
2394 global findpattern findtype findstring gdttype
2395
bb3edc8b 2396 stopfinding
687c8765
PM
2397 # delete previous highlights, if any
2398 foreach row $boldnamerows {
9c311b32 2399 bolden_name $row mainfont
687c8765
PM
2400 }
2401 set boldnamerows {}
2402 catch {unset nhighlights}
2403 unbolden
2404 unmarkmatches
b007ee20 2405 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
687c8765 2406 set findpattern {}
b007ee20 2407 } elseif {$findtype eq [mc "Regexp"]} {
687c8765
PM
2408 set findpattern $findstring
2409 } else {
2410 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2411 $findstring]
2412 set findpattern "*$e*"
2413 }
2414}
2415
63b79191
PM
2416proc makepatterns {l} {
2417 set ret {}
2418 foreach e $l {
2419 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2420 if {[string index $ee end] eq "/"} {
2421 lappend ret "$ee*"
2422 } else {
2423 lappend ret $ee
2424 lappend ret "$ee/*"
2425 }
2426 }
2427 return $ret
2428}
2429
908c3585 2430proc do_file_hl {serial} {
4e7d6779 2431 global highlight_files filehighlight highlight_paths gdttype fhl_list
908c3585 2432
b007ee20 2433 if {$gdttype eq [mc "touching paths:"]} {
60f7a7dc
PM
2434 if {[catch {set paths [shellsplit $highlight_files]}]} return
2435 set highlight_paths [makepatterns $paths]
2436 highlight_filelist
2437 set gdtargs [concat -- $paths]
b007ee20 2438 } elseif {$gdttype eq [mc "adding/removing string:"]} {
60f7a7dc 2439 set gdtargs [list "-S$highlight_files"]
687c8765
PM
2440 } else {
2441 # must be "containing:", i.e. we're searching commit info
2442 return
60f7a7dc 2443 }
1ce09dd6 2444 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
2445 set filehighlight [open $cmd r+]
2446 fconfigure $filehighlight -blocking 0
7eb3cb9c 2447 filerun $filehighlight readfhighlight
4e7d6779 2448 set fhl_list {}
908c3585
PM
2449 drawvisible
2450 flushhighlights
2451}
2452
2453proc flushhighlights {} {
4e7d6779 2454 global filehighlight fhl_list
908c3585
PM
2455
2456 if {[info exists filehighlight]} {
4e7d6779 2457 lappend fhl_list {}
908c3585
PM
2458 puts $filehighlight ""
2459 flush $filehighlight
2460 }
2461}
2462
2463proc askfilehighlight {row id} {
4e7d6779 2464 global filehighlight fhighlights fhl_list
908c3585 2465
4e7d6779
PM
2466 lappend fhl_list $id
2467 set fhighlights($row) -1
908c3585
PM
2468 puts $filehighlight $id
2469}
2470
2471proc readfhighlight {} {
9c311b32 2472 global filehighlight fhighlights commitrow curview iddrawn
687c8765 2473 global fhl_list find_dirn
4e7d6779 2474
7eb3cb9c
PM
2475 if {![info exists filehighlight]} {
2476 return 0
2477 }
2478 set nr 0
2479 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4e7d6779
PM
2480 set line [string trim $line]
2481 set i [lsearch -exact $fhl_list $line]
2482 if {$i < 0} continue
2483 for {set j 0} {$j < $i} {incr j} {
2484 set id [lindex $fhl_list $j]
2485 if {[info exists commitrow($curview,$id)]} {
2486 set fhighlights($commitrow($curview,$id)) 0
2487 }
908c3585 2488 }
4e7d6779
PM
2489 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2490 if {$line eq {}} continue
2491 if {![info exists commitrow($curview,$line)]} continue
2492 set row $commitrow($curview,$line)
2493 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
9c311b32 2494 bolden $row mainfontbold
4e7d6779
PM
2495 }
2496 set fhighlights($row) 1
908c3585 2497 }
4e7d6779
PM
2498 if {[eof $filehighlight]} {
2499 # strange...
1ce09dd6 2500 puts "oops, git diff-tree died"
4e7d6779
PM
2501 catch {close $filehighlight}
2502 unset filehighlight
7eb3cb9c 2503 return 0
908c3585 2504 }
687c8765 2505 if {[info exists find_dirn]} {
cca5d946 2506 run findmore
908c3585 2507 }
687c8765 2508 return 1
908c3585
PM
2509}
2510
4fb0fa19 2511proc doesmatch {f} {
687c8765 2512 global findtype findpattern
4fb0fa19 2513
b007ee20 2514 if {$findtype eq [mc "Regexp"]} {
687c8765 2515 return [regexp $findpattern $f]
b007ee20 2516 } elseif {$findtype eq [mc "IgnCase"]} {
4fb0fa19
PM
2517 return [string match -nocase $findpattern $f]
2518 } else {
2519 return [string match $findpattern $f]
2520 }
2521}
2522
60f7a7dc 2523proc askfindhighlight {row id} {
9c311b32 2524 global nhighlights commitinfo iddrawn
4fb0fa19
PM
2525 global findloc
2526 global markingmatches
908c3585
PM
2527
2528 if {![info exists commitinfo($id)]} {
2529 getcommit $id
2530 }
60f7a7dc 2531 set info $commitinfo($id)
908c3585 2532 set isbold 0
b007ee20 2533 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
60f7a7dc 2534 foreach f $info ty $fldtypes {
b007ee20 2535 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4fb0fa19 2536 [doesmatch $f]} {
b007ee20 2537 if {$ty eq [mc "Author"]} {
60f7a7dc 2538 set isbold 2
4fb0fa19 2539 break
60f7a7dc 2540 }
4fb0fa19 2541 set isbold 1
908c3585
PM
2542 }
2543 }
4fb0fa19 2544 if {$isbold && [info exists iddrawn($id)]} {
4fb0fa19 2545 if {![ishighlighted $row]} {
9c311b32 2546 bolden $row mainfontbold
4fb0fa19 2547 if {$isbold > 1} {
9c311b32 2548 bolden_name $row mainfontbold
4fb0fa19 2549 }
908c3585 2550 }
4fb0fa19 2551 if {$markingmatches} {
005a2f4e 2552 markrowmatches $row $id
908c3585
PM
2553 }
2554 }
2555 set nhighlights($row) $isbold
da7c24dd
PM
2556}
2557
005a2f4e
PM
2558proc markrowmatches {row id} {
2559 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 2560
005a2f4e
PM
2561 set headline [lindex $commitinfo($id) 0]
2562 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
2563 $canv delete match$row
2564 $canv2 delete match$row
b007ee20 2565 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
005a2f4e
PM
2566 set m [findmatches $headline]
2567 if {$m ne {}} {
2568 markmatches $canv $row $headline $linehtag($row) $m \
2569 [$canv itemcget $linehtag($row) -font] $row
2570 }
4fb0fa19 2571 }
b007ee20 2572 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
005a2f4e
PM
2573 set m [findmatches $author]
2574 if {$m ne {}} {
2575 markmatches $canv2 $row $author $linentag($row) $m \
2576 [$canv2 itemcget $linentag($row) -font] $row
2577 }
4fb0fa19
PM
2578 }
2579}
2580
164ff275
PM
2581proc vrel_change {name ix op} {
2582 global highlight_related
2583
2584 rhighlight_none
b007ee20 2585 if {$highlight_related ne [mc "None"]} {
7eb3cb9c 2586 run drawvisible
164ff275
PM
2587 }
2588}
2589
2590# prepare for testing whether commits are descendents or ancestors of a
2591proc rhighlight_sel {a} {
2592 global descendent desc_todo ancestor anc_todo
2593 global highlight_related rhighlights
2594
2595 catch {unset descendent}
2596 set desc_todo [list $a]
2597 catch {unset ancestor}
2598 set anc_todo [list $a]
b007ee20 2599 if {$highlight_related ne [mc "None"]} {
164ff275 2600 rhighlight_none
7eb3cb9c 2601 run drawvisible
164ff275
PM
2602 }
2603}
2604
2605proc rhighlight_none {} {
2606 global rhighlights
2607
4e7d6779
PM
2608 catch {unset rhighlights}
2609 unbolden
164ff275
PM
2610}
2611
2612proc is_descendent {a} {
2613 global curview children commitrow descendent desc_todo
2614
2615 set v $curview
2616 set la $commitrow($v,$a)
2617 set todo $desc_todo
2618 set leftover {}
2619 set done 0
2620 for {set i 0} {$i < [llength $todo]} {incr i} {
2621 set do [lindex $todo $i]
2622 if {$commitrow($v,$do) < $la} {
2623 lappend leftover $do
2624 continue
2625 }
2626 foreach nk $children($v,$do) {
2627 if {![info exists descendent($nk)]} {
2628 set descendent($nk) 1
2629 lappend todo $nk
2630 if {$nk eq $a} {
2631 set done 1
2632 }
2633 }
2634 }
2635 if {$done} {
2636 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2637 return
2638 }
2639 }
2640 set descendent($a) 0
2641 set desc_todo $leftover
2642}
2643
2644proc is_ancestor {a} {
2645 global curview parentlist commitrow ancestor anc_todo
2646
2647 set v $curview
2648 set la $commitrow($v,$a)
2649 set todo $anc_todo
2650 set leftover {}
2651 set done 0
2652 for {set i 0} {$i < [llength $todo]} {incr i} {
2653 set do [lindex $todo $i]
2654 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2655 lappend leftover $do
2656 continue
2657 }
2658 foreach np [lindex $parentlist $commitrow($v,$do)] {
2659 if {![info exists ancestor($np)]} {
2660 set ancestor($np) 1
2661 lappend todo $np
2662 if {$np eq $a} {
2663 set done 1
2664 }
2665 }
2666 }
2667 if {$done} {
2668 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2669 return
2670 }
2671 }
2672 set ancestor($a) 0
2673 set anc_todo $leftover
2674}
2675
2676proc askrelhighlight {row id} {
9c311b32 2677 global descendent highlight_related iddrawn rhighlights
164ff275
PM
2678 global selectedline ancestor
2679
2680 if {![info exists selectedline]} return
2681 set isbold 0
55e34436
CS
2682 if {$highlight_related eq [mc "Descendant"] ||
2683 $highlight_related eq [mc "Not descendant"]} {
164ff275
PM
2684 if {![info exists descendent($id)]} {
2685 is_descendent $id
2686 }
55e34436 2687 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
164ff275
PM
2688 set isbold 1
2689 }
b007ee20
CS
2690 } elseif {$highlight_related eq [mc "Ancestor"] ||
2691 $highlight_related eq [mc "Not ancestor"]} {
164ff275
PM
2692 if {![info exists ancestor($id)]} {
2693 is_ancestor $id
2694 }
b007ee20 2695 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
164ff275
PM
2696 set isbold 1
2697 }
2698 }
2699 if {[info exists iddrawn($id)]} {
2700 if {$isbold && ![ishighlighted $row]} {
9c311b32 2701 bolden $row mainfontbold
164ff275
PM
2702 }
2703 }
2704 set rhighlights($row) $isbold
2705}
2706
da7c24dd
PM
2707# Graph layout functions
2708
9f1afe05
PM
2709proc shortids {ids} {
2710 set res {}
2711 foreach id $ids {
2712 if {[llength $id] > 1} {
2713 lappend res [shortids $id]
2714 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2715 lappend res [string range $id 0 7]
2716 } else {
2717 lappend res $id
2718 }
2719 }
2720 return $res
2721}
2722
9f1afe05
PM
2723proc ntimes {n o} {
2724 set ret {}
0380081c
PM
2725 set o [list $o]
2726 for {set mask 1} {$mask <= $n} {incr mask $mask} {
2727 if {($n & $mask) != 0} {
2728 set ret [concat $ret $o]
9f1afe05 2729 }
0380081c 2730 set o [concat $o $o]
9f1afe05 2731 }
0380081c 2732 return $ret
9f1afe05
PM
2733}
2734
6e8c8707
PM
2735# Work out where id should go in idlist so that order-token
2736# values increase from left to right
2737proc idcol {idlist id {i 0}} {
2738 global ordertok curview
9f1afe05 2739
6e8c8707
PM
2740 set t $ordertok($curview,$id)
2741 if {$i >= [llength $idlist] ||
2742 $t < $ordertok($curview,[lindex $idlist $i])} {
2743 if {$i > [llength $idlist]} {
2744 set i [llength $idlist]
9f1afe05 2745 }
6e8c8707
PM
2746 while {[incr i -1] >= 0 &&
2747 $t < $ordertok($curview,[lindex $idlist $i])} {}
2748 incr i
2749 } else {
2750 if {$t > $ordertok($curview,[lindex $idlist $i])} {
2751 while {[incr i] < [llength $idlist] &&
2752 $t >= $ordertok($curview,[lindex $idlist $i])} {}
9f1afe05 2753 }
9f1afe05 2754 }
6e8c8707 2755 return $i
9f1afe05
PM
2756}
2757
2758proc initlayout {} {
f5f3c2e2 2759 global rowidlist rowisopt rowfinal displayorder commitlisted
da7c24dd 2760 global numcommits canvxmax canv
8f7d0cec 2761 global nextcolor
6a90bff1 2762 global parentlist
da7c24dd 2763 global colormap rowtextx
322a8cc9 2764 global selectfirst
9f1afe05 2765
8f7d0cec
PM
2766 set numcommits 0
2767 set displayorder {}
79b2c75e
PM
2768 set commitlisted {}
2769 set parentlist {}
8f7d0cec 2770 set nextcolor 0
0380081c
PM
2771 set rowidlist {}
2772 set rowisopt {}
f5f3c2e2 2773 set rowfinal {}
be0cd098 2774 set canvxmax [$canv cget -width]
50b44ece
PM
2775 catch {unset colormap}
2776 catch {unset rowtextx}
e507fd48 2777 set selectfirst 1
be0cd098
PM
2778}
2779
2780proc setcanvscroll {} {
2781 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2782
2783 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2784 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2785 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2786 $canv3 conf -scrollregion [list 0 0 0 $ymax]
9f1afe05
PM
2787}
2788
2789proc visiblerows {} {
2790 global canv numcommits linespc
2791
2792 set ymax [lindex [$canv cget -scrollregion] 3]
2793 if {$ymax eq {} || $ymax == 0} return
2794 set f [$canv yview]
2795 set y0 [expr {int([lindex $f 0] * $ymax)}]
2796 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2797 if {$r0 < 0} {
2798 set r0 0
2799 }
2800 set y1 [expr {int([lindex $f 1] * $ymax)}]
2801 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2802 if {$r1 >= $numcommits} {
2803 set r1 [expr {$numcommits - 1}]
2804 }
2805 return [list $r0 $r1]
2806}
2807
f5f3c2e2
PM
2808proc layoutmore {} {
2809 global commitidx viewcomplete numcommits
0380081c 2810 global uparrowlen downarrowlen mingaplen curview
9f1afe05 2811
0380081c 2812 set show $commitidx($curview)
308ff3d5 2813 if {$show > $numcommits || $viewcomplete($curview)} {
f5f3c2e2 2814 showstuff $show $viewcomplete($curview)
9f1afe05
PM
2815 }
2816}
2817
219ea3a9 2818proc showstuff {canshow last} {
322a8cc9 2819 global numcommits commitrow pending_select selectedline curview
3e6b893f 2820 global mainheadid displayorder selectfirst
887c996e 2821 global lastscrollset commitinterest
9f1afe05 2822
8f7d0cec
PM
2823 if {$numcommits == 0} {
2824 global phase
2825 set phase "incrdraw"
2826 allcanvs delete all
2827 }
322a8cc9 2828 set r0 $numcommits
a2c22362 2829 set prev $numcommits
9f1afe05 2830 set numcommits $canshow
a2c22362
PM
2831 set t [clock clicks -milliseconds]
2832 if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2833 set lastscrollset $t
2834 setcanvscroll
2835 }
9f1afe05 2836 set rows [visiblerows]
9f1afe05 2837 set r1 [lindex $rows 1]
322a8cc9
PM
2838 if {$r1 >= $canshow} {
2839 set r1 [expr {$canshow - 1}]
9f1afe05 2840 }
322a8cc9
PM
2841 if {$r0 <= $r1} {
2842 drawcommits $r0 $r1
9f1afe05 2843 }
d94f8cd6 2844 if {[info exists pending_select] &&
da7c24dd
PM
2845 [info exists commitrow($curview,$pending_select)] &&
2846 $commitrow($curview,$pending_select) < $numcommits} {
2847 selectline $commitrow($curview,$pending_select) 1
d94f8cd6 2848 }
e507fd48
PM
2849 if {$selectfirst} {
2850 if {[info exists selectedline] || [info exists pending_select]} {
2851 set selectfirst 0
2852 } else {
8f489363 2853 set l [first_real_row]
219ea3a9 2854 selectline $l 1
e507fd48
PM
2855 set selectfirst 0
2856 }
fdedbcfb 2857 }
219ea3a9
PM
2858}
2859
2860proc doshowlocalchanges {} {
3e6b893f 2861 global curview mainheadid phase commitrow
219ea3a9
PM
2862
2863 if {[info exists commitrow($curview,$mainheadid)] &&
2864 ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2865 dodiffindex
2866 } elseif {$phase ne {}} {
3e6b893f 2867 lappend commitinterest($mainheadid) {}
219ea3a9
PM
2868 }
2869}
2870
2871proc dohidelocalchanges {} {
3e6b893f 2872 global localfrow localirow lserial
219ea3a9 2873
8f489363
PM
2874 if {$localfrow >= 0} {
2875 removerow $localfrow
2876 set localfrow -1
2877 if {$localirow > 0} {
2878 incr localirow -1
2879 }
2880 }
2881 if {$localirow >= 0} {
2882 removerow $localirow
2883 set localirow -1
219ea3a9
PM
2884 }
2885 incr lserial
2886}
2887
8f489363 2888# spawn off a process to do git diff-index --cached HEAD
219ea3a9 2889proc dodiffindex {} {
3e6b893f 2890 global localirow localfrow lserial showlocalchanges
cb8329aa 2891 global isworktree
219ea3a9 2892
cb8329aa 2893 if {!$showlocalchanges || !$isworktree} return
219ea3a9 2894 incr lserial
8f489363
PM
2895 set localfrow -1
2896 set localirow -1
2897 set fd [open "|git diff-index --cached HEAD" r]
219ea3a9
PM
2898 fconfigure $fd -blocking 0
2899 filerun $fd [list readdiffindex $fd $lserial]
2900}
2901
2902proc readdiffindex {fd serial} {
8f489363 2903 global localirow commitrow mainheadid nullid2 curview
219ea3a9
PM
2904 global commitinfo commitdata lserial
2905
8f489363 2906 set isdiff 1
219ea3a9 2907 if {[gets $fd line] < 0} {
8f489363
PM
2908 if {![eof $fd]} {
2909 return 1
219ea3a9 2910 }
8f489363 2911 set isdiff 0
219ea3a9
PM
2912 }
2913 # we only need to see one line and we don't really care what it says...
2914 close $fd
2915
8f489363
PM
2916 # now see if there are any local changes not checked in to the index
2917 if {$serial == $lserial} {
2918 set fd [open "|git diff-files" r]
2919 fconfigure $fd -blocking 0
2920 filerun $fd [list readdifffiles $fd $serial]
2921 }
2922
2923 if {$isdiff && $serial == $lserial && $localirow == -1} {
2924 # add the line for the changes in the index to the graph
2925 set localirow $commitrow($curview,$mainheadid)
d990cedf 2926 set hl [mc "Local changes checked in to index but not committed"]
8f489363
PM
2927 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2928 set commitdata($nullid2) "\n $hl\n"
2929 insertrow $localirow $nullid2
2930 }
2931 return 0
2932}
2933
2934proc readdifffiles {fd serial} {
2935 global localirow localfrow commitrow mainheadid nullid curview
2936 global commitinfo commitdata lserial
2937
2938 set isdiff 1
2939 if {[gets $fd line] < 0} {
2940 if {![eof $fd]} {
2941 return 1
2942 }
2943 set isdiff 0
2944 }
2945 # we only need to see one line and we don't really care what it says...
2946 close $fd
2947
2948 if {$isdiff && $serial == $lserial && $localfrow == -1} {
219ea3a9 2949 # add the line for the local diff to the graph
8f489363
PM
2950 if {$localirow >= 0} {
2951 set localfrow $localirow
2952 incr localirow
2953 } else {
2954 set localfrow $commitrow($curview,$mainheadid)
2955 }
d990cedf 2956 set hl [mc "Local uncommitted changes, not checked in to index"]
219ea3a9
PM
2957 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2958 set commitdata($nullid) "\n $hl\n"
8f489363 2959 insertrow $localfrow $nullid
219ea3a9
PM
2960 }
2961 return 0
9f1afe05
PM
2962}
2963
8f0bc7e9
PM
2964proc nextuse {id row} {
2965 global commitrow curview children
9f1afe05 2966
8f0bc7e9
PM
2967 if {[info exists children($curview,$id)]} {
2968 foreach kid $children($curview,$id) {
0380081c
PM
2969 if {![info exists commitrow($curview,$kid)]} {
2970 return -1
2971 }
2972 if {$commitrow($curview,$kid) > $row} {
8f0bc7e9 2973 return $commitrow($curview,$kid)
9f1afe05 2974 }
9f1afe05 2975 }
8f0bc7e9
PM
2976 }
2977 if {[info exists commitrow($curview,$id)]} {
2978 return $commitrow($curview,$id)
2979 }
2980 return -1
2981}
2982
f5f3c2e2
PM
2983proc prevuse {id row} {
2984 global commitrow curview children
2985
2986 set ret -1
2987 if {[info exists children($curview,$id)]} {
2988 foreach kid $children($curview,$id) {
2989 if {![info exists commitrow($curview,$kid)]} break
2990 if {$commitrow($curview,$kid) < $row} {
2991 set ret $commitrow($curview,$kid)
7b459a1c 2992 }
7b459a1c 2993 }
f5f3c2e2
PM
2994 }
2995 return $ret
2996}
2997
0380081c
PM
2998proc make_idlist {row} {
2999 global displayorder parentlist uparrowlen downarrowlen mingaplen
3000 global commitidx curview ordertok children commitrow
9f1afe05 3001
0380081c
PM
3002 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3003 if {$r < 0} {
3004 set r 0
8f0bc7e9 3005 }
0380081c
PM
3006 set ra [expr {$row - $downarrowlen}]
3007 if {$ra < 0} {
3008 set ra 0
3009 }
3010 set rb [expr {$row + $uparrowlen}]
3011 if {$rb > $commitidx($curview)} {
3012 set rb $commitidx($curview)
3013 }
3014 set ids {}
3015 for {} {$r < $ra} {incr r} {
3016 set nextid [lindex $displayorder [expr {$r + 1}]]
3017 foreach p [lindex $parentlist $r] {
3018 if {$p eq $nextid} continue
3019 set rn [nextuse $p $r]
3020 if {$rn >= $row &&
3021 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3022 lappend ids [list $ordertok($curview,$p) $p]
9f1afe05 3023 }
9f1afe05 3024 }
0380081c
PM
3025 }
3026 for {} {$r < $row} {incr r} {
3027 set nextid [lindex $displayorder [expr {$r + 1}]]
3028 foreach p [lindex $parentlist $r] {
3029 if {$p eq $nextid} continue
3030 set rn [nextuse $p $r]
3031 if {$rn < 0 || $rn >= $row} {
3032 lappend ids [list $ordertok($curview,$p) $p]
9f1afe05 3033 }
9f1afe05 3034 }
0380081c
PM
3035 }
3036 set id [lindex $displayorder $row]
3037 lappend ids [list $ordertok($curview,$id) $id]
3038 while {$r < $rb} {
3039 foreach p [lindex $parentlist $r] {
3040 set firstkid [lindex $children($curview,$p) 0]
3041 if {$commitrow($curview,$firstkid) < $row} {
3042 lappend ids [list $ordertok($curview,$p) $p]
9f1afe05 3043 }
9f1afe05 3044 }
0380081c
PM
3045 incr r
3046 set id [lindex $displayorder $r]
3047 if {$id ne {}} {
3048 set firstkid [lindex $children($curview,$id) 0]
3049 if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3050 lappend ids [list $ordertok($curview,$id) $id]
3051 }
9f1afe05 3052 }
9f1afe05 3053 }
0380081c
PM
3054 set idlist {}
3055 foreach idx [lsort -unique $ids] {
3056 lappend idlist [lindex $idx 1]
3057 }
3058 return $idlist
9f1afe05
PM
3059}
3060
f5f3c2e2
PM
3061proc rowsequal {a b} {
3062 while {[set i [lsearch -exact $a {}]] >= 0} {
3063 set a [lreplace $a $i $i]
3064 }
3065 while {[set i [lsearch -exact $b {}]] >= 0} {
3066 set b [lreplace $b $i $i]
3067 }
3068 return [expr {$a eq $b}]
9f1afe05
PM
3069}
3070
f5f3c2e2
PM
3071proc makeupline {id row rend col} {
3072 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 3073
f5f3c2e2
PM
3074 for {set r $rend} {1} {set r $rstart} {
3075 set rstart [prevuse $id $r]
3076 if {$rstart < 0} return
3077 if {$rstart < $row} break
3078 }
3079 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3080 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 3081 }
f5f3c2e2
PM
3082 for {set r $rstart} {[incr r] <= $row} {} {
3083 set idlist [lindex $rowidlist $r]
3084 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3085 set col [idcol $idlist $id $col]
3086 lset rowidlist $r [linsert $idlist $col $id]
3087 changedrow $r
3088 }
9f1afe05
PM
3089 }
3090}
3091
0380081c 3092proc layoutrows {row endrow} {
f5f3c2e2 3093 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
3094 global uparrowlen downarrowlen maxwidth mingaplen
3095 global children parentlist
f5f3c2e2 3096 global commitidx viewcomplete curview commitrow
9f1afe05 3097
0380081c
PM
3098 set idlist {}
3099 if {$row > 0} {
f56782ae
PM
3100 set rm1 [expr {$row - 1}]
3101 foreach id [lindex $rowidlist $rm1] {
0380081c
PM
3102 if {$id ne {}} {
3103 lappend idlist $id
3104 }
3105 }
f56782ae 3106 set final [lindex $rowfinal $rm1]
79b2c75e 3107 }
0380081c
PM
3108 for {} {$row < $endrow} {incr row} {
3109 set rm1 [expr {$row - 1}]
f56782ae 3110 if {$rm1 < 0 || $idlist eq {}} {
0380081c 3111 set idlist [make_idlist $row]
f5f3c2e2 3112 set final 1
0380081c
PM
3113 } else {
3114 set id [lindex $displayorder $rm1]
3115 set col [lsearch -exact $idlist $id]
3116 set idlist [lreplace $idlist $col $col]
3117 foreach p [lindex $parentlist $rm1] {
3118 if {[lsearch -exact $idlist $p] < 0} {
3119 set col [idcol $idlist $p $col]
3120 set idlist [linsert $idlist $col $p]
f5f3c2e2
PM
3121 # if not the first child, we have to insert a line going up
3122 if {$id ne [lindex $children($curview,$p) 0]} {
3123 makeupline $p $rm1 $row $col
3124 }
0380081c
PM
3125 }
3126 }
3127 set id [lindex $displayorder $row]
3128 if {$row > $downarrowlen} {
3129 set termrow [expr {$row - $downarrowlen - 1}]
3130 foreach p [lindex $parentlist $termrow] {
3131 set i [lsearch -exact $idlist $p]
3132 if {$i < 0} continue
3133 set nr [nextuse $p $termrow]
3134 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3135 set idlist [lreplace $idlist $i $i]
3136 }
3137 }
3138 }
3139 set col [lsearch -exact $idlist $id]
3140 if {$col < 0} {
3141 set col [idcol $idlist $id]
3142 set idlist [linsert $idlist $col $id]
f5f3c2e2
PM
3143 if {$children($curview,$id) ne {}} {
3144 makeupline $id $rm1 $row $col
3145 }
0380081c
PM
3146 }
3147 set r [expr {$row + $uparrowlen - 1}]
3148 if {$r < $commitidx($curview)} {
3149 set x $col
3150 foreach p [lindex $parentlist $r] {
3151 if {[lsearch -exact $idlist $p] >= 0} continue
3152 set fk [lindex $children($curview,$p) 0]
3153 if {$commitrow($curview,$fk) < $row} {
3154 set x [idcol $idlist $p $x]
3155 set idlist [linsert $idlist $x $p]
3156 }
3157 }
3158 if {[incr r] < $commitidx($curview)} {
3159 set p [lindex $displayorder $r]
3160 if {[lsearch -exact $idlist $p] < 0} {
3161 set fk [lindex $children($curview,$p) 0]
3162 if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3163 set x [idcol $idlist $p $x]
3164 set idlist [linsert $idlist $x $p]
3165 }
3166 }
3167 }
3168 }
3169 }
f5f3c2e2
PM
3170 if {$final && !$viewcomplete($curview) &&
3171 $row + $uparrowlen + $mingaplen + $downarrowlen
3172 >= $commitidx($curview)} {
3173 set final 0
3174 }
0380081c
PM
3175 set l [llength $rowidlist]
3176 if {$row == $l} {
3177 lappend rowidlist $idlist
3178 lappend rowisopt 0
f5f3c2e2 3179 lappend rowfinal $final
0380081c 3180 } elseif {$row < $l} {
f5f3c2e2 3181 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
0380081c
PM
3182 lset rowidlist $row $idlist
3183 changedrow $row
3184 }
f56782ae 3185 lset rowfinal $row $final
0380081c 3186 } else {
f5f3c2e2
PM
3187 set pad [ntimes [expr {$row - $l}] {}]
3188 set rowidlist [concat $rowidlist $pad]
0380081c 3189 lappend rowidlist $idlist
f5f3c2e2
PM
3190 set rowfinal [concat $rowfinal $pad]
3191 lappend rowfinal $final
0380081c
PM
3192 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3193 }
9f1afe05 3194 }
0380081c 3195 return $row
9f1afe05
PM
3196}
3197
0380081c
PM
3198proc changedrow {row} {
3199 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 3200
0380081c
PM
3201 set l [llength $rowisopt]
3202 if {$row < $l} {
3203 lset rowisopt $row 0
3204 if {$row + 1 < $l} {
3205 lset rowisopt [expr {$row + 1}] 0
3206 if {$row + 2 < $l} {
3207 lset rowisopt [expr {$row + 2}] 0
3208 }
3209 }
3210 }
3211 set id [lindex $displayorder $row]
3212 if {[info exists iddrawn($id)]} {
3213 set need_redisplay 1
9f1afe05
PM
3214 }
3215}
3216
3217proc insert_pad {row col npad} {
6e8c8707 3218 global rowidlist
9f1afe05
PM
3219
3220 set pad [ntimes $npad {}]
e341c06d
PM
3221 set idlist [lindex $rowidlist $row]
3222 set bef [lrange $idlist 0 [expr {$col - 1}]]
3223 set aft [lrange $idlist $col end]
3224 set i [lsearch -exact $aft {}]
3225 if {$i > 0} {
3226 set aft [lreplace $aft $i $i]
3227 }
3228 lset rowidlist $row [concat $bef $pad $aft]
0380081c 3229 changedrow $row
9f1afe05
PM
3230}
3231
3232proc optimize_rows {row col endrow} {
0380081c 3233 global rowidlist rowisopt displayorder curview children
9f1afe05 3234
6e8c8707
PM
3235 if {$row < 1} {
3236 set row 1
3237 }
0380081c
PM
3238 for {} {$row < $endrow} {incr row; set col 0} {
3239 if {[lindex $rowisopt $row]} continue
9f1afe05 3240 set haspad 0
6e8c8707
PM
3241 set y0 [expr {$row - 1}]
3242 set ym [expr {$row - 2}]
0380081c
PM
3243 set idlist [lindex $rowidlist $row]
3244 set previdlist [lindex $rowidlist $y0]
3245 if {$idlist eq {} || $previdlist eq {}} continue
3246 if {$ym >= 0} {
3247 set pprevidlist [lindex $rowidlist $ym]
3248 if {$pprevidlist eq {}} continue
3249 } else {
3250 set pprevidlist {}
3251 }
6e8c8707
PM
3252 set x0 -1
3253 set xm -1
3254 for {} {$col < [llength $idlist]} {incr col} {
3255 set id [lindex $idlist $col]
3256 if {[lindex $previdlist $col] eq $id} continue
3257 if {$id eq {}} {
9f1afe05
PM
3258 set haspad 1
3259 continue
3260 }
6e8c8707
PM
3261 set x0 [lsearch -exact $previdlist $id]
3262 if {$x0 < 0} continue
3263 set z [expr {$x0 - $col}]
9f1afe05 3264 set isarrow 0
6e8c8707
PM
3265 set z0 {}
3266 if {$ym >= 0} {
3267 set xm [lsearch -exact $pprevidlist $id]
3268 if {$xm >= 0} {
3269 set z0 [expr {$xm - $x0}]
3270 }
3271 }
9f1afe05 3272 if {$z0 eq {}} {
92ed666f
PM
3273 # if row y0 is the first child of $id then it's not an arrow
3274 if {[lindex $children($curview,$id) 0] ne
3275 [lindex $displayorder $y0]} {
9f1afe05
PM
3276 set isarrow 1
3277 }
3278 }
e341c06d
PM
3279 if {!$isarrow && $id ne [lindex $displayorder $row] &&
3280 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3281 set isarrow 1
3282 }
3fc4279a
PM
3283 # Looking at lines from this row to the previous row,
3284 # make them go straight up if they end in an arrow on
3285 # the previous row; otherwise make them go straight up
3286 # or at 45 degrees.
9f1afe05 3287 if {$z < -1 || ($z < 0 && $isarrow)} {
3fc4279a
PM
3288 # Line currently goes left too much;
3289 # insert pads in the previous row, then optimize it
9f1afe05 3290 set npad [expr {-1 - $z + $isarrow}]
9f1afe05
PM
3291 insert_pad $y0 $x0 $npad
3292 if {$y0 > 0} {
3293 optimize_rows $y0 $x0 $row
3294 }
6e8c8707
PM
3295 set previdlist [lindex $rowidlist $y0]
3296 set x0 [lsearch -exact $previdlist $id]
3297 set z [expr {$x0 - $col}]
3298 if {$z0 ne {}} {
3299 set pprevidlist [lindex $rowidlist $ym]
3300 set xm [lsearch -exact $pprevidlist $id]
3301 set z0 [expr {$xm - $x0}]
3302 }
9f1afe05 3303 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3fc4279a 3304 # Line currently goes right too much;
6e8c8707 3305 # insert pads in this line
9f1afe05 3306 set npad [expr {$z - 1 + $isarrow}]
e341c06d
PM
3307 insert_pad $row $col $npad
3308 set idlist [lindex $rowidlist $row]
9f1afe05 3309 incr col $npad
6e8c8707 3310 set z [expr {$x0 - $col}]
9f1afe05
PM
3311 set haspad 1
3312 }
6e8c8707 3313 if {$z0 eq {} && !$isarrow && $ym >= 0} {
eb447a12 3314 # this line links to its first child on row $row-2
6e8c8707
PM
3315 set id [lindex $displayorder $ym]
3316 set xc [lsearch -exact $pprevidlist $id]
eb447a12
PM
3317 if {$xc >= 0} {
3318 set z0 [expr {$xc - $x0}]
3319 }
3320 }
3fc4279a 3321 # avoid lines jigging left then immediately right
9f1afe05
PM
3322 if {$z0 ne {} && $z < 0 && $z0 > 0} {
3323 insert_pad $y0 $x0 1
6e8c8707
PM
3324 incr x0
3325 optimize_rows $y0 $x0 $row
3326 set previdlist [lindex $rowidlist $y0]
9f1afe05
PM
3327 }
3328 }
3329 if {!$haspad} {
3fc4279a 3330 # Find the first column that doesn't have a line going right
9f1afe05 3331 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
6e8c8707
PM
3332 set id [lindex $idlist $col]
3333 if {$id eq {}} break
3334 set x0 [lsearch -exact $previdlist $id]
3335 if {$x0 < 0} {
eb447a12 3336 # check if this is the link to the first child
92ed666f
PM
3337 set kid [lindex $displayorder $y0]
3338 if {[lindex $children($curview,$id) 0] eq $kid} {
eb447a12 3339 # it is, work out offset to child
92ed666f 3340 set x0 [lsearch -exact $previdlist $kid]
eb447a12
PM
3341 }
3342 }
6e8c8707 3343 if {$x0 <= $col} break
9f1afe05 3344 }
3fc4279a 3345 # Insert a pad at that column as long as it has a line and
6e8c8707
PM
3346 # isn't the last column
3347 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
9f1afe05 3348 set idlist [linsert $idlist $col {}]
0380081c
PM
3349 lset rowidlist $row $idlist
3350 changedrow $row
9f1afe05
PM
3351 }
3352 }
9f1afe05
PM
3353 }
3354}
3355
3356proc xc {row col} {
3357 global canvx0 linespc
3358 return [expr {$canvx0 + $col * $linespc}]
3359}
3360
3361proc yc {row} {
3362 global canvy0 linespc
3363 return [expr {$canvy0 + $row * $linespc}]
3364}
3365
c934a8a3
PM
3366proc linewidth {id} {
3367 global thickerline lthickness
3368
3369 set wid $lthickness
3370 if {[info exists thickerline] && $id eq $thickerline} {
3371 set wid [expr {2 * $lthickness}]
3372 }
3373 return $wid
3374}
3375
50b44ece 3376proc rowranges {id} {
92ed666f
PM
3377 global commitrow curview children uparrowlen downarrowlen
3378 global rowidlist
50b44ece 3379
92ed666f
PM
3380 set kids $children($curview,$id)
3381 if {$kids eq {}} {
3382 return {}
66e46f37 3383 }
92ed666f
PM
3384 set ret {}
3385 lappend kids $id
3386 foreach child $kids {
3387 if {![info exists commitrow($curview,$child)]} break
3388 set row $commitrow($curview,$child)
3389 if {![info exists prev]} {
3390 lappend ret [expr {$row + 1}]
322a8cc9 3391 } else {
92ed666f
PM
3392 if {$row <= $prevrow} {
3393 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3394 }
3395 # see if the line extends the whole way from prevrow to row
3396 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3397 [lsearch -exact [lindex $rowidlist \
3398 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3399 # it doesn't, see where it ends
3400 set r [expr {$prevrow + $downarrowlen}]
3401 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3402 while {[incr r -1] > $prevrow &&
3403 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3404 } else {
3405 while {[incr r] <= $row &&
3406 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3407 incr r -1
3408 }
3409 lappend ret $r
3410 # see where it starts up again
3411 set r [expr {$row - $uparrowlen}]
3412 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3413 while {[incr r] < $row &&
3414 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3415 } else {
3416 while {[incr r -1] >= $prevrow &&
3417 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3418 incr r
3419 }
3420 lappend ret $r
3421 }
3422 }
3423 if {$child eq $id} {
3424 lappend ret $row
322a8cc9 3425 }
92ed666f
PM
3426 set prev $id
3427 set prevrow $row
9f1afe05 3428 }
92ed666f 3429 return $ret
322a8cc9
PM
3430}
3431
3432proc drawlineseg {id row endrow arrowlow} {
3433 global rowidlist displayorder iddrawn linesegs
e341c06d 3434 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
3435
3436 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3437 set le [expr {$row + 1}]
3438 set arrowhigh 1
9f1afe05 3439 while {1} {
322a8cc9
PM
3440 set c [lsearch -exact [lindex $rowidlist $le] $id]
3441 if {$c < 0} {
3442 incr le -1
3443 break
3444 }
3445 lappend cols $c
3446 set x [lindex $displayorder $le]
3447 if {$x eq $id} {
3448 set arrowhigh 0
3449 break
9f1afe05 3450 }
322a8cc9
PM
3451 if {[info exists iddrawn($x)] || $le == $endrow} {
3452 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3453 if {$c >= 0} {
3454 lappend cols $c
3455 set arrowhigh 0
3456 }
3457 break
3458 }
3459 incr le
9f1afe05 3460 }
322a8cc9
PM
3461 if {$le <= $row} {
3462 return $row
3463 }
3464
3465 set lines {}
3466 set i 0
3467 set joinhigh 0
3468 if {[info exists linesegs($id)]} {
3469 set lines $linesegs($id)
3470 foreach li $lines {
3471 set r0 [lindex $li 0]
3472 if {$r0 > $row} {
3473 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3474 set joinhigh 1
3475 }
3476 break
3477 }
3478 incr i
3479 }
3480 }
3481 set joinlow 0
3482 if {$i > 0} {
3483 set li [lindex $lines [expr {$i-1}]]
3484 set r1 [lindex $li 1]
3485 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3486 set joinlow 1
3487 }
3488 }
3489
3490 set x [lindex $cols [expr {$le - $row}]]
3491 set xp [lindex $cols [expr {$le - 1 - $row}]]
3492 set dir [expr {$xp - $x}]
3493 if {$joinhigh} {
3494 set ith [lindex $lines $i 2]
3495 set coords [$canv coords $ith]
3496 set ah [$canv itemcget $ith -arrow]
3497 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3498 set x2 [lindex $cols [expr {$le + 1 - $row}]]
3499 if {$x2 ne {} && $x - $x2 == $dir} {
3500 set coords [lrange $coords 0 end-2]
3501 }
3502 } else {
3503 set coords [list [xc $le $x] [yc $le]]
3504 }
3505 if {$joinlow} {
3506 set itl [lindex $lines [expr {$i-1}] 2]
3507 set al [$canv itemcget $itl -arrow]
3508 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d
PM
3509 } elseif {$arrowlow} {
3510 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3511 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3512 set arrowlow 0
3513 }
322a8cc9
PM
3514 }
3515 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3516 for {set y $le} {[incr y -1] > $row} {} {
3517 set x $xp
3518 set xp [lindex $cols [expr {$y - 1 - $row}]]
3519 set ndir [expr {$xp - $x}]
3520 if {$dir != $ndir || $xp < 0} {
3521 lappend coords [xc $y $x] [yc $y]
3522 }
3523 set dir $ndir
3524 }
3525 if {!$joinlow} {
3526 if {$xp < 0} {
3527 # join parent line to first child
3528 set ch [lindex $displayorder $row]
3529 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3530 if {$xc < 0} {
3531 puts "oops: drawlineseg: child $ch not on row $row"
e341c06d
PM
3532 } elseif {$xc != $x} {
3533 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3534 set d [expr {int(0.5 * $linespc)}]
3535 set x1 [xc $row $x]
3536 if {$xc < $x} {
3537 set x2 [expr {$x1 - $d}]
3538 } else {
3539 set x2 [expr {$x1 + $d}]
3540 }
3541 set y2 [yc $row]
3542 set y1 [expr {$y2 + $d}]
3543 lappend coords $x1 $y1 $x2 $y2
3544 } elseif {$xc < $x - 1} {
322a8cc9
PM
3545 lappend coords [xc $row [expr {$x-1}]] [yc $row]
3546 } elseif {$xc > $x + 1} {
3547 lappend coords [xc $row [expr {$x+1}]] [yc $row]
3548 }
3549 set x $xc
eb447a12 3550 }
322a8cc9
PM
3551 lappend coords [xc $row $x] [yc $row]
3552 } else {
3553 set xn [xc $row $xp]
3554 set yn [yc $row]
e341c06d 3555 lappend coords $xn $yn
322a8cc9
PM
3556 }
3557 if {!$joinhigh} {
322a8cc9
PM
3558 assigncolor $id
3559 set t [$canv create line $coords -width [linewidth $id] \
3560 -fill $colormap($id) -tags lines.$id -arrow $arrow]
3561 $canv lower $t
3562 bindline $t $id
3563 set lines [linsert $lines $i [list $row $le $t]]
3564 } else {
3565 $canv coords $ith $coords
3566 if {$arrow ne $ah} {
3567 $canv itemconf $ith -arrow $arrow
3568 }
3569 lset lines $i 0 $row
3570 }
3571 } else {
3572 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3573 set ndir [expr {$xo - $xp}]
3574 set clow [$canv coords $itl]
3575 if {$dir == $ndir} {
3576 set clow [lrange $clow 2 end]
3577 }
3578 set coords [concat $coords $clow]
3579 if {!$joinhigh} {
3580 lset lines [expr {$i-1}] 1 $le
322a8cc9
PM
3581 } else {
3582 # coalesce two pieces
3583 $canv delete $ith
3584 set b [lindex $lines [expr {$i-1}] 0]
3585 set e [lindex $lines $i 1]
3586 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3587 }
3588 $canv coords $itl $coords
3589 if {$arrow ne $al} {
3590 $canv itemconf $itl -arrow $arrow
879e8b1a
PM
3591 }
3592 }
322a8cc9
PM
3593
3594 set linesegs($id) $lines
3595 return $le
9f1afe05
PM
3596}
3597
322a8cc9
PM
3598proc drawparentlinks {id row} {
3599 global rowidlist canv colormap curview parentlist
513a54dc 3600 global idpos linespc
9f1afe05 3601
322a8cc9
PM
3602 set rowids [lindex $rowidlist $row]
3603 set col [lsearch -exact $rowids $id]
3604 if {$col < 0} return
3605 set olds [lindex $parentlist $row]
9f1afe05
PM
3606 set row2 [expr {$row + 1}]
3607 set x [xc $row $col]
3608 set y [yc $row]
3609 set y2 [yc $row2]
e341c06d 3610 set d [expr {int(0.5 * $linespc)}]
513a54dc 3611 set ymid [expr {$y + $d}]
8f7d0cec 3612 set ids [lindex $rowidlist $row2]
9f1afe05
PM
3613 # rmx = right-most X coord used
3614 set rmx 0
9f1afe05 3615 foreach p $olds {
f3408449
PM
3616 set i [lsearch -exact $ids $p]
3617 if {$i < 0} {
3618 puts "oops, parent $p of $id not in list"
3619 continue
3620 }
3621 set x2 [xc $row2 $i]
3622 if {$x2 > $rmx} {
3623 set rmx $x2
3624 }
513a54dc
PM
3625 set j [lsearch -exact $rowids $p]
3626 if {$j < 0} {
eb447a12
PM
3627 # drawlineseg will do this one for us
3628 continue
3629 }
9f1afe05
PM
3630 assigncolor $p
3631 # should handle duplicated parents here...
3632 set coords [list $x $y]
513a54dc
PM
3633 if {$i != $col} {
3634 # if attaching to a vertical segment, draw a smaller
3635 # slant for visual distinctness
3636 if {$i == $j} {
3637 if {$i < $col} {
3638 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3639 } else {
3640 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3641 }
3642 } elseif {$i < $col && $i < $j} {
3643 # segment slants towards us already
3644 lappend coords [xc $row $j] $y
3645 } else {
3646 if {$i < $col - 1} {
3647 lappend coords [expr {$x2 + $linespc}] $y
3648 } elseif {$i > $col + 1} {
3649 lappend coords [expr {$x2 - $linespc}] $y
3650 }
3651 lappend coords $x2 $y2
3652 }
3653 } else {
3654 lappend coords $x2 $y2
9f1afe05 3655 }
c934a8a3 3656 set t [$canv create line $coords -width [linewidth $p] \
9f1afe05
PM
3657 -fill $colormap($p) -tags lines.$p]
3658 $canv lower $t
3659 bindline $t $p
3660 }
322a8cc9
PM
3661 if {$rmx > [lindex $idpos($id) 1]} {
3662 lset idpos($id) 1 $rmx
3663 redrawtags $id
3664 }
9f1afe05
PM
3665}
3666
c934a8a3 3667proc drawlines {id} {
322a8cc9 3668 global canv
9f1afe05 3669
322a8cc9 3670 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
3671}
3672
322a8cc9 3673proc drawcmittext {id row col} {
c961b228 3674 global linespc canv canv2 canv3 canvy0 fgcolor curview
322a8cc9 3675 global commitlisted commitinfo rowidlist parentlist
9f1afe05 3676 global rowtextx idpos idtags idheads idotherrefs
0380081c 3677 global linehtag linentag linedtag selectedline
9c311b32 3678 global canvxmax boldrows boldnamerows fgcolor nullid nullid2
9f1afe05 3679
1407ade9 3680 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
c961b228 3681 set listed [lindex $commitlisted $row]
219ea3a9
PM
3682 if {$id eq $nullid} {
3683 set ofill red
8f489363 3684 } elseif {$id eq $nullid2} {
ef3192b8 3685 set ofill green
219ea3a9 3686 } else {
1407ade9 3687 set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
219ea3a9 3688 }