gitk: Fix errors in the theme patch
[git] / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
9e026d39 3exec wish "$0" -- "$@"
1db95b00 4
ee66e089 5# Copyright © 2005-2008 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
d93f1713
PT
10package require Tk
11
73b6a6cb
JH
12proc gitdir {} {
13 global env
14 if {[info exists env(GIT_DIR)]} {
15 return $env(GIT_DIR)
16 } else {
5024baa4 17 return [exec git rev-parse --git-dir]
73b6a6cb
JH
18 }
19}
20
7eb3cb9c
PM
21# A simple scheduler for compute-intensive stuff.
22# The aim is to make sure that event handlers for GUI actions can
23# run at least every 50-100 ms. Unfortunately fileevent handlers are
24# run before X event handlers, so reading from a fast source can
25# make the GUI completely unresponsive.
26proc run args {
df75e86d 27 global isonrunq runq currunq
7eb3cb9c
PM
28
29 set script $args
30 if {[info exists isonrunq($script)]} return
df75e86d 31 if {$runq eq {} && ![info exists currunq]} {
7eb3cb9c
PM
32 after idle dorunq
33 }
34 lappend runq [list {} $script]
35 set isonrunq($script) 1
36}
37
38proc filerun {fd script} {
39 fileevent $fd readable [list filereadable $fd $script]
40}
41
42proc filereadable {fd script} {
df75e86d 43 global runq currunq
7eb3cb9c
PM
44
45 fileevent $fd readable {}
df75e86d 46 if {$runq eq {} && ![info exists currunq]} {
7eb3cb9c
PM
47 after idle dorunq
48 }
49 lappend runq [list $fd $script]
50}
51
7fcc92bf
PM
52proc nukefile {fd} {
53 global runq
54
55 for {set i 0} {$i < [llength $runq]} {} {
56 if {[lindex $runq $i 0] eq $fd} {
57 set runq [lreplace $runq $i $i]
58 } else {
59 incr i
60 }
61 }
62}
63
7eb3cb9c 64proc dorunq {} {
df75e86d 65 global isonrunq runq currunq
7eb3cb9c
PM
66
67 set tstart [clock clicks -milliseconds]
68 set t0 $tstart
7fcc92bf 69 while {[llength $runq] > 0} {
7eb3cb9c
PM
70 set fd [lindex $runq 0 0]
71 set script [lindex $runq 0 1]
df75e86d
AG
72 set currunq [lindex $runq 0]
73 set runq [lrange $runq 1 end]
7eb3cb9c 74 set repeat [eval $script]
df75e86d 75 unset currunq
7eb3cb9c
PM
76 set t1 [clock clicks -milliseconds]
77 set t [expr {$t1 - $t0}]
7eb3cb9c
PM
78 if {$repeat ne {} && $repeat} {
79 if {$fd eq {} || $repeat == 2} {
80 # script returns 1 if it wants to be readded
81 # file readers return 2 if they could do more straight away
82 lappend runq [list $fd $script]
83 } else {
84 fileevent $fd readable [list filereadable $fd $script]
85 }
86 } elseif {$fd eq {}} {
87 unset isonrunq($script)
88 }
89 set t0 $t1
90 if {$t1 - $tstart >= 80} break
91 }
92 if {$runq ne {}} {
93 after idle dorunq
94 }
95}
96
e439e092
AG
97proc reg_instance {fd} {
98 global commfd leftover loginstance
99
100 set i [incr loginstance]
101 set commfd($i) $fd
102 set leftover($i) {}
103 return $i
104}
105
3ed31a81
PM
106proc unmerged_files {files} {
107 global nr_unmerged
108
109 # find the list of unmerged files
110 set mlist {}
111 set nr_unmerged 0
112 if {[catch {
113 set fd [open "| git ls-files -u" r]
114 } err]} {
115 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
116 exit 1
117 }
118 while {[gets $fd line] >= 0} {
119 set i [string first "\t" $line]
120 if {$i < 0} continue
121 set fname [string range $line [expr {$i+1}] end]
122 if {[lsearch -exact $mlist $fname] >= 0} continue
123 incr nr_unmerged
124 if {$files eq {} || [path_filter $files $fname]} {
125 lappend mlist $fname
126 }
127 }
128 catch {close $fd}
129 return $mlist
130}
131
132proc parseviewargs {n arglist} {
ee66e089 133 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
3ed31a81
PM
134
135 set vdatemode($n) 0
136 set vmergeonly($n) 0
ee66e089
PM
137 set glflags {}
138 set diffargs {}
139 set nextisval 0
140 set revargs {}
141 set origargs $arglist
142 set allknown 1
143 set filtered 0
144 set i -1
145 foreach arg $arglist {
146 incr i
147 if {$nextisval} {
148 lappend glflags $arg
149 set nextisval 0
150 continue
151 }
3ed31a81
PM
152 switch -glob -- $arg {
153 "-d" -
154 "--date-order" {
155 set vdatemode($n) 1
ee66e089
PM
156 # remove from origargs in case we hit an unknown option
157 set origargs [lreplace $origargs $i $i]
158 incr i -1
159 }
ee66e089
PM
160 "-[puabwcrRBMC]" -
161 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
162 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
163 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
164 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
165 "--ignore-space-change" - "-U*" - "--unified=*" {
29582284
PM
166 # These request or affect diff output, which we don't want.
167 # Some could be used to set our defaults for diff display.
ee66e089
PM
168 lappend diffargs $arg
169 }
ee66e089
PM
170 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
171 "--name-only" - "--name-status" - "--color" - "--color-words" -
172 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
173 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
174 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
175 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
176 "--objects" - "--objects-edge" - "--reverse" {
29582284
PM
177 # These cause our parsing of git log's output to fail, or else
178 # they're options we want to set ourselves, so ignore them.
ee66e089 179 }
ee66e089
PM
180 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
181 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
182 "--full-history" - "--dense" - "--sparse" -
183 "--follow" - "--left-right" - "--encoding=*" {
29582284 184 # These are harmless, and some are even useful
ee66e089
PM
185 lappend glflags $arg
186 }
ee66e089
PM
187 "--diff-filter=*" - "--no-merges" - "--unpacked" -
188 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
189 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
190 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
191 "--remove-empty" - "--first-parent" - "--cherry-pick" -
29582284
PM
192 "-S*" - "--pickaxe-all" - "--pickaxe-regex" {
193 # These mean that we get a subset of the commits
ee66e089
PM
194 set filtered 1
195 lappend glflags $arg
196 }
ee66e089 197 "-n" {
29582284
PM
198 # This appears to be the only one that has a value as a
199 # separate word following it
ee66e089
PM
200 set filtered 1
201 set nextisval 1
202 lappend glflags $arg
203 }
6e7e87c7 204 "--not" - "--all" {
ee66e089 205 lappend revargs $arg
3ed31a81
PM
206 }
207 "--merge" {
208 set vmergeonly($n) 1
ee66e089
PM
209 # git rev-parse doesn't understand --merge
210 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
211 }
ee66e089 212 "-*" {
29582284 213 # Other flag arguments including -<n>
ee66e089
PM
214 if {[string is digit -strict [string range $arg 1 end]]} {
215 set filtered 1
216 } else {
217 # a flag argument that we don't recognize;
218 # that means we can't optimize
219 set allknown 0
220 }
221 lappend glflags $arg
3ed31a81
PM
222 }
223 default {
29582284 224 # Non-flag arguments specify commits or ranges of commits
ee66e089
PM
225 if {[string match "*...*" $arg]} {
226 lappend revargs --gitk-symmetric-diff-marker
227 }
228 lappend revargs $arg
229 }
230 }
231 }
232 set vdflags($n) $diffargs
233 set vflags($n) $glflags
234 set vrevs($n) $revargs
235 set vfiltered($n) $filtered
236 set vorigargs($n) $origargs
237 return $allknown
238}
239
240proc parseviewrevs {view revs} {
241 global vposids vnegids
242
243 if {$revs eq {}} {
244 set revs HEAD
245 }
246 if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
247 # we get stdout followed by stderr in $err
248 # for an unknown rev, git rev-parse echoes it and then errors out
249 set errlines [split $err "\n"]
250 set badrev {}
251 for {set l 0} {$l < [llength $errlines]} {incr l} {
252 set line [lindex $errlines $l]
253 if {!([string length $line] == 40 && [string is xdigit $line])} {
254 if {[string match "fatal:*" $line]} {
255 if {[string match "fatal: ambiguous argument*" $line]
256 && $badrev ne {}} {
257 if {[llength $badrev] == 1} {
258 set err "unknown revision $badrev"
259 } else {
260 set err "unknown revisions: [join $badrev ", "]"
261 }
262 } else {
263 set err [join [lrange $errlines $l end] "\n"]
264 }
265 break
266 }
267 lappend badrev $line
268 }
d93f1713 269 }
3945d2c0 270 error_popup "[mc "Error parsing revisions:"] $err"
ee66e089
PM
271 return {}
272 }
273 set ret {}
274 set pos {}
275 set neg {}
276 set sdm 0
277 foreach id [split $ids "\n"] {
278 if {$id eq "--gitk-symmetric-diff-marker"} {
279 set sdm 4
280 } elseif {[string match "^*" $id]} {
281 if {$sdm != 1} {
282 lappend ret $id
283 if {$sdm == 3} {
284 set sdm 0
285 }
286 }
287 lappend neg [string range $id 1 end]
288 } else {
289 if {$sdm != 2} {
290 lappend ret $id
291 } else {
292 lset ret end [lindex $ret end]...$id
3ed31a81 293 }
ee66e089 294 lappend pos $id
3ed31a81 295 }
ee66e089 296 incr sdm -1
3ed31a81 297 }
ee66e089
PM
298 set vposids($view) $pos
299 set vnegids($view) $neg
300 return $ret
3ed31a81
PM
301}
302
f9e0b6fb 303# Start off a git log process and arrange to read its output
da7c24dd 304proc start_rev_list {view} {
6df7403a 305 global startmsecs commitidx viewcomplete curview
e439e092 306 global tclencoding
ee66e089 307 global viewargs viewargscmd viewfiles vfilelimit
d375ef9b 308 global showlocalchanges
e439e092 309 global viewactive viewinstances vmergeonly
cdc8429c 310 global mainheadid viewmainheadid viewmainheadid_orig
ee66e089 311 global vcanopt vflags vrevs vorigargs
9ccbdfbf 312
9ccbdfbf 313 set startmsecs [clock clicks -milliseconds]
da7c24dd 314 set commitidx($view) 0
3ed31a81
PM
315 # these are set this way for the error exits
316 set viewcomplete($view) 1
317 set viewactive($view) 0
7fcc92bf
PM
318 varcinit $view
319
2d480856
YD
320 set args $viewargs($view)
321 if {$viewargscmd($view) ne {}} {
322 if {[catch {
323 set str [exec sh -c $viewargscmd($view)]
324 } err]} {
3945d2c0 325 error_popup "[mc "Error executing --argscmd command:"] $err"
3ed31a81 326 return 0
2d480856
YD
327 }
328 set args [concat $args [split $str "\n"]]
329 }
ee66e089 330 set vcanopt($view) [parseviewargs $view $args]
3ed31a81
PM
331
332 set files $viewfiles($view)
333 if {$vmergeonly($view)} {
334 set files [unmerged_files $files]
335 if {$files eq {}} {
336 global nr_unmerged
337 if {$nr_unmerged == 0} {
338 error_popup [mc "No files selected: --merge specified but\
339 no files are unmerged."]
340 } else {
341 error_popup [mc "No files selected: --merge specified but\
342 no unmerged files are within file limit."]
343 }
344 return 0
345 }
346 }
347 set vfilelimit($view) $files
348
ee66e089
PM
349 if {$vcanopt($view)} {
350 set revs [parseviewrevs $view $vrevs($view)]
351 if {$revs eq {}} {
352 return 0
353 }
354 set args [concat $vflags($view) $revs]
355 } else {
356 set args $vorigargs($view)
357 }
358
418c4c7b 359 if {[catch {
7fcc92bf 360 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
3ed31a81 361 --boundary $args "--" $files] r]
418c4c7b 362 } err]} {
00abadb9 363 error_popup "[mc "Error executing git log:"] $err"
3ed31a81 364 return 0
1d10f36d 365 }
e439e092 366 set i [reg_instance $fd]
7fcc92bf 367 set viewinstances($view) [list $i]
cdc8429c
PM
368 set viewmainheadid($view) $mainheadid
369 set viewmainheadid_orig($view) $mainheadid
370 if {$files ne {} && $mainheadid ne {}} {
371 get_viewmainhead $view
372 }
373 if {$showlocalchanges && $viewmainheadid($view) ne {}} {
374 interestedin $viewmainheadid($view) dodiffindex
3e6b893f 375 }
86da5b6c 376 fconfigure $fd -blocking 0 -translation lf -eofchar {}
fd8ccbec 377 if {$tclencoding != {}} {
da7c24dd 378 fconfigure $fd -encoding $tclencoding
fd8ccbec 379 }
f806f0fb 380 filerun $fd [list getcommitlines $fd $i $view 0]
d990cedf 381 nowbusy $view [mc "Reading"]
3ed31a81
PM
382 set viewcomplete($view) 0
383 set viewactive($view) 1
384 return 1
38ad0910
PM
385}
386
e2f90ee4
AG
387proc stop_instance {inst} {
388 global commfd leftover
389
390 set fd $commfd($inst)
391 catch {
392 set pid [pid $fd]
b6326e92
AG
393
394 if {$::tcl_platform(platform) eq {windows}} {
395 exec kill -f $pid
396 } else {
397 exec kill $pid
398 }
e2f90ee4
AG
399 }
400 catch {close $fd}
401 nukefile $fd
402 unset commfd($inst)
403 unset leftover($inst)
404}
405
406proc stop_backends {} {
407 global commfd
408
409 foreach inst [array names commfd] {
410 stop_instance $inst
411 }
412}
413
7fcc92bf 414proc stop_rev_list {view} {
e2f90ee4 415 global viewinstances
22626ef4 416
7fcc92bf 417 foreach inst $viewinstances($view) {
e2f90ee4 418 stop_instance $inst
22626ef4 419 }
7fcc92bf 420 set viewinstances($view) {}
22626ef4
PM
421}
422
567c34e0 423proc reset_pending_select {selid} {
39816d60 424 global pending_select mainheadid selectheadid
567c34e0
AG
425
426 if {$selid ne {}} {
427 set pending_select $selid
39816d60
AG
428 } elseif {$selectheadid ne {}} {
429 set pending_select $selectheadid
567c34e0
AG
430 } else {
431 set pending_select $mainheadid
432 }
433}
434
435proc getcommits {selid} {
3ed31a81 436 global canv curview need_redisplay viewactive
38ad0910 437
da7c24dd 438 initlayout
3ed31a81 439 if {[start_rev_list $curview]} {
567c34e0 440 reset_pending_select $selid
3ed31a81
PM
441 show_status [mc "Reading commits..."]
442 set need_redisplay 1
443 } else {
444 show_status [mc "No commits selected"]
445 }
1d10f36d
PM
446}
447
7fcc92bf 448proc updatecommits {} {
ee66e089 449 global curview vcanopt vorigargs vfilelimit viewinstances
e439e092
AG
450 global viewactive viewcomplete tclencoding
451 global startmsecs showneartags showlocalchanges
cdc8429c 452 global mainheadid viewmainheadid viewmainheadid_orig pending_select
92e22ca0 453 global isworktree
ee66e089 454 global varcid vposids vnegids vflags vrevs
7fcc92bf 455
92e22ca0 456 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
fc2a256f 457 rereadrefs
cdc8429c
PM
458 set view $curview
459 if {$mainheadid ne $viewmainheadid_orig($view)} {
460 if {$showlocalchanges} {
eb5f8c9c
PM
461 dohidelocalchanges
462 }
cdc8429c
PM
463 set viewmainheadid($view) $mainheadid
464 set viewmainheadid_orig($view) $mainheadid
465 if {$vfilelimit($view) ne {}} {
466 get_viewmainhead $view
eb5f8c9c
PM
467 }
468 }
cdc8429c
PM
469 if {$showlocalchanges} {
470 doshowlocalchanges
471 }
ee66e089
PM
472 if {$vcanopt($view)} {
473 set oldpos $vposids($view)
474 set oldneg $vnegids($view)
475 set revs [parseviewrevs $view $vrevs($view)]
476 if {$revs eq {}} {
477 return
478 }
479 # note: getting the delta when negative refs change is hard,
480 # and could require multiple git log invocations, so in that
481 # case we ask git log for all the commits (not just the delta)
482 if {$oldneg eq $vnegids($view)} {
483 set newrevs {}
484 set npos 0
485 # take out positive refs that we asked for before or
486 # that we have already seen
487 foreach rev $revs {
488 if {[string length $rev] == 40} {
489 if {[lsearch -exact $oldpos $rev] < 0
490 && ![info exists varcid($view,$rev)]} {
491 lappend newrevs $rev
492 incr npos
493 }
494 } else {
495 lappend $newrevs $rev
496 }
497 }
498 if {$npos == 0} return
499 set revs $newrevs
500 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
501 }
502 set args [concat $vflags($view) $revs --not $oldpos]
503 } else {
504 set args $vorigargs($view)
505 }
7fcc92bf
PM
506 if {[catch {
507 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
ee66e089 508 --boundary $args "--" $vfilelimit($view)] r]
7fcc92bf 509 } err]} {
3945d2c0 510 error_popup "[mc "Error executing git log:"] $err"
ee66e089 511 return
7fcc92bf
PM
512 }
513 if {$viewactive($view) == 0} {
514 set startmsecs [clock clicks -milliseconds]
515 }
e439e092 516 set i [reg_instance $fd]
7fcc92bf 517 lappend viewinstances($view) $i
7fcc92bf
PM
518 fconfigure $fd -blocking 0 -translation lf -eofchar {}
519 if {$tclencoding != {}} {
520 fconfigure $fd -encoding $tclencoding
521 }
f806f0fb 522 filerun $fd [list getcommitlines $fd $i $view 1]
7fcc92bf
PM
523 incr viewactive($view)
524 set viewcomplete($view) 0
567c34e0 525 reset_pending_select {}
b56e0a9a 526 nowbusy $view [mc "Reading"]
7fcc92bf
PM
527 if {$showneartags} {
528 getallcommits
529 }
530}
531
532proc reloadcommits {} {
533 global curview viewcomplete selectedline currentid thickerline
534 global showneartags treediffs commitinterest cached_commitrow
6df7403a 535 global targetid
7fcc92bf 536
567c34e0
AG
537 set selid {}
538 if {$selectedline ne {}} {
539 set selid $currentid
540 }
541
7fcc92bf
PM
542 if {!$viewcomplete($curview)} {
543 stop_rev_list $curview
7fcc92bf
PM
544 }
545 resetvarcs $curview
94b4a69f 546 set selectedline {}
7fcc92bf
PM
547 catch {unset currentid}
548 catch {unset thickerline}
549 catch {unset treediffs}
550 readrefs
551 changedrefs
552 if {$showneartags} {
553 getallcommits
554 }
555 clear_display
556 catch {unset commitinterest}
557 catch {unset cached_commitrow}
42a671fc 558 catch {unset targetid}
7fcc92bf 559 setcanvscroll
567c34e0 560 getcommits $selid
e7297a1c 561 return 0
7fcc92bf
PM
562}
563
6e8c8707
PM
564# This makes a string representation of a positive integer which
565# sorts as a string in numerical order
566proc strrep {n} {
567 if {$n < 16} {
568 return [format "%x" $n]
569 } elseif {$n < 256} {
570 return [format "x%.2x" $n]
571 } elseif {$n < 65536} {
572 return [format "y%.4x" $n]
573 }
574 return [format "z%.8x" $n]
575}
576
7fcc92bf
PM
577# Procedures used in reordering commits from git log (without
578# --topo-order) into the order for display.
579
580proc varcinit {view} {
f3ea5ede
PM
581 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
582 global vtokmod varcmod vrowmod varcix vlastins
7fcc92bf 583
7fcc92bf
PM
584 set varcstart($view) {{}}
585 set vupptr($view) {0}
586 set vdownptr($view) {0}
587 set vleftptr($view) {0}
f3ea5ede 588 set vbackptr($view) {0}
7fcc92bf
PM
589 set varctok($view) {{}}
590 set varcrow($view) {{}}
591 set vtokmod($view) {}
592 set varcmod($view) 0
e5b37ac1 593 set vrowmod($view) 0
7fcc92bf 594 set varcix($view) {{}}
f3ea5ede 595 set vlastins($view) {0}
7fcc92bf
PM
596}
597
598proc resetvarcs {view} {
599 global varcid varccommits parents children vseedcount ordertok
600
601 foreach vid [array names varcid $view,*] {
602 unset varcid($vid)
603 unset children($vid)
604 unset parents($vid)
605 }
606 # some commits might have children but haven't been seen yet
607 foreach vid [array names children $view,*] {
608 unset children($vid)
609 }
610 foreach va [array names varccommits $view,*] {
611 unset varccommits($va)
612 }
613 foreach vd [array names vseedcount $view,*] {
614 unset vseedcount($vd)
615 }
9257d8f7 616 catch {unset ordertok}
7fcc92bf
PM
617}
618
468bcaed
PM
619# returns a list of the commits with no children
620proc seeds {v} {
621 global vdownptr vleftptr varcstart
622
623 set ret {}
624 set a [lindex $vdownptr($v) 0]
625 while {$a != 0} {
626 lappend ret [lindex $varcstart($v) $a]
627 set a [lindex $vleftptr($v) $a]
628 }
629 return $ret
630}
631
7fcc92bf 632proc newvarc {view id} {
3ed31a81 633 global varcid varctok parents children vdatemode
f3ea5ede
PM
634 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
635 global commitdata commitinfo vseedcount varccommits vlastins
7fcc92bf
PM
636
637 set a [llength $varctok($view)]
638 set vid $view,$id
3ed31a81 639 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
7fcc92bf
PM
640 if {![info exists commitinfo($id)]} {
641 parsecommit $id $commitdata($id) 1
642 }
643 set cdate [lindex $commitinfo($id) 4]
644 if {![string is integer -strict $cdate]} {
645 set cdate 0
646 }
647 if {![info exists vseedcount($view,$cdate)]} {
648 set vseedcount($view,$cdate) -1
649 }
650 set c [incr vseedcount($view,$cdate)]
651 set cdate [expr {$cdate ^ 0xffffffff}]
652 set tok "s[strrep $cdate][strrep $c]"
7fcc92bf
PM
653 } else {
654 set tok {}
f3ea5ede
PM
655 }
656 set ka 0
657 if {[llength $children($vid)] > 0} {
658 set kid [lindex $children($vid) end]
659 set k $varcid($view,$kid)
660 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
661 set ki $kid
662 set ka $k
663 set tok [lindex $varctok($view) $k]
7fcc92bf 664 }
f3ea5ede
PM
665 }
666 if {$ka != 0} {
7fcc92bf
PM
667 set i [lsearch -exact $parents($view,$ki) $id]
668 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
7fcc92bf
PM
669 append tok [strrep $j]
670 }
f3ea5ede
PM
671 set c [lindex $vlastins($view) $ka]
672 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
673 set c $ka
674 set b [lindex $vdownptr($view) $ka]
675 } else {
676 set b [lindex $vleftptr($view) $c]
677 }
678 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
679 set c $b
680 set b [lindex $vleftptr($view) $c]
681 }
682 if {$c == $ka} {
683 lset vdownptr($view) $ka $a
684 lappend vbackptr($view) 0
685 } else {
686 lset vleftptr($view) $c $a
687 lappend vbackptr($view) $c
688 }
689 lset vlastins($view) $ka $a
690 lappend vupptr($view) $ka
691 lappend vleftptr($view) $b
692 if {$b != 0} {
693 lset vbackptr($view) $b $a
694 }
7fcc92bf
PM
695 lappend varctok($view) $tok
696 lappend varcstart($view) $id
697 lappend vdownptr($view) 0
698 lappend varcrow($view) {}
699 lappend varcix($view) {}
e5b37ac1 700 set varccommits($view,$a) {}
f3ea5ede 701 lappend vlastins($view) 0
7fcc92bf
PM
702 return $a
703}
704
705proc splitvarc {p v} {
52b8ea93 706 global varcid varcstart varccommits varctok vtokmod
f3ea5ede 707 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
7fcc92bf
PM
708
709 set oa $varcid($v,$p)
52b8ea93 710 set otok [lindex $varctok($v) $oa]
7fcc92bf
PM
711 set ac $varccommits($v,$oa)
712 set i [lsearch -exact $varccommits($v,$oa) $p]
713 if {$i <= 0} return
714 set na [llength $varctok($v)]
715 # "%" sorts before "0"...
52b8ea93 716 set tok "$otok%[strrep $i]"
7fcc92bf
PM
717 lappend varctok($v) $tok
718 lappend varcrow($v) {}
719 lappend varcix($v) {}
720 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
721 set varccommits($v,$na) [lrange $ac $i end]
722 lappend varcstart($v) $p
723 foreach id $varccommits($v,$na) {
724 set varcid($v,$id) $na
725 }
726 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
841ea824 727 lappend vlastins($v) [lindex $vlastins($v) $oa]
7fcc92bf 728 lset vdownptr($v) $oa $na
841ea824 729 lset vlastins($v) $oa 0
7fcc92bf
PM
730 lappend vupptr($v) $oa
731 lappend vleftptr($v) 0
f3ea5ede 732 lappend vbackptr($v) 0
7fcc92bf
PM
733 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
734 lset vupptr($v) $b $na
735 }
52b8ea93
PM
736 if {[string compare $otok $vtokmod($v)] <= 0} {
737 modify_arc $v $oa
738 }
7fcc92bf
PM
739}
740
741proc renumbervarc {a v} {
742 global parents children varctok varcstart varccommits
3ed31a81 743 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
7fcc92bf
PM
744
745 set t1 [clock clicks -milliseconds]
746 set todo {}
747 set isrelated($a) 1
f3ea5ede 748 set kidchanged($a) 1
7fcc92bf
PM
749 set ntot 0
750 while {$a != 0} {
751 if {[info exists isrelated($a)]} {
752 lappend todo $a
753 set id [lindex $varccommits($v,$a) end]
754 foreach p $parents($v,$id) {
755 if {[info exists varcid($v,$p)]} {
756 set isrelated($varcid($v,$p)) 1
757 }
758 }
759 }
760 incr ntot
761 set b [lindex $vdownptr($v) $a]
762 if {$b == 0} {
763 while {$a != 0} {
764 set b [lindex $vleftptr($v) $a]
765 if {$b != 0} break
766 set a [lindex $vupptr($v) $a]
767 }
768 }
769 set a $b
770 }
771 foreach a $todo {
f3ea5ede 772 if {![info exists kidchanged($a)]} continue
7fcc92bf 773 set id [lindex $varcstart($v) $a]
f3ea5ede
PM
774 if {[llength $children($v,$id)] > 1} {
775 set children($v,$id) [lsort -command [list vtokcmp $v] \
776 $children($v,$id)]
777 }
778 set oldtok [lindex $varctok($v) $a]
3ed31a81 779 if {!$vdatemode($v)} {
f3ea5ede
PM
780 set tok {}
781 } else {
782 set tok $oldtok
783 }
784 set ka 0
c8c9f3d9
PM
785 set kid [last_real_child $v,$id]
786 if {$kid ne {}} {
f3ea5ede
PM
787 set k $varcid($v,$kid)
788 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
789 set ki $kid
790 set ka $k
791 set tok [lindex $varctok($v) $k]
7fcc92bf
PM
792 }
793 }
f3ea5ede 794 if {$ka != 0} {
7fcc92bf
PM
795 set i [lsearch -exact $parents($v,$ki) $id]
796 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
797 append tok [strrep $j]
7fcc92bf 798 }
f3ea5ede
PM
799 if {$tok eq $oldtok} {
800 continue
801 }
802 set id [lindex $varccommits($v,$a) end]
803 foreach p $parents($v,$id) {
804 if {[info exists varcid($v,$p)]} {
805 set kidchanged($varcid($v,$p)) 1
806 } else {
807 set sortkids($p) 1
808 }
809 }
810 lset varctok($v) $a $tok
7fcc92bf
PM
811 set b [lindex $vupptr($v) $a]
812 if {$b != $ka} {
9257d8f7
PM
813 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
814 modify_arc $v $ka
38dfe939 815 }
9257d8f7
PM
816 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
817 modify_arc $v $b
38dfe939 818 }
f3ea5ede
PM
819 set c [lindex $vbackptr($v) $a]
820 set d [lindex $vleftptr($v) $a]
821 if {$c == 0} {
822 lset vdownptr($v) $b $d
7fcc92bf 823 } else {
f3ea5ede
PM
824 lset vleftptr($v) $c $d
825 }
826 if {$d != 0} {
827 lset vbackptr($v) $d $c
7fcc92bf 828 }
841ea824
PM
829 if {[lindex $vlastins($v) $b] == $a} {
830 lset vlastins($v) $b $c
831 }
7fcc92bf 832 lset vupptr($v) $a $ka
f3ea5ede
PM
833 set c [lindex $vlastins($v) $ka]
834 if {$c == 0 || \
835 [string compare $tok [lindex $varctok($v) $c]] < 0} {
836 set c $ka
837 set b [lindex $vdownptr($v) $ka]
838 } else {
839 set b [lindex $vleftptr($v) $c]
840 }
841 while {$b != 0 && \
842 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
843 set c $b
844 set b [lindex $vleftptr($v) $c]
7fcc92bf 845 }
f3ea5ede
PM
846 if {$c == $ka} {
847 lset vdownptr($v) $ka $a
848 lset vbackptr($v) $a 0
849 } else {
850 lset vleftptr($v) $c $a
851 lset vbackptr($v) $a $c
7fcc92bf 852 }
f3ea5ede
PM
853 lset vleftptr($v) $a $b
854 if {$b != 0} {
855 lset vbackptr($v) $b $a
856 }
857 lset vlastins($v) $ka $a
858 }
859 }
860 foreach id [array names sortkids] {
861 if {[llength $children($v,$id)] > 1} {
862 set children($v,$id) [lsort -command [list vtokcmp $v] \
863 $children($v,$id)]
7fcc92bf
PM
864 }
865 }
866 set t2 [clock clicks -milliseconds]
867 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
868}
869
f806f0fb
PM
870# Fix up the graph after we have found out that in view $v,
871# $p (a commit that we have already seen) is actually the parent
872# of the last commit in arc $a.
7fcc92bf 873proc fix_reversal {p a v} {
24f7a667 874 global varcid varcstart varctok vupptr
7fcc92bf
PM
875
876 set pa $varcid($v,$p)
877 if {$p ne [lindex $varcstart($v) $pa]} {
878 splitvarc $p $v
879 set pa $varcid($v,$p)
880 }
24f7a667
PM
881 # seeds always need to be renumbered
882 if {[lindex $vupptr($v) $pa] == 0 ||
883 [string compare [lindex $varctok($v) $a] \
884 [lindex $varctok($v) $pa]] > 0} {
7fcc92bf
PM
885 renumbervarc $pa $v
886 }
887}
888
889proc insertrow {id p v} {
b8a938cf
PM
890 global cmitlisted children parents varcid varctok vtokmod
891 global varccommits ordertok commitidx numcommits curview
892 global targetid targetrow
893
894 readcommit $id
895 set vid $v,$id
896 set cmitlisted($vid) 1
897 set children($vid) {}
898 set parents($vid) [list $p]
899 set a [newvarc $v $id]
900 set varcid($vid) $a
901 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
902 modify_arc $v $a
903 }
904 lappend varccommits($v,$a) $id
905 set vp $v,$p
906 if {[llength [lappend children($vp) $id]] > 1} {
907 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
908 catch {unset ordertok}
909 }
910 fix_reversal $p $a $v
911 incr commitidx($v)
912 if {$v == $curview} {
913 set numcommits $commitidx($v)
914 setcanvscroll
915 if {[info exists targetid]} {
916 if {![comes_before $targetid $p]} {
917 incr targetrow
918 }
919 }
920 }
921}
922
923proc insertfakerow {id p} {
9257d8f7 924 global varcid varccommits parents children cmitlisted
b8a938cf 925 global commitidx varctok vtokmod targetid targetrow curview numcommits
7fcc92bf 926
b8a938cf 927 set v $curview
7fcc92bf
PM
928 set a $varcid($v,$p)
929 set i [lsearch -exact $varccommits($v,$a) $p]
930 if {$i < 0} {
b8a938cf 931 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
7fcc92bf
PM
932 return
933 }
934 set children($v,$id) {}
935 set parents($v,$id) [list $p]
936 set varcid($v,$id) $a
9257d8f7 937 lappend children($v,$p) $id
7fcc92bf 938 set cmitlisted($v,$id) 1
b8a938cf 939 set numcommits [incr commitidx($v)]
7fcc92bf
PM
940 # note we deliberately don't update varcstart($v) even if $i == 0
941 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
c9cfdc96 942 modify_arc $v $a $i
42a671fc
PM
943 if {[info exists targetid]} {
944 if {![comes_before $targetid $p]} {
945 incr targetrow
946 }
947 }
b8a938cf 948 setcanvscroll
9257d8f7 949 drawvisible
7fcc92bf
PM
950}
951
b8a938cf 952proc removefakerow {id} {
9257d8f7 953 global varcid varccommits parents children commitidx
fc2a256f 954 global varctok vtokmod cmitlisted currentid selectedline
b8a938cf 955 global targetid curview numcommits
7fcc92bf 956
b8a938cf 957 set v $curview
7fcc92bf 958 if {[llength $parents($v,$id)] != 1} {
b8a938cf 959 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
7fcc92bf
PM
960 return
961 }
962 set p [lindex $parents($v,$id) 0]
963 set a $varcid($v,$id)
964 set i [lsearch -exact $varccommits($v,$a) $id]
965 if {$i < 0} {
b8a938cf 966 puts "oops: removefakerow can't find [shortids $id] on arc $a"
7fcc92bf
PM
967 return
968 }
969 unset varcid($v,$id)
970 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
971 unset parents($v,$id)
972 unset children($v,$id)
973 unset cmitlisted($v,$id)
b8a938cf 974 set numcommits [incr commitidx($v) -1]
7fcc92bf
PM
975 set j [lsearch -exact $children($v,$p) $id]
976 if {$j >= 0} {
977 set children($v,$p) [lreplace $children($v,$p) $j $j]
978 }
c9cfdc96 979 modify_arc $v $a $i
fc2a256f
PM
980 if {[info exist currentid] && $id eq $currentid} {
981 unset currentid
94b4a69f 982 set selectedline {}
fc2a256f 983 }
42a671fc
PM
984 if {[info exists targetid] && $targetid eq $id} {
985 set targetid $p
986 }
b8a938cf 987 setcanvscroll
9257d8f7 988 drawvisible
7fcc92bf
PM
989}
990
c8c9f3d9
PM
991proc first_real_child {vp} {
992 global children nullid nullid2
993
994 foreach id $children($vp) {
995 if {$id ne $nullid && $id ne $nullid2} {
996 return $id
997 }
998 }
999 return {}
1000}
1001
1002proc last_real_child {vp} {
1003 global children nullid nullid2
1004
1005 set kids $children($vp)
1006 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1007 set id [lindex $kids $i]
1008 if {$id ne $nullid && $id ne $nullid2} {
1009 return $id
1010 }
1011 }
1012 return {}
1013}
1014
7fcc92bf
PM
1015proc vtokcmp {v a b} {
1016 global varctok varcid
1017
1018 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1019 [lindex $varctok($v) $varcid($v,$b)]]
1020}
1021
c9cfdc96
PM
1022# This assumes that if lim is not given, the caller has checked that
1023# arc a's token is less than $vtokmod($v)
e5b37ac1
PM
1024proc modify_arc {v a {lim {}}} {
1025 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
9257d8f7 1026
c9cfdc96
PM
1027 if {$lim ne {}} {
1028 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1029 if {$c > 0} return
1030 if {$c == 0} {
1031 set r [lindex $varcrow($v) $a]
1032 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1033 }
1034 }
9257d8f7
PM
1035 set vtokmod($v) [lindex $varctok($v) $a]
1036 set varcmod($v) $a
1037 if {$v == $curview} {
1038 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1039 set a [lindex $vupptr($v) $a]
e5b37ac1 1040 set lim {}
9257d8f7 1041 }
e5b37ac1
PM
1042 set r 0
1043 if {$a != 0} {
1044 if {$lim eq {}} {
1045 set lim [llength $varccommits($v,$a)]
1046 }
1047 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1048 }
1049 set vrowmod($v) $r
0c27886e 1050 undolayout $r
9257d8f7
PM
1051 }
1052}
1053
7fcc92bf 1054proc update_arcrows {v} {
e5b37ac1 1055 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
24f7a667 1056 global varcid vrownum varcorder varcix varccommits
7fcc92bf 1057 global vupptr vdownptr vleftptr varctok
24f7a667 1058 global displayorder parentlist curview cached_commitrow
7fcc92bf 1059
c9cfdc96
PM
1060 if {$vrowmod($v) == $commitidx($v)} return
1061 if {$v == $curview} {
1062 if {[llength $displayorder] > $vrowmod($v)} {
1063 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1064 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1065 }
1066 catch {unset cached_commitrow}
1067 }
7fcc92bf
PM
1068 set narctot [expr {[llength $varctok($v)] - 1}]
1069 set a $varcmod($v)
1070 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1071 # go up the tree until we find something that has a row number,
1072 # or we get to a seed
1073 set a [lindex $vupptr($v) $a]
1074 }
1075 if {$a == 0} {
1076 set a [lindex $vdownptr($v) 0]
1077 if {$a == 0} return
1078 set vrownum($v) {0}
1079 set varcorder($v) [list $a]
1080 lset varcix($v) $a 0
1081 lset varcrow($v) $a 0
1082 set arcn 0
1083 set row 0
1084 } else {
1085 set arcn [lindex $varcix($v) $a]
7fcc92bf
PM
1086 if {[llength $vrownum($v)] > $arcn + 1} {
1087 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1088 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1089 }
1090 set row [lindex $varcrow($v) $a]
1091 }
7fcc92bf
PM
1092 while {1} {
1093 set p $a
1094 incr row [llength $varccommits($v,$a)]
1095 # go down if possible
1096 set b [lindex $vdownptr($v) $a]
1097 if {$b == 0} {
1098 # if not, go left, or go up until we can go left
1099 while {$a != 0} {
1100 set b [lindex $vleftptr($v) $a]
1101 if {$b != 0} break
1102 set a [lindex $vupptr($v) $a]
1103 }
1104 if {$a == 0} break
1105 }
1106 set a $b
1107 incr arcn
1108 lappend vrownum($v) $row
1109 lappend varcorder($v) $a
1110 lset varcix($v) $a $arcn
1111 lset varcrow($v) $a $row
1112 }
e5b37ac1
PM
1113 set vtokmod($v) [lindex $varctok($v) $p]
1114 set varcmod($v) $p
1115 set vrowmod($v) $row
7fcc92bf
PM
1116 if {[info exists currentid]} {
1117 set selectedline [rowofcommit $currentid]
1118 }
7fcc92bf
PM
1119}
1120
1121# Test whether view $v contains commit $id
1122proc commitinview {id v} {
1123 global varcid
1124
1125 return [info exists varcid($v,$id)]
1126}
1127
1128# Return the row number for commit $id in the current view
1129proc rowofcommit {id} {
1130 global varcid varccommits varcrow curview cached_commitrow
9257d8f7 1131 global varctok vtokmod
7fcc92bf 1132
7fcc92bf
PM
1133 set v $curview
1134 if {![info exists varcid($v,$id)]} {
1135 puts "oops rowofcommit no arc for [shortids $id]"
1136 return {}
1137 }
1138 set a $varcid($v,$id)
fc2a256f 1139 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
9257d8f7
PM
1140 update_arcrows $v
1141 }
31c0eaa8
PM
1142 if {[info exists cached_commitrow($id)]} {
1143 return $cached_commitrow($id)
1144 }
7fcc92bf
PM
1145 set i [lsearch -exact $varccommits($v,$a) $id]
1146 if {$i < 0} {
1147 puts "oops didn't find commit [shortids $id] in arc $a"
1148 return {}
1149 }
1150 incr i [lindex $varcrow($v) $a]
1151 set cached_commitrow($id) $i
1152 return $i
1153}
1154
42a671fc
PM
1155# Returns 1 if a is on an earlier row than b, otherwise 0
1156proc comes_before {a b} {
1157 global varcid varctok curview
1158
1159 set v $curview
1160 if {$a eq $b || ![info exists varcid($v,$a)] || \
1161 ![info exists varcid($v,$b)]} {
1162 return 0
1163 }
1164 if {$varcid($v,$a) != $varcid($v,$b)} {
1165 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1166 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1167 }
1168 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1169}
1170
7fcc92bf
PM
1171proc bsearch {l elt} {
1172 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1173 return 0
1174 }
1175 set lo 0
1176 set hi [llength $l]
1177 while {$hi - $lo > 1} {
1178 set mid [expr {int(($lo + $hi) / 2)}]
1179 set t [lindex $l $mid]
1180 if {$elt < $t} {
1181 set hi $mid
1182 } elseif {$elt > $t} {
1183 set lo $mid
1184 } else {
1185 return $mid
1186 }
1187 }
1188 return $lo
1189}
1190
1191# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1192proc make_disporder {start end} {
1193 global vrownum curview commitidx displayorder parentlist
e5b37ac1 1194 global varccommits varcorder parents vrowmod varcrow
7fcc92bf
PM
1195 global d_valid_start d_valid_end
1196
e5b37ac1 1197 if {$end > $vrowmod($curview)} {
9257d8f7
PM
1198 update_arcrows $curview
1199 }
7fcc92bf
PM
1200 set ai [bsearch $vrownum($curview) $start]
1201 set start [lindex $vrownum($curview) $ai]
1202 set narc [llength $vrownum($curview)]
1203 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1204 set a [lindex $varcorder($curview) $ai]
1205 set l [llength $displayorder]
1206 set al [llength $varccommits($curview,$a)]
1207 if {$l < $r + $al} {
1208 if {$l < $r} {
1209 set pad [ntimes [expr {$r - $l}] {}]
1210 set displayorder [concat $displayorder $pad]
1211 set parentlist [concat $parentlist $pad]
1212 } elseif {$l > $r} {
1213 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1214 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1215 }
1216 foreach id $varccommits($curview,$a) {
1217 lappend displayorder $id
1218 lappend parentlist $parents($curview,$id)
1219 }
17529cf9 1220 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
7fcc92bf
PM
1221 set i $r
1222 foreach id $varccommits($curview,$a) {
1223 lset displayorder $i $id
1224 lset parentlist $i $parents($curview,$id)
1225 incr i
1226 }
1227 }
1228 incr r $al
1229 }
1230}
1231
1232proc commitonrow {row} {
1233 global displayorder
1234
1235 set id [lindex $displayorder $row]
1236 if {$id eq {}} {
1237 make_disporder $row [expr {$row + 1}]
1238 set id [lindex $displayorder $row]
1239 }
1240 return $id
1241}
1242
1243proc closevarcs {v} {
1244 global varctok varccommits varcid parents children
d375ef9b 1245 global cmitlisted commitidx vtokmod
7fcc92bf
PM
1246
1247 set missing_parents 0
1248 set scripts {}
1249 set narcs [llength $varctok($v)]
1250 for {set a 1} {$a < $narcs} {incr a} {
1251 set id [lindex $varccommits($v,$a) end]
1252 foreach p $parents($v,$id) {
1253 if {[info exists varcid($v,$p)]} continue
1254 # add p as a new commit
1255 incr missing_parents
1256 set cmitlisted($v,$p) 0
1257 set parents($v,$p) {}
1258 if {[llength $children($v,$p)] == 1 &&
1259 [llength $parents($v,$id)] == 1} {
1260 set b $a
1261 } else {
1262 set b [newvarc $v $p]
1263 }
1264 set varcid($v,$p) $b
9257d8f7
PM
1265 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1266 modify_arc $v $b
7fcc92bf 1267 }
e5b37ac1 1268 lappend varccommits($v,$b) $p
7fcc92bf 1269 incr commitidx($v)
d375ef9b 1270 set scripts [check_interest $p $scripts]
7fcc92bf
PM
1271 }
1272 }
1273 if {$missing_parents > 0} {
7fcc92bf
PM
1274 foreach s $scripts {
1275 eval $s
1276 }
1277 }
1278}
1279
f806f0fb
PM
1280# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1281# Assumes we already have an arc for $rwid.
1282proc rewrite_commit {v id rwid} {
1283 global children parents varcid varctok vtokmod varccommits
1284
1285 foreach ch $children($v,$id) {
1286 # make $rwid be $ch's parent in place of $id
1287 set i [lsearch -exact $parents($v,$ch) $id]
1288 if {$i < 0} {
1289 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1290 }
1291 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1292 # add $ch to $rwid's children and sort the list if necessary
1293 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1294 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1295 $children($v,$rwid)]
1296 }
1297 # fix the graph after joining $id to $rwid
1298 set a $varcid($v,$ch)
1299 fix_reversal $rwid $a $v
c9cfdc96
PM
1300 # parentlist is wrong for the last element of arc $a
1301 # even if displayorder is right, hence the 3rd arg here
1302 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
f806f0fb
PM
1303 }
1304}
1305
d375ef9b
PM
1306# Mechanism for registering a command to be executed when we come
1307# across a particular commit. To handle the case when only the
1308# prefix of the commit is known, the commitinterest array is now
1309# indexed by the first 4 characters of the ID. Each element is a
1310# list of id, cmd pairs.
1311proc interestedin {id cmd} {
1312 global commitinterest
1313
1314 lappend commitinterest([string range $id 0 3]) $id $cmd
1315}
1316
1317proc check_interest {id scripts} {
1318 global commitinterest
1319
1320 set prefix [string range $id 0 3]
1321 if {[info exists commitinterest($prefix)]} {
1322 set newlist {}
1323 foreach {i script} $commitinterest($prefix) {
1324 if {[string match "$i*" $id]} {
1325 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1326 } else {
1327 lappend newlist $i $script
1328 }
1329 }
1330 if {$newlist ne {}} {
1331 set commitinterest($prefix) $newlist
1332 } else {
1333 unset commitinterest($prefix)
1334 }
1335 }
1336 return $scripts
1337}
1338
f806f0fb 1339proc getcommitlines {fd inst view updating} {
d375ef9b 1340 global cmitlisted leftover
3ed31a81 1341 global commitidx commitdata vdatemode
7fcc92bf 1342 global parents children curview hlview
468bcaed 1343 global idpending ordertok
3ed31a81 1344 global varccommits varcid varctok vtokmod vfilelimit
9ccbdfbf 1345
d1e46756 1346 set stuff [read $fd 500000]
005a2f4e 1347 # git log doesn't terminate the last commit with a null...
7fcc92bf 1348 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
005a2f4e
PM
1349 set stuff "\0"
1350 }
b490a991 1351 if {$stuff == {}} {
7eb3cb9c
PM
1352 if {![eof $fd]} {
1353 return 1
1354 }
6df7403a 1355 global commfd viewcomplete viewactive viewname
7fcc92bf
PM
1356 global viewinstances
1357 unset commfd($inst)
1358 set i [lsearch -exact $viewinstances($view) $inst]
1359 if {$i >= 0} {
1360 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
b0cdca99 1361 }
f0654861 1362 # set it blocking so we wait for the process to terminate
da7c24dd 1363 fconfigure $fd -blocking 1
098dd8a3
PM
1364 if {[catch {close $fd} err]} {
1365 set fv {}
1366 if {$view != $curview} {
1367 set fv " for the \"$viewname($view)\" view"
da7c24dd 1368 }
098dd8a3
PM
1369 if {[string range $err 0 4] == "usage"} {
1370 set err "Gitk: error reading commits$fv:\
f9e0b6fb 1371 bad arguments to git log."
098dd8a3
PM
1372 if {$viewname($view) eq "Command line"} {
1373 append err \
f9e0b6fb 1374 " (Note: arguments to gitk are passed to git log\
098dd8a3
PM
1375 to allow selection of commits to be displayed.)"
1376 }
1377 } else {
1378 set err "Error reading commits$fv: $err"
1379 }
1380 error_popup $err
1d10f36d 1381 }
7fcc92bf
PM
1382 if {[incr viewactive($view) -1] <= 0} {
1383 set viewcomplete($view) 1
1384 # Check if we have seen any ids listed as parents that haven't
1385 # appeared in the list
1386 closevarcs $view
1387 notbusy $view
7fcc92bf 1388 }
098dd8a3 1389 if {$view == $curview} {
ac1276ab 1390 run chewcommits
9a40c50c 1391 }
7eb3cb9c 1392 return 0
9a40c50c 1393 }
b490a991 1394 set start 0
8f7d0cec 1395 set gotsome 0
7fcc92bf 1396 set scripts {}
b490a991
PM
1397 while 1 {
1398 set i [string first "\0" $stuff $start]
1399 if {$i < 0} {
7fcc92bf 1400 append leftover($inst) [string range $stuff $start end]
9f1afe05 1401 break
9ccbdfbf 1402 }
b490a991 1403 if {$start == 0} {
7fcc92bf 1404 set cmit $leftover($inst)
8f7d0cec 1405 append cmit [string range $stuff 0 [expr {$i - 1}]]
7fcc92bf 1406 set leftover($inst) {}
8f7d0cec
PM
1407 } else {
1408 set cmit [string range $stuff $start [expr {$i - 1}]]
b490a991
PM
1409 }
1410 set start [expr {$i + 1}]
e5ea701b
PM
1411 set j [string first "\n" $cmit]
1412 set ok 0
16c1ff96 1413 set listed 1
c961b228
PM
1414 if {$j >= 0 && [string match "commit *" $cmit]} {
1415 set ids [string range $cmit 7 [expr {$j - 1}]]
1407ade9 1416 if {[string match {[-^<>]*} $ids]} {
c961b228
PM
1417 switch -- [string index $ids 0] {
1418 "-" {set listed 0}
1407ade9
LT
1419 "^" {set listed 2}
1420 "<" {set listed 3}
1421 ">" {set listed 4}
c961b228 1422 }
16c1ff96
PM
1423 set ids [string range $ids 1 end]
1424 }
e5ea701b
PM
1425 set ok 1
1426 foreach id $ids {
8f7d0cec 1427 if {[string length $id] != 40} {
e5ea701b
PM
1428 set ok 0
1429 break
1430 }
1431 }
1432 }
1433 if {!$ok} {
7e952e79
PM
1434 set shortcmit $cmit
1435 if {[string length $shortcmit] > 80} {
1436 set shortcmit "[string range $shortcmit 0 80]..."
1437 }
d990cedf 1438 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
b490a991
PM
1439 exit 1
1440 }
e5ea701b 1441 set id [lindex $ids 0]
7fcc92bf 1442 set vid $view,$id
f806f0fb
PM
1443
1444 if {!$listed && $updating && ![info exists varcid($vid)] &&
3ed31a81 1445 $vfilelimit($view) ne {}} {
f806f0fb
PM
1446 # git log doesn't rewrite parents for unlisted commits
1447 # when doing path limiting, so work around that here
1448 # by working out the rewritten parent with git rev-list
1449 # and if we already know about it, using the rewritten
1450 # parent as a substitute parent for $id's children.
1451 if {![catch {
1452 set rwid [exec git rev-list --first-parent --max-count=1 \
3ed31a81 1453 $id -- $vfilelimit($view)]
f806f0fb
PM
1454 }]} {
1455 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1456 # use $rwid in place of $id
1457 rewrite_commit $view $id $rwid
1458 continue
1459 }
1460 }
1461 }
1462
f1bf4ee6
PM
1463 set a 0
1464 if {[info exists varcid($vid)]} {
1465 if {$cmitlisted($vid) || !$listed} continue
1466 set a $varcid($vid)
1467 }
16c1ff96
PM
1468 if {$listed} {
1469 set olds [lrange $ids 1 end]
16c1ff96
PM
1470 } else {
1471 set olds {}
1472 }
f7a3e8d2 1473 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
7fcc92bf
PM
1474 set cmitlisted($vid) $listed
1475 set parents($vid) $olds
7fcc92bf
PM
1476 if {![info exists children($vid)]} {
1477 set children($vid) {}
f1bf4ee6 1478 } elseif {$a == 0 && [llength $children($vid)] == 1} {
f3ea5ede
PM
1479 set k [lindex $children($vid) 0]
1480 if {[llength $parents($view,$k)] == 1 &&
3ed31a81 1481 (!$vdatemode($view) ||
f3ea5ede
PM
1482 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1483 set a $varcid($view,$k)
7fcc92bf 1484 }
da7c24dd 1485 }
7fcc92bf
PM
1486 if {$a == 0} {
1487 # new arc
1488 set a [newvarc $view $id]
1489 }
e5b37ac1
PM
1490 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1491 modify_arc $view $a
1492 }
f1bf4ee6
PM
1493 if {![info exists varcid($vid)]} {
1494 set varcid($vid) $a
1495 lappend varccommits($view,$a) $id
1496 incr commitidx($view)
1497 }
e5b37ac1 1498
7fcc92bf
PM
1499 set i 0
1500 foreach p $olds {
1501 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1502 set vp $view,$p
1503 if {[llength [lappend children($vp) $id]] > 1 &&
1504 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1505 set children($vp) [lsort -command [list vtokcmp $view] \
1506 $children($vp)]
9257d8f7 1507 catch {unset ordertok}
7fcc92bf 1508 }
f3ea5ede
PM
1509 if {[info exists varcid($view,$p)]} {
1510 fix_reversal $p $a $view
1511 }
7fcc92bf
PM
1512 }
1513 incr i
1514 }
7fcc92bf 1515
d375ef9b 1516 set scripts [check_interest $id $scripts]
8f7d0cec
PM
1517 set gotsome 1
1518 }
1519 if {$gotsome} {
ac1276ab
PM
1520 global numcommits hlview
1521
1522 if {$view == $curview} {
1523 set numcommits $commitidx($view)
1524 run chewcommits
1525 }
1526 if {[info exists hlview] && $view == $hlview} {
1527 # we never actually get here...
1528 run vhighlightmore
1529 }
7fcc92bf
PM
1530 foreach s $scripts {
1531 eval $s
1532 }
9ccbdfbf 1533 }
7eb3cb9c 1534 return 2
9ccbdfbf
PM
1535}
1536
ac1276ab 1537proc chewcommits {} {
f5f3c2e2 1538 global curview hlview viewcomplete
7fcc92bf 1539 global pending_select
7eb3cb9c 1540
ac1276ab
PM
1541 layoutmore
1542 if {$viewcomplete($curview)} {
1543 global commitidx varctok
1544 global numcommits startmsecs
ac1276ab
PM
1545
1546 if {[info exists pending_select]} {
835e62ae
AG
1547 update
1548 reset_pending_select {}
1549
1550 if {[commitinview $pending_select $curview]} {
1551 selectline [rowofcommit $pending_select] 1
1552 } else {
1553 set row [first_real_row]
1554 selectline $row 1
1555 }
7eb3cb9c 1556 }
ac1276ab
PM
1557 if {$commitidx($curview) > 0} {
1558 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1559 #puts "overall $ms ms for $numcommits commits"
1560 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1561 } else {
1562 show_status [mc "No commits selected"]
1563 }
1564 notbusy layout
b664550c 1565 }
f5f3c2e2 1566 return 0
1db95b00
PM
1567}
1568
590915da
AG
1569proc do_readcommit {id} {
1570 global tclencoding
1571
1572 # Invoke git-log to handle automatic encoding conversion
1573 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1574 # Read the results using i18n.logoutputencoding
1575 fconfigure $fd -translation lf -eofchar {}
1576 if {$tclencoding != {}} {
1577 fconfigure $fd -encoding $tclencoding
1578 }
1579 set contents [read $fd]
1580 close $fd
1581 # Remove the heading line
1582 regsub {^commit [0-9a-f]+\n} $contents {} contents
1583
1584 return $contents
1585}
1586
1db95b00 1587proc readcommit {id} {
590915da
AG
1588 if {[catch {set contents [do_readcommit $id]}]} return
1589 parsecommit $id $contents 1
b490a991
PM
1590}
1591
8f7d0cec 1592proc parsecommit {id contents listed} {
b5c2f306
SV
1593 global commitinfo cdate
1594
1595 set inhdr 1
1596 set comment {}
1597 set headline {}
1598 set auname {}
1599 set audate {}
1600 set comname {}
1601 set comdate {}
232475d3
PM
1602 set hdrend [string first "\n\n" $contents]
1603 if {$hdrend < 0} {
1604 # should never happen...
1605 set hdrend [string length $contents]
1606 }
1607 set header [string range $contents 0 [expr {$hdrend - 1}]]
1608 set comment [string range $contents [expr {$hdrend + 2}] end]
1609 foreach line [split $header "\n"] {
61f57cb0 1610 set line [split $line " "]
232475d3
PM
1611 set tag [lindex $line 0]
1612 if {$tag == "author"} {
1613 set audate [lindex $line end-1]
61f57cb0 1614 set auname [join [lrange $line 1 end-2] " "]
232475d3
PM
1615 } elseif {$tag == "committer"} {
1616 set comdate [lindex $line end-1]
61f57cb0 1617 set comname [join [lrange $line 1 end-2] " "]
1db95b00
PM
1618 }
1619 }
232475d3 1620 set headline {}
43c25074
PM
1621 # take the first non-blank line of the comment as the headline
1622 set headline [string trimleft $comment]
1623 set i [string first "\n" $headline]
232475d3 1624 if {$i >= 0} {
43c25074
PM
1625 set headline [string range $headline 0 $i]
1626 }
1627 set headline [string trimright $headline]
1628 set i [string first "\r" $headline]
1629 if {$i >= 0} {
1630 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
1631 }
1632 if {!$listed} {
f9e0b6fb 1633 # git log indents the comment by 4 spaces;
8974c6f9 1634 # if we got this via git cat-file, add the indentation
232475d3
PM
1635 set newcomment {}
1636 foreach line [split $comment "\n"] {
1637 append newcomment " "
1638 append newcomment $line
f6e2869f 1639 append newcomment "\n"
232475d3
PM
1640 }
1641 set comment $newcomment
1db95b00
PM
1642 }
1643 if {$comdate != {}} {
cfb4563c 1644 set cdate($id) $comdate
1db95b00 1645 }
e5c2d856
PM
1646 set commitinfo($id) [list $headline $auname $audate \
1647 $comname $comdate $comment]
1db95b00
PM
1648}
1649
f7a3e8d2 1650proc getcommit {id} {
79b2c75e 1651 global commitdata commitinfo
8ed16484 1652
f7a3e8d2
PM
1653 if {[info exists commitdata($id)]} {
1654 parsecommit $id $commitdata($id) 1
8ed16484
PM
1655 } else {
1656 readcommit $id
1657 if {![info exists commitinfo($id)]} {
d990cedf 1658 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
1659 }
1660 }
1661 return 1
1662}
1663
d375ef9b
PM
1664# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1665# and are present in the current view.
1666# This is fairly slow...
1667proc longid {prefix} {
1668 global varcid curview
1669
1670 set ids {}
1671 foreach match [array names varcid "$curview,$prefix*"] {
1672 lappend ids [lindex [split $match ","] 1]
1673 }
1674 return $ids
1675}
1676
887fe3c4 1677proc readrefs {} {
62d3ea65 1678 global tagids idtags headids idheads tagobjid
219ea3a9 1679 global otherrefids idotherrefs mainhead mainheadid
39816d60 1680 global selecthead selectheadid
106288cb 1681
b5c2f306
SV
1682 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1683 catch {unset $v}
1684 }
62d3ea65
PM
1685 set refd [open [list | git show-ref -d] r]
1686 while {[gets $refd line] >= 0} {
1687 if {[string index $line 40] ne " "} continue
1688 set id [string range $line 0 39]
1689 set ref [string range $line 41 end]
1690 if {![string match "refs/*" $ref]} continue
1691 set name [string range $ref 5 end]
1692 if {[string match "remotes/*" $name]} {
1693 if {![string match "*/HEAD" $name]} {
1694 set headids($name) $id
1695 lappend idheads($id) $name
f1d83ba3 1696 }
62d3ea65
PM
1697 } elseif {[string match "heads/*" $name]} {
1698 set name [string range $name 6 end]
36a7cad6
JH
1699 set headids($name) $id
1700 lappend idheads($id) $name
62d3ea65
PM
1701 } elseif {[string match "tags/*" $name]} {
1702 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1703 # which is what we want since the former is the commit ID
1704 set name [string range $name 5 end]
1705 if {[string match "*^{}" $name]} {
1706 set name [string range $name 0 end-3]
1707 } else {
1708 set tagobjid($name) $id
1709 }
1710 set tagids($name) $id
1711 lappend idtags($id) $name
36a7cad6
JH
1712 } else {
1713 set otherrefids($name) $id
1714 lappend idotherrefs($id) $name
f1d83ba3
PM
1715 }
1716 }
062d671f 1717 catch {close $refd}
8a48571c 1718 set mainhead {}
219ea3a9 1719 set mainheadid {}
8a48571c 1720 catch {
c11ff120 1721 set mainheadid [exec git rev-parse HEAD]
8a48571c
PM
1722 set thehead [exec git symbolic-ref HEAD]
1723 if {[string match "refs/heads/*" $thehead]} {
1724 set mainhead [string range $thehead 11 end]
1725 }
1726 }
39816d60
AG
1727 set selectheadid {}
1728 if {$selecthead ne {}} {
1729 catch {
1730 set selectheadid [exec git rev-parse --verify $selecthead]
1731 }
1732 }
887fe3c4
PM
1733}
1734
8f489363
PM
1735# skip over fake commits
1736proc first_real_row {} {
7fcc92bf 1737 global nullid nullid2 numcommits
8f489363
PM
1738
1739 for {set row 0} {$row < $numcommits} {incr row} {
7fcc92bf 1740 set id [commitonrow $row]
8f489363
PM
1741 if {$id ne $nullid && $id ne $nullid2} {
1742 break
1743 }
1744 }
1745 return $row
1746}
1747
e11f1233
PM
1748# update things for a head moved to a child of its previous location
1749proc movehead {id name} {
1750 global headids idheads
1751
1752 removehead $headids($name) $name
1753 set headids($name) $id
1754 lappend idheads($id) $name
1755}
1756
1757# update things when a head has been removed
1758proc removehead {id name} {
1759 global headids idheads
1760
1761 if {$idheads($id) eq $name} {
1762 unset idheads($id)
1763 } else {
1764 set i [lsearch -exact $idheads($id) $name]
1765 if {$i >= 0} {
1766 set idheads($id) [lreplace $idheads($id) $i $i]
1767 }
1768 }
1769 unset headids($name)
1770}
1771
d93f1713
PT
1772proc ttk_toplevel {w args} {
1773 global use_ttk
1774 eval [linsert $args 0 ::toplevel $w]
1775 if {$use_ttk} {
1776 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1777 }
1778 return $w
1779}
1780
e7d64008
AG
1781proc make_transient {window origin} {
1782 global have_tk85
1783
1784 # In MacOS Tk 8.4 transient appears to work by setting
1785 # overrideredirect, which is utterly useless, since the
1786 # windows get no border, and are not even kept above
1787 # the parent.
1788 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1789
1790 wm transient $window $origin
1791
1792 # Windows fails to place transient windows normally, so
1793 # schedule a callback to center them on the parent.
1794 if {[tk windowingsystem] eq {win32}} {
1795 after idle [list tk::PlaceWindow $window widget $origin]
1796 }
1797}
1798
e54be9e3 1799proc show_error {w top msg} {
d93f1713 1800 global NS
3cb1f9c9 1801 if {![info exists NS]} {set NS ""}
d93f1713 1802 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
df3d83b1
PM
1803 message $w.m -text $msg -justify center -aspect 400
1804 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1805 ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
df3d83b1 1806 pack $w.ok -side bottom -fill x
e54be9e3
PM
1807 bind $top <Visibility> "grab $top; focus $top"
1808 bind $top <Key-Return> "destroy $top"
76f15947
AG
1809 bind $top <Key-space> "destroy $top"
1810 bind $top <Key-Escape> "destroy $top"
e54be9e3 1811 tkwait window $top
df3d83b1
PM
1812}
1813
84a76f18 1814proc error_popup {msg {owner .}} {
d93f1713
PT
1815 if {[tk windowingsystem] eq "win32"} {
1816 tk_messageBox -icon error -type ok -title [wm title .] \
1817 -parent $owner -message $msg
1818 } else {
1819 set w .error
1820 ttk_toplevel $w
1821 make_transient $w $owner
1822 show_error $w $w $msg
1823 }
098dd8a3
PM
1824}
1825
84a76f18 1826proc confirm_popup {msg {owner .}} {
d93f1713 1827 global confirm_ok NS
10299152
PM
1828 set confirm_ok 0
1829 set w .confirm
d93f1713 1830 ttk_toplevel $w
e7d64008 1831 make_transient $w $owner
10299152
PM
1832 message $w.m -text $msg -justify center -aspect 400
1833 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1834 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1835 pack $w.ok -side left -fill x
d93f1713 1836 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1837 pack $w.cancel -side right -fill x
1838 bind $w <Visibility> "grab $w; focus $w"
76f15947
AG
1839 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1840 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1841 bind $w <Key-Escape> "destroy $w"
d93f1713 1842 tk::PlaceWindow $w widget $owner
10299152
PM
1843 tkwait window $w
1844 return $confirm_ok
1845}
1846
b039f0a6 1847proc setoptions {} {
d93f1713
PT
1848 if {[tk windowingsystem] ne "win32"} {
1849 option add *Panedwindow.showHandle 1 startupFile
1850 option add *Panedwindow.sashRelief raised startupFile
1851 if {[tk windowingsystem] ne "aqua"} {
1852 option add *Menu.font uifont startupFile
1853 }
1854 } else {
1855 option add *Menu.TearOff 0 startupFile
1856 }
b039f0a6
PM
1857 option add *Button.font uifont startupFile
1858 option add *Checkbutton.font uifont startupFile
1859 option add *Radiobutton.font uifont startupFile
b039f0a6
PM
1860 option add *Menubutton.font uifont startupFile
1861 option add *Label.font uifont startupFile
1862 option add *Message.font uifont startupFile
1863 option add *Entry.font uifont startupFile
d93f1713 1864 option add *Labelframe.font uifont startupFile
b039f0a6
PM
1865}
1866
79056034
PM
1867# Make a menu and submenus.
1868# m is the window name for the menu, items is the list of menu items to add.
1869# Each item is a list {mc label type description options...}
1870# mc is ignored; it's so we can put mc there to alert xgettext
1871# label is the string that appears in the menu
1872# type is cascade, command or radiobutton (should add checkbutton)
1873# description depends on type; it's the sublist for cascade, the
1874# command to invoke for command, or {variable value} for radiobutton
f2d0bbbd
PM
1875proc makemenu {m items} {
1876 menu $m
cea07cf8
AG
1877 if {[tk windowingsystem] eq {aqua}} {
1878 set Meta1 Cmd
1879 } else {
1880 set Meta1 Ctrl
1881 }
f2d0bbbd 1882 foreach i $items {
79056034
PM
1883 set name [mc [lindex $i 1]]
1884 set type [lindex $i 2]
1885 set thing [lindex $i 3]
f2d0bbbd
PM
1886 set params [list $type]
1887 if {$name ne {}} {
1888 set u [string first "&" [string map {&& x} $name]]
1889 lappend params -label [string map {&& & & {}} $name]
1890 if {$u >= 0} {
1891 lappend params -underline $u
1892 }
1893 }
1894 switch -- $type {
1895 "cascade" {
79056034 1896 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
f2d0bbbd
PM
1897 lappend params -menu $m.$submenu
1898 }
1899 "command" {
1900 lappend params -command $thing
1901 }
1902 "radiobutton" {
1903 lappend params -variable [lindex $thing 0] \
1904 -value [lindex $thing 1]
1905 }
1906 }
cea07cf8
AG
1907 set tail [lrange $i 4 end]
1908 regsub -all {\yMeta1\y} $tail $Meta1 tail
1909 eval $m add $params $tail
f2d0bbbd
PM
1910 if {$type eq "cascade"} {
1911 makemenu $m.$submenu $thing
1912 }
1913 }
1914}
1915
1916# translate string and remove ampersands
1917proc mca {str} {
1918 return [string map {&& & & {}} [mc $str]]
1919}
1920
d93f1713
PT
1921proc makedroplist {w varname args} {
1922 global use_ttk
1923 if {$use_ttk} {
3cb1f9c9
PT
1924 set width 0
1925 foreach label $args {
1926 set cx [string length $label]
1927 if {$cx > $width} {set width $cx}
1928 }
1929 set gm [ttk::combobox $w -width $width -state readonly\
d93f1713
PT
1930 -textvariable $varname -values $args]
1931 } else {
1932 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
1933 }
1934 return $gm
1935}
1936
d94f8cd6 1937proc makewindow {} {
31c0eaa8 1938 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 1939 global tabstop
b74fd579 1940 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 1941 global entries sha1entry sha1string sha1but
890fae70 1942 global diffcontextstring diffcontext
b9b86007 1943 global ignorespace
94a2eede 1944 global maincursor textcursor curtextcursor
219ea3a9 1945 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 1946 global highlight_files gdttype
3ea06f9f 1947 global searchstring sstring
60378c0c 1948 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
bb3edc8b
PM
1949 global headctxmenu progresscanv progressitem progresscoords statusw
1950 global fprogitem fprogcoord lastprogupdate progupdatepending
6df7403a 1951 global rprogitem rprogcoord rownumsel numcommits
d93f1713 1952 global have_tk85 use_ttk NS
9a40c50c 1953
79056034
PM
1954 # The "mc" arguments here are purely so that xgettext
1955 # sees the following string as needing to be translated
5fdcbb13
DS
1956 set file {
1957 mc "File" cascade {
79056034 1958 {mc "Update" command updatecommits -accelerator F5}
cea07cf8 1959 {mc "Reload" command reloadcommits -accelerator Meta1-F5}
79056034 1960 {mc "Reread references" command rereadrefs}
cea07cf8 1961 {mc "List references" command showrefs -accelerator F2}
7fb0abb1
AG
1962 {xx "" separator}
1963 {mc "Start git gui" command {exec git gui &}}
1964 {xx "" separator}
cea07cf8 1965 {mc "Quit" command doquit -accelerator Meta1-Q}
f2d0bbbd 1966 }}
5fdcbb13
DS
1967 set edit {
1968 mc "Edit" cascade {
79056034 1969 {mc "Preferences" command doprefs}
f2d0bbbd 1970 }}
5fdcbb13
DS
1971 set view {
1972 mc "View" cascade {
cea07cf8
AG
1973 {mc "New view..." command {newview 0} -accelerator Shift-F4}
1974 {mc "Edit view..." command editview -state disabled -accelerator F4}
79056034
PM
1975 {mc "Delete view" command delview -state disabled}
1976 {xx "" separator}
1977 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
f2d0bbbd 1978 }}
5fdcbb13
DS
1979 if {[tk windowingsystem] ne "aqua"} {
1980 set help {
1981 mc "Help" cascade {
79056034
PM
1982 {mc "About gitk" command about}
1983 {mc "Key bindings" command keys}
f2d0bbbd 1984 }}
5fdcbb13
DS
1985 set bar [list $file $edit $view $help]
1986 } else {
1987 proc ::tk::mac::ShowPreferences {} {doprefs}
1988 proc ::tk::mac::Quit {} {doquit}
1989 lset file end [lreplace [lindex $file end] end-1 end]
1990 set apple {
1991 xx "Apple" cascade {
79056034 1992 {mc "About gitk" command about}
5fdcbb13
DS
1993 {xx "" separator}
1994 }}
1995 set help {
1996 mc "Help" cascade {
79056034 1997 {mc "Key bindings" command keys}
f2d0bbbd 1998 }}
5fdcbb13 1999 set bar [list $apple $file $view $help]
f2d0bbbd 2000 }
5fdcbb13 2001 makemenu .bar $bar
9a40c50c
PM
2002 . configure -menu .bar
2003
d93f1713
PT
2004 if {$use_ttk} {
2005 # cover the non-themed toplevel with a themed frame.
2006 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2007 }
2008
e9937d2a 2009 # the gui has upper and lower half, parts of a paned window.
d93f1713 2010 ${NS}::panedwindow .ctop -orient vertical
e9937d2a
JH
2011
2012 # possibly use assumed geometry
9ca72f4f 2013 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
2014 set geometry(topheight) [expr {15 * $linespc}]
2015 set geometry(topwidth) [expr {80 * $charspc}]
2016 set geometry(botheight) [expr {15 * $linespc}]
2017 set geometry(botwidth) [expr {50 * $charspc}]
d93f1713
PT
2018 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2019 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
e9937d2a
JH
2020 }
2021
2022 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
d93f1713
PT
2023 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2024 ${NS}::frame .tf.histframe
2025 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2026 if {!$use_ttk} {
2027 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2028 }
e9937d2a
JH
2029
2030 # create three canvases
2031 set cscroll .tf.histframe.csb
2032 set canv .tf.histframe.pwclist.canv
9ca72f4f 2033 canvas $canv \
60378c0c 2034 -selectbackground $selectbgcolor \
f8a2c0d1 2035 -background $bgcolor -bd 0 \
9f1afe05 2036 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
2037 .tf.histframe.pwclist add $canv
2038 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 2039 canvas $canv2 \
60378c0c 2040 -selectbackground $selectbgcolor \
f8a2c0d1 2041 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
2042 .tf.histframe.pwclist add $canv2
2043 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 2044 canvas $canv3 \
60378c0c 2045 -selectbackground $selectbgcolor \
f8a2c0d1 2046 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 2047 .tf.histframe.pwclist add $canv3
d93f1713
PT
2048 if {$use_ttk} {
2049 bind .tf.histframe.pwclist <Map> {
2050 bind %W <Map> {}
2051 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2052 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2053 }
2054 } else {
2055 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2056 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2057 }
e9937d2a
JH
2058
2059 # a scroll bar to rule them
d93f1713
PT
2060 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2061 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
e9937d2a
JH
2062 pack $cscroll -side right -fill y
2063 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 2064 lappend bglist $canv $canv2 $canv3
e9937d2a 2065 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 2066
e9937d2a 2067 # we have two button bars at bottom of top frame. Bar 1
d93f1713
PT
2068 ${NS}::frame .tf.bar
2069 ${NS}::frame .tf.lbar -height 15
e9937d2a
JH
2070
2071 set sha1entry .tf.bar.sha1
887fe3c4 2072 set entries $sha1entry
e9937d2a 2073 set sha1but .tf.bar.sha1label
d990cedf 2074 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
b039f0a6 2075 -command gotocommit -width 8
887fe3c4 2076 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 2077 pack .tf.bar.sha1label -side left
d93f1713 2078 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 2079 trace add variable sha1string write sha1change
98f350e5 2080 pack $sha1entry -side left -pady 2
d698206c
PM
2081
2082 image create bitmap bm-left -data {
2083 #define left_width 16
2084 #define left_height 16
2085 static unsigned char left_bits[] = {
2086 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2087 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2088 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2089 }
2090 image create bitmap bm-right -data {
2091 #define right_width 16
2092 #define right_height 16
2093 static unsigned char right_bits[] = {
2094 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2095 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2096 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2097 }
d93f1713 2098 ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
d698206c 2099 -state disabled -width 26
e9937d2a 2100 pack .tf.bar.leftbut -side left -fill y
d93f1713 2101 ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
d698206c 2102 -state disabled -width 26
e9937d2a 2103 pack .tf.bar.rightbut -side left -fill y
d698206c 2104
d93f1713 2105 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
6df7403a 2106 set rownumsel {}
d93f1713 2107 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
6df7403a 2108 -relief sunken -anchor e
d93f1713
PT
2109 ${NS}::label .tf.bar.rowlabel2 -text "/"
2110 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
6df7403a
PM
2111 -relief sunken -anchor e
2112 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2113 -side left
d93f1713
PT
2114 if {!$use_ttk} {
2115 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2116 }
6df7403a 2117 global selectedline
94b4a69f 2118 trace add variable selectedline write selectedline_change
6df7403a 2119
bb3edc8b
PM
2120 # Status label and progress bar
2121 set statusw .tf.bar.status
d93f1713 2122 ${NS}::label $statusw -width 15 -relief sunken
bb3edc8b 2123 pack $statusw -side left -padx 5
d93f1713
PT
2124 if {$use_ttk} {
2125 set progresscanv [ttk::progressbar .tf.bar.progress]
2126 } else {
2127 set h [expr {[font metrics uifont -linespace] + 2}]
2128 set progresscanv .tf.bar.progress
2129 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2130 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2131 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2132 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2133 }
2134 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
bb3edc8b
PM
2135 set progresscoords {0 0}
2136 set fprogcoord 0
a137a90f 2137 set rprogcoord 0
bb3edc8b
PM
2138 bind $progresscanv <Configure> adjustprogress
2139 set lastprogupdate [clock clicks -milliseconds]
2140 set progupdatepending 0
2141
687c8765 2142 # build up the bottom bar of upper window
d93f1713
PT
2143 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2144 ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2145 ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2146 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
687c8765
PM
2147 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2148 -side left -fill y
b007ee20 2149 set gdttype [mc "containing:"]
3cb1f9c9 2150 set gm [makedroplist .tf.lbar.gdttype gdttype \
b007ee20
CS
2151 [mc "containing:"] \
2152 [mc "touching paths:"] \
2153 [mc "adding/removing string:"]]
687c8765 2154 trace add variable gdttype write gdttype_change
687c8765
PM
2155 pack .tf.lbar.gdttype -side left -fill y
2156
98f350e5 2157 set findstring {}
687c8765 2158 set fstring .tf.lbar.findstring
887fe3c4 2159 lappend entries $fstring
d93f1713 2160 ${NS}::entry $fstring -width 30 -font textfont -textvariable findstring
60f7a7dc 2161 trace add variable findstring write find_change
b007ee20 2162 set findtype [mc "Exact"]
d93f1713
PT
2163 set findtypemenu [makedroplist .tf.lbar.findtype \
2164 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 2165 trace add variable findtype write findcom_change
b007ee20 2166 set findloc [mc "All fields"]
d93f1713 2167 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
b007ee20 2168 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 2169 trace add variable findloc write find_change
687c8765
PM
2170 pack .tf.lbar.findloc -side right
2171 pack .tf.lbar.findtype -side right
2172 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
2173
2174 # Finish putting the upper half of the viewer together
2175 pack .tf.lbar -in .tf -side bottom -fill x
2176 pack .tf.bar -in .tf -side bottom -fill x
2177 pack .tf.histframe -fill both -side top -expand 1
2178 .ctop add .tf
d93f1713
PT
2179 if {!$use_ttk} {
2180 .ctop paneconfigure .tf -height $geometry(topheight)
2181 .ctop paneconfigure .tf -width $geometry(topwidth)
2182 }
e9937d2a
JH
2183
2184 # now build up the bottom
d93f1713 2185 ${NS}::panedwindow .pwbottom -orient horizontal
e9937d2a
JH
2186
2187 # lower left, a text box over search bar, scroll bar to the right
2188 # if we know window height, then that will set the lower text height, otherwise
2189 # we set lower text height which will drive window height
2190 if {[info exists geometry(main)]} {
d93f1713 2191 ${NS}::frame .bleft -width $geometry(botwidth)
e9937d2a 2192 } else {
d93f1713 2193 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
e9937d2a 2194 }
d93f1713
PT
2195 ${NS}::frame .bleft.top
2196 ${NS}::frame .bleft.mid
2197 ${NS}::frame .bleft.bottom
e9937d2a 2198
d93f1713 2199 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
2200 pack .bleft.top.search -side left -padx 5
2201 set sstring .bleft.top.sstring
d93f1713
PT
2202 set searchstring ""
2203 ${NS}::entry $sstring -width 20 -font textfont -textvariable searchstring
3ea06f9f
PM
2204 lappend entries $sstring
2205 trace add variable searchstring write incrsearch
2206 pack $sstring -side left -expand 1 -fill x
d93f1713 2207 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 2208 -command changediffdisp -variable diffelide -value {0 0}
d93f1713 2209 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 2210 -command changediffdisp -variable diffelide -value {0 1}
d93f1713 2211 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 2212 -command changediffdisp -variable diffelide -value {1 0}
d93f1713 2213 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
a8d610a2 2214 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
9c311b32 2215 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
890fae70
SP
2216 -from 1 -increment 1 -to 10000000 \
2217 -validate all -validatecommand "diffcontextvalidate %P" \
2218 -textvariable diffcontextstring
2219 .bleft.mid.diffcontext set $diffcontext
2220 trace add variable diffcontextstring write diffcontextchange
2221 lappend entries .bleft.mid.diffcontext
2222 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
d93f1713 2223 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
b9b86007
SP
2224 -command changeignorespace -variable ignorespace
2225 pack .bleft.mid.ignspace -side left -padx 5
8809d691 2226 set ctext .bleft.bottom.ctext
f8a2c0d1 2227 text $ctext -background $bgcolor -foreground $fgcolor \
9c311b32 2228 -state disabled -font textfont \
8809d691
PK
2229 -yscrollcommand scrolltext -wrap none \
2230 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4
PM
2231 if {$have_tk85} {
2232 $ctext conf -tabstyle wordprocessor
2233 }
d93f1713
PT
2234 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2235 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
e9937d2a 2236 pack .bleft.top -side top -fill x
a8d610a2 2237 pack .bleft.mid -side top -fill x
8809d691
PK
2238 grid $ctext .bleft.bottom.sb -sticky nsew
2239 grid .bleft.bottom.sbhorizontal -sticky ew
2240 grid columnconfigure .bleft.bottom 0 -weight 1
2241 grid rowconfigure .bleft.bottom 0 -weight 1
2242 grid rowconfigure .bleft.bottom 1 -weight 0
2243 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
2244 lappend bglist $ctext
2245 lappend fglist $ctext
d2610d11 2246
f1b86294 2247 $ctext tag conf comment -wrap $wrapcomment
9c311b32 2248 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
f8a2c0d1
PM
2249 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2250 $ctext tag conf d0 -fore [lindex $diffcolors 0]
8b07dca1 2251 $ctext tag conf dresult -fore [lindex $diffcolors 1]
712fcc08
PM
2252 $ctext tag conf m0 -fore red
2253 $ctext tag conf m1 -fore blue
2254 $ctext tag conf m2 -fore green
2255 $ctext tag conf m3 -fore purple
2256 $ctext tag conf m4 -fore brown
b77b0278
PM
2257 $ctext tag conf m5 -fore "#009090"
2258 $ctext tag conf m6 -fore magenta
2259 $ctext tag conf m7 -fore "#808000"
2260 $ctext tag conf m8 -fore "#009000"
2261 $ctext tag conf m9 -fore "#ff0080"
2262 $ctext tag conf m10 -fore cyan
2263 $ctext tag conf m11 -fore "#b07070"
2264 $ctext tag conf m12 -fore "#70b0f0"
2265 $ctext tag conf m13 -fore "#70f0b0"
2266 $ctext tag conf m14 -fore "#f0b070"
2267 $ctext tag conf m15 -fore "#ff70b0"
712fcc08 2268 $ctext tag conf mmax -fore darkgrey
b77b0278 2269 set mergemax 16
9c311b32
PM
2270 $ctext tag conf mresult -font textfontbold
2271 $ctext tag conf msep -font textfontbold
712fcc08 2272 $ctext tag conf found -back yellow
e5c2d856 2273
e9937d2a 2274 .pwbottom add .bleft
d93f1713
PT
2275 if {!$use_ttk} {
2276 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2277 }
e9937d2a
JH
2278
2279 # lower right
d93f1713
PT
2280 ${NS}::frame .bright
2281 ${NS}::frame .bright.mode
2282 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 2283 -command reselectline -variable cmitmode -value "patch"
d93f1713 2284 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 2285 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
2286 grid .bright.mode.patch .bright.mode.tree -sticky ew
2287 pack .bright.mode -side top -fill x
2288 set cflist .bright.cfiles
9c311b32 2289 set indent [font measure mainfont "nn"]
e9937d2a 2290 text $cflist \
60378c0c 2291 -selectbackground $selectbgcolor \
f8a2c0d1 2292 -background $bgcolor -foreground $fgcolor \
9c311b32 2293 -font mainfont \
7fcceed7 2294 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 2295 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
2296 -cursor [. cget -cursor] \
2297 -spacing1 1 -spacing3 1
f8a2c0d1
PM
2298 lappend bglist $cflist
2299 lappend fglist $cflist
d93f1713 2300 ${NS}::scrollbar .bright.sb -command "$cflist yview"
e9937d2a 2301 pack .bright.sb -side right -fill y
d2610d11 2302 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
2303 $cflist tag configure highlight \
2304 -background [$cflist cget -selectbackground]
9c311b32 2305 $cflist tag configure bold -font mainfontbold
d2610d11 2306
e9937d2a
JH
2307 .pwbottom add .bright
2308 .ctop add .pwbottom
1db95b00 2309
b9bee115 2310 # restore window width & height if known
e9937d2a 2311 if {[info exists geometry(main)]} {
b9bee115
PM
2312 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2313 if {$w > [winfo screenwidth .]} {
2314 set w [winfo screenwidth .]
2315 }
2316 if {$h > [winfo screenheight .]} {
2317 set h [winfo screenheight .]
2318 }
2319 wm geometry . "${w}x$h"
2320 }
e9937d2a
JH
2321 }
2322
c876dbad
PT
2323 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2324 wm state . $geometry(state)
2325 }
2326
d23d98d3
SP
2327 if {[tk windowingsystem] eq {aqua}} {
2328 set M1B M1
5fdcbb13 2329 set ::BM "3"
d23d98d3
SP
2330 } else {
2331 set M1B Control
5fdcbb13 2332 set ::BM "2"
d23d98d3
SP
2333 }
2334
d93f1713
PT
2335 if {$use_ttk} {
2336 bind .ctop <Map> {
2337 bind %W <Map> {}
2338 %W sashpos 0 $::geometry(topheight)
2339 }
2340 bind .pwbottom <Map> {
2341 bind %W <Map> {}
2342 %W sashpos 0 $::geometry(botwidth)
2343 }
2344 }
2345
e9937d2a
JH
2346 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2347 pack .ctop -fill both -expand 1
c8dfbcf9
PM
2348 bindall <1> {selcanvline %W %x %y}
2349 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
2350 if {[tk windowingsystem] == "win32"} {
2351 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2352 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2353 } else {
2354 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2355 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
5dd57d51
JS
2356 if {[tk windowingsystem] eq "aqua"} {
2357 bindall <MouseWheel> {
2358 set delta [expr {- (%D)}]
2359 allcanvs yview scroll $delta units
2360 }
5fdcbb13
DS
2361 bindall <Shift-MouseWheel> {
2362 set delta [expr {- (%D)}]
2363 $canv xview scroll $delta units
2364 }
5dd57d51 2365 }
314c3093 2366 }
5fdcbb13
DS
2367 bindall <$::BM> "canvscan mark %W %x %y"
2368 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
6e5f7203
RN
2369 bindkey <Home> selfirstline
2370 bindkey <End> sellastline
17386066
PM
2371 bind . <Key-Up> "selnextline -1"
2372 bind . <Key-Down> "selnextline 1"
cca5d946
PM
2373 bind . <Shift-Key-Up> "dofind -1 0"
2374 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
2375 bindkey <Key-Right> "goforw"
2376 bindkey <Key-Left> "goback"
2377 bind . <Key-Prior> "selnextpage -1"
2378 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
2379 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2380 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2381 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2382 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2383 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2384 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
2385 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2386 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2387 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
2388 bindkey p "selnextline -1"
2389 bindkey n "selnextline 1"
6e2dda35
RS
2390 bindkey z "goback"
2391 bindkey x "goforw"
2392 bindkey i "selnextline -1"
2393 bindkey k "selnextline 1"
2394 bindkey j "goback"
2395 bindkey l "goforw"
f4c54b3c 2396 bindkey b prevfile
cfb4563c
PM
2397 bindkey d "$ctext yview scroll 18 units"
2398 bindkey u "$ctext yview scroll -18 units"
97bed034 2399 bindkey / {focus $fstring}
b6e192db 2400 bindkey <Key-KP_Divide> {focus $fstring}
cca5d946
PM
2401 bindkey <Key-Return> {dofind 1 1}
2402 bindkey ? {dofind -1 1}
39ad8570 2403 bindkey f nextfile
cea07cf8
AG
2404 bind . <F5> updatecommits
2405 bind . <$M1B-F5> reloadcommits
2406 bind . <F2> showrefs
2407 bind . <Shift-F4> {newview 0}
2408 catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
2409 bind . <F4> edit_or_newview
d23d98d3 2410 bind . <$M1B-q> doquit
cca5d946
PM
2411 bind . <$M1B-f> {dofind 1 1}
2412 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
2413 bind . <$M1B-r> dosearchback
2414 bind . <$M1B-s> dosearch
2415 bind . <$M1B-equal> {incrfont 1}
646f3a14 2416 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
2417 bind . <$M1B-KP_Add> {incrfont 1}
2418 bind . <$M1B-minus> {incrfont -1}
2419 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 2420 wm protocol . WM_DELETE_WINDOW doquit
e2f90ee4 2421 bind . <Destroy> {stop_backends}
df3d83b1 2422 bind . <Button-1> "click %W"
cca5d946 2423 bind $fstring <Key-Return> {dofind 1 1}
968ce45c 2424 bind $sha1entry <Key-Return> {gotocommit; break}
ee3dc72e 2425 bind $sha1entry <<PasteSelection>> clearsha1
7fcceed7
PM
2426 bind $cflist <1> {sel_flist %W %x %y; break}
2427 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 2428 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
d277e89f
PM
2429 global ctxbut
2430 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
7cdc3556 2431 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
ea13cba1
PM
2432
2433 set maincursor [. cget -cursor]
2434 set textcursor [$ctext cget -cursor]
94a2eede 2435 set curtextcursor $textcursor
84ba7345 2436
c8dfbcf9 2437 set rowctxmenu .rowctxmenu
f2d0bbbd 2438 makemenu $rowctxmenu {
79056034
PM
2439 {mc "Diff this -> selected" command {diffvssel 0}}
2440 {mc "Diff selected -> this" command {diffvssel 1}}
2441 {mc "Make patch" command mkpatch}
2442 {mc "Create tag" command mktag}
2443 {mc "Write commit to file" command writecommit}
2444 {mc "Create new branch" command mkbranch}
2445 {mc "Cherry-pick this commit" command cherrypick}
2446 {mc "Reset HEAD branch to here" command resethead}
b9fdba7f
PM
2447 {mc "Mark this commit" command markhere}
2448 {mc "Return to mark" command gotomark}
2449 {mc "Find descendant of this and mark" command find_common_desc}
010509f2 2450 {mc "Compare with marked commit" command compare_commits}
f2d0bbbd
PM
2451 }
2452 $rowctxmenu configure -tearoff 0
10299152 2453
219ea3a9 2454 set fakerowmenu .fakerowmenu
f2d0bbbd 2455 makemenu $fakerowmenu {
79056034
PM
2456 {mc "Diff this -> selected" command {diffvssel 0}}
2457 {mc "Diff selected -> this" command {diffvssel 1}}
2458 {mc "Make patch" command mkpatch}
f2d0bbbd
PM
2459 }
2460 $fakerowmenu configure -tearoff 0
219ea3a9 2461
10299152 2462 set headctxmenu .headctxmenu
f2d0bbbd 2463 makemenu $headctxmenu {
79056034
PM
2464 {mc "Check out this branch" command cobranch}
2465 {mc "Remove this branch" command rmbranch}
f2d0bbbd
PM
2466 }
2467 $headctxmenu configure -tearoff 0
3244729a
PM
2468
2469 global flist_menu
2470 set flist_menu .flistctxmenu
f2d0bbbd 2471 makemenu $flist_menu {
79056034
PM
2472 {mc "Highlight this too" command {flist_hl 0}}
2473 {mc "Highlight this only" command {flist_hl 1}}
2474 {mc "External diff" command {external_diff}}
2475 {mc "Blame parent commit" command {external_blame 1}}
f2d0bbbd
PM
2476 }
2477 $flist_menu configure -tearoff 0
7cdc3556
AG
2478
2479 global diff_menu
2480 set diff_menu .diffctxmenu
2481 makemenu $diff_menu {
8a897742 2482 {mc "Show origin of this line" command show_line_source}
7cdc3556
AG
2483 {mc "Run git gui blame on this line" command {external_blame_diff}}
2484 }
2485 $diff_menu configure -tearoff 0
df3d83b1
PM
2486}
2487
314c3093
ML
2488# Windows sends all mouse wheel events to the current focused window, not
2489# the one where the mouse hovers, so bind those events here and redirect
2490# to the correct window
2491proc windows_mousewheel_redirector {W X Y D} {
2492 global canv canv2 canv3
2493 set w [winfo containing -displayof $W $X $Y]
2494 if {$w ne ""} {
2495 set u [expr {$D < 0 ? 5 : -5}]
2496 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2497 allcanvs yview scroll $u units
2498 } else {
2499 catch {
2500 $w yview scroll $u units
2501 }
2502 }
2503 }
2504}
2505
6df7403a
PM
2506# Update row number label when selectedline changes
2507proc selectedline_change {n1 n2 op} {
2508 global selectedline rownumsel
2509
94b4a69f 2510 if {$selectedline eq {}} {
6df7403a
PM
2511 set rownumsel {}
2512 } else {
2513 set rownumsel [expr {$selectedline + 1}]
2514 }
2515}
2516
be0cd098
PM
2517# mouse-2 makes all windows scan vertically, but only the one
2518# the cursor is in scans horizontally
2519proc canvscan {op w x y} {
2520 global canv canv2 canv3
2521 foreach c [list $canv $canv2 $canv3] {
2522 if {$c == $w} {
2523 $c scan $op $x $y
2524 } else {
2525 $c scan $op 0 $y
2526 }
2527 }
2528}
2529
9f1afe05
PM
2530proc scrollcanv {cscroll f0 f1} {
2531 $cscroll set $f0 $f1
31c0eaa8 2532 drawvisible
908c3585 2533 flushhighlights
9f1afe05
PM
2534}
2535
df3d83b1
PM
2536# when we make a key binding for the toplevel, make sure
2537# it doesn't get triggered when that key is pressed in the
2538# find string entry widget.
2539proc bindkey {ev script} {
887fe3c4 2540 global entries
df3d83b1
PM
2541 bind . $ev $script
2542 set escript [bind Entry $ev]
2543 if {$escript == {}} {
2544 set escript [bind Entry <Key>]
2545 }
887fe3c4
PM
2546 foreach e $entries {
2547 bind $e $ev "$escript; break"
2548 }
df3d83b1
PM
2549}
2550
2551# set the focus back to the toplevel for any click outside
887fe3c4 2552# the entry widgets
df3d83b1 2553proc click {w} {
bd441de4
ML
2554 global ctext entries
2555 foreach e [concat $entries $ctext] {
887fe3c4 2556 if {$w == $e} return
df3d83b1 2557 }
887fe3c4 2558 focus .
0fba86b3
PM
2559}
2560
bb3edc8b
PM
2561# Adjust the progress bar for a change in requested extent or canvas size
2562proc adjustprogress {} {
2563 global progresscanv progressitem progresscoords
2564 global fprogitem fprogcoord lastprogupdate progupdatepending
d93f1713
PT
2565 global rprogitem rprogcoord use_ttk
2566
2567 if {$use_ttk} {
2568 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2569 return
2570 }
bb3edc8b
PM
2571
2572 set w [expr {[winfo width $progresscanv] - 4}]
2573 set x0 [expr {$w * [lindex $progresscoords 0]}]
2574 set x1 [expr {$w * [lindex $progresscoords 1]}]
2575 set h [winfo height $progresscanv]
2576 $progresscanv coords $progressitem $x0 0 $x1 $h
2577 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 2578 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
2579 set now [clock clicks -milliseconds]
2580 if {$now >= $lastprogupdate + 100} {
2581 set progupdatepending 0
2582 update
2583 } elseif {!$progupdatepending} {
2584 set progupdatepending 1
2585 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2586 }
2587}
2588
2589proc doprogupdate {} {
2590 global lastprogupdate progupdatepending
2591
2592 if {$progupdatepending} {
2593 set progupdatepending 0
2594 set lastprogupdate [clock clicks -milliseconds]
2595 update
2596 }
2597}
2598
0fba86b3 2599proc savestuff {w} {
32f1b3e4 2600 global canv canv2 canv3 mainfont textfont uifont tabstop
712fcc08 2601 global stuffsaved findmergefiles maxgraphpct
219ea3a9 2602 global maxwidth showneartags showlocalchanges
2d480856 2603 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
7a39a17a 2604 global cmitmode wrapcomment datetimeformat limitdiffs
890fae70 2605 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
d93f1713 2606 global autoselect extdifftool perfile_attrs markbgcolor use_ttk
4ef17537 2607
0fba86b3 2608 if {$stuffsaved} return
df3d83b1 2609 if {![winfo viewable .]} return
0fba86b3
PM
2610 catch {
2611 set f [open "~/.gitk-new" w]
9832e4f2
PM
2612 if {$::tcl_platform(platform) eq {windows}} {
2613 file attributes "~/.gitk-new" -hidden true
2614 }
f0654861
PM
2615 puts $f [list set mainfont $mainfont]
2616 puts $f [list set textfont $textfont]
4840be66 2617 puts $f [list set uifont $uifont]
7e12f1a6 2618 puts $f [list set tabstop $tabstop]
f0654861 2619 puts $f [list set findmergefiles $findmergefiles]
8d858d1a 2620 puts $f [list set maxgraphpct $maxgraphpct]
04c13d38 2621 puts $f [list set maxwidth $maxwidth]
f8b28a40 2622 puts $f [list set cmitmode $cmitmode]
f1b86294 2623 puts $f [list set wrapcomment $wrapcomment]
95293b58 2624 puts $f [list set autoselect $autoselect]
b8ab2e17 2625 puts $f [list set showneartags $showneartags]
219ea3a9 2626 puts $f [list set showlocalchanges $showlocalchanges]
e8b5f4be 2627 puts $f [list set datetimeformat $datetimeformat]
7a39a17a 2628 puts $f [list set limitdiffs $limitdiffs]
f8a2c0d1
PM
2629 puts $f [list set bgcolor $bgcolor]
2630 puts $f [list set fgcolor $fgcolor]
2631 puts $f [list set colors $colors]
2632 puts $f [list set diffcolors $diffcolors]
e3e901be 2633 puts $f [list set markbgcolor $markbgcolor]
890fae70 2634 puts $f [list set diffcontext $diffcontext]
60378c0c 2635 puts $f [list set selectbgcolor $selectbgcolor]
314f5de1 2636 puts $f [list set extdifftool $extdifftool]
39ee47ef 2637 puts $f [list set perfile_attrs $perfile_attrs]
e9937d2a 2638
b6047c5a 2639 puts $f "set geometry(main) [wm geometry .]"
c876dbad 2640 puts $f "set geometry(state) [wm state .]"
e9937d2a
JH
2641 puts $f "set geometry(topwidth) [winfo width .tf]"
2642 puts $f "set geometry(topheight) [winfo height .tf]"
d93f1713
PT
2643 if {$use_ttk} {
2644 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2645 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2646 } else {
2647 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2648 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2649 }
e9937d2a
JH
2650 puts $f "set geometry(botwidth) [winfo width .bleft]"
2651 puts $f "set geometry(botheight) [winfo height .bleft]"
2652
a90a6d24
PM
2653 puts -nonewline $f "set permviews {"
2654 for {set v 0} {$v < $nextviewnum} {incr v} {
2655 if {$viewperm($v)} {
2d480856 2656 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
a90a6d24
PM
2657 }
2658 }
2659 puts $f "}"
0fba86b3
PM
2660 close $f
2661 file rename -force "~/.gitk-new" "~/.gitk"
2662 }
2663 set stuffsaved 1
1db95b00
PM
2664}
2665
43bddeb4 2666proc resizeclistpanes {win w} {
d93f1713 2667 global oldwidth use_ttk
418c4c7b 2668 if {[info exists oldwidth($win)]} {
d93f1713
PT
2669 if {$use_ttk} {
2670 set s0 [$win sashpos 0]
2671 set s1 [$win sashpos 1]
2672 } else {
2673 set s0 [$win sash coord 0]
2674 set s1 [$win sash coord 1]
2675 }
43bddeb4
PM
2676 if {$w < 60} {
2677 set sash0 [expr {int($w/2 - 2)}]
2678 set sash1 [expr {int($w*5/6 - 2)}]
2679 } else {
2680 set factor [expr {1.0 * $w / $oldwidth($win)}]
2681 set sash0 [expr {int($factor * [lindex $s0 0])}]
2682 set sash1 [expr {int($factor * [lindex $s1 0])}]
2683 if {$sash0 < 30} {
2684 set sash0 30
2685 }
2686 if {$sash1 < $sash0 + 20} {
2ed49d54 2687 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
2688 }
2689 if {$sash1 > $w - 10} {
2ed49d54 2690 set sash1 [expr {$w - 10}]
43bddeb4 2691 if {$sash0 > $sash1 - 20} {
2ed49d54 2692 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
2693 }
2694 }
2695 }
d93f1713
PT
2696 if {$use_ttk} {
2697 $win sashpos 0 $sash0
2698 $win sashpos 1 $sash1
2699 } else {
2700 $win sash place 0 $sash0 [lindex $s0 1]
2701 $win sash place 1 $sash1 [lindex $s1 1]
2702 }
43bddeb4
PM
2703 }
2704 set oldwidth($win) $w
2705}
2706
2707proc resizecdetpanes {win w} {
d93f1713 2708 global oldwidth use_ttk
418c4c7b 2709 if {[info exists oldwidth($win)]} {
d93f1713
PT
2710 if {$use_ttk} {
2711 set s0 [$win sashpos 0]
2712 } else {
2713 set s0 [$win sash coord 0]
2714 }
43bddeb4
PM
2715 if {$w < 60} {
2716 set sash0 [expr {int($w*3/4 - 2)}]
2717 } else {
2718 set factor [expr {1.0 * $w / $oldwidth($win)}]
2719 set sash0 [expr {int($factor * [lindex $s0 0])}]
2720 if {$sash0 < 45} {
2721 set sash0 45
2722 }
2723 if {$sash0 > $w - 15} {
2ed49d54 2724 set sash0 [expr {$w - 15}]
43bddeb4
PM
2725 }
2726 }
d93f1713
PT
2727 if {$use_ttk} {
2728 $win sashpos 0 $sash0
2729 } else {
2730 $win sash place 0 $sash0 [lindex $s0 1]
2731 }
43bddeb4
PM
2732 }
2733 set oldwidth($win) $w
2734}
2735
b5721c72
PM
2736proc allcanvs args {
2737 global canv canv2 canv3
2738 eval $canv $args
2739 eval $canv2 $args
2740 eval $canv3 $args
2741}
2742
2743proc bindall {event action} {
2744 global canv canv2 canv3
2745 bind $canv $event $action
2746 bind $canv2 $event $action
2747 bind $canv3 $event $action
2748}
2749
9a40c50c 2750proc about {} {
d93f1713 2751 global uifont NS
9a40c50c
PM
2752 set w .about
2753 if {[winfo exists $w]} {
2754 raise $w
2755 return
2756 }
d93f1713 2757 ttk_toplevel $w
d990cedf 2758 wm title $w [mc "About gitk"]
e7d64008 2759 make_transient $w .
d990cedf 2760 message $w.m -text [mc "
9f1afe05 2761Gitk - a commit viewer for git
9a40c50c 2762
d93f1713 2763Copyright \u00a9 2005-2009 Paul Mackerras
9a40c50c 2764
d990cedf 2765Use and redistribute under the terms of the GNU General Public License"] \
3a950e9a
ER
2766 -justify center -aspect 400 -border 2 -bg white -relief groove
2767 pack $w.m -side top -fill x -padx 2 -pady 2
d93f1713 2768 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 2769 pack $w.ok -side bottom
3a950e9a
ER
2770 bind $w <Visibility> "focus $w.ok"
2771 bind $w <Key-Escape> "destroy $w"
2772 bind $w <Key-Return> "destroy $w"
d93f1713 2773 tk::PlaceWindow $w widget .
9a40c50c
PM
2774}
2775
4e95e1f7 2776proc keys {} {
d93f1713 2777 global NS
4e95e1f7
PM
2778 set w .keys
2779 if {[winfo exists $w]} {
2780 raise $w
2781 return
2782 }
d23d98d3
SP
2783 if {[tk windowingsystem] eq {aqua}} {
2784 set M1T Cmd
2785 } else {
2786 set M1T Ctrl
2787 }
d93f1713 2788 ttk_toplevel $w
d990cedf 2789 wm title $w [mc "Gitk key bindings"]
e7d64008 2790 make_transient $w .
3d2c998e
MB
2791 message $w.m -text "
2792[mc "Gitk key bindings:"]
2793
2794[mc "<%s-Q> Quit" $M1T]
2795[mc "<Home> Move to first commit"]
2796[mc "<End> Move to last commit"]
2797[mc "<Up>, p, i Move up one commit"]
2798[mc "<Down>, n, k Move down one commit"]
2799[mc "<Left>, z, j Go back in history list"]
2800[mc "<Right>, x, l Go forward in history list"]
2801[mc "<PageUp> Move up one page in commit list"]
2802[mc "<PageDown> Move down one page in commit list"]
2803[mc "<%s-Home> Scroll to top of commit list" $M1T]
2804[mc "<%s-End> Scroll to bottom of commit list" $M1T]
2805[mc "<%s-Up> Scroll commit list up one line" $M1T]
2806[mc "<%s-Down> Scroll commit list down one line" $M1T]
2807[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2808[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2809[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2810[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2811[mc "<Delete>, b Scroll diff view up one page"]
2812[mc "<Backspace> Scroll diff view up one page"]
2813[mc "<Space> Scroll diff view down one page"]
2814[mc "u Scroll diff view up 18 lines"]
2815[mc "d Scroll diff view down 18 lines"]
2816[mc "<%s-F> Find" $M1T]
2817[mc "<%s-G> Move to next find hit" $M1T]
2818[mc "<Return> Move to next find hit"]
97bed034 2819[mc "/ Focus the search box"]
3d2c998e
MB
2820[mc "? Move to previous find hit"]
2821[mc "f Scroll diff view to next file"]
2822[mc "<%s-S> Search for next hit in diff view" $M1T]
2823[mc "<%s-R> Search for previous hit in diff view" $M1T]
2824[mc "<%s-KP+> Increase font size" $M1T]
2825[mc "<%s-plus> Increase font size" $M1T]
2826[mc "<%s-KP-> Decrease font size" $M1T]
2827[mc "<%s-minus> Decrease font size" $M1T]
2828[mc "<F5> Update"]
2829" \
3a950e9a
ER
2830 -justify left -bg white -border 2 -relief groove
2831 pack $w.m -side top -fill both -padx 2 -pady 2
d93f1713 2832 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
76f15947 2833 bind $w <Key-Escape> [list destroy $w]
4e95e1f7 2834 pack $w.ok -side bottom
3a950e9a
ER
2835 bind $w <Visibility> "focus $w.ok"
2836 bind $w <Key-Escape> "destroy $w"
2837 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
2838}
2839
7fcceed7
PM
2840# Procedures for manipulating the file list window at the
2841# bottom right of the overall window.
f8b28a40
PM
2842
2843proc treeview {w l openlevs} {
2844 global treecontents treediropen treeheight treeparent treeindex
2845
2846 set ix 0
2847 set treeindex() 0
2848 set lev 0
2849 set prefix {}
2850 set prefixend -1
2851 set prefendstack {}
2852 set htstack {}
2853 set ht 0
2854 set treecontents() {}
2855 $w conf -state normal
2856 foreach f $l {
2857 while {[string range $f 0 $prefixend] ne $prefix} {
2858 if {$lev <= $openlevs} {
2859 $w mark set e:$treeindex($prefix) "end -1c"
2860 $w mark gravity e:$treeindex($prefix) left
2861 }
2862 set treeheight($prefix) $ht
2863 incr ht [lindex $htstack end]
2864 set htstack [lreplace $htstack end end]
2865 set prefixend [lindex $prefendstack end]
2866 set prefendstack [lreplace $prefendstack end end]
2867 set prefix [string range $prefix 0 $prefixend]
2868 incr lev -1
2869 }
2870 set tail [string range $f [expr {$prefixend+1}] end]
2871 while {[set slash [string first "/" $tail]] >= 0} {
2872 lappend htstack $ht
2873 set ht 0
2874 lappend prefendstack $prefixend
2875 incr prefixend [expr {$slash + 1}]
2876 set d [string range $tail 0 $slash]
2877 lappend treecontents($prefix) $d
2878 set oldprefix $prefix
2879 append prefix $d
2880 set treecontents($prefix) {}
2881 set treeindex($prefix) [incr ix]
2882 set treeparent($prefix) $oldprefix
2883 set tail [string range $tail [expr {$slash+1}] end]
2884 if {$lev <= $openlevs} {
2885 set ht 1
2886 set treediropen($prefix) [expr {$lev < $openlevs}]
2887 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2888 $w mark set d:$ix "end -1c"
2889 $w mark gravity d:$ix left
2890 set str "\n"
2891 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2892 $w insert end $str
2893 $w image create end -align center -image $bm -padx 1 \
2894 -name a:$ix
45a9d505 2895 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
2896 $w mark set s:$ix "end -1c"
2897 $w mark gravity s:$ix left
2898 }
2899 incr lev
2900 }
2901 if {$tail ne {}} {
2902 if {$lev <= $openlevs} {
2903 incr ht
2904 set str "\n"
2905 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2906 $w insert end $str
45a9d505 2907 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
2908 }
2909 lappend treecontents($prefix) $tail
2910 }
2911 }
2912 while {$htstack ne {}} {
2913 set treeheight($prefix) $ht
2914 incr ht [lindex $htstack end]
2915 set htstack [lreplace $htstack end end]
096e96b4
BD
2916 set prefixend [lindex $prefendstack end]
2917 set prefendstack [lreplace $prefendstack end end]
2918 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
2919 }
2920 $w conf -state disabled
2921}
2922
2923proc linetoelt {l} {
2924 global treeheight treecontents
2925
2926 set y 2
2927 set prefix {}
2928 while {1} {
2929 foreach e $treecontents($prefix) {
2930 if {$y == $l} {
2931 return "$prefix$e"
2932 }
2933 set n 1
2934 if {[string index $e end] eq "/"} {
2935 set n $treeheight($prefix$e)
2936 if {$y + $n > $l} {
2937 append prefix $e
2938 incr y
2939 break
2940 }
2941 }
2942 incr y $n
2943 }
2944 }
2945}
2946
45a9d505
PM
2947proc highlight_tree {y prefix} {
2948 global treeheight treecontents cflist
2949
2950 foreach e $treecontents($prefix) {
2951 set path $prefix$e
2952 if {[highlight_tag $path] ne {}} {
2953 $cflist tag add bold $y.0 "$y.0 lineend"
2954 }
2955 incr y
2956 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2957 set y [highlight_tree $y $path]
2958 }
2959 }
2960 return $y
2961}
2962
f8b28a40
PM
2963proc treeclosedir {w dir} {
2964 global treediropen treeheight treeparent treeindex
2965
2966 set ix $treeindex($dir)
2967 $w conf -state normal
2968 $w delete s:$ix e:$ix
2969 set treediropen($dir) 0
2970 $w image configure a:$ix -image tri-rt
2971 $w conf -state disabled
2972 set n [expr {1 - $treeheight($dir)}]
2973 while {$dir ne {}} {
2974 incr treeheight($dir) $n
2975 set dir $treeparent($dir)
2976 }
2977}
2978
2979proc treeopendir {w dir} {
2980 global treediropen treeheight treeparent treecontents treeindex
2981
2982 set ix $treeindex($dir)
2983 $w conf -state normal
2984 $w image configure a:$ix -image tri-dn
2985 $w mark set e:$ix s:$ix
2986 $w mark gravity e:$ix right
2987 set lev 0
2988 set str "\n"
2989 set n [llength $treecontents($dir)]
2990 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2991 incr lev
2992 append str "\t"
2993 incr treeheight($x) $n
2994 }
2995 foreach e $treecontents($dir) {
45a9d505 2996 set de $dir$e
f8b28a40 2997 if {[string index $e end] eq "/"} {
f8b28a40
PM
2998 set iy $treeindex($de)
2999 $w mark set d:$iy e:$ix
3000 $w mark gravity d:$iy left
3001 $w insert e:$ix $str
3002 set treediropen($de) 0
3003 $w image create e:$ix -align center -image tri-rt -padx 1 \
3004 -name a:$iy
45a9d505 3005 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3006 $w mark set s:$iy e:$ix
3007 $w mark gravity s:$iy left
3008 set treeheight($de) 1
3009 } else {
3010 $w insert e:$ix $str
45a9d505 3011 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3012 }
3013 }
b8a640ee 3014 $w mark gravity e:$ix right
f8b28a40
PM
3015 $w conf -state disabled
3016 set treediropen($dir) 1
3017 set top [lindex [split [$w index @0,0] .] 0]
3018 set ht [$w cget -height]
3019 set l [lindex [split [$w index s:$ix] .] 0]
3020 if {$l < $top} {
3021 $w yview $l.0
3022 } elseif {$l + $n + 1 > $top + $ht} {
3023 set top [expr {$l + $n + 2 - $ht}]
3024 if {$l < $top} {
3025 set top $l
3026 }
3027 $w yview $top.0
3028 }
3029}
3030
3031proc treeclick {w x y} {
3032 global treediropen cmitmode ctext cflist cflist_top
3033
3034 if {$cmitmode ne "tree"} return
3035 if {![info exists cflist_top]} return
3036 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3037 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3038 $cflist tag add highlight $l.0 "$l.0 lineend"
3039 set cflist_top $l
3040 if {$l == 1} {
3041 $ctext yview 1.0
3042 return
3043 }
3044 set e [linetoelt $l]
3045 if {[string index $e end] ne "/"} {
3046 showfile $e
3047 } elseif {$treediropen($e)} {
3048 treeclosedir $w $e
3049 } else {
3050 treeopendir $w $e
3051 }
3052}
3053
3054proc setfilelist {id} {
8a897742 3055 global treefilelist cflist jump_to_here
f8b28a40
PM
3056
3057 treeview $cflist $treefilelist($id) 0
8a897742
PM
3058 if {$jump_to_here ne {}} {
3059 set f [lindex $jump_to_here 0]
3060 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3061 showfile $f
3062 }
3063 }
f8b28a40
PM
3064}
3065
3066image create bitmap tri-rt -background black -foreground blue -data {
3067 #define tri-rt_width 13
3068 #define tri-rt_height 13
3069 static unsigned char tri-rt_bits[] = {
3070 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3071 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3072 0x00, 0x00};
3073} -maskdata {
3074 #define tri-rt-mask_width 13
3075 #define tri-rt-mask_height 13
3076 static unsigned char tri-rt-mask_bits[] = {
3077 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3078 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3079 0x08, 0x00};
3080}
3081image create bitmap tri-dn -background black -foreground blue -data {
3082 #define tri-dn_width 13
3083 #define tri-dn_height 13
3084 static unsigned char tri-dn_bits[] = {
3085 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3086 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3087 0x00, 0x00};
3088} -maskdata {
3089 #define tri-dn-mask_width 13
3090 #define tri-dn-mask_height 13
3091 static unsigned char tri-dn-mask_bits[] = {
3092 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3093 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3094 0x00, 0x00};
3095}
3096
887c996e
PM
3097image create bitmap reficon-T -background black -foreground yellow -data {
3098 #define tagicon_width 13
3099 #define tagicon_height 9
3100 static unsigned char tagicon_bits[] = {
3101 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3102 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3103} -maskdata {
3104 #define tagicon-mask_width 13
3105 #define tagicon-mask_height 9
3106 static unsigned char tagicon-mask_bits[] = {
3107 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3108 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3109}
3110set rectdata {
3111 #define headicon_width 13
3112 #define headicon_height 9
3113 static unsigned char headicon_bits[] = {
3114 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3115 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3116}
3117set rectmask {
3118 #define headicon-mask_width 13
3119 #define headicon-mask_height 9
3120 static unsigned char headicon-mask_bits[] = {
3121 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3122 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3123}
3124image create bitmap reficon-H -background black -foreground green \
3125 -data $rectdata -maskdata $rectmask
3126image create bitmap reficon-o -background black -foreground "#ddddff" \
3127 -data $rectdata -maskdata $rectmask
3128
7fcceed7 3129proc init_flist {first} {
7fcc92bf 3130 global cflist cflist_top difffilestart
7fcceed7
PM
3131
3132 $cflist conf -state normal
3133 $cflist delete 0.0 end
3134 if {$first ne {}} {
3135 $cflist insert end $first
3136 set cflist_top 1
7fcceed7
PM
3137 $cflist tag add highlight 1.0 "1.0 lineend"
3138 } else {
3139 catch {unset cflist_top}
3140 }
3141 $cflist conf -state disabled
3142 set difffilestart {}
3143}
3144
63b79191
PM
3145proc highlight_tag {f} {
3146 global highlight_paths
3147
3148 foreach p $highlight_paths {
3149 if {[string match $p $f]} {
3150 return "bold"
3151 }
3152 }
3153 return {}
3154}
3155
3156proc highlight_filelist {} {
45a9d505 3157 global cmitmode cflist
63b79191 3158
45a9d505
PM
3159 $cflist conf -state normal
3160 if {$cmitmode ne "tree"} {
63b79191
PM
3161 set end [lindex [split [$cflist index end] .] 0]
3162 for {set l 2} {$l < $end} {incr l} {
3163 set line [$cflist get $l.0 "$l.0 lineend"]
3164 if {[highlight_tag $line] ne {}} {
3165 $cflist tag add bold $l.0 "$l.0 lineend"
3166 }
3167 }
45a9d505
PM
3168 } else {
3169 highlight_tree 2 {}
63b79191 3170 }
45a9d505 3171 $cflist conf -state disabled
63b79191
PM
3172}
3173
3174proc unhighlight_filelist {} {
45a9d505 3175 global cflist
63b79191 3176
45a9d505
PM
3177 $cflist conf -state normal
3178 $cflist tag remove bold 1.0 end
3179 $cflist conf -state disabled
63b79191
PM
3180}
3181
f8b28a40 3182proc add_flist {fl} {
45a9d505 3183 global cflist
7fcceed7 3184
45a9d505
PM
3185 $cflist conf -state normal
3186 foreach f $fl {
3187 $cflist insert end "\n"
3188 $cflist insert end $f [highlight_tag $f]
7fcceed7 3189 }
45a9d505 3190 $cflist conf -state disabled
7fcceed7
PM
3191}
3192
3193proc sel_flist {w x y} {
45a9d505 3194 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 3195
f8b28a40 3196 if {$cmitmode eq "tree"} return
7fcceed7
PM
3197 if {![info exists cflist_top]} return
3198 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
3199 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3200 $cflist tag add highlight $l.0 "$l.0 lineend"
3201 set cflist_top $l
f8b28a40
PM
3202 if {$l == 1} {
3203 $ctext yview 1.0
3204 } else {
3205 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 3206 }
7fcceed7
PM
3207}
3208
3244729a
PM
3209proc pop_flist_menu {w X Y x y} {
3210 global ctext cflist cmitmode flist_menu flist_menu_file
3211 global treediffs diffids
3212
bb3edc8b 3213 stopfinding
3244729a
PM
3214 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3215 if {$l <= 1} return
3216 if {$cmitmode eq "tree"} {
3217 set e [linetoelt $l]
3218 if {[string index $e end] eq "/"} return
3219 } else {
3220 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3221 }
3222 set flist_menu_file $e
314f5de1
TA
3223 set xdiffstate "normal"
3224 if {$cmitmode eq "tree"} {
3225 set xdiffstate "disabled"
3226 }
3227 # Disable "External diff" item in tree mode
3228 $flist_menu entryconf 2 -state $xdiffstate
3244729a
PM
3229 tk_popup $flist_menu $X $Y
3230}
3231
7cdc3556
AG
3232proc find_ctext_fileinfo {line} {
3233 global ctext_file_names ctext_file_lines
3234
3235 set ok [bsearch $ctext_file_lines $line]
3236 set tline [lindex $ctext_file_lines $ok]
3237
3238 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3239 return {}
3240 } else {
3241 return [list [lindex $ctext_file_names $ok] $tline]
3242 }
3243}
3244
3245proc pop_diff_menu {w X Y x y} {
3246 global ctext diff_menu flist_menu_file
3247 global diff_menu_txtpos diff_menu_line
3248 global diff_menu_filebase
3249
7cdc3556
AG
3250 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3251 set diff_menu_line [lindex $diff_menu_txtpos 0]
190ec52c
PM
3252 # don't pop up the menu on hunk-separator or file-separator lines
3253 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3254 return
3255 }
3256 stopfinding
7cdc3556
AG
3257 set f [find_ctext_fileinfo $diff_menu_line]
3258 if {$f eq {}} return
3259 set flist_menu_file [lindex $f 0]
3260 set diff_menu_filebase [lindex $f 1]
3261 tk_popup $diff_menu $X $Y
3262}
3263
3244729a 3264proc flist_hl {only} {
bb3edc8b 3265 global flist_menu_file findstring gdttype
3244729a
PM
3266
3267 set x [shellquote $flist_menu_file]
b007ee20 3268 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 3269 set findstring $x
3244729a 3270 } else {
bb3edc8b 3271 append findstring " " $x
3244729a 3272 }
b007ee20 3273 set gdttype [mc "touching paths:"]
3244729a
PM
3274}
3275
314f5de1
TA
3276proc save_file_from_commit {filename output what} {
3277 global nullfile
3278
3279 if {[catch {exec git show $filename -- > $output} err]} {
3280 if {[string match "fatal: bad revision *" $err]} {
3281 return $nullfile
3282 }
3945d2c0 3283 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
314f5de1
TA
3284 return {}
3285 }
3286 return $output
3287}
3288
3289proc external_diff_get_one_file {diffid filename diffdir} {
3290 global nullid nullid2 nullfile
3291 global gitdir
3292
3293 if {$diffid == $nullid} {
3294 set difffile [file join [file dirname $gitdir] $filename]
3295 if {[file exists $difffile]} {
3296 return $difffile
3297 }
3298 return $nullfile
3299 }
3300 if {$diffid == $nullid2} {
3301 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3302 return [save_file_from_commit :$filename $difffile index]
3303 }
3304 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3305 return [save_file_from_commit $diffid:$filename $difffile \
3306 "revision $diffid"]
3307}
3308
3309proc external_diff {} {
3310 global gitktmpdir nullid nullid2
3311 global flist_menu_file
3312 global diffids
3313 global diffnum
3314 global gitdir extdifftool
3315
3316 if {[llength $diffids] == 1} {
3317 # no reference commit given
3318 set diffidto [lindex $diffids 0]
3319 if {$diffidto eq $nullid} {
3320 # diffing working copy with index
3321 set diffidfrom $nullid2
3322 } elseif {$diffidto eq $nullid2} {
3323 # diffing index with HEAD
3324 set diffidfrom "HEAD"
3325 } else {
3326 # use first parent commit
3327 global parentlist selectedline
3328 set diffidfrom [lindex $parentlist $selectedline 0]
3329 }
3330 } else {
3331 set diffidfrom [lindex $diffids 0]
3332 set diffidto [lindex $diffids 1]
3333 }
3334
3335 # make sure that several diffs wont collide
3336 if {![info exists gitktmpdir]} {
3337 set gitktmpdir [file join [file dirname $gitdir] \
3338 [format ".gitk-tmp.%s" [pid]]]
3339 if {[catch {file mkdir $gitktmpdir} err]} {
3945d2c0 3340 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
314f5de1
TA
3341 unset gitktmpdir
3342 return
3343 }
3344 set diffnum 0
3345 }
3346 incr diffnum
3347 set diffdir [file join $gitktmpdir $diffnum]
3348 if {[catch {file mkdir $diffdir} err]} {
3945d2c0 3349 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
314f5de1
TA
3350 return
3351 }
3352
3353 # gather files to diff
3354 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3355 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3356
3357 if {$difffromfile ne {} && $difftofile ne {}} {
b575b2f1
PT
3358 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3359 if {[catch {set fl [open |$cmd r]} err]} {
314f5de1 3360 file delete -force $diffdir
3945d2c0 3361 error_popup "$extdifftool: [mc "command failed:"] $err"
314f5de1
TA
3362 } else {
3363 fconfigure $fl -blocking 0
3364 filerun $fl [list delete_at_eof $fl $diffdir]
3365 }
3366 }
3367}
3368
7cdc3556
AG
3369proc find_hunk_blamespec {base line} {
3370 global ctext
3371
3372 # Find and parse the hunk header
3373 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3374 if {$s_lix eq {}} return
3375
3376 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3377 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3378 s_line old_specs osz osz1 new_line nsz]} {
3379 return
3380 }
3381
3382 # base lines for the parents
3383 set base_lines [list $new_line]
3384 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3385 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3386 old_spec old_line osz]} {
3387 return
3388 }
3389 lappend base_lines $old_line
3390 }
3391
3392 # Now scan the lines to determine offset within the hunk
7cdc3556
AG
3393 set max_parent [expr {[llength $base_lines]-2}]
3394 set dline 0
3395 set s_lno [lindex [split $s_lix "."] 0]
3396
190ec52c
PM
3397 # Determine if the line is removed
3398 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3399 if {[string match {[-+ ]*} $chunk]} {
7cdc3556
AG
3400 set removed_idx [string first "-" $chunk]
3401 # Choose a parent index
190ec52c
PM
3402 if {$removed_idx >= 0} {
3403 set parent $removed_idx
3404 } else {
3405 set unchanged_idx [string first " " $chunk]
3406 if {$unchanged_idx >= 0} {
3407 set parent $unchanged_idx
7cdc3556 3408 } else {
190ec52c
PM
3409 # blame the current commit
3410 set parent -1
7cdc3556
AG
3411 }
3412 }
3413 # then count other lines that belong to it
190ec52c
PM
3414 for {set i $line} {[incr i -1] > $s_lno} {} {
3415 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3416 # Determine if the line is removed
3417 set removed_idx [string first "-" $chunk]
3418 if {$parent >= 0} {
3419 set code [string index $chunk $parent]
3420 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3421 incr dline
3422 }
3423 } else {
3424 if {$removed_idx < 0} {
3425 incr dline
3426 }
7cdc3556
AG
3427 }
3428 }
190ec52c
PM
3429 incr parent
3430 } else {
3431 set parent 0
7cdc3556
AG
3432 }
3433
7cdc3556
AG
3434 incr dline [lindex $base_lines $parent]
3435 return [list $parent $dline]
3436}
3437
3438proc external_blame_diff {} {
8b07dca1 3439 global currentid cmitmode
7cdc3556
AG
3440 global diff_menu_txtpos diff_menu_line
3441 global diff_menu_filebase flist_menu_file
3442
3443 if {$cmitmode eq "tree"} {
3444 set parent_idx 0
190ec52c 3445 set line [expr {$diff_menu_line - $diff_menu_filebase}]
7cdc3556
AG
3446 } else {
3447 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3448 if {$hinfo ne {}} {
3449 set parent_idx [lindex $hinfo 0]
3450 set line [lindex $hinfo 1]
3451 } else {
3452 set parent_idx 0
3453 set line 0
3454 }
3455 }
3456
3457 external_blame $parent_idx $line
3458}
3459
fc4977e1
PM
3460# Find the SHA1 ID of the blob for file $fname in the index
3461# at stage 0 or 2
3462proc index_sha1 {fname} {
3463 set f [open [list | git ls-files -s $fname] r]
3464 while {[gets $f line] >= 0} {
3465 set info [lindex [split $line "\t"] 0]
3466 set stage [lindex $info 2]
3467 if {$stage eq "0" || $stage eq "2"} {
3468 close $f
3469 return [lindex $info 1]
3470 }
3471 }
3472 close $f
3473 return {}
3474}
3475
9712b81a
PM
3476# Turn an absolute path into one relative to the current directory
3477proc make_relative {f} {
3478 set elts [file split $f]
3479 set here [file split [pwd]]
3480 set ei 0
3481 set hi 0
3482 set res {}
3483 foreach d $here {
3484 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3485 lappend res ".."
3486 } else {
3487 incr ei
3488 }
3489 incr hi
3490 }
3491 set elts [concat $res [lrange $elts $ei end]]
3492 return [eval file join $elts]
3493}
3494
7cdc3556 3495proc external_blame {parent_idx {line {}}} {
9712b81a 3496 global flist_menu_file gitdir
77aa0ae8
AG
3497 global nullid nullid2
3498 global parentlist selectedline currentid
3499
3500 if {$parent_idx > 0} {
3501 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3502 } else {
3503 set base_commit $currentid
3504 }
3505
3506 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3507 error_popup [mc "No such commit"]
3508 return
3509 }
3510
7cdc3556
AG
3511 set cmdline [list git gui blame]
3512 if {$line ne {} && $line > 1} {
3513 lappend cmdline "--line=$line"
3514 }
9712b81a
PM
3515 set f [file join [file dirname $gitdir] $flist_menu_file]
3516 # Unfortunately it seems git gui blame doesn't like
3517 # being given an absolute path...
3518 set f [make_relative $f]
3519 lappend cmdline $base_commit $f
7cdc3556 3520 if {[catch {eval exec $cmdline &} err]} {
3945d2c0 3521 error_popup "[mc "git gui blame: command failed:"] $err"
77aa0ae8
AG
3522 }
3523}
3524
8a897742
PM
3525proc show_line_source {} {
3526 global cmitmode currentid parents curview blamestuff blameinst
3527 global diff_menu_line diff_menu_filebase flist_menu_file
fc4977e1 3528 global nullid nullid2 gitdir
8a897742 3529
fc4977e1 3530 set from_index {}
8a897742
PM
3531 if {$cmitmode eq "tree"} {
3532 set id $currentid
3533 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3534 } else {
3535 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3536 if {$h eq {}} return
3537 set pi [lindex $h 0]
3538 if {$pi == 0} {
3539 mark_ctext_line $diff_menu_line
3540 return
3541 }
fc4977e1
PM
3542 incr pi -1
3543 if {$currentid eq $nullid} {
3544 if {$pi > 0} {
3545 # must be a merge in progress...
3546 if {[catch {
3547 # get the last line from .git/MERGE_HEAD
3548 set f [open [file join $gitdir MERGE_HEAD] r]
3549 set id [lindex [split [read $f] "\n"] end-1]
3550 close $f
3551 } err]} {
3552 error_popup [mc "Couldn't read merge head: %s" $err]
3553 return
3554 }
3555 } elseif {$parents($curview,$currentid) eq $nullid2} {
3556 # need to do the blame from the index
3557 if {[catch {
3558 set from_index [index_sha1 $flist_menu_file]
3559 } err]} {
3560 error_popup [mc "Error reading index: %s" $err]
3561 return
3562 }
9712b81a
PM
3563 } else {
3564 set id $parents($curview,$currentid)
fc4977e1
PM
3565 }
3566 } else {
3567 set id [lindex $parents($curview,$currentid) $pi]
3568 }
8a897742
PM
3569 set line [lindex $h 1]
3570 }
fc4977e1
PM
3571 set blameargs {}
3572 if {$from_index ne {}} {
3573 lappend blameargs | git cat-file blob $from_index
3574 }
3575 lappend blameargs | git blame -p -L$line,+1
3576 if {$from_index ne {}} {
3577 lappend blameargs --contents -
3578 } else {
3579 lappend blameargs $id
3580 }
9712b81a 3581 lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
8a897742 3582 if {[catch {
fc4977e1 3583 set f [open $blameargs r]
8a897742
PM
3584 } err]} {
3585 error_popup [mc "Couldn't start git blame: %s" $err]
3586 return
3587 }
f3413079 3588 nowbusy blaming [mc "Searching"]
8a897742
PM
3589 fconfigure $f -blocking 0
3590 set i [reg_instance $f]
3591 set blamestuff($i) {}
3592 set blameinst $i
3593 filerun $f [list read_line_source $f $i]
3594}
3595
3596proc stopblaming {} {
3597 global blameinst
3598
3599 if {[info exists blameinst]} {
3600 stop_instance $blameinst
3601 unset blameinst
f3413079 3602 notbusy blaming
8a897742
PM
3603 }
3604}
3605
3606proc read_line_source {fd inst} {
fc4977e1 3607 global blamestuff curview commfd blameinst nullid nullid2
8a897742
PM
3608
3609 while {[gets $fd line] >= 0} {
3610 lappend blamestuff($inst) $line
3611 }
3612 if {![eof $fd]} {
3613 return 1
3614 }
3615 unset commfd($inst)
3616 unset blameinst
f3413079 3617 notbusy blaming
8a897742
PM
3618 fconfigure $fd -blocking 1
3619 if {[catch {close $fd} err]} {
3620 error_popup [mc "Error running git blame: %s" $err]
3621 return 0
3622 }
3623
3624 set fname {}
3625 set line [split [lindex $blamestuff($inst) 0] " "]
3626 set id [lindex $line 0]
3627 set lnum [lindex $line 1]
3628 if {[string length $id] == 40 && [string is xdigit $id] &&
3629 [string is digit -strict $lnum]} {
3630 # look for "filename" line
3631 foreach l $blamestuff($inst) {
3632 if {[string match "filename *" $l]} {
3633 set fname [string range $l 9 end]
3634 break
3635 }
3636 }
3637 }
3638 if {$fname ne {}} {
3639 # all looks good, select it
fc4977e1
PM
3640 if {$id eq $nullid} {
3641 # blame uses all-zeroes to mean not committed,
3642 # which would mean a change in the index
3643 set id $nullid2
3644 }
8a897742
PM
3645 if {[commitinview $id $curview]} {
3646 selectline [rowofcommit $id] 1 [list $fname $lnum]
3647 } else {
3648 error_popup [mc "That line comes from commit %s, \
3649 which is not in this view" [shortids $id]]
3650 }
3651 } else {
3652 puts "oops couldn't parse git blame output"
3653 }
3654 return 0
3655}
3656
314f5de1
TA
3657# delete $dir when we see eof on $f (presumably because the child has exited)
3658proc delete_at_eof {f dir} {
3659 while {[gets $f line] >= 0} {}
3660 if {[eof $f]} {
3661 if {[catch {close $f} err]} {
3945d2c0 3662 error_popup "[mc "External diff viewer failed:"] $err"
314f5de1
TA
3663 }
3664 file delete -force $dir
3665 return 0
3666 }
3667 return 1
3668}
3669
098dd8a3
PM
3670# Functions for adding and removing shell-type quoting
3671
3672proc shellquote {str} {
3673 if {![string match "*\['\"\\ \t]*" $str]} {
3674 return $str
3675 }
3676 if {![string match "*\['\"\\]*" $str]} {
3677 return "\"$str\""
3678 }
3679 if {![string match "*'*" $str]} {
3680 return "'$str'"
3681 }
3682 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3683}
3684
3685proc shellarglist {l} {
3686 set str {}
3687 foreach a $l {
3688 if {$str ne {}} {
3689 append str " "
3690 }
3691 append str [shellquote $a]
3692 }
3693 return $str
3694}
3695
3696proc shelldequote {str} {
3697 set ret {}
3698 set used -1
3699 while {1} {
3700 incr used
3701 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3702 append ret [string range $str $used end]
3703 set used [string length $str]
3704 break
3705 }
3706 set first [lindex $first 0]
3707 set ch [string index $str $first]
3708 if {$first > $used} {
3709 append ret [string range $str $used [expr {$first - 1}]]
3710 set used $first
3711 }
3712 if {$ch eq " " || $ch eq "\t"} break
3713 incr used
3714 if {$ch eq "'"} {
3715 set first [string first "'" $str $used]
3716 if {$first < 0} {
3717 error "unmatched single-quote"
3718 }
3719 append ret [string range $str $used [expr {$first - 1}]]
3720 set used $first
3721 continue
3722 }
3723 if {$ch eq "\\"} {
3724 if {$used >= [string length $str]} {
3725 error "trailing backslash"
3726 }
3727 append ret [string index $str $used]
3728 continue
3729 }
3730 # here ch == "\""
3731 while {1} {
3732 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3733 error "unmatched double-quote"
3734 }
3735 set first [lindex $first 0]
3736 set ch [string index $str $first]
3737 if {$first > $used} {
3738 append ret [string range $str $used [expr {$first - 1}]]
3739 set used $first
3740 }
3741 if {$ch eq "\""} break
3742 incr used
3743 append ret [string index $str $used]
3744 incr used
3745 }
3746 }
3747 return [list $used $ret]
3748}
3749
3750proc shellsplit {str} {
3751 set l {}
3752 while {1} {
3753 set str [string trimleft $str]
3754 if {$str eq {}} break
3755 set dq [shelldequote $str]
3756 set n [lindex $dq 0]
3757 set word [lindex $dq 1]
3758 set str [string range $str $n end]
3759 lappend l $word
3760 }
3761 return $l
3762}
3763
7fcceed7
PM
3764# Code to implement multiple views
3765
da7c24dd 3766proc newview {ishighlight} {
218a900b
AG
3767 global nextviewnum newviewname newishighlight
3768 global revtreeargs viewargscmd newviewopts curview
50b44ece 3769
da7c24dd 3770 set newishighlight $ishighlight
50b44ece
PM
3771 set top .gitkview
3772 if {[winfo exists $top]} {
3773 raise $top
3774 return
3775 }
a3a1f579 3776 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
218a900b
AG
3777 set newviewopts($nextviewnum,perm) 0
3778 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3779 decode_view_opts $nextviewnum $revtreeargs
d990cedf 3780 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
3781}
3782
218a900b
AG
3783set known_view_options {
3784 {perm b . {} {mc "Remember this view"}}
3785 {args t50= + {} {mc "Commits to include (arguments to git log):"}}
3786 {all b * "--all" {mc "Use all refs"}}
3787 {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
3788 {lright b . "--left-right" {mc "Mark branch sides"}}
3789 {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
3790 {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
3791 {limit t10 + "--max-count=*" {mc "Max count:"}}
3792 {skip t10 . "--skip=*" {mc "Skip:"}}
3793 {first b . "--first-parent" {mc "Limit to first parent"}}
3794 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3795 }
3796
3797proc encode_view_opts {n} {
3798 global known_view_options newviewopts
3799
3800 set rargs [list]
3801 foreach opt $known_view_options {
3802 set patterns [lindex $opt 3]
3803 if {$patterns eq {}} continue
3804 set pattern [lindex $patterns 0]
3805
3806 set val $newviewopts($n,[lindex $opt 0])
d93f1713 3807
218a900b
AG
3808 if {[lindex $opt 1] eq "b"} {
3809 if {$val} {
3810 lappend rargs $pattern
3811 }
3812 } else {
3813 set val [string trim $val]
3814 if {$val ne {}} {
3815 set pfix [string range $pattern 0 end-1]
3816 lappend rargs $pfix$val
3817 }
3818 }
3819 }
3820 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3821}
3822
3823proc decode_view_opts {n view_args} {
3824 global known_view_options newviewopts
3825
3826 foreach opt $known_view_options {
3827 if {[lindex $opt 1] eq "b"} {
3828 set val 0
3829 } else {
3830 set val {}
3831 }
3832 set newviewopts($n,[lindex $opt 0]) $val
3833 }
3834 set oargs [list]
3835 foreach arg $view_args {
3836 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3837 && ![info exists found(limit)]} {
3838 set newviewopts($n,limit) $cnt
3839 set found(limit) 1
3840 continue
3841 }
3842 catch { unset val }
3843 foreach opt $known_view_options {
3844 set id [lindex $opt 0]
3845 if {[info exists found($id)]} continue
3846 foreach pattern [lindex $opt 3] {
3847 if {![string match $pattern $arg]} continue
3848 if {[lindex $opt 1] ne "b"} {
3849 set size [string length $pattern]
3850 set val [string range $arg [expr {$size-1}] end]
3851 } else {
3852 set val 1
3853 }
3854 set newviewopts($n,$id) $val
3855 set found($id) 1
3856 break
3857 }
3858 if {[info exists val]} break
3859 }
3860 if {[info exists val]} continue
3861 lappend oargs $arg
3862 }
3863 set newviewopts($n,args) [shellarglist $oargs]
3864}
3865
cea07cf8
AG
3866proc edit_or_newview {} {
3867 global curview
3868
3869 if {$curview > 0} {
3870 editview
3871 } else {
3872 newview 0
3873 }
3874}
3875
d16c0812
PM
3876proc editview {} {
3877 global curview
218a900b
AG
3878 global viewname viewperm newviewname newviewopts
3879 global viewargs viewargscmd
d16c0812
PM
3880
3881 set top .gitkvedit-$curview
3882 if {[winfo exists $top]} {
3883 raise $top
3884 return
3885 }
218a900b
AG
3886 set newviewname($curview) $viewname($curview)
3887 set newviewopts($curview,perm) $viewperm($curview)
3888 set newviewopts($curview,cmd) $viewargscmd($curview)
3889 decode_view_opts $curview $viewargs($curview)
b56e0a9a 3890 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
d16c0812
PM
3891}
3892
3893proc vieweditor {top n title} {
218a900b 3894 global newviewname newviewopts viewfiles bgcolor
d93f1713 3895 global known_view_options NS
d16c0812 3896
d93f1713 3897 ttk_toplevel $top
d16c0812 3898 wm title $top $title
e7d64008 3899 make_transient $top .
218a900b
AG
3900
3901 # View name
d93f1713
PT
3902 ${NS}::frame $top.nfr
3903 ${NS}::label $top.nl -text [mc "Name"]
3904 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
218a900b
AG
3905 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3906 pack $top.nl -in $top.nfr -side left -padx {0 30}
3907 pack $top.name -in $top.nfr -side left
3908
3909 # View options
3910 set cframe $top.nfr
3911 set cexpand 0
3912 set cnt 0
3913 foreach opt $known_view_options {
3914 set id [lindex $opt 0]
3915 set type [lindex $opt 1]
3916 set flags [lindex $opt 2]
3917 set title [eval [lindex $opt 4]]
3918 set lxpad 0
3919
3920 if {$flags eq "+" || $flags eq "*"} {
3921 set cframe $top.fr$cnt
3922 incr cnt
d93f1713 3923 ${NS}::frame $cframe
218a900b
AG
3924 pack $cframe -in $top -fill x -pady 3 -padx 3
3925 set cexpand [expr {$flags eq "*"}]
3926 } else {
3927 set lxpad 5
3928 }
3929
3930 if {$type eq "b"} {
d93f1713 3931 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
218a900b
AG
3932 pack $cframe.c_$id -in $cframe -side left \
3933 -padx [list $lxpad 0] -expand $cexpand -anchor w
3934 } elseif {[regexp {^t(\d+)$} $type type sz]} {
d93f1713
PT
3935 ${NS}::label $cframe.l_$id -text $title
3936 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
3937 -textvariable newviewopts($n,$id)
3938 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3939 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3940 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
d93f1713
PT
3941 ${NS}::label $cframe.l_$id -text $title
3942 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
3943 -textvariable newviewopts($n,$id)
3944 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3945 pack $cframe.e_$id -in $cframe -side top -fill x
3946 }
3947 }
3948
3949 # Path list
d93f1713 3950 ${NS}::label $top.l \
d990cedf 3951 -text [mc "Enter files and directories to include, one per line:"]
218a900b
AG
3952 pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
3953 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
d16c0812
PM
3954 if {[info exists viewfiles($n)]} {
3955 foreach f $viewfiles($n) {
3956 $top.t insert end $f
3957 $top.t insert end "\n"
3958 }
3959 $top.t delete {end - 1c} end
3960 $top.t mark set insert 0.0
3961 }
218a900b 3962 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
d93f1713
PT
3963 ${NS}::frame $top.buts
3964 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3965 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3966 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
218a900b
AG
3967 bind $top <Control-Return> [list newviewok $top $n]
3968 bind $top <F5> [list newviewok $top $n 1]
76f15947 3969 bind $top <Escape> [list destroy $top]
218a900b 3970 grid $top.buts.ok $top.buts.apply $top.buts.can
50b44ece
PM
3971 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3972 grid columnconfigure $top.buts 1 -weight 1 -uniform a
218a900b
AG
3973 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3974 pack $top.buts -in $top -side top -fill x
50b44ece
PM
3975 focus $top.t
3976}
3977
908c3585 3978proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
3979 set nmenu [$m index end]
3980 for {set i $first} {$i <= $nmenu} {incr i} {
3981 if {[$m entrycget $i -command] eq $cmd} {
908c3585 3982 eval $m $op $i $argv
da7c24dd 3983 break
d16c0812
PM
3984 }
3985 }
da7c24dd
PM
3986}
3987
3988proc allviewmenus {n op args} {
687c8765 3989 # global viewhlmenu
908c3585 3990
3cd204e5 3991 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 3992 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
3993}
3994
218a900b 3995proc newviewok {top n {apply 0}} {
da7c24dd 3996 global nextviewnum newviewperm newviewname newishighlight
d16c0812 3997 global viewname viewfiles viewperm selectedview curview
218a900b 3998 global viewargs viewargscmd newviewopts viewhlmenu
50b44ece 3999
098dd8a3 4000 if {[catch {
218a900b 4001 set newargs [encode_view_opts $n]
098dd8a3 4002 } err]} {
84a76f18 4003 error_popup "[mc "Error in commit selection arguments:"] $err" $top
098dd8a3
PM
4004 return
4005 }
50b44ece 4006 set files {}
d16c0812 4007 foreach f [split [$top.t get 0.0 end] "\n"] {
50b44ece
PM
4008 set ft [string trim $f]
4009 if {$ft ne {}} {
4010 lappend files $ft
4011 }
4012 }
d16c0812
PM
4013 if {![info exists viewfiles($n)]} {
4014 # creating a new view
4015 incr nextviewnum
4016 set viewname($n) $newviewname($n)
218a900b 4017 set viewperm($n) $newviewopts($n,perm)
d16c0812 4018 set viewfiles($n) $files
098dd8a3 4019 set viewargs($n) $newargs
218a900b 4020 set viewargscmd($n) $newviewopts($n,cmd)
da7c24dd
PM
4021 addviewmenu $n
4022 if {!$newishighlight} {
7eb3cb9c 4023 run showview $n
da7c24dd 4024 } else {
7eb3cb9c 4025 run addvhighlight $n
da7c24dd 4026 }
d16c0812
PM
4027 } else {
4028 # editing an existing view
218a900b 4029 set viewperm($n) $newviewopts($n,perm)
d16c0812
PM
4030 if {$newviewname($n) ne $viewname($n)} {
4031 set viewname($n) $newviewname($n)
3cd204e5 4032 doviewmenu .bar.view 5 [list showview $n] \
908c3585 4033 entryconf [list -label $viewname($n)]
687c8765
PM
4034 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4035 # entryconf [list -label $viewname($n) -value $viewname($n)]
d16c0812 4036 }
2d480856 4037 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
218a900b 4038 $newviewopts($n,cmd) ne $viewargscmd($n)} {
d16c0812 4039 set viewfiles($n) $files
098dd8a3 4040 set viewargs($n) $newargs
218a900b 4041 set viewargscmd($n) $newviewopts($n,cmd)
d16c0812 4042 if {$curview == $n} {
7fcc92bf 4043 run reloadcommits
d16c0812
PM
4044 }
4045 }
4046 }
218a900b 4047 if {$apply} return
d16c0812 4048 catch {destroy $top}
50b44ece
PM
4049}
4050
4051proc delview {} {
7fcc92bf 4052 global curview viewperm hlview selectedhlview
50b44ece
PM
4053
4054 if {$curview == 0} return
908c3585 4055 if {[info exists hlview] && $hlview == $curview} {
b007ee20 4056 set selectedhlview [mc "None"]
908c3585
PM
4057 unset hlview
4058 }
da7c24dd 4059 allviewmenus $curview delete
a90a6d24 4060 set viewperm($curview) 0
50b44ece
PM
4061 showview 0
4062}
4063
da7c24dd 4064proc addviewmenu {n} {
908c3585 4065 global viewname viewhlmenu
da7c24dd
PM
4066
4067 .bar.view add radiobutton -label $viewname($n) \
4068 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
4069 #$viewhlmenu add radiobutton -label $viewname($n) \
4070 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
4071}
4072
50b44ece 4073proc showview {n} {
3ed31a81 4074 global curview cached_commitrow ordertok
f5f3c2e2 4075 global displayorder parentlist rowidlist rowisopt rowfinal
7fcc92bf
PM
4076 global colormap rowtextx nextcolor canvxmax
4077 global numcommits viewcomplete
50b44ece 4078 global selectedline currentid canv canvy0
4fb0fa19 4079 global treediffs
3e76608d 4080 global pending_select mainheadid
0380081c 4081 global commitidx
3e76608d 4082 global selectedview
97645683 4083 global hlview selectedhlview commitinterest
50b44ece
PM
4084
4085 if {$n == $curview} return
4086 set selid {}
7fcc92bf
PM
4087 set ymax [lindex [$canv cget -scrollregion] 3]
4088 set span [$canv yview]
4089 set ytop [expr {[lindex $span 0] * $ymax}]
4090 set ybot [expr {[lindex $span 1] * $ymax}]
4091 set yscreen [expr {($ybot - $ytop) / 2}]
94b4a69f 4092 if {$selectedline ne {}} {
50b44ece
PM
4093 set selid $currentid
4094 set y [yc $selectedline]
50b44ece
PM
4095 if {$ytop < $y && $y < $ybot} {
4096 set yscreen [expr {$y - $ytop}]
50b44ece 4097 }
e507fd48
PM
4098 } elseif {[info exists pending_select]} {
4099 set selid $pending_select
4100 unset pending_select
50b44ece
PM
4101 }
4102 unselectline
fdedbcfb 4103 normalline
50b44ece
PM
4104 catch {unset treediffs}
4105 clear_display
908c3585
PM
4106 if {[info exists hlview] && $hlview == $n} {
4107 unset hlview
b007ee20 4108 set selectedhlview [mc "None"]
908c3585 4109 }
97645683 4110 catch {unset commitinterest}
7fcc92bf 4111 catch {unset cached_commitrow}
9257d8f7 4112 catch {unset ordertok}
50b44ece
PM
4113
4114 set curview $n
a90a6d24 4115 set selectedview $n
f2d0bbbd
PM
4116 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4117 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 4118
df904497 4119 run refill_reflist
7fcc92bf 4120 if {![info exists viewcomplete($n)]} {
567c34e0 4121 getcommits $selid
50b44ece
PM
4122 return
4123 }
4124
7fcc92bf
PM
4125 set displayorder {}
4126 set parentlist {}
4127 set rowidlist {}
4128 set rowisopt {}
4129 set rowfinal {}
f5f3c2e2 4130 set numcommits $commitidx($n)
22626ef4 4131
50b44ece
PM
4132 catch {unset colormap}
4133 catch {unset rowtextx}
da7c24dd
PM
4134 set nextcolor 0
4135 set canvxmax [$canv cget -width]
50b44ece
PM
4136 set curview $n
4137 set row 0
50b44ece
PM
4138 setcanvscroll
4139 set yf 0
e507fd48 4140 set row {}
7fcc92bf
PM
4141 if {$selid ne {} && [commitinview $selid $n]} {
4142 set row [rowofcommit $selid]
50b44ece
PM
4143 # try to get the selected row in the same position on the screen
4144 set ymax [lindex [$canv cget -scrollregion] 3]
4145 set ytop [expr {[yc $row] - $yscreen}]
4146 if {$ytop < 0} {
4147 set ytop 0
4148 }
4149 set yf [expr {$ytop * 1.0 / $ymax}]
4150 }
4151 allcanvs yview moveto $yf
4152 drawvisible
e507fd48
PM
4153 if {$row ne {}} {
4154 selectline $row 0
3e76608d 4155 } elseif {!$viewcomplete($n)} {
567c34e0 4156 reset_pending_select $selid
e507fd48 4157 } else {
835e62ae
AG
4158 reset_pending_select {}
4159
4160 if {[commitinview $pending_select $curview]} {
4161 selectline [rowofcommit $pending_select] 1
4162 } else {
4163 set row [first_real_row]
4164 if {$row < $numcommits} {
4165 selectline $row 0
4166 }
e507fd48
PM
4167 }
4168 }
7fcc92bf
PM
4169 if {!$viewcomplete($n)} {
4170 if {$numcommits == 0} {
d990cedf 4171 show_status [mc "Reading commits..."]
d16c0812 4172 }
098dd8a3 4173 } elseif {$numcommits == 0} {
d990cedf 4174 show_status [mc "No commits selected"]
2516dae2 4175 }
50b44ece
PM
4176}
4177
908c3585
PM
4178# Stuff relating to the highlighting facility
4179
476ca63d 4180proc ishighlighted {id} {
164ff275 4181 global vhighlights fhighlights nhighlights rhighlights
908c3585 4182
476ca63d
PM
4183 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4184 return $nhighlights($id)
908c3585 4185 }
476ca63d
PM
4186 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4187 return $vhighlights($id)
908c3585 4188 }
476ca63d
PM
4189 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4190 return $fhighlights($id)
908c3585 4191 }
476ca63d
PM
4192 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4193 return $rhighlights($id)
164ff275 4194 }
908c3585
PM
4195 return 0
4196}
4197
28593d3f 4198proc bolden {id font} {
b9fdba7f 4199 global canv linehtag currentid boldids need_redisplay markedid
908c3585 4200
d98d50e2
PM
4201 # need_redisplay = 1 means the display is stale and about to be redrawn
4202 if {$need_redisplay} return
28593d3f
PM
4203 lappend boldids $id
4204 $canv itemconf $linehtag($id) -font $font
4205 if {[info exists currentid] && $id eq $currentid} {
908c3585 4206 $canv delete secsel
28593d3f 4207 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
908c3585
PM
4208 -outline {{}} -tags secsel \
4209 -fill [$canv cget -selectbackground]]
4210 $canv lower $t
4211 }
b9fdba7f
PM
4212 if {[info exists markedid] && $id eq $markedid} {
4213 make_idmark $id
4214 }
908c3585
PM
4215}
4216
28593d3f
PM
4217proc bolden_name {id font} {
4218 global canv2 linentag currentid boldnameids need_redisplay
908c3585 4219
d98d50e2 4220 if {$need_redisplay} return
28593d3f
PM
4221 lappend boldnameids $id
4222 $canv2 itemconf $linentag($id) -font $font
4223 if {[info exists currentid] && $id eq $currentid} {
908c3585 4224 $canv2 delete secsel
28593d3f 4225 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
908c3585
PM
4226 -outline {{}} -tags secsel \
4227 -fill [$canv2 cget -selectbackground]]
4228 $canv2 lower $t
4229 }
4230}
4231
4e7d6779 4232proc unbolden {} {
28593d3f 4233 global boldids
908c3585 4234
4e7d6779 4235 set stillbold {}
28593d3f
PM
4236 foreach id $boldids {
4237 if {![ishighlighted $id]} {
4238 bolden $id mainfont
4e7d6779 4239 } else {
28593d3f 4240 lappend stillbold $id
908c3585
PM
4241 }
4242 }
28593d3f 4243 set boldids $stillbold
908c3585
PM
4244}
4245
4246proc addvhighlight {n} {
476ca63d 4247 global hlview viewcomplete curview vhl_done commitidx
da7c24dd
PM
4248
4249 if {[info exists hlview]} {
908c3585 4250 delvhighlight
da7c24dd
PM
4251 }
4252 set hlview $n
7fcc92bf 4253 if {$n != $curview && ![info exists viewcomplete($n)]} {
da7c24dd 4254 start_rev_list $n
908c3585
PM
4255 }
4256 set vhl_done $commitidx($hlview)
4257 if {$vhl_done > 0} {
4258 drawvisible
da7c24dd
PM
4259 }
4260}
4261
908c3585
PM
4262proc delvhighlight {} {
4263 global hlview vhighlights
da7c24dd
PM
4264
4265 if {![info exists hlview]} return
4266 unset hlview
4e7d6779
PM
4267 catch {unset vhighlights}
4268 unbolden
da7c24dd
PM
4269}
4270
908c3585 4271proc vhighlightmore {} {
7fcc92bf 4272 global hlview vhl_done commitidx vhighlights curview
da7c24dd 4273
da7c24dd 4274 set max $commitidx($hlview)
908c3585
PM
4275 set vr [visiblerows]
4276 set r0 [lindex $vr 0]
4277 set r1 [lindex $vr 1]
4278 for {set i $vhl_done} {$i < $max} {incr i} {
7fcc92bf
PM
4279 set id [commitonrow $i $hlview]
4280 if {[commitinview $id $curview]} {
4281 set row [rowofcommit $id]
908c3585
PM
4282 if {$r0 <= $row && $row <= $r1} {
4283 if {![highlighted $row]} {
28593d3f 4284 bolden $id mainfontbold
da7c24dd 4285 }
476ca63d 4286 set vhighlights($id) 1
da7c24dd
PM
4287 }
4288 }
4289 }
908c3585 4290 set vhl_done $max
ac1276ab 4291 return 0
908c3585
PM
4292}
4293
4294proc askvhighlight {row id} {
7fcc92bf 4295 global hlview vhighlights iddrawn
908c3585 4296
7fcc92bf 4297 if {[commitinview $id $hlview]} {
476ca63d 4298 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
28593d3f 4299 bolden $id mainfontbold
908c3585 4300 }
476ca63d 4301 set vhighlights($id) 1
908c3585 4302 } else {
476ca63d 4303 set vhighlights($id) 0
908c3585
PM
4304 }
4305}
4306
687c8765 4307proc hfiles_change {} {
908c3585 4308 global highlight_files filehighlight fhighlights fh_serial
8b39e04f 4309 global highlight_paths
908c3585
PM
4310
4311 if {[info exists filehighlight]} {
4312 # delete previous highlights
4313 catch {close $filehighlight}
4314 unset filehighlight
4e7d6779
PM
4315 catch {unset fhighlights}
4316 unbolden
63b79191 4317 unhighlight_filelist
908c3585 4318 }
63b79191 4319 set highlight_paths {}
908c3585
PM
4320 after cancel do_file_hl $fh_serial
4321 incr fh_serial
4322 if {$highlight_files ne {}} {
4323 after 300 do_file_hl $fh_serial
4324 }
4325}
4326
687c8765
PM
4327proc gdttype_change {name ix op} {
4328 global gdttype highlight_files findstring findpattern
4329
bb3edc8b 4330 stopfinding
687c8765 4331 if {$findstring ne {}} {
b007ee20 4332 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4333 if {$highlight_files ne {}} {
4334 set highlight_files {}
4335 hfiles_change
4336 }
4337 findcom_change
4338 } else {
4339 if {$findpattern ne {}} {
4340 set findpattern {}
4341 findcom_change
4342 }
4343 set highlight_files $findstring
4344 hfiles_change
4345 }
4346 drawvisible
4347 }
4348 # enable/disable findtype/findloc menus too
4349}
4350
4351proc find_change {name ix op} {
4352 global gdttype findstring highlight_files
4353
bb3edc8b 4354 stopfinding
b007ee20 4355 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4356 findcom_change
4357 } else {
4358 if {$highlight_files ne $findstring} {
4359 set highlight_files $findstring
4360 hfiles_change
4361 }
4362 }
4363 drawvisible
4364}
4365
64b5f146 4366proc findcom_change args {
28593d3f 4367 global nhighlights boldnameids
687c8765
PM
4368 global findpattern findtype findstring gdttype
4369
bb3edc8b 4370 stopfinding
687c8765 4371 # delete previous highlights, if any
28593d3f
PM
4372 foreach id $boldnameids {
4373 bolden_name $id mainfont
687c8765 4374 }
28593d3f 4375 set boldnameids {}
687c8765
PM
4376 catch {unset nhighlights}
4377 unbolden
4378 unmarkmatches
b007ee20 4379 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
687c8765 4380 set findpattern {}
b007ee20 4381 } elseif {$findtype eq [mc "Regexp"]} {
687c8765
PM
4382 set findpattern $findstring
4383 } else {
4384 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4385 $findstring]
4386 set findpattern "*$e*"
4387 }
4388}
4389
63b79191
PM
4390proc makepatterns {l} {
4391 set ret {}
4392 foreach e $l {
4393 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4394 if {[string index $ee end] eq "/"} {
4395 lappend ret "$ee*"
4396 } else {
4397 lappend ret $ee
4398 lappend ret "$ee/*"
4399 }
4400 }
4401 return $ret
4402}
4403
908c3585 4404proc do_file_hl {serial} {
4e7d6779 4405 global highlight_files filehighlight highlight_paths gdttype fhl_list
908c3585 4406
b007ee20 4407 if {$gdttype eq [mc "touching paths:"]} {
60f7a7dc
PM
4408 if {[catch {set paths [shellsplit $highlight_files]}]} return
4409 set highlight_paths [makepatterns $paths]
4410 highlight_filelist
4411 set gdtargs [concat -- $paths]
b007ee20 4412 } elseif {$gdttype eq [mc "adding/removing string:"]} {
60f7a7dc 4413 set gdtargs [list "-S$highlight_files"]
687c8765
PM
4414 } else {
4415 # must be "containing:", i.e. we're searching commit info
4416 return
60f7a7dc 4417 }
1ce09dd6 4418 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
4419 set filehighlight [open $cmd r+]
4420 fconfigure $filehighlight -blocking 0
7eb3cb9c 4421 filerun $filehighlight readfhighlight
4e7d6779 4422 set fhl_list {}
908c3585
PM
4423 drawvisible
4424 flushhighlights
4425}
4426
4427proc flushhighlights {} {
4e7d6779 4428 global filehighlight fhl_list
908c3585
PM
4429
4430 if {[info exists filehighlight]} {
4e7d6779 4431 lappend fhl_list {}
908c3585
PM
4432 puts $filehighlight ""
4433 flush $filehighlight
4434 }
4435}
4436
4437proc askfilehighlight {row id} {
4e7d6779 4438 global filehighlight fhighlights fhl_list
908c3585 4439
4e7d6779 4440 lappend fhl_list $id
476ca63d 4441 set fhighlights($id) -1
908c3585
PM
4442 puts $filehighlight $id
4443}
4444
4445proc readfhighlight {} {
7fcc92bf 4446 global filehighlight fhighlights curview iddrawn
687c8765 4447 global fhl_list find_dirn
4e7d6779 4448
7eb3cb9c
PM
4449 if {![info exists filehighlight]} {
4450 return 0
4451 }
4452 set nr 0
4453 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4e7d6779
PM
4454 set line [string trim $line]
4455 set i [lsearch -exact $fhl_list $line]
4456 if {$i < 0} continue
4457 for {set j 0} {$j < $i} {incr j} {
4458 set id [lindex $fhl_list $j]
476ca63d 4459 set fhighlights($id) 0
908c3585 4460 }
4e7d6779
PM
4461 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4462 if {$line eq {}} continue
7fcc92bf 4463 if {![commitinview $line $curview]} continue
476ca63d 4464 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
28593d3f 4465 bolden $line mainfontbold
4e7d6779 4466 }
476ca63d 4467 set fhighlights($line) 1
908c3585 4468 }
4e7d6779
PM
4469 if {[eof $filehighlight]} {
4470 # strange...
1ce09dd6 4471 puts "oops, git diff-tree died"
4e7d6779
PM
4472 catch {close $filehighlight}
4473 unset filehighlight
7eb3cb9c 4474 return 0
908c3585 4475 }
687c8765 4476 if {[info exists find_dirn]} {
cca5d946 4477 run findmore
908c3585 4478 }
687c8765 4479 return 1
908c3585
PM
4480}
4481
4fb0fa19 4482proc doesmatch {f} {
687c8765 4483 global findtype findpattern
4fb0fa19 4484
b007ee20 4485 if {$findtype eq [mc "Regexp"]} {
687c8765 4486 return [regexp $findpattern $f]
b007ee20 4487 } elseif {$findtype eq [mc "IgnCase"]} {
4fb0fa19
PM
4488 return [string match -nocase $findpattern $f]
4489 } else {
4490 return [string match $findpattern $f]
4491 }
4492}
4493
60f7a7dc 4494proc askfindhighlight {row id} {
9c311b32 4495 global nhighlights commitinfo iddrawn
4fb0fa19
PM
4496 global findloc
4497 global markingmatches
908c3585
PM
4498
4499 if {![info exists commitinfo($id)]} {
4500 getcommit $id
4501 }
60f7a7dc 4502 set info $commitinfo($id)
908c3585 4503 set isbold 0
b007ee20 4504 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
60f7a7dc 4505 foreach f $info ty $fldtypes {
b007ee20 4506 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4fb0fa19 4507 [doesmatch $f]} {
b007ee20 4508 if {$ty eq [mc "Author"]} {
60f7a7dc 4509 set isbold 2
4fb0fa19 4510 break
60f7a7dc 4511 }
4fb0fa19 4512 set isbold 1
908c3585
PM
4513 }
4514 }
4fb0fa19 4515 if {$isbold && [info exists iddrawn($id)]} {
476ca63d 4516 if {![ishighlighted $id]} {
28593d3f 4517 bolden $id mainfontbold
4fb0fa19 4518 if {$isbold > 1} {
28593d3f 4519 bolden_name $id mainfontbold
4fb0fa19 4520 }
908c3585 4521 }
4fb0fa19 4522 if {$markingmatches} {
005a2f4e 4523 markrowmatches $row $id
908c3585
PM
4524 }
4525 }
476ca63d 4526 set nhighlights($id) $isbold
da7c24dd
PM
4527}
4528
005a2f4e
PM
4529proc markrowmatches {row id} {
4530 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 4531
005a2f4e
PM
4532 set headline [lindex $commitinfo($id) 0]
4533 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
4534 $canv delete match$row
4535 $canv2 delete match$row
b007ee20 4536 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
005a2f4e
PM
4537 set m [findmatches $headline]
4538 if {$m ne {}} {
28593d3f
PM
4539 markmatches $canv $row $headline $linehtag($id) $m \
4540 [$canv itemcget $linehtag($id) -font] $row
005a2f4e 4541 }
4fb0fa19 4542 }
b007ee20 4543 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
005a2f4e
PM
4544 set m [findmatches $author]
4545 if {$m ne {}} {
28593d3f
PM
4546 markmatches $canv2 $row $author $linentag($id) $m \
4547 [$canv2 itemcget $linentag($id) -font] $row
005a2f4e 4548 }
4fb0fa19
PM
4549 }
4550}
4551
164ff275
PM
4552proc vrel_change {name ix op} {
4553 global highlight_related
4554
4555 rhighlight_none
b007ee20 4556 if {$highlight_related ne [mc "None"]} {
7eb3cb9c 4557 run drawvisible
164ff275
PM
4558 }
4559}
4560
4561# prepare for testing whether commits are descendents or ancestors of a
4562proc rhighlight_sel {a} {
4563 global descendent desc_todo ancestor anc_todo
476ca63d 4564 global highlight_related
164ff275
PM
4565
4566 catch {unset descendent}
4567 set desc_todo [list $a]
4568 catch {unset ancestor}
4569 set anc_todo [list $a]
b007ee20 4570 if {$highlight_related ne [mc "None"]} {
164ff275 4571 rhighlight_none
7eb3cb9c 4572 run drawvisible
164ff275
PM
4573 }
4574}
4575
4576proc rhighlight_none {} {
4577 global rhighlights
4578
4e7d6779
PM
4579 catch {unset rhighlights}
4580 unbolden
164ff275
PM
4581}
4582
4583proc is_descendent {a} {
7fcc92bf 4584 global curview children descendent desc_todo
164ff275
PM
4585
4586 set v $curview
7fcc92bf 4587 set la [rowofcommit $a]
164ff275
PM
4588 set todo $desc_todo
4589 set leftover {}
4590 set done 0
4591 for {set i 0} {$i < [llength $todo]} {incr i} {
4592 set do [lindex $todo $i]
7fcc92bf 4593 if {[rowofcommit $do] < $la} {
164ff275
PM
4594 lappend leftover $do
4595 continue
4596 }
4597 foreach nk $children($v,$do) {
4598 if {![info exists descendent($nk)]} {
4599 set descendent($nk) 1
4600 lappend todo $nk
4601 if {$nk eq $a} {
4602 set done 1
4603 }
4604 }
4605 }
4606 if {$done} {
4607 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4608 return
4609 }
4610 }
4611 set descendent($a) 0
4612 set desc_todo $leftover
4613}
4614
4615proc is_ancestor {a} {
7fcc92bf 4616 global curview parents ancestor anc_todo
164ff275
PM
4617
4618 set v $curview
7fcc92bf 4619 set la [rowofcommit $a]
164ff275
PM
4620 set todo $anc_todo
4621 set leftover {}
4622 set done 0
4623 for {set i 0} {$i < [llength $todo]} {incr i} {
4624 set do [lindex $todo $i]
7fcc92bf 4625 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
164ff275
PM
4626 lappend leftover $do
4627 continue
4628 }
7fcc92bf 4629 foreach np $parents($v,$do) {
164ff275
PM
4630 if {![info exists ancestor($np)]} {
4631 set ancestor($np) 1
4632 lappend todo $np
4633 if {$np eq $a} {
4634 set done 1
4635 }
4636 }
4637 }
4638 if {$done} {
4639 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4640 return
4641 }
4642 }
4643 set ancestor($a) 0
4644 set anc_todo $leftover
4645}
4646
4647proc askrelhighlight {row id} {
9c311b32 4648 global descendent highlight_related iddrawn rhighlights
164ff275
PM
4649 global selectedline ancestor
4650
94b4a69f 4651 if {$selectedline eq {}} return
164ff275 4652 set isbold 0
55e34436
CS
4653 if {$highlight_related eq [mc "Descendant"] ||
4654 $highlight_related eq [mc "Not descendant"]} {
164ff275
PM
4655 if {![info exists descendent($id)]} {
4656 is_descendent $id
4657 }
55e34436 4658 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
164ff275
PM
4659 set isbold 1
4660 }
b007ee20
CS
4661 } elseif {$highlight_related eq [mc "Ancestor"] ||
4662 $highlight_related eq [mc "Not ancestor"]} {
164ff275
PM
4663 if {![info exists ancestor($id)]} {
4664 is_ancestor $id
4665 }
b007ee20 4666 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
164ff275
PM
4667 set isbold 1
4668 }
4669 }
4670 if {[info exists iddrawn($id)]} {
476ca63d 4671 if {$isbold && ![ishighlighted $id]} {
28593d3f 4672 bolden $id mainfontbold
164ff275
PM
4673 }
4674 }
476ca63d 4675 set rhighlights($id) $isbold
164ff275
PM
4676}
4677
da7c24dd
PM
4678# Graph layout functions
4679
9f1afe05
PM
4680proc shortids {ids} {
4681 set res {}
4682 foreach id $ids {
4683 if {[llength $id] > 1} {
4684 lappend res [shortids $id]
4685 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4686 lappend res [string range $id 0 7]
4687 } else {
4688 lappend res $id
4689 }
4690 }
4691 return $res
4692}
4693
9f1afe05
PM
4694proc ntimes {n o} {
4695 set ret {}
0380081c
PM
4696 set o [list $o]
4697 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4698 if {($n & $mask) != 0} {
4699 set ret [concat $ret $o]
9f1afe05 4700 }
0380081c 4701 set o [concat $o $o]
9f1afe05 4702 }
0380081c 4703 return $ret
9f1afe05
PM
4704}
4705
9257d8f7
PM
4706proc ordertoken {id} {
4707 global ordertok curview varcid varcstart varctok curview parents children
4708 global nullid nullid2
4709
4710 if {[info exists ordertok($id)]} {
4711 return $ordertok($id)
4712 }
4713 set origid $id
4714 set todo {}
4715 while {1} {
4716 if {[info exists varcid($curview,$id)]} {
4717 set a $varcid($curview,$id)
4718 set p [lindex $varcstart($curview) $a]
4719 } else {
4720 set p [lindex $children($curview,$id) 0]
4721 }
4722 if {[info exists ordertok($p)]} {
4723 set tok $ordertok($p)
4724 break
4725 }
c8c9f3d9
PM
4726 set id [first_real_child $curview,$p]
4727 if {$id eq {}} {
9257d8f7 4728 # it's a root
46308ea1 4729 set tok [lindex $varctok($curview) $varcid($curview,$p)]
9257d8f7
PM
4730 break
4731 }
9257d8f7
PM
4732 if {[llength $parents($curview,$id)] == 1} {
4733 lappend todo [list $p {}]
4734 } else {
4735 set j [lsearch -exact $parents($curview,$id) $p]
4736 if {$j < 0} {
4737 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4738 }
4739 lappend todo [list $p [strrep $j]]
4740 }
4741 }
4742 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4743 set p [lindex $todo $i 0]
4744 append tok [lindex $todo $i 1]
4745 set ordertok($p) $tok
4746 }
4747 set ordertok($origid) $tok
4748 return $tok
4749}
4750
6e8c8707
PM
4751# Work out where id should go in idlist so that order-token
4752# values increase from left to right
4753proc idcol {idlist id {i 0}} {
9257d8f7 4754 set t [ordertoken $id]
e5b37ac1
PM
4755 if {$i < 0} {
4756 set i 0
4757 }
9257d8f7 4758 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
6e8c8707
PM
4759 if {$i > [llength $idlist]} {
4760 set i [llength $idlist]
9f1afe05 4761 }
9257d8f7 4762 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
6e8c8707
PM
4763 incr i
4764 } else {
9257d8f7 4765 if {$t > [ordertoken [lindex $idlist $i]]} {
6e8c8707 4766 while {[incr i] < [llength $idlist] &&
9257d8f7 4767 $t >= [ordertoken [lindex $idlist $i]]} {}
9f1afe05 4768 }
9f1afe05 4769 }
6e8c8707 4770 return $i
9f1afe05
PM
4771}
4772
4773proc initlayout {} {
7fcc92bf 4774 global rowidlist rowisopt rowfinal displayorder parentlist
da7c24dd 4775 global numcommits canvxmax canv
8f7d0cec 4776 global nextcolor
da7c24dd 4777 global colormap rowtextx
9f1afe05 4778
8f7d0cec
PM
4779 set numcommits 0
4780 set displayorder {}
79b2c75e 4781 set parentlist {}
8f7d0cec 4782 set nextcolor 0
0380081c
PM
4783 set rowidlist {}
4784 set rowisopt {}
f5f3c2e2 4785 set rowfinal {}
be0cd098 4786 set canvxmax [$canv cget -width]
50b44ece
PM
4787 catch {unset colormap}
4788 catch {unset rowtextx}
ac1276ab 4789 setcanvscroll
be0cd098
PM
4790}
4791
4792proc setcanvscroll {} {
4793 global canv canv2 canv3 numcommits linespc canvxmax canvy0
ac1276ab 4794 global lastscrollset lastscrollrows
be0cd098
PM
4795
4796 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4797 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4798 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4799 $canv3 conf -scrollregion [list 0 0 0 $ymax]
ac1276ab
PM
4800 set lastscrollset [clock clicks -milliseconds]
4801 set lastscrollrows $numcommits
9f1afe05
PM
4802}
4803
4804proc visiblerows {} {
4805 global canv numcommits linespc
4806
4807 set ymax [lindex [$canv cget -scrollregion] 3]
4808 if {$ymax eq {} || $ymax == 0} return
4809 set f [$canv yview]
4810 set y0 [expr {int([lindex $f 0] * $ymax)}]
4811 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4812 if {$r0 < 0} {
4813 set r0 0
4814 }
4815 set y1 [expr {int([lindex $f 1] * $ymax)}]
4816 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4817 if {$r1 >= $numcommits} {
4818 set r1 [expr {$numcommits - 1}]
4819 }
4820 return [list $r0 $r1]
4821}
4822
f5f3c2e2 4823proc layoutmore {} {
38dfe939 4824 global commitidx viewcomplete curview
94b4a69f 4825 global numcommits pending_select curview
d375ef9b 4826 global lastscrollset lastscrollrows
ac1276ab
PM
4827
4828 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4829 [clock clicks -milliseconds] - $lastscrollset > 500} {
a2c22362
PM
4830 setcanvscroll
4831 }
d94f8cd6 4832 if {[info exists pending_select] &&
7fcc92bf 4833 [commitinview $pending_select $curview]} {
567c34e0 4834 update
7fcc92bf 4835 selectline [rowofcommit $pending_select] 1
d94f8cd6 4836 }
ac1276ab 4837 drawvisible
219ea3a9
PM
4838}
4839
cdc8429c
PM
4840# With path limiting, we mightn't get the actual HEAD commit,
4841# so ask git rev-list what is the first ancestor of HEAD that
4842# touches a file in the path limit.
4843proc get_viewmainhead {view} {
4844 global viewmainheadid vfilelimit viewinstances mainheadid
4845
4846 catch {
4847 set rfd [open [concat | git rev-list -1 $mainheadid \
4848 -- $vfilelimit($view)] r]
4849 set j [reg_instance $rfd]
4850 lappend viewinstances($view) $j
4851 fconfigure $rfd -blocking 0
4852 filerun $rfd [list getviewhead $rfd $j $view]
4853 set viewmainheadid($curview) {}
4854 }
4855}
4856
4857# git rev-list should give us just 1 line to use as viewmainheadid($view)
4858proc getviewhead {fd inst view} {
4859 global viewmainheadid commfd curview viewinstances showlocalchanges
4860
4861 set id {}
4862 if {[gets $fd line] < 0} {
4863 if {![eof $fd]} {
4864 return 1
4865 }
4866 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
4867 set id $line
4868 }
4869 set viewmainheadid($view) $id
4870 close $fd
4871 unset commfd($inst)
4872 set i [lsearch -exact $viewinstances($view) $inst]
4873 if {$i >= 0} {
4874 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
4875 }
4876 if {$showlocalchanges && $id ne {} && $view == $curview} {
4877 doshowlocalchanges
4878 }
4879 return 0
4880}
4881
219ea3a9 4882proc doshowlocalchanges {} {
cdc8429c 4883 global curview viewmainheadid
219ea3a9 4884
cdc8429c
PM
4885 if {$viewmainheadid($curview) eq {}} return
4886 if {[commitinview $viewmainheadid($curview) $curview]} {
219ea3a9 4887 dodiffindex
38dfe939 4888 } else {
cdc8429c 4889 interestedin $viewmainheadid($curview) dodiffindex
219ea3a9
PM
4890 }
4891}
4892
4893proc dohidelocalchanges {} {
7fcc92bf 4894 global nullid nullid2 lserial curview
219ea3a9 4895
7fcc92bf 4896 if {[commitinview $nullid $curview]} {
b8a938cf 4897 removefakerow $nullid
8f489363 4898 }
7fcc92bf 4899 if {[commitinview $nullid2 $curview]} {
b8a938cf 4900 removefakerow $nullid2
219ea3a9
PM
4901 }
4902 incr lserial
4903}
4904
8f489363 4905# spawn off a process to do git diff-index --cached HEAD
219ea3a9 4906proc dodiffindex {} {
cdc8429c 4907 global lserial showlocalchanges vfilelimit curview
cb8329aa 4908 global isworktree
219ea3a9 4909
cb8329aa 4910 if {!$showlocalchanges || !$isworktree} return
219ea3a9 4911 incr lserial
cdc8429c
PM
4912 set cmd "|git diff-index --cached HEAD"
4913 if {$vfilelimit($curview) ne {}} {
4914 set cmd [concat $cmd -- $vfilelimit($curview)]
4915 }
4916 set fd [open $cmd r]
219ea3a9 4917 fconfigure $fd -blocking 0
e439e092
AG
4918 set i [reg_instance $fd]
4919 filerun $fd [list readdiffindex $fd $lserial $i]
219ea3a9
PM
4920}
4921
e439e092 4922proc readdiffindex {fd serial inst} {
cdc8429c
PM
4923 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
4924 global vfilelimit
219ea3a9 4925
8f489363 4926 set isdiff 1
219ea3a9 4927 if {[gets $fd line] < 0} {
8f489363
PM
4928 if {![eof $fd]} {
4929 return 1
219ea3a9 4930 }
8f489363 4931 set isdiff 0
219ea3a9
PM
4932 }
4933 # we only need to see one line and we don't really care what it says...
e439e092 4934 stop_instance $inst
219ea3a9 4935
24f7a667
PM
4936 if {$serial != $lserial} {
4937 return 0
8f489363
PM
4938 }
4939
24f7a667 4940 # now see if there are any local changes not checked in to the index
cdc8429c
PM
4941 set cmd "|git diff-files"
4942 if {$vfilelimit($curview) ne {}} {
4943 set cmd [concat $cmd -- $vfilelimit($curview)]
4944 }
4945 set fd [open $cmd r]
24f7a667 4946 fconfigure $fd -blocking 0
e439e092
AG
4947 set i [reg_instance $fd]
4948 filerun $fd [list readdifffiles $fd $serial $i]
24f7a667
PM
4949
4950 if {$isdiff && ![commitinview $nullid2 $curview]} {
8f489363 4951 # add the line for the changes in the index to the graph
d990cedf 4952 set hl [mc "Local changes checked in to index but not committed"]
8f489363
PM
4953 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4954 set commitdata($nullid2) "\n $hl\n"
fc2a256f 4955 if {[commitinview $nullid $curview]} {
b8a938cf 4956 removefakerow $nullid
fc2a256f 4957 }
cdc8429c 4958 insertfakerow $nullid2 $viewmainheadid($curview)
24f7a667 4959 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
cdc8429c
PM
4960 if {[commitinview $nullid $curview]} {
4961 removefakerow $nullid
4962 }
b8a938cf 4963 removefakerow $nullid2
8f489363
PM
4964 }
4965 return 0
4966}
4967
e439e092 4968proc readdifffiles {fd serial inst} {
cdc8429c 4969 global viewmainheadid nullid nullid2 curview
8f489363
PM
4970 global commitinfo commitdata lserial
4971
4972 set isdiff 1
4973 if {[gets $fd line] < 0} {
4974 if {![eof $fd]} {
4975 return 1
4976 }
4977 set isdiff 0
4978 }
4979 # we only need to see one line and we don't really care what it says...
e439e092 4980 stop_instance $inst
8f489363 4981
24f7a667
PM
4982 if {$serial != $lserial} {
4983 return 0
4984 }
4985
4986 if {$isdiff && ![commitinview $nullid $curview]} {
219ea3a9 4987 # add the line for the local diff to the graph
d990cedf 4988 set hl [mc "Local uncommitted changes, not checked in to index"]
219ea3a9
PM
4989 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4990 set commitdata($nullid) "\n $hl\n"
7fcc92bf
PM
4991 if {[commitinview $nullid2 $curview]} {
4992 set p $nullid2
4993 } else {
cdc8429c 4994 set p $viewmainheadid($curview)
7fcc92bf 4995 }
b8a938cf 4996 insertfakerow $nullid $p
24f7a667 4997 } elseif {!$isdiff && [commitinview $nullid $curview]} {
b8a938cf 4998 removefakerow $nullid
219ea3a9
PM
4999 }
5000 return 0
9f1afe05
PM
5001}
5002
8f0bc7e9 5003proc nextuse {id row} {
7fcc92bf 5004 global curview children
9f1afe05 5005
8f0bc7e9
PM
5006 if {[info exists children($curview,$id)]} {
5007 foreach kid $children($curview,$id) {
7fcc92bf 5008 if {![commitinview $kid $curview]} {
0380081c
PM
5009 return -1
5010 }
7fcc92bf
PM
5011 if {[rowofcommit $kid] > $row} {
5012 return [rowofcommit $kid]
9f1afe05 5013 }
9f1afe05 5014 }
8f0bc7e9 5015 }
7fcc92bf
PM
5016 if {[commitinview $id $curview]} {
5017 return [rowofcommit $id]
8f0bc7e9
PM
5018 }
5019 return -1
5020}
5021
f5f3c2e2 5022proc prevuse {id row} {
7fcc92bf 5023 global curview children
f5f3c2e2
PM
5024
5025 set ret -1
5026 if {[info exists children($curview,$id)]} {
5027 foreach kid $children($curview,$id) {
7fcc92bf
PM
5028 if {![commitinview $kid $curview]} break
5029 if {[rowofcommit $kid] < $row} {
5030 set ret [rowofcommit $kid]
7b459a1c 5031 }
7b459a1c 5032 }
f5f3c2e2
PM
5033 }
5034 return $ret
5035}
5036
0380081c
PM
5037proc make_idlist {row} {
5038 global displayorder parentlist uparrowlen downarrowlen mingaplen
9257d8f7 5039 global commitidx curview children
9f1afe05 5040
0380081c
PM
5041 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5042 if {$r < 0} {
5043 set r 0
8f0bc7e9 5044 }
0380081c
PM
5045 set ra [expr {$row - $downarrowlen}]
5046 if {$ra < 0} {
5047 set ra 0
5048 }
5049 set rb [expr {$row + $uparrowlen}]
5050 if {$rb > $commitidx($curview)} {
5051 set rb $commitidx($curview)
5052 }
7fcc92bf 5053 make_disporder $r [expr {$rb + 1}]
0380081c
PM
5054 set ids {}
5055 for {} {$r < $ra} {incr r} {
5056 set nextid [lindex $displayorder [expr {$r + 1}]]
5057 foreach p [lindex $parentlist $r] {
5058 if {$p eq $nextid} continue
5059 set rn [nextuse $p $r]
5060 if {$rn >= $row &&
5061 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
9257d8f7 5062 lappend ids [list [ordertoken $p] $p]
9f1afe05 5063 }
9f1afe05 5064 }
0380081c
PM
5065 }
5066 for {} {$r < $row} {incr r} {
5067 set nextid [lindex $displayorder [expr {$r + 1}]]
5068 foreach p [lindex $parentlist $r] {
5069 if {$p eq $nextid} continue
5070 set rn [nextuse $p $r]
5071 if {$rn < 0 || $rn >= $row} {
9257d8f7 5072 lappend ids [list [ordertoken $p] $p]
9f1afe05 5073 }
9f1afe05 5074 }
0380081c
PM
5075 }
5076 set id [lindex $displayorder $row]
9257d8f7 5077 lappend ids [list [ordertoken $id] $id]
0380081c
PM
5078 while {$r < $rb} {
5079 foreach p [lindex $parentlist $r] {
5080 set firstkid [lindex $children($curview,$p) 0]
7fcc92bf 5081 if {[rowofcommit $firstkid] < $row} {
9257d8f7 5082 lappend ids [list [ordertoken $p] $p]
9f1afe05 5083 }
9f1afe05 5084 }
0380081c
PM
5085 incr r
5086 set id [lindex $displayorder $r]
5087 if {$id ne {}} {
5088 set firstkid [lindex $children($curview,$id) 0]
7fcc92bf 5089 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
9257d8f7 5090 lappend ids [list [ordertoken $id] $id]
0380081c 5091 }
9f1afe05 5092 }
9f1afe05 5093 }
0380081c
PM
5094 set idlist {}
5095 foreach idx [lsort -unique $ids] {
5096 lappend idlist [lindex $idx 1]
5097 }
5098 return $idlist
9f1afe05
PM
5099}
5100
f5f3c2e2
PM
5101proc rowsequal {a b} {
5102 while {[set i [lsearch -exact $a {}]] >= 0} {
5103 set a [lreplace $a $i $i]
5104 }
5105 while {[set i [lsearch -exact $b {}]] >= 0} {
5106 set b [lreplace $b $i $i]
5107 }
5108 return [expr {$a eq $b}]
9f1afe05
PM
5109}
5110
f5f3c2e2
PM
5111proc makeupline {id row rend col} {
5112 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 5113
f5f3c2e2
PM
5114 for {set r $rend} {1} {set r $rstart} {
5115 set rstart [prevuse $id $r]
5116 if {$rstart < 0} return
5117 if {$rstart < $row} break
5118 }
5119 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5120 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 5121 }
f5f3c2e2
PM
5122 for {set r $rstart} {[incr r] <= $row} {} {
5123 set idlist [lindex $rowidlist $r]
5124 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5125 set col [idcol $idlist $id $col]
5126 lset rowidlist $r [linsert $idlist $col $id]
5127 changedrow $r
5128 }
9f1afe05
PM
5129 }
5130}
5131
0380081c 5132proc layoutrows {row endrow} {
f5f3c2e2 5133 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
5134 global uparrowlen downarrowlen maxwidth mingaplen
5135 global children parentlist
7fcc92bf 5136 global commitidx viewcomplete curview
9f1afe05 5137
7fcc92bf 5138 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
0380081c
PM
5139 set idlist {}
5140 if {$row > 0} {
f56782ae
PM
5141 set rm1 [expr {$row - 1}]
5142 foreach id [lindex $rowidlist $rm1] {
0380081c
PM
5143 if {$id ne {}} {
5144 lappend idlist $id
5145 }
5146 }
f56782ae 5147 set final [lindex $rowfinal $rm1]
79b2c75e 5148 }
0380081c
PM
5149 for {} {$row < $endrow} {incr row} {
5150 set rm1 [expr {$row - 1}]
f56782ae 5151 if {$rm1 < 0 || $idlist eq {}} {
0380081c 5152 set idlist [make_idlist $row]
f5f3c2e2 5153 set final 1
0380081c
PM
5154 } else {
5155 set id [lindex $displayorder $rm1]
5156 set col [lsearch -exact $idlist $id]
5157 set idlist [lreplace $idlist $col $col]
5158 foreach p [lindex $parentlist $rm1] {
5159 if {[lsearch -exact $idlist $p] < 0} {
5160 set col [idcol $idlist $p $col]
5161 set idlist [linsert $idlist $col $p]
f5f3c2e2
PM
5162 # if not the first child, we have to insert a line going up
5163 if {$id ne [lindex $children($curview,$p) 0]} {
5164 makeupline $p $rm1 $row $col
5165 }
0380081c
PM
5166 }
5167 }
5168 set id [lindex $displayorder $row]
5169 if {$row > $downarrowlen} {
5170 set termrow [expr {$row - $downarrowlen - 1}]
5171 foreach p [lindex $parentlist $termrow] {
5172 set i [lsearch -exact $idlist $p]
5173 if {$i < 0} continue
5174 set nr [nextuse $p $termrow]
5175 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5176 set idlist [lreplace $idlist $i $i]
5177 }
5178 }
5179 }
5180 set col [lsearch -exact $idlist $id]
5181 if {$col < 0} {
5182 set col [idcol $idlist $id]
5183 set idlist [linsert $idlist $col $id]
f5f3c2e2
PM
5184 if {$children($curview,$id) ne {}} {
5185 makeupline $id $rm1 $row $col
5186 }
0380081c
PM
5187 }
5188 set r [expr {$row + $uparrowlen - 1}]
5189 if {$r < $commitidx($curview)} {
5190 set x $col
5191 foreach p [lindex $parentlist $r] {
5192 if {[lsearch -exact $idlist $p] >= 0} continue
5193 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5194 if {[rowofcommit $fk] < $row} {
0380081c
PM
5195 set x [idcol $idlist $p $x]
5196 set idlist [linsert $idlist $x $p]
5197 }
5198 }
5199 if {[incr r] < $commitidx($curview)} {
5200 set p [lindex $displayorder $r]
5201 if {[lsearch -exact $idlist $p] < 0} {
5202 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5203 if {$fk ne {} && [rowofcommit $fk] < $row} {
0380081c
PM
5204 set x [idcol $idlist $p $x]
5205 set idlist [linsert $idlist $x $p]
5206 }
5207 }
5208 }
5209 }
5210 }
f5f3c2e2
PM
5211 if {$final && !$viewcomplete($curview) &&
5212 $row + $uparrowlen + $mingaplen + $downarrowlen
5213 >= $commitidx($curview)} {
5214 set final 0
5215 }
0380081c
PM
5216 set l [llength $rowidlist]
5217 if {$row == $l} {
5218 lappend rowidlist $idlist
5219 lappend rowisopt 0
f5f3c2e2 5220 lappend rowfinal $final
0380081c 5221 } elseif {$row < $l} {
f5f3c2e2 5222 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
0380081c
PM
5223 lset rowidlist $row $idlist
5224 changedrow $row
5225 }
f56782ae 5226 lset rowfinal $row $final
0380081c 5227 } else {
f5f3c2e2
PM
5228 set pad [ntimes [expr {$row - $l}] {}]
5229 set rowidlist [concat $rowidlist $pad]
0380081c 5230 lappend rowidlist $idlist
f5f3c2e2
PM
5231 set rowfinal [concat $rowfinal $pad]
5232 lappend rowfinal $final
0380081c
PM
5233 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5234 }
9f1afe05 5235 }
0380081c 5236 return $row
9f1afe05
PM
5237}
5238
0380081c
PM
5239proc changedrow {row} {
5240 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 5241
0380081c
PM
5242 set l [llength $rowisopt]
5243 if {$row < $l} {
5244 lset rowisopt $row 0
5245 if {$row + 1 < $l} {
5246 lset rowisopt [expr {$row + 1}] 0
5247 if {$row + 2 < $l} {
5248 lset rowisopt [expr {$row + 2}] 0
5249 }
5250 }
5251 }
5252 set id [lindex $displayorder $row]
5253 if {[info exists iddrawn($id)]} {
5254 set need_redisplay 1
9f1afe05
PM
5255 }
5256}
5257
5258proc insert_pad {row col npad} {
6e8c8707 5259 global rowidlist
9f1afe05
PM
5260
5261 set pad [ntimes $npad {}]
e341c06d
PM
5262 set idlist [lindex $rowidlist $row]
5263 set bef [lrange $idlist 0 [expr {$col - 1}]]
5264 set aft [lrange $idlist $col end]
5265 set i [lsearch -exact $aft {}]
5266 if {$i > 0} {
5267 set aft [lreplace $aft $i $i]
5268 }
5269 lset rowidlist $row [concat $bef $pad $aft]
0380081c 5270 changedrow $row
9f1afe05
PM
5271}
5272
5273proc optimize_rows {row col endrow} {
0380081c 5274 global rowidlist rowisopt displayorder curview children
9f1afe05 5275
6e8c8707
PM
5276 if {$row < 1} {
5277 set row 1
5278 }
0380081c
PM
5279 for {} {$row < $endrow} {incr row; set col 0} {
5280 if {[lindex $rowisopt $row]} continue
9f1afe05 5281 set haspad 0
6e8c8707
PM
5282 set y0 [expr {$row - 1}]
5283 set ym [expr {$row - 2}]
0380081c
PM
5284 set idlist [lindex $rowidlist $row]
5285 set previdlist [lindex $rowidlist $y0]
5286 if {$idlist eq {} || $previdlist eq {}} continue
5287 if {$ym >= 0} {
5288 set pprevidlist [lindex $rowidlist $ym]
5289 if {$pprevidlist eq {}} continue
5290 } else {
5291 set pprevidlist {}
5292 }
6e8c8707
PM
5293 set x0 -1
5294 set xm -1
5295 for {} {$col < [llength $idlist]} {incr col} {
5296 set id [lindex $idlist $col]
5297 if {[lindex $previdlist $col] eq $id} continue
5298 if {$id eq {}} {
9f1afe05
PM
5299 set haspad 1
5300 continue
5301 }
6e8c8707
PM
5302 set x0 [lsearch -exact $previdlist $id]
5303 if {$x0 < 0} continue
5304 set z [expr {$x0 - $col}]
9f1afe05 5305 set isarrow 0
6e8c8707
PM
5306 set z0 {}
5307 if {$ym >= 0} {
5308 set xm [lsearch -exact $pprevidlist $id]
5309 if {$xm >= 0} {
5310 set z0 [expr {$xm - $x0}]
5311 }
5312 }
9f1afe05 5313 if {$z0 eq {}} {
92ed666f
PM
5314 # if row y0 is the first child of $id then it's not an arrow
5315 if {[lindex $children($curview,$id) 0] ne
5316 [lindex $displayorder $y0]} {
9f1afe05
PM
5317 set isarrow 1
5318 }
5319 }
e341c06d
PM
5320 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5321 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5322 set isarrow 1
5323 }
3fc4279a
PM
5324 # Looking at lines from this row to the previous row,
5325 # make them go straight up if they end in an arrow on
5326 # the previous row; otherwise make them go straight up
5327 # or at 45 degrees.
9f1afe05 5328 if {$z < -1 || ($z < 0 && $isarrow)} {
3fc4279a
PM
5329 # Line currently goes left too much;
5330 # insert pads in the previous row, then optimize it
9f1afe05 5331 set npad [expr {-1 - $z + $isarrow}]
9f1afe05
PM
5332 insert_pad $y0 $x0 $npad
5333 if {$y0 > 0} {
5334 optimize_rows $y0 $x0 $row
5335 }
6e8c8707
PM
5336 set previdlist [lindex $rowidlist $y0]
5337 set x0 [lsearch -exact $previdlist $id]
5338 set z [expr {$x0 - $col}]
5339 if {$z0 ne {}} {
5340 set pprevidlist [lindex $rowidlist $ym]
5341 set xm [lsearch -exact $pprevidlist $id]
5342 set z0 [expr {$xm - $x0}]
5343 }
9f1afe05 5344 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3fc4279a 5345 # Line currently goes right too much;
6e8c8707 5346 # insert pads in this line
9f1afe05 5347 set npad [expr {$z - 1 + $isarrow}]
e341c06d
PM
5348 insert_pad $row $col $npad
5349 set idlist [lindex $rowidlist $row]
9f1afe05 5350 incr col $npad
6e8c8707 5351 set z [expr {$x0 - $col}]
9f1afe05
PM
5352 set haspad 1
5353 }
6e8c8707 5354 if {$z0 eq {} && !$isarrow && $ym >= 0} {
eb447a12 5355 # this line links to its first child on row $row-2
6e8c8707
PM
5356 set id [lindex $displayorder $ym]
5357 set xc [lsearch -exact $pprevidlist $id]
eb447a12
PM
5358 if {$xc >= 0} {
5359 set z0 [expr {$xc - $x0}]
5360 }
5361 }
3fc4279a 5362 # avoid lines jigging left then immediately right
9f1afe05
PM
5363 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5364 insert_pad $y0 $x0 1
6e8c8707
PM
5365 incr x0
5366 optimize_rows $y0 $x0 $row
5367 set previdlist [lindex $rowidlist $y0]
9f1afe05
PM
5368 }
5369 }
5370 if {!$haspad} {
3fc4279a 5371 # Find the first column that doesn't have a line going right
9f1afe05 5372 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
6e8c8707
PM
5373 set id [lindex $idlist $col]
5374 if {$id eq {}} break
5375 set x0 [lsearch -exact $previdlist $id]
5376 if {$x0 < 0} {
eb447a12 5377 # check if this is the link to the first child
92ed666f
PM
5378 set kid [lindex $displayorder $y0]
5379 if {[lindex $children($curview,$id) 0] eq $kid} {
eb447a12 5380 # it is, work out offset to child
92ed666f 5381 set x0 [lsearch -exact $previdlist $kid]
eb447a12
PM
5382 }
5383 }
6e8c8707 5384 if {$x0 <= $col} break
9f1afe05 5385 }
3fc4279a 5386 # Insert a pad at that column as long as it has a line and
6e8c8707
PM
5387 # isn't the last column
5388 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
9f1afe05 5389 set idlist [linsert $idlist $col {}]
0380081c
PM
5390 lset rowidlist $row $idlist
5391 changedrow $row
9f1afe05
PM
5392 }
5393 }
9f1afe05
PM
5394 }
5395}
5396
5397proc xc {row col} {
5398 global canvx0 linespc
5399 return [expr {$canvx0 + $col * $linespc}]
5400}
5401
5402proc yc {row} {
5403 global canvy0 linespc
5404 return [expr {$canvy0 + $row * $linespc}]
5405}
5406
c934a8a3
PM
5407proc linewidth {id} {
5408 global thickerline lthickness
5409
5410 set wid $lthickness
5411 if {[info exists thickerline] && $id eq $thickerline} {
5412 set wid [expr {2 * $lthickness}]
5413 }
5414 return $wid
5415}
5416
50b44ece 5417proc rowranges {id} {
7fcc92bf 5418 global curview children uparrowlen downarrowlen
92ed666f 5419 global rowidlist
50b44ece 5420
92ed666f
PM
5421 set kids $children($curview,$id)
5422 if {$kids eq {}} {
5423 return {}
66e46f37 5424 }
92ed666f
PM
5425 set ret {}
5426 lappend kids $id
5427 foreach child $kids {
7fcc92bf
PM
5428 if {![commitinview $child $curview]} break
5429 set row [rowofcommit $child]
92ed666f
PM
5430 if {![info exists prev]} {
5431 lappend ret [expr {$row + 1}]
322a8cc9 5432 } else {
92ed666f 5433 if {$row <= $prevrow} {
7fcc92bf 5434 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
92ed666f
PM
5435 }
5436 # see if the line extends the whole way from prevrow to row
5437 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5438 [lsearch -exact [lindex $rowidlist \
5439 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5440 # it doesn't, see where it ends
5441 set r [expr {$prevrow + $downarrowlen}]
5442 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5443 while {[incr r -1] > $prevrow &&
5444 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5445 } else {
5446 while {[incr r] <= $row &&
5447 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5448 incr r -1
5449 }
5450 lappend ret $r
5451 # see where it starts up again
5452 set r [expr {$row - $uparrowlen}]
5453 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5454 while {[incr r] < $row &&
5455 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5456 } else {
5457 while {[incr r -1] >= $prevrow &&
5458 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5459 incr r
5460 }
5461 lappend ret $r
5462 }
5463 }
5464 if {$child eq $id} {
5465 lappend ret $row
322a8cc9 5466 }
7fcc92bf 5467 set prev $child
92ed666f 5468 set prevrow $row
9f1afe05 5469 }
92ed666f 5470 return $ret
322a8cc9
PM
5471}
5472
5473proc drawlineseg {id row endrow arrowlow} {
5474 global rowidlist displayorder iddrawn linesegs
e341c06d 5475 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
5476
5477 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5478 set le [expr {$row + 1}]
5479 set arrowhigh 1
9f1afe05 5480 while {1} {
322a8cc9
PM
5481 set c [lsearch -exact [lindex $rowidlist $le] $id]
5482 if {$c < 0} {
5483 incr le -1
5484 break
5485 }
5486 lappend cols $c
5487 set x [lindex $displayorder $le]
5488 if {$x eq $id} {
5489 set arrowhigh 0
5490 break
9f1afe05 5491 }
322a8cc9
PM
5492 if {[info exists iddrawn($x)] || $le == $endrow} {
5493 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5494 if {$c >= 0} {
5495 lappend cols $c
5496 set arrowhigh 0
5497 }
5498 break
5499 }
5500 incr le
9f1afe05 5501 }
322a8cc9
PM
5502 if {$le <= $row} {
5503 return $row
5504 }
5505
5506 set lines {}
5507 set i 0
5508 set joinhigh 0
5509 if {[info exists linesegs($id)]} {
5510 set lines $linesegs($id)
5511 foreach li $lines {
5512 set r0 [lindex $li 0]
5513 if {$r0 > $row} {
5514 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5515 set joinhigh 1
5516 }
5517 break
5518 }
5519 incr i
5520 }
5521 }
5522 set joinlow 0
5523 if {$i > 0} {
5524 set li [lindex $lines [expr {$i-1}]]
5525 set r1 [lindex $li 1]
5526 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5527 set joinlow 1
5528 }
5529 }
5530
5531 set x [lindex $cols [expr {$le - $row}]]
5532 set xp [lindex $cols [expr {$le - 1 - $row}]]
5533 set dir [expr {$xp - $x}]
5534 if {$joinhigh} {
5535 set ith [lindex $lines $i 2]
5536 set coords [$canv coords $ith]
5537 set ah [$canv itemcget $ith -arrow]
5538 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5539 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5540 if {$x2 ne {} && $x - $x2 == $dir} {
5541 set coords [lrange $coords 0 end-2]
5542 }
5543 } else {
5544 set coords [list [xc $le $x] [yc $le]]
5545 }
5546 if {$joinlow} {
5547 set itl [lindex $lines [expr {$i-1}] 2]
5548 set al [$canv itemcget $itl -arrow]
5549 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d
PM
5550 } elseif {$arrowlow} {
5551 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5552 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5553 set arrowlow 0
5554 }
322a8cc9
PM
5555 }
5556 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5557 for {set y $le} {[incr y -1] > $row} {} {
5558 set x $xp
5559 set xp [lindex $cols [expr {$y - 1 - $row}]]
5560 set ndir [expr {$xp - $x}]
5561 if {$dir != $ndir || $xp < 0} {
5562 lappend coords [xc $y $x] [yc $y]
5563 }
5564 set dir $ndir
5565 }
5566 if {!$joinlow} {
5567 if {$xp < 0} {
5568 # join parent line to first child
5569 set ch [lindex $displayorder $row]
5570 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5571 if {$xc < 0} {
5572 puts "oops: drawlineseg: child $ch not on row $row"
e341c06d
PM
5573 } elseif {$xc != $x} {
5574 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5575 set d [expr {int(0.5 * $linespc)}]
5576 set x1 [xc $row $x]
5577 if {$xc < $x} {
5578 set x2 [expr {$x1 - $d}]
5579 } else {
5580 set x2 [expr {$x1 + $d}]
5581 }
5582 set y2 [yc $row]
5583 set y1 [expr {$y2 + $d}]
5584 lappend coords $x1 $y1 $x2 $y2
5585 } elseif {$xc < $x - 1} {
322a8cc9
PM
5586 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5587 } elseif {$xc > $x + 1} {
5588 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5589 }
5590 set x $xc
eb447a12 5591 }
322a8cc9
PM
5592 lappend coords [xc $row $x] [yc $row]
5593 } else {
5594 set xn [xc $row $xp]
5595 set yn [yc $row]
e341c06d 5596 lappend coords $xn $yn
322a8cc9
PM
5597 }
5598 if {!$joinhigh} {
322a8cc9
PM
5599 assigncolor $id
5600 set t [$canv create line $coords -width [linewidth $id] \
5601 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5602 $canv lower $t
5603 bindline $t $id
5604 set lines [linsert $lines $i [list $row $le $t]]
5605 } else {
5606 $canv coords $ith $coords
5607 if {$arrow ne $ah} {
5608 $canv itemconf $ith -arrow $arrow
5609 }
5610 lset lines $i 0 $row
5611 }
5612 } else {
5613 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5614 set ndir [expr {$xo - $xp}]
5615 set clow [$canv coords $itl]
5616 if {$dir == $ndir} {
5617 set clow [lrange $clow 2 end]
5618 }
5619 set coords [concat $coords $clow]
5620 if {!$joinhigh} {
5621 lset lines [expr {$i-1}] 1 $le
322a8cc9
PM
5622 } else {
5623 # coalesce two pieces
5624 $canv delete $ith
5625 set b [lindex $lines [expr {$i-1}] 0]
5626 set e [lindex $lines $i 1]
5627 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5628 }
5629 $canv coords $itl $coords
5630 if {$arrow ne $al} {
5631 $canv itemconf $itl -arrow $arrow
879e8b1a
PM
5632 }
5633 }
322a8cc9
PM
5634
5635 set linesegs($id) $lines
5636 return $le
9f1afe05
PM
5637}
5638
322a8cc9
PM
5639proc drawparentlinks {id row} {
5640 global rowidlist canv colormap curview parentlist
513a54dc 5641 global idpos linespc
9f1afe05 5642
322a8cc9
PM
5643 set rowids [lindex $rowidlist $row]
5644 set col [lsearch -exact $rowids $id]
5645 if {$col < 0} return
5646 set olds [lindex $parentlist $row]
9f1afe05
PM
5647 set row2 [expr {$row + 1}]
5648 set x [xc $row $col]
5649 set y [yc $row]
5650 set y2 [yc $row2]
e341c06d 5651 set d [expr {int(0.5 * $linespc)}]
513a54dc 5652 set ymid [expr {$y + $d}]
8f7d0cec 5653 set ids [lindex $rowidlist $row2]
9f1afe05
PM
5654 # rmx = right-most X coord used
5655 set rmx 0
9f1afe05 5656 foreach p $olds {
f3408449
PM
5657 set i [lsearch -exact $ids $p]
5658 if {$i < 0} {
5659 puts "oops, parent $p of $id not in list"
5660 continue
5661 }
5662 set x2 [xc $row2 $i]
5663 if {$x2 > $rmx} {
5664 set rmx $x2
5665 }
513a54dc
PM
5666 set j [lsearch -exact $rowids $p]
5667 if {$j < 0} {
eb447a12
PM
5668 # drawlineseg will do this one for us
5669 continue
5670 }
9f1afe05
PM
5671 assigncolor $p
5672 # should handle duplicated parents here...
5673 set coords [list $x $y]
513a54dc
PM
5674 if {$i != $col} {
5675 # if attaching to a vertical segment, draw a smaller
5676 # slant for visual distinctness
5677 if {$i == $j} {
5678 if {$i < $col} {
5679 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5680 } else {
5681 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5682 }
5683 } elseif {$i < $col && $i < $j} {
5684 # segment slants towards us already
5685 lappend coords [xc $row $j] $y
5686 } else {
5687 if {$i < $col - 1} {
5688 lappend coords [expr {$x2 + $linespc}] $y
5689 } elseif {$i > $col + 1} {
5690 lappend coords [expr {$x2 - $linespc}] $y
5691 }
5692 lappend coords $x2 $y2
5693 }
5694 } else {
5695 lappend coords $x2 $y2
9f1afe05 5696 }
c934a8a3 5697 set t [$canv create line $coords -width [linewidth $p] \
9f1afe05
PM
5698 -fill $colormap($p) -tags lines.$p]
5699 $canv lower $t
5700 bindline $t $p
5701 }
322a8cc9
PM
5702 if {$rmx > [lindex $idpos($id) 1]} {
5703 lset idpos($id) 1 $rmx
5704 redrawtags $id
5705 }
9f1afe05
PM
5706}
5707
c934a8a3 5708proc drawlines {id} {
322a8cc9 5709 global canv
9f1afe05 5710
322a8cc9 5711 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
5712}
5713
322a8cc9 5714proc drawcmittext {id row col} {
7fcc92bf
PM
5715 global linespc canv canv2 canv3 fgcolor curview
5716 global cmitlisted commitinfo rowidlist parentlist
9f1afe05 5717 global rowtextx idpos idtags idheads idotherrefs
0380081c 5718 global linehtag linentag linedtag selectedline
b9fdba7f 5719 global canvxmax boldids boldnameids fgcolor markedid
d277e89f 5720 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
9f1afe05 5721
1407ade9 5722 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
7fcc92bf 5723 set listed $cmitlisted($curview,$id)
219ea3a9
PM
5724 if {$id eq $nullid} {
5725 set ofill red
8f489363 5726 } elseif {$id eq $nullid2} {
ef3192b8 5727 set ofill green
c11ff120
PM
5728 } elseif {$id eq $mainheadid} {
5729 set ofill yellow
219ea3a9 5730 } else {
c11ff120 5731 set ofill [lindex $circlecolors $listed]
219ea3a9 5732 }
9f1afe05
PM
5733 set x [xc $row $col]
5734 set y [yc $row]
5735 set orad [expr {$linespc / 3}]
1407ade9 5736 if {$listed <= 2} {
c961b228
PM
5737 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5738 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5739 -fill $ofill -outline $fgcolor -width 1 -tags circle]
1407ade9 5740 } elseif {$listed == 3} {
c961b228
PM
5741 # triangle pointing left for left-side commits
5742 set t [$canv create polygon \
5743 [expr {$x - $orad}] $y \
5744 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5745 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5746 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5747 } else {
5748 # triangle pointing right for right-side commits
5749 set t [$canv create polygon \
5750 [expr {$x + $orad - 1}] $y \
5751 [expr {$x - $orad}] [expr {$y - $orad}] \
5752 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5753 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5754 }
c11ff120 5755 set circleitem($row) $t
9f1afe05
PM
5756 $canv raise $t
5757 $canv bind $t <1> {selcanvline {} %x %y}
322a8cc9
PM
5758 set rmx [llength [lindex $rowidlist $row]]
5759 set olds [lindex $parentlist $row]
5760 if {$olds ne {}} {
5761 set nextids [lindex $rowidlist [expr {$row + 1}]]
5762 foreach p $olds {
5763 set i [lsearch -exact $nextids $p]
5764 if {$i > $rmx} {
5765 set rmx $i
5766 }
5767 }
9f1afe05 5768 }
322a8cc9 5769 set xt [xc $row $rmx]
9f1afe05
PM
5770 set rowtextx($row) $xt
5771 set idpos($id) [list $x $xt $y]
5772 if {[info exists idtags($id)] || [info exists idheads($id)]
5773 || [info exists idotherrefs($id)]} {
5774 set xt [drawtags $id $x $xt $y]
5775 }
5776 set headline [lindex $commitinfo($id) 0]
5777 set name [lindex $commitinfo($id) 1]
5778 set date [lindex $commitinfo($id) 2]
5779 set date [formatdate $date]
9c311b32
PM
5780 set font mainfont
5781 set nfont mainfont
476ca63d 5782 set isbold [ishighlighted $id]
908c3585 5783 if {$isbold > 0} {
28593d3f 5784 lappend boldids $id
9c311b32 5785 set font mainfontbold
908c3585 5786 if {$isbold > 1} {
28593d3f 5787 lappend boldnameids $id
9c311b32 5788 set nfont mainfontbold
908c3585 5789 }
da7c24dd 5790 }
28593d3f
PM
5791 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5792 -text $headline -font $font -tags text]
5793 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5794 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5795 -text $name -font $nfont -tags text]
5796 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5797 -text $date -font mainfont -tags text]
94b4a69f 5798 if {$selectedline == $row} {
28593d3f 5799 make_secsel $id
0380081c 5800 }
b9fdba7f
PM
5801 if {[info exists markedid] && $markedid eq $id} {
5802 make_idmark $id
5803 }
9c311b32 5804 set xr [expr {$xt + [font measure $font $headline]}]
be0cd098
PM
5805 if {$xr > $canvxmax} {
5806 set canvxmax $xr
5807 setcanvscroll
5808 }
9f1afe05
PM
5809}
5810
5811proc drawcmitrow {row} {
0380081c 5812 global displayorder rowidlist nrows_drawn
005a2f4e 5813 global iddrawn markingmatches
7fcc92bf 5814 global commitinfo numcommits
687c8765 5815 global filehighlight fhighlights findpattern nhighlights
908c3585 5816 global hlview vhighlights
164ff275 5817 global highlight_related rhighlights
9f1afe05 5818
8f7d0cec 5819 if {$row >= $numcommits} return
9f1afe05
PM
5820
5821 set id [lindex $displayorder $row]
476ca63d 5822 if {[info exists hlview] && ![info exists vhighlights($id)]} {
908c3585
PM
5823 askvhighlight $row $id
5824 }
476ca63d 5825 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
908c3585
PM
5826 askfilehighlight $row $id
5827 }
476ca63d 5828 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
60f7a7dc 5829 askfindhighlight $row $id
908c3585 5830 }
476ca63d 5831 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
164ff275
PM
5832 askrelhighlight $row $id
5833 }
005a2f4e
PM
5834 if {![info exists iddrawn($id)]} {
5835 set col [lsearch -exact [lindex $rowidlist $row] $id]
5836 if {$col < 0} {
5837 puts "oops, row $row id $id not in list"
5838 return
5839 }
5840 if {![info exists commitinfo($id)]} {
5841 getcommit $id
5842 }
5843 assigncolor $id
5844 drawcmittext $id $row $col
5845 set iddrawn($id) 1
0380081c 5846 incr nrows_drawn
9f1afe05 5847 }
005a2f4e
PM
5848 if {$markingmatches} {
5849 markrowmatches $row $id
9f1afe05 5850 }
9f1afe05
PM
5851}
5852
322a8cc9 5853proc drawcommits {row {endrow {}}} {
0380081c 5854 global numcommits iddrawn displayorder curview need_redisplay
f5f3c2e2 5855 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
9f1afe05 5856
9f1afe05
PM
5857 if {$row < 0} {
5858 set row 0
5859 }
322a8cc9
PM
5860 if {$endrow eq {}} {
5861 set endrow $row
5862 }
9f1afe05
PM
5863 if {$endrow >= $numcommits} {
5864 set endrow [expr {$numcommits - 1}]
5865 }
322a8cc9 5866
0380081c
PM
5867 set rl1 [expr {$row - $downarrowlen - 3}]
5868 if {$rl1 < 0} {
5869 set rl1 0
5870 }
5871 set ro1 [expr {$row - 3}]
5872 if {$ro1 < 0} {
5873 set ro1 0
5874 }
5875 set r2 [expr {$endrow + $uparrowlen + 3}]
5876 if {$r2 > $numcommits} {
5877 set r2 $numcommits
5878 }
5879 for {set r $rl1} {$r < $r2} {incr r} {
f5f3c2e2 5880 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
0380081c
PM
5881 if {$rl1 < $r} {
5882 layoutrows $rl1 $r
5883 }
5884 set rl1 [expr {$r + 1}]
5885 }
5886 }
5887 if {$rl1 < $r} {
5888 layoutrows $rl1 $r
5889 }
5890 optimize_rows $ro1 0 $r2
5891 if {$need_redisplay || $nrows_drawn > 2000} {
5892 clear_display
0380081c
PM
5893 }
5894
322a8cc9
PM
5895 # make the lines join to already-drawn rows either side
5896 set r [expr {$row - 1}]
5897 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5898 set r $row
5899 }
5900 set er [expr {$endrow + 1}]
5901 if {$er >= $numcommits ||
5902 ![info exists iddrawn([lindex $displayorder $er])]} {
5903 set er $endrow
5904 }
5905 for {} {$r <= $er} {incr r} {
5906 set id [lindex $displayorder $r]
5907 set wasdrawn [info exists iddrawn($id)]
4fb0fa19 5908 drawcmitrow $r
322a8cc9
PM
5909 if {$r == $er} break
5910 set nextid [lindex $displayorder [expr {$r + 1}]]
e5ef6f95 5911 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
322a8cc9
PM
5912 drawparentlinks $id $r
5913
322a8cc9
PM
5914 set rowids [lindex $rowidlist $r]
5915 foreach lid $rowids {
5916 if {$lid eq {}} continue
e5ef6f95 5917 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
322a8cc9
PM
5918 if {$lid eq $id} {
5919 # see if this is the first child of any of its parents
5920 foreach p [lindex $parentlist $r] {
5921 if {[lsearch -exact $rowids $p] < 0} {
5922 # make this line extend up to the child
e5ef6f95 5923 set lineend($p) [drawlineseg $p $r $er 0]
322a8cc9
PM
5924 }
5925 }
e5ef6f95
PM
5926 } else {
5927 set lineend($lid) [drawlineseg $lid $r $er 1]
322a8cc9
PM
5928 }
5929 }
9f1afe05
PM
5930 }
5931}
5932
7fcc92bf
PM
5933proc undolayout {row} {
5934 global uparrowlen mingaplen downarrowlen
5935 global rowidlist rowisopt rowfinal need_redisplay
5936
5937 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5938 if {$r < 0} {
5939 set r 0
5940 }
5941 if {[llength $rowidlist] > $r} {
5942 incr r -1
5943 set rowidlist [lrange $rowidlist 0 $r]
5944 set rowfinal [lrange $rowfinal 0 $r]
5945 set rowisopt [lrange $rowisopt 0 $r]
5946 set need_redisplay 1
5947 run drawvisible
5948 }
5949}
5950
31c0eaa8
PM
5951proc drawvisible {} {
5952 global canv linespc curview vrowmod selectedline targetrow targetid
42a671fc 5953 global need_redisplay cscroll numcommits
322a8cc9 5954
31c0eaa8 5955 set fs [$canv yview]
322a8cc9 5956 set ymax [lindex [$canv cget -scrollregion] 3]
5a7f577d 5957 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
31c0eaa8
PM
5958 set f0 [lindex $fs 0]
5959 set f1 [lindex $fs 1]
322a8cc9 5960 set y0 [expr {int($f0 * $ymax)}]
322a8cc9 5961 set y1 [expr {int($f1 * $ymax)}]
31c0eaa8
PM
5962
5963 if {[info exists targetid]} {
42a671fc
PM
5964 if {[commitinview $targetid $curview]} {
5965 set r [rowofcommit $targetid]
5966 if {$r != $targetrow} {
5967 # Fix up the scrollregion and change the scrolling position
5968 # now that our target row has moved.
5969 set diff [expr {($r - $targetrow) * $linespc}]
5970 set targetrow $r
5971 setcanvscroll
5972 set ymax [lindex [$canv cget -scrollregion] 3]
5973 incr y0 $diff
5974 incr y1 $diff
5975 set f0 [expr {$y0 / $ymax}]
5976 set f1 [expr {$y1 / $ymax}]
5977 allcanvs yview moveto $f0
5978 $cscroll set $f0 $f1
5979 set need_redisplay 1
5980 }
5981 } else {
5982 unset targetid
31c0eaa8
PM
5983 }
5984 }
5985
5986 set row [expr {int(($y0 - 3) / $linespc) - 1}]
322a8cc9 5987 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
31c0eaa8
PM
5988 if {$endrow >= $vrowmod($curview)} {
5989 update_arcrows $curview
5990 }
94b4a69f 5991 if {$selectedline ne {} &&
31c0eaa8
PM
5992 $row <= $selectedline && $selectedline <= $endrow} {
5993 set targetrow $selectedline
ac1276ab 5994 } elseif {[info exists targetid]} {
31c0eaa8
PM
5995 set targetrow [expr {int(($row + $endrow) / 2)}]
5996 }
ac1276ab
PM
5997 if {[info exists targetrow]} {
5998 if {$targetrow >= $numcommits} {
5999 set targetrow [expr {$numcommits - 1}]
6000 }
6001 set targetid [commitonrow $targetrow]
42a671fc 6002 }
322a8cc9
PM
6003 drawcommits $row $endrow
6004}
6005
9f1afe05 6006proc clear_display {} {
0380081c 6007 global iddrawn linesegs need_redisplay nrows_drawn
164ff275 6008 global vhighlights fhighlights nhighlights rhighlights
28593d3f 6009 global linehtag linentag linedtag boldids boldnameids
9f1afe05
PM
6010
6011 allcanvs delete all
6012 catch {unset iddrawn}
322a8cc9 6013 catch {unset linesegs}
94503a66
PM
6014 catch {unset linehtag}
6015 catch {unset linentag}
6016 catch {unset linedtag}
28593d3f
PM
6017 set boldids {}
6018 set boldnameids {}
908c3585
PM
6019 catch {unset vhighlights}
6020 catch {unset fhighlights}
6021 catch {unset nhighlights}
164ff275 6022 catch {unset rhighlights}
0380081c
PM
6023 set need_redisplay 0
6024 set nrows_drawn 0
9f1afe05
PM
6025}
6026
50b44ece 6027proc findcrossings {id} {
6e8c8707 6028 global rowidlist parentlist numcommits displayorder
50b44ece
PM
6029
6030 set cross {}
6031 set ccross {}
6032 foreach {s e} [rowranges $id] {
6033 if {$e >= $numcommits} {
6034 set e [expr {$numcommits - 1}]
50b44ece 6035 }
d94f8cd6 6036 if {$e <= $s} continue
50b44ece 6037 for {set row $e} {[incr row -1] >= $s} {} {
6e8c8707
PM
6038 set x [lsearch -exact [lindex $rowidlist $row] $id]
6039 if {$x < 0} break
50b44ece
PM
6040 set olds [lindex $parentlist $row]
6041 set kid [lindex $displayorder $row]
6042 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6043 if {$kidx < 0} continue
6044 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6045 foreach p $olds {
6046 set px [lsearch -exact $nextrow $p]
6047 if {$px < 0} continue
6048 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6049 if {[lsearch -exact $ccross $p] >= 0} continue
6050 if {$x == $px + ($kidx < $px? -1: 1)} {
6051 lappend ccross $p
6052 } elseif {[lsearch -exact $cross $p] < 0} {
6053 lappend cross $p
6054 }
6055 }
6056 }
50b44ece
PM
6057 }
6058 }
6059 return [concat $ccross {{}} $cross]
6060}
6061
e5c2d856 6062proc assigncolor {id} {
aa81d974 6063 global colormap colors nextcolor
7fcc92bf 6064 global parents children children curview
6c20ff34 6065
418c4c7b 6066 if {[info exists colormap($id)]} return
e5c2d856 6067 set ncolors [llength $colors]
da7c24dd
PM
6068 if {[info exists children($curview,$id)]} {
6069 set kids $children($curview,$id)
79b2c75e
PM
6070 } else {
6071 set kids {}
6072 }
6073 if {[llength $kids] == 1} {
6074 set child [lindex $kids 0]
9ccbdfbf 6075 if {[info exists colormap($child)]
7fcc92bf 6076 && [llength $parents($curview,$child)] == 1} {
9ccbdfbf
PM
6077 set colormap($id) $colormap($child)
6078 return
e5c2d856 6079 }
9ccbdfbf
PM
6080 }
6081 set badcolors {}
50b44ece
PM
6082 set origbad {}
6083 foreach x [findcrossings $id] {
6084 if {$x eq {}} {
6085 # delimiter between corner crossings and other crossings
6086 if {[llength $badcolors] >= $ncolors - 1} break
6087 set origbad $badcolors
e5c2d856 6088 }
50b44ece
PM
6089 if {[info exists colormap($x)]
6090 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6091 lappend badcolors $colormap($x)
6c20ff34
PM
6092 }
6093 }
50b44ece
PM
6094 if {[llength $badcolors] >= $ncolors} {
6095 set badcolors $origbad
9ccbdfbf 6096 }
50b44ece 6097 set origbad $badcolors
6c20ff34 6098 if {[llength $badcolors] < $ncolors - 1} {
79b2c75e 6099 foreach child $kids {
6c20ff34
PM
6100 if {[info exists colormap($child)]
6101 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6102 lappend badcolors $colormap($child)
6103 }
7fcc92bf 6104 foreach p $parents($curview,$child) {
79b2c75e
PM
6105 if {[info exists colormap($p)]
6106 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6107 lappend badcolors $colormap($p)
6c20ff34
PM
6108 }
6109 }
6110 }
6111 if {[llength $badcolors] >= $ncolors} {
6112 set badcolors $origbad
6113 }
9ccbdfbf
PM
6114 }
6115 for {set i 0} {$i <= $ncolors} {incr i} {
6116 set c [lindex $colors $nextcolor]
6117 if {[incr nextcolor] >= $ncolors} {
6118 set nextcolor 0
e5c2d856 6119 }
9ccbdfbf 6120 if {[lsearch -exact $badcolors $c]} break
e5c2d856 6121 }
9ccbdfbf 6122 set colormap($id) $c
e5c2d856
PM
6123}
6124
a823a911
PM
6125proc bindline {t id} {
6126 global canv
6127
a823a911
PM
6128 $canv bind $t <Enter> "lineenter %x %y $id"
6129 $canv bind $t <Motion> "linemotion %x %y $id"
6130 $canv bind $t <Leave> "lineleave $id"
fa4da7b3 6131 $canv bind $t <Button-1> "lineclick %x %y $id 1"
a823a911
PM
6132}
6133
bdbfbe3d 6134proc drawtags {id x xt y1} {
8a48571c 6135 global idtags idheads idotherrefs mainhead
bdbfbe3d 6136 global linespc lthickness
d277e89f 6137 global canv rowtextx curview fgcolor bgcolor ctxbut
bdbfbe3d
PM
6138
6139 set marks {}
6140 set ntags 0
f1d83ba3 6141 set nheads 0
bdbfbe3d
PM
6142 if {[info exists idtags($id)]} {
6143 set marks $idtags($id)
6144 set ntags [llength $marks]
6145 }
6146 if {[info exists idheads($id)]} {
6147 set marks [concat $marks $idheads($id)]
f1d83ba3
PM
6148 set nheads [llength $idheads($id)]
6149 }
6150 if {[info exists idotherrefs($id)]} {
6151 set marks [concat $marks $idotherrefs($id)]
bdbfbe3d
PM
6152 }
6153 if {$marks eq {}} {
6154 return $xt
6155 }
6156
6157 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2ed49d54
JH
6158 set yt [expr {$y1 - 0.5 * $linespc}]
6159 set yb [expr {$yt + $linespc - 1}]
bdbfbe3d
PM
6160 set xvals {}
6161 set wvals {}
8a48571c 6162 set i -1
bdbfbe3d 6163 foreach tag $marks {
8a48571c
PM
6164 incr i
6165 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
9c311b32 6166 set wid [font measure mainfontbold $tag]
8a48571c 6167 } else {
9c311b32 6168 set wid [font measure mainfont $tag]
8a48571c 6169 }
bdbfbe3d
PM
6170 lappend xvals $xt
6171 lappend wvals $wid
6172 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6173 }
6174 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6175 -width $lthickness -fill black -tags tag.$id]
6176 $canv lower $t
6177 foreach tag $marks x $xvals wid $wvals {
2ed49d54
JH
6178 set xl [expr {$x + $delta}]
6179 set xr [expr {$x + $delta + $wid + $lthickness}]
9c311b32 6180 set font mainfont
bdbfbe3d
PM
6181 if {[incr ntags -1] >= 0} {
6182 # draw a tag
2ed49d54
JH
6183 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6184 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
106288cb
PM
6185 -width 1 -outline black -fill yellow -tags tag.$id]
6186 $canv bind $t <1> [list showtag $tag 1]
7fcc92bf 6187 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
bdbfbe3d 6188 } else {
f1d83ba3
PM
6189 # draw a head or other ref
6190 if {[incr nheads -1] >= 0} {
6191 set col green
8a48571c 6192 if {$tag eq $mainhead} {
9c311b32 6193 set font mainfontbold
8a48571c 6194 }
f1d83ba3
PM
6195 } else {
6196 set col "#ddddff"
6197 }
2ed49d54 6198 set xl [expr {$xl - $delta/2}]
bdbfbe3d 6199 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
f1d83ba3 6200 -width 1 -outline black -fill $col -tags tag.$id
a970fcf2 6201 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
9c311b32 6202 set rwid [font measure mainfont $remoteprefix]
a970fcf2
JW
6203 set xi [expr {$x + 1}]
6204 set yti [expr {$yt + 1}]
6205 set xri [expr {$x + $rwid}]
6206 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6207 -width 0 -fill "#ffddaa" -tags tag.$id
6208 }
bdbfbe3d 6209 }
f8a2c0d1 6210 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
8a48571c 6211 -font $font -tags [list tag.$id text]]
106288cb
PM
6212 if {$ntags >= 0} {
6213 $canv bind $t <1> [list showtag $tag 1]
10299152 6214 } elseif {$nheads >= 0} {
d277e89f 6215 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
106288cb 6216 }
bdbfbe3d
PM
6217 }
6218 return $xt
6219}
6220
8d858d1a
PM
6221proc xcoord {i level ln} {
6222 global canvx0 xspc1 xspc2
6223
6224 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6225 if {$i > 0 && $i == $level} {
6226 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6227 } elseif {$i > $level} {
6228 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6229 }
6230 return $x
6231}
9ccbdfbf 6232
098dd8a3 6233proc show_status {msg} {
9c311b32 6234 global canv fgcolor
098dd8a3
PM
6235
6236 clear_display
9c311b32 6237 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
f8a2c0d1 6238 -tags text -fill $fgcolor
098dd8a3
PM
6239}
6240
94a2eede
PM
6241# Don't change the text pane cursor if it is currently the hand cursor,
6242# showing that we are over a sha1 ID link.
6243proc settextcursor {c} {
6244 global ctext curtextcursor
6245
6246 if {[$ctext cget -cursor] == $curtextcursor} {
6247 $ctext config -cursor $c
6248 }
6249 set curtextcursor $c
9ccbdfbf
PM
6250}
6251
a137a90f
PM
6252proc nowbusy {what {name {}}} {
6253 global isbusy busyname statusw
da7c24dd
PM
6254
6255 if {[array names isbusy] eq {}} {
6256 . config -cursor watch
6257 settextcursor watch
6258 }
6259 set isbusy($what) 1
a137a90f
PM
6260 set busyname($what) $name
6261 if {$name ne {}} {
6262 $statusw conf -text $name
6263 }
da7c24dd
PM
6264}
6265
6266proc notbusy {what} {
a137a90f 6267 global isbusy maincursor textcursor busyname statusw
da7c24dd 6268
a137a90f
PM
6269 catch {
6270 unset isbusy($what)
6271 if {$busyname($what) ne {} &&
6272 [$statusw cget -text] eq $busyname($what)} {
6273 $statusw conf -text {}
6274 }
6275 }
da7c24dd
PM
6276 if {[array names isbusy] eq {}} {
6277 . config -cursor $maincursor
6278 settextcursor $textcursor
6279 }
6280}
6281
df3d83b1 6282proc findmatches {f} {
4fb0fa19 6283 global findtype findstring
b007ee20 6284 if {$findtype == [mc "Regexp"]} {
4fb0fa19 6285 set matches [regexp -indices -all -inline $findstring $f]
df3d83b1 6286 } else {
4fb0fa19 6287 set fs $findstring
b007ee20 6288 if {$findtype == [mc "IgnCase"]} {
4fb0fa19
PM
6289 set f [string tolower $f]
6290 set fs [string tolower $fs]
df3d83b1
PM
6291 }
6292 set matches {}
6293 set i 0
4fb0fa19
PM
6294 set l [string length $fs]
6295 while {[set j [string first $fs $f $i]] >= 0} {
6296 lappend matches [list $j [expr {$j+$l-1}]]
6297 set i [expr {$j + $l}]
df3d83b1
PM
6298 }
6299 }
6300 return $matches
6301}
6302
cca5d946 6303proc dofind {{dirn 1} {wrap 1}} {
4fb0fa19 6304 global findstring findstartline findcurline selectedline numcommits
cca5d946 6305 global gdttype filehighlight fh_serial find_dirn findallowwrap
b74fd579 6306
cca5d946
PM
6307 if {[info exists find_dirn]} {
6308 if {$find_dirn == $dirn} return
6309 stopfinding
6310 }
df3d83b1 6311 focus .
4fb0fa19 6312 if {$findstring eq {} || $numcommits == 0} return
94b4a69f 6313 if {$selectedline eq {}} {
cca5d946 6314 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
98f350e5 6315 } else {
4fb0fa19 6316 set findstartline $selectedline
98f350e5 6317 }
4fb0fa19 6318 set findcurline $findstartline
b007ee20
CS
6319 nowbusy finding [mc "Searching"]
6320 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
687c8765
PM
6321 after cancel do_file_hl $fh_serial
6322 do_file_hl $fh_serial
98f350e5 6323 }
cca5d946
PM
6324 set find_dirn $dirn
6325 set findallowwrap $wrap
6326 run findmore
4fb0fa19
PM
6327}
6328
bb3edc8b
PM
6329proc stopfinding {} {
6330 global find_dirn findcurline fprogcoord
4fb0fa19 6331
bb3edc8b
PM
6332 if {[info exists find_dirn]} {
6333 unset find_dirn
6334 unset findcurline
6335 notbusy finding
6336 set fprogcoord 0
6337 adjustprogress
4fb0fa19 6338 }
8a897742 6339 stopblaming
4fb0fa19
PM
6340}
6341
6342proc findmore {} {
687c8765 6343 global commitdata commitinfo numcommits findpattern findloc
7fcc92bf 6344 global findstartline findcurline findallowwrap
bb3edc8b 6345 global find_dirn gdttype fhighlights fprogcoord
cd2bcae7 6346 global curview varcorder vrownum varccommits vrowmod
4fb0fa19 6347
bb3edc8b 6348 if {![info exists find_dirn]} {
4fb0fa19
PM
6349 return 0
6350 }
b007ee20 6351 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4fb0fa19 6352 set l $findcurline
cca5d946
PM
6353 set moretodo 0
6354 if {$find_dirn > 0} {
6355 incr l
6356 if {$l >= $numcommits} {
6357 set l 0
6358 }
6359 if {$l <= $findstartline} {
6360 set lim [expr {$findstartline + 1}]
6361 } else {
6362 set lim $numcommits
6363 set moretodo $findallowwrap
8ed16484 6364 }
4fb0fa19 6365 } else {
cca5d946
PM
6366 if {$l == 0} {
6367 set l $numcommits
98f350e5 6368 }
cca5d946
PM
6369 incr l -1
6370 if {$l >= $findstartline} {
6371 set lim [expr {$findstartline - 1}]
bb3edc8b 6372 } else {
cca5d946
PM
6373 set lim -1
6374 set moretodo $findallowwrap
bb3edc8b 6375 }
687c8765 6376 }
cca5d946
PM
6377 set n [expr {($lim - $l) * $find_dirn}]
6378 if {$n > 500} {
6379 set n 500
6380 set moretodo 1
4fb0fa19 6381 }
cd2bcae7
PM
6382 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6383 update_arcrows $curview
6384 }
687c8765
PM
6385 set found 0
6386 set domore 1
7fcc92bf
PM
6387 set ai [bsearch $vrownum($curview) $l]
6388 set a [lindex $varcorder($curview) $ai]
6389 set arow [lindex $vrownum($curview) $ai]
6390 set ids [lindex $varccommits($curview,$a)]
6391 set arowend [expr {$arow + [llength $ids]}]
b007ee20 6392 if {$gdttype eq [mc "containing:"]} {
cca5d946 6393 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6394 if {$l < $arow || $l >= $arowend} {
6395 incr ai $find_dirn
6396 set a [lindex $varcorder($curview) $ai]
6397 set arow [lindex $vrownum($curview) $ai]
6398 set ids [lindex $varccommits($curview,$a)]
6399 set arowend [expr {$arow + [llength $ids]}]
6400 }
6401 set id [lindex $ids [expr {$l - $arow}]]
cca5d946 6402 # shouldn't happen unless git log doesn't give all the commits...
7fcc92bf
PM
6403 if {![info exists commitdata($id)] ||
6404 ![doesmatch $commitdata($id)]} {
6405 continue
6406 }
687c8765
PM
6407 if {![info exists commitinfo($id)]} {
6408 getcommit $id
6409 }
6410 set info $commitinfo($id)
6411 foreach f $info ty $fldtypes {
b007ee20 6412 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
687c8765
PM
6413 [doesmatch $f]} {
6414 set found 1
6415 break
6416 }
6417 }
6418 if {$found} break
4fb0fa19 6419 }
687c8765 6420 } else {
cca5d946 6421 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6422 if {$l < $arow || $l >= $arowend} {
6423 incr ai $find_dirn
6424 set a [lindex $varcorder($curview) $ai]
6425 set arow [lindex $vrownum($curview) $ai]
6426 set ids [lindex $varccommits($curview,$a)]
6427 set arowend [expr {$arow + [llength $ids]}]
6428 }
6429 set id [lindex $ids [expr {$l - $arow}]]
476ca63d
PM
6430 if {![info exists fhighlights($id)]} {
6431 # this sets fhighlights($id) to -1
687c8765 6432 askfilehighlight $l $id
cd2bcae7 6433 }
476ca63d 6434 if {$fhighlights($id) > 0} {
cd2bcae7
PM
6435 set found $domore
6436 break
6437 }
476ca63d 6438 if {$fhighlights($id) < 0} {
687c8765
PM
6439 if {$domore} {
6440 set domore 0
cca5d946 6441 set findcurline [expr {$l - $find_dirn}]
687c8765 6442 }
98f350e5
PM
6443 }
6444 }
6445 }
cca5d946 6446 if {$found || ($domore && !$moretodo)} {
4fb0fa19 6447 unset findcurline
687c8765 6448 unset find_dirn
4fb0fa19 6449 notbusy finding
bb3edc8b
PM
6450 set fprogcoord 0
6451 adjustprogress
6452 if {$found} {
6453 findselectline $l
6454 } else {
6455 bell
6456 }
4fb0fa19 6457 return 0
df3d83b1 6458 }
687c8765
PM
6459 if {!$domore} {
6460 flushhighlights
bb3edc8b 6461 } else {
cca5d946 6462 set findcurline [expr {$l - $find_dirn}]
687c8765 6463 }
cca5d946 6464 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
bb3edc8b
PM
6465 if {$n < 0} {
6466 incr n $numcommits
df3d83b1 6467 }
bb3edc8b
PM
6468 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6469 adjustprogress
6470 return $domore
df3d83b1
PM
6471}
6472
6473proc findselectline {l} {
687c8765 6474 global findloc commentend ctext findcurline markingmatches gdttype
005a2f4e 6475
8b39e04f 6476 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
005a2f4e 6477 set findcurline $l
d698206c 6478 selectline $l 1
8b39e04f
PM
6479 if {$markingmatches &&
6480 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
df3d83b1
PM
6481 # highlight the matches in the comments
6482 set f [$ctext get 1.0 $commentend]
6483 set matches [findmatches $f]
6484 foreach match $matches {
6485 set start [lindex $match 0]
2ed49d54 6486 set end [expr {[lindex $match 1] + 1}]
df3d83b1
PM
6487 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6488 }
98f350e5 6489 }
005a2f4e 6490 drawvisible
98f350e5
PM
6491}
6492
4fb0fa19 6493# mark the bits of a headline or author that match a find string
005a2f4e
PM
6494proc markmatches {canv l str tag matches font row} {
6495 global selectedline
6496
98f350e5
PM
6497 set bbox [$canv bbox $tag]
6498 set x0 [lindex $bbox 0]
6499 set y0 [lindex $bbox 1]
6500 set y1 [lindex $bbox 3]
6501 foreach match $matches {
6502 set start [lindex $match 0]
6503 set end [lindex $match 1]
6504 if {$start > $end} continue
2ed49d54
JH
6505 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6506 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6507 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6508 [expr {$x0+$xlen+2}] $y1 \
4fb0fa19 6509 -outline {} -tags [list match$l matches] -fill yellow]
98f350e5 6510 $canv lower $t
94b4a69f 6511 if {$row == $selectedline} {
005a2f4e
PM
6512 $canv raise $t secsel
6513 }
98f350e5
PM
6514 }
6515}
6516
6517proc unmarkmatches {} {
bb3edc8b 6518 global markingmatches
4fb0fa19 6519
98f350e5 6520 allcanvs delete matches
4fb0fa19 6521 set markingmatches 0
bb3edc8b 6522 stopfinding
98f350e5
PM
6523}
6524
c8dfbcf9 6525proc selcanvline {w x y} {
fa4da7b3 6526 global canv canvy0 ctext linespc
9f1afe05 6527 global rowtextx
1db95b00 6528 set ymax [lindex [$canv cget -scrollregion] 3]
cfb4563c 6529 if {$ymax == {}} return
1db95b00
PM
6530 set yfrac [lindex [$canv yview] 0]
6531 set y [expr {$y + $yfrac * $ymax}]
6532 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6533 if {$l < 0} {
6534 set l 0
6535 }
c8dfbcf9 6536 if {$w eq $canv} {
fc2a256f
PM
6537 set xmax [lindex [$canv cget -scrollregion] 2]
6538 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6539 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
c8dfbcf9 6540 }
98f350e5 6541 unmarkmatches
d698206c 6542 selectline $l 1
5ad588de
PM
6543}
6544
b1ba39e7
LT
6545proc commit_descriptor {p} {
6546 global commitinfo
b0934489
PM
6547 if {![info exists commitinfo($p)]} {
6548 getcommit $p
6549 }
b1ba39e7 6550 set l "..."
b0934489 6551 if {[llength $commitinfo($p)] > 1} {
b1ba39e7
LT
6552 set l [lindex $commitinfo($p) 0]
6553 }
b8ab2e17 6554 return "$p ($l)\n"
b1ba39e7
LT
6555}
6556
106288cb
PM
6557# append some text to the ctext widget, and make any SHA1 ID
6558# that we know about be a clickable link.
f1b86294 6559proc appendwithlinks {text tags} {
d375ef9b 6560 global ctext linknum curview
106288cb
PM
6561
6562 set start [$ctext index "end - 1c"]
f1b86294 6563 $ctext insert end $text $tags
d375ef9b 6564 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
106288cb
PM
6565 foreach l $links {
6566 set s [lindex $l 0]
6567 set e [lindex $l 1]
6568 set linkid [string range $text $s $e]
106288cb 6569 incr e
c73adce2 6570 $ctext tag delete link$linknum
106288cb 6571 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
97645683 6572 setlink $linkid link$linknum
106288cb
PM
6573 incr linknum
6574 }
97645683
PM
6575}
6576
6577proc setlink {id lk} {
d375ef9b 6578 global curview ctext pendinglinks
97645683 6579
d375ef9b
PM
6580 set known 0
6581 if {[string length $id] < 40} {
6582 set matches [longid $id]
6583 if {[llength $matches] > 0} {
6584 if {[llength $matches] > 1} return
6585 set known 1
6586 set id [lindex $matches 0]
6587 }
6588 } else {
6589 set known [commitinview $id $curview]
6590 }
6591 if {$known} {
97645683 6592 $ctext tag conf $lk -foreground blue -underline 1
d375ef9b 6593 $ctext tag bind $lk <1> [list selbyid $id]
97645683
PM
6594 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6595 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6596 } else {
6597 lappend pendinglinks($id) $lk
d375ef9b 6598 interestedin $id {makelink %P}
97645683
PM
6599 }
6600}
6601
6f63fc18
PM
6602proc appendshortlink {id {pre {}} {post {}}} {
6603 global ctext linknum
6604
6605 $ctext insert end $pre
6606 $ctext tag delete link$linknum
6607 $ctext insert end [string range $id 0 7] link$linknum
6608 $ctext insert end $post
6609 setlink $id link$linknum
6610 incr linknum
6611}
6612
97645683
PM
6613proc makelink {id} {
6614 global pendinglinks
6615
6616 if {![info exists pendinglinks($id)]} return
6617 foreach lk $pendinglinks($id) {
6618 setlink $id $lk
6619 }
6620 unset pendinglinks($id)
6621}
6622
6623proc linkcursor {w inc} {
6624 global linkentercount curtextcursor
6625
6626 if {[incr linkentercount $inc] > 0} {
6627 $w configure -cursor hand2
6628 } else {
6629 $w configure -cursor $curtextcursor
6630 if {$linkentercount < 0} {
6631 set linkentercount 0
6632 }
6633 }
106288cb
PM
6634}
6635
6e5f7203
RN
6636proc viewnextline {dir} {
6637 global canv linespc
6638
6639 $canv delete hover
6640 set ymax [lindex [$canv cget -scrollregion] 3]
6641 set wnow [$canv yview]
6642 set wtop [expr {[lindex $wnow 0] * $ymax}]
6643 set newtop [expr {$wtop + $dir * $linespc}]
6644 if {$newtop < 0} {
6645 set newtop 0
6646 } elseif {$newtop > $ymax} {
6647 set newtop $ymax
6648 }
6649 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6650}
6651
ef030b85
PM
6652# add a list of tag or branch names at position pos
6653# returns the number of names inserted
e11f1233 6654proc appendrefs {pos ids var} {
7fcc92bf 6655 global ctext linknum curview $var maxrefs
b8ab2e17 6656
ef030b85
PM
6657 if {[catch {$ctext index $pos}]} {
6658 return 0
6659 }
e11f1233
PM
6660 $ctext conf -state normal
6661 $ctext delete $pos "$pos lineend"
6662 set tags {}
6663 foreach id $ids {
6664 foreach tag [set $var\($id\)] {
6665 lappend tags [list $tag $id]
6666 }
6667 }
0a4dd8b8 6668 if {[llength $tags] > $maxrefs} {
84b4b832 6669 $ctext insert $pos "[mc "many"] ([llength $tags])"
0a4dd8b8
PM
6670 } else {
6671 set tags [lsort -index 0 -decreasing $tags]
6672 set sep {}
6673 foreach ti $tags {
6674 set id [lindex $ti 1]
6675 set lk link$linknum
6676 incr linknum
6677 $ctext tag delete $lk
6678 $ctext insert $pos $sep
6679 $ctext insert $pos [lindex $ti 0] $lk
97645683 6680 setlink $id $lk
0a4dd8b8 6681 set sep ", "
b8ab2e17 6682 }
b8ab2e17 6683 }
e11f1233 6684 $ctext conf -state disabled
ef030b85 6685 return [llength $tags]
b8ab2e17
PM
6686}
6687
e11f1233
PM
6688# called when we have finished computing the nearby tags
6689proc dispneartags {delay} {
6690 global selectedline currentid showneartags tagphase
ca6d8f58 6691
94b4a69f 6692 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
6693 after cancel dispnexttag
6694 if {$delay} {
6695 after 200 dispnexttag
6696 set tagphase -1
6697 } else {
6698 after idle dispnexttag
6699 set tagphase 0
ca6d8f58 6700 }
ca6d8f58
PM
6701}
6702
e11f1233
PM
6703proc dispnexttag {} {
6704 global selectedline currentid showneartags tagphase ctext
b8ab2e17 6705
94b4a69f 6706 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
6707 switch -- $tagphase {
6708 0 {
6709 set dtags [desctags $currentid]
6710 if {$dtags ne {}} {
6711 appendrefs precedes $dtags idtags
6712 }
6713 }
6714 1 {
6715 set atags [anctags $currentid]
6716 if {$atags ne {}} {
6717 appendrefs follows $atags idtags
6718 }
6719 }
6720 2 {
6721 set dheads [descheads $currentid]
6722 if {$dheads ne {}} {
6723 if {[appendrefs branch $dheads idheads] > 1
6724 && [$ctext get "branch -3c"] eq "h"} {
6725 # turn "Branch" into "Branches"
6726 $ctext conf -state normal
6727 $ctext insert "branch -2c" "es"
6728 $ctext conf -state disabled
6729 }
6730 }
ef030b85
PM
6731 }
6732 }
e11f1233
PM
6733 if {[incr tagphase] <= 2} {
6734 after idle dispnexttag
b8ab2e17 6735 }
b8ab2e17
PM
6736}
6737
28593d3f 6738proc make_secsel {id} {
0380081c
PM
6739 global linehtag linentag linedtag canv canv2 canv3
6740
28593d3f 6741 if {![info exists linehtag($id)]} return
0380081c 6742 $canv delete secsel
28593d3f 6743 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
0380081c
PM
6744 -tags secsel -fill [$canv cget -selectbackground]]
6745 $canv lower $t
6746 $canv2 delete secsel
28593d3f 6747 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
0380081c
PM
6748 -tags secsel -fill [$canv2 cget -selectbackground]]
6749 $canv2 lower $t
6750 $canv3 delete secsel
28593d3f 6751 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
0380081c
PM
6752 -tags secsel -fill [$canv3 cget -selectbackground]]
6753 $canv3 lower $t
6754}
6755
b9fdba7f
PM
6756proc make_idmark {id} {
6757 global linehtag canv fgcolor
6758
6759 if {![info exists linehtag($id)]} return
6760 $canv delete markid
6761 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6762 -tags markid -outline $fgcolor]
6763 $canv raise $t
6764}
6765
8a897742 6766proc selectline {l isnew {desired_loc {}}} {
0380081c 6767 global canv ctext commitinfo selectedline
7fcc92bf 6768 global canvy0 linespc parents children curview
7fcceed7 6769 global currentid sha1entry
9f1afe05 6770 global commentend idtags linknum
d94f8cd6 6771 global mergemax numcommits pending_select
e11f1233 6772 global cmitmode showneartags allcommits
c30acc77 6773 global targetrow targetid lastscrollrows
8a897742 6774 global autoselect jump_to_here
d698206c 6775
d94f8cd6 6776 catch {unset pending_select}
84ba7345 6777 $canv delete hover
9843c307 6778 normalline
887c996e 6779 unsel_reflist
bb3edc8b 6780 stopfinding
8f7d0cec 6781 if {$l < 0 || $l >= $numcommits} return
ac1276ab
PM
6782 set id [commitonrow $l]
6783 set targetid $id
6784 set targetrow $l
c30acc77
PM
6785 set selectedline $l
6786 set currentid $id
6787 if {$lastscrollrows < $numcommits} {
6788 setcanvscroll
6789 }
ac1276ab 6790
5ad588de 6791 set y [expr {$canvy0 + $l * $linespc}]
17386066 6792 set ymax [lindex [$canv cget -scrollregion] 3]
5842215e
PM
6793 set ytop [expr {$y - $linespc - 1}]
6794 set ybot [expr {$y + $linespc + 1}]
5ad588de 6795 set wnow [$canv yview]
2ed49d54
JH
6796 set wtop [expr {[lindex $wnow 0] * $ymax}]
6797 set wbot [expr {[lindex $wnow 1] * $ymax}]
5842215e
PM
6798 set wh [expr {$wbot - $wtop}]
6799 set newtop $wtop
17386066 6800 if {$ytop < $wtop} {
5842215e
PM
6801 if {$ybot < $wtop} {
6802 set newtop [expr {$y - $wh / 2.0}]
6803 } else {
6804 set newtop $ytop
6805 if {$newtop > $wtop - $linespc} {
6806 set newtop [expr {$wtop - $linespc}]
6807 }
17386066 6808 }
5842215e
PM
6809 } elseif {$ybot > $wbot} {
6810 if {$ytop > $wbot} {
6811 set newtop [expr {$y - $wh / 2.0}]
6812 } else {
6813 set newtop [expr {$ybot - $wh}]
6814 if {$newtop < $wtop + $linespc} {
6815 set newtop [expr {$wtop + $linespc}]
6816 }
17386066 6817 }
5842215e
PM
6818 }
6819 if {$newtop != $wtop} {
6820 if {$newtop < 0} {
6821 set newtop 0
6822 }
2ed49d54 6823 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
9f1afe05 6824 drawvisible
5ad588de 6825 }
d698206c 6826
28593d3f 6827 make_secsel $id
9f1afe05 6828
fa4da7b3 6829 if {$isnew} {
354af6bd 6830 addtohistory [list selbyid $id 0] savecmitpos
d698206c
PM
6831 }
6832
98f350e5
PM
6833 $sha1entry delete 0 end
6834 $sha1entry insert 0 $id
95293b58 6835 if {$autoselect} {
d93f1713 6836 $sha1entry selection range 0 end
95293b58 6837 }
164ff275 6838 rhighlight_sel $id
98f350e5 6839
5ad588de 6840 $ctext conf -state normal
3ea06f9f 6841 clear_ctext
106288cb 6842 set linknum 0
d76afb15
PM
6843 if {![info exists commitinfo($id)]} {
6844 getcommit $id
6845 }
1db95b00 6846 set info $commitinfo($id)
232475d3 6847 set date [formatdate [lindex $info 2]]
d990cedf 6848 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
232475d3 6849 set date [formatdate [lindex $info 4]]
d990cedf 6850 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
887fe3c4 6851 if {[info exists idtags($id)]} {
d990cedf 6852 $ctext insert end [mc "Tags:"]
887fe3c4
PM
6853 foreach tag $idtags($id) {
6854 $ctext insert end " $tag"
6855 }
6856 $ctext insert end "\n"
6857 }
40b87ff8 6858
f1b86294 6859 set headers {}
7fcc92bf 6860 set olds $parents($curview,$id)
79b2c75e 6861 if {[llength $olds] > 1} {
b77b0278 6862 set np 0
79b2c75e 6863 foreach p $olds {
b77b0278
PM
6864 if {$np >= $mergemax} {
6865 set tag mmax
6866 } else {
6867 set tag m$np
6868 }
d990cedf 6869 $ctext insert end "[mc "Parent"]: " $tag
f1b86294 6870 appendwithlinks [commit_descriptor $p] {}
b77b0278
PM
6871 incr np
6872 }
6873 } else {
79b2c75e 6874 foreach p $olds {
d990cedf 6875 append headers "[mc "Parent"]: [commit_descriptor $p]"
b1ba39e7
LT
6876 }
6877 }
b77b0278 6878
6a90bff1 6879 foreach c $children($curview,$id) {
d990cedf 6880 append headers "[mc "Child"]: [commit_descriptor $c]"
8b192809 6881 }
d698206c
PM
6882
6883 # make anything that looks like a SHA1 ID be a clickable link
f1b86294 6884 appendwithlinks $headers {}
b8ab2e17
PM
6885 if {$showneartags} {
6886 if {![info exists allcommits]} {
6887 getallcommits
6888 }
d990cedf 6889 $ctext insert end "[mc "Branch"]: "
ef030b85
PM
6890 $ctext mark set branch "end -1c"
6891 $ctext mark gravity branch left
d990cedf 6892 $ctext insert end "\n[mc "Follows"]: "
b8ab2e17
PM
6893 $ctext mark set follows "end -1c"
6894 $ctext mark gravity follows left
d990cedf 6895 $ctext insert end "\n[mc "Precedes"]: "
b8ab2e17
PM
6896 $ctext mark set precedes "end -1c"
6897 $ctext mark gravity precedes left
b8ab2e17 6898 $ctext insert end "\n"
e11f1233 6899 dispneartags 1
b8ab2e17
PM
6900 }
6901 $ctext insert end "\n"
43c25074
PM
6902 set comment [lindex $info 5]
6903 if {[string first "\r" $comment] >= 0} {
6904 set comment [string map {"\r" "\n "} $comment]
6905 }
6906 appendwithlinks $comment {comment}
d698206c 6907
df3d83b1 6908 $ctext tag remove found 1.0 end
5ad588de 6909 $ctext conf -state disabled
df3d83b1 6910 set commentend [$ctext index "end - 1c"]
5ad588de 6911
8a897742 6912 set jump_to_here $desired_loc
b007ee20 6913 init_flist [mc "Comments"]
f8b28a40
PM
6914 if {$cmitmode eq "tree"} {
6915 gettree $id
6916 } elseif {[llength $olds] <= 1} {
d327244a 6917 startdiff $id
7b5ff7e7 6918 } else {
7fcc92bf 6919 mergediff $id
3c461ffe
PM
6920 }
6921}
6922
6e5f7203
RN
6923proc selfirstline {} {
6924 unmarkmatches
6925 selectline 0 1
6926}
6927
6928proc sellastline {} {
6929 global numcommits
6930 unmarkmatches
6931 set l [expr {$numcommits - 1}]
6932 selectline $l 1
6933}
6934
3c461ffe
PM
6935proc selnextline {dir} {
6936 global selectedline
bd441de4 6937 focus .
94b4a69f 6938 if {$selectedline eq {}} return
2ed49d54 6939 set l [expr {$selectedline + $dir}]
3c461ffe 6940 unmarkmatches
d698206c
PM
6941 selectline $l 1
6942}
6943
6e5f7203
RN
6944proc selnextpage {dir} {
6945 global canv linespc selectedline numcommits
6946
6947 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6948 if {$lpp < 1} {
6949 set lpp 1
6950 }
6951 allcanvs yview scroll [expr {$dir * $lpp}] units
e72ee5eb 6952 drawvisible
94b4a69f 6953 if {$selectedline eq {}} return
6e5f7203
RN
6954 set l [expr {$selectedline + $dir * $lpp}]
6955 if {$l < 0} {
6956 set l 0
6957 } elseif {$l >= $numcommits} {
6958 set l [expr $numcommits - 1]
6959 }
6960 unmarkmatches
40b87ff8 6961 selectline $l 1
6e5f7203
RN
6962}
6963
fa4da7b3 6964proc unselectline {} {
50b44ece 6965 global selectedline currentid
fa4da7b3 6966
94b4a69f 6967 set selectedline {}
50b44ece 6968 catch {unset currentid}
fa4da7b3 6969 allcanvs delete secsel
164ff275 6970 rhighlight_none
fa4da7b3
PM
6971}
6972
f8b28a40
PM
6973proc reselectline {} {
6974 global selectedline
6975
94b4a69f 6976 if {$selectedline ne {}} {
f8b28a40
PM
6977 selectline $selectedline 0
6978 }
6979}
6980
354af6bd 6981proc addtohistory {cmd {saveproc {}}} {
2516dae2 6982 global history historyindex curview
fa4da7b3 6983
354af6bd
PM
6984 unset_posvars
6985 save_position
6986 set elt [list $curview $cmd $saveproc {}]
fa4da7b3 6987 if {$historyindex > 0
2516dae2 6988 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
fa4da7b3
PM
6989 return
6990 }
6991
6992 if {$historyindex < [llength $history]} {
2516dae2 6993 set history [lreplace $history $historyindex end $elt]
fa4da7b3 6994 } else {
2516dae2 6995 lappend history $elt
fa4da7b3
PM
6996 }
6997 incr historyindex
6998 if {$historyindex > 1} {
e9937d2a 6999 .tf.bar.leftbut conf -state normal
fa4da7b3 7000 } else {
e9937d2a 7001 .tf.bar.leftbut conf -state disabled
fa4da7b3 7002 }
e9937d2a 7003 .tf.bar.rightbut conf -state disabled
fa4da7b3
PM
7004}
7005
354af6bd
PM
7006# save the scrolling position of the diff display pane
7007proc save_position {} {
7008 global historyindex history
7009
7010 if {$historyindex < 1} return
7011 set hi [expr {$historyindex - 1}]
7012 set fn [lindex $history $hi 2]
7013 if {$fn ne {}} {
7014 lset history $hi 3 [eval $fn]
7015 }
7016}
7017
7018proc unset_posvars {} {
7019 global last_posvars
7020
7021 if {[info exists last_posvars]} {
7022 foreach {var val} $last_posvars {
7023 global $var
7024 catch {unset $var}
7025 }
7026 unset last_posvars
7027 }
7028}
7029
2516dae2 7030proc godo {elt} {
354af6bd 7031 global curview last_posvars
2516dae2
PM
7032
7033 set view [lindex $elt 0]
7034 set cmd [lindex $elt 1]
354af6bd 7035 set pv [lindex $elt 3]
2516dae2
PM
7036 if {$curview != $view} {
7037 showview $view
7038 }
354af6bd
PM
7039 unset_posvars
7040 foreach {var val} $pv {
7041 global $var
7042 set $var $val
7043 }
7044 set last_posvars $pv
2516dae2
PM
7045 eval $cmd
7046}
7047
d698206c
PM
7048proc goback {} {
7049 global history historyindex
bd441de4 7050 focus .
d698206c
PM
7051
7052 if {$historyindex > 1} {
354af6bd 7053 save_position
d698206c 7054 incr historyindex -1
2516dae2 7055 godo [lindex $history [expr {$historyindex - 1}]]
e9937d2a 7056 .tf.bar.rightbut conf -state normal
d698206c
PM
7057 }
7058 if {$historyindex <= 1} {
e9937d2a 7059 .tf.bar.leftbut conf -state disabled
d698206c
PM
7060 }
7061}
7062
7063proc goforw {} {
7064 global history historyindex
bd441de4 7065 focus .
d698206c
PM
7066
7067 if {$historyindex < [llength $history]} {
354af6bd 7068 save_position
fa4da7b3 7069 set cmd [lindex $history $historyindex]
d698206c 7070 incr historyindex
2516dae2 7071 godo $cmd
e9937d2a 7072 .tf.bar.leftbut conf -state normal
d698206c
PM
7073 }
7074 if {$historyindex >= [llength $history]} {
e9937d2a 7075 .tf.bar.rightbut conf -state disabled
d698206c 7076 }
e2ed4324
PM
7077}
7078
f8b28a40 7079proc gettree {id} {
8f489363
PM
7080 global treefilelist treeidlist diffids diffmergeid treepending
7081 global nullid nullid2
f8b28a40
PM
7082
7083 set diffids $id
7084 catch {unset diffmergeid}
7085 if {![info exists treefilelist($id)]} {
7086 if {![info exists treepending]} {
8f489363
PM
7087 if {$id eq $nullid} {
7088 set cmd [list | git ls-files]
7089 } elseif {$id eq $nullid2} {
7090 set cmd [list | git ls-files --stage -t]
219ea3a9 7091 } else {
8f489363 7092 set cmd [list | git ls-tree -r $id]
219ea3a9
PM
7093 }
7094 if {[catch {set gtf [open $cmd r]}]} {
f8b28a40
PM
7095 return
7096 }
7097 set treepending $id
7098 set treefilelist($id) {}
7099 set treeidlist($id) {}
09c7029d 7100 fconfigure $gtf -blocking 0 -encoding binary
7eb3cb9c 7101 filerun $gtf [list gettreeline $gtf $id]
f8b28a40
PM
7102 }
7103 } else {
7104 setfilelist $id
7105 }
7106}
7107
7108proc gettreeline {gtf id} {
8f489363 7109 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
f8b28a40 7110
7eb3cb9c
PM
7111 set nl 0
7112 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
8f489363
PM
7113 if {$diffids eq $nullid} {
7114 set fname $line
7115 } else {
9396cd38
PM
7116 set i [string first "\t" $line]
7117 if {$i < 0} continue
9396cd38 7118 set fname [string range $line [expr {$i+1}] end]
f31fa2c0
PM
7119 set line [string range $line 0 [expr {$i-1}]]
7120 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7121 set sha1 [lindex $line 2]
219ea3a9 7122 lappend treeidlist($id) $sha1
219ea3a9 7123 }
09c7029d
AG
7124 if {[string index $fname 0] eq "\""} {
7125 set fname [lindex $fname 0]
7126 }
7127 set fname [encoding convertfrom $fname]
7eb3cb9c
PM
7128 lappend treefilelist($id) $fname
7129 }
7130 if {![eof $gtf]} {
7131 return [expr {$nl >= 1000? 2: 1}]
f8b28a40 7132 }
f8b28a40
PM
7133 close $gtf
7134 unset treepending
7135 if {$cmitmode ne "tree"} {
7136 if {![info exists diffmergeid]} {
7137 gettreediffs $diffids
7138 }
7139 } elseif {$id ne $diffids} {
7140 gettree $diffids
7141 } else {
7142 setfilelist $id
7143 }
7eb3cb9c 7144 return 0
f8b28a40
PM
7145}
7146
7147proc showfile {f} {
8f489363 7148 global treefilelist treeidlist diffids nullid nullid2
7cdc3556 7149 global ctext_file_names ctext_file_lines
f8b28a40
PM
7150 global ctext commentend
7151
7152 set i [lsearch -exact $treefilelist($diffids) $f]
7153 if {$i < 0} {
7154 puts "oops, $f not in list for id $diffids"
7155 return
7156 }
8f489363
PM
7157 if {$diffids eq $nullid} {
7158 if {[catch {set bf [open $f r]} err]} {
7159 puts "oops, can't read $f: $err"
219ea3a9
PM
7160 return
7161 }
7162 } else {
8f489363
PM
7163 set blob [lindex $treeidlist($diffids) $i]
7164 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7165 puts "oops, error reading blob $blob: $err"
219ea3a9
PM
7166 return
7167 }
f8b28a40 7168 }
09c7029d 7169 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7eb3cb9c 7170 filerun $bf [list getblobline $bf $diffids]
f8b28a40 7171 $ctext config -state normal
3ea06f9f 7172 clear_ctext $commentend
7cdc3556
AG
7173 lappend ctext_file_names $f
7174 lappend ctext_file_lines [lindex [split $commentend "."] 0]
f8b28a40
PM
7175 $ctext insert end "\n"
7176 $ctext insert end "$f\n" filesep
7177 $ctext config -state disabled
7178 $ctext yview $commentend
32f1b3e4 7179 settabs 0
f8b28a40
PM
7180}
7181
7182proc getblobline {bf id} {
7183 global diffids cmitmode ctext
7184
7185 if {$id ne $diffids || $cmitmode ne "tree"} {
7186 catch {close $bf}
7eb3cb9c 7187 return 0
f8b28a40
PM
7188 }
7189 $ctext config -state normal
7eb3cb9c
PM
7190 set nl 0
7191 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
f8b28a40
PM
7192 $ctext insert end "$line\n"
7193 }
7194 if {[eof $bf]} {
8a897742
PM
7195 global jump_to_here ctext_file_names commentend
7196
f8b28a40
PM
7197 # delete last newline
7198 $ctext delete "end - 2c" "end - 1c"
7199 close $bf
8a897742
PM
7200 if {$jump_to_here ne {} &&
7201 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7202 set lnum [expr {[lindex $jump_to_here 1] +
7203 [lindex [split $commentend .] 0]}]
7204 mark_ctext_line $lnum
7205 }
7eb3cb9c 7206 return 0
f8b28a40
PM
7207 }
7208 $ctext config -state disabled
7eb3cb9c 7209 return [expr {$nl >= 1000? 2: 1}]
f8b28a40
PM
7210}
7211
8a897742 7212proc mark_ctext_line {lnum} {
e3e901be 7213 global ctext markbgcolor
8a897742
PM
7214
7215 $ctext tag delete omark
7216 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
e3e901be 7217 $ctext tag conf omark -background $markbgcolor
8a897742
PM
7218 $ctext see $lnum.0
7219}
7220
7fcc92bf 7221proc mergediff {id} {
8b07dca1 7222 global diffmergeid
2df6442f 7223 global diffids treediffs
8b07dca1 7224 global parents curview
e2ed4324 7225
3c461ffe 7226 set diffmergeid $id
7a1d9d14 7227 set diffids $id
2df6442f 7228 set treediffs($id) {}
7fcc92bf 7229 set np [llength $parents($curview,$id)]
32f1b3e4 7230 settabs $np
8b07dca1 7231 getblobdiffs $id
c8a4acbf
PM
7232}
7233
3c461ffe 7234proc startdiff {ids} {
8f489363 7235 global treediffs diffids treepending diffmergeid nullid nullid2
c8dfbcf9 7236
32f1b3e4 7237 settabs 1
4f2c2642 7238 set diffids $ids
3c461ffe 7239 catch {unset diffmergeid}
8f489363
PM
7240 if {![info exists treediffs($ids)] ||
7241 [lsearch -exact $ids $nullid] >= 0 ||
7242 [lsearch -exact $ids $nullid2] >= 0} {
c8dfbcf9 7243 if {![info exists treepending]} {
14c9dbd6 7244 gettreediffs $ids
c8dfbcf9
PM
7245 }
7246 } else {
14c9dbd6 7247 addtocflist $ids
c8dfbcf9
PM
7248 }
7249}
7250
7a39a17a
PM
7251proc path_filter {filter name} {
7252 foreach p $filter {
7253 set l [string length $p]
74a40c71
PM
7254 if {[string index $p end] eq "/"} {
7255 if {[string compare -length $l $p $name] == 0} {
7256 return 1
7257 }
7258 } else {
7259 if {[string compare -length $l $p $name] == 0 &&
7260 ([string length $name] == $l ||
7261 [string index $name $l] eq "/")} {
7262 return 1
7263 }
7a39a17a
PM
7264 }
7265 }
7266 return 0
7267}
7268
c8dfbcf9 7269proc addtocflist {ids} {
74a40c71 7270 global treediffs
7a39a17a 7271
74a40c71 7272 add_flist $treediffs($ids)
c8dfbcf9 7273 getblobdiffs $ids
d2610d11
PM
7274}
7275
219ea3a9 7276proc diffcmd {ids flags} {
8f489363 7277 global nullid nullid2
219ea3a9
PM
7278
7279 set i [lsearch -exact $ids $nullid]
8f489363 7280 set j [lsearch -exact $ids $nullid2]
219ea3a9 7281 if {$i >= 0} {
8f489363
PM
7282 if {[llength $ids] > 1 && $j < 0} {
7283 # comparing working directory with some specific revision
7284 set cmd [concat | git diff-index $flags]
7285 if {$i == 0} {
7286 lappend cmd -R [lindex $ids 1]
7287 } else {
7288 lappend cmd [lindex $ids 0]
7289 }
7290 } else {
7291 # comparing working directory with index
7292 set cmd [concat | git diff-files $flags]
7293 if {$j == 1} {
7294 lappend cmd -R
7295 }
7296 }
7297 } elseif {$j >= 0} {
7298 set cmd [concat | git diff-index --cached $flags]
219ea3a9 7299 if {[llength $ids] > 1} {
8f489363 7300 # comparing index with specific revision
219ea3a9
PM
7301 if {$i == 0} {
7302 lappend cmd -R [lindex $ids 1]
7303 } else {
7304 lappend cmd [lindex $ids 0]
7305 }
7306 } else {
8f489363 7307 # comparing index with HEAD
219ea3a9
PM
7308 lappend cmd HEAD
7309 }
7310 } else {
8f489363 7311 set cmd [concat | git diff-tree -r $flags $ids]
219ea3a9
PM
7312 }
7313 return $cmd
7314}
7315
c8dfbcf9 7316proc gettreediffs {ids} {
79b2c75e 7317 global treediff treepending
219ea3a9 7318
7272131b
AG
7319 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7320
c8dfbcf9 7321 set treepending $ids
3c461ffe 7322 set treediff {}
09c7029d 7323 fconfigure $gdtf -blocking 0 -encoding binary
7eb3cb9c 7324 filerun $gdtf [list gettreediffline $gdtf $ids]
d2610d11
PM
7325}
7326
c8dfbcf9 7327proc gettreediffline {gdtf ids} {
3c461ffe 7328 global treediff treediffs treepending diffids diffmergeid
39ee47ef 7329 global cmitmode vfilelimit curview limitdiffs perfile_attrs
3c461ffe 7330
7eb3cb9c 7331 set nr 0
4db09304 7332 set sublist {}
39ee47ef
PM
7333 set max 1000
7334 if {$perfile_attrs} {
7335 # cache_gitattr is slow, and even slower on win32 where we
7336 # have to invoke it for only about 30 paths at a time
7337 set max 500
7338 if {[tk windowingsystem] == "win32"} {
7339 set max 120
7340 }
7341 }
7342 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
9396cd38
PM
7343 set i [string first "\t" $line]
7344 if {$i >= 0} {
7345 set file [string range $line [expr {$i+1}] end]
7346 if {[string index $file 0] eq "\""} {
7347 set file [lindex $file 0]
7348 }
09c7029d 7349 set file [encoding convertfrom $file]
48a81b7c
PM
7350 if {$file ne [lindex $treediff end]} {
7351 lappend treediff $file
7352 lappend sublist $file
7353 }
9396cd38 7354 }
7eb3cb9c 7355 }
39ee47ef
PM
7356 if {$perfile_attrs} {
7357 cache_gitattr encoding $sublist
7358 }
7eb3cb9c 7359 if {![eof $gdtf]} {
39ee47ef 7360 return [expr {$nr >= $max? 2: 1}]
7eb3cb9c
PM
7361 }
7362 close $gdtf
3ed31a81 7363 if {$limitdiffs && $vfilelimit($curview) ne {}} {
74a40c71
PM
7364 set flist {}
7365 foreach f $treediff {
3ed31a81 7366 if {[path_filter $vfilelimit($curview) $f]} {
74a40c71
PM
7367 lappend flist $f
7368 }
7369 }
7370 set treediffs($ids) $flist
7371 } else {
7372 set treediffs($ids) $treediff
7373 }
7eb3cb9c 7374 unset treepending
e1160138 7375 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7eb3cb9c
PM
7376 gettree $diffids
7377 } elseif {$ids != $diffids} {
7378 if {![info exists diffmergeid]} {
7379 gettreediffs $diffids
b74fd579 7380 }
7eb3cb9c
PM
7381 } else {
7382 addtocflist $ids
d2610d11 7383 }
7eb3cb9c 7384 return 0
d2610d11
PM
7385}
7386
890fae70
SP
7387# empty string or positive integer
7388proc diffcontextvalidate {v} {
7389 return [regexp {^(|[1-9][0-9]*)$} $v]
7390}
7391
7392proc diffcontextchange {n1 n2 op} {
7393 global diffcontextstring diffcontext
7394
7395 if {[string is integer -strict $diffcontextstring]} {
7396 if {$diffcontextstring > 0} {
7397 set diffcontext $diffcontextstring
7398 reselectline
7399 }
7400 }
7401}
7402
b9b86007
SP
7403proc changeignorespace {} {
7404 reselectline
7405}
7406
c8dfbcf9 7407proc getblobdiffs {ids} {
8d73b242 7408 global blobdifffd diffids env
7eb3cb9c 7409 global diffinhdr treediffs
890fae70 7410 global diffcontext
b9b86007 7411 global ignorespace
3ed31a81 7412 global limitdiffs vfilelimit curview
8b07dca1 7413 global diffencoding targetline diffnparents
c8dfbcf9 7414
8b07dca1 7415 set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
b9b86007
SP
7416 if {$ignorespace} {
7417 append cmd " -w"
7418 }
3ed31a81
PM
7419 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7420 set cmd [concat $cmd -- $vfilelimit($curview)]
7a39a17a
PM
7421 }
7422 if {[catch {set bdf [open $cmd r]} err]} {
8b07dca1 7423 error_popup [mc "Error getting diffs: %s" $err]
e5c2d856
PM
7424 return
7425 }
8a897742 7426 set targetline {}
8b07dca1 7427 set diffnparents 0
4f2c2642 7428 set diffinhdr 0
09c7029d 7429 set diffencoding [get_path_encoding {}]
681c3290 7430 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
c8dfbcf9 7431 set blobdifffd($ids) $bdf
7eb3cb9c 7432 filerun $bdf [list getblobdiffline $bdf $diffids]
e5c2d856
PM
7433}
7434
354af6bd
PM
7435proc savecmitpos {} {
7436 global ctext cmitmode
7437
7438 if {$cmitmode eq "tree"} {
7439 return {}
7440 }
7441 return [list target_scrollpos [$ctext index @0,0]]
7442}
7443
7444proc savectextpos {} {
7445 global ctext
7446
7447 return [list target_scrollpos [$ctext index @0,0]]
7448}
7449
7450proc maybe_scroll_ctext {ateof} {
7451 global ctext target_scrollpos
7452
7453 if {![info exists target_scrollpos]} return
7454 if {!$ateof} {
7455 set nlines [expr {[winfo height $ctext]
7456 / [font metrics textfont -linespace]}]
7457 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7458 }
7459 $ctext yview $target_scrollpos
7460 unset target_scrollpos
7461}
7462
89b11d3b
PM
7463proc setinlist {var i val} {
7464 global $var
7465
7466 while {[llength [set $var]] < $i} {
7467 lappend $var {}
7468 }
7469 if {[llength [set $var]] == $i} {
7470 lappend $var $val
7471 } else {
7472 lset $var $i $val
7473 }
7474}
7475
9396cd38 7476proc makediffhdr {fname ids} {
8b07dca1 7477 global ctext curdiffstart treediffs diffencoding
8a897742 7478 global ctext_file_names jump_to_here targetline diffline
9396cd38 7479
8b07dca1
PM
7480 set fname [encoding convertfrom $fname]
7481 set diffencoding [get_path_encoding $fname]
9396cd38
PM
7482 set i [lsearch -exact $treediffs($ids) $fname]
7483 if {$i >= 0} {
7484 setinlist difffilestart $i $curdiffstart
7485 }
48a81b7c 7486 lset ctext_file_names end $fname
9396cd38
PM
7487 set l [expr {(78 - [string length $fname]) / 2}]
7488 set pad [string range "----------------------------------------" 1 $l]
7489 $ctext insert $curdiffstart "$pad $fname $pad" filesep
8a897742
PM
7490 set targetline {}
7491 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7492 set targetline [lindex $jump_to_here 1]
7493 }
7494 set diffline 0
9396cd38
PM
7495}
7496
c8dfbcf9 7497proc getblobdiffline {bdf ids} {
9396cd38 7498 global diffids blobdifffd ctext curdiffstart
7eab2933 7499 global diffnexthead diffnextnote difffilestart
7cdc3556 7500 global ctext_file_names ctext_file_lines
8b07dca1 7501 global diffinhdr treediffs mergemax diffnparents
8a897742 7502 global diffencoding jump_to_here targetline diffline
c8dfbcf9 7503
7eb3cb9c 7504 set nr 0
e5c2d856 7505 $ctext conf -state normal
7eb3cb9c
PM
7506 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7507 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7508 close $bdf
7509 return 0
89b11d3b 7510 }
8b07dca1
PM
7511 if {![string compare -length 5 "diff " $line]} {
7512 if {![regexp {^diff (--cc|--git) } $line m type]} {
7513 set line [encoding convertfrom $line]
7514 $ctext insert end "$line\n" hunksep
7515 continue
7516 }
7eb3cb9c 7517 # start of a new file
8b07dca1 7518 set diffinhdr 1
7eb3cb9c 7519 $ctext insert end "\n"
9396cd38 7520 set curdiffstart [$ctext index "end - 1c"]
7cdc3556
AG
7521 lappend ctext_file_names ""
7522 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
9396cd38 7523 $ctext insert end "\n" filesep
8b07dca1
PM
7524
7525 if {$type eq "--cc"} {
7526 # start of a new file in a merge diff
7527 set fname [string range $line 10 end]
7528 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7529 lappend treediffs($ids) $fname
7530 add_flist [list $fname]
7531 }
7532
9396cd38 7533 } else {
8b07dca1
PM
7534 set line [string range $line 11 end]
7535 # If the name hasn't changed the length will be odd,
7536 # the middle char will be a space, and the two bits either
7537 # side will be a/name and b/name, or "a/name" and "b/name".
7538 # If the name has changed we'll get "rename from" and
7539 # "rename to" or "copy from" and "copy to" lines following
7540 # this, and we'll use them to get the filenames.
7541 # This complexity is necessary because spaces in the
7542 # filename(s) don't get escaped.
7543 set l [string length $line]
7544 set i [expr {$l / 2}]
7545 if {!(($l & 1) && [string index $line $i] eq " " &&
7546 [string range $line 2 [expr {$i - 1}]] eq \
7547 [string range $line [expr {$i + 3}] end])} {
7548 continue
7549 }
7550 # unescape if quoted and chop off the a/ from the front
7551 if {[string index $line 0] eq "\""} {
7552 set fname [string range [lindex $line 0] 2 end]
7553 } else {
7554 set fname [string range $line 2 [expr {$i - 1}]]
7555 }
7eb3cb9c 7556 }
9396cd38
PM
7557 makediffhdr $fname $ids
7558
48a81b7c
PM
7559 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7560 set fname [encoding convertfrom [string range $line 16 end]]
7561 $ctext insert end "\n"
7562 set curdiffstart [$ctext index "end - 1c"]
7563 lappend ctext_file_names $fname
7564 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7565 $ctext insert end "$line\n" filesep
7566 set i [lsearch -exact $treediffs($ids) $fname]
7567 if {$i >= 0} {
7568 setinlist difffilestart $i $curdiffstart
7569 }
7570
8b07dca1
PM
7571 } elseif {![string compare -length 2 "@@" $line]} {
7572 regexp {^@@+} $line ats
09c7029d 7573 set line [encoding convertfrom $diffencoding $line]
7eb3cb9c 7574 $ctext insert end "$line\n" hunksep
8b07dca1
PM
7575 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7576 set diffline $nl
7577 }
7578 set diffnparents [expr {[string length $ats] - 1}]
7eb3cb9c 7579 set diffinhdr 0
9396cd38
PM
7580
7581 } elseif {$diffinhdr} {
5e85ec4c 7582 if {![string compare -length 12 "rename from " $line]} {
d1cb298b 7583 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
9396cd38
PM
7584 if {[string index $fname 0] eq "\""} {
7585 set fname [lindex $fname 0]
7586 }
09c7029d 7587 set fname [encoding convertfrom $fname]
9396cd38
PM
7588 set i [lsearch -exact $treediffs($ids) $fname]
7589 if {$i >= 0} {
7590 setinlist difffilestart $i $curdiffstart
7591 }
d1cb298b
JS
7592 } elseif {![string compare -length 10 $line "rename to "] ||
7593 ![string compare -length 8 $line "copy to "]} {
7594 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
9396cd38
PM
7595 if {[string index $fname 0] eq "\""} {
7596 set fname [lindex $fname 0]
7597 }
7598 makediffhdr $fname $ids
7599 } elseif {[string compare -length 3 $line "---"] == 0} {
7600 # do nothing
7601 continue
7602 } elseif {[string compare -length 3 $line "+++"] == 0} {
7603 set diffinhdr 0
7604 continue
7605 }
7606 $ctext insert end "$line\n" filesep
7607
e5c2d856 7608 } else {
681c3290
PT
7609 set line [string map {\x1A ^Z} \
7610 [encoding convertfrom $diffencoding $line]]
8b07dca1
PM
7611 # parse the prefix - one ' ', '-' or '+' for each parent
7612 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7613 set tag [expr {$diffnparents > 1? "m": "d"}]
7614 if {[string trim $prefix " -+"] eq {}} {
7615 # prefix only has " ", "-" and "+" in it: normal diff line
7616 set num [string first "-" $prefix]
7617 if {$num >= 0} {
7618 # removed line, first parent with line is $num
7619 if {$num >= $mergemax} {
7620 set num "max"
7621 }
7622 $ctext insert end "$line\n" $tag$num
7623 } else {
7624 set tags {}
7625 if {[string first "+" $prefix] >= 0} {
7626 # added line
7627 lappend tags ${tag}result
7628 if {$diffnparents > 1} {
7629 set num [string first " " $prefix]
7630 if {$num >= 0} {
7631 if {$num >= $mergemax} {
7632 set num "max"
7633 }
7634 lappend tags m$num
7635 }
7636 }
7637 }
7638 if {$targetline ne {}} {
7639 if {$diffline == $targetline} {
7640 set seehere [$ctext index "end - 1 chars"]
7641 set targetline {}
7642 } else {
7643 incr diffline
7644 }
7645 }
7646 $ctext insert end "$line\n" $tags
7647 }
7eb3cb9c 7648 } else {
9396cd38
PM
7649 # "\ No newline at end of file",
7650 # or something else we don't recognize
7651 $ctext insert end "$line\n" hunksep
e5c2d856 7652 }
e5c2d856
PM
7653 }
7654 }
8b07dca1
PM
7655 if {[info exists seehere]} {
7656 mark_ctext_line [lindex [split $seehere .] 0]
7657 }
354af6bd 7658 maybe_scroll_ctext [eof $bdf]
e5c2d856 7659 $ctext conf -state disabled
7eb3cb9c
PM
7660 if {[eof $bdf]} {
7661 close $bdf
7eb3cb9c 7662 return 0
c8dfbcf9 7663 }
7eb3cb9c 7664 return [expr {$nr >= 1000? 2: 1}]
e5c2d856
PM
7665}
7666
a8d610a2
PM
7667proc changediffdisp {} {
7668 global ctext diffelide
7669
7670 $ctext tag conf d0 -elide [lindex $diffelide 0]
8b07dca1 7671 $ctext tag conf dresult -elide [lindex $diffelide 1]
a8d610a2
PM
7672}
7673
f4c54b3c
PM
7674proc highlightfile {loc cline} {
7675 global ctext cflist cflist_top
7676
7677 $ctext yview $loc
7678 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7679 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7680 $cflist see $cline.0
7681 set cflist_top $cline
7682}
7683
67c22874 7684proc prevfile {} {
f4c54b3c
PM
7685 global difffilestart ctext cmitmode
7686
7687 if {$cmitmode eq "tree"} return
7688 set prev 0.0
7689 set prevline 1
67c22874
OH
7690 set here [$ctext index @0,0]
7691 foreach loc $difffilestart {
7692 if {[$ctext compare $loc >= $here]} {
f4c54b3c 7693 highlightfile $prev $prevline
67c22874
OH
7694 return
7695 }
7696 set prev $loc
f4c54b3c 7697 incr prevline
67c22874 7698 }
f4c54b3c 7699 highlightfile $prev $prevline
67c22874
OH
7700}
7701
39ad8570 7702proc nextfile {} {
f4c54b3c
PM
7703 global difffilestart ctext cmitmode
7704
7705 if {$cmitmode eq "tree"} return
39ad8570 7706 set here [$ctext index @0,0]
f4c54b3c 7707 set line 1
7fcceed7 7708 foreach loc $difffilestart {
f4c54b3c 7709 incr line
7fcceed7 7710 if {[$ctext compare $loc > $here]} {
f4c54b3c 7711 highlightfile $loc $line
67c22874 7712 return
39ad8570
PM
7713 }
7714 }
1db95b00
PM
7715}
7716
3ea06f9f
PM
7717proc clear_ctext {{first 1.0}} {
7718 global ctext smarktop smarkbot
7cdc3556 7719 global ctext_file_names ctext_file_lines
97645683 7720 global pendinglinks
3ea06f9f 7721
1902c270
PM
7722 set l [lindex [split $first .] 0]
7723 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7724 set smarktop $l
3ea06f9f 7725 }
1902c270
PM
7726 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7727 set smarkbot $l
3ea06f9f
PM
7728 }
7729 $ctext delete $first end
97645683
PM
7730 if {$first eq "1.0"} {
7731 catch {unset pendinglinks}
7732 }
7cdc3556
AG
7733 set ctext_file_names {}
7734 set ctext_file_lines {}
3ea06f9f
PM
7735}
7736
32f1b3e4 7737proc settabs {{firstab {}}} {
9c311b32 7738 global firsttabstop tabstop ctext have_tk85
32f1b3e4
PM
7739
7740 if {$firstab ne {} && $have_tk85} {
7741 set firsttabstop $firstab
7742 }
9c311b32 7743 set w [font measure textfont "0"]
32f1b3e4 7744 if {$firsttabstop != 0} {
64b5f146
PM
7745 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7746 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
32f1b3e4
PM
7747 } elseif {$have_tk85 || $tabstop != 8} {
7748 $ctext conf -tabs [expr {$tabstop * $w}]
7749 } else {
7750 $ctext conf -tabs {}
7751 }
3ea06f9f
PM
7752}
7753
7754proc incrsearch {name ix op} {
1902c270 7755 global ctext searchstring searchdirn
3ea06f9f
PM
7756
7757 $ctext tag remove found 1.0 end
1902c270
PM
7758 if {[catch {$ctext index anchor}]} {
7759 # no anchor set, use start of selection, or of visible area
7760 set sel [$ctext tag ranges sel]
7761 if {$sel ne {}} {
7762 $ctext mark set anchor [lindex $sel 0]
7763 } elseif {$searchdirn eq "-forwards"} {
7764 $ctext mark set anchor @0,0
7765 } else {
7766 $ctext mark set anchor @0,[winfo height $ctext]
7767 }
7768 }
3ea06f9f 7769 if {$searchstring ne {}} {
1902c270
PM
7770 set here [$ctext search $searchdirn -- $searchstring anchor]
7771 if {$here ne {}} {
7772 $ctext see $here
7773 }
3ea06f9f
PM
7774 searchmarkvisible 1
7775 }
7776}
7777
7778proc dosearch {} {
1902c270 7779 global sstring ctext searchstring searchdirn
3ea06f9f
PM
7780
7781 focus $sstring
7782 $sstring icursor end
1902c270
PM
7783 set searchdirn -forwards
7784 if {$searchstring ne {}} {
7785 set sel [$ctext tag ranges sel]
7786 if {$sel ne {}} {
7787 set start "[lindex $sel 0] + 1c"
7788 } elseif {[catch {set start [$ctext index anchor]}]} {
7789 set start "@0,0"
7790 }
7791 set match [$ctext search -count mlen -- $searchstring $start]
7792 $ctext tag remove sel 1.0 end
7793 if {$match eq {}} {
7794 bell
7795 return
7796 }
7797 $ctext see $match
7798 set mend "$match + $mlen c"
7799 $ctext tag add sel $match $mend
7800 $ctext mark unset anchor
7801 }
7802}
7803
7804proc dosearchback {} {
7805 global sstring ctext searchstring searchdirn
7806
7807 focus $sstring
7808 $sstring icursor end
7809 set searchdirn -backwards
7810 if {$searchstring ne {}} {
7811 set sel [$ctext tag ranges sel]
7812 if {$sel ne {}} {
7813 set start [lindex $sel 0]
7814 } elseif {[catch {set start [$ctext index anchor]}]} {
7815 set start @0,[winfo height $ctext]
7816 }
7817 set match [$ctext search -backwards -count ml -- $searchstring $start]
7818 $ctext tag remove sel 1.0 end
7819 if {$match eq {}} {
7820 bell
7821 return
7822 }
7823 $ctext see $match
7824 set mend "$match + $ml c"
7825 $ctext tag add sel $match $mend
7826 $ctext mark unset anchor
3ea06f9f 7827 }
3ea06f9f
PM
7828}
7829
7830proc searchmark {first last} {
7831 global ctext searchstring
7832
7833 set mend $first.0
7834 while {1} {
7835 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7836 if {$match eq {}} break
7837 set mend "$match + $mlen c"
7838 $ctext tag add found $match $mend
7839 }
7840}
7841
7842proc searchmarkvisible {doall} {
7843 global ctext smarktop smarkbot
7844
7845 set topline [lindex [split [$ctext index @0,0] .] 0]
7846 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7847 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7848 # no overlap with previous
7849 searchmark $topline $botline
7850 set smarktop $topline
7851 set smarkbot $botline
7852 } else {
7853 if {$topline < $smarktop} {
7854 searchmark $topline [expr {$smarktop-1}]
7855 set smarktop $topline
7856 }
7857 if {$botline > $smarkbot} {
7858 searchmark [expr {$smarkbot+1}] $botline
7859 set smarkbot $botline
7860 }
7861 }
7862}
7863
7864proc scrolltext {f0 f1} {
1902c270 7865 global searchstring
3ea06f9f 7866
8809d691 7867 .bleft.bottom.sb set $f0 $f1
3ea06f9f
PM
7868 if {$searchstring ne {}} {
7869 searchmarkvisible 0
7870 }
7871}
7872
1d10f36d 7873proc setcoords {} {
9c311b32 7874 global linespc charspc canvx0 canvy0
f6075eba 7875 global xspc1 xspc2 lthickness
8d858d1a 7876
9c311b32
PM
7877 set linespc [font metrics mainfont -linespace]
7878 set charspc [font measure mainfont "m"]
9f1afe05
PM
7879 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7880 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
f6075eba 7881 set lthickness [expr {int($linespc / 9) + 1}]
8d858d1a
PM
7882 set xspc1(0) $linespc
7883 set xspc2 $linespc
9a40c50c 7884}
1db95b00 7885
1d10f36d 7886proc redisplay {} {
be0cd098 7887 global canv
9f1afe05
PM
7888 global selectedline
7889
7890 set ymax [lindex [$canv cget -scrollregion] 3]
7891 if {$ymax eq {} || $ymax == 0} return
7892 set span [$canv yview]
7893 clear_display
be0cd098 7894 setcanvscroll
9f1afe05
PM
7895 allcanvs yview moveto [lindex $span 0]
7896 drawvisible
94b4a69f 7897 if {$selectedline ne {}} {
9f1afe05 7898 selectline $selectedline 0
ca6d8f58 7899 allcanvs yview moveto [lindex $span 0]
1d10f36d
PM
7900 }
7901}
7902
0ed1dd3c
PM
7903proc parsefont {f n} {
7904 global fontattr
7905
7906 set fontattr($f,family) [lindex $n 0]
7907 set s [lindex $n 1]
7908 if {$s eq {} || $s == 0} {
7909 set s 10
7910 } elseif {$s < 0} {
7911 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
9c311b32 7912 }
0ed1dd3c
PM
7913 set fontattr($f,size) $s
7914 set fontattr($f,weight) normal
7915 set fontattr($f,slant) roman
7916 foreach style [lrange $n 2 end] {
7917 switch -- $style {
7918 "normal" -
7919 "bold" {set fontattr($f,weight) $style}
7920 "roman" -
7921 "italic" {set fontattr($f,slant) $style}
7922 }
9c311b32 7923 }
0ed1dd3c
PM
7924}
7925
7926proc fontflags {f {isbold 0}} {
7927 global fontattr
7928
7929 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7930 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7931 -slant $fontattr($f,slant)]
7932}
7933
7934proc fontname {f} {
7935 global fontattr
7936
7937 set n [list $fontattr($f,family) $fontattr($f,size)]
7938 if {$fontattr($f,weight) eq "bold"} {
7939 lappend n "bold"
9c311b32 7940 }
0ed1dd3c
PM
7941 if {$fontattr($f,slant) eq "italic"} {
7942 lappend n "italic"
9c311b32 7943 }
0ed1dd3c 7944 return $n
9c311b32
PM
7945}
7946
1d10f36d 7947proc incrfont {inc} {
7fcc92bf 7948 global mainfont textfont ctext canv cflist showrefstop
0ed1dd3c
PM
7949 global stopped entries fontattr
7950
1d10f36d 7951 unmarkmatches
0ed1dd3c 7952 set s $fontattr(mainfont,size)
9c311b32
PM
7953 incr s $inc
7954 if {$s < 1} {
7955 set s 1
7956 }
0ed1dd3c 7957 set fontattr(mainfont,size) $s
9c311b32
PM
7958 font config mainfont -size $s
7959 font config mainfontbold -size $s
0ed1dd3c
PM
7960 set mainfont [fontname mainfont]
7961 set s $fontattr(textfont,size)
9c311b32
PM
7962 incr s $inc
7963 if {$s < 1} {
7964 set s 1
7965 }
0ed1dd3c 7966 set fontattr(textfont,size) $s
9c311b32
PM
7967 font config textfont -size $s
7968 font config textfontbold -size $s
0ed1dd3c 7969 set textfont [fontname textfont]
1d10f36d 7970 setcoords
32f1b3e4 7971 settabs
1d10f36d
PM
7972 redisplay
7973}
1db95b00 7974
ee3dc72e
PM
7975proc clearsha1 {} {
7976 global sha1entry sha1string
7977 if {[string length $sha1string] == 40} {
7978 $sha1entry delete 0 end
7979 }
7980}
7981
887fe3c4
PM
7982proc sha1change {n1 n2 op} {
7983 global sha1string currentid sha1but
7984 if {$sha1string == {}
7985 || ([info exists currentid] && $sha1string == $currentid)} {
7986 set state disabled
7987 } else {
7988 set state normal
7989 }
7990 if {[$sha1but cget -state] == $state} return
7991 if {$state == "normal"} {
d990cedf 7992 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
887fe3c4 7993 } else {
d990cedf 7994 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
887fe3c4
PM
7995 }
7996}
7997
7998proc gotocommit {} {
7fcc92bf 7999 global sha1string tagids headids curview varcid
f3b8b3ce 8000
887fe3c4
PM
8001 if {$sha1string == {}
8002 || ([info exists currentid] && $sha1string == $currentid)} return
8003 if {[info exists tagids($sha1string)]} {
8004 set id $tagids($sha1string)
e1007129
SR
8005 } elseif {[info exists headids($sha1string)]} {
8006 set id $headids($sha1string)
887fe3c4
PM
8007 } else {
8008 set id [string tolower $sha1string]
f3b8b3ce 8009 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
d375ef9b 8010 set matches [longid $id]
f3b8b3ce
PM
8011 if {$matches ne {}} {
8012 if {[llength $matches] > 1} {
d990cedf 8013 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
f3b8b3ce
PM
8014 return
8015 }
d375ef9b 8016 set id [lindex $matches 0]
f3b8b3ce
PM
8017 }
8018 }
887fe3c4 8019 }
7fcc92bf
PM
8020 if {[commitinview $id $curview]} {
8021 selectline [rowofcommit $id] 1
887fe3c4
PM
8022 return
8023 }
f3b8b3ce 8024 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
d990cedf 8025 set msg [mc "SHA1 id %s is not known" $sha1string]
887fe3c4 8026 } else {
d990cedf 8027 set msg [mc "Tag/Head %s is not known" $sha1string]
887fe3c4 8028 }
d990cedf 8029 error_popup $msg
887fe3c4
PM
8030}
8031
84ba7345
PM
8032proc lineenter {x y id} {
8033 global hoverx hovery hoverid hovertimer
8034 global commitinfo canv
8035
8ed16484 8036 if {![info exists commitinfo($id)] && ![getcommit $id]} return
84ba7345
PM
8037 set hoverx $x
8038 set hovery $y
8039 set hoverid $id
8040 if {[info exists hovertimer]} {
8041 after cancel $hovertimer
8042 }
8043 set hovertimer [after 500 linehover]
8044 $canv delete hover
8045}
8046
8047proc linemotion {x y id} {
8048 global hoverx hovery hoverid hovertimer
8049
8050 if {[info exists hoverid] && $id == $hoverid} {
8051 set hoverx $x
8052 set hovery $y
8053 if {[info exists hovertimer]} {
8054 after cancel $hovertimer
8055 }
8056 set hovertimer [after 500 linehover]
8057 }
8058}
8059
8060proc lineleave {id} {
8061 global hoverid hovertimer canv
8062
8063 if {[info exists hoverid] && $id == $hoverid} {
8064 $canv delete hover
8065 if {[info exists hovertimer]} {
8066 after cancel $hovertimer
8067 unset hovertimer
8068 }
8069 unset hoverid
8070 }
8071}
8072
8073proc linehover {} {
8074 global hoverx hovery hoverid hovertimer
8075 global canv linespc lthickness
9c311b32 8076 global commitinfo
84ba7345
PM
8077
8078 set text [lindex $commitinfo($hoverid) 0]
8079 set ymax [lindex [$canv cget -scrollregion] 3]
8080 if {$ymax == {}} return
8081 set yfrac [lindex [$canv yview] 0]
8082 set x [expr {$hoverx + 2 * $linespc}]
8083 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8084 set x0 [expr {$x - 2 * $lthickness}]
8085 set y0 [expr {$y - 2 * $lthickness}]
9c311b32 8086 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
84ba7345
PM
8087 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8088 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8089 -fill \#ffff80 -outline black -width 1 -tags hover]
8090 $canv raise $t
f8a2c0d1 8091 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
9c311b32 8092 -font mainfont]
84ba7345
PM
8093 $canv raise $t
8094}
8095
9843c307 8096proc clickisonarrow {id y} {
50b44ece 8097 global lthickness
9843c307 8098
50b44ece 8099 set ranges [rowranges $id]
9843c307 8100 set thresh [expr {2 * $lthickness + 6}]
50b44ece 8101 set n [expr {[llength $ranges] - 1}]
f6342480 8102 for {set i 1} {$i < $n} {incr i} {
50b44ece 8103 set row [lindex $ranges $i]
f6342480
PM
8104 if {abs([yc $row] - $y) < $thresh} {
8105 return $i
9843c307
PM
8106 }
8107 }
8108 return {}
8109}
8110
f6342480 8111proc arrowjump {id n y} {
50b44ece 8112 global canv
9843c307 8113
f6342480
PM
8114 # 1 <-> 2, 3 <-> 4, etc...
8115 set n [expr {(($n - 1) ^ 1) + 1}]
50b44ece 8116 set row [lindex [rowranges $id] $n]
f6342480 8117 set yt [yc $row]
9843c307
PM
8118 set ymax [lindex [$canv cget -scrollregion] 3]
8119 if {$ymax eq {} || $ymax <= 0} return
8120 set view [$canv yview]
8121 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8122 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8123 if {$yfrac < 0} {
8124 set yfrac 0
8125 }
f6342480 8126 allcanvs yview moveto $yfrac
9843c307
PM
8127}
8128
fa4da7b3 8129proc lineclick {x y id isnew} {
7fcc92bf 8130 global ctext commitinfo children canv thickerline curview
c8dfbcf9 8131
8ed16484 8132 if {![info exists commitinfo($id)] && ![getcommit $id]} return
c8dfbcf9 8133 unmarkmatches
fa4da7b3 8134 unselectline
9843c307
PM
8135 normalline
8136 $canv delete hover
8137 # draw this line thicker than normal
9843c307 8138 set thickerline $id
c934a8a3 8139 drawlines $id
fa4da7b3 8140 if {$isnew} {
9843c307
PM
8141 set ymax [lindex [$canv cget -scrollregion] 3]
8142 if {$ymax eq {}} return
8143 set yfrac [lindex [$canv yview] 0]
8144 set y [expr {$y + $yfrac * $ymax}]
8145 }
8146 set dirn [clickisonarrow $id $y]
8147 if {$dirn ne {}} {
8148 arrowjump $id $dirn $y
8149 return
8150 }
8151
8152 if {$isnew} {
354af6bd 8153 addtohistory [list lineclick $x $y $id 0] savectextpos
fa4da7b3 8154 }
c8dfbcf9
PM
8155 # fill the details pane with info about this line
8156 $ctext conf -state normal
3ea06f9f 8157 clear_ctext
32f1b3e4 8158 settabs 0
d990cedf 8159 $ctext insert end "[mc "Parent"]:\t"
97645683
PM
8160 $ctext insert end $id link0
8161 setlink $id link0
c8dfbcf9 8162 set info $commitinfo($id)
fa4da7b3 8163 $ctext insert end "\n\t[lindex $info 0]\n"
d990cedf 8164 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
232475d3 8165 set date [formatdate [lindex $info 2]]
d990cedf 8166 $ctext insert end "\t[mc "Date"]:\t$date\n"
da7c24dd 8167 set kids $children($curview,$id)
79b2c75e 8168 if {$kids ne {}} {
d990cedf 8169 $ctext insert end "\n[mc "Children"]:"
fa4da7b3 8170 set i 0
79b2c75e 8171 foreach child $kids {
fa4da7b3 8172 incr i
8ed16484 8173 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
c8dfbcf9 8174 set info $commitinfo($child)
fa4da7b3 8175 $ctext insert end "\n\t"
97645683
PM
8176 $ctext insert end $child link$i
8177 setlink $child link$i
fa4da7b3 8178 $ctext insert end "\n\t[lindex $info 0]"
d990cedf 8179 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
232475d3 8180 set date [formatdate [lindex $info 2]]
d990cedf 8181 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
c8dfbcf9
PM
8182 }
8183 }
354af6bd 8184 maybe_scroll_ctext 1
c8dfbcf9 8185 $ctext conf -state disabled
7fcceed7 8186 init_flist {}
c8dfbcf9
PM
8187}
8188
9843c307
PM
8189proc normalline {} {
8190 global thickerline
8191 if {[info exists thickerline]} {
c934a8a3 8192 set id $thickerline
9843c307 8193 unset thickerline
c934a8a3 8194 drawlines $id
9843c307
PM
8195 }
8196}
8197
354af6bd 8198proc selbyid {id {isnew 1}} {
7fcc92bf
PM
8199 global curview
8200 if {[commitinview $id $curview]} {
354af6bd 8201 selectline [rowofcommit $id] $isnew
c8dfbcf9
PM
8202 }
8203}
8204
8205proc mstime {} {
8206 global startmstime
8207 if {![info exists startmstime]} {
8208 set startmstime [clock clicks -milliseconds]
8209 }
8210 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8211}
8212
8213proc rowmenu {x y id} {
7fcc92bf 8214 global rowctxmenu selectedline rowmenuid curview
b9fdba7f 8215 global nullid nullid2 fakerowmenu mainhead markedid
c8dfbcf9 8216
bb3edc8b 8217 stopfinding
219ea3a9 8218 set rowmenuid $id
94b4a69f 8219 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
c8dfbcf9
PM
8220 set state disabled
8221 } else {
8222 set state normal
8223 }
8f489363 8224 if {$id ne $nullid && $id ne $nullid2} {
219ea3a9 8225 set menu $rowctxmenu
5e3502da 8226 if {$mainhead ne {}} {
da12e59d 8227 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
5e3502da
MB
8228 } else {
8229 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8230 }
b9fdba7f
PM
8231 if {[info exists markedid] && $markedid ne $id} {
8232 $menu entryconfigure 9 -state normal
8233 $menu entryconfigure 10 -state normal
010509f2 8234 $menu entryconfigure 11 -state normal
b9fdba7f
PM
8235 } else {
8236 $menu entryconfigure 9 -state disabled
8237 $menu entryconfigure 10 -state disabled
010509f2 8238 $menu entryconfigure 11 -state disabled
b9fdba7f 8239 }
219ea3a9
PM
8240 } else {
8241 set menu $fakerowmenu
8242 }
f2d0bbbd
PM
8243 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8244 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8245 $menu entryconfigure [mca "Make patch"] -state $state
219ea3a9 8246 tk_popup $menu $x $y
c8dfbcf9
PM
8247}
8248
b9fdba7f
PM
8249proc markhere {} {
8250 global rowmenuid markedid canv
8251
8252 set markedid $rowmenuid
8253 make_idmark $markedid
8254}
8255
8256proc gotomark {} {
8257 global markedid
8258
8259 if {[info exists markedid]} {
8260 selbyid $markedid
8261 }
8262}
8263
8264proc replace_by_kids {l r} {
8265 global curview children
8266
8267 set id [commitonrow $r]
8268 set l [lreplace $l 0 0]
8269 foreach kid $children($curview,$id) {
8270 lappend l [rowofcommit $kid]
8271 }
8272 return [lsort -integer -decreasing -unique $l]
8273}
8274
8275proc find_common_desc {} {
8276 global markedid rowmenuid curview children
8277
8278 if {![info exists markedid]} return
8279 if {![commitinview $markedid $curview] ||
8280 ![commitinview $rowmenuid $curview]} return
8281 #set t1 [clock clicks -milliseconds]
8282 set l1 [list [rowofcommit $markedid]]
8283 set l2 [list [rowofcommit $rowmenuid]]
8284 while 1 {
8285 set r1 [lindex $l1 0]
8286 set r2 [lindex $l2 0]
8287 if {$r1 eq {} || $r2 eq {}} break
8288 if {$r1 == $r2} {
8289 selectline $r1 1
8290 break
8291 }
8292 if {$r1 > $r2} {
8293 set l1 [replace_by_kids $l1 $r1]
8294 } else {
8295 set l2 [replace_by_kids $l2 $r2]
8296 }
8297 }
8298 #set t2 [clock clicks -milliseconds]
8299 #puts "took [expr {$t2-$t1}]ms"
8300}
8301
010509f2
PM
8302proc compare_commits {} {
8303 global markedid rowmenuid curview children
8304
8305 if {![info exists markedid]} return
8306 if {![commitinview $markedid $curview]} return
8307 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8308 do_cmp_commits $markedid $rowmenuid
8309}
8310
8311proc getpatchid {id} {
8312 global patchids
8313
8314 if {![info exists patchids($id)]} {
6f63fc18
PM
8315 set cmd [diffcmd [list $id] {-p --root}]
8316 # trim off the initial "|"
8317 set cmd [lrange $cmd 1 end]
8318 if {[catch {
8319 set x [eval exec $cmd | git patch-id]
8320 set patchids($id) [lindex $x 0]
8321 }]} {
8322 set patchids($id) "error"
8323 }
010509f2
PM
8324 }
8325 return $patchids($id)
8326}
8327
8328proc do_cmp_commits {a b} {
8329 global ctext curview parents children patchids commitinfo
8330
8331 $ctext conf -state normal
8332 clear_ctext
8333 init_flist {}
8334 for {set i 0} {$i < 100} {incr i} {
010509f2
PM
8335 set skipa 0
8336 set skipb 0
8337 if {[llength $parents($curview,$a)] > 1} {
6f63fc18 8338 appendshortlink $a [mc "Skipping merge commit "] "\n"
010509f2
PM
8339 set skipa 1
8340 } else {
8341 set patcha [getpatchid $a]
8342 }
8343 if {[llength $parents($curview,$b)] > 1} {
6f63fc18 8344 appendshortlink $b [mc "Skipping merge commit "] "\n"
010509f2
PM
8345 set skipb 1
8346 } else {
8347 set patchb [getpatchid $b]
8348 }
8349 if {!$skipa && !$skipb} {
8350 set heada [lindex $commitinfo($a) 0]
8351 set headb [lindex $commitinfo($b) 0]
6f63fc18
PM
8352 if {$patcha eq "error"} {
8353 appendshortlink $a [mc "Error getting patch ID for "] \
8354 [mc " - stopping\n"]
8355 break
8356 }
8357 if {$patchb eq "error"} {
8358 appendshortlink $b [mc "Error getting patch ID for "] \
8359 [mc " - stopping\n"]
8360 break
8361 }
010509f2
PM
8362 if {$patcha eq $patchb} {
8363 if {$heada eq $headb} {
6f63fc18
PM
8364 appendshortlink $a [mc "Commit "]
8365 appendshortlink $b " == " " $heada\n"
010509f2 8366 } else {
6f63fc18
PM
8367 appendshortlink $a [mc "Commit "] " $heada\n"
8368 appendshortlink $b [mc " is the same patch as\n "] \
8369 " $headb\n"
010509f2
PM
8370 }
8371 set skipa 1
8372 set skipb 1
8373 } else {
8374 $ctext insert end "\n"
6f63fc18
PM
8375 appendshortlink $a [mc "Commit "] " $heada\n"
8376 appendshortlink $b [mc " differs from\n "] \
8377 " $headb\n"
8378 $ctext insert end [mc "- stopping\n"]
010509f2
PM
8379 break
8380 }
8381 }
8382 if {$skipa} {
8383 if {[llength $children($curview,$a)] != 1} {
8384 $ctext insert end "\n"
6f63fc18
PM
8385 appendshortlink $a [mc "Commit "] \
8386 [mc " has %s children - stopping\n" \
8387 [llength $children($curview,$a)]]
010509f2
PM
8388 break
8389 }
8390 set a [lindex $children($curview,$a) 0]
8391 }
8392 if {$skipb} {
8393 if {[llength $children($curview,$b)] != 1} {
6f63fc18
PM
8394 appendshortlink $b [mc "Commit "] \
8395 [mc " has %s children - stopping\n" \
8396 [llength $children($curview,$b)]]
010509f2
PM
8397 break
8398 }
8399 set b [lindex $children($curview,$b) 0]
8400 }
8401 }
8402 $ctext conf -state disabled
8403}
8404
c8dfbcf9 8405proc diffvssel {dirn} {
7fcc92bf 8406 global rowmenuid selectedline
c8dfbcf9 8407
94b4a69f 8408 if {$selectedline eq {}} return
c8dfbcf9 8409 if {$dirn} {
7fcc92bf 8410 set oldid [commitonrow $selectedline]
c8dfbcf9
PM
8411 set newid $rowmenuid
8412 } else {
8413 set oldid $rowmenuid
7fcc92bf 8414 set newid [commitonrow $selectedline]
c8dfbcf9 8415 }
354af6bd 8416 addtohistory [list doseldiff $oldid $newid] savectextpos
fa4da7b3
PM
8417 doseldiff $oldid $newid
8418}
8419
8420proc doseldiff {oldid newid} {
7fcceed7 8421 global ctext
fa4da7b3
PM
8422 global commitinfo
8423
c8dfbcf9 8424 $ctext conf -state normal
3ea06f9f 8425 clear_ctext
d990cedf
CS
8426 init_flist [mc "Top"]
8427 $ctext insert end "[mc "From"] "
97645683
PM
8428 $ctext insert end $oldid link0
8429 setlink $oldid link0
fa4da7b3 8430 $ctext insert end "\n "
c8dfbcf9 8431 $ctext insert end [lindex $commitinfo($oldid) 0]
d990cedf 8432 $ctext insert end "\n\n[mc "To"] "
97645683
PM
8433 $ctext insert end $newid link1
8434 setlink $newid link1
fa4da7b3 8435 $ctext insert end "\n "
c8dfbcf9
PM
8436 $ctext insert end [lindex $commitinfo($newid) 0]
8437 $ctext insert end "\n"
8438 $ctext conf -state disabled
c8dfbcf9 8439 $ctext tag remove found 1.0 end
d327244a 8440 startdiff [list $oldid $newid]
c8dfbcf9
PM
8441}
8442
74daedb6 8443proc mkpatch {} {
d93f1713 8444 global rowmenuid currentid commitinfo patchtop patchnum NS
74daedb6
PM
8445
8446 if {![info exists currentid]} return
8447 set oldid $currentid
8448 set oldhead [lindex $commitinfo($oldid) 0]
8449 set newid $rowmenuid
8450 set newhead [lindex $commitinfo($newid) 0]
8451 set top .patch
8452 set patchtop $top
8453 catch {destroy $top}
d93f1713 8454 ttk_toplevel $top
e7d64008 8455 make_transient $top .
d93f1713 8456 ${NS}::label $top.title -text [mc "Generate patch"]
4a2139f5 8457 grid $top.title - -pady 10
d93f1713
PT
8458 ${NS}::label $top.from -text [mc "From:"]
8459 ${NS}::entry $top.fromsha1 -width 40
74daedb6
PM
8460 $top.fromsha1 insert 0 $oldid
8461 $top.fromsha1 conf -state readonly
8462 grid $top.from $top.fromsha1 -sticky w
d93f1713 8463 ${NS}::entry $top.fromhead -width 60
74daedb6
PM
8464 $top.fromhead insert 0 $oldhead
8465 $top.fromhead conf -state readonly
8466 grid x $top.fromhead -sticky w
d93f1713
PT
8467 ${NS}::label $top.to -text [mc "To:"]
8468 ${NS}::entry $top.tosha1 -width 40
74daedb6
PM
8469 $top.tosha1 insert 0 $newid
8470 $top.tosha1 conf -state readonly
8471 grid $top.to $top.tosha1 -sticky w
d93f1713 8472 ${NS}::entry $top.tohead -width 60
74daedb6
PM
8473 $top.tohead insert 0 $newhead
8474 $top.tohead conf -state readonly
8475 grid x $top.tohead -sticky w
d93f1713
PT
8476 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8477 grid $top.rev x -pady 10 -padx 5
8478 ${NS}::label $top.flab -text [mc "Output file:"]
8479 ${NS}::entry $top.fname -width 60
74daedb6
PM
8480 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8481 incr patchnum
bdbfbe3d 8482 grid $top.flab $top.fname -sticky w
d93f1713
PT
8483 ${NS}::frame $top.buts
8484 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8485 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
76f15947
AG
8486 bind $top <Key-Return> mkpatchgo
8487 bind $top <Key-Escape> mkpatchcan
74daedb6
PM
8488 grid $top.buts.gen $top.buts.can
8489 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8490 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8491 grid $top.buts - -pady 10 -sticky ew
bdbfbe3d 8492 focus $top.fname
74daedb6
PM
8493}
8494
8495proc mkpatchrev {} {
8496 global patchtop
8497
8498 set oldid [$patchtop.fromsha1 get]
8499 set oldhead [$patchtop.fromhead get]
8500 set newid [$patchtop.tosha1 get]
8501 set newhead [$patchtop.tohead get]
8502 foreach e [list fromsha1 fromhead tosha1 tohead] \
8503 v [list $newid $newhead $oldid $oldhead] {
8504 $patchtop.$e conf -state normal
8505 $patchtop.$e delete 0 end
8506 $patchtop.$e insert 0 $v
8507 $patchtop.$e conf -state readonly
8508 }
8509}
8510
8511proc mkpatchgo {} {
8f489363 8512 global patchtop nullid nullid2
74daedb6
PM
8513
8514 set oldid [$patchtop.fromsha1 get]
8515 set newid [$patchtop.tosha1 get]
8516 set fname [$patchtop.fname get]
8f489363 8517 set cmd [diffcmd [list $oldid $newid] -p]
d372e216
PM
8518 # trim off the initial "|"
8519 set cmd [lrange $cmd 1 end]
219ea3a9
PM
8520 lappend cmd >$fname &
8521 if {[catch {eval exec $cmd} err]} {
84a76f18 8522 error_popup "[mc "Error creating patch:"] $err" $patchtop
74daedb6
PM
8523 }
8524 catch {destroy $patchtop}
8525 unset patchtop
8526}
8527
8528proc mkpatchcan {} {
8529 global patchtop
8530
8531 catch {destroy $patchtop}
8532 unset patchtop
8533}
8534
bdbfbe3d 8535proc mktag {} {
d93f1713 8536 global rowmenuid mktagtop commitinfo NS
bdbfbe3d
PM
8537
8538 set top .maketag
8539 set mktagtop $top
8540 catch {destroy $top}
d93f1713 8541 ttk_toplevel $top
e7d64008 8542 make_transient $top .
d93f1713 8543 ${NS}::label $top.title -text [mc "Create tag"]
4a2139f5 8544 grid $top.title - -pady 10
d93f1713
PT
8545 ${NS}::label $top.id -text [mc "ID:"]
8546 ${NS}::entry $top.sha1 -width 40
bdbfbe3d
PM
8547 $top.sha1 insert 0 $rowmenuid
8548 $top.sha1 conf -state readonly
8549 grid $top.id $top.sha1 -sticky w
d93f1713 8550 ${NS}::entry $top.head -width 60
bdbfbe3d
PM
8551 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8552 $top.head conf -state readonly
8553 grid x $top.head -sticky w
d93f1713
PT
8554 ${NS}::label $top.tlab -text [mc "Tag name:"]
8555 ${NS}::entry $top.tag -width 60
bdbfbe3d 8556 grid $top.tlab $top.tag -sticky w
d93f1713
PT
8557 ${NS}::frame $top.buts
8558 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8559 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
76f15947
AG
8560 bind $top <Key-Return> mktaggo
8561 bind $top <Key-Escape> mktagcan
bdbfbe3d
PM
8562 grid $top.buts.gen $top.buts.can
8563 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8564 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8565 grid $top.buts - -pady 10 -sticky ew
8566 focus $top.tag
8567}
8568
8569proc domktag {} {
8570 global mktagtop env tagids idtags
bdbfbe3d
PM
8571
8572 set id [$mktagtop.sha1 get]
8573 set tag [$mktagtop.tag get]
8574 if {$tag == {}} {
84a76f18
AG
8575 error_popup [mc "No tag name specified"] $mktagtop
8576 return 0
bdbfbe3d
PM
8577 }
8578 if {[info exists tagids($tag)]} {
84a76f18
AG
8579 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8580 return 0
bdbfbe3d
PM
8581 }
8582 if {[catch {
48750d6a 8583 exec git tag $tag $id
bdbfbe3d 8584 } err]} {
84a76f18
AG
8585 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8586 return 0
bdbfbe3d
PM
8587 }
8588
8589 set tagids($tag) $id
8590 lappend idtags($id) $tag
f1d83ba3 8591 redrawtags $id
ceadfe90 8592 addedtag $id
887c996e
PM
8593 dispneartags 0
8594 run refill_reflist
84a76f18 8595 return 1
f1d83ba3
PM
8596}
8597
8598proc redrawtags {id} {
b9fdba7f 8599 global canv linehtag idpos currentid curview cmitlisted markedid
c11ff120 8600 global canvxmax iddrawn circleitem mainheadid circlecolors
f1d83ba3 8601
7fcc92bf 8602 if {![commitinview $id $curview]} return
322a8cc9 8603 if {![info exists iddrawn($id)]} return
fc2a256f 8604 set row [rowofcommit $id]
c11ff120
PM
8605 if {$id eq $mainheadid} {
8606 set ofill yellow
8607 } else {
8608 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8609 }
8610 $canv itemconf $circleitem($row) -fill $ofill
bdbfbe3d
PM
8611 $canv delete tag.$id
8612 set xt [eval drawtags $id $idpos($id)]
28593d3f
PM
8613 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8614 set text [$canv itemcget $linehtag($id) -text]
8615 set font [$canv itemcget $linehtag($id) -font]
fc2a256f 8616 set xr [expr {$xt + [font measure $font $text]}]
b8ab2e17
PM
8617 if {$xr > $canvxmax} {
8618 set canvxmax $xr
8619 setcanvscroll
8620 }
fc2a256f 8621 if {[info exists currentid] && $currentid == $id} {
28593d3f 8622 make_secsel $id
bdbfbe3d 8623 }
b9fdba7f
PM
8624 if {[info exists markedid] && $markedid eq $id} {
8625 make_idmark $id
8626 }
bdbfbe3d
PM
8627}
8628
8629proc mktagcan {} {
8630 global mktagtop
8631
8632 catch {destroy $mktagtop}
8633 unset mktagtop
8634}
8635
8636proc mktaggo {} {
84a76f18 8637 if {![domktag]} return
bdbfbe3d
PM
8638 mktagcan
8639}
8640
4a2139f5 8641proc writecommit {} {
d93f1713 8642 global rowmenuid wrcomtop commitinfo wrcomcmd NS
4a2139f5
PM
8643
8644 set top .writecommit
8645 set wrcomtop $top
8646 catch {destroy $top}
d93f1713 8647 ttk_toplevel $top
e7d64008 8648 make_transient $top .
d93f1713 8649 ${NS}::label $top.title -text [mc "Write commit to file"]
4a2139f5 8650 grid $top.title - -pady 10
d93f1713
PT
8651 ${NS}::label $top.id -text [mc "ID:"]
8652 ${NS}::entry $top.sha1 -width 40
4a2139f5
PM
8653 $top.sha1 insert 0 $rowmenuid
8654 $top.sha1 conf -state readonly
8655 grid $top.id $top.sha1 -sticky w
d93f1713 8656 ${NS}::entry $top.head -width 60
4a2139f5
PM
8657 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8658 $top.head conf -state readonly
8659 grid x $top.head -sticky w
d93f1713
PT
8660 ${NS}::label $top.clab -text [mc "Command:"]
8661 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
4a2139f5 8662 grid $top.clab $top.cmd -sticky w -pady 10
d93f1713
PT
8663 ${NS}::label $top.flab -text [mc "Output file:"]
8664 ${NS}::entry $top.fname -width 60
4a2139f5
PM
8665 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8666 grid $top.flab $top.fname -sticky w
d93f1713
PT
8667 ${NS}::frame $top.buts
8668 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8669 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
76f15947
AG
8670 bind $top <Key-Return> wrcomgo
8671 bind $top <Key-Escape> wrcomcan
4a2139f5
PM
8672 grid $top.buts.gen $top.buts.can
8673 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8674 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8675 grid $top.buts - -pady 10 -sticky ew
8676 focus $top.fname
8677}
8678
8679proc wrcomgo {} {
8680 global wrcomtop
8681
8682 set id [$wrcomtop.sha1 get]
8683 set cmd "echo $id | [$wrcomtop.cmd get]"
8684 set fname [$wrcomtop.fname get]
8685 if {[catch {exec sh -c $cmd >$fname &} err]} {
84a76f18 8686 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
4a2139f5
PM
8687 }
8688 catch {destroy $wrcomtop}
8689 unset wrcomtop
8690}
8691
8692proc wrcomcan {} {
8693 global wrcomtop
8694
8695 catch {destroy $wrcomtop}
8696 unset wrcomtop
8697}
8698
d6ac1a86 8699proc mkbranch {} {
d93f1713 8700 global rowmenuid mkbrtop NS
d6ac1a86
PM
8701
8702 set top .makebranch
8703 catch {destroy $top}
d93f1713 8704 ttk_toplevel $top
e7d64008 8705 make_transient $top .
d93f1713 8706 ${NS}::label $top.title -text [mc "Create new branch"]
d6ac1a86 8707 grid $top.title - -pady 10
d93f1713
PT
8708 ${NS}::label $top.id -text [mc "ID:"]
8709 ${NS}::entry $top.sha1 -width 40
d6ac1a86
PM
8710 $top.sha1 insert 0 $rowmenuid
8711 $top.sha1 conf -state readonly
8712 grid $top.id $top.sha1 -sticky w
d93f1713
PT
8713 ${NS}::label $top.nlab -text [mc "Name:"]
8714 ${NS}::entry $top.name -width 40
d6ac1a86 8715 grid $top.nlab $top.name -sticky w
d93f1713
PT
8716 ${NS}::frame $top.buts
8717 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8718 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
76f15947
AG
8719 bind $top <Key-Return> [list mkbrgo $top]
8720 bind $top <Key-Escape> "catch {destroy $top}"
d6ac1a86
PM
8721 grid $top.buts.go $top.buts.can
8722 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8723 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8724 grid $top.buts - -pady 10 -sticky ew
8725 focus $top.name
8726}
8727
8728proc mkbrgo {top} {
8729 global headids idheads
8730
8731 set name [$top.name get]
8732 set id [$top.sha1 get]
bee866fa
AG
8733 set cmdargs {}
8734 set old_id {}
d6ac1a86 8735 if {$name eq {}} {
84a76f18 8736 error_popup [mc "Please specify a name for the new branch"] $top
d6ac1a86
PM
8737 return
8738 }
bee866fa
AG
8739 if {[info exists headids($name)]} {
8740 if {![confirm_popup [mc \
84a76f18 8741 "Branch '%s' already exists. Overwrite?" $name] $top]} {
bee866fa
AG
8742 return
8743 }
8744 set old_id $headids($name)
8745 lappend cmdargs -f
8746 }
d6ac1a86 8747 catch {destroy $top}
bee866fa 8748 lappend cmdargs $name $id
d6ac1a86
PM
8749 nowbusy newbranch
8750 update
8751 if {[catch {
bee866fa 8752 eval exec git branch $cmdargs
d6ac1a86
PM
8753 } err]} {
8754 notbusy newbranch
8755 error_popup $err
8756 } else {
d6ac1a86 8757 notbusy newbranch
bee866fa
AG
8758 if {$old_id ne {}} {
8759 movehead $id $name
8760 movedhead $id $name
8761 redrawtags $old_id
8762 redrawtags $id
8763 } else {
8764 set headids($name) $id
8765 lappend idheads($id) $name
8766 addedhead $id $name
8767 redrawtags $id
8768 }
e11f1233 8769 dispneartags 0
887c996e 8770 run refill_reflist
d6ac1a86
PM
8771 }
8772}
8773
15e35055
AG
8774proc exec_citool {tool_args {baseid {}}} {
8775 global commitinfo env
8776
8777 set save_env [array get env GIT_AUTHOR_*]
8778
8779 if {$baseid ne {}} {
8780 if {![info exists commitinfo($baseid)]} {
8781 getcommit $baseid
8782 }
8783 set author [lindex $commitinfo($baseid) 1]
8784 set date [lindex $commitinfo($baseid) 2]
8785 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8786 $author author name email]
8787 && $date ne {}} {
8788 set env(GIT_AUTHOR_NAME) $name
8789 set env(GIT_AUTHOR_EMAIL) $email
8790 set env(GIT_AUTHOR_DATE) $date
8791 }
8792 }
8793
8794 eval exec git citool $tool_args &
8795
8796 array unset env GIT_AUTHOR_*
8797 array set env $save_env
8798}
8799
ca6d8f58 8800proc cherrypick {} {
468bcaed 8801 global rowmenuid curview
b8a938cf 8802 global mainhead mainheadid
ca6d8f58 8803
e11f1233
PM
8804 set oldhead [exec git rev-parse HEAD]
8805 set dheads [descheads $rowmenuid]
8806 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
d990cedf
CS
8807 set ok [confirm_popup [mc "Commit %s is already\
8808 included in branch %s -- really re-apply it?" \
8809 [string range $rowmenuid 0 7] $mainhead]]
ca6d8f58
PM
8810 if {!$ok} return
8811 }
d990cedf 8812 nowbusy cherrypick [mc "Cherry-picking"]
ca6d8f58 8813 update
ca6d8f58
PM
8814 # Unfortunately git-cherry-pick writes stuff to stderr even when
8815 # no error occurs, and exec takes that as an indication of error...
8816 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8817 notbusy cherrypick
15e35055 8818 if {[regexp -line \
887a791f
PM
8819 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8820 $err msg fname]} {
8821 error_popup [mc "Cherry-pick failed because of local changes\
8822 to file '%s'.\nPlease commit, reset or stash\
8823 your changes and try again." $fname]
8824 } elseif {[regexp -line \
8825 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8826 $err]} {
8827 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8828 conflict.\nDo you wish to run git citool to\
8829 resolve it?"]]} {
8830 # Force citool to read MERGE_MSG
8831 file delete [file join [gitdir] "GITGUI_MSG"]
8832 exec_citool {} $rowmenuid
8833 }
15e35055
AG
8834 } else {
8835 error_popup $err
8836 }
887a791f 8837 run updatecommits
ca6d8f58
PM
8838 return
8839 }
8840 set newhead [exec git rev-parse HEAD]
8841 if {$newhead eq $oldhead} {
8842 notbusy cherrypick
d990cedf 8843 error_popup [mc "No changes committed"]
ca6d8f58
PM
8844 return
8845 }
e11f1233 8846 addnewchild $newhead $oldhead
7fcc92bf 8847 if {[commitinview $oldhead $curview]} {
cdc8429c 8848 # XXX this isn't right if we have a path limit...
7fcc92bf 8849 insertrow $newhead $oldhead $curview
ca6d8f58 8850 if {$mainhead ne {}} {
e11f1233 8851 movehead $newhead $mainhead
ca6d8f58
PM
8852 movedhead $newhead $mainhead
8853 }
c11ff120 8854 set mainheadid $newhead
ca6d8f58
PM
8855 redrawtags $oldhead
8856 redrawtags $newhead
46308ea1 8857 selbyid $newhead
ca6d8f58
PM
8858 }
8859 notbusy cherrypick
8860}
8861
6fb735ae 8862proc resethead {} {
d93f1713 8863 global mainhead rowmenuid confirm_ok resettype NS
6fb735ae
PM
8864
8865 set confirm_ok 0
8866 set w ".confirmreset"
d93f1713 8867 ttk_toplevel $w
e7d64008 8868 make_transient $w .
d990cedf 8869 wm title $w [mc "Confirm reset"]
d93f1713
PT
8870 ${NS}::label $w.m -text \
8871 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
6fb735ae 8872 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 8873 ${NS}::labelframe $w.f -text [mc "Reset type:"]
6fb735ae 8874 set resettype mixed
d93f1713 8875 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
d990cedf 8876 -text [mc "Soft: Leave working tree and index untouched"]
6fb735ae 8877 grid $w.f.soft -sticky w
d93f1713 8878 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
d990cedf 8879 -text [mc "Mixed: Leave working tree untouched, reset index"]
6fb735ae 8880 grid $w.f.mixed -sticky w
d93f1713 8881 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
d990cedf 8882 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6fb735ae 8883 grid $w.f.hard -sticky w
d93f1713
PT
8884 pack $w.f -side top -fill x -padx 4
8885 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6fb735ae 8886 pack $w.ok -side left -fill x -padx 20 -pady 20
d93f1713 8887 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
76f15947 8888 bind $w <Key-Escape> [list destroy $w]
6fb735ae
PM
8889 pack $w.cancel -side right -fill x -padx 20 -pady 20
8890 bind $w <Visibility> "grab $w; focus $w"
8891 tkwait window $w
8892 if {!$confirm_ok} return
706d6c3e 8893 if {[catch {set fd [open \
08ba820f 8894 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
6fb735ae
PM
8895 error_popup $err
8896 } else {
706d6c3e 8897 dohidelocalchanges
a137a90f 8898 filerun $fd [list readresetstat $fd]
d990cedf 8899 nowbusy reset [mc "Resetting"]
46308ea1 8900 selbyid $rowmenuid
706d6c3e
PM
8901 }
8902}
8903
a137a90f
PM
8904proc readresetstat {fd} {
8905 global mainhead mainheadid showlocalchanges rprogcoord
706d6c3e
PM
8906
8907 if {[gets $fd line] >= 0} {
8908 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
a137a90f
PM
8909 set rprogcoord [expr {1.0 * $m / $n}]
8910 adjustprogress
706d6c3e
PM
8911 }
8912 return 1
8913 }
a137a90f
PM
8914 set rprogcoord 0
8915 adjustprogress
706d6c3e
PM
8916 notbusy reset
8917 if {[catch {close $fd} err]} {
8918 error_popup $err
8919 }
8920 set oldhead $mainheadid
8921 set newhead [exec git rev-parse HEAD]
8922 if {$newhead ne $oldhead} {
8923 movehead $newhead $mainhead
8924 movedhead $newhead $mainhead
8925 set mainheadid $newhead
6fb735ae 8926 redrawtags $oldhead
706d6c3e 8927 redrawtags $newhead
6fb735ae
PM
8928 }
8929 if {$showlocalchanges} {
8930 doshowlocalchanges
8931 }
706d6c3e 8932 return 0
6fb735ae
PM
8933}
8934
10299152
PM
8935# context menu for a head
8936proc headmenu {x y id head} {
00609463 8937 global headmenuid headmenuhead headctxmenu mainhead
10299152 8938
bb3edc8b 8939 stopfinding
10299152
PM
8940 set headmenuid $id
8941 set headmenuhead $head
00609463
PM
8942 set state normal
8943 if {$head eq $mainhead} {
8944 set state disabled
8945 }
8946 $headctxmenu entryconfigure 0 -state $state
8947 $headctxmenu entryconfigure 1 -state $state
10299152
PM
8948 tk_popup $headctxmenu $x $y
8949}
8950
8951proc cobranch {} {
c11ff120 8952 global headmenuid headmenuhead headids
cdc8429c 8953 global showlocalchanges
10299152
PM
8954
8955 # check the tree is clean first??
d990cedf 8956 nowbusy checkout [mc "Checking out"]
10299152 8957 update
219ea3a9 8958 dohidelocalchanges
10299152 8959 if {[catch {
08ba820f 8960 set fd [open [list | git checkout $headmenuhead 2>@1] r]
10299152
PM
8961 } err]} {
8962 notbusy checkout
8963 error_popup $err
08ba820f
PM
8964 if {$showlocalchanges} {
8965 dodiffindex
8966 }
10299152 8967 } else {
08ba820f
PM
8968 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8969 }
8970}
8971
8972proc readcheckoutstat {fd newhead newheadid} {
8973 global mainhead mainheadid headids showlocalchanges progresscoords
cdc8429c 8974 global viewmainheadid curview
08ba820f
PM
8975
8976 if {[gets $fd line] >= 0} {
8977 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8978 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8979 adjustprogress
10299152 8980 }
08ba820f
PM
8981 return 1
8982 }
8983 set progresscoords {0 0}
8984 adjustprogress
8985 notbusy checkout
8986 if {[catch {close $fd} err]} {
8987 error_popup $err
8988 }
c11ff120 8989 set oldmainid $mainheadid
08ba820f
PM
8990 set mainhead $newhead
8991 set mainheadid $newheadid
cdc8429c 8992 set viewmainheadid($curview) $newheadid
c11ff120 8993 redrawtags $oldmainid
08ba820f
PM
8994 redrawtags $newheadid
8995 selbyid $newheadid
6fb735ae
PM
8996 if {$showlocalchanges} {
8997 dodiffindex
10299152
PM
8998 }
8999}
9000
9001proc rmbranch {} {
e11f1233 9002 global headmenuid headmenuhead mainhead
b1054ac9 9003 global idheads
10299152
PM
9004
9005 set head $headmenuhead
9006 set id $headmenuid
00609463 9007 # this check shouldn't be needed any more...
10299152 9008 if {$head eq $mainhead} {
d990cedf 9009 error_popup [mc "Cannot delete the currently checked-out branch"]
10299152
PM
9010 return
9011 }
e11f1233 9012 set dheads [descheads $id]
d7b16113 9013 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
10299152 9014 # the stuff on this branch isn't on any other branch
d990cedf
CS
9015 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9016 branch.\nReally delete branch %s?" $head $head]]} return
10299152
PM
9017 }
9018 nowbusy rmbranch
9019 update
9020 if {[catch {exec git branch -D $head} err]} {
9021 notbusy rmbranch
9022 error_popup $err
9023 return
9024 }
e11f1233 9025 removehead $id $head
ca6d8f58 9026 removedhead $id $head
10299152
PM
9027 redrawtags $id
9028 notbusy rmbranch
e11f1233 9029 dispneartags 0
887c996e
PM
9030 run refill_reflist
9031}
9032
9033# Display a list of tags and heads
9034proc showrefs {} {
d93f1713 9035 global showrefstop bgcolor fgcolor selectbgcolor NS
9c311b32 9036 global bglist fglist reflistfilter reflist maincursor
887c996e
PM
9037
9038 set top .showrefs
9039 set showrefstop $top
9040 if {[winfo exists $top]} {
9041 raise $top
9042 refill_reflist
9043 return
9044 }
d93f1713 9045 ttk_toplevel $top
d990cedf 9046 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
e7d64008 9047 make_transient $top .
887c996e 9048 text $top.list -background $bgcolor -foreground $fgcolor \
9c311b32 9049 -selectbackground $selectbgcolor -font mainfont \
887c996e
PM
9050 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9051 -width 30 -height 20 -cursor $maincursor \
9052 -spacing1 1 -spacing3 1 -state disabled
9053 $top.list tag configure highlight -background $selectbgcolor
9054 lappend bglist $top.list
9055 lappend fglist $top.list
d93f1713
PT
9056 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9057 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
887c996e
PM
9058 grid $top.list $top.ysb -sticky nsew
9059 grid $top.xsb x -sticky ew
d93f1713
PT
9060 ${NS}::frame $top.f
9061 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9062 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
887c996e
PM
9063 set reflistfilter "*"
9064 trace add variable reflistfilter write reflistfilter_change
9065 pack $top.f.e -side right -fill x -expand 1
9066 pack $top.f.l -side left
9067 grid $top.f - -sticky ew -pady 2
d93f1713 9068 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
76f15947 9069 bind $top <Key-Escape> [list destroy $top]
887c996e
PM
9070 grid $top.close -
9071 grid columnconfigure $top 0 -weight 1
9072 grid rowconfigure $top 0 -weight 1
9073 bind $top.list <1> {break}
9074 bind $top.list <B1-Motion> {break}
9075 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9076 set reflist {}
9077 refill_reflist
9078}
9079
9080proc sel_reflist {w x y} {
9081 global showrefstop reflist headids tagids otherrefids
9082
9083 if {![winfo exists $showrefstop]} return
9084 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9085 set ref [lindex $reflist [expr {$l-1}]]
9086 set n [lindex $ref 0]
9087 switch -- [lindex $ref 1] {
9088 "H" {selbyid $headids($n)}
9089 "T" {selbyid $tagids($n)}
9090 "o" {selbyid $otherrefids($n)}
9091 }
9092 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9093}
9094
9095proc unsel_reflist {} {
9096 global showrefstop
9097
9098 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9099 $showrefstop.list tag remove highlight 0.0 end
9100}
9101
9102proc reflistfilter_change {n1 n2 op} {
9103 global reflistfilter
9104
9105 after cancel refill_reflist
9106 after 200 refill_reflist
9107}
9108
9109proc refill_reflist {} {
9110 global reflist reflistfilter showrefstop headids tagids otherrefids
d375ef9b 9111 global curview
887c996e
PM
9112
9113 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9114 set refs {}
9115 foreach n [array names headids] {
9116 if {[string match $reflistfilter $n]} {
7fcc92bf 9117 if {[commitinview $headids($n) $curview]} {
887c996e
PM
9118 lappend refs [list $n H]
9119 } else {
d375ef9b 9120 interestedin $headids($n) {run refill_reflist}
887c996e
PM
9121 }
9122 }
9123 }
9124 foreach n [array names tagids] {
9125 if {[string match $reflistfilter $n]} {
7fcc92bf 9126 if {[commitinview $tagids($n) $curview]} {
887c996e
PM
9127 lappend refs [list $n T]
9128 } else {
d375ef9b 9129 interestedin $tagids($n) {run refill_reflist}
887c996e
PM
9130 }
9131 }
9132 }
9133 foreach n [array names otherrefids] {
9134 if {[string match $reflistfilter $n]} {
7fcc92bf 9135 if {[commitinview $otherrefids($n) $curview]} {
887c996e
PM
9136 lappend refs [list $n o]
9137 } else {
d375ef9b 9138 interestedin $otherrefids($n) {run refill_reflist}
887c996e
PM
9139 }
9140 }
9141 }
9142 set refs [lsort -index 0 $refs]
9143 if {$refs eq $reflist} return
9144
9145 # Update the contents of $showrefstop.list according to the
9146 # differences between $reflist (old) and $refs (new)
9147 $showrefstop.list conf -state normal
9148 $showrefstop.list insert end "\n"
9149 set i 0
9150 set j 0
9151 while {$i < [llength $reflist] || $j < [llength $refs]} {
9152 if {$i < [llength $reflist]} {
9153 if {$j < [llength $refs]} {
9154 set cmp [string compare [lindex $reflist $i 0] \
9155 [lindex $refs $j 0]]
9156 if {$cmp == 0} {
9157 set cmp [string compare [lindex $reflist $i 1] \
9158 [lindex $refs $j 1]]
9159 }
9160 } else {
9161 set cmp -1
9162 }
9163 } else {
9164 set cmp 1
9165 }
9166 switch -- $cmp {
9167 -1 {
9168 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9169 incr i
9170 }
9171 0 {
9172 incr i
9173 incr j
9174 }
9175 1 {
9176 set l [expr {$j + 1}]
9177 $showrefstop.list image create $l.0 -align baseline \
9178 -image reficon-[lindex $refs $j 1] -padx 2
9179 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9180 incr j
9181 }
9182 }
9183 }
9184 set reflist $refs
9185 # delete last newline
9186 $showrefstop.list delete end-2c end-1c
9187 $showrefstop.list conf -state disabled
10299152
PM
9188}
9189
b8ab2e17
PM
9190# Stuff for finding nearby tags
9191proc getallcommits {} {
5cd15b6b
PM
9192 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9193 global idheads idtags idotherrefs allparents tagobjid
f1d83ba3 9194
a69b2d1a 9195 if {![info exists allcommits]} {
a69b2d1a
PM
9196 set nextarc 0
9197 set allcommits 0
9198 set seeds {}
5cd15b6b
PM
9199 set allcwait 0
9200 set cachedarcs 0
9201 set allccache [file join [gitdir] "gitk.cache"]
9202 if {![catch {
9203 set f [open $allccache r]
9204 set allcwait 1
9205 getcache $f
9206 }]} return
a69b2d1a 9207 }
2d71bccc 9208
5cd15b6b
PM
9209 if {$allcwait} {
9210 return
9211 }
9212 set cmd [list | git rev-list --parents]
9213 set allcupdate [expr {$seeds ne {}}]
9214 if {!$allcupdate} {
9215 set ids "--all"
9216 } else {
9217 set refs [concat [array names idheads] [array names idtags] \
9218 [array names idotherrefs]]
9219 set ids {}
9220 set tagobjs {}
9221 foreach name [array names tagobjid] {
9222 lappend tagobjs $tagobjid($name)
9223 }
9224 foreach id [lsort -unique $refs] {
9225 if {![info exists allparents($id)] &&
9226 [lsearch -exact $tagobjs $id] < 0} {
9227 lappend ids $id
9228 }
9229 }
9230 if {$ids ne {}} {
9231 foreach id $seeds {
9232 lappend ids "^$id"
9233 }
9234 }
9235 }
9236 if {$ids ne {}} {
9237 set fd [open [concat $cmd $ids] r]
9238 fconfigure $fd -blocking 0
9239 incr allcommits
9240 nowbusy allcommits
9241 filerun $fd [list getallclines $fd]
9242 } else {
9243 dispneartags 0
2d71bccc 9244 }
e11f1233
PM
9245}
9246
9247# Since most commits have 1 parent and 1 child, we group strings of
9248# such commits into "arcs" joining branch/merge points (BMPs), which
9249# are commits that either don't have 1 parent or don't have 1 child.
9250#
9251# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9252# arcout(id) - outgoing arcs for BMP
9253# arcids(a) - list of IDs on arc including end but not start
9254# arcstart(a) - BMP ID at start of arc
9255# arcend(a) - BMP ID at end of arc
9256# growing(a) - arc a is still growing
9257# arctags(a) - IDs out of arcids (excluding end) that have tags
9258# archeads(a) - IDs out of arcids (excluding end) that have heads
9259# The start of an arc is at the descendent end, so "incoming" means
9260# coming from descendents, and "outgoing" means going towards ancestors.
9261
9262proc getallclines {fd} {
5cd15b6b 9263 global allparents allchildren idtags idheads nextarc
e11f1233 9264 global arcnos arcids arctags arcout arcend arcstart archeads growing
5cd15b6b 9265 global seeds allcommits cachedarcs allcupdate
d93f1713 9266
e11f1233 9267 set nid 0
7eb3cb9c 9268 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
e11f1233
PM
9269 set id [lindex $line 0]
9270 if {[info exists allparents($id)]} {
9271 # seen it already
9272 continue
9273 }
5cd15b6b 9274 set cachedarcs 0
e11f1233
PM
9275 set olds [lrange $line 1 end]
9276 set allparents($id) $olds
9277 if {![info exists allchildren($id)]} {
9278 set allchildren($id) {}
9279 set arcnos($id) {}
9280 lappend seeds $id
9281 } else {
9282 set a $arcnos($id)
9283 if {[llength $olds] == 1 && [llength $a] == 1} {
9284 lappend arcids($a) $id
9285 if {[info exists idtags($id)]} {
9286 lappend arctags($a) $id
b8ab2e17 9287 }
e11f1233
PM
9288 if {[info exists idheads($id)]} {
9289 lappend archeads($a) $id
9290 }
9291 if {[info exists allparents($olds)]} {
9292 # seen parent already
9293 if {![info exists arcout($olds)]} {
9294 splitarc $olds
9295 }
9296 lappend arcids($a) $olds
9297 set arcend($a) $olds
9298 unset growing($a)
9299 }
9300 lappend allchildren($olds) $id
9301 lappend arcnos($olds) $a
9302 continue
9303 }
9304 }
e11f1233
PM
9305 foreach a $arcnos($id) {
9306 lappend arcids($a) $id
9307 set arcend($a) $id
9308 unset growing($a)
9309 }
9310
9311 set ao {}
9312 foreach p $olds {
9313 lappend allchildren($p) $id
9314 set a [incr nextarc]
9315 set arcstart($a) $id
9316 set archeads($a) {}
9317 set arctags($a) {}
9318 set archeads($a) {}
9319 set arcids($a) {}
9320 lappend ao $a
9321 set growing($a) 1
9322 if {[info exists allparents($p)]} {
9323 # seen it already, may need to make a new branch
9324 if {![info exists arcout($p)]} {
9325 splitarc $p
9326 }
9327 lappend arcids($a) $p
9328 set arcend($a) $p
9329 unset growing($a)
9330 }
9331 lappend arcnos($p) $a
9332 }
9333 set arcout($id) $ao
f1d83ba3 9334 }
f3326b66
PM
9335 if {$nid > 0} {
9336 global cached_dheads cached_dtags cached_atags
9337 catch {unset cached_dheads}
9338 catch {unset cached_dtags}
9339 catch {unset cached_atags}
9340 }
7eb3cb9c
PM
9341 if {![eof $fd]} {
9342 return [expr {$nid >= 1000? 2: 1}]
9343 }
5cd15b6b
PM
9344 set cacheok 1
9345 if {[catch {
9346 fconfigure $fd -blocking 1
9347 close $fd
9348 } err]} {
9349 # got an error reading the list of commits
9350 # if we were updating, try rereading the whole thing again
9351 if {$allcupdate} {
9352 incr allcommits -1
9353 dropcache $err
9354 return
9355 }
d990cedf 9356 error_popup "[mc "Error reading commit topology information;\
5cd15b6b 9357 branch and preceding/following tag information\
d990cedf 9358 will be incomplete."]\n($err)"
5cd15b6b
PM
9359 set cacheok 0
9360 }
e11f1233
PM
9361 if {[incr allcommits -1] == 0} {
9362 notbusy allcommits
5cd15b6b
PM
9363 if {$cacheok} {
9364 run savecache
9365 }
e11f1233
PM
9366 }
9367 dispneartags 0
7eb3cb9c 9368 return 0
b8ab2e17
PM
9369}
9370
e11f1233
PM
9371proc recalcarc {a} {
9372 global arctags archeads arcids idtags idheads
b8ab2e17 9373
e11f1233
PM
9374 set at {}
9375 set ah {}
9376 foreach id [lrange $arcids($a) 0 end-1] {
9377 if {[info exists idtags($id)]} {
9378 lappend at $id
9379 }
9380 if {[info exists idheads($id)]} {
9381 lappend ah $id
b8ab2e17 9382 }
f1d83ba3 9383 }
e11f1233
PM
9384 set arctags($a) $at
9385 set archeads($a) $ah
b8ab2e17
PM
9386}
9387
e11f1233 9388proc splitarc {p} {
5cd15b6b 9389 global arcnos arcids nextarc arctags archeads idtags idheads
e11f1233 9390 global arcstart arcend arcout allparents growing
cec7bece 9391
e11f1233
PM
9392 set a $arcnos($p)
9393 if {[llength $a] != 1} {
9394 puts "oops splitarc called but [llength $a] arcs already"
9395 return
9396 }
9397 set a [lindex $a 0]
9398 set i [lsearch -exact $arcids($a) $p]
9399 if {$i < 0} {
9400 puts "oops splitarc $p not in arc $a"
9401 return
9402 }
9403 set na [incr nextarc]
9404 if {[info exists arcend($a)]} {
9405 set arcend($na) $arcend($a)
9406 } else {
9407 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9408 set j [lsearch -exact $arcnos($l) $a]
9409 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9410 }
9411 set tail [lrange $arcids($a) [expr {$i+1}] end]
9412 set arcids($a) [lrange $arcids($a) 0 $i]
9413 set arcend($a) $p
9414 set arcstart($na) $p
9415 set arcout($p) $na
9416 set arcids($na) $tail
9417 if {[info exists growing($a)]} {
9418 set growing($na) 1
9419 unset growing($a)
9420 }
e11f1233
PM
9421
9422 foreach id $tail {
9423 if {[llength $arcnos($id)] == 1} {
9424 set arcnos($id) $na
cec7bece 9425 } else {
e11f1233
PM
9426 set j [lsearch -exact $arcnos($id) $a]
9427 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
cec7bece 9428 }
e11f1233
PM
9429 }
9430
9431 # reconstruct tags and heads lists
9432 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9433 recalcarc $a
9434 recalcarc $na
9435 } else {
9436 set arctags($na) {}
9437 set archeads($na) {}
9438 }
9439}
9440
9441# Update things for a new commit added that is a child of one
9442# existing commit. Used when cherry-picking.
9443proc addnewchild {id p} {
5cd15b6b 9444 global allparents allchildren idtags nextarc
e11f1233 9445 global arcnos arcids arctags arcout arcend arcstart archeads growing
719c2b9d 9446 global seeds allcommits
e11f1233 9447
3ebba3c7 9448 if {![info exists allcommits] || ![info exists arcnos($p)]} return
e11f1233
PM
9449 set allparents($id) [list $p]
9450 set allchildren($id) {}
9451 set arcnos($id) {}
9452 lappend seeds $id
e11f1233
PM
9453 lappend allchildren($p) $id
9454 set a [incr nextarc]
9455 set arcstart($a) $id
9456 set archeads($a) {}
9457 set arctags($a) {}
9458 set arcids($a) [list $p]
9459 set arcend($a) $p
9460 if {![info exists arcout($p)]} {
9461 splitarc $p
9462 }
9463 lappend arcnos($p) $a
9464 set arcout($id) [list $a]
9465}
9466
5cd15b6b
PM
9467# This implements a cache for the topology information.
9468# The cache saves, for each arc, the start and end of the arc,
9469# the ids on the arc, and the outgoing arcs from the end.
9470proc readcache {f} {
9471 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9472 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9473 global allcwait
9474
9475 set a $nextarc
9476 set lim $cachedarcs
9477 if {$lim - $a > 500} {
9478 set lim [expr {$a + 500}]
9479 }
9480 if {[catch {
9481 if {$a == $lim} {
9482 # finish reading the cache and setting up arctags, etc.
9483 set line [gets $f]
9484 if {$line ne "1"} {error "bad final version"}
9485 close $f
9486 foreach id [array names idtags] {
9487 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9488 [llength $allparents($id)] == 1} {
9489 set a [lindex $arcnos($id) 0]
9490 if {$arctags($a) eq {}} {
9491 recalcarc $a
9492 }
9493 }
9494 }
9495 foreach id [array names idheads] {
9496 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9497 [llength $allparents($id)] == 1} {
9498 set a [lindex $arcnos($id) 0]
9499 if {$archeads($a) eq {}} {
9500 recalcarc $a
9501 }
9502 }
9503 }
9504 foreach id [lsort -unique $possible_seeds] {
9505 if {$arcnos($id) eq {}} {
9506 lappend seeds $id
9507 }
9508 }
9509 set allcwait 0
9510 } else {
9511 while {[incr a] <= $lim} {
9512 set line [gets $f]
9513 if {[llength $line] != 3} {error "bad line"}
9514 set s [lindex $line 0]
9515 set arcstart($a) $s
9516 lappend arcout($s) $a
9517 if {![info exists arcnos($s)]} {
9518 lappend possible_seeds $s
9519 set arcnos($s) {}
9520 }
9521 set e [lindex $line 1]
9522 if {$e eq {}} {
9523 set growing($a) 1
9524 } else {
9525 set arcend($a) $e
9526 if {![info exists arcout($e)]} {
9527 set arcout($e) {}
9528 }
9529 }
9530 set arcids($a) [lindex $line 2]
9531 foreach id $arcids($a) {
9532 lappend allparents($s) $id
9533 set s $id
9534 lappend arcnos($id) $a
9535 }
9536 if {![info exists allparents($s)]} {
9537 set allparents($s) {}
9538 }
9539 set arctags($a) {}
9540 set archeads($a) {}
9541 }
9542 set nextarc [expr {$a - 1}]
9543 }
9544 } err]} {
9545 dropcache $err
9546 return 0
9547 }
9548 if {!$allcwait} {
9549 getallcommits
9550 }
9551 return $allcwait
9552}
9553
9554proc getcache {f} {
9555 global nextarc cachedarcs possible_seeds
9556
9557 if {[catch {
9558 set line [gets $f]
9559 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9560 # make sure it's an integer
9561 set cachedarcs [expr {int([lindex $line 1])}]
9562 if {$cachedarcs < 0} {error "bad number of arcs"}
9563 set nextarc 0
9564 set possible_seeds {}
9565 run readcache $f
9566 } err]} {
9567 dropcache $err
9568 }
9569 return 0
9570}
9571
9572proc dropcache {err} {
9573 global allcwait nextarc cachedarcs seeds
9574
9575 #puts "dropping cache ($err)"
9576 foreach v {arcnos arcout arcids arcstart arcend growing \
9577 arctags archeads allparents allchildren} {
9578 global $v
9579 catch {unset $v}
9580 }
9581 set allcwait 0
9582 set nextarc 0
9583 set cachedarcs 0
9584 set seeds {}
9585 getallcommits
9586}
9587
9588proc writecache {f} {
9589 global cachearc cachedarcs allccache
9590 global arcstart arcend arcnos arcids arcout
9591
9592 set a $cachearc
9593 set lim $cachedarcs
9594 if {$lim - $a > 1000} {
9595 set lim [expr {$a + 1000}]
9596 }
9597 if {[catch {
9598 while {[incr a] <= $lim} {
9599 if {[info exists arcend($a)]} {
9600 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9601 } else {
9602 puts $f [list $arcstart($a) {} $arcids($a)]
9603 }
9604 }
9605 } err]} {
9606 catch {close $f}
9607 catch {file delete $allccache}
9608 #puts "writing cache failed ($err)"
9609 return 0
9610 }
9611 set cachearc [expr {$a - 1}]
9612 if {$a > $cachedarcs} {
9613 puts $f "1"
9614 close $f
9615 return 0
9616 }
9617 return 1
9618}
9619
9620proc savecache {} {
9621 global nextarc cachedarcs cachearc allccache
9622
9623 if {$nextarc == $cachedarcs} return
9624 set cachearc 0
9625 set cachedarcs $nextarc
9626 catch {
9627 set f [open $allccache w]
9628 puts $f [list 1 $cachedarcs]
9629 run writecache $f
9630 }
9631}
9632
e11f1233
PM
9633# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9634# or 0 if neither is true.
9635proc anc_or_desc {a b} {
9636 global arcout arcstart arcend arcnos cached_isanc
9637
9638 if {$arcnos($a) eq $arcnos($b)} {
9639 # Both are on the same arc(s); either both are the same BMP,
9640 # or if one is not a BMP, the other is also not a BMP or is
9641 # the BMP at end of the arc (and it only has 1 incoming arc).
69c0b5d2
PM
9642 # Or both can be BMPs with no incoming arcs.
9643 if {$a eq $b || $arcnos($a) eq {}} {
e11f1233 9644 return 0
cec7bece 9645 }
e11f1233
PM
9646 # assert {[llength $arcnos($a)] == 1}
9647 set arc [lindex $arcnos($a) 0]
9648 set i [lsearch -exact $arcids($arc) $a]
9649 set j [lsearch -exact $arcids($arc) $b]
9650 if {$i < 0 || $i > $j} {
9651 return 1
9652 } else {
9653 return -1
cec7bece
PM
9654 }
9655 }
e11f1233
PM
9656
9657 if {![info exists arcout($a)]} {
9658 set arc [lindex $arcnos($a) 0]
9659 if {[info exists arcend($arc)]} {
9660 set aend $arcend($arc)
9661 } else {
9662 set aend {}
cec7bece 9663 }
e11f1233
PM
9664 set a $arcstart($arc)
9665 } else {
9666 set aend $a
9667 }
9668 if {![info exists arcout($b)]} {
9669 set arc [lindex $arcnos($b) 0]
9670 if {[info exists arcend($arc)]} {
9671 set bend $arcend($arc)
9672 } else {
9673 set bend {}
cec7bece 9674 }
e11f1233
PM
9675 set b $arcstart($arc)
9676 } else {
9677 set bend $b
cec7bece 9678 }
e11f1233
PM
9679 if {$a eq $bend} {
9680 return 1
9681 }
9682 if {$b eq $aend} {
9683 return -1
9684 }
9685 if {[info exists cached_isanc($a,$bend)]} {
9686 if {$cached_isanc($a,$bend)} {
9687 return 1
9688 }
9689 }
9690 if {[info exists cached_isanc($b,$aend)]} {
9691 if {$cached_isanc($b,$aend)} {
9692 return -1
9693 }
9694 if {[info exists cached_isanc($a,$bend)]} {
9695 return 0
9696 }
cec7bece 9697 }
cec7bece 9698
e11f1233
PM
9699 set todo [list $a $b]
9700 set anc($a) a
9701 set anc($b) b
9702 for {set i 0} {$i < [llength $todo]} {incr i} {
9703 set x [lindex $todo $i]
9704 if {$anc($x) eq {}} {
9705 continue
9706 }
9707 foreach arc $arcnos($x) {
9708 set xd $arcstart($arc)
9709 if {$xd eq $bend} {
9710 set cached_isanc($a,$bend) 1
9711 set cached_isanc($b,$aend) 0
9712 return 1
9713 } elseif {$xd eq $aend} {
9714 set cached_isanc($b,$aend) 1
9715 set cached_isanc($a,$bend) 0
9716 return -1
9717 }
9718 if {![info exists anc($xd)]} {
9719 set anc($xd) $anc($x)
9720 lappend todo $xd
9721 } elseif {$anc($xd) ne $anc($x)} {
9722 set anc($xd) {}
9723 }
9724 }
9725 }
9726 set cached_isanc($a,$bend) 0
9727 set cached_isanc($b,$aend) 0
9728 return 0
9729}
b8ab2e17 9730
e11f1233
PM
9731# This identifies whether $desc has an ancestor that is
9732# a growing tip of the graph and which is not an ancestor of $anc
9733# and returns 0 if so and 1 if not.
9734# If we subsequently discover a tag on such a growing tip, and that
9735# turns out to be a descendent of $anc (which it could, since we
9736# don't necessarily see children before parents), then $desc
9737# isn't a good choice to display as a descendent tag of
9738# $anc (since it is the descendent of another tag which is
9739# a descendent of $anc). Similarly, $anc isn't a good choice to
9740# display as a ancestor tag of $desc.
9741#
9742proc is_certain {desc anc} {
9743 global arcnos arcout arcstart arcend growing problems
9744
9745 set certain {}
9746 if {[llength $arcnos($anc)] == 1} {
9747 # tags on the same arc are certain
9748 if {$arcnos($desc) eq $arcnos($anc)} {
9749 return 1
b8ab2e17 9750 }
e11f1233
PM
9751 if {![info exists arcout($anc)]} {
9752 # if $anc is partway along an arc, use the start of the arc instead
9753 set a [lindex $arcnos($anc) 0]
9754 set anc $arcstart($a)
b8ab2e17 9755 }
e11f1233
PM
9756 }
9757 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9758 set x $desc
9759 } else {
9760 set a [lindex $arcnos($desc) 0]
9761 set x $arcend($a)
9762 }
9763 if {$x == $anc} {
9764 return 1
9765 }
9766 set anclist [list $x]
9767 set dl($x) 1
9768 set nnh 1
9769 set ngrowanc 0
9770 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9771 set x [lindex $anclist $i]
9772 if {$dl($x)} {
9773 incr nnh -1
9774 }
9775 set done($x) 1
9776 foreach a $arcout($x) {
9777 if {[info exists growing($a)]} {
9778 if {![info exists growanc($x)] && $dl($x)} {
9779 set growanc($x) 1
9780 incr ngrowanc
9781 }
9782 } else {
9783 set y $arcend($a)
9784 if {[info exists dl($y)]} {
9785 if {$dl($y)} {
9786 if {!$dl($x)} {
9787 set dl($y) 0
9788 if {![info exists done($y)]} {
9789 incr nnh -1
9790 }
9791 if {[info exists growanc($x)]} {
9792 incr ngrowanc -1
9793 }
9794 set xl [list $y]
9795 for {set k 0} {$k < [llength $xl]} {incr k} {
9796 set z [lindex $xl $k]
9797 foreach c $arcout($z) {
9798 if {[info exists arcend($c)]} {
9799 set v $arcend($c)
9800 if {[info exists dl($v)] && $dl($v)} {
9801 set dl($v) 0
9802 if {![info exists done($v)]} {
9803 incr nnh -1
9804 }
9805 if {[info exists growanc($v)]} {
9806 incr ngrowanc -1
9807 }
9808 lappend xl $v
9809 }
9810 }
9811 }
9812 }
9813 }
9814 }
9815 } elseif {$y eq $anc || !$dl($x)} {
9816 set dl($y) 0
9817 lappend anclist $y
9818 } else {
9819 set dl($y) 1
9820 lappend anclist $y
9821 incr nnh
9822 }
9823 }
b8ab2e17
PM
9824 }
9825 }
e11f1233
PM
9826 foreach x [array names growanc] {
9827 if {$dl($x)} {
9828 return 0
b8ab2e17 9829 }
7eb3cb9c 9830 return 0
b8ab2e17 9831 }
e11f1233 9832 return 1
b8ab2e17
PM
9833}
9834
e11f1233
PM
9835proc validate_arctags {a} {
9836 global arctags idtags
b8ab2e17 9837
e11f1233
PM
9838 set i -1
9839 set na $arctags($a)
9840 foreach id $arctags($a) {
9841 incr i
9842 if {![info exists idtags($id)]} {
9843 set na [lreplace $na $i $i]
9844 incr i -1
9845 }
9846 }
9847 set arctags($a) $na
9848}
9849
9850proc validate_archeads {a} {
9851 global archeads idheads
9852
9853 set i -1
9854 set na $archeads($a)
9855 foreach id $archeads($a) {
9856 incr i
9857 if {![info exists idheads($id)]} {
9858 set na [lreplace $na $i $i]
9859 incr i -1
9860 }
9861 }
9862 set archeads($a) $na
9863}
9864
9865# Return the list of IDs that have tags that are descendents of id,
9866# ignoring IDs that are descendents of IDs already reported.
9867proc desctags {id} {
9868 global arcnos arcstart arcids arctags idtags allparents
9869 global growing cached_dtags
9870
9871 if {![info exists allparents($id)]} {
9872 return {}
9873 }
9874 set t1 [clock clicks -milliseconds]
9875 set argid $id
9876 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9877 # part-way along an arc; check that arc first
9878 set a [lindex $arcnos($id) 0]
9879 if {$arctags($a) ne {}} {
9880 validate_arctags $a
9881 set i [lsearch -exact $arcids($a) $id]
9882 set tid {}
9883 foreach t $arctags($a) {
9884 set j [lsearch -exact $arcids($a) $t]
9885 if {$j >= $i} break
9886 set tid $t
b8ab2e17 9887 }
e11f1233
PM
9888 if {$tid ne {}} {
9889 return $tid
b8ab2e17
PM
9890 }
9891 }
e11f1233
PM
9892 set id $arcstart($a)
9893 if {[info exists idtags($id)]} {
9894 return $id
9895 }
9896 }
9897 if {[info exists cached_dtags($id)]} {
9898 return $cached_dtags($id)
9899 }
9900
9901 set origid $id
9902 set todo [list $id]
9903 set queued($id) 1
9904 set nc 1
9905 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9906 set id [lindex $todo $i]
9907 set done($id) 1
9908 set ta [info exists hastaggedancestor($id)]
9909 if {!$ta} {
9910 incr nc -1
9911 }
9912 # ignore tags on starting node
9913 if {!$ta && $i > 0} {
9914 if {[info exists idtags($id)]} {
9915 set tagloc($id) $id
9916 set ta 1
9917 } elseif {[info exists cached_dtags($id)]} {
9918 set tagloc($id) $cached_dtags($id)
9919 set ta 1
9920 }
9921 }
9922 foreach a $arcnos($id) {
9923 set d $arcstart($a)
9924 if {!$ta && $arctags($a) ne {}} {
9925 validate_arctags $a
9926 if {$arctags($a) ne {}} {
9927 lappend tagloc($id) [lindex $arctags($a) end]
9928 }
9929 }
9930 if {$ta || $arctags($a) ne {}} {
9931 set tomark [list $d]
9932 for {set j 0} {$j < [llength $tomark]} {incr j} {
9933 set dd [lindex $tomark $j]
9934 if {![info exists hastaggedancestor($dd)]} {
9935 if {[info exists done($dd)]} {
9936 foreach b $arcnos($dd) {
9937 lappend tomark $arcstart($b)
9938 }
9939 if {[info exists tagloc($dd)]} {
9940 unset tagloc($dd)
9941 }
9942 } elseif {[info exists queued($dd)]} {
9943 incr nc -1
9944 }
9945 set hastaggedancestor($dd) 1
9946 }
9947 }
9948 }
9949 if {![info exists queued($d)]} {
9950 lappend todo $d
9951 set queued($d) 1
9952 if {![info exists hastaggedancestor($d)]} {
9953 incr nc
9954 }
9955 }
b8ab2e17 9956 }
f1d83ba3 9957 }
e11f1233
PM
9958 set tags {}
9959 foreach id [array names tagloc] {
9960 if {![info exists hastaggedancestor($id)]} {
9961 foreach t $tagloc($id) {
9962 if {[lsearch -exact $tags $t] < 0} {
9963 lappend tags $t
9964 }
9965 }
9966 }
9967 }
9968 set t2 [clock clicks -milliseconds]
9969 set loopix $i
f1d83ba3 9970
e11f1233
PM
9971 # remove tags that are descendents of other tags
9972 for {set i 0} {$i < [llength $tags]} {incr i} {
9973 set a [lindex $tags $i]
9974 for {set j 0} {$j < $i} {incr j} {
9975 set b [lindex $tags $j]
9976 set r [anc_or_desc $a $b]
9977 if {$r == 1} {
9978 set tags [lreplace $tags $j $j]
9979 incr j -1
9980 incr i -1
9981 } elseif {$r == -1} {
9982 set tags [lreplace $tags $i $i]
9983 incr i -1
9984 break
ceadfe90
PM
9985 }
9986 }
9987 }
9988
e11f1233
PM
9989 if {[array names growing] ne {}} {
9990 # graph isn't finished, need to check if any tag could get
9991 # eclipsed by another tag coming later. Simply ignore any
9992 # tags that could later get eclipsed.
9993 set ctags {}
9994 foreach t $tags {
9995 if {[is_certain $t $origid]} {
9996 lappend ctags $t
9997 }
ceadfe90 9998 }
e11f1233
PM
9999 if {$tags eq $ctags} {
10000 set cached_dtags($origid) $tags
10001 } else {
10002 set tags $ctags
ceadfe90 10003 }
e11f1233
PM
10004 } else {
10005 set cached_dtags($origid) $tags
10006 }
10007 set t3 [clock clicks -milliseconds]
10008 if {0 && $t3 - $t1 >= 100} {
10009 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10010 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
ceadfe90 10011 }
e11f1233
PM
10012 return $tags
10013}
ceadfe90 10014
e11f1233
PM
10015proc anctags {id} {
10016 global arcnos arcids arcout arcend arctags idtags allparents
10017 global growing cached_atags
10018
10019 if {![info exists allparents($id)]} {
10020 return {}
10021 }
10022 set t1 [clock clicks -milliseconds]
10023 set argid $id
10024 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10025 # part-way along an arc; check that arc first
10026 set a [lindex $arcnos($id) 0]
10027 if {$arctags($a) ne {}} {
10028 validate_arctags $a
10029 set i [lsearch -exact $arcids($a) $id]
10030 foreach t $arctags($a) {
10031 set j [lsearch -exact $arcids($a) $t]
10032 if {$j > $i} {
10033 return $t
10034 }
10035 }
ceadfe90 10036 }
e11f1233
PM
10037 if {![info exists arcend($a)]} {
10038 return {}
10039 }
10040 set id $arcend($a)
10041 if {[info exists idtags($id)]} {
10042 return $id
10043 }
10044 }
10045 if {[info exists cached_atags($id)]} {
10046 return $cached_atags($id)
10047 }
10048
10049 set origid $id
10050 set todo [list $id]
10051 set queued($id) 1
10052 set taglist {}
10053 set nc 1
10054 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10055 set id [lindex $todo $i]
10056 set done($id) 1
10057 set td [info exists hastaggeddescendent($id)]
10058 if {!$td} {
10059 incr nc -1
10060 }
10061 # ignore tags on starting node
10062 if {!$td && $i > 0} {
10063 if {[info exists idtags($id)]} {
10064 set tagloc($id) $id
10065 set td 1
10066 } elseif {[info exists cached_atags($id)]} {
10067 set tagloc($id) $cached_atags($id)
10068 set td 1
10069 }
10070 }
10071 foreach a $arcout($id) {
10072 if {!$td && $arctags($a) ne {}} {
10073 validate_arctags $a
10074 if {$arctags($a) ne {}} {
10075 lappend tagloc($id) [lindex $arctags($a) 0]
10076 }
10077 }
10078 if {![info exists arcend($a)]} continue
10079 set d $arcend($a)
10080 if {$td || $arctags($a) ne {}} {
10081 set tomark [list $d]
10082 for {set j 0} {$j < [llength $tomark]} {incr j} {
10083 set dd [lindex $tomark $j]
10084 if {![info exists hastaggeddescendent($dd)]} {
10085 if {[info exists done($dd)]} {
10086 foreach b $arcout($dd) {
10087 if {[info exists arcend($b)]} {
10088 lappend tomark $arcend($b)
10089 }
10090 }
10091 if {[info exists tagloc($dd)]} {
10092 unset tagloc($dd)
10093 }
10094 } elseif {[info exists queued($dd)]} {
10095 incr nc -1
10096 }
10097 set hastaggeddescendent($dd) 1
10098 }
10099 }
10100 }
10101 if {![info exists queued($d)]} {
10102 lappend todo $d
10103 set queued($d) 1
10104 if {![info exists hastaggeddescendent($d)]} {
10105 incr nc
10106 }
10107 }
10108 }
10109 }
10110 set t2 [clock clicks -milliseconds]
10111 set loopix $i
10112 set tags {}
10113 foreach id [array names tagloc] {
10114 if {![info exists hastaggeddescendent($id)]} {
10115 foreach t $tagloc($id) {
10116 if {[lsearch -exact $tags $t] < 0} {
10117 lappend tags $t
10118 }
10119 }
ceadfe90
PM
10120 }
10121 }
ceadfe90 10122
e11f1233
PM
10123 # remove tags that are ancestors of other tags
10124 for {set i 0} {$i < [llength $tags]} {incr i} {
10125 set a [lindex $tags $i]
10126 for {set j 0} {$j < $i} {incr j} {
10127 set b [lindex $tags $j]
10128 set r [anc_or_desc $a $b]
10129 if {$r == -1} {
10130 set tags [lreplace $tags $j $j]
10131 incr j -1
10132 incr i -1
10133 } elseif {$r == 1} {
10134 set tags [lreplace $tags $i $i]
10135 incr i -1
10136 break
10137 }
10138 }
10139 }
10140
10141 if {[array names growing] ne {}} {
10142 # graph isn't finished, need to check if any tag could get
10143 # eclipsed by another tag coming later. Simply ignore any
10144 # tags that could later get eclipsed.
10145 set ctags {}
10146 foreach t $tags {
10147 if {[is_certain $origid $t]} {
10148 lappend ctags $t
10149 }
10150 }
10151 if {$tags eq $ctags} {
10152 set cached_atags($origid) $tags
10153 } else {
10154 set tags $ctags
d6ac1a86 10155 }
e11f1233
PM
10156 } else {
10157 set cached_atags($origid) $tags
10158 }
10159 set t3 [clock clicks -milliseconds]
10160 if {0 && $t3 - $t1 >= 100} {
10161 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10162 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
d6ac1a86 10163 }
e11f1233 10164 return $tags
d6ac1a86
PM
10165}
10166
e11f1233
PM
10167# Return the list of IDs that have heads that are descendents of id,
10168# including id itself if it has a head.
10169proc descheads {id} {
10170 global arcnos arcstart arcids archeads idheads cached_dheads
10171 global allparents
ca6d8f58 10172
e11f1233
PM
10173 if {![info exists allparents($id)]} {
10174 return {}
10175 }
f3326b66 10176 set aret {}
e11f1233
PM
10177 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10178 # part-way along an arc; check it first
10179 set a [lindex $arcnos($id) 0]
10180 if {$archeads($a) ne {}} {
10181 validate_archeads $a
10182 set i [lsearch -exact $arcids($a) $id]
10183 foreach t $archeads($a) {
10184 set j [lsearch -exact $arcids($a) $t]
10185 if {$j > $i} break
f3326b66 10186 lappend aret $t
e11f1233 10187 }
ca6d8f58 10188 }
e11f1233 10189 set id $arcstart($a)
ca6d8f58 10190 }
e11f1233
PM
10191 set origid $id
10192 set todo [list $id]
10193 set seen($id) 1
f3326b66 10194 set ret {}
e11f1233
PM
10195 for {set i 0} {$i < [llength $todo]} {incr i} {
10196 set id [lindex $todo $i]
10197 if {[info exists cached_dheads($id)]} {
10198 set ret [concat $ret $cached_dheads($id)]
10199 } else {
10200 if {[info exists idheads($id)]} {
10201 lappend ret $id
10202 }
10203 foreach a $arcnos($id) {
10204 if {$archeads($a) ne {}} {
706d6c3e
PM
10205 validate_archeads $a
10206 if {$archeads($a) ne {}} {
10207 set ret [concat $ret $archeads($a)]
10208 }
e11f1233
PM
10209 }
10210 set d $arcstart($a)
10211 if {![info exists seen($d)]} {
10212 lappend todo $d
10213 set seen($d) 1
10214 }
10215 }
10299152 10216 }
10299152 10217 }
e11f1233
PM
10218 set ret [lsort -unique $ret]
10219 set cached_dheads($origid) $ret
f3326b66 10220 return [concat $ret $aret]
10299152
PM
10221}
10222
e11f1233
PM
10223proc addedtag {id} {
10224 global arcnos arcout cached_dtags cached_atags
ca6d8f58 10225
e11f1233
PM
10226 if {![info exists arcnos($id)]} return
10227 if {![info exists arcout($id)]} {
10228 recalcarc [lindex $arcnos($id) 0]
ca6d8f58 10229 }
e11f1233
PM
10230 catch {unset cached_dtags}
10231 catch {unset cached_atags}
ca6d8f58
PM
10232}
10233
e11f1233
PM
10234proc addedhead {hid head} {
10235 global arcnos arcout cached_dheads
10236
10237 if {![info exists arcnos($hid)]} return
10238 if {![info exists arcout($hid)]} {
10239 recalcarc [lindex $arcnos($hid) 0]
10240 }
10241 catch {unset cached_dheads}
10242}
10243
10244proc removedhead {hid head} {
10245 global cached_dheads
10246
10247 catch {unset cached_dheads}
10248}
10249
10250proc movedhead {hid head} {
10251 global arcnos arcout cached_dheads
cec7bece 10252
e11f1233
PM
10253 if {![info exists arcnos($hid)]} return
10254 if {![info exists arcout($hid)]} {
10255 recalcarc [lindex $arcnos($hid) 0]
cec7bece 10256 }
e11f1233
PM
10257 catch {unset cached_dheads}
10258}
10259
10260proc changedrefs {} {
10261 global cached_dheads cached_dtags cached_atags
10262 global arctags archeads arcnos arcout idheads idtags
10263
10264 foreach id [concat [array names idheads] [array names idtags]] {
10265 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10266 set a [lindex $arcnos($id) 0]
10267 if {![info exists donearc($a)]} {
10268 recalcarc $a
10269 set donearc($a) 1
10270 }
cec7bece
PM
10271 }
10272 }
e11f1233
PM
10273 catch {unset cached_dtags}
10274 catch {unset cached_atags}
10275 catch {unset cached_dheads}
cec7bece
PM
10276}
10277
f1d83ba3 10278proc rereadrefs {} {
fc2a256f 10279 global idtags idheads idotherrefs mainheadid
f1d83ba3
PM
10280
10281 set refids [concat [array names idtags] \
10282 [array names idheads] [array names idotherrefs]]
10283 foreach id $refids {
10284 if {![info exists ref($id)]} {
10285 set ref($id) [listrefs $id]
10286 }
10287 }
fc2a256f 10288 set oldmainhead $mainheadid
f1d83ba3 10289 readrefs
cec7bece 10290 changedrefs
f1d83ba3
PM
10291 set refids [lsort -unique [concat $refids [array names idtags] \
10292 [array names idheads] [array names idotherrefs]]]
10293 foreach id $refids {
10294 set v [listrefs $id]
c11ff120 10295 if {![info exists ref($id)] || $ref($id) != $v} {
f1d83ba3
PM
10296 redrawtags $id
10297 }
10298 }
c11ff120
PM
10299 if {$oldmainhead ne $mainheadid} {
10300 redrawtags $oldmainhead
10301 redrawtags $mainheadid
10302 }
887c996e 10303 run refill_reflist
f1d83ba3
PM
10304}
10305
2e1ded44
JH
10306proc listrefs {id} {
10307 global idtags idheads idotherrefs
10308
10309 set x {}
10310 if {[info exists idtags($id)]} {
10311 set x $idtags($id)
10312 }
10313 set y {}
10314 if {[info exists idheads($id)]} {
10315 set y $idheads($id)
10316 }
10317 set z {}
10318 if {[info exists idotherrefs($id)]} {
10319 set z $idotherrefs($id)
10320 }
10321 return [list $x $y $z]
10322}
10323
106288cb 10324proc showtag {tag isnew} {
62d3ea65 10325 global ctext tagcontents tagids linknum tagobjid
106288cb
PM
10326
10327 if {$isnew} {
354af6bd 10328 addtohistory [list showtag $tag 0] savectextpos
106288cb
PM
10329 }
10330 $ctext conf -state normal
3ea06f9f 10331 clear_ctext
32f1b3e4 10332 settabs 0
106288cb 10333 set linknum 0
62d3ea65
PM
10334 if {![info exists tagcontents($tag)]} {
10335 catch {
10336 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
10337 }
10338 }
106288cb
PM
10339 if {[info exists tagcontents($tag)]} {
10340 set text $tagcontents($tag)
10341 } else {
d990cedf 10342 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
106288cb 10343 }
f1b86294 10344 appendwithlinks $text {}
354af6bd 10345 maybe_scroll_ctext
106288cb 10346 $ctext conf -state disabled
7fcceed7 10347 init_flist {}
106288cb
PM
10348}
10349
1d10f36d
PM
10350proc doquit {} {
10351 global stopped
314f5de1
TA
10352 global gitktmpdir
10353
1d10f36d 10354 set stopped 100
b6047c5a 10355 savestuff .
1d10f36d 10356 destroy .
314f5de1
TA
10357
10358 if {[info exists gitktmpdir]} {
10359 catch {file delete -force $gitktmpdir}
10360 }
1d10f36d 10361}
1db95b00 10362
9a7558f3 10363proc mkfontdisp {font top which} {
d93f1713 10364 global fontattr fontpref $font NS use_ttk
9a7558f3
PM
10365
10366 set fontpref($font) [set $font]
d93f1713 10367 ${NS}::button $top.${font}but -text $which \
9a7558f3 10368 -command [list choosefont $font $which]
d93f1713
PT
10369 if {!$use_ttk} {$top.${font}but configure -font optionfont}
10370 ${NS}::label $top.$font -relief flat -font $font \
9a7558f3
PM
10371 -text $fontattr($font,family) -justify left
10372 grid x $top.${font}but $top.$font -sticky w
10373}
10374
10375proc choosefont {font which} {
10376 global fontparam fontlist fonttop fontattr
d93f1713 10377 global prefstop NS
9a7558f3
PM
10378
10379 set fontparam(which) $which
10380 set fontparam(font) $font
10381 set fontparam(family) [font actual $font -family]
10382 set fontparam(size) $fontattr($font,size)
10383 set fontparam(weight) $fontattr($font,weight)
10384 set fontparam(slant) $fontattr($font,slant)
10385 set top .gitkfont
10386 set fonttop $top
10387 if {![winfo exists $top]} {
10388 font create sample
10389 eval font config sample [font actual $font]
d93f1713 10390 ttk_toplevel $top
e7d64008 10391 make_transient $top $prefstop
d990cedf 10392 wm title $top [mc "Gitk font chooser"]
d93f1713 10393 ${NS}::label $top.l -textvariable fontparam(which)
9a7558f3
PM
10394 pack $top.l -side top
10395 set fontlist [lsort [font families]]
d93f1713 10396 ${NS}::frame $top.f
9a7558f3
PM
10397 listbox $top.f.fam -listvariable fontlist \
10398 -yscrollcommand [list $top.f.sb set]
10399 bind $top.f.fam <<ListboxSelect>> selfontfam
d93f1713 10400 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
9a7558f3
PM
10401 pack $top.f.sb -side right -fill y
10402 pack $top.f.fam -side left -fill both -expand 1
10403 pack $top.f -side top -fill both -expand 1
d93f1713 10404 ${NS}::frame $top.g
9a7558f3
PM
10405 spinbox $top.g.size -from 4 -to 40 -width 4 \
10406 -textvariable fontparam(size) \
10407 -validatecommand {string is integer -strict %s}
10408 checkbutton $top.g.bold -padx 5 \
d990cedf 10409 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9a7558f3
PM
10410 -variable fontparam(weight) -onvalue bold -offvalue normal
10411 checkbutton $top.g.ital -padx 5 \
d990cedf 10412 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9a7558f3
PM
10413 -variable fontparam(slant) -onvalue italic -offvalue roman
10414 pack $top.g.size $top.g.bold $top.g.ital -side left
10415 pack $top.g -side top
10416 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10417 -background white
10418 $top.c create text 100 25 -anchor center -text $which -font sample \
10419 -fill black -tags text
10420 bind $top.c <Configure> [list centertext $top.c]
10421 pack $top.c -side top -fill x
d93f1713
PT
10422 ${NS}::frame $top.buts
10423 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10424 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
76f15947
AG
10425 bind $top <Key-Return> fontok
10426 bind $top <Key-Escape> fontcan
9a7558f3
PM
10427 grid $top.buts.ok $top.buts.can
10428 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10429 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10430 pack $top.buts -side bottom -fill x
10431 trace add variable fontparam write chg_fontparam
10432 } else {
10433 raise $top
10434 $top.c itemconf text -text $which
10435 }
10436 set i [lsearch -exact $fontlist $fontparam(family)]
10437 if {$i >= 0} {
10438 $top.f.fam selection set $i
10439 $top.f.fam see $i
10440 }
10441}
10442
10443proc centertext {w} {
10444 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10445}
10446
10447proc fontok {} {
10448 global fontparam fontpref prefstop
10449
10450 set f $fontparam(font)
10451 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10452 if {$fontparam(weight) eq "bold"} {
10453 lappend fontpref($f) "bold"
10454 }
10455 if {$fontparam(slant) eq "italic"} {
10456 lappend fontpref($f) "italic"
10457 }
10458 set w $prefstop.$f
10459 $w conf -text $fontparam(family) -font $fontpref($f)
d93f1713 10460
9a7558f3
PM
10461 fontcan
10462}
10463
10464proc fontcan {} {
10465 global fonttop fontparam
10466
10467 if {[info exists fonttop]} {
10468 catch {destroy $fonttop}
10469 catch {font delete sample}
10470 unset fonttop
10471 unset fontparam
10472 }
10473}
10474
d93f1713
PT
10475if {[package vsatisfies [package provide Tk] 8.6]} {
10476 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10477 # function to make use of it.
10478 proc choosefont {font which} {
10479 tk fontchooser configure -title $which -font $font \
10480 -command [list on_choosefont $font $which]
10481 tk fontchooser show
10482 }
10483 proc on_choosefont {font which newfont} {
10484 global fontparam
10485 puts stderr "$font $newfont"
10486 array set f [font actual $newfont]
10487 set fontparam(which) $which
10488 set fontparam(font) $font
10489 set fontparam(family) $f(-family)
10490 set fontparam(size) $f(-size)
10491 set fontparam(weight) $f(-weight)
10492 set fontparam(slant) $f(-slant)
10493 fontok
10494 }
10495}
10496
9a7558f3
PM
10497proc selfontfam {} {
10498 global fonttop fontparam
10499
10500 set i [$fonttop.f.fam curselection]
10501 if {$i ne {}} {
10502 set fontparam(family) [$fonttop.f.fam get $i]
10503 }
10504}
10505
10506proc chg_fontparam {v sub op} {
10507 global fontparam
10508
10509 font config sample -$sub $fontparam($sub)
10510}
10511
712fcc08 10512proc doprefs {} {
d93f1713 10513 global maxwidth maxgraphpct use_ttk NS
219ea3a9 10514 global oldprefs prefstop showneartags showlocalchanges
e3e901be 10515 global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
39ee47ef 10516 global tabstop limitdiffs autoselect extdifftool perfile_attrs
232475d3 10517
712fcc08
PM
10518 set top .gitkprefs
10519 set prefstop $top
10520 if {[winfo exists $top]} {
10521 raise $top
10522 return
757f17bc 10523 }
3de07118 10524 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
39ee47ef 10525 limitdiffs tabstop perfile_attrs} {
712fcc08 10526 set oldprefs($v) [set $v]
232475d3 10527 }
d93f1713 10528 ttk_toplevel $top
d990cedf 10529 wm title $top [mc "Gitk preferences"]
e7d64008 10530 make_transient $top .
d93f1713 10531 ${NS}::label $top.ldisp -text [mc "Commit list display options"]
712fcc08 10532 grid $top.ldisp - -sticky w -pady 10
d93f1713
PT
10533 ${NS}::label $top.spacer -text " "
10534 ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
712fcc08
PM
10535 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10536 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
d93f1713 10537 ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
712fcc08
PM
10538 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10539 grid x $top.maxpctl $top.maxpct -sticky w
d93f1713
PT
10540 ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
10541 -variable showlocalchanges
219ea3a9 10542 grid x $top.showlocal -sticky w
d93f1713
PT
10543 ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1"] \
10544 -variable autoselect
95293b58 10545 grid x $top.autoselect -sticky w
f8a2c0d1 10546
d93f1713 10547 ${NS}::label $top.ddisp -text [mc "Diff display options"]
712fcc08 10548 grid $top.ddisp - -sticky w -pady 10
d93f1713 10549 ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
94503918
PM
10550 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10551 grid x $top.tabstopl $top.tabstop -sticky w
d93f1713
PT
10552 ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
10553 -variable showneartags
b8ab2e17 10554 grid x $top.ntag -sticky w
d93f1713
PT
10555 ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
10556 -variable limitdiffs
7a39a17a 10557 grid x $top.ldiff -sticky w
d93f1713
PT
10558 ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
10559 -variable perfile_attrs
39ee47ef 10560 grid x $top.lattr -sticky w
f8a2c0d1 10561
d93f1713
PT
10562 ${NS}::entry $top.extdifft -textvariable extdifftool
10563 ${NS}::frame $top.extdifff
10564 ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
10565 ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
314f5de1 10566 pack $top.extdifff.l $top.extdifff.b -side left
d93f1713
PT
10567 pack configure $top.extdifff.l -padx 10
10568 grid x $top.extdifff $top.extdifft -sticky ew
314f5de1 10569
d93f1713 10570 ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
f8a2c0d1
PM
10571 grid $top.cdisp - -sticky w -pady 10
10572 label $top.bg -padx 40 -relief sunk -background $bgcolor
d93f1713 10573 ${NS}::button $top.bgbut -text [mc "Background"] \
968b016a 10574 -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
f8a2c0d1
PM
10575 grid x $top.bgbut $top.bg -sticky w
10576 label $top.fg -padx 40 -relief sunk -background $fgcolor
d93f1713 10577 ${NS}::button $top.fgbut -text [mc "Foreground"] \
968b016a 10578 -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
f8a2c0d1
PM
10579 grid x $top.fgbut $top.fg -sticky w
10580 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
d93f1713 10581 ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
968b016a 10582 -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
f8a2c0d1
PM
10583 [list $ctext tag conf d0 -foreground]]
10584 grid x $top.diffoldbut $top.diffold -sticky w
10585 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
d93f1713 10586 ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
968b016a 10587 -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
8b07dca1 10588 [list $ctext tag conf dresult -foreground]]
f8a2c0d1
PM
10589 grid x $top.diffnewbut $top.diffnew -sticky w
10590 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
d93f1713 10591 ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
f8a2c0d1 10592 -command [list choosecolor diffcolors 2 $top.hunksep \
968b016a 10593 [mc "diff hunk header"] \
f8a2c0d1
PM
10594 [list $ctext tag conf hunksep -foreground]]
10595 grid x $top.hunksepbut $top.hunksep -sticky w
e3e901be 10596 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
d93f1713 10597 ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
e3e901be
PM
10598 -command [list choosecolor markbgcolor {} $top.markbgsep \
10599 [mc "marked line background"] \
10600 [list $ctext tag conf omark -background]]
10601 grid x $top.markbgbut $top.markbgsep -sticky w
60378c0c 10602 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
d93f1713 10603 ${NS}::button $top.selbgbut -text [mc "Select bg"] \
968b016a 10604 -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
60378c0c 10605 grid x $top.selbgbut $top.selbgsep -sticky w
f8a2c0d1 10606
d93f1713 10607 ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
9a7558f3 10608 grid $top.cfont - -sticky w -pady 10
d990cedf
CS
10609 mkfontdisp mainfont $top [mc "Main font"]
10610 mkfontdisp textfont $top [mc "Diff display font"]
10611 mkfontdisp uifont $top [mc "User interface font"]
9a7558f3 10612
d93f1713
PT
10613 if {!$use_ttk} {
10614 foreach w {maxpctl maxwidthl showlocal autoselect tabstopl ntag
10615 ldiff lattr extdifff.l extdifff.b bgbut fgbut
10616 diffoldbut diffnewbut hunksepbut markbgbut selbgbut} {
10617 $top.$w configure -font optionfont
10618 }
10619 }
10620
10621 ${NS}::frame $top.buts
10622 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10623 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
76f15947
AG
10624 bind $top <Key-Return> prefsok
10625 bind $top <Key-Escape> prefscan
712fcc08
PM
10626 grid $top.buts.ok $top.buts.can
10627 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10628 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10629 grid $top.buts - - -pady 10 -sticky ew
d93f1713 10630 grid columnconfigure $top 2 -weight 1
3a950e9a 10631 bind $top <Visibility> "focus $top.buts.ok"
712fcc08
PM
10632}
10633
314f5de1
TA
10634proc choose_extdiff {} {
10635 global extdifftool
10636
b56e0a9a 10637 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
314f5de1
TA
10638 if {$prog ne {}} {
10639 set extdifftool $prog
10640 }
10641}
10642
f8a2c0d1
PM
10643proc choosecolor {v vi w x cmd} {
10644 global $v
10645
10646 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
d990cedf 10647 -title [mc "Gitk: choose color for %s" $x]]
f8a2c0d1
PM
10648 if {$c eq {}} return
10649 $w conf -background $c
10650 lset $v $vi $c
10651 eval $cmd $c
10652}
10653
60378c0c
ML
10654proc setselbg {c} {
10655 global bglist cflist
10656 foreach w $bglist {
10657 $w configure -selectbackground $c
10658 }
10659 $cflist tag configure highlight \
10660 -background [$cflist cget -selectbackground]
10661 allcanvs itemconf secsel -fill $c
10662}
10663
f8a2c0d1
PM
10664proc setbg {c} {
10665 global bglist
10666
10667 foreach w $bglist {
10668 $w conf -background $c
10669 }
10670}
10671
10672proc setfg {c} {
10673 global fglist canv
10674
10675 foreach w $fglist {
10676 $w conf -foreground $c
10677 }
10678 allcanvs itemconf text -fill $c
10679 $canv itemconf circle -outline $c
b9fdba7f 10680 $canv itemconf markid -outline $c
f8a2c0d1
PM
10681}
10682
712fcc08 10683proc prefscan {} {
94503918 10684 global oldprefs prefstop
712fcc08 10685
3de07118 10686 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
39ee47ef 10687 limitdiffs tabstop perfile_attrs} {
94503918 10688 global $v
712fcc08
PM
10689 set $v $oldprefs($v)
10690 }
10691 catch {destroy $prefstop}
10692 unset prefstop
9a7558f3 10693 fontcan
712fcc08
PM
10694}
10695
10696proc prefsok {} {
10697 global maxwidth maxgraphpct
219ea3a9 10698 global oldprefs prefstop showneartags showlocalchanges
9a7558f3 10699 global fontpref mainfont textfont uifont
39ee47ef 10700 global limitdiffs treediffs perfile_attrs
712fcc08
PM
10701
10702 catch {destroy $prefstop}
10703 unset prefstop
9a7558f3
PM
10704 fontcan
10705 set fontchanged 0
10706 if {$mainfont ne $fontpref(mainfont)} {
10707 set mainfont $fontpref(mainfont)
10708 parsefont mainfont $mainfont
10709 eval font configure mainfont [fontflags mainfont]
10710 eval font configure mainfontbold [fontflags mainfont 1]
10711 setcoords
10712 set fontchanged 1
10713 }
10714 if {$textfont ne $fontpref(textfont)} {
10715 set textfont $fontpref(textfont)
10716 parsefont textfont $textfont
10717 eval font configure textfont [fontflags textfont]
10718 eval font configure textfontbold [fontflags textfont 1]
10719 }
10720 if {$uifont ne $fontpref(uifont)} {
10721 set uifont $fontpref(uifont)
10722 parsefont uifont $uifont
10723 eval font configure uifont [fontflags uifont]
10724 }
32f1b3e4 10725 settabs
219ea3a9
PM
10726 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10727 if {$showlocalchanges} {
10728 doshowlocalchanges
10729 } else {
10730 dohidelocalchanges
10731 }
10732 }
39ee47ef
PM
10733 if {$limitdiffs != $oldprefs(limitdiffs) ||
10734 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10735 # treediffs elements are limited by path;
10736 # won't have encodings cached if perfile_attrs was just turned on
74a40c71
PM
10737 catch {unset treediffs}
10738 }
9a7558f3 10739 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
712fcc08
PM
10740 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10741 redisplay
7a39a17a
PM
10742 } elseif {$showneartags != $oldprefs(showneartags) ||
10743 $limitdiffs != $oldprefs(limitdiffs)} {
b8ab2e17 10744 reselectline
712fcc08
PM
10745 }
10746}
10747
10748proc formatdate {d} {
e8b5f4be 10749 global datetimeformat
219ea3a9 10750 if {$d ne {}} {
e8b5f4be 10751 set d [clock format $d -format $datetimeformat]
219ea3a9
PM
10752 }
10753 return $d
232475d3
PM
10754}
10755
fd8ccbec
PM
10756# This list of encoding names and aliases is distilled from
10757# http://www.iana.org/assignments/character-sets.
10758# Not all of them are supported by Tcl.
10759set encoding_aliases {
10760 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10761 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10762 { ISO-10646-UTF-1 csISO10646UTF1 }
10763 { ISO_646.basic:1983 ref csISO646basic1983 }
10764 { INVARIANT csINVARIANT }
10765 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10766 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10767 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10768 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10769 { NATS-DANO iso-ir-9-1 csNATSDANO }
10770 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10771 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10772 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10773 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10774 { ISO-2022-KR csISO2022KR }
10775 { EUC-KR csEUCKR }
10776 { ISO-2022-JP csISO2022JP }
10777 { ISO-2022-JP-2 csISO2022JP2 }
10778 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10779 csISO13JISC6220jp }
10780 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10781 { IT iso-ir-15 ISO646-IT csISO15Italian }
10782 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10783 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10784 { greek7-old iso-ir-18 csISO18Greek7Old }
10785 { latin-greek iso-ir-19 csISO19LatinGreek }
10786 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10787 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10788 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10789 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10790 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10791 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10792 { INIS iso-ir-49 csISO49INIS }
10793 { INIS-8 iso-ir-50 csISO50INIS8 }
10794 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10795 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10796 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10797 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10798 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10799 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10800 csISO60Norwegian1 }
10801 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10802 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10803 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10804 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10805 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10806 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10807 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10808 { greek7 iso-ir-88 csISO88Greek7 }
10809 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10810 { iso-ir-90 csISO90 }
10811 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10812 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10813 csISO92JISC62991984b }
10814 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10815 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10816 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10817 csISO95JIS62291984handadd }
10818 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10819 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10820 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10821 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10822 CP819 csISOLatin1 }
10823 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10824 { T.61-7bit iso-ir-102 csISO102T617bit }
10825 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10826 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10827 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10828 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10829 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10830 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10831 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10832 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10833 arabic csISOLatinArabic }
10834 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10835 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10836 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10837 greek greek8 csISOLatinGreek }
10838 { T.101-G2 iso-ir-128 csISO128T101G2 }
10839 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10840 csISOLatinHebrew }
10841 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10842 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10843 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10844 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10845 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10846 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10847 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10848 csISOLatinCyrillic }
10849 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10850 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10851 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10852 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10853 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10854 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10855 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10856 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10857 { ISO_10367-box iso-ir-155 csISO10367Box }
10858 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10859 { latin-lap lap iso-ir-158 csISO158Lap }
10860 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10861 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10862 { us-dk csUSDK }
10863 { dk-us csDKUS }
10864 { JIS_X0201 X0201 csHalfWidthKatakana }
10865 { KSC5636 ISO646-KR csKSC5636 }
10866 { ISO-10646-UCS-2 csUnicode }
10867 { ISO-10646-UCS-4 csUCS4 }
10868 { DEC-MCS dec csDECMCS }
10869 { hp-roman8 roman8 r8 csHPRoman8 }
10870 { macintosh mac csMacintosh }
10871 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10872 csIBM037 }
10873 { IBM038 EBCDIC-INT cp038 csIBM038 }
10874 { IBM273 CP273 csIBM273 }
10875 { IBM274 EBCDIC-BE CP274 csIBM274 }
10876 { IBM275 EBCDIC-BR cp275 csIBM275 }
10877 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10878 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10879 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10880 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10881 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10882 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10883 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10884 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10885 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10886 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10887 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10888 { IBM437 cp437 437 csPC8CodePage437 }
10889 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10890 { IBM775 cp775 csPC775Baltic }
10891 { IBM850 cp850 850 csPC850Multilingual }
10892 { IBM851 cp851 851 csIBM851 }
10893 { IBM852 cp852 852 csPCp852 }
10894 { IBM855 cp855 855 csIBM855 }
10895 { IBM857 cp857 857 csIBM857 }
10896 { IBM860 cp860 860 csIBM860 }
10897 { IBM861 cp861 861 cp-is csIBM861 }
10898 { IBM862 cp862 862 csPC862LatinHebrew }
10899 { IBM863 cp863 863 csIBM863 }
10900 { IBM864 cp864 csIBM864 }
10901 { IBM865 cp865 865 csIBM865 }
10902 { IBM866 cp866 866 csIBM866 }
10903 { IBM868 CP868 cp-ar csIBM868 }
10904 { IBM869 cp869 869 cp-gr csIBM869 }
10905 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10906 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10907 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10908 { IBM891 cp891 csIBM891 }
10909 { IBM903 cp903 csIBM903 }
10910 { IBM904 cp904 904 csIBBM904 }
10911 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10912 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10913 { IBM1026 CP1026 csIBM1026 }
10914 { EBCDIC-AT-DE csIBMEBCDICATDE }
10915 { EBCDIC-AT-DE-A csEBCDICATDEA }
10916 { EBCDIC-CA-FR csEBCDICCAFR }
10917 { EBCDIC-DK-NO csEBCDICDKNO }
10918 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10919 { EBCDIC-FI-SE csEBCDICFISE }
10920 { EBCDIC-FI-SE-A csEBCDICFISEA }
10921 { EBCDIC-FR csEBCDICFR }
10922 { EBCDIC-IT csEBCDICIT }
10923 { EBCDIC-PT csEBCDICPT }
10924 { EBCDIC-ES csEBCDICES }
10925 { EBCDIC-ES-A csEBCDICESA }
10926 { EBCDIC-ES-S csEBCDICESS }
10927 { EBCDIC-UK csEBCDICUK }
10928 { EBCDIC-US csEBCDICUS }
10929 { UNKNOWN-8BIT csUnknown8BiT }
10930 { MNEMONIC csMnemonic }
10931 { MNEM csMnem }
10932 { VISCII csVISCII }
10933 { VIQR csVIQR }
10934 { KOI8-R csKOI8R }
10935 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10936 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10937 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10938 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10939 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10940 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10941 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10942 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10943 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10944 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10945 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10946 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10947 { IBM1047 IBM-1047 }
10948 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10949 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10950 { UNICODE-1-1 csUnicode11 }
10951 { CESU-8 csCESU-8 }
10952 { BOCU-1 csBOCU-1 }
10953 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10954 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10955 l8 }
10956 { ISO-8859-15 ISO_8859-15 Latin-9 }
10957 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10958 { GBK CP936 MS936 windows-936 }
10959 { JIS_Encoding csJISEncoding }
09c7029d 10960 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
fd8ccbec
PM
10961 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10962 EUC-JP }
10963 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10964 { ISO-10646-UCS-Basic csUnicodeASCII }
10965 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10966 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10967 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10968 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10969 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10970 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10971 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10972 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10973 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10974 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10975 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10976 { Ventura-US csVenturaUS }
10977 { Ventura-International csVenturaInternational }
10978 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10979 { PC8-Turkish csPC8Turkish }
10980 { IBM-Symbols csIBMSymbols }
10981 { IBM-Thai csIBMThai }
10982 { HP-Legal csHPLegal }
10983 { HP-Pi-font csHPPiFont }
10984 { HP-Math8 csHPMath8 }
10985 { Adobe-Symbol-Encoding csHPPSMath }
10986 { HP-DeskTop csHPDesktop }
10987 { Ventura-Math csVenturaMath }
10988 { Microsoft-Publishing csMicrosoftPublishing }
10989 { Windows-31J csWindows31J }
10990 { GB2312 csGB2312 }
10991 { Big5 csBig5 }
10992}
10993
10994proc tcl_encoding {enc} {
39ee47ef
PM
10995 global encoding_aliases tcl_encoding_cache
10996 if {[info exists tcl_encoding_cache($enc)]} {
10997 return $tcl_encoding_cache($enc)
10998 }
fd8ccbec
PM
10999 set names [encoding names]
11000 set lcnames [string tolower $names]
11001 set enc [string tolower $enc]
11002 set i [lsearch -exact $lcnames $enc]
11003 if {$i < 0} {
11004 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
09c7029d 11005 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
fd8ccbec
PM
11006 set i [lsearch -exact $lcnames $encx]
11007 }
11008 }
11009 if {$i < 0} {
11010 foreach l $encoding_aliases {
11011 set ll [string tolower $l]
11012 if {[lsearch -exact $ll $enc] < 0} continue
11013 # look through the aliases for one that tcl knows about
11014 foreach e $ll {
11015 set i [lsearch -exact $lcnames $e]
11016 if {$i < 0} {
09c7029d 11017 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
fd8ccbec
PM
11018 set i [lsearch -exact $lcnames $ex]
11019 }
11020 }
11021 if {$i >= 0} break
11022 }
11023 break
11024 }
11025 }
39ee47ef 11026 set tclenc {}
fd8ccbec 11027 if {$i >= 0} {
39ee47ef 11028 set tclenc [lindex $names $i]
fd8ccbec 11029 }
39ee47ef
PM
11030 set tcl_encoding_cache($enc) $tclenc
11031 return $tclenc
fd8ccbec
PM
11032}
11033
09c7029d 11034proc gitattr {path attr default} {
39ee47ef
PM
11035 global path_attr_cache
11036 if {[info exists path_attr_cache($attr,$path)]} {
11037 set r $path_attr_cache($attr,$path)
11038 } else {
11039 set r "unspecified"
11040 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11041 regexp "(.*): encoding: (.*)" $line m f r
09c7029d 11042 }
4db09304 11043 set path_attr_cache($attr,$path) $r
39ee47ef
PM
11044 }
11045 if {$r eq "unspecified"} {
11046 return $default
11047 }
11048 return $r
09c7029d
AG
11049}
11050
4db09304 11051proc cache_gitattr {attr pathlist} {
39ee47ef
PM
11052 global path_attr_cache
11053 set newlist {}
11054 foreach path $pathlist {
11055 if {![info exists path_attr_cache($attr,$path)]} {
11056 lappend newlist $path
11057 }
11058 }
11059 set lim 1000
11060 if {[tk windowingsystem] == "win32"} {
11061 # windows has a 32k limit on the arguments to a command...
11062 set lim 30
11063 }
11064 while {$newlist ne {}} {
11065 set head [lrange $newlist 0 [expr {$lim - 1}]]
11066 set newlist [lrange $newlist $lim end]
11067 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11068 foreach row [split $rlist "\n"] {
11069 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
11070 if {[string index $path 0] eq "\""} {
11071 set path [encoding convertfrom [lindex $path 0]]
11072 }
11073 set path_attr_cache($attr,$path) $value
4db09304 11074 }
39ee47ef 11075 }
4db09304 11076 }
39ee47ef 11077 }
4db09304
AG
11078}
11079
09c7029d 11080proc get_path_encoding {path} {
39ee47ef
PM
11081 global gui_encoding perfile_attrs
11082 set tcl_enc $gui_encoding
11083 if {$path ne {} && $perfile_attrs} {
11084 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11085 if {$enc2 ne {}} {
11086 set tcl_enc $enc2
09c7029d 11087 }
39ee47ef
PM
11088 }
11089 return $tcl_enc
09c7029d
AG
11090}
11091
5d7589d4
PM
11092# First check that Tcl/Tk is recent enough
11093if {[catch {package require Tk 8.4} err]} {
d990cedf
CS
11094 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11095 Gitk requires at least Tcl/Tk 8.4."]
5d7589d4
PM
11096 exit 1
11097}
11098
1d10f36d 11099# defaults...
8974c6f9 11100set wrcomcmd "git diff-tree --stdin -p --pretty"
671bc153 11101
fd8ccbec 11102set gitencoding {}
671bc153 11103catch {
27cb61ca 11104 set gitencoding [exec git config --get i18n.commitencoding]
671bc153 11105}
590915da
AG
11106catch {
11107 set gitencoding [exec git config --get i18n.logoutputencoding]
11108}
671bc153 11109if {$gitencoding == ""} {
fd8ccbec
PM
11110 set gitencoding "utf-8"
11111}
11112set tclencoding [tcl_encoding $gitencoding]
11113if {$tclencoding == {}} {
11114 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
671bc153 11115}
1db95b00 11116
09c7029d
AG
11117set gui_encoding [encoding system]
11118catch {
39ee47ef
PM
11119 set enc [exec git config --get gui.encoding]
11120 if {$enc ne {}} {
11121 set tclenc [tcl_encoding $enc]
11122 if {$tclenc ne {}} {
11123 set gui_encoding $tclenc
11124 } else {
11125 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11126 }
11127 }
09c7029d
AG
11128}
11129
5fdcbb13
DS
11130if {[tk windowingsystem] eq "aqua"} {
11131 set mainfont {{Lucida Grande} 9}
11132 set textfont {Monaco 9}
11133 set uifont {{Lucida Grande} 9 bold}
11134} else {
11135 set mainfont {Helvetica 9}
11136 set textfont {Courier 9}
11137 set uifont {Helvetica 9 bold}
11138}
7e12f1a6 11139set tabstop 8
b74fd579 11140set findmergefiles 0
8d858d1a 11141set maxgraphpct 50
f6075eba 11142set maxwidth 16
232475d3 11143set revlistorder 0
757f17bc 11144set fastdate 0
6e8c8707
PM
11145set uparrowlen 5
11146set downarrowlen 5
11147set mingaplen 100
f8b28a40 11148set cmitmode "patch"
f1b86294 11149set wrapcomment "none"
b8ab2e17 11150set showneartags 1
0a4dd8b8 11151set maxrefs 20
322a8cc9 11152set maxlinelen 200
219ea3a9 11153set showlocalchanges 1
7a39a17a 11154set limitdiffs 1
e8b5f4be 11155set datetimeformat "%Y-%m-%d %H:%M:%S"
95293b58 11156set autoselect 1
39ee47ef 11157set perfile_attrs 0
1d10f36d 11158
5fdcbb13
DS
11159if {[tk windowingsystem] eq "aqua"} {
11160 set extdifftool "opendiff"
11161} else {
11162 set extdifftool "meld"
11163}
314f5de1 11164
1d10f36d 11165set colors {green red blue magenta darkgrey brown orange}
f8a2c0d1
PM
11166set bgcolor white
11167set fgcolor black
11168set diffcolors {red "#00a000" blue}
890fae70 11169set diffcontext 3
b9b86007 11170set ignorespace 0
60378c0c 11171set selectbgcolor gray85
e3e901be 11172set markbgcolor "#e0e0ff"
1d10f36d 11173
c11ff120
PM
11174set circlecolors {white blue gray blue blue}
11175
d277e89f
PM
11176# button for popping up context menus
11177if {[tk windowingsystem] eq "aqua"} {
11178 set ctxbut <Button-2>
11179} else {
11180 set ctxbut <Button-3>
11181}
11182
663c3aa9
CS
11183## For msgcat loading, first locate the installation location.
11184if { [info exists ::env(GITK_MSGSDIR)] } {
11185 ## Msgsdir was manually set in the environment.
11186 set gitk_msgsdir $::env(GITK_MSGSDIR)
11187} else {
11188 ## Let's guess the prefix from argv0.
11189 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11190 set gitk_libdir [file join $gitk_prefix share gitk lib]
11191 set gitk_msgsdir [file join $gitk_libdir msgs]
11192 unset gitk_prefix
11193}
11194
11195## Internationalization (i18n) through msgcat and gettext. See
11196## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11197package require msgcat
11198namespace import ::msgcat::mc
11199## And eventually load the actual message catalog
11200::msgcat::mcload $gitk_msgsdir
11201
1d10f36d
PM
11202catch {source ~/.gitk}
11203
712fcc08 11204font create optionfont -family sans-serif -size -12
17386066 11205
0ed1dd3c
PM
11206parsefont mainfont $mainfont
11207eval font create mainfont [fontflags mainfont]
11208eval font create mainfontbold [fontflags mainfont 1]
11209
11210parsefont textfont $textfont
11211eval font create textfont [fontflags textfont]
11212eval font create textfontbold [fontflags textfont 1]
11213
11214parsefont uifont $uifont
11215eval font create uifont [fontflags uifont]
17386066 11216
b039f0a6
PM
11217setoptions
11218
cdaee5db 11219# check that we can find a .git directory somewhere...
6c87d60c 11220if {[catch {set gitdir [gitdir]}]} {
d990cedf 11221 show_error {} . [mc "Cannot find a git repository here."]
6c87d60c
AR
11222 exit 1
11223}
cdaee5db 11224if {![file isdirectory $gitdir]} {
d990cedf 11225 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
cdaee5db
PM
11226 exit 1
11227}
11228
39816d60
AG
11229set selecthead {}
11230set selectheadid {}
11231
1d10f36d 11232set revtreeargs {}
cdaee5db
PM
11233set cmdline_files {}
11234set i 0
2d480856 11235set revtreeargscmd {}
1d10f36d 11236foreach arg $argv {
2d480856 11237 switch -glob -- $arg {
6ebedabf 11238 "" { }
cdaee5db
PM
11239 "--" {
11240 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11241 break
11242 }
39816d60
AG
11243 "--select-commit=*" {
11244 set selecthead [string range $arg 16 end]
11245 }
2d480856
YD
11246 "--argscmd=*" {
11247 set revtreeargscmd [string range $arg 10 end]
11248 }
1d10f36d
PM
11249 default {
11250 lappend revtreeargs $arg
11251 }
11252 }
cdaee5db 11253 incr i
1db95b00 11254}
1d10f36d 11255
39816d60
AG
11256if {$selecthead eq "HEAD"} {
11257 set selecthead {}
11258}
11259
cdaee5db 11260if {$i >= [llength $argv] && $revtreeargs ne {}} {
3ed31a81 11261 # no -- on command line, but some arguments (other than --argscmd)
098dd8a3 11262 if {[catch {
8974c6f9 11263 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
098dd8a3
PM
11264 set cmdline_files [split $f "\n"]
11265 set n [llength $cmdline_files]
11266 set revtreeargs [lrange $revtreeargs 0 end-$n]
cdaee5db
PM
11267 # Unfortunately git rev-parse doesn't produce an error when
11268 # something is both a revision and a filename. To be consistent
11269 # with git log and git rev-list, check revtreeargs for filenames.
11270 foreach arg $revtreeargs {
11271 if {[file exists $arg]} {
d990cedf
CS
11272 show_error {} . [mc "Ambiguous argument '%s': both revision\
11273 and filename" $arg]
cdaee5db
PM
11274 exit 1
11275 }
11276 }
098dd8a3
PM
11277 } err]} {
11278 # unfortunately we get both stdout and stderr in $err,
11279 # so look for "fatal:".
11280 set i [string first "fatal:" $err]
11281 if {$i > 0} {
b5e09633 11282 set err [string range $err [expr {$i + 6}] end]
098dd8a3 11283 }
d990cedf 11284 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
098dd8a3
PM
11285 exit 1
11286 }
11287}
11288
219ea3a9 11289set nullid "0000000000000000000000000000000000000000"
8f489363 11290set nullid2 "0000000000000000000000000000000000000001"
314f5de1 11291set nullfile "/dev/null"
8f489363 11292
32f1b3e4 11293set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
d93f1713
PT
11294if {![info exists use_ttk]} {
11295 set use_ttk [llength [info commands ::ttk::style]]
11296}
11297set NS [expr {$use_ttk ? "ttk" : ""}]
219ea3a9 11298
7eb3cb9c 11299set runq {}
d698206c
PM
11300set history {}
11301set historyindex 0
908c3585 11302set fh_serial 0
908c3585 11303set nhl_names {}
63b79191 11304set highlight_paths {}
687c8765 11305set findpattern {}
1902c270 11306set searchdirn -forwards
28593d3f
PM
11307set boldids {}
11308set boldnameids {}
a8d610a2 11309set diffelide {0 0}
4fb0fa19 11310set markingmatches 0
97645683 11311set linkentercount 0
0380081c
PM
11312set need_redisplay 0
11313set nrows_drawn 0
32f1b3e4 11314set firsttabstop 0
9f1afe05 11315
50b44ece
PM
11316set nextviewnum 1
11317set curview 0
a90a6d24 11318set selectedview 0
b007ee20
CS
11319set selectedhlview [mc "None"]
11320set highlight_related [mc "None"]
687c8765 11321set highlight_files {}
50b44ece 11322set viewfiles(0) {}
a90a6d24 11323set viewperm(0) 0
098dd8a3 11324set viewargs(0) {}
2d480856 11325set viewargscmd(0) {}
50b44ece 11326
94b4a69f 11327set selectedline {}
6df7403a 11328set numcommits 0
7fcc92bf 11329set loginstance 0
098dd8a3 11330set cmdlineok 0
1d10f36d 11331set stopped 0
0fba86b3 11332set stuffsaved 0
74daedb6 11333set patchnum 0
219ea3a9 11334set lserial 0
cb8329aa 11335set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
1d10f36d 11336setcoords
d94f8cd6 11337makewindow
37871b73
GB
11338catch {
11339 image create photo gitlogo -width 16 -height 16
11340
11341 image create photo gitlogominus -width 4 -height 2
11342 gitlogominus put #C00000 -to 0 0 4 2
11343 gitlogo copy gitlogominus -to 1 5
11344 gitlogo copy gitlogominus -to 6 5
11345 gitlogo copy gitlogominus -to 11 5
11346 image delete gitlogominus
11347
11348 image create photo gitlogoplus -width 4 -height 4
11349 gitlogoplus put #008000 -to 1 0 3 4
11350 gitlogoplus put #008000 -to 0 1 4 3
11351 gitlogo copy gitlogoplus -to 1 9
11352 gitlogo copy gitlogoplus -to 6 9
11353 gitlogo copy gitlogoplus -to 11 9
11354 image delete gitlogoplus
11355
d38d7d49
SB
11356 image create photo gitlogo32 -width 32 -height 32
11357 gitlogo32 copy gitlogo -zoom 2 2
11358
11359 wm iconphoto . -default gitlogo gitlogo32
37871b73 11360}
0eafba14
PM
11361# wait for the window to become visible
11362tkwait visibility .
6c283328 11363wm title . "[file tail $argv0]: [file tail [pwd]]"
478afad6 11364update
887fe3c4 11365readrefs
a8aaf19c 11366
2d480856 11367if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
50b44ece
PM
11368 # create a view for the files/dirs specified on the command line
11369 set curview 1
a90a6d24 11370 set selectedview 1
50b44ece 11371 set nextviewnum 2
d990cedf 11372 set viewname(1) [mc "Command line"]
50b44ece 11373 set viewfiles(1) $cmdline_files
098dd8a3 11374 set viewargs(1) $revtreeargs
2d480856 11375 set viewargscmd(1) $revtreeargscmd
a90a6d24 11376 set viewperm(1) 0
3ed31a81 11377 set vdatemode(1) 0
da7c24dd 11378 addviewmenu 1
f2d0bbbd
PM
11379 .bar.view entryconf [mca "Edit view..."] -state normal
11380 .bar.view entryconf [mca "Delete view"] -state normal
50b44ece 11381}
a90a6d24
PM
11382
11383if {[info exists permviews]} {
11384 foreach v $permviews {
11385 set n $nextviewnum
11386 incr nextviewnum
11387 set viewname($n) [lindex $v 0]
11388 set viewfiles($n) [lindex $v 1]
098dd8a3 11389 set viewargs($n) [lindex $v 2]
2d480856 11390 set viewargscmd($n) [lindex $v 3]
a90a6d24 11391 set viewperm($n) 1
da7c24dd 11392 addviewmenu $n
a90a6d24
PM
11393 }
11394}
e4df519f
JS
11395
11396if {[tk windowingsystem] eq "win32"} {
11397 focus -force .
11398}
11399
567c34e0 11400getcommits {}