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