]> git.ipfire.org Git - thirdparty/git.git/blame - gitk-git/gitk
Start the 2.46 cycle
[thirdparty/git.git] / gitk-git / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
9e026d39 3exec wish "$0" -- "$@"
1db95b00 4
fbf42647 5# Copyright © 2005-2016 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
74cb884f
MZ
12proc hasworktree {} {
13 return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
e244588e 14 [exec git rev-parse --is-inside-git-dir] == "false"}]
74cb884f
MZ
15}
16
3878e636
ZJS
17proc reponame {} {
18 global gitdir
19 set n [file normalize $gitdir]
20 if {[string match "*/.git" $n]} {
e244588e 21 set n [string range $n 0 end-5]
3878e636
ZJS
22 }
23 return [file tail $n]
24}
25
65bb0bda
PT
26proc gitworktree {} {
27 variable _gitworktree
28 if {[info exists _gitworktree]} {
e244588e 29 return $_gitworktree
65bb0bda
PT
30 }
31 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
32 if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
33 # try to set work tree from environment, core.worktree or use
34 # cdup to obtain a relative path to the top of the worktree. If
35 # run from the top, the ./ prefix ensures normalize expands pwd.
36 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
e244588e
DL
37 if {[catch {set _gitworktree [exec git config --get core.worktree]}]} {
38 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
39 }
65bb0bda
PT
40 }
41 }
42 return $_gitworktree
43}
44
7eb3cb9c
PM
45# A simple scheduler for compute-intensive stuff.
46# The aim is to make sure that event handlers for GUI actions can
47# run at least every 50-100 ms. Unfortunately fileevent handlers are
48# run before X event handlers, so reading from a fast source can
49# make the GUI completely unresponsive.
50proc run args {
df75e86d 51 global isonrunq runq currunq
7eb3cb9c
PM
52
53 set script $args
54 if {[info exists isonrunq($script)]} return
df75e86d 55 if {$runq eq {} && ![info exists currunq]} {
e244588e 56 after idle dorunq
7eb3cb9c
PM
57 }
58 lappend runq [list {} $script]
59 set isonrunq($script) 1
60}
61
62proc filerun {fd script} {
63 fileevent $fd readable [list filereadable $fd $script]
64}
65
66proc filereadable {fd script} {
df75e86d 67 global runq currunq
7eb3cb9c
PM
68
69 fileevent $fd readable {}
df75e86d 70 if {$runq eq {} && ![info exists currunq]} {
e244588e 71 after idle dorunq
7eb3cb9c
PM
72 }
73 lappend runq [list $fd $script]
74}
75
7fcc92bf
PM
76proc nukefile {fd} {
77 global runq
78
79 for {set i 0} {$i < [llength $runq]} {} {
e244588e
DL
80 if {[lindex $runq $i 0] eq $fd} {
81 set runq [lreplace $runq $i $i]
82 } else {
83 incr i
84 }
7fcc92bf
PM
85 }
86}
87
7eb3cb9c 88proc dorunq {} {
df75e86d 89 global isonrunq runq currunq
7eb3cb9c
PM
90
91 set tstart [clock clicks -milliseconds]
92 set t0 $tstart
7fcc92bf 93 while {[llength $runq] > 0} {
e244588e
DL
94 set fd [lindex $runq 0 0]
95 set script [lindex $runq 0 1]
96 set currunq [lindex $runq 0]
97 set runq [lrange $runq 1 end]
98 set repeat [eval $script]
99 unset currunq
100 set t1 [clock clicks -milliseconds]
101 set t [expr {$t1 - $t0}]
102 if {$repeat ne {} && $repeat} {
103 if {$fd eq {} || $repeat == 2} {
104 # script returns 1 if it wants to be readded
105 # file readers return 2 if they could do more straight away
106 lappend runq [list $fd $script]
107 } else {
108 fileevent $fd readable [list filereadable $fd $script]
109 }
110 } elseif {$fd eq {}} {
111 unset isonrunq($script)
112 }
113 set t0 $t1
114 if {$t1 - $tstart >= 80} break
7eb3cb9c
PM
115 }
116 if {$runq ne {}} {
e244588e 117 after idle dorunq
7eb3cb9c
PM
118 }
119}
120
e439e092
AG
121proc reg_instance {fd} {
122 global commfd leftover loginstance
123
124 set i [incr loginstance]
125 set commfd($i) $fd
126 set leftover($i) {}
127 return $i
128}
129
3ed31a81
PM
130proc unmerged_files {files} {
131 global nr_unmerged
132
133 # find the list of unmerged files
134 set mlist {}
135 set nr_unmerged 0
136 if {[catch {
e244588e 137 set fd [open "| git ls-files -u" r]
3ed31a81 138 } err]} {
e244588e
DL
139 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
140 exit 1
3ed31a81
PM
141 }
142 while {[gets $fd line] >= 0} {
e244588e
DL
143 set i [string first "\t" $line]
144 if {$i < 0} continue
145 set fname [string range $line [expr {$i+1}] end]
146 if {[lsearch -exact $mlist $fname] >= 0} continue
147 incr nr_unmerged
148 if {$files eq {} || [path_filter $files $fname]} {
149 lappend mlist $fname
150 }
3ed31a81
PM
151 }
152 catch {close $fd}
153 return $mlist
154}
155
156proc parseviewargs {n arglist} {
c2f2dab9 157 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
9403bd02 158 global vinlinediff
ae4e3ff9 159 global worddiff git_version
3ed31a81
PM
160
161 set vdatemode($n) 0
162 set vmergeonly($n) 0
9403bd02 163 set vinlinediff($n) 0
ee66e089
PM
164 set glflags {}
165 set diffargs {}
166 set nextisval 0
167 set revargs {}
168 set origargs $arglist
169 set allknown 1
170 set filtered 0
171 set i -1
172 foreach arg $arglist {
e244588e
DL
173 incr i
174 if {$nextisval} {
175 lappend glflags $arg
176 set nextisval 0
177 continue
178 }
179 switch -glob -- $arg {
180 "-d" -
181 "--date-order" {
182 set vdatemode($n) 1
183 # remove from origargs in case we hit an unknown option
184 set origargs [lreplace $origargs $i $i]
185 incr i -1
186 }
187 "-[puabwcrRBMC]" -
188 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
189 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
190 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
191 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
192 "--ignore-space-change" - "-U*" - "--unified=*" {
193 # These request or affect diff output, which we don't want.
194 # Some could be used to set our defaults for diff display.
195 lappend diffargs $arg
196 }
197 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
198 "--name-only" - "--name-status" - "--color" -
199 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
200 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
201 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
202 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
203 "--objects" - "--objects-edge" - "--reverse" {
204 # These cause our parsing of git log's output to fail, or else
205 # they're options we want to set ourselves, so ignore them.
206 }
207 "--color-words*" - "--word-diff=color" {
208 # These trigger a word diff in the console interface,
209 # so help the user by enabling our own support
210 if {[package vcompare $git_version "1.7.2"] >= 0} {
211 set worddiff [mc "Color words"]
212 }
213 }
214 "--word-diff*" {
215 if {[package vcompare $git_version "1.7.2"] >= 0} {
216 set worddiff [mc "Markup words"]
217 }
218 }
219 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
220 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
221 "--full-history" - "--dense" - "--sparse" -
222 "--follow" - "--left-right" - "--encoding=*" {
223 # These are harmless, and some are even useful
224 lappend glflags $arg
225 }
226 "--diff-filter=*" - "--no-merges" - "--unpacked" -
227 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
228 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
229 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
230 "--remove-empty" - "--first-parent" - "--cherry-pick" -
231 "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
232 "--simplify-by-decoration" {
233 # These mean that we get a subset of the commits
234 set filtered 1
235 lappend glflags $arg
236 }
237 "-L*" {
238 # Line-log with 'stuck' argument (unstuck form is
239 # not supported)
240 set filtered 1
241 set vinlinediff($n) 1
242 set allknown 0
243 lappend glflags $arg
244 }
245 "-n" {
246 # This appears to be the only one that has a value as a
247 # separate word following it
248 set filtered 1
249 set nextisval 1
250 lappend glflags $arg
251 }
252 "--not" - "--all" {
253 lappend revargs $arg
254 }
255 "--merge" {
256 set vmergeonly($n) 1
257 # git rev-parse doesn't understand --merge
258 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
259 }
260 "--no-replace-objects" {
261 set env(GIT_NO_REPLACE_OBJECTS) "1"
262 }
263 "-*" {
264 # Other flag arguments including -<n>
265 if {[string is digit -strict [string range $arg 1 end]]} {
266 set filtered 1
267 } else {
268 # a flag argument that we don't recognize;
269 # that means we can't optimize
270 set allknown 0
271 }
272 lappend glflags $arg
273 }
274 default {
275 # Non-flag arguments specify commits or ranges of commits
276 if {[string match "*...*" $arg]} {
277 lappend revargs --gitk-symmetric-diff-marker
278 }
279 lappend revargs $arg
280 }
281 }
ee66e089
PM
282 }
283 set vdflags($n) $diffargs
284 set vflags($n) $glflags
285 set vrevs($n) $revargs
286 set vfiltered($n) $filtered
287 set vorigargs($n) $origargs
288 return $allknown
289}
290
291proc parseviewrevs {view revs} {
292 global vposids vnegids
293
294 if {$revs eq {}} {
e244588e 295 set revs HEAD
4d5e1b13 296 } elseif {[lsearch -exact $revs --all] >= 0} {
e244588e 297 lappend revs HEAD
ee66e089
PM
298 }
299 if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
e244588e
DL
300 # we get stdout followed by stderr in $err
301 # for an unknown rev, git rev-parse echoes it and then errors out
302 set errlines [split $err "\n"]
303 set badrev {}
304 for {set l 0} {$l < [llength $errlines]} {incr l} {
305 set line [lindex $errlines $l]
306 if {!([string length $line] == 40 && [string is xdigit $line])} {
307 if {[string match "fatal:*" $line]} {
308 if {[string match "fatal: ambiguous argument*" $line]
309 && $badrev ne {}} {
310 if {[llength $badrev] == 1} {
311 set err "unknown revision $badrev"
312 } else {
313 set err "unknown revisions: [join $badrev ", "]"
314 }
315 } else {
316 set err [join [lrange $errlines $l end] "\n"]
317 }
318 break
319 }
320 lappend badrev $line
321 }
322 }
323 error_popup "[mc "Error parsing revisions:"] $err"
324 return {}
ee66e089
PM
325 }
326 set ret {}
327 set pos {}
328 set neg {}
329 set sdm 0
330 foreach id [split $ids "\n"] {
e244588e
DL
331 if {$id eq "--gitk-symmetric-diff-marker"} {
332 set sdm 4
333 } elseif {[string match "^*" $id]} {
334 if {$sdm != 1} {
335 lappend ret $id
336 if {$sdm == 3} {
337 set sdm 0
338 }
339 }
340 lappend neg [string range $id 1 end]
341 } else {
342 if {$sdm != 2} {
343 lappend ret $id
344 } else {
345 lset ret end $id...[lindex $ret end]
346 }
347 lappend pos $id
348 }
349 incr sdm -1
3ed31a81 350 }
ee66e089
PM
351 set vposids($view) $pos
352 set vnegids($view) $neg
353 return $ret
3ed31a81
PM
354}
355
7dd272ec
NR
356# Escapes a list of filter paths to be passed to git log via stdin. Note that
357# paths must not be quoted.
358proc escape_filter_paths {paths} {
359 set escaped [list]
360 foreach path $paths {
361 lappend escaped [string map {\\ \\\\ "\ " "\\\ "} $path]
362 }
363 return $escaped
364}
365
f9e0b6fb 366# Start off a git log process and arrange to read its output
da7c24dd 367proc start_rev_list {view} {
6df7403a 368 global startmsecs commitidx viewcomplete curview
e439e092 369 global tclencoding
ee66e089 370 global viewargs viewargscmd viewfiles vfilelimit
d375ef9b 371 global showlocalchanges
e439e092 372 global viewactive viewinstances vmergeonly
cdc8429c 373 global mainheadid viewmainheadid viewmainheadid_orig
ee66e089 374 global vcanopt vflags vrevs vorigargs
7defefb1 375 global show_notes
9ccbdfbf 376
9ccbdfbf 377 set startmsecs [clock clicks -milliseconds]
da7c24dd 378 set commitidx($view) 0
3ed31a81
PM
379 # these are set this way for the error exits
380 set viewcomplete($view) 1
381 set viewactive($view) 0
7fcc92bf
PM
382 varcinit $view
383
2d480856
YD
384 set args $viewargs($view)
385 if {$viewargscmd($view) ne {}} {
e244588e
DL
386 if {[catch {
387 set str [exec sh -c $viewargscmd($view)]
388 } err]} {
389 error_popup "[mc "Error executing --argscmd command:"] $err"
390 return 0
391 }
392 set args [concat $args [split $str "\n"]]
2d480856 393 }
ee66e089 394 set vcanopt($view) [parseviewargs $view $args]
3ed31a81
PM
395
396 set files $viewfiles($view)
397 if {$vmergeonly($view)} {
e244588e
DL
398 set files [unmerged_files $files]
399 if {$files eq {}} {
400 global nr_unmerged
401 if {$nr_unmerged == 0} {
402 error_popup [mc "No files selected: --merge specified but\
403 no files are unmerged."]
404 } else {
405 error_popup [mc "No files selected: --merge specified but\
406 no unmerged files are within file limit."]
407 }
408 return 0
409 }
3ed31a81
PM
410 }
411 set vfilelimit($view) $files
412
ee66e089 413 if {$vcanopt($view)} {
e244588e
DL
414 set revs [parseviewrevs $view $vrevs($view)]
415 if {$revs eq {}} {
416 return 0
417 }
bb5cb23d 418 set args $vflags($view)
ee66e089 419 } else {
bb5cb23d 420 set revs {}
e244588e 421 set args $vorigargs($view)
ee66e089
PM
422 }
423
418c4c7b 424 if {[catch {
e244588e 425 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
bb5cb23d 426 --parents --boundary $args --stdin \
7dd272ec
NR
427 "<<[join [concat $revs "--" \
428 [escape_filter_paths $files]] "\\n"]"] r]
418c4c7b 429 } err]} {
e244588e
DL
430 error_popup "[mc "Error executing git log:"] $err"
431 return 0
1d10f36d 432 }
e439e092 433 set i [reg_instance $fd]
7fcc92bf 434 set viewinstances($view) [list $i]
cdc8429c
PM
435 set viewmainheadid($view) $mainheadid
436 set viewmainheadid_orig($view) $mainheadid
437 if {$files ne {} && $mainheadid ne {}} {
e244588e 438 get_viewmainhead $view
cdc8429c
PM
439 }
440 if {$showlocalchanges && $viewmainheadid($view) ne {}} {
e244588e 441 interestedin $viewmainheadid($view) dodiffindex
3e6b893f 442 }
86da5b6c 443 fconfigure $fd -blocking 0 -translation lf -eofchar {}
fd8ccbec 444 if {$tclencoding != {}} {
e244588e 445 fconfigure $fd -encoding $tclencoding
fd8ccbec 446 }
f806f0fb 447 filerun $fd [list getcommitlines $fd $i $view 0]
d990cedf 448 nowbusy $view [mc "Reading"]
3ed31a81
PM
449 set viewcomplete($view) 0
450 set viewactive($view) 1
451 return 1
38ad0910
PM
452}
453
e2f90ee4
AG
454proc stop_instance {inst} {
455 global commfd leftover
456
457 set fd $commfd($inst)
458 catch {
e244588e 459 set pid [pid $fd]
b6326e92 460
e244588e
DL
461 if {$::tcl_platform(platform) eq {windows}} {
462 exec taskkill /pid $pid
463 } else {
464 exec kill $pid
465 }
e2f90ee4
AG
466 }
467 catch {close $fd}
468 nukefile $fd
469 unset commfd($inst)
470 unset leftover($inst)
471}
472
473proc stop_backends {} {
474 global commfd
475
476 foreach inst [array names commfd] {
e244588e 477 stop_instance $inst
e2f90ee4
AG
478 }
479}
480
7fcc92bf 481proc stop_rev_list {view} {
e2f90ee4 482 global viewinstances
22626ef4 483
7fcc92bf 484 foreach inst $viewinstances($view) {
e244588e 485 stop_instance $inst
22626ef4 486 }
7fcc92bf 487 set viewinstances($view) {}
22626ef4
PM
488}
489
567c34e0 490proc reset_pending_select {selid} {
39816d60 491 global pending_select mainheadid selectheadid
567c34e0
AG
492
493 if {$selid ne {}} {
e244588e 494 set pending_select $selid
39816d60 495 } elseif {$selectheadid ne {}} {
e244588e 496 set pending_select $selectheadid
567c34e0 497 } else {
e244588e 498 set pending_select $mainheadid
567c34e0
AG
499 }
500}
501
502proc getcommits {selid} {
3ed31a81 503 global canv curview need_redisplay viewactive
38ad0910 504
da7c24dd 505 initlayout
3ed31a81 506 if {[start_rev_list $curview]} {
e244588e
DL
507 reset_pending_select $selid
508 show_status [mc "Reading commits..."]
509 set need_redisplay 1
3ed31a81 510 } else {
e244588e 511 show_status [mc "No commits selected"]
3ed31a81 512 }
1d10f36d
PM
513}
514
7fcc92bf 515proc updatecommits {} {
ee66e089 516 global curview vcanopt vorigargs vfilelimit viewinstances
e439e092
AG
517 global viewactive viewcomplete tclencoding
518 global startmsecs showneartags showlocalchanges
cdc8429c 519 global mainheadid viewmainheadid viewmainheadid_orig pending_select
74cb884f 520 global hasworktree
ee66e089 521 global varcid vposids vnegids vflags vrevs
7defefb1 522 global show_notes
7fcc92bf 523
74cb884f 524 set hasworktree [hasworktree]
fc2a256f 525 rereadrefs
cdc8429c
PM
526 set view $curview
527 if {$mainheadid ne $viewmainheadid_orig($view)} {
e244588e
DL
528 if {$showlocalchanges} {
529 dohidelocalchanges
530 }
531 set viewmainheadid($view) $mainheadid
532 set viewmainheadid_orig($view) $mainheadid
533 if {$vfilelimit($view) ne {}} {
534 get_viewmainhead $view
535 }
eb5f8c9c 536 }
cdc8429c 537 if {$showlocalchanges} {
e244588e 538 doshowlocalchanges
cdc8429c 539 }
ee66e089 540 if {$vcanopt($view)} {
e244588e
DL
541 set oldpos $vposids($view)
542 set oldneg $vnegids($view)
543 set revs [parseviewrevs $view $vrevs($view)]
544 if {$revs eq {}} {
545 return
546 }
547 # note: getting the delta when negative refs change is hard,
548 # and could require multiple git log invocations, so in that
549 # case we ask git log for all the commits (not just the delta)
550 if {$oldneg eq $vnegids($view)} {
551 set newrevs {}
552 set npos 0
553 # take out positive refs that we asked for before or
554 # that we have already seen
555 foreach rev $revs {
556 if {[string length $rev] == 40} {
557 if {[lsearch -exact $oldpos $rev] < 0
558 && ![info exists varcid($view,$rev)]} {
559 lappend newrevs $rev
560 incr npos
561 }
562 } else {
563 lappend $newrevs $rev
564 }
565 }
566 if {$npos == 0} return
567 set revs $newrevs
568 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
569 }
bb5cb23d
JS
570 set args $vflags($view)
571 foreach r $oldpos {
572 lappend revs "^$r"
573 }
ee66e089 574 } else {
bb5cb23d 575 set revs {}
e244588e 576 set args $vorigargs($view)
ee66e089 577 }
7fcc92bf 578 if {[catch {
e244588e 579 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
bb5cb23d
JS
580 --parents --boundary $args --stdin \
581 "<<[join [concat $revs "--" \
7dd272ec
NR
582 [escape_filter_paths \
583 $vfilelimit($view)]] "\\n"]"] r]
7fcc92bf 584 } err]} {
e244588e
DL
585 error_popup "[mc "Error executing git log:"] $err"
586 return
7fcc92bf
PM
587 }
588 if {$viewactive($view) == 0} {
e244588e 589 set startmsecs [clock clicks -milliseconds]
7fcc92bf 590 }
e439e092 591 set i [reg_instance $fd]
7fcc92bf 592 lappend viewinstances($view) $i
7fcc92bf
PM
593 fconfigure $fd -blocking 0 -translation lf -eofchar {}
594 if {$tclencoding != {}} {
e244588e 595 fconfigure $fd -encoding $tclencoding
7fcc92bf 596 }
f806f0fb 597 filerun $fd [list getcommitlines $fd $i $view 1]
7fcc92bf
PM
598 incr viewactive($view)
599 set viewcomplete($view) 0
567c34e0 600 reset_pending_select {}
b56e0a9a 601 nowbusy $view [mc "Reading"]
7fcc92bf 602 if {$showneartags} {
e244588e 603 getallcommits
7fcc92bf
PM
604 }
605}
606
607proc reloadcommits {} {
608 global curview viewcomplete selectedline currentid thickerline
609 global showneartags treediffs commitinterest cached_commitrow
18ae9120 610 global targetid commitinfo
7fcc92bf 611
567c34e0
AG
612 set selid {}
613 if {$selectedline ne {}} {
e244588e 614 set selid $currentid
567c34e0
AG
615 }
616
7fcc92bf 617 if {!$viewcomplete($curview)} {
e244588e 618 stop_rev_list $curview
7fcc92bf
PM
619 }
620 resetvarcs $curview
94b4a69f 621 set selectedline {}
009409fe
PM
622 unset -nocomplain currentid
623 unset -nocomplain thickerline
624 unset -nocomplain treediffs
7fcc92bf
PM
625 readrefs
626 changedrefs
627 if {$showneartags} {
e244588e 628 getallcommits
7fcc92bf
PM
629 }
630 clear_display
18ae9120 631 unset -nocomplain commitinfo
009409fe
PM
632 unset -nocomplain commitinterest
633 unset -nocomplain cached_commitrow
634 unset -nocomplain targetid
7fcc92bf 635 setcanvscroll
567c34e0 636 getcommits $selid
e7297a1c 637 return 0
7fcc92bf
PM
638}
639
6e8c8707
PM
640# This makes a string representation of a positive integer which
641# sorts as a string in numerical order
642proc strrep {n} {
643 if {$n < 16} {
e244588e 644 return [format "%x" $n]
6e8c8707 645 } elseif {$n < 256} {
e244588e 646 return [format "x%.2x" $n]
6e8c8707 647 } elseif {$n < 65536} {
e244588e 648 return [format "y%.4x" $n]
6e8c8707
PM
649 }
650 return [format "z%.8x" $n]
651}
652
7fcc92bf
PM
653# Procedures used in reordering commits from git log (without
654# --topo-order) into the order for display.
655
656proc varcinit {view} {
f3ea5ede
PM
657 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
658 global vtokmod varcmod vrowmod varcix vlastins
7fcc92bf 659
7fcc92bf
PM
660 set varcstart($view) {{}}
661 set vupptr($view) {0}
662 set vdownptr($view) {0}
663 set vleftptr($view) {0}
f3ea5ede 664 set vbackptr($view) {0}
7fcc92bf
PM
665 set varctok($view) {{}}
666 set varcrow($view) {{}}
667 set vtokmod($view) {}
668 set varcmod($view) 0
e5b37ac1 669 set vrowmod($view) 0
7fcc92bf 670 set varcix($view) {{}}
f3ea5ede 671 set vlastins($view) {0}
7fcc92bf
PM
672}
673
674proc resetvarcs {view} {
675 global varcid varccommits parents children vseedcount ordertok
22387f23 676 global vshortids
7fcc92bf
PM
677
678 foreach vid [array names varcid $view,*] {
e244588e
DL
679 unset varcid($vid)
680 unset children($vid)
681 unset parents($vid)
7fcc92bf 682 }
22387f23 683 foreach vid [array names vshortids $view,*] {
e244588e 684 unset vshortids($vid)
22387f23 685 }
7fcc92bf
PM
686 # some commits might have children but haven't been seen yet
687 foreach vid [array names children $view,*] {
e244588e 688 unset children($vid)
7fcc92bf
PM
689 }
690 foreach va [array names varccommits $view,*] {
e244588e 691 unset varccommits($va)
7fcc92bf
PM
692 }
693 foreach vd [array names vseedcount $view,*] {
e244588e 694 unset vseedcount($vd)
7fcc92bf 695 }
009409fe 696 unset -nocomplain ordertok
7fcc92bf
PM
697}
698
468bcaed
PM
699# returns a list of the commits with no children
700proc seeds {v} {
701 global vdownptr vleftptr varcstart
702
703 set ret {}
704 set a [lindex $vdownptr($v) 0]
705 while {$a != 0} {
e244588e
DL
706 lappend ret [lindex $varcstart($v) $a]
707 set a [lindex $vleftptr($v) $a]
468bcaed
PM
708 }
709 return $ret
710}
711
7fcc92bf 712proc newvarc {view id} {
3ed31a81 713 global varcid varctok parents children vdatemode
f3ea5ede
PM
714 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
715 global commitdata commitinfo vseedcount varccommits vlastins
7fcc92bf
PM
716
717 set a [llength $varctok($view)]
718 set vid $view,$id
3ed31a81 719 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
e244588e
DL
720 if {![info exists commitinfo($id)]} {
721 parsecommit $id $commitdata($id) 1
722 }
723 set cdate [lindex [lindex $commitinfo($id) 4] 0]
724 if {![string is integer -strict $cdate]} {
725 set cdate 0
726 }
727 if {![info exists vseedcount($view,$cdate)]} {
728 set vseedcount($view,$cdate) -1
729 }
730 set c [incr vseedcount($view,$cdate)]
731 set cdate [expr {$cdate ^ 0xffffffff}]
732 set tok "s[strrep $cdate][strrep $c]"
7fcc92bf 733 } else {
e244588e 734 set tok {}
f3ea5ede
PM
735 }
736 set ka 0
737 if {[llength $children($vid)] > 0} {
e244588e
DL
738 set kid [lindex $children($vid) end]
739 set k $varcid($view,$kid)
740 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
741 set ki $kid
742 set ka $k
743 set tok [lindex $varctok($view) $k]
744 }
f3ea5ede
PM
745 }
746 if {$ka != 0} {
e244588e
DL
747 set i [lsearch -exact $parents($view,$ki) $id]
748 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
749 append tok [strrep $j]
7fcc92bf 750 }
f3ea5ede
PM
751 set c [lindex $vlastins($view) $ka]
752 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
e244588e
DL
753 set c $ka
754 set b [lindex $vdownptr($view) $ka]
f3ea5ede 755 } else {
e244588e 756 set b [lindex $vleftptr($view) $c]
f3ea5ede
PM
757 }
758 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
e244588e
DL
759 set c $b
760 set b [lindex $vleftptr($view) $c]
f3ea5ede
PM
761 }
762 if {$c == $ka} {
e244588e
DL
763 lset vdownptr($view) $ka $a
764 lappend vbackptr($view) 0
f3ea5ede 765 } else {
e244588e
DL
766 lset vleftptr($view) $c $a
767 lappend vbackptr($view) $c
f3ea5ede
PM
768 }
769 lset vlastins($view) $ka $a
770 lappend vupptr($view) $ka
771 lappend vleftptr($view) $b
772 if {$b != 0} {
e244588e 773 lset vbackptr($view) $b $a
f3ea5ede 774 }
7fcc92bf
PM
775 lappend varctok($view) $tok
776 lappend varcstart($view) $id
777 lappend vdownptr($view) 0
778 lappend varcrow($view) {}
779 lappend varcix($view) {}
e5b37ac1 780 set varccommits($view,$a) {}
f3ea5ede 781 lappend vlastins($view) 0
7fcc92bf
PM
782 return $a
783}
784
785proc splitvarc {p v} {
52b8ea93 786 global varcid varcstart varccommits varctok vtokmod
f3ea5ede 787 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
7fcc92bf
PM
788
789 set oa $varcid($v,$p)
52b8ea93 790 set otok [lindex $varctok($v) $oa]
7fcc92bf
PM
791 set ac $varccommits($v,$oa)
792 set i [lsearch -exact $varccommits($v,$oa) $p]
793 if {$i <= 0} return
794 set na [llength $varctok($v)]
795 # "%" sorts before "0"...
52b8ea93 796 set tok "$otok%[strrep $i]"
7fcc92bf
PM
797 lappend varctok($v) $tok
798 lappend varcrow($v) {}
799 lappend varcix($v) {}
800 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
801 set varccommits($v,$na) [lrange $ac $i end]
802 lappend varcstart($v) $p
803 foreach id $varccommits($v,$na) {
e244588e 804 set varcid($v,$id) $na
7fcc92bf
PM
805 }
806 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
841ea824 807 lappend vlastins($v) [lindex $vlastins($v) $oa]
7fcc92bf 808 lset vdownptr($v) $oa $na
841ea824 809 lset vlastins($v) $oa 0
7fcc92bf
PM
810 lappend vupptr($v) $oa
811 lappend vleftptr($v) 0
f3ea5ede 812 lappend vbackptr($v) 0
7fcc92bf 813 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
e244588e 814 lset vupptr($v) $b $na
7fcc92bf 815 }
52b8ea93 816 if {[string compare $otok $vtokmod($v)] <= 0} {
e244588e 817 modify_arc $v $oa
52b8ea93 818 }
7fcc92bf
PM
819}
820
821proc renumbervarc {a v} {
822 global parents children varctok varcstart varccommits
3ed31a81 823 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
7fcc92bf
PM
824
825 set t1 [clock clicks -milliseconds]
826 set todo {}
827 set isrelated($a) 1
f3ea5ede 828 set kidchanged($a) 1
7fcc92bf
PM
829 set ntot 0
830 while {$a != 0} {
e244588e
DL
831 if {[info exists isrelated($a)]} {
832 lappend todo $a
833 set id [lindex $varccommits($v,$a) end]
834 foreach p $parents($v,$id) {
835 if {[info exists varcid($v,$p)]} {
836 set isrelated($varcid($v,$p)) 1
837 }
838 }
839 }
840 incr ntot
841 set b [lindex $vdownptr($v) $a]
842 if {$b == 0} {
843 while {$a != 0} {
844 set b [lindex $vleftptr($v) $a]
845 if {$b != 0} break
846 set a [lindex $vupptr($v) $a]
847 }
848 }
849 set a $b
7fcc92bf
PM
850 }
851 foreach a $todo {
e244588e
DL
852 if {![info exists kidchanged($a)]} continue
853 set id [lindex $varcstart($v) $a]
854 if {[llength $children($v,$id)] > 1} {
855 set children($v,$id) [lsort -command [list vtokcmp $v] \
856 $children($v,$id)]
857 }
858 set oldtok [lindex $varctok($v) $a]
859 if {!$vdatemode($v)} {
860 set tok {}
861 } else {
862 set tok $oldtok
863 }
864 set ka 0
865 set kid [last_real_child $v,$id]
866 if {$kid ne {}} {
867 set k $varcid($v,$kid)
868 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
869 set ki $kid
870 set ka $k
871 set tok [lindex $varctok($v) $k]
872 }
873 }
874 if {$ka != 0} {
875 set i [lsearch -exact $parents($v,$ki) $id]
876 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
877 append tok [strrep $j]
878 }
879 if {$tok eq $oldtok} {
880 continue
881 }
882 set id [lindex $varccommits($v,$a) end]
883 foreach p $parents($v,$id) {
884 if {[info exists varcid($v,$p)]} {
885 set kidchanged($varcid($v,$p)) 1
886 } else {
887 set sortkids($p) 1
888 }
889 }
890 lset varctok($v) $a $tok
891 set b [lindex $vupptr($v) $a]
892 if {$b != $ka} {
893 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
894 modify_arc $v $ka
895 }
896 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
897 modify_arc $v $b
898 }
899 set c [lindex $vbackptr($v) $a]
900 set d [lindex $vleftptr($v) $a]
901 if {$c == 0} {
902 lset vdownptr($v) $b $d
903 } else {
904 lset vleftptr($v) $c $d
905 }
906 if {$d != 0} {
907 lset vbackptr($v) $d $c
908 }
909 if {[lindex $vlastins($v) $b] == $a} {
910 lset vlastins($v) $b $c
911 }
912 lset vupptr($v) $a $ka
913 set c [lindex $vlastins($v) $ka]
914 if {$c == 0 || \
915 [string compare $tok [lindex $varctok($v) $c]] < 0} {
916 set c $ka
917 set b [lindex $vdownptr($v) $ka]
918 } else {
919 set b [lindex $vleftptr($v) $c]
920 }
921 while {$b != 0 && \
922 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
923 set c $b
924 set b [lindex $vleftptr($v) $c]
925 }
926 if {$c == $ka} {
927 lset vdownptr($v) $ka $a
928 lset vbackptr($v) $a 0
929 } else {
930 lset vleftptr($v) $c $a
931 lset vbackptr($v) $a $c
932 }
933 lset vleftptr($v) $a $b
934 if {$b != 0} {
935 lset vbackptr($v) $b $a
936 }
937 lset vlastins($v) $ka $a
938 }
f3ea5ede
PM
939 }
940 foreach id [array names sortkids] {
e244588e
DL
941 if {[llength $children($v,$id)] > 1} {
942 set children($v,$id) [lsort -command [list vtokcmp $v] \
943 $children($v,$id)]
944 }
7fcc92bf
PM
945 }
946 set t2 [clock clicks -milliseconds]
947 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
948}
949
f806f0fb
PM
950# Fix up the graph after we have found out that in view $v,
951# $p (a commit that we have already seen) is actually the parent
952# of the last commit in arc $a.
7fcc92bf 953proc fix_reversal {p a v} {
24f7a667 954 global varcid varcstart varctok vupptr
7fcc92bf
PM
955
956 set pa $varcid($v,$p)
957 if {$p ne [lindex $varcstart($v) $pa]} {
e244588e
DL
958 splitvarc $p $v
959 set pa $varcid($v,$p)
7fcc92bf 960 }
24f7a667
PM
961 # seeds always need to be renumbered
962 if {[lindex $vupptr($v) $pa] == 0 ||
e244588e
DL
963 [string compare [lindex $varctok($v) $a] \
964 [lindex $varctok($v) $pa]] > 0} {
965 renumbervarc $pa $v
7fcc92bf
PM
966 }
967}
968
969proc insertrow {id p v} {
b8a938cf
PM
970 global cmitlisted children parents varcid varctok vtokmod
971 global varccommits ordertok commitidx numcommits curview
22387f23 972 global targetid targetrow vshortids
b8a938cf
PM
973
974 readcommit $id
975 set vid $v,$id
976 set cmitlisted($vid) 1
977 set children($vid) {}
978 set parents($vid) [list $p]
979 set a [newvarc $v $id]
980 set varcid($vid) $a
22387f23 981 lappend vshortids($v,[string range $id 0 3]) $id
b8a938cf 982 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
e244588e 983 modify_arc $v $a
b8a938cf
PM
984 }
985 lappend varccommits($v,$a) $id
986 set vp $v,$p
987 if {[llength [lappend children($vp) $id]] > 1} {
e244588e
DL
988 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
989 unset -nocomplain ordertok
b8a938cf
PM
990 }
991 fix_reversal $p $a $v
992 incr commitidx($v)
993 if {$v == $curview} {
e244588e
DL
994 set numcommits $commitidx($v)
995 setcanvscroll
996 if {[info exists targetid]} {
997 if {![comes_before $targetid $p]} {
998 incr targetrow
999 }
1000 }
b8a938cf
PM
1001 }
1002}
1003
1004proc insertfakerow {id p} {
9257d8f7 1005 global varcid varccommits parents children cmitlisted
b8a938cf 1006 global commitidx varctok vtokmod targetid targetrow curview numcommits
7fcc92bf 1007
b8a938cf 1008 set v $curview
7fcc92bf
PM
1009 set a $varcid($v,$p)
1010 set i [lsearch -exact $varccommits($v,$a) $p]
1011 if {$i < 0} {
e244588e
DL
1012 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
1013 return
7fcc92bf
PM
1014 }
1015 set children($v,$id) {}
1016 set parents($v,$id) [list $p]
1017 set varcid($v,$id) $a
9257d8f7 1018 lappend children($v,$p) $id
7fcc92bf 1019 set cmitlisted($v,$id) 1
b8a938cf 1020 set numcommits [incr commitidx($v)]
7fcc92bf
PM
1021 # note we deliberately don't update varcstart($v) even if $i == 0
1022 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
c9cfdc96 1023 modify_arc $v $a $i
42a671fc 1024 if {[info exists targetid]} {
e244588e
DL
1025 if {![comes_before $targetid $p]} {
1026 incr targetrow
1027 }
42a671fc 1028 }
b8a938cf 1029 setcanvscroll
9257d8f7 1030 drawvisible
7fcc92bf
PM
1031}
1032
b8a938cf 1033proc removefakerow {id} {
9257d8f7 1034 global varcid varccommits parents children commitidx
fc2a256f 1035 global varctok vtokmod cmitlisted currentid selectedline
b8a938cf 1036 global targetid curview numcommits
7fcc92bf 1037
b8a938cf 1038 set v $curview
7fcc92bf 1039 if {[llength $parents($v,$id)] != 1} {
e244588e
DL
1040 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1041 return
7fcc92bf
PM
1042 }
1043 set p [lindex $parents($v,$id) 0]
1044 set a $varcid($v,$id)
1045 set i [lsearch -exact $varccommits($v,$a) $id]
1046 if {$i < 0} {
e244588e
DL
1047 puts "oops: removefakerow can't find [shortids $id] on arc $a"
1048 return
7fcc92bf
PM
1049 }
1050 unset varcid($v,$id)
1051 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1052 unset parents($v,$id)
1053 unset children($v,$id)
1054 unset cmitlisted($v,$id)
b8a938cf 1055 set numcommits [incr commitidx($v) -1]
7fcc92bf
PM
1056 set j [lsearch -exact $children($v,$p) $id]
1057 if {$j >= 0} {
e244588e 1058 set children($v,$p) [lreplace $children($v,$p) $j $j]
7fcc92bf 1059 }
c9cfdc96 1060 modify_arc $v $a $i
fc2a256f 1061 if {[info exist currentid] && $id eq $currentid} {
e244588e
DL
1062 unset currentid
1063 set selectedline {}
fc2a256f 1064 }
42a671fc 1065 if {[info exists targetid] && $targetid eq $id} {
e244588e 1066 set targetid $p
42a671fc 1067 }
b8a938cf 1068 setcanvscroll
9257d8f7 1069 drawvisible
7fcc92bf
PM
1070}
1071
aa43561a
PM
1072proc real_children {vp} {
1073 global children nullid nullid2
1074
1075 set kids {}
1076 foreach id $children($vp) {
e244588e
DL
1077 if {$id ne $nullid && $id ne $nullid2} {
1078 lappend kids $id
1079 }
aa43561a
PM
1080 }
1081 return $kids
1082}
1083
c8c9f3d9
PM
1084proc first_real_child {vp} {
1085 global children nullid nullid2
1086
1087 foreach id $children($vp) {
e244588e
DL
1088 if {$id ne $nullid && $id ne $nullid2} {
1089 return $id
1090 }
c8c9f3d9
PM
1091 }
1092 return {}
1093}
1094
1095proc last_real_child {vp} {
1096 global children nullid nullid2
1097
1098 set kids $children($vp)
1099 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
e244588e
DL
1100 set id [lindex $kids $i]
1101 if {$id ne $nullid && $id ne $nullid2} {
1102 return $id
1103 }
c8c9f3d9
PM
1104 }
1105 return {}
1106}
1107
7fcc92bf
PM
1108proc vtokcmp {v a b} {
1109 global varctok varcid
1110
1111 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
e244588e 1112 [lindex $varctok($v) $varcid($v,$b)]]
7fcc92bf
PM
1113}
1114
c9cfdc96
PM
1115# This assumes that if lim is not given, the caller has checked that
1116# arc a's token is less than $vtokmod($v)
e5b37ac1
PM
1117proc modify_arc {v a {lim {}}} {
1118 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
9257d8f7 1119
c9cfdc96 1120 if {$lim ne {}} {
e244588e
DL
1121 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1122 if {$c > 0} return
1123 if {$c == 0} {
1124 set r [lindex $varcrow($v) $a]
1125 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1126 }
c9cfdc96 1127 }
9257d8f7
PM
1128 set vtokmod($v) [lindex $varctok($v) $a]
1129 set varcmod($v) $a
1130 if {$v == $curview} {
e244588e
DL
1131 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1132 set a [lindex $vupptr($v) $a]
1133 set lim {}
1134 }
1135 set r 0
1136 if {$a != 0} {
1137 if {$lim eq {}} {
1138 set lim [llength $varccommits($v,$a)]
1139 }
1140 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1141 }
1142 set vrowmod($v) $r
1143 undolayout $r
9257d8f7
PM
1144 }
1145}
1146
7fcc92bf 1147proc update_arcrows {v} {
e5b37ac1 1148 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
24f7a667 1149 global varcid vrownum varcorder varcix varccommits
7fcc92bf 1150 global vupptr vdownptr vleftptr varctok
24f7a667 1151 global displayorder parentlist curview cached_commitrow
7fcc92bf 1152
c9cfdc96
PM
1153 if {$vrowmod($v) == $commitidx($v)} return
1154 if {$v == $curview} {
e244588e
DL
1155 if {[llength $displayorder] > $vrowmod($v)} {
1156 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1157 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1158 }
1159 unset -nocomplain cached_commitrow
c9cfdc96 1160 }
7fcc92bf
PM
1161 set narctot [expr {[llength $varctok($v)] - 1}]
1162 set a $varcmod($v)
1163 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
e244588e
DL
1164 # go up the tree until we find something that has a row number,
1165 # or we get to a seed
1166 set a [lindex $vupptr($v) $a]
7fcc92bf
PM
1167 }
1168 if {$a == 0} {
e244588e
DL
1169 set a [lindex $vdownptr($v) 0]
1170 if {$a == 0} return
1171 set vrownum($v) {0}
1172 set varcorder($v) [list $a]
1173 lset varcix($v) $a 0
1174 lset varcrow($v) $a 0
1175 set arcn 0
1176 set row 0
7fcc92bf 1177 } else {
e244588e
DL
1178 set arcn [lindex $varcix($v) $a]
1179 if {[llength $vrownum($v)] > $arcn + 1} {
1180 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1181 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1182 }
1183 set row [lindex $varcrow($v) $a]
7fcc92bf 1184 }
7fcc92bf 1185 while {1} {
e244588e
DL
1186 set p $a
1187 incr row [llength $varccommits($v,$a)]
1188 # go down if possible
1189 set b [lindex $vdownptr($v) $a]
1190 if {$b == 0} {
1191 # if not, go left, or go up until we can go left
1192 while {$a != 0} {
1193 set b [lindex $vleftptr($v) $a]
1194 if {$b != 0} break
1195 set a [lindex $vupptr($v) $a]
1196 }
1197 if {$a == 0} break
1198 }
1199 set a $b
1200 incr arcn
1201 lappend vrownum($v) $row
1202 lappend varcorder($v) $a
1203 lset varcix($v) $a $arcn
1204 lset varcrow($v) $a $row
7fcc92bf 1205 }
e5b37ac1
PM
1206 set vtokmod($v) [lindex $varctok($v) $p]
1207 set varcmod($v) $p
1208 set vrowmod($v) $row
7fcc92bf 1209 if {[info exists currentid]} {
e244588e 1210 set selectedline [rowofcommit $currentid]
7fcc92bf 1211 }
7fcc92bf
PM
1212}
1213
1214# Test whether view $v contains commit $id
1215proc commitinview {id v} {
1216 global varcid
1217
1218 return [info exists varcid($v,$id)]
1219}
1220
1221# Return the row number for commit $id in the current view
1222proc rowofcommit {id} {
1223 global varcid varccommits varcrow curview cached_commitrow
9257d8f7 1224 global varctok vtokmod
7fcc92bf 1225
7fcc92bf
PM
1226 set v $curview
1227 if {![info exists varcid($v,$id)]} {
e244588e
DL
1228 puts "oops rowofcommit no arc for [shortids $id]"
1229 return {}
7fcc92bf
PM
1230 }
1231 set a $varcid($v,$id)
fc2a256f 1232 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
e244588e 1233 update_arcrows $v
9257d8f7 1234 }
31c0eaa8 1235 if {[info exists cached_commitrow($id)]} {
e244588e 1236 return $cached_commitrow($id)
31c0eaa8 1237 }
7fcc92bf
PM
1238 set i [lsearch -exact $varccommits($v,$a) $id]
1239 if {$i < 0} {
e244588e
DL
1240 puts "oops didn't find commit [shortids $id] in arc $a"
1241 return {}
7fcc92bf
PM
1242 }
1243 incr i [lindex $varcrow($v) $a]
1244 set cached_commitrow($id) $i
1245 return $i
1246}
1247
42a671fc
PM
1248# Returns 1 if a is on an earlier row than b, otherwise 0
1249proc comes_before {a b} {
1250 global varcid varctok curview
1251
1252 set v $curview
1253 if {$a eq $b || ![info exists varcid($v,$a)] || \
e244588e
DL
1254 ![info exists varcid($v,$b)]} {
1255 return 0
42a671fc
PM
1256 }
1257 if {$varcid($v,$a) != $varcid($v,$b)} {
e244588e
DL
1258 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1259 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
42a671fc
PM
1260 }
1261 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1262}
1263
7fcc92bf
PM
1264proc bsearch {l elt} {
1265 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
e244588e 1266 return 0
7fcc92bf
PM
1267 }
1268 set lo 0
1269 set hi [llength $l]
1270 while {$hi - $lo > 1} {
e244588e
DL
1271 set mid [expr {int(($lo + $hi) / 2)}]
1272 set t [lindex $l $mid]
1273 if {$elt < $t} {
1274 set hi $mid
1275 } elseif {$elt > $t} {
1276 set lo $mid
1277 } else {
1278 return $mid
1279 }
7fcc92bf
PM
1280 }
1281 return $lo
1282}
1283
1284# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1285proc make_disporder {start end} {
1286 global vrownum curview commitidx displayorder parentlist
e5b37ac1 1287 global varccommits varcorder parents vrowmod varcrow
7fcc92bf
PM
1288 global d_valid_start d_valid_end
1289
e5b37ac1 1290 if {$end > $vrowmod($curview)} {
e244588e 1291 update_arcrows $curview
9257d8f7 1292 }
7fcc92bf
PM
1293 set ai [bsearch $vrownum($curview) $start]
1294 set start [lindex $vrownum($curview) $ai]
1295 set narc [llength $vrownum($curview)]
1296 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
e244588e
DL
1297 set a [lindex $varcorder($curview) $ai]
1298 set l [llength $displayorder]
1299 set al [llength $varccommits($curview,$a)]
1300 if {$l < $r + $al} {
1301 if {$l < $r} {
1302 set pad [ntimes [expr {$r - $l}] {}]
1303 set displayorder [concat $displayorder $pad]
1304 set parentlist [concat $parentlist $pad]
1305 } elseif {$l > $r} {
1306 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1307 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1308 }
1309 foreach id $varccommits($curview,$a) {
1310 lappend displayorder $id
1311 lappend parentlist $parents($curview,$id)
1312 }
1313 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1314 set i $r
1315 foreach id $varccommits($curview,$a) {
1316 lset displayorder $i $id
1317 lset parentlist $i $parents($curview,$id)
1318 incr i
1319 }
1320 }
1321 incr r $al
7fcc92bf
PM
1322 }
1323}
1324
1325proc commitonrow {row} {
1326 global displayorder
1327
1328 set id [lindex $displayorder $row]
1329 if {$id eq {}} {
e244588e
DL
1330 make_disporder $row [expr {$row + 1}]
1331 set id [lindex $displayorder $row]
7fcc92bf
PM
1332 }
1333 return $id
1334}
1335
1336proc closevarcs {v} {
1337 global varctok varccommits varcid parents children
d92aa570 1338 global cmitlisted commitidx vtokmod curview numcommits
7fcc92bf
PM
1339
1340 set missing_parents 0
1341 set scripts {}
1342 set narcs [llength $varctok($v)]
1343 for {set a 1} {$a < $narcs} {incr a} {
e244588e
DL
1344 set id [lindex $varccommits($v,$a) end]
1345 foreach p $parents($v,$id) {
1346 if {[info exists varcid($v,$p)]} continue
1347 # add p as a new commit
1348 incr missing_parents
1349 set cmitlisted($v,$p) 0
1350 set parents($v,$p) {}
1351 if {[llength $children($v,$p)] == 1 &&
1352 [llength $parents($v,$id)] == 1} {
1353 set b $a
1354 } else {
1355 set b [newvarc $v $p]
1356 }
1357 set varcid($v,$p) $b
1358 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1359 modify_arc $v $b
1360 }
1361 lappend varccommits($v,$b) $p
1362 incr commitidx($v)
1363 if {$v == $curview} {
1364 set numcommits $commitidx($v)
1365 }
1366 set scripts [check_interest $p $scripts]
1367 }
7fcc92bf
PM
1368 }
1369 if {$missing_parents > 0} {
e244588e
DL
1370 foreach s $scripts {
1371 eval $s
1372 }
7fcc92bf
PM
1373 }
1374}
1375
f806f0fb
PM
1376# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1377# Assumes we already have an arc for $rwid.
1378proc rewrite_commit {v id rwid} {
1379 global children parents varcid varctok vtokmod varccommits
1380
1381 foreach ch $children($v,$id) {
e244588e
DL
1382 # make $rwid be $ch's parent in place of $id
1383 set i [lsearch -exact $parents($v,$ch) $id]
1384 if {$i < 0} {
1385 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1386 }
1387 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1388 # add $ch to $rwid's children and sort the list if necessary
1389 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1390 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1391 $children($v,$rwid)]
1392 }
1393 # fix the graph after joining $id to $rwid
1394 set a $varcid($v,$ch)
1395 fix_reversal $rwid $a $v
1396 # parentlist is wrong for the last element of arc $a
1397 # even if displayorder is right, hence the 3rd arg here
1398 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
f806f0fb
PM
1399 }
1400}
1401
d375ef9b
PM
1402# Mechanism for registering a command to be executed when we come
1403# across a particular commit. To handle the case when only the
1404# prefix of the commit is known, the commitinterest array is now
1405# indexed by the first 4 characters of the ID. Each element is a
1406# list of id, cmd pairs.
1407proc interestedin {id cmd} {
1408 global commitinterest
1409
1410 lappend commitinterest([string range $id 0 3]) $id $cmd
1411}
1412
1413proc check_interest {id scripts} {
1414 global commitinterest
1415
1416 set prefix [string range $id 0 3]
1417 if {[info exists commitinterest($prefix)]} {
e244588e
DL
1418 set newlist {}
1419 foreach {i script} $commitinterest($prefix) {
1420 if {[string match "$i*" $id]} {
1421 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1422 } else {
1423 lappend newlist $i $script
1424 }
1425 }
1426 if {$newlist ne {}} {
1427 set commitinterest($prefix) $newlist
1428 } else {
1429 unset commitinterest($prefix)
1430 }
d375ef9b
PM
1431 }
1432 return $scripts
1433}
1434
f806f0fb 1435proc getcommitlines {fd inst view updating} {
d375ef9b 1436 global cmitlisted leftover
3ed31a81 1437 global commitidx commitdata vdatemode
7fcc92bf 1438 global parents children curview hlview
468bcaed 1439 global idpending ordertok
22387f23 1440 global varccommits varcid varctok vtokmod vfilelimit vshortids
9ccbdfbf 1441
d1e46756 1442 set stuff [read $fd 500000]
005a2f4e 1443 # git log doesn't terminate the last commit with a null...
7fcc92bf 1444 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
e244588e 1445 set stuff "\0"
005a2f4e 1446 }
b490a991 1447 if {$stuff == {}} {
e244588e
DL
1448 if {![eof $fd]} {
1449 return 1
1450 }
1451 global commfd viewcomplete viewactive viewname
1452 global viewinstances
1453 unset commfd($inst)
1454 set i [lsearch -exact $viewinstances($view) $inst]
1455 if {$i >= 0} {
1456 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1457 }
1458 # set it blocking so we wait for the process to terminate
1459 fconfigure $fd -blocking 1
1460 if {[catch {close $fd} err]} {
1461 set fv {}
1462 if {$view != $curview} {
1463 set fv " for the \"$viewname($view)\" view"
1464 }
1465 if {[string range $err 0 4] == "usage"} {
1466 set err "Gitk: error reading commits$fv:\
1467 bad arguments to git log."
1468 if {$viewname($view) eq [mc "Command line"]} {
1469 append err \
1470 " (Note: arguments to gitk are passed to git log\
1471 to allow selection of commits to be displayed.)"
1472 }
1473 } else {
1474 set err "Error reading commits$fv: $err"
1475 }
1476 error_popup $err
1477 }
1478 if {[incr viewactive($view) -1] <= 0} {
1479 set viewcomplete($view) 1
1480 # Check if we have seen any ids listed as parents that haven't
1481 # appeared in the list
1482 closevarcs $view
1483 notbusy $view
1484 }
1485 if {$view == $curview} {
1486 run chewcommits
1487 }
1488 return 0
9a40c50c 1489 }
b490a991 1490 set start 0
8f7d0cec 1491 set gotsome 0
7fcc92bf 1492 set scripts {}
b490a991 1493 while 1 {
e244588e
DL
1494 set i [string first "\0" $stuff $start]
1495 if {$i < 0} {
1496 append leftover($inst) [string range $stuff $start end]
1497 break
1498 }
1499 if {$start == 0} {
1500 set cmit $leftover($inst)
1501 append cmit [string range $stuff 0 [expr {$i - 1}]]
1502 set leftover($inst) {}
1503 } else {
1504 set cmit [string range $stuff $start [expr {$i - 1}]]
1505 }
1506 set start [expr {$i + 1}]
1507 set j [string first "\n" $cmit]
1508 set ok 0
1509 set listed 1
1510 if {$j >= 0 && [string match "commit *" $cmit]} {
1511 set ids [string range $cmit 7 [expr {$j - 1}]]
1512 if {[string match {[-^<>]*} $ids]} {
1513 switch -- [string index $ids 0] {
1514 "-" {set listed 0}
1515 "^" {set listed 2}
1516 "<" {set listed 3}
1517 ">" {set listed 4}
1518 }
1519 set ids [string range $ids 1 end]
1520 }
1521 set ok 1
1522 foreach id $ids {
1523 if {[string length $id] != 40} {
1524 set ok 0
1525 break
1526 }
1527 }
1528 }
1529 if {!$ok} {
1530 set shortcmit $cmit
1531 if {[string length $shortcmit] > 80} {
1532 set shortcmit "[string range $shortcmit 0 80]..."
1533 }
1534 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1535 exit 1
1536 }
1537 set id [lindex $ids 0]
1538 set vid $view,$id
1539
1540 lappend vshortids($view,[string range $id 0 3]) $id
1541
1542 if {!$listed && $updating && ![info exists varcid($vid)] &&
1543 $vfilelimit($view) ne {}} {
1544 # git log doesn't rewrite parents for unlisted commits
1545 # when doing path limiting, so work around that here
1546 # by working out the rewritten parent with git rev-list
1547 # and if we already know about it, using the rewritten
1548 # parent as a substitute parent for $id's children.
1549 if {![catch {
1550 set rwid [exec git rev-list --first-parent --max-count=1 \
1551 $id -- $vfilelimit($view)]
1552 }]} {
1553 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1554 # use $rwid in place of $id
1555 rewrite_commit $view $id $rwid
1556 continue
1557 }
1558 }
1559 }
1560
1561 set a 0
1562 if {[info exists varcid($vid)]} {
1563 if {$cmitlisted($vid) || !$listed} continue
1564 set a $varcid($vid)
1565 }
1566 if {$listed} {
1567 set olds [lrange $ids 1 end]
1568 } else {
1569 set olds {}
1570 }
1571 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1572 set cmitlisted($vid) $listed
1573 set parents($vid) $olds
1574 if {![info exists children($vid)]} {
1575 set children($vid) {}
1576 } elseif {$a == 0 && [llength $children($vid)] == 1} {
1577 set k [lindex $children($vid) 0]
1578 if {[llength $parents($view,$k)] == 1 &&
1579 (!$vdatemode($view) ||
1580 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1581 set a $varcid($view,$k)
1582 }
1583 }
1584 if {$a == 0} {
1585 # new arc
1586 set a [newvarc $view $id]
1587 }
1588 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1589 modify_arc $view $a
1590 }
1591 if {![info exists varcid($vid)]} {
1592 set varcid($vid) $a
1593 lappend varccommits($view,$a) $id
1594 incr commitidx($view)
1595 }
1596
1597 set i 0
1598 foreach p $olds {
1599 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1600 set vp $view,$p
1601 if {[llength [lappend children($vp) $id]] > 1 &&
1602 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1603 set children($vp) [lsort -command [list vtokcmp $view] \
1604 $children($vp)]
1605 unset -nocomplain ordertok
1606 }
1607 if {[info exists varcid($view,$p)]} {
1608 fix_reversal $p $a $view
1609 }
1610 }
1611 incr i
1612 }
1613
1614 set scripts [check_interest $id $scripts]
1615 set gotsome 1
8f7d0cec
PM
1616 }
1617 if {$gotsome} {
e244588e
DL
1618 global numcommits hlview
1619
1620 if {$view == $curview} {
1621 set numcommits $commitidx($view)
1622 run chewcommits
1623 }
1624 if {[info exists hlview] && $view == $hlview} {
1625 # we never actually get here...
1626 run vhighlightmore
1627 }
1628 foreach s $scripts {
1629 eval $s
1630 }
9ccbdfbf 1631 }
7eb3cb9c 1632 return 2
9ccbdfbf
PM
1633}
1634
ac1276ab 1635proc chewcommits {} {
f5f3c2e2 1636 global curview hlview viewcomplete
7fcc92bf 1637 global pending_select
7eb3cb9c 1638
ac1276ab
PM
1639 layoutmore
1640 if {$viewcomplete($curview)} {
e244588e
DL
1641 global commitidx varctok
1642 global numcommits startmsecs
1643
1644 if {[info exists pending_select]} {
1645 update
1646 reset_pending_select {}
1647
1648 if {[commitinview $pending_select $curview]} {
1649 selectline [rowofcommit $pending_select] 1
1650 } else {
1651 set row [first_real_row]
1652 selectline $row 1
1653 }
1654 }
1655 if {$commitidx($curview) > 0} {
1656 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1657 #puts "overall $ms ms for $numcommits commits"
1658 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1659 } else {
1660 show_status [mc "No commits selected"]
1661 }
1662 notbusy layout
b664550c 1663 }
f5f3c2e2 1664 return 0
1db95b00
PM
1665}
1666
590915da
AG
1667proc do_readcommit {id} {
1668 global tclencoding
1669
1670 # Invoke git-log to handle automatic encoding conversion
1671 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1672 # Read the results using i18n.logoutputencoding
1673 fconfigure $fd -translation lf -eofchar {}
1674 if {$tclencoding != {}} {
e244588e 1675 fconfigure $fd -encoding $tclencoding
590915da
AG
1676 }
1677 set contents [read $fd]
1678 close $fd
1679 # Remove the heading line
1680 regsub {^commit [0-9a-f]+\n} $contents {} contents
1681
1682 return $contents
1683}
1684
1db95b00 1685proc readcommit {id} {
590915da
AG
1686 if {[catch {set contents [do_readcommit $id]}]} return
1687 parsecommit $id $contents 1
b490a991
PM
1688}
1689
8f7d0cec 1690proc parsecommit {id contents listed} {
ef73896b 1691 global commitinfo
b5c2f306
SV
1692
1693 set inhdr 1
1694 set comment {}
1695 set headline {}
1696 set auname {}
1697 set audate {}
1698 set comname {}
1699 set comdate {}
232475d3
PM
1700 set hdrend [string first "\n\n" $contents]
1701 if {$hdrend < 0} {
e244588e
DL
1702 # should never happen...
1703 set hdrend [string length $contents]
232475d3
PM
1704 }
1705 set header [string range $contents 0 [expr {$hdrend - 1}]]
1706 set comment [string range $contents [expr {$hdrend + 2}] end]
1707 foreach line [split $header "\n"] {
e244588e
DL
1708 set line [split $line " "]
1709 set tag [lindex $line 0]
1710 if {$tag == "author"} {
1711 set audate [lrange $line end-1 end]
1712 set auname [join [lrange $line 1 end-2] " "]
1713 } elseif {$tag == "committer"} {
1714 set comdate [lrange $line end-1 end]
1715 set comname [join [lrange $line 1 end-2] " "]
1716 }
1db95b00 1717 }
232475d3 1718 set headline {}
43c25074
PM
1719 # take the first non-blank line of the comment as the headline
1720 set headline [string trimleft $comment]
1721 set i [string first "\n" $headline]
232475d3 1722 if {$i >= 0} {
e244588e 1723 set headline [string range $headline 0 $i]
43c25074
PM
1724 }
1725 set headline [string trimright $headline]
1726 set i [string first "\r" $headline]
1727 if {$i >= 0} {
e244588e 1728 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
1729 }
1730 if {!$listed} {
e244588e
DL
1731 # git log indents the comment by 4 spaces;
1732 # if we got this via git cat-file, add the indentation
1733 set newcomment {}
1734 foreach line [split $comment "\n"] {
1735 append newcomment " "
1736 append newcomment $line
1737 append newcomment "\n"
1738 }
1739 set comment $newcomment
1db95b00 1740 }
36242490 1741 set hasnote [string first "\nNotes:\n" $contents]
b449eb2c
TR
1742 set diff ""
1743 # If there is diff output shown in the git-log stream, split it
1744 # out. But get rid of the empty line that always precedes the
1745 # diff.
1746 set i [string first "\n\ndiff" $comment]
1747 if {$i >= 0} {
e244588e
DL
1748 set diff [string range $comment $i+1 end]
1749 set comment [string range $comment 0 $i-1]
b449eb2c 1750 }
e5c2d856 1751 set commitinfo($id) [list $headline $auname $audate \
e244588e 1752 $comname $comdate $comment $hasnote $diff]
1db95b00
PM
1753}
1754
f7a3e8d2 1755proc getcommit {id} {
79b2c75e 1756 global commitdata commitinfo
8ed16484 1757
f7a3e8d2 1758 if {[info exists commitdata($id)]} {
e244588e 1759 parsecommit $id $commitdata($id) 1
8ed16484 1760 } else {
e244588e
DL
1761 readcommit $id
1762 if {![info exists commitinfo($id)]} {
1763 set commitinfo($id) [list [mc "No commit information available"]]
1764 }
8ed16484
PM
1765 }
1766 return 1
1767}
1768
d375ef9b
PM
1769# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1770# and are present in the current view.
1771# This is fairly slow...
1772proc longid {prefix} {
22387f23 1773 global varcid curview vshortids
d375ef9b
PM
1774
1775 set ids {}
22387f23 1776 if {[string length $prefix] >= 4} {
e244588e
DL
1777 set vshortid $curview,[string range $prefix 0 3]
1778 if {[info exists vshortids($vshortid)]} {
1779 foreach id $vshortids($vshortid) {
1780 if {[string match "$prefix*" $id]} {
1781 if {[lsearch -exact $ids $id] < 0} {
1782 lappend ids $id
1783 if {[llength $ids] >= 2} break
1784 }
1785 }
1786 }
1787 }
22387f23 1788 } else {
e244588e
DL
1789 foreach match [array names varcid "$curview,$prefix*"] {
1790 lappend ids [lindex [split $match ","] 1]
1791 if {[llength $ids] >= 2} break
1792 }
d375ef9b
PM
1793 }
1794 return $ids
1795}
1796
887fe3c4 1797proc readrefs {} {
62d3ea65 1798 global tagids idtags headids idheads tagobjid
219ea3a9 1799 global otherrefids idotherrefs mainhead mainheadid
39816d60 1800 global selecthead selectheadid
ffe15297 1801 global hideremotes
d4247e06 1802 global tclencoding
106288cb 1803
b5c2f306 1804 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
e244588e 1805 unset -nocomplain $v
b5c2f306 1806 }
62d3ea65 1807 set refd [open [list | git show-ref -d] r]
d4247e06 1808 if {$tclencoding != {}} {
e244588e 1809 fconfigure $refd -encoding $tclencoding
d4247e06 1810 }
62d3ea65 1811 while {[gets $refd line] >= 0} {
e244588e
DL
1812 if {[string index $line 40] ne " "} continue
1813 set id [string range $line 0 39]
1814 set ref [string range $line 41 end]
1815 if {![string match "refs/*" $ref]} continue
1816 set name [string range $ref 5 end]
1817 if {[string match "remotes/*" $name]} {
1818 if {![string match "*/HEAD" $name] && !$hideremotes} {
1819 set headids($name) $id
1820 lappend idheads($id) $name
1821 }
1822 } elseif {[string match "heads/*" $name]} {
1823 set name [string range $name 6 end]
1824 set headids($name) $id
1825 lappend idheads($id) $name
1826 } elseif {[string match "tags/*" $name]} {
1827 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1828 # which is what we want since the former is the commit ID
1829 set name [string range $name 5 end]
1830 if {[string match "*^{}" $name]} {
1831 set name [string range $name 0 end-3]
1832 } else {
1833 set tagobjid($name) $id
1834 }
1835 set tagids($name) $id
1836 lappend idtags($id) $name
1837 } else {
1838 set otherrefids($name) $id
1839 lappend idotherrefs($id) $name
1840 }
f1d83ba3 1841 }
062d671f 1842 catch {close $refd}
8a48571c 1843 set mainhead {}
219ea3a9 1844 set mainheadid {}
8a48571c 1845 catch {
e244588e
DL
1846 set mainheadid [exec git rev-parse HEAD]
1847 set thehead [exec git symbolic-ref HEAD]
1848 if {[string match "refs/heads/*" $thehead]} {
1849 set mainhead [string range $thehead 11 end]
1850 }
8a48571c 1851 }
39816d60
AG
1852 set selectheadid {}
1853 if {$selecthead ne {}} {
e244588e
DL
1854 catch {
1855 set selectheadid [exec git rev-parse --verify $selecthead]
1856 }
39816d60 1857 }
887fe3c4
PM
1858}
1859
8f489363
PM
1860# skip over fake commits
1861proc first_real_row {} {
7fcc92bf 1862 global nullid nullid2 numcommits
8f489363
PM
1863
1864 for {set row 0} {$row < $numcommits} {incr row} {
e244588e
DL
1865 set id [commitonrow $row]
1866 if {$id ne $nullid && $id ne $nullid2} {
1867 break
1868 }
8f489363
PM
1869 }
1870 return $row
1871}
1872
e11f1233
PM
1873# update things for a head moved to a child of its previous location
1874proc movehead {id name} {
1875 global headids idheads
1876
1877 removehead $headids($name) $name
1878 set headids($name) $id
1879 lappend idheads($id) $name
1880}
1881
1882# update things when a head has been removed
1883proc removehead {id name} {
1884 global headids idheads
1885
1886 if {$idheads($id) eq $name} {
e244588e 1887 unset idheads($id)
e11f1233 1888 } else {
e244588e
DL
1889 set i [lsearch -exact $idheads($id) $name]
1890 if {$i >= 0} {
1891 set idheads($id) [lreplace $idheads($id) $i $i]
1892 }
e11f1233
PM
1893 }
1894 unset headids($name)
1895}
1896
d93f1713
PT
1897proc ttk_toplevel {w args} {
1898 global use_ttk
1899 eval [linsert $args 0 ::toplevel $w]
1900 if {$use_ttk} {
1901 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1902 }
1903 return $w
1904}
1905
e7d64008
AG
1906proc make_transient {window origin} {
1907 global have_tk85
1908
1909 # In MacOS Tk 8.4 transient appears to work by setting
1910 # overrideredirect, which is utterly useless, since the
1911 # windows get no border, and are not even kept above
1912 # the parent.
1913 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1914
1915 wm transient $window $origin
1916
1917 # Windows fails to place transient windows normally, so
1918 # schedule a callback to center them on the parent.
1919 if {[tk windowingsystem] eq {win32}} {
e244588e 1920 after idle [list tk::PlaceWindow $window widget $origin]
e7d64008
AG
1921 }
1922}
1923
ef87a480 1924proc show_error {w top msg} {
d93f1713 1925 global NS
3cb1f9c9 1926 if {![info exists NS]} {set NS ""}
d93f1713 1927 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
df3d83b1
PM
1928 message $w.m -text $msg -justify center -aspect 400
1929 pack $w.m -side top -fill x -padx 20 -pady 20
ef87a480 1930 ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
df3d83b1 1931 pack $w.ok -side bottom -fill x
e54be9e3
PM
1932 bind $top <Visibility> "grab $top; focus $top"
1933 bind $top <Key-Return> "destroy $top"
76f15947
AG
1934 bind $top <Key-space> "destroy $top"
1935 bind $top <Key-Escape> "destroy $top"
e54be9e3 1936 tkwait window $top
df3d83b1
PM
1937}
1938
84a76f18 1939proc error_popup {msg {owner .}} {
d93f1713
PT
1940 if {[tk windowingsystem] eq "win32"} {
1941 tk_messageBox -icon error -type ok -title [wm title .] \
1942 -parent $owner -message $msg
1943 } else {
1944 set w .error
1945 ttk_toplevel $w
1946 make_transient $w $owner
1947 show_error $w $w $msg
1948 }
098dd8a3
PM
1949}
1950
84a76f18 1951proc confirm_popup {msg {owner .}} {
d93f1713 1952 global confirm_ok NS
10299152
PM
1953 set confirm_ok 0
1954 set w .confirm
d93f1713 1955 ttk_toplevel $w
e7d64008 1956 make_transient $w $owner
10299152
PM
1957 message $w.m -text $msg -justify center -aspect 400
1958 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1959 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1960 pack $w.ok -side left -fill x
d93f1713 1961 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1962 pack $w.cancel -side right -fill x
1963 bind $w <Visibility> "grab $w; focus $w"
76f15947
AG
1964 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1965 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1966 bind $w <Key-Escape> "destroy $w"
d93f1713 1967 tk::PlaceWindow $w widget $owner
10299152
PM
1968 tkwait window $w
1969 return $confirm_ok
1970}
1971
b039f0a6 1972proc setoptions {} {
6cb73c84
GB
1973 global use_ttk
1974
d93f1713
PT
1975 if {[tk windowingsystem] ne "win32"} {
1976 option add *Panedwindow.showHandle 1 startupFile
1977 option add *Panedwindow.sashRelief raised startupFile
1978 if {[tk windowingsystem] ne "aqua"} {
1979 option add *Menu.font uifont startupFile
1980 }
1981 } else {
1982 option add *Menu.TearOff 0 startupFile
1983 }
b039f0a6
PM
1984 option add *Button.font uifont startupFile
1985 option add *Checkbutton.font uifont startupFile
1986 option add *Radiobutton.font uifont startupFile
b039f0a6
PM
1987 option add *Menubutton.font uifont startupFile
1988 option add *Label.font uifont startupFile
1989 option add *Message.font uifont startupFile
b9b142ff
MH
1990 option add *Entry.font textfont startupFile
1991 option add *Text.font textfont startupFile
d93f1713 1992 option add *Labelframe.font uifont startupFile
0933b04e 1993 option add *Spinbox.font textfont startupFile
207ad7b8 1994 option add *Listbox.font mainfont startupFile
b039f0a6
PM
1995}
1996
6cb73c84
GB
1997proc setttkstyle {} {
1998 eval font configure TkDefaultFont [fontflags mainfont]
1999 eval font configure TkTextFont [fontflags textfont]
2000 eval font configure TkHeadingFont [fontflags mainfont]
2001 eval font configure TkCaptionFont [fontflags mainfont] -weight bold
2002 eval font configure TkTooltipFont [fontflags uifont]
2003 eval font configure TkFixedFont [fontflags textfont]
2004 eval font configure TkIconFont [fontflags uifont]
2005 eval font configure TkMenuFont [fontflags uifont]
2006 eval font configure TkSmallCaptionFont [fontflags uifont]
2007}
2008
79056034
PM
2009# Make a menu and submenus.
2010# m is the window name for the menu, items is the list of menu items to add.
2011# Each item is a list {mc label type description options...}
2012# mc is ignored; it's so we can put mc there to alert xgettext
2013# label is the string that appears in the menu
2014# type is cascade, command or radiobutton (should add checkbutton)
2015# description depends on type; it's the sublist for cascade, the
2016# command to invoke for command, or {variable value} for radiobutton
f2d0bbbd
PM
2017proc makemenu {m items} {
2018 menu $m
cea07cf8 2019 if {[tk windowingsystem] eq {aqua}} {
e244588e 2020 set Meta1 Cmd
cea07cf8 2021 } else {
e244588e 2022 set Meta1 Ctrl
cea07cf8 2023 }
f2d0bbbd 2024 foreach i $items {
e244588e
DL
2025 set name [mc [lindex $i 1]]
2026 set type [lindex $i 2]
2027 set thing [lindex $i 3]
2028 set params [list $type]
2029 if {$name ne {}} {
2030 set u [string first "&" [string map {&& x} $name]]
2031 lappend params -label [string map {&& & & {}} $name]
2032 if {$u >= 0} {
2033 lappend params -underline $u
2034 }
2035 }
2036 switch -- $type {
2037 "cascade" {
2038 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2039 lappend params -menu $m.$submenu
2040 }
2041 "command" {
2042 lappend params -command $thing
2043 }
2044 "radiobutton" {
2045 lappend params -variable [lindex $thing 0] \
2046 -value [lindex $thing 1]
2047 }
2048 }
2049 set tail [lrange $i 4 end]
2050 regsub -all {\yMeta1\y} $tail $Meta1 tail
2051 eval $m add $params $tail
2052 if {$type eq "cascade"} {
2053 makemenu $m.$submenu $thing
2054 }
f2d0bbbd
PM
2055 }
2056}
2057
2058# translate string and remove ampersands
2059proc mca {str} {
2060 return [string map {&& & & {}} [mc $str]]
2061}
2062
39c12691
PM
2063proc cleardropsel {w} {
2064 $w selection clear
2065}
d93f1713
PT
2066proc makedroplist {w varname args} {
2067 global use_ttk
2068 if {$use_ttk} {
3cb1f9c9
PT
2069 set width 0
2070 foreach label $args {
2071 set cx [string length $label]
2072 if {$cx > $width} {set width $cx}
2073 }
e244588e
DL
2074 set gm [ttk::combobox $w -width $width -state readonly\
2075 -textvariable $varname -values $args \
2076 -exportselection false]
2077 bind $gm <<ComboboxSelected>> [list $gm selection clear]
d93f1713 2078 } else {
e244588e 2079 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
d93f1713
PT
2080 }
2081 return $gm
2082}
2083
d94f8cd6 2084proc makewindow {} {
31c0eaa8 2085 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 2086 global tabstop
b74fd579 2087 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 2088 global entries sha1entry sha1string sha1but
890fae70 2089 global diffcontextstring diffcontext
b9b86007 2090 global ignorespace
94a2eede 2091 global maincursor textcursor curtextcursor
219ea3a9 2092 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 2093 global highlight_files gdttype
3ea06f9f 2094 global searchstring sstring
113ce124 2095 global bgcolor fgcolor bglist fglist diffcolors diffbgcolors selectbgcolor
252c52df
2096 global uifgcolor uifgdisabledcolor
2097 global filesepbgcolor filesepfgcolor
2098 global mergecolors foundbgcolor currentsearchhitbgcolor
bb3edc8b
PM
2099 global headctxmenu progresscanv progressitem progresscoords statusw
2100 global fprogitem fprogcoord lastprogupdate progupdatepending
6df7403a 2101 global rprogitem rprogcoord rownumsel numcommits
d93f1713 2102 global have_tk85 use_ttk NS
ae4e3ff9
TR
2103 global git_version
2104 global worddiff
9a40c50c 2105
79056034
PM
2106 # The "mc" arguments here are purely so that xgettext
2107 # sees the following string as needing to be translated
5fdcbb13 2108 set file {
e244588e
DL
2109 mc "&File" cascade {
2110 {mc "&Update" command updatecommits -accelerator F5}
2111 {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2112 {mc "Reread re&ferences" command rereadrefs}
2113 {mc "&List references" command showrefs -accelerator F2}
2114 {xx "" separator}
2115 {mc "Start git &gui" command {exec git gui &}}
2116 {xx "" separator}
2117 {mc "&Quit" command doquit -accelerator Meta1-Q}
2118 }}
5fdcbb13 2119 set edit {
e244588e
DL
2120 mc "&Edit" cascade {
2121 {mc "&Preferences" command doprefs}
2122 }}
5fdcbb13 2123 set view {
e244588e
DL
2124 mc "&View" cascade {
2125 {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2126 {mc "&Edit view..." command editview -state disabled -accelerator F4}
2127 {mc "&Delete view" command delview -state disabled}
2128 {xx "" separator}
2129 {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2130 }}
5fdcbb13 2131 if {[tk windowingsystem] ne "aqua"} {
e244588e
DL
2132 set help {
2133 mc "&Help" cascade {
2134 {mc "&About gitk" command about}
2135 {mc "&Key bindings" command keys}
2136 }}
2137 set bar [list $file $edit $view $help]
5fdcbb13 2138 } else {
e244588e
DL
2139 proc ::tk::mac::ShowPreferences {} {doprefs}
2140 proc ::tk::mac::Quit {} {doquit}
2141 lset file end [lreplace [lindex $file end] end-1 end]
2142 set apple {
2143 xx "&Apple" cascade {
2144 {mc "&About gitk" command about}
2145 {xx "" separator}
2146 }}
2147 set help {
2148 mc "&Help" cascade {
2149 {mc "&Key bindings" command keys}
2150 }}
2151 set bar [list $apple $file $view $help]
f2d0bbbd 2152 }
5fdcbb13 2153 makemenu .bar $bar
9a40c50c
PM
2154 . configure -menu .bar
2155
d93f1713
PT
2156 if {$use_ttk} {
2157 # cover the non-themed toplevel with a themed frame.
2158 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2159 }
2160
e9937d2a 2161 # the gui has upper and lower half, parts of a paned window.
d93f1713 2162 ${NS}::panedwindow .ctop -orient vertical
e9937d2a
JH
2163
2164 # possibly use assumed geometry
9ca72f4f 2165 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
2166 set geometry(topheight) [expr {15 * $linespc}]
2167 set geometry(topwidth) [expr {80 * $charspc}]
2168 set geometry(botheight) [expr {15 * $linespc}]
2169 set geometry(botwidth) [expr {50 * $charspc}]
d93f1713
PT
2170 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2171 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
e9937d2a
JH
2172 }
2173
2174 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
d93f1713
PT
2175 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2176 ${NS}::frame .tf.histframe
2177 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2178 if {!$use_ttk} {
e244588e 2179 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
d93f1713 2180 }
e9937d2a
JH
2181
2182 # create three canvases
2183 set cscroll .tf.histframe.csb
2184 set canv .tf.histframe.pwclist.canv
9ca72f4f 2185 canvas $canv \
e244588e
DL
2186 -selectbackground $selectbgcolor \
2187 -background $bgcolor -bd 0 \
2188 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
2189 .tf.histframe.pwclist add $canv
2190 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 2191 canvas $canv2 \
e244588e
DL
2192 -selectbackground $selectbgcolor \
2193 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
2194 .tf.histframe.pwclist add $canv2
2195 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 2196 canvas $canv3 \
e244588e
DL
2197 -selectbackground $selectbgcolor \
2198 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 2199 .tf.histframe.pwclist add $canv3
d93f1713 2200 if {$use_ttk} {
e244588e
DL
2201 bind .tf.histframe.pwclist <Map> {
2202 bind %W <Map> {}
2203 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2204 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2205 }
d93f1713 2206 } else {
e244588e
DL
2207 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2208 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
d93f1713 2209 }
e9937d2a
JH
2210
2211 # a scroll bar to rule them
d93f1713
PT
2212 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2213 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
e9937d2a
JH
2214 pack $cscroll -side right -fill y
2215 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 2216 lappend bglist $canv $canv2 $canv3
e9937d2a 2217 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 2218
e9937d2a 2219 # we have two button bars at bottom of top frame. Bar 1
d93f1713
PT
2220 ${NS}::frame .tf.bar
2221 ${NS}::frame .tf.lbar -height 15
e9937d2a
JH
2222
2223 set sha1entry .tf.bar.sha1
887fe3c4 2224 set entries $sha1entry
e9937d2a 2225 set sha1but .tf.bar.sha1label
0359ba72 2226 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
e244588e 2227 -command gotocommit -width 8
887fe3c4 2228 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 2229 pack .tf.bar.sha1label -side left
d93f1713 2230 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 2231 trace add variable sha1string write sha1change
98f350e5 2232 pack $sha1entry -side left -pady 2
d698206c 2233
f062e50f 2234 set bm_left_data {
e244588e
DL
2235 #define left_width 16
2236 #define left_height 16
2237 static unsigned char left_bits[] = {
2238 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2239 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2240 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
d698206c 2241 }
f062e50f 2242 set bm_right_data {
e244588e
DL
2243 #define right_width 16
2244 #define right_height 16
2245 static unsigned char right_bits[] = {
2246 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2247 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2248 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
d698206c 2249 }
252c52df
2250 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2251 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2252 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2253 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
f062e50f 2254
62e9ac5e
MK
2255 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2256 if {$use_ttk} {
e244588e 2257 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
62e9ac5e 2258 } else {
e244588e 2259 .tf.bar.leftbut configure -image bm-left
62e9ac5e 2260 }
e9937d2a 2261 pack .tf.bar.leftbut -side left -fill y
62e9ac5e
MK
2262 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2263 if {$use_ttk} {
e244588e 2264 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
62e9ac5e 2265 } else {
e244588e 2266 .tf.bar.rightbut configure -image bm-right
62e9ac5e 2267 }
e9937d2a 2268 pack .tf.bar.rightbut -side left -fill y
d698206c 2269
d93f1713 2270 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
6df7403a 2271 set rownumsel {}
d93f1713 2272 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
e244588e 2273 -relief sunken -anchor e
d93f1713
PT
2274 ${NS}::label .tf.bar.rowlabel2 -text "/"
2275 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
e244588e 2276 -relief sunken -anchor e
6df7403a 2277 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
e244588e 2278 -side left
d93f1713
PT
2279 if {!$use_ttk} {
2280 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2281 }
6df7403a 2282 global selectedline
94b4a69f 2283 trace add variable selectedline write selectedline_change
6df7403a 2284
bb3edc8b
PM
2285 # Status label and progress bar
2286 set statusw .tf.bar.status
d93f1713 2287 ${NS}::label $statusw -width 15 -relief sunken
bb3edc8b 2288 pack $statusw -side left -padx 5
d93f1713 2289 if {$use_ttk} {
e244588e 2290 set progresscanv [ttk::progressbar .tf.bar.progress]
d93f1713 2291 } else {
e244588e
DL
2292 set h [expr {[font metrics uifont -linespace] + 2}]
2293 set progresscanv .tf.bar.progress
2294 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2295 set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2296 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2297 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
d93f1713
PT
2298 }
2299 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
bb3edc8b
PM
2300 set progresscoords {0 0}
2301 set fprogcoord 0
a137a90f 2302 set rprogcoord 0
bb3edc8b
PM
2303 bind $progresscanv <Configure> adjustprogress
2304 set lastprogupdate [clock clicks -milliseconds]
2305 set progupdatepending 0
2306
687c8765 2307 # build up the bottom bar of upper window
d93f1713 2308 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
786f15c8
MB
2309
2310 set bm_down_data {
e244588e
DL
2311 #define down_width 16
2312 #define down_height 16
2313 static unsigned char down_bits[] = {
2314 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2315 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2316 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2317 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
786f15c8
MB
2318 }
2319 image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2320 ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2321 .tf.lbar.fnext configure -image bm-down
2322
2323 set bm_up_data {
e244588e
DL
2324 #define up_width 16
2325 #define up_height 16
2326 static unsigned char up_bits[] = {
2327 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2328 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2329 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2330 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
786f15c8
MB
2331 }
2332 image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2333 ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2334 .tf.lbar.fprev configure -image bm-up
2335
d93f1713 2336 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
786f15c8 2337
687c8765 2338 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
e244588e 2339 -side left -fill y
b007ee20 2340 set gdttype [mc "containing:"]
3cb1f9c9 2341 set gm [makedroplist .tf.lbar.gdttype gdttype \
e244588e
DL
2342 [mc "containing:"] \
2343 [mc "touching paths:"] \
2344 [mc "adding/removing string:"] \
2345 [mc "changing lines matching:"]]
687c8765 2346 trace add variable gdttype write gdttype_change
687c8765
PM
2347 pack .tf.lbar.gdttype -side left -fill y
2348
98f350e5 2349 set findstring {}
687c8765 2350 set fstring .tf.lbar.findstring
887fe3c4 2351 lappend entries $fstring
b9b142ff 2352 ${NS}::entry $fstring -width 30 -textvariable findstring
60f7a7dc 2353 trace add variable findstring write find_change
b007ee20 2354 set findtype [mc "Exact"]
d93f1713 2355 set findtypemenu [makedroplist .tf.lbar.findtype \
e244588e 2356 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 2357 trace add variable findtype write findcom_change
b007ee20 2358 set findloc [mc "All fields"]
d93f1713 2359 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
e244588e 2360 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 2361 trace add variable findloc write find_change
687c8765
PM
2362 pack .tf.lbar.findloc -side right
2363 pack .tf.lbar.findtype -side right
2364 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
2365
2366 # Finish putting the upper half of the viewer together
2367 pack .tf.lbar -in .tf -side bottom -fill x
2368 pack .tf.bar -in .tf -side bottom -fill x
2369 pack .tf.histframe -fill both -side top -expand 1
2370 .ctop add .tf
d93f1713 2371 if {!$use_ttk} {
e244588e
DL
2372 .ctop paneconfigure .tf -height $geometry(topheight)
2373 .ctop paneconfigure .tf -width $geometry(topwidth)
d93f1713 2374 }
e9937d2a
JH
2375
2376 # now build up the bottom
d93f1713 2377 ${NS}::panedwindow .pwbottom -orient horizontal
e9937d2a
JH
2378
2379 # lower left, a text box over search bar, scroll bar to the right
2380 # if we know window height, then that will set the lower text height, otherwise
2381 # we set lower text height which will drive window height
2382 if {[info exists geometry(main)]} {
e244588e 2383 ${NS}::frame .bleft -width $geometry(botwidth)
e9937d2a 2384 } else {
e244588e 2385 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
e9937d2a 2386 }
d93f1713
PT
2387 ${NS}::frame .bleft.top
2388 ${NS}::frame .bleft.mid
2389 ${NS}::frame .bleft.bottom
e9937d2a 2390
cae4b60a
GB
2391 # gap between sub-widgets
2392 set wgap [font measure uifont "i"]
2393
d93f1713 2394 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
2395 pack .bleft.top.search -side left -padx 5
2396 set sstring .bleft.top.sstring
d93f1713 2397 set searchstring ""
b9b142ff 2398 ${NS}::entry $sstring -width 20 -textvariable searchstring
3ea06f9f
PM
2399 lappend entries $sstring
2400 trace add variable searchstring write incrsearch
2401 pack $sstring -side left -expand 1 -fill x
d93f1713 2402 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
e244588e 2403 -command changediffdisp -variable diffelide -value {0 0}
d93f1713 2404 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
e244588e 2405 -command changediffdisp -variable diffelide -value {0 1}
d93f1713 2406 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
e244588e 2407 -command changediffdisp -variable diffelide -value {1 0}
cae4b60a 2408
d93f1713 2409 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
cae4b60a 2410 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
0933b04e 2411 spinbox .bleft.mid.diffcontext -width 5 \
e244588e
DL
2412 -from 0 -increment 1 -to 10000000 \
2413 -validate all -validatecommand "diffcontextvalidate %P" \
2414 -textvariable diffcontextstring
890fae70
SP
2415 .bleft.mid.diffcontext set $diffcontext
2416 trace add variable diffcontextstring write diffcontextchange
2417 lappend entries .bleft.mid.diffcontext
cae4b60a 2418 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
d93f1713 2419 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
e244588e 2420 -command changeignorespace -variable ignorespace
b9b86007 2421 pack .bleft.mid.ignspace -side left -padx 5
ae4e3ff9
TR
2422
2423 set worddiff [mc "Line diff"]
2424 if {[package vcompare $git_version "1.7.2"] >= 0} {
e244588e
DL
2425 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2426 [mc "Markup words"] [mc "Color words"]
2427 trace add variable worddiff write changeworddiff
2428 pack .bleft.mid.worddiff -side left -padx 5
ae4e3ff9
TR
2429 }
2430
8809d691 2431 set ctext .bleft.bottom.ctext
f8a2c0d1 2432 text $ctext -background $bgcolor -foreground $fgcolor \
e244588e
DL
2433 -state disabled -undo 0 -font textfont \
2434 -yscrollcommand scrolltext -wrap none \
2435 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4 2436 if {$have_tk85} {
e244588e 2437 $ctext conf -tabstyle wordprocessor
32f1b3e4 2438 }
d93f1713
PT
2439 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2440 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
e9937d2a 2441 pack .bleft.top -side top -fill x
a8d610a2 2442 pack .bleft.mid -side top -fill x
8809d691
PK
2443 grid $ctext .bleft.bottom.sb -sticky nsew
2444 grid .bleft.bottom.sbhorizontal -sticky ew
2445 grid columnconfigure .bleft.bottom 0 -weight 1
2446 grid rowconfigure .bleft.bottom 0 -weight 1
2447 grid rowconfigure .bleft.bottom 1 -weight 0
2448 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
2449 lappend bglist $ctext
2450 lappend fglist $ctext
d2610d11 2451
f1b86294 2452 $ctext tag conf comment -wrap $wrapcomment
252c52df 2453 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
f8a2c0d1
PM
2454 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2455 $ctext tag conf d0 -fore [lindex $diffcolors 0]
113ce124 2456 $ctext tag conf d0 -back [lindex $diffbgcolors 0]
8b07dca1 2457 $ctext tag conf dresult -fore [lindex $diffcolors 1]
113ce124 2458 $ctext tag conf dresult -back [lindex $diffbgcolors 1]
252c52df
2459 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2460 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2461 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2462 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2463 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2464 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2465 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2466 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2467 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2468 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2469 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2470 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2471 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2472 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2473 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2474 $ctext tag conf m15 -fore [lindex $mergecolors 15]
712fcc08 2475 $ctext tag conf mmax -fore darkgrey
b77b0278 2476 set mergemax 16
9c311b32
PM
2477 $ctext tag conf mresult -font textfontbold
2478 $ctext tag conf msep -font textfontbold
252c52df
2479 $ctext tag conf found -back $foundbgcolor
2480 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
76d64ca6 2481 $ctext tag conf wwrap -wrap word -lmargin2 1c
4399fe33 2482 $ctext tag conf bold -font textfontbold
2faa6cdc
JS
2483 # set these to the lowest priority:
2484 $ctext tag lower currentsearchhit
2485 $ctext tag lower found
2486 $ctext tag lower filesep
2487 $ctext tag lower dresult
2488 $ctext tag lower d0
e5c2d856 2489
e9937d2a 2490 .pwbottom add .bleft
d93f1713 2491 if {!$use_ttk} {
e244588e 2492 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
d93f1713 2493 }
e9937d2a
JH
2494
2495 # lower right
d93f1713
PT
2496 ${NS}::frame .bright
2497 ${NS}::frame .bright.mode
2498 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
e244588e 2499 -command reselectline -variable cmitmode -value "patch"
d93f1713 2500 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
e244588e 2501 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
2502 grid .bright.mode.patch .bright.mode.tree -sticky ew
2503 pack .bright.mode -side top -fill x
2504 set cflist .bright.cfiles
9c311b32 2505 set indent [font measure mainfont "nn"]
e9937d2a 2506 text $cflist \
e244588e
DL
2507 -selectbackground $selectbgcolor \
2508 -background $bgcolor -foreground $fgcolor \
2509 -font mainfont \
2510 -tabs [list $indent [expr {2 * $indent}]] \
2511 -yscrollcommand ".bright.sb set" \
2512 -cursor [. cget -cursor] \
2513 -spacing1 1 -spacing3 1
f8a2c0d1
PM
2514 lappend bglist $cflist
2515 lappend fglist $cflist
d93f1713 2516 ${NS}::scrollbar .bright.sb -command "$cflist yview"
e9937d2a 2517 pack .bright.sb -side right -fill y
d2610d11 2518 pack $cflist -side left -fill both -expand 1
89b11d3b 2519 $cflist tag configure highlight \
e244588e 2520 -background [$cflist cget -selectbackground]
9c311b32 2521 $cflist tag configure bold -font mainfontbold
d2610d11 2522
e9937d2a
JH
2523 .pwbottom add .bright
2524 .ctop add .pwbottom
1db95b00 2525
b9bee115 2526 # restore window width & height if known
e9937d2a 2527 if {[info exists geometry(main)]} {
e244588e
DL
2528 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2529 if {$w > [winfo screenwidth .]} {
2530 set w [winfo screenwidth .]
2531 }
2532 if {$h > [winfo screenheight .]} {
2533 set h [winfo screenheight .]
2534 }
2535 wm geometry . "${w}x$h"
2536 }
e9937d2a
JH
2537 }
2538
c876dbad
PT
2539 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2540 wm state . $geometry(state)
2541 }
2542
d23d98d3
SP
2543 if {[tk windowingsystem] eq {aqua}} {
2544 set M1B M1
5fdcbb13 2545 set ::BM "3"
d23d98d3
SP
2546 } else {
2547 set M1B Control
5fdcbb13 2548 set ::BM "2"
d23d98d3
SP
2549 }
2550
d93f1713
PT
2551 if {$use_ttk} {
2552 bind .ctop <Map> {
2553 bind %W <Map> {}
2554 %W sashpos 0 $::geometry(topheight)
2555 }
2556 bind .pwbottom <Map> {
2557 bind %W <Map> {}
2558 %W sashpos 0 $::geometry(botwidth)
2559 }
e244588e 2560 bind .pwbottom <Configure> {resizecdetpanes %W %w}
d93f1713
PT
2561 }
2562
e9937d2a 2563 pack .ctop -fill both -expand 1
c8dfbcf9
PM
2564 bindall <1> {selcanvline %W %x %y}
2565 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093 2566 if {[tk windowingsystem] == "win32"} {
e244588e
DL
2567 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2568 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
314c3093 2569 } else {
e244588e
DL
2570 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2571 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2572 bind $ctext <Button> {
2573 if {"%b" eq 6} {
2574 $ctext xview scroll -5 units
2575 } elseif {"%b" eq 7} {
2576 $ctext xview scroll 5 units
2577 }
2578 }
5dd57d51
JS
2579 if {[tk windowingsystem] eq "aqua"} {
2580 bindall <MouseWheel> {
2581 set delta [expr {- (%D)}]
2582 allcanvs yview scroll $delta units
2583 }
5fdcbb13
DS
2584 bindall <Shift-MouseWheel> {
2585 set delta [expr {- (%D)}]
2586 $canv xview scroll $delta units
2587 }
5dd57d51 2588 }
314c3093 2589 }
5fdcbb13
DS
2590 bindall <$::BM> "canvscan mark %W %x %y"
2591 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
decd0a1e
JL
2592 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2593 bind . <$M1B-Key-w> doquit
6e5f7203
RN
2594 bindkey <Home> selfirstline
2595 bindkey <End> sellastline
17386066
PM
2596 bind . <Key-Up> "selnextline -1"
2597 bind . <Key-Down> "selnextline 1"
cca5d946
PM
2598 bind . <Shift-Key-Up> "dofind -1 0"
2599 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
2600 bindkey <Key-Right> "goforw"
2601 bindkey <Key-Left> "goback"
2602 bind . <Key-Prior> "selnextpage -1"
2603 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
2604 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2605 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2606 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2607 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2608 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2609 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
2610 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2611 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2612 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
2613 bindkey p "selnextline -1"
2614 bindkey n "selnextline 1"
6e2dda35
RS
2615 bindkey z "goback"
2616 bindkey x "goforw"
811c70fc
JN
2617 bindkey k "selnextline -1"
2618 bindkey j "selnextline 1"
2619 bindkey h "goback"
6e2dda35 2620 bindkey l "goforw"
f4c54b3c 2621 bindkey b prevfile
cfb4563c
PM
2622 bindkey d "$ctext yview scroll 18 units"
2623 bindkey u "$ctext yview scroll -18 units"
0deb5c97 2624 bindkey g {$sha1entry delete 0 end; focus $sha1entry}
97bed034 2625 bindkey / {focus $fstring}
b6e192db 2626 bindkey <Key-KP_Divide> {focus $fstring}
cca5d946
PM
2627 bindkey <Key-Return> {dofind 1 1}
2628 bindkey ? {dofind -1 1}
39ad8570 2629 bindkey f nextfile
cea07cf8 2630 bind . <F5> updatecommits
ebb91db8 2631 bindmodfunctionkey Shift 5 reloadcommits
cea07cf8 2632 bind . <F2> showrefs
69ecfcd6 2633 bindmodfunctionkey Shift 4 {newview 0}
cea07cf8 2634 bind . <F4> edit_or_newview
d23d98d3 2635 bind . <$M1B-q> doquit
cca5d946
PM
2636 bind . <$M1B-f> {dofind 1 1}
2637 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
2638 bind . <$M1B-r> dosearchback
2639 bind . <$M1B-s> dosearch
2640 bind . <$M1B-equal> {incrfont 1}
646f3a14 2641 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
2642 bind . <$M1B-KP_Add> {incrfont 1}
2643 bind . <$M1B-minus> {incrfont -1}
2644 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 2645 wm protocol . WM_DELETE_WINDOW doquit
e2f90ee4 2646 bind . <Destroy> {stop_backends}
df3d83b1 2647 bind . <Button-1> "click %W"
cca5d946 2648 bind $fstring <Key-Return> {dofind 1 1}
968ce45c 2649 bind $sha1entry <Key-Return> {gotocommit; break}
ee3dc72e 2650 bind $sha1entry <<PasteSelection>> clearsha1
ada2ea16 2651 bind $sha1entry <<Paste>> clearsha1
7fcceed7
PM
2652 bind $cflist <1> {sel_flist %W %x %y; break}
2653 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 2654 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
d277e89f
PM
2655 global ctxbut
2656 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
7cdc3556 2657 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
4adcbea0 2658 bind $ctext <Button-1> {focus %W}
c4614994 2659 bind $ctext <<Selection>> rehighlight_search_results
d4ec30b2 2660 for {set i 1} {$i < 10} {incr i} {
e244588e 2661 bind . <$M1B-Key-$i> [list go_to_parent $i]
d4ec30b2 2662 }
ea13cba1
PM
2663
2664 set maincursor [. cget -cursor]
2665 set textcursor [$ctext cget -cursor]
94a2eede 2666 set curtextcursor $textcursor
84ba7345 2667
c8dfbcf9 2668 set rowctxmenu .rowctxmenu
f2d0bbbd 2669 makemenu $rowctxmenu {
e244588e
DL
2670 {mc "Diff this -> selected" command {diffvssel 0}}
2671 {mc "Diff selected -> this" command {diffvssel 1}}
2672 {mc "Make patch" command mkpatch}
2673 {mc "Create tag" command mktag}
2674 {mc "Copy commit reference" command copyreference}
2675 {mc "Write commit to file" command writecommit}
2676 {mc "Create new branch" command mkbranch}
2677 {mc "Cherry-pick this commit" command cherrypick}
2678 {mc "Reset HEAD branch to here" command resethead}
2679 {mc "Mark this commit" command markhere}
2680 {mc "Return to mark" command gotomark}
2681 {mc "Find descendant of this and mark" command find_common_desc}
2682 {mc "Compare with marked commit" command compare_commits}
2683 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2684 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2685 {mc "Revert this commit" command revert}
f2d0bbbd
PM
2686 }
2687 $rowctxmenu configure -tearoff 0
10299152 2688
219ea3a9 2689 set fakerowmenu .fakerowmenu
f2d0bbbd 2690 makemenu $fakerowmenu {
e244588e
DL
2691 {mc "Diff this -> selected" command {diffvssel 0}}
2692 {mc "Diff selected -> this" command {diffvssel 1}}
2693 {mc "Make patch" command mkpatch}
2694 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2695 {mc "Diff marked commit -> this" command {diffvsmark 1}}
f2d0bbbd
PM
2696 }
2697 $fakerowmenu configure -tearoff 0
219ea3a9 2698
10299152 2699 set headctxmenu .headctxmenu
f2d0bbbd 2700 makemenu $headctxmenu {
e244588e
DL
2701 {mc "Check out this branch" command cobranch}
2702 {mc "Rename this branch" command mvbranch}
2703 {mc "Remove this branch" command rmbranch}
2704 {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
f2d0bbbd
PM
2705 }
2706 $headctxmenu configure -tearoff 0
3244729a
PM
2707
2708 global flist_menu
2709 set flist_menu .flistctxmenu
f2d0bbbd 2710 makemenu $flist_menu {
e244588e
DL
2711 {mc "Highlight this too" command {flist_hl 0}}
2712 {mc "Highlight this only" command {flist_hl 1}}
2713 {mc "External diff" command {external_diff}}
2714 {mc "Blame parent commit" command {external_blame 1}}
2715 {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
f2d0bbbd
PM
2716 }
2717 $flist_menu configure -tearoff 0
7cdc3556
AG
2718
2719 global diff_menu
2720 set diff_menu .diffctxmenu
2721 makemenu $diff_menu {
e244588e
DL
2722 {mc "Show origin of this line" command show_line_source}
2723 {mc "Run git gui blame on this line" command {external_blame_diff}}
7cdc3556
AG
2724 }
2725 $diff_menu configure -tearoff 0
df3d83b1
PM
2726}
2727
314c3093
ML
2728# Windows sends all mouse wheel events to the current focused window, not
2729# the one where the mouse hovers, so bind those events here and redirect
2730# to the correct window
2731proc windows_mousewheel_redirector {W X Y D} {
2732 global canv canv2 canv3
2733 set w [winfo containing -displayof $W $X $Y]
2734 if {$w ne ""} {
e244588e
DL
2735 set u [expr {$D < 0 ? 5 : -5}]
2736 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2737 allcanvs yview scroll $u units
2738 } else {
2739 catch {
2740 $w yview scroll $u units
2741 }
2742 }
314c3093
ML
2743 }
2744}
2745
6df7403a
PM
2746# Update row number label when selectedline changes
2747proc selectedline_change {n1 n2 op} {
2748 global selectedline rownumsel
2749
94b4a69f 2750 if {$selectedline eq {}} {
e244588e 2751 set rownumsel {}
6df7403a 2752 } else {
e244588e 2753 set rownumsel [expr {$selectedline + 1}]
6df7403a
PM
2754 }
2755}
2756
be0cd098
PM
2757# mouse-2 makes all windows scan vertically, but only the one
2758# the cursor is in scans horizontally
2759proc canvscan {op w x y} {
2760 global canv canv2 canv3
2761 foreach c [list $canv $canv2 $canv3] {
e244588e
DL
2762 if {$c == $w} {
2763 $c scan $op $x $y
2764 } else {
2765 $c scan $op 0 $y
2766 }
be0cd098
PM
2767 }
2768}
2769
9f1afe05
PM
2770proc scrollcanv {cscroll f0 f1} {
2771 $cscroll set $f0 $f1
31c0eaa8 2772 drawvisible
908c3585 2773 flushhighlights
9f1afe05
PM
2774}
2775
df3d83b1
PM
2776# when we make a key binding for the toplevel, make sure
2777# it doesn't get triggered when that key is pressed in the
2778# find string entry widget.
2779proc bindkey {ev script} {
887fe3c4 2780 global entries
df3d83b1
PM
2781 bind . $ev $script
2782 set escript [bind Entry $ev]
2783 if {$escript == {}} {
e244588e 2784 set escript [bind Entry <Key>]
df3d83b1 2785 }
887fe3c4 2786 foreach e $entries {
e244588e 2787 bind $e $ev "$escript; break"
887fe3c4 2788 }
df3d83b1
PM
2789}
2790
69ecfcd6
AW
2791proc bindmodfunctionkey {mod n script} {
2792 bind . <$mod-F$n> $script
2793 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2794}
2795
df3d83b1 2796# set the focus back to the toplevel for any click outside
887fe3c4 2797# the entry widgets
df3d83b1 2798proc click {w} {
bd441de4
ML
2799 global ctext entries
2800 foreach e [concat $entries $ctext] {
e244588e 2801 if {$w == $e} return
df3d83b1 2802 }
887fe3c4 2803 focus .
0fba86b3
PM
2804}
2805
bb3edc8b
PM
2806# Adjust the progress bar for a change in requested extent or canvas size
2807proc adjustprogress {} {
2808 global progresscanv progressitem progresscoords
2809 global fprogitem fprogcoord lastprogupdate progupdatepending
d93f1713
PT
2810 global rprogitem rprogcoord use_ttk
2811
2812 if {$use_ttk} {
e244588e
DL
2813 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2814 return
d93f1713 2815 }
bb3edc8b
PM
2816
2817 set w [expr {[winfo width $progresscanv] - 4}]
2818 set x0 [expr {$w * [lindex $progresscoords 0]}]
2819 set x1 [expr {$w * [lindex $progresscoords 1]}]
2820 set h [winfo height $progresscanv]
2821 $progresscanv coords $progressitem $x0 0 $x1 $h
2822 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 2823 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
2824 set now [clock clicks -milliseconds]
2825 if {$now >= $lastprogupdate + 100} {
e244588e
DL
2826 set progupdatepending 0
2827 update
bb3edc8b 2828 } elseif {!$progupdatepending} {
e244588e
DL
2829 set progupdatepending 1
2830 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
bb3edc8b
PM
2831 }
2832}
2833
2834proc doprogupdate {} {
2835 global lastprogupdate progupdatepending
2836
2837 if {$progupdatepending} {
e244588e
DL
2838 set progupdatepending 0
2839 set lastprogupdate [clock clicks -milliseconds]
2840 update
bb3edc8b
PM
2841 }
2842}
2843
eaf7e835
MK
2844proc config_check_tmp_exists {tries_left} {
2845 global config_file_tmp
2846
2847 if {[file exists $config_file_tmp]} {
e244588e
DL
2848 incr tries_left -1
2849 if {$tries_left > 0} {
2850 after 100 [list config_check_tmp_exists $tries_left]
2851 } else {
2852 error_popup "There appears to be a stale $config_file_tmp\
eaf7e835
MK
2853 file, which will prevent gitk from saving its configuration on exit.\
2854 Please remove it if it is not being used by any existing gitk process."
e244588e 2855 }
eaf7e835
MK
2856 }
2857}
2858
995f792b
MK
2859proc config_init_trace {name} {
2860 global config_variable_changed config_variable_original
2861
2862 upvar #0 $name var
2863 set config_variable_changed($name) 0
2864 set config_variable_original($name) $var
2865}
2866
2867proc config_variable_change_cb {name name2 op} {
2868 global config_variable_changed config_variable_original
2869
2870 upvar #0 $name var
2871 if {$op eq "write" &&
e244588e
DL
2872 (![info exists config_variable_original($name)] ||
2873 $config_variable_original($name) ne $var)} {
2874 set config_variable_changed($name) 1
995f792b
MK
2875 }
2876}
2877
0fba86b3 2878proc savestuff {w} {
9fabefb1 2879 global stuffsaved
8f863398 2880 global config_file config_file_tmp
995f792b
MK
2881 global config_variables config_variable_changed
2882 global viewchanged
2883
2884 upvar #0 viewname current_viewname
2885 upvar #0 viewfiles current_viewfiles
2886 upvar #0 viewargs current_viewargs
2887 upvar #0 viewargscmd current_viewargscmd
2888 upvar #0 viewperm current_viewperm
2889 upvar #0 nextviewnum current_nextviewnum
2890 upvar #0 use_ttk current_use_ttk
4ef17537 2891
0fba86b3 2892 if {$stuffsaved} return
df3d83b1 2893 if {![winfo viewable .]} return
eaf7e835 2894 set remove_tmp 0
1dd29606 2895 if {[catch {
e244588e
DL
2896 set try_count 0
2897 while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2898 if {[incr try_count] > 50} {
2899 error "Unable to write config file: $config_file_tmp exists"
2900 }
2901 after 100
2902 }
2903 set remove_tmp 1
2904 if {$::tcl_platform(platform) eq {windows}} {
2905 file attributes $config_file_tmp -hidden true
2906 }
2907 if {[file exists $config_file]} {
2908 source $config_file
2909 }
2910 foreach var_name $config_variables {
2911 upvar #0 $var_name var
2912 upvar 0 $var_name old_var
2913 if {!$config_variable_changed($var_name) && [info exists old_var]} {
2914 puts $f [list set $var_name $old_var]
2915 } else {
2916 puts $f [list set $var_name $var]
2917 }
2918 }
2919
2920 puts $f "set geometry(main) [wm geometry .]"
2921 puts $f "set geometry(state) [wm state .]"
2922 puts $f "set geometry(topwidth) [winfo width .tf]"
2923 puts $f "set geometry(topheight) [winfo height .tf]"
2924 if {$current_use_ttk} {
2925 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2926 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2927 } else {
2928 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2929 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2930 }
2931 puts $f "set geometry(botwidth) [winfo width .bleft]"
2932 puts $f "set geometry(botheight) [winfo height .bleft]"
2933
2934 array set view_save {}
2935 array set views {}
2936 if {![info exists permviews]} { set permviews {} }
2937 foreach view $permviews {
2938 set view_save([lindex $view 0]) 1
2939 set views([lindex $view 0]) $view
2940 }
2941 puts -nonewline $f "set permviews {"
2942 for {set v 1} {$v < $current_nextviewnum} {incr v} {
2943 if {$viewchanged($v)} {
2944 if {$current_viewperm($v)} {
2945 set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2946 } else {
2947 set view_save($current_viewname($v)) 0
2948 }
2949 }
2950 }
2951 # write old and updated view to their places and append remaining to the end
2952 foreach view $permviews {
2953 set view_name [lindex $view 0]
2954 if {$view_save($view_name)} {
2955 puts $f "{$views($view_name)}"
2956 }
2957 unset views($view_name)
2958 }
2959 foreach view_name [array names views] {
2960 puts $f "{$views($view_name)}"
2961 }
2962 puts $f "}"
2963 close $f
2964 file rename -force $config_file_tmp $config_file
2965 set remove_tmp 0
1dd29606
MK
2966 } err]} {
2967 puts "Error saving config: $err"
0fba86b3 2968 }
eaf7e835 2969 if {$remove_tmp} {
e244588e 2970 file delete -force $config_file_tmp
eaf7e835 2971 }
0fba86b3 2972 set stuffsaved 1
1db95b00
PM
2973}
2974
43bddeb4 2975proc resizeclistpanes {win w} {
6cd80496 2976 global oldwidth oldsash use_ttk
418c4c7b 2977 if {[info exists oldwidth($win)]} {
1f6b1966 2978 if {[info exists oldsash($win)]} {
2979 set s0 [lindex $oldsash($win) 0]
2980 set s1 [lindex $oldsash($win) 1]
6cd80496 2981 } elseif {$use_ttk} {
e244588e
DL
2982 set s0 [$win sashpos 0]
2983 set s1 [$win sashpos 1]
2984 } else {
2985 set s0 [$win sash coord 0]
2986 set s1 [$win sash coord 1]
2987 }
2988 if {$w < 60} {
2989 set sash0 [expr {int($w/2 - 2)}]
2990 set sash1 [expr {int($w*5/6 - 2)}]
2991 } else {
2992 set factor [expr {1.0 * $w / $oldwidth($win)}]
2993 set sash0 [expr {int($factor * [lindex $s0 0])}]
2994 set sash1 [expr {int($factor * [lindex $s1 0])}]
2995 if {$sash0 < 30} {
2996 set sash0 30
2997 }
2998 if {$sash1 < $sash0 + 20} {
2999 set sash1 [expr {$sash0 + 20}]
3000 }
3001 if {$sash1 > $w - 10} {
3002 set sash1 [expr {$w - 10}]
3003 if {$sash0 > $sash1 - 20} {
3004 set sash0 [expr {$sash1 - 20}]
3005 }
3006 }
3007 }
3008 if {$use_ttk} {
3009 $win sashpos 0 $sash0
3010 $win sashpos 1 $sash1
3011 } else {
3012 $win sash place 0 $sash0 [lindex $s0 1]
3013 $win sash place 1 $sash1 [lindex $s1 1]
465f0386 3014 set sash0 [list $sash0 [lindex $s0 1]]
3015 set sash1 [list $sash1 [lindex $s1 1]]
e244588e 3016 }
1f6b1966 3017 set oldsash($win) [list $sash0 $sash1]
43bddeb4
PM
3018 }
3019 set oldwidth($win) $w
3020}
3021
3022proc resizecdetpanes {win w} {
6cd80496 3023 global oldwidth oldsash use_ttk
418c4c7b 3024 if {[info exists oldwidth($win)]} {
1f6b1966 3025 if {[info exists oldsash($win)]} {
3026 set s0 $oldsash($win)
6cd80496 3027 } elseif {$use_ttk} {
e244588e
DL
3028 set s0 [$win sashpos 0]
3029 } else {
3030 set s0 [$win sash coord 0]
3031 }
3032 if {$w < 60} {
3033 set sash0 [expr {int($w*3/4 - 2)}]
3034 } else {
3035 set factor [expr {1.0 * $w / $oldwidth($win)}]
3036 set sash0 [expr {int($factor * [lindex $s0 0])}]
3037 if {$sash0 < 45} {
3038 set sash0 45
3039 }
3040 if {$sash0 > $w - 15} {
3041 set sash0 [expr {$w - 15}]
3042 }
3043 }
3044 if {$use_ttk} {
3045 $win sashpos 0 $sash0
3046 } else {
3047 $win sash place 0 $sash0 [lindex $s0 1]
465f0386 3048 set sash0 [list $sash0 [lindex $s0 1]]
e244588e 3049 }
1f6b1966 3050 set oldsash($win) $sash0
43bddeb4
PM
3051 }
3052 set oldwidth($win) $w
3053}
3054
b5721c72
PM
3055proc allcanvs args {
3056 global canv canv2 canv3
3057 eval $canv $args
3058 eval $canv2 $args
3059 eval $canv3 $args
3060}
3061
3062proc bindall {event action} {
3063 global canv canv2 canv3
3064 bind $canv $event $action
3065 bind $canv2 $event $action
3066 bind $canv3 $event $action
3067}
3068
9a40c50c 3069proc about {} {
22a713c7 3070 global bgcolor NS
9a40c50c
PM
3071 set w .about
3072 if {[winfo exists $w]} {
e244588e
DL
3073 raise $w
3074 return
9a40c50c 3075 }
d93f1713 3076 ttk_toplevel $w
d990cedf 3077 wm title $w [mc "About gitk"]
e7d64008 3078 make_transient $w .
d990cedf 3079 message $w.m -text [mc "
9f1afe05 3080Gitk - a commit viewer for git
9a40c50c 3081
fbf42647 3082Copyright \u00a9 2005-2016 Paul Mackerras
9a40c50c 3083
d990cedf 3084Use and redistribute under the terms of the GNU General Public License"] \
e244588e 3085 -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3a950e9a 3086 pack $w.m -side top -fill x -padx 2 -pady 2
d93f1713 3087 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 3088 pack $w.ok -side bottom
3a950e9a
ER
3089 bind $w <Visibility> "focus $w.ok"
3090 bind $w <Key-Escape> "destroy $w"
3091 bind $w <Key-Return> "destroy $w"
d93f1713 3092 tk::PlaceWindow $w widget .
9a40c50c
PM
3093}
3094
4e95e1f7 3095proc keys {} {
22a713c7 3096 global bgcolor NS
4e95e1f7
PM
3097 set w .keys
3098 if {[winfo exists $w]} {
e244588e
DL
3099 raise $w
3100 return
4e95e1f7 3101 }
d23d98d3 3102 if {[tk windowingsystem] eq {aqua}} {
e244588e 3103 set M1T Cmd
d23d98d3 3104 } else {
e244588e 3105 set M1T Ctrl
d23d98d3 3106 }
d93f1713 3107 ttk_toplevel $w
d990cedf 3108 wm title $w [mc "Gitk key bindings"]
e7d64008 3109 make_transient $w .
3d2c998e
MB
3110 message $w.m -text "
3111[mc "Gitk key bindings:"]
3112
3113[mc "<%s-Q> Quit" $M1T]
decd0a1e 3114[mc "<%s-W> Close window" $M1T]
3d2c998e
MB
3115[mc "<Home> Move to first commit"]
3116[mc "<End> Move to last commit"]
811c70fc
JN
3117[mc "<Up>, p, k Move up one commit"]
3118[mc "<Down>, n, j Move down one commit"]
3119[mc "<Left>, z, h Go back in history list"]
3d2c998e 3120[mc "<Right>, x, l Go forward in history list"]
d4ec30b2 3121[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
3d2c998e
MB
3122[mc "<PageUp> Move up one page in commit list"]
3123[mc "<PageDown> Move down one page in commit list"]
3124[mc "<%s-Home> Scroll to top of commit list" $M1T]
3125[mc "<%s-End> Scroll to bottom of commit list" $M1T]
3126[mc "<%s-Up> Scroll commit list up one line" $M1T]
3127[mc "<%s-Down> Scroll commit list down one line" $M1T]
3128[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
3129[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
3130[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3131[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
3132[mc "<Delete>, b Scroll diff view up one page"]
3133[mc "<Backspace> Scroll diff view up one page"]
3134[mc "<Space> Scroll diff view down one page"]
3135[mc "u Scroll diff view up 18 lines"]
3136[mc "d Scroll diff view down 18 lines"]
3137[mc "<%s-F> Find" $M1T]
3138[mc "<%s-G> Move to next find hit" $M1T]
3139[mc "<Return> Move to next find hit"]
0deb5c97 3140[mc "g Go to commit"]
97bed034 3141[mc "/ Focus the search box"]
3d2c998e
MB
3142[mc "? Move to previous find hit"]
3143[mc "f Scroll diff view to next file"]
3144[mc "<%s-S> Search for next hit in diff view" $M1T]
3145[mc "<%s-R> Search for previous hit in diff view" $M1T]
3146[mc "<%s-KP+> Increase font size" $M1T]
3147[mc "<%s-plus> Increase font size" $M1T]
3148[mc "<%s-KP-> Decrease font size" $M1T]
3149[mc "<%s-minus> Decrease font size" $M1T]
3150[mc "<F5> Update"]
3151" \
e244588e 3152 -justify left -bg $bgcolor -border 2 -relief groove
3a950e9a 3153 pack $w.m -side top -fill both -padx 2 -pady 2
d93f1713 3154 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
76f15947 3155 bind $w <Key-Escape> [list destroy $w]
4e95e1f7 3156 pack $w.ok -side bottom
3a950e9a
ER
3157 bind $w <Visibility> "focus $w.ok"
3158 bind $w <Key-Escape> "destroy $w"
3159 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
3160}
3161
7fcceed7
PM
3162# Procedures for manipulating the file list window at the
3163# bottom right of the overall window.
f8b28a40
PM
3164
3165proc treeview {w l openlevs} {
3166 global treecontents treediropen treeheight treeparent treeindex
3167
3168 set ix 0
3169 set treeindex() 0
3170 set lev 0
3171 set prefix {}
3172 set prefixend -1
3173 set prefendstack {}
3174 set htstack {}
3175 set ht 0
3176 set treecontents() {}
3177 $w conf -state normal
3178 foreach f $l {
e244588e
DL
3179 while {[string range $f 0 $prefixend] ne $prefix} {
3180 if {$lev <= $openlevs} {
3181 $w mark set e:$treeindex($prefix) "end -1c"
3182 $w mark gravity e:$treeindex($prefix) left
3183 }
3184 set treeheight($prefix) $ht
3185 incr ht [lindex $htstack end]
3186 set htstack [lreplace $htstack end end]
3187 set prefixend [lindex $prefendstack end]
3188 set prefendstack [lreplace $prefendstack end end]
3189 set prefix [string range $prefix 0 $prefixend]
3190 incr lev -1
3191 }
3192 set tail [string range $f [expr {$prefixend+1}] end]
3193 while {[set slash [string first "/" $tail]] >= 0} {
3194 lappend htstack $ht
3195 set ht 0
3196 lappend prefendstack $prefixend
3197 incr prefixend [expr {$slash + 1}]
3198 set d [string range $tail 0 $slash]
3199 lappend treecontents($prefix) $d
3200 set oldprefix $prefix
3201 append prefix $d
3202 set treecontents($prefix) {}
3203 set treeindex($prefix) [incr ix]
3204 set treeparent($prefix) $oldprefix
3205 set tail [string range $tail [expr {$slash+1}] end]
3206 if {$lev <= $openlevs} {
3207 set ht 1
3208 set treediropen($prefix) [expr {$lev < $openlevs}]
3209 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3210 $w mark set d:$ix "end -1c"
3211 $w mark gravity d:$ix left
3212 set str "\n"
3213 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3214 $w insert end $str
3215 $w image create end -align center -image $bm -padx 1 \
3216 -name a:$ix
3217 $w insert end $d [highlight_tag $prefix]
3218 $w mark set s:$ix "end -1c"
3219 $w mark gravity s:$ix left
3220 }
3221 incr lev
3222 }
3223 if {$tail ne {}} {
3224 if {$lev <= $openlevs} {
3225 incr ht
3226 set str "\n"
3227 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3228 $w insert end $str
3229 $w insert end $tail [highlight_tag $f]
3230 }
3231 lappend treecontents($prefix) $tail
3232 }
f8b28a40
PM
3233 }
3234 while {$htstack ne {}} {
e244588e
DL
3235 set treeheight($prefix) $ht
3236 incr ht [lindex $htstack end]
3237 set htstack [lreplace $htstack end end]
3238 set prefixend [lindex $prefendstack end]
3239 set prefendstack [lreplace $prefendstack end end]
3240 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
3241 }
3242 $w conf -state disabled
3243}
3244
3245proc linetoelt {l} {
3246 global treeheight treecontents
3247
3248 set y 2
3249 set prefix {}
3250 while {1} {
e244588e
DL
3251 foreach e $treecontents($prefix) {
3252 if {$y == $l} {
3253 return "$prefix$e"
3254 }
3255 set n 1
3256 if {[string index $e end] eq "/"} {
3257 set n $treeheight($prefix$e)
3258 if {$y + $n > $l} {
3259 append prefix $e
3260 incr y
3261 break
3262 }
3263 }
3264 incr y $n
3265 }
f8b28a40
PM
3266 }
3267}
3268
45a9d505
PM
3269proc highlight_tree {y prefix} {
3270 global treeheight treecontents cflist
3271
3272 foreach e $treecontents($prefix) {
e244588e
DL
3273 set path $prefix$e
3274 if {[highlight_tag $path] ne {}} {
3275 $cflist tag add bold $y.0 "$y.0 lineend"
3276 }
3277 incr y
3278 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3279 set y [highlight_tree $y $path]
3280 }
45a9d505
PM
3281 }
3282 return $y
3283}
3284
f8b28a40
PM
3285proc treeclosedir {w dir} {
3286 global treediropen treeheight treeparent treeindex
3287
3288 set ix $treeindex($dir)
3289 $w conf -state normal
3290 $w delete s:$ix e:$ix
3291 set treediropen($dir) 0
3292 $w image configure a:$ix -image tri-rt
3293 $w conf -state disabled
3294 set n [expr {1 - $treeheight($dir)}]
3295 while {$dir ne {}} {
e244588e
DL
3296 incr treeheight($dir) $n
3297 set dir $treeparent($dir)
f8b28a40
PM
3298 }
3299}
3300
3301proc treeopendir {w dir} {
3302 global treediropen treeheight treeparent treecontents treeindex
3303
3304 set ix $treeindex($dir)
3305 $w conf -state normal
3306 $w image configure a:$ix -image tri-dn
3307 $w mark set e:$ix s:$ix
3308 $w mark gravity e:$ix right
3309 set lev 0
3310 set str "\n"
3311 set n [llength $treecontents($dir)]
3312 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
e244588e
DL
3313 incr lev
3314 append str "\t"
3315 incr treeheight($x) $n
f8b28a40
PM
3316 }
3317 foreach e $treecontents($dir) {
e244588e
DL
3318 set de $dir$e
3319 if {[string index $e end] eq "/"} {
3320 set iy $treeindex($de)
3321 $w mark set d:$iy e:$ix
3322 $w mark gravity d:$iy left
3323 $w insert e:$ix $str
3324 set treediropen($de) 0
3325 $w image create e:$ix -align center -image tri-rt -padx 1 \
3326 -name a:$iy
3327 $w insert e:$ix $e [highlight_tag $de]
3328 $w mark set s:$iy e:$ix
3329 $w mark gravity s:$iy left
3330 set treeheight($de) 1
3331 } else {
3332 $w insert e:$ix $str
3333 $w insert e:$ix $e [highlight_tag $de]
3334 }
f8b28a40 3335 }
b8a640ee 3336 $w mark gravity e:$ix right
f8b28a40
PM
3337 $w conf -state disabled
3338 set treediropen($dir) 1
3339 set top [lindex [split [$w index @0,0] .] 0]
3340 set ht [$w cget -height]
3341 set l [lindex [split [$w index s:$ix] .] 0]
3342 if {$l < $top} {
e244588e 3343 $w yview $l.0
f8b28a40 3344 } elseif {$l + $n + 1 > $top + $ht} {
e244588e
DL
3345 set top [expr {$l + $n + 2 - $ht}]
3346 if {$l < $top} {
3347 set top $l
3348 }
3349 $w yview $top.0
f8b28a40
PM
3350 }
3351}
3352
3353proc treeclick {w x y} {
3354 global treediropen cmitmode ctext cflist cflist_top
3355
3356 if {$cmitmode ne "tree"} return
3357 if {![info exists cflist_top]} return
3358 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3359 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3360 $cflist tag add highlight $l.0 "$l.0 lineend"
3361 set cflist_top $l
3362 if {$l == 1} {
e244588e
DL
3363 $ctext yview 1.0
3364 return
f8b28a40
PM
3365 }
3366 set e [linetoelt $l]
3367 if {[string index $e end] ne "/"} {
e244588e 3368 showfile $e
f8b28a40 3369 } elseif {$treediropen($e)} {
e244588e 3370 treeclosedir $w $e
f8b28a40 3371 } else {
e244588e 3372 treeopendir $w $e
f8b28a40
PM
3373 }
3374}
3375
3376proc setfilelist {id} {
8a897742 3377 global treefilelist cflist jump_to_here
f8b28a40
PM
3378
3379 treeview $cflist $treefilelist($id) 0
8a897742 3380 if {$jump_to_here ne {}} {
e244588e
DL
3381 set f [lindex $jump_to_here 0]
3382 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3383 showfile $f
3384 }
8a897742 3385 }
f8b28a40
PM
3386}
3387
3388image create bitmap tri-rt -background black -foreground blue -data {
3389 #define tri-rt_width 13
3390 #define tri-rt_height 13
3391 static unsigned char tri-rt_bits[] = {
3392 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3393 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3394 0x00, 0x00};
3395} -maskdata {
3396 #define tri-rt-mask_width 13
3397 #define tri-rt-mask_height 13
3398 static unsigned char tri-rt-mask_bits[] = {
3399 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3400 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3401 0x08, 0x00};
3402}
3403image create bitmap tri-dn -background black -foreground blue -data {
3404 #define tri-dn_width 13
3405 #define tri-dn_height 13
3406 static unsigned char tri-dn_bits[] = {
3407 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3408 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3409 0x00, 0x00};
3410} -maskdata {
3411 #define tri-dn-mask_width 13
3412 #define tri-dn-mask_height 13
3413 static unsigned char tri-dn-mask_bits[] = {
3414 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3415 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3416 0x00, 0x00};
3417}
3418
887c996e
PM
3419image create bitmap reficon-T -background black -foreground yellow -data {
3420 #define tagicon_width 13
3421 #define tagicon_height 9
3422 static unsigned char tagicon_bits[] = {
3423 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3424 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3425} -maskdata {
3426 #define tagicon-mask_width 13
3427 #define tagicon-mask_height 9
3428 static unsigned char tagicon-mask_bits[] = {
3429 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3430 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3431}
3432set rectdata {
3433 #define headicon_width 13
3434 #define headicon_height 9
3435 static unsigned char headicon_bits[] = {
3436 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3437 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3438}
3439set rectmask {
3440 #define headicon-mask_width 13
3441 #define headicon-mask_height 9
3442 static unsigned char headicon-mask_bits[] = {
3443 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3444 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3445}
6e8fda5f 3446image create bitmap reficon-H -background black -foreground "#00ff00" \
887c996e 3447 -data $rectdata -maskdata $rectmask
d7cc4fb0
PW
3448image create bitmap reficon-R -background black -foreground "#ffddaa" \
3449 -data $rectdata -maskdata $rectmask
887c996e
PM
3450image create bitmap reficon-o -background black -foreground "#ddddff" \
3451 -data $rectdata -maskdata $rectmask
3452
7fcceed7 3453proc init_flist {first} {
7fcc92bf 3454 global cflist cflist_top difffilestart
7fcceed7
PM
3455
3456 $cflist conf -state normal
3457 $cflist delete 0.0 end
3458 if {$first ne {}} {
e244588e
DL
3459 $cflist insert end $first
3460 set cflist_top 1
3461 $cflist tag add highlight 1.0 "1.0 lineend"
7fcceed7 3462 } else {
e244588e 3463 unset -nocomplain cflist_top
7fcceed7
PM
3464 }
3465 $cflist conf -state disabled
3466 set difffilestart {}
3467}
3468
63b79191
PM
3469proc highlight_tag {f} {
3470 global highlight_paths
3471
3472 foreach p $highlight_paths {
e244588e
DL
3473 if {[string match $p $f]} {
3474 return "bold"
3475 }
63b79191
PM
3476 }
3477 return {}
3478}
3479
3480proc highlight_filelist {} {
45a9d505 3481 global cmitmode cflist
63b79191 3482
45a9d505
PM
3483 $cflist conf -state normal
3484 if {$cmitmode ne "tree"} {
e244588e
DL
3485 set end [lindex [split [$cflist index end] .] 0]
3486 for {set l 2} {$l < $end} {incr l} {
3487 set line [$cflist get $l.0 "$l.0 lineend"]
3488 if {[highlight_tag $line] ne {}} {
3489 $cflist tag add bold $l.0 "$l.0 lineend"
3490 }
3491 }
45a9d505 3492 } else {
e244588e 3493 highlight_tree 2 {}
63b79191 3494 }
45a9d505 3495 $cflist conf -state disabled
63b79191
PM
3496}
3497
3498proc unhighlight_filelist {} {
45a9d505 3499 global cflist
63b79191 3500
45a9d505
PM
3501 $cflist conf -state normal
3502 $cflist tag remove bold 1.0 end
3503 $cflist conf -state disabled
63b79191
PM
3504}
3505
f8b28a40 3506proc add_flist {fl} {
45a9d505 3507 global cflist
7fcceed7 3508
45a9d505
PM
3509 $cflist conf -state normal
3510 foreach f $fl {
e244588e
DL
3511 $cflist insert end "\n"
3512 $cflist insert end $f [highlight_tag $f]
7fcceed7 3513 }
45a9d505 3514 $cflist conf -state disabled
7fcceed7
PM
3515}
3516
3517proc sel_flist {w x y} {
45a9d505 3518 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 3519
f8b28a40 3520 if {$cmitmode eq "tree"} return
7fcceed7
PM
3521 if {![info exists cflist_top]} return
3522 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
3523 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3524 $cflist tag add highlight $l.0 "$l.0 lineend"
3525 set cflist_top $l
f8b28a40 3526 if {$l == 1} {
e244588e 3527 $ctext yview 1.0
f8b28a40 3528 } else {
e244588e 3529 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 3530 }
b967135d 3531 suppress_highlighting_file_for_current_scrollpos
7fcceed7
PM
3532}
3533
3244729a
PM
3534proc pop_flist_menu {w X Y x y} {
3535 global ctext cflist cmitmode flist_menu flist_menu_file
3536 global treediffs diffids
3537
bb3edc8b 3538 stopfinding
3244729a
PM
3539 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3540 if {$l <= 1} return
3541 if {$cmitmode eq "tree"} {
e244588e
DL
3542 set e [linetoelt $l]
3543 if {[string index $e end] eq "/"} return
3244729a 3544 } else {
e244588e 3545 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3244729a
PM
3546 }
3547 set flist_menu_file $e
314f5de1
TA
3548 set xdiffstate "normal"
3549 if {$cmitmode eq "tree"} {
e244588e 3550 set xdiffstate "disabled"
314f5de1
TA
3551 }
3552 # Disable "External diff" item in tree mode
3553 $flist_menu entryconf 2 -state $xdiffstate
3244729a
PM
3554 tk_popup $flist_menu $X $Y
3555}
3556
7cdc3556
AG
3557proc find_ctext_fileinfo {line} {
3558 global ctext_file_names ctext_file_lines
3559
3560 set ok [bsearch $ctext_file_lines $line]
3561 set tline [lindex $ctext_file_lines $ok]
3562
3563 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3564 return {}
3565 } else {
3566 return [list [lindex $ctext_file_names $ok] $tline]
3567 }
3568}
3569
3570proc pop_diff_menu {w X Y x y} {
3571 global ctext diff_menu flist_menu_file
3572 global diff_menu_txtpos diff_menu_line
3573 global diff_menu_filebase
3574
7cdc3556
AG
3575 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3576 set diff_menu_line [lindex $diff_menu_txtpos 0]
190ec52c
PM
3577 # don't pop up the menu on hunk-separator or file-separator lines
3578 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
e244588e 3579 return
190ec52c
PM
3580 }
3581 stopfinding
7cdc3556
AG
3582 set f [find_ctext_fileinfo $diff_menu_line]
3583 if {$f eq {}} return
3584 set flist_menu_file [lindex $f 0]
3585 set diff_menu_filebase [lindex $f 1]
3586 tk_popup $diff_menu $X $Y
3587}
3588
3244729a 3589proc flist_hl {only} {
bb3edc8b 3590 global flist_menu_file findstring gdttype
3244729a
PM
3591
3592 set x [shellquote $flist_menu_file]
b007ee20 3593 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
e244588e 3594 set findstring $x
3244729a 3595 } else {
e244588e 3596 append findstring " " $x
3244729a 3597 }
b007ee20 3598 set gdttype [mc "touching paths:"]
3244729a
PM
3599}
3600
c21398be 3601proc gitknewtmpdir {} {
c7664f1a 3602 global diffnum gitktmpdir gitdir env
c21398be
PM
3603
3604 if {![info exists gitktmpdir]} {
e244588e
DL
3605 if {[info exists env(GITK_TMPDIR)]} {
3606 set tmpdir $env(GITK_TMPDIR)
3607 } elseif {[info exists env(TMPDIR)]} {
3608 set tmpdir $env(TMPDIR)
3609 } else {
3610 set tmpdir $gitdir
3611 }
3612 set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3613 if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3614 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3615 }
3616 if {[catch {file mkdir $gitktmpdir} err]} {
3617 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3618 unset gitktmpdir
3619 return {}
3620 }
3621 set diffnum 0
c21398be
PM
3622 }
3623 incr diffnum
3624 set diffdir [file join $gitktmpdir $diffnum]
3625 if {[catch {file mkdir $diffdir} err]} {
e244588e
DL
3626 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3627 return {}
c21398be
PM
3628 }
3629 return $diffdir
3630}
3631
314f5de1
TA
3632proc save_file_from_commit {filename output what} {
3633 global nullfile
3634
3635 if {[catch {exec git show $filename -- > $output} err]} {
e244588e
DL
3636 if {[string match "fatal: bad revision *" $err]} {
3637 return $nullfile
3638 }
3639 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3640 return {}
314f5de1
TA
3641 }
3642 return $output
3643}
3644
3645proc external_diff_get_one_file {diffid filename diffdir} {
3646 global nullid nullid2 nullfile
784b7e2f 3647 global worktree
314f5de1
TA
3648
3649 if {$diffid == $nullid} {
784b7e2f 3650 set difffile [file join $worktree $filename]
e244588e
DL
3651 if {[file exists $difffile]} {
3652 return $difffile
3653 }
3654 return $nullfile
314f5de1
TA
3655 }
3656 if {$diffid == $nullid2} {
3657 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3658 return [save_file_from_commit :$filename $difffile index]
3659 }
3660 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3661 return [save_file_from_commit $diffid:$filename $difffile \
e244588e 3662 "revision $diffid"]
314f5de1
TA
3663}
3664
3665proc external_diff {} {
c21398be 3666 global nullid nullid2
314f5de1
TA
3667 global flist_menu_file
3668 global diffids
c21398be 3669 global extdifftool
314f5de1
TA
3670
3671 if {[llength $diffids] == 1} {
3672 # no reference commit given
3673 set diffidto [lindex $diffids 0]
3674 if {$diffidto eq $nullid} {
3675 # diffing working copy with index
3676 set diffidfrom $nullid2
3677 } elseif {$diffidto eq $nullid2} {
3678 # diffing index with HEAD
3679 set diffidfrom "HEAD"
3680 } else {
3681 # use first parent commit
3682 global parentlist selectedline
3683 set diffidfrom [lindex $parentlist $selectedline 0]
3684 }
3685 } else {
3686 set diffidfrom [lindex $diffids 0]
3687 set diffidto [lindex $diffids 1]
3688 }
3689
3690 # make sure that several diffs wont collide
c21398be
PM
3691 set diffdir [gitknewtmpdir]
3692 if {$diffdir eq {}} return
314f5de1
TA
3693
3694 # gather files to diff
3695 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3696 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3697
3698 if {$difffromfile ne {} && $difftofile ne {}} {
b575b2f1
PT
3699 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3700 if {[catch {set fl [open |$cmd r]} err]} {
314f5de1 3701 file delete -force $diffdir
3945d2c0 3702 error_popup "$extdifftool: [mc "command failed:"] $err"
314f5de1
TA
3703 } else {
3704 fconfigure $fl -blocking 0
3705 filerun $fl [list delete_at_eof $fl $diffdir]
3706 }
3707 }
3708}
3709
7cdc3556
AG
3710proc find_hunk_blamespec {base line} {
3711 global ctext
3712
3713 # Find and parse the hunk header
3714 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3715 if {$s_lix eq {}} return
3716
3717 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3718 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
e244588e
DL
3719 s_line old_specs osz osz1 new_line nsz]} {
3720 return
7cdc3556
AG
3721 }
3722
3723 # base lines for the parents
3724 set base_lines [list $new_line]
3725 foreach old_spec [lrange [split $old_specs " "] 1 end] {
e244588e
DL
3726 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3727 old_spec old_line osz]} {
3728 return
3729 }
3730 lappend base_lines $old_line
7cdc3556
AG
3731 }
3732
3733 # Now scan the lines to determine offset within the hunk
7cdc3556
AG
3734 set max_parent [expr {[llength $base_lines]-2}]
3735 set dline 0
3736 set s_lno [lindex [split $s_lix "."] 0]
3737
190ec52c
PM
3738 # Determine if the line is removed
3739 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3740 if {[string match {[-+ ]*} $chunk]} {
e244588e
DL
3741 set removed_idx [string first "-" $chunk]
3742 # Choose a parent index
3743 if {$removed_idx >= 0} {
3744 set parent $removed_idx
3745 } else {
3746 set unchanged_idx [string first " " $chunk]
3747 if {$unchanged_idx >= 0} {
3748 set parent $unchanged_idx
3749 } else {
3750 # blame the current commit
3751 set parent -1
3752 }
3753 }
3754 # then count other lines that belong to it
3755 for {set i $line} {[incr i -1] > $s_lno} {} {
3756 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3757 # Determine if the line is removed
3758 set removed_idx [string first "-" $chunk]
3759 if {$parent >= 0} {
3760 set code [string index $chunk $parent]
3761 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3762 incr dline
3763 }
3764 } else {
3765 if {$removed_idx < 0} {
3766 incr dline
3767 }
3768 }
3769 }
3770 incr parent
190ec52c 3771 } else {
e244588e 3772 set parent 0
7cdc3556
AG
3773 }
3774
7cdc3556
AG
3775 incr dline [lindex $base_lines $parent]
3776 return [list $parent $dline]
3777}
3778
3779proc external_blame_diff {} {
8b07dca1 3780 global currentid cmitmode
7cdc3556
AG
3781 global diff_menu_txtpos diff_menu_line
3782 global diff_menu_filebase flist_menu_file
3783
3784 if {$cmitmode eq "tree"} {
e244588e
DL
3785 set parent_idx 0
3786 set line [expr {$diff_menu_line - $diff_menu_filebase}]
7cdc3556 3787 } else {
e244588e
DL
3788 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3789 if {$hinfo ne {}} {
3790 set parent_idx [lindex $hinfo 0]
3791 set line [lindex $hinfo 1]
3792 } else {
3793 set parent_idx 0
3794 set line 0
3795 }
7cdc3556
AG
3796 }
3797
3798 external_blame $parent_idx $line
3799}
3800
fc4977e1
PM
3801# Find the SHA1 ID of the blob for file $fname in the index
3802# at stage 0 or 2
3803proc index_sha1 {fname} {
3804 set f [open [list | git ls-files -s $fname] r]
3805 while {[gets $f line] >= 0} {
e244588e
DL
3806 set info [lindex [split $line "\t"] 0]
3807 set stage [lindex $info 2]
3808 if {$stage eq "0" || $stage eq "2"} {
3809 close $f
3810 return [lindex $info 1]
3811 }
fc4977e1
PM
3812 }
3813 close $f
3814 return {}
3815}
3816
9712b81a
PM
3817# Turn an absolute path into one relative to the current directory
3818proc make_relative {f} {
a4390ace 3819 if {[file pathtype $f] eq "relative"} {
e244588e 3820 return $f
a4390ace 3821 }
9712b81a
PM
3822 set elts [file split $f]
3823 set here [file split [pwd]]
3824 set ei 0
3825 set hi 0
3826 set res {}
3827 foreach d $here {
e244588e
DL
3828 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3829 lappend res ".."
3830 } else {
3831 incr ei
3832 }
3833 incr hi
9712b81a
PM
3834 }
3835 set elts [concat $res [lrange $elts $ei end]]
3836 return [eval file join $elts]
3837}
3838
7cdc3556 3839proc external_blame {parent_idx {line {}}} {
0a2a9793 3840 global flist_menu_file cdup
77aa0ae8
AG
3841 global nullid nullid2
3842 global parentlist selectedline currentid
3843
3844 if {$parent_idx > 0} {
e244588e 3845 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
77aa0ae8 3846 } else {
e244588e 3847 set base_commit $currentid
77aa0ae8
AG
3848 }
3849
3850 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
e244588e
DL
3851 error_popup [mc "No such commit"]
3852 return
77aa0ae8
AG
3853 }
3854
7cdc3556
AG
3855 set cmdline [list git gui blame]
3856 if {$line ne {} && $line > 1} {
e244588e 3857 lappend cmdline "--line=$line"
7cdc3556 3858 }
0a2a9793 3859 set f [file join $cdup $flist_menu_file]
9712b81a
PM
3860 # Unfortunately it seems git gui blame doesn't like
3861 # being given an absolute path...
3862 set f [make_relative $f]
3863 lappend cmdline $base_commit $f
7cdc3556 3864 if {[catch {eval exec $cmdline &} err]} {
e244588e 3865 error_popup "[mc "git gui blame: command failed:"] $err"
77aa0ae8
AG
3866 }
3867}
3868
8a897742
PM
3869proc show_line_source {} {
3870 global cmitmode currentid parents curview blamestuff blameinst
3871 global diff_menu_line diff_menu_filebase flist_menu_file
9b6adf34 3872 global nullid nullid2 gitdir cdup
8a897742 3873
fc4977e1 3874 set from_index {}
8a897742 3875 if {$cmitmode eq "tree"} {
e244588e
DL
3876 set id $currentid
3877 set line [expr {$diff_menu_line - $diff_menu_filebase}]
8a897742 3878 } else {
e244588e
DL
3879 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3880 if {$h eq {}} return
3881 set pi [lindex $h 0]
3882 if {$pi == 0} {
3883 mark_ctext_line $diff_menu_line
3884 return
3885 }
3886 incr pi -1
3887 if {$currentid eq $nullid} {
3888 if {$pi > 0} {
3889 # must be a merge in progress...
3890 if {[catch {
3891 # get the last line from .git/MERGE_HEAD
3892 set f [open [file join $gitdir MERGE_HEAD] r]
3893 set id [lindex [split [read $f] "\n"] end-1]
3894 close $f
3895 } err]} {
3896 error_popup [mc "Couldn't read merge head: %s" $err]
3897 return
3898 }
3899 } elseif {$parents($curview,$currentid) eq $nullid2} {
3900 # need to do the blame from the index
3901 if {[catch {
3902 set from_index [index_sha1 $flist_menu_file]
3903 } err]} {
3904 error_popup [mc "Error reading index: %s" $err]
3905 return
3906 }
3907 } else {
3908 set id $parents($curview,$currentid)
3909 }
3910 } else {
3911 set id [lindex $parents($curview,$currentid) $pi]
3912 }
3913 set line [lindex $h 1]
3914 }
3915 set blameargs {}
fc4977e1 3916 if {$from_index ne {}} {
e244588e 3917 lappend blameargs | git cat-file blob $from_index
fc4977e1
PM
3918 }
3919 lappend blameargs | git blame -p -L$line,+1
3920 if {$from_index ne {}} {
e244588e 3921 lappend blameargs --contents -
fc4977e1 3922 } else {
e244588e 3923 lappend blameargs $id
fc4977e1 3924 }
9b6adf34 3925 lappend blameargs -- [file join $cdup $flist_menu_file]
8a897742 3926 if {[catch {
e244588e 3927 set f [open $blameargs r]
8a897742 3928 } err]} {
e244588e
DL
3929 error_popup [mc "Couldn't start git blame: %s" $err]
3930 return
8a897742 3931 }
f3413079 3932 nowbusy blaming [mc "Searching"]
8a897742
PM
3933 fconfigure $f -blocking 0
3934 set i [reg_instance $f]
3935 set blamestuff($i) {}
3936 set blameinst $i
3937 filerun $f [list read_line_source $f $i]
3938}
3939
3940proc stopblaming {} {
3941 global blameinst
3942
3943 if {[info exists blameinst]} {
e244588e
DL
3944 stop_instance $blameinst
3945 unset blameinst
3946 notbusy blaming
8a897742
PM
3947 }
3948}
3949
3950proc read_line_source {fd inst} {
fc4977e1 3951 global blamestuff curview commfd blameinst nullid nullid2
8a897742
PM
3952
3953 while {[gets $fd line] >= 0} {
e244588e 3954 lappend blamestuff($inst) $line
8a897742
PM
3955 }
3956 if {![eof $fd]} {
e244588e 3957 return 1
8a897742
PM
3958 }
3959 unset commfd($inst)
3960 unset blameinst
f3413079 3961 notbusy blaming
8a897742
PM
3962 fconfigure $fd -blocking 1
3963 if {[catch {close $fd} err]} {
e244588e
DL
3964 error_popup [mc "Error running git blame: %s" $err]
3965 return 0
8a897742
PM
3966 }
3967
3968 set fname {}
3969 set line [split [lindex $blamestuff($inst) 0] " "]
3970 set id [lindex $line 0]
3971 set lnum [lindex $line 1]
3972 if {[string length $id] == 40 && [string is xdigit $id] &&
e244588e
DL
3973 [string is digit -strict $lnum]} {
3974 # look for "filename" line
3975 foreach l $blamestuff($inst) {
3976 if {[string match "filename *" $l]} {
3977 set fname [string range $l 9 end]
3978 break
3979 }
3980 }
8a897742
PM
3981 }
3982 if {$fname ne {}} {
e244588e
DL
3983 # all looks good, select it
3984 if {$id eq $nullid} {
3985 # blame uses all-zeroes to mean not committed,
3986 # which would mean a change in the index
3987 set id $nullid2
3988 }
3989 if {[commitinview $id $curview]} {
3990 selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3991 } else {
3992 error_popup [mc "That line comes from commit %s, \
3993 which is not in this view" [shortids $id]]
3994 }
8a897742 3995 } else {
e244588e 3996 puts "oops couldn't parse git blame output"
8a897742
PM
3997 }
3998 return 0
3999}
4000
314f5de1
TA
4001# delete $dir when we see eof on $f (presumably because the child has exited)
4002proc delete_at_eof {f dir} {
4003 while {[gets $f line] >= 0} {}
4004 if {[eof $f]} {
e244588e
DL
4005 if {[catch {close $f} err]} {
4006 error_popup "[mc "External diff viewer failed:"] $err"
4007 }
4008 file delete -force $dir
4009 return 0
314f5de1
TA
4010 }
4011 return 1
4012}
4013
098dd8a3
PM
4014# Functions for adding and removing shell-type quoting
4015
4016proc shellquote {str} {
4017 if {![string match "*\['\"\\ \t]*" $str]} {
e244588e 4018 return $str
098dd8a3
PM
4019 }
4020 if {![string match "*\['\"\\]*" $str]} {
e244588e 4021 return "\"$str\""
098dd8a3
PM
4022 }
4023 if {![string match "*'*" $str]} {
e244588e 4024 return "'$str'"
098dd8a3
PM
4025 }
4026 return "\"[string map {\" \\\" \\ \\\\} $str]\""
4027}
4028
4029proc shellarglist {l} {
4030 set str {}
4031 foreach a $l {
e244588e
DL
4032 if {$str ne {}} {
4033 append str " "
4034 }
4035 append str [shellquote $a]
098dd8a3
PM
4036 }
4037 return $str
4038}
4039
4040proc shelldequote {str} {
4041 set ret {}
4042 set used -1
4043 while {1} {
e244588e
DL
4044 incr used
4045 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4046 append ret [string range $str $used end]
4047 set used [string length $str]
4048 break
4049 }
4050 set first [lindex $first 0]
4051 set ch [string index $str $first]
4052 if {$first > $used} {
4053 append ret [string range $str $used [expr {$first - 1}]]
4054 set used $first
4055 }
4056 if {$ch eq " " || $ch eq "\t"} break
4057 incr used
4058 if {$ch eq "'"} {
4059 set first [string first "'" $str $used]
4060 if {$first < 0} {
4061 error "unmatched single-quote"
4062 }
4063 append ret [string range $str $used [expr {$first - 1}]]
4064 set used $first
4065 continue
4066 }
4067 if {$ch eq "\\"} {
4068 if {$used >= [string length $str]} {
4069 error "trailing backslash"
4070 }
4071 append ret [string index $str $used]
4072 continue
4073 }
4074 # here ch == "\""
4075 while {1} {
4076 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4077 error "unmatched double-quote"
4078 }
4079 set first [lindex $first 0]
4080 set ch [string index $str $first]
4081 if {$first > $used} {
4082 append ret [string range $str $used [expr {$first - 1}]]
4083 set used $first
4084 }
4085 if {$ch eq "\""} break
4086 incr used
4087 append ret [string index $str $used]
4088 incr used
4089 }
098dd8a3
PM
4090 }
4091 return [list $used $ret]
4092}
4093
4094proc shellsplit {str} {
4095 set l {}
4096 while {1} {
e244588e
DL
4097 set str [string trimleft $str]
4098 if {$str eq {}} break
4099 set dq [shelldequote $str]
4100 set n [lindex $dq 0]
4101 set word [lindex $dq 1]
4102 set str [string range $str $n end]
4103 lappend l $word
098dd8a3
PM
4104 }
4105 return $l
4106}
4107
9922c5a3
MB
4108proc set_window_title {} {
4109 global appname curview viewname vrevs
4110 set rev [mc "All files"]
4111 if {$curview ne 0} {
e244588e
DL
4112 if {$viewname($curview) eq [mc "Command line"]} {
4113 set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4114 } else {
4115 set rev $viewname($curview)
4116 }
9922c5a3
MB
4117 }
4118 wm title . "[reponame]: $rev - $appname"
4119}
4120
7fcceed7
PM
4121# Code to implement multiple views
4122
da7c24dd 4123proc newview {ishighlight} {
218a900b
AG
4124 global nextviewnum newviewname newishighlight
4125 global revtreeargs viewargscmd newviewopts curview
50b44ece 4126
da7c24dd 4127 set newishighlight $ishighlight
50b44ece
PM
4128 set top .gitkview
4129 if {[winfo exists $top]} {
e244588e
DL
4130 raise $top
4131 return
50b44ece 4132 }
5d11f794 4133 decode_view_opts $nextviewnum $revtreeargs
a3a1f579 4134 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
218a900b
AG
4135 set newviewopts($nextviewnum,perm) 0
4136 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
d990cedf 4137 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
4138}
4139
218a900b 4140set known_view_options {
13d40b61
EN
4141 {perm b . {} {mc "Remember this view"}}
4142 {reflabel l + {} {mc "References (space separated list):"}}
4143 {refs t15 .. {} {mc "Branches & tags:"}}
4144 {allrefs b *. "--all" {mc "All refs"}}
4145 {branches b . "--branches" {mc "All (local) branches"}}
4146 {tags b . "--tags" {mc "All tags"}}
4147 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
4148 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
4149 {author t15 .. "--author=*" {mc "Author:"}}
4150 {committer t15 . "--committer=*" {mc "Committer:"}}
4151 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
4152 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
0013251f 4153 {igrep b .. "--invert-grep" {mc "Matches no Commit Info criteria"}}
13d40b61
EN
4154 {changes_l l + {} {mc "Changes to Files:"}}
4155 {pickaxe_s r0 . {} {mc "Fixed String"}}
4156 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
4157 {pickaxe t15 .. "-S*" {mc "Search string:"}}
4158 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4159 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
4160 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
4161 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
4162 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
4163 {skip t10 . "--skip=*" {mc "Number to skip:"}}
4164 {misc_lbl l + {} {mc "Miscellaneous options:"}}
4165 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
4166 {lright b . "--left-right" {mc "Mark branch sides"}}
4167 {first b . "--first-parent" {mc "Limit to first parent"}}
f687aaa8 4168 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
13d40b61
EN
4169 {args t50 *. {} {mc "Additional arguments to git log:"}}
4170 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4171 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
218a900b
AG
4172 }
4173
e7feb695 4174# Convert $newviewopts($n, ...) into args for git log.
218a900b
AG
4175proc encode_view_opts {n} {
4176 global known_view_options newviewopts
4177
4178 set rargs [list]
4179 foreach opt $known_view_options {
e244588e
DL
4180 set patterns [lindex $opt 3]
4181 if {$patterns eq {}} continue
4182 set pattern [lindex $patterns 0]
4183
4184 if {[lindex $opt 1] eq "b"} {
4185 set val $newviewopts($n,[lindex $opt 0])
4186 if {$val} {
4187 lappend rargs $pattern
4188 }
4189 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4190 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4191 set val $newviewopts($n,$button_id)
4192 if {$val eq $value} {
4193 lappend rargs $pattern
4194 }
4195 } else {
4196 set val $newviewopts($n,[lindex $opt 0])
4197 set val [string trim $val]
4198 if {$val ne {}} {
4199 set pfix [string range $pattern 0 end-1]
4200 lappend rargs $pfix$val
4201 }
4202 }
218a900b 4203 }
13d40b61 4204 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
218a900b
AG
4205 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4206}
4207
e7feb695 4208# Fill $newviewopts($n, ...) based on args for git log.
218a900b
AG
4209proc decode_view_opts {n view_args} {
4210 global known_view_options newviewopts
4211
4212 foreach opt $known_view_options {
e244588e
DL
4213 set id [lindex $opt 0]
4214 if {[lindex $opt 1] eq "b"} {
4215 # Checkboxes
4216 set val 0
13d40b61 4217 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
e244588e
DL
4218 # Radiobuttons
4219 regexp {^(.*_)} $id uselessvar id
4220 set val 0
4221 } else {
4222 # Text fields
4223 set val {}
4224 }
4225 set newviewopts($n,$id) $val
218a900b
AG
4226 }
4227 set oargs [list]
13d40b61 4228 set refargs [list]
218a900b 4229 foreach arg $view_args {
e244588e
DL
4230 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4231 && ![info exists found(limit)]} {
4232 set newviewopts($n,limit) $cnt
4233 set found(limit) 1
4234 continue
4235 }
4236 catch { unset val }
4237 foreach opt $known_view_options {
4238 set id [lindex $opt 0]
4239 if {[info exists found($id)]} continue
4240 foreach pattern [lindex $opt 3] {
4241 if {![string match $pattern $arg]} continue
4242 if {[lindex $opt 1] eq "b"} {
4243 # Check buttons
4244 set val 1
4245 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4246 # Radio buttons
4247 regexp {^(.*_)} $id uselessvar id
4248 set val $num
4249 } else {
4250 # Text input fields
4251 set size [string length $pattern]
4252 set val [string range $arg [expr {$size-1}] end]
4253 }
4254 set newviewopts($n,$id) $val
4255 set found($id) 1
4256 break
4257 }
4258 if {[info exists val]} break
4259 }
4260 if {[info exists val]} continue
4261 if {[regexp {^-} $arg]} {
4262 lappend oargs $arg
4263 } else {
4264 lappend refargs $arg
4265 }
218a900b 4266 }
13d40b61 4267 set newviewopts($n,refs) [shellarglist $refargs]
218a900b
AG
4268 set newviewopts($n,args) [shellarglist $oargs]
4269}
4270
cea07cf8
AG
4271proc edit_or_newview {} {
4272 global curview
4273
4274 if {$curview > 0} {
e244588e 4275 editview
cea07cf8 4276 } else {
e244588e 4277 newview 0
cea07cf8
AG
4278 }
4279}
4280
d16c0812
PM
4281proc editview {} {
4282 global curview
218a900b
AG
4283 global viewname viewperm newviewname newviewopts
4284 global viewargs viewargscmd
d16c0812
PM
4285
4286 set top .gitkvedit-$curview
4287 if {[winfo exists $top]} {
e244588e
DL
4288 raise $top
4289 return
d16c0812 4290 }
5d11f794 4291 decode_view_opts $curview $viewargs($curview)
218a900b
AG
4292 set newviewname($curview) $viewname($curview)
4293 set newviewopts($curview,perm) $viewperm($curview)
4294 set newviewopts($curview,cmd) $viewargscmd($curview)
b56e0a9a 4295 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
d16c0812
PM
4296}
4297
4298proc vieweditor {top n title} {
218a900b 4299 global newviewname newviewopts viewfiles bgcolor
d93f1713 4300 global known_view_options NS
d16c0812 4301
d93f1713 4302 ttk_toplevel $top
e0a01995 4303 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
e7d64008 4304 make_transient $top .
218a900b
AG
4305
4306 # View name
d93f1713 4307 ${NS}::frame $top.nfr
eae7d64a 4308 ${NS}::label $top.nl -text [mc "View Name"]
d93f1713 4309 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
218a900b 4310 pack $top.nfr -in $top -fill x -pady 5 -padx 3
13d40b61
EN
4311 pack $top.nl -in $top.nfr -side left -padx {0 5}
4312 pack $top.name -in $top.nfr -side left -padx {0 25}
218a900b
AG
4313
4314 # View options
4315 set cframe $top.nfr
4316 set cexpand 0
4317 set cnt 0
4318 foreach opt $known_view_options {
e244588e
DL
4319 set id [lindex $opt 0]
4320 set type [lindex $opt 1]
4321 set flags [lindex $opt 2]
4322 set title [eval [lindex $opt 4]]
4323 set lxpad 0
4324
4325 if {$flags eq "+" || $flags eq "*"} {
4326 set cframe $top.fr$cnt
4327 incr cnt
4328 ${NS}::frame $cframe
4329 pack $cframe -in $top -fill x -pady 3 -padx 3
4330 set cexpand [expr {$flags eq "*"}]
13d40b61 4331 } elseif {$flags eq ".." || $flags eq "*."} {
e244588e
DL
4332 set cframe $top.fr$cnt
4333 incr cnt
4334 ${NS}::frame $cframe
4335 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4336 set cexpand [expr {$flags eq "*."}]
4337 } else {
4338 set lxpad 5
4339 }
4340
4341 if {$type eq "l"} {
eae7d64a 4342 ${NS}::label $cframe.l_$id -text $title
13d40b61 4343 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
e244588e
DL
4344 } elseif {$type eq "b"} {
4345 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4346 pack $cframe.c_$id -in $cframe -side left \
4347 -padx [list $lxpad 0] -expand $cexpand -anchor w
4348 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4349 regexp {^(.*_)} $id uselessvar button_id
4350 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4351 pack $cframe.c_$id -in $cframe -side left \
4352 -padx [list $lxpad 0] -expand $cexpand -anchor w
4353 } elseif {[regexp {^t(\d+)$} $type type sz]} {
4354 ${NS}::label $cframe.l_$id -text $title
4355 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4356 -textvariable newviewopts($n,$id)
4357 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4358 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4359 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4360 ${NS}::label $cframe.l_$id -text $title
4361 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4362 -textvariable newviewopts($n,$id)
4363 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4364 pack $cframe.e_$id -in $cframe -side top -fill x
4365 } elseif {$type eq "path"} {
4366 ${NS}::label $top.l -text $title
4367 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4368 text $top.t -width 40 -height 5 -background $bgcolor
4369 if {[info exists viewfiles($n)]} {
4370 foreach f $viewfiles($n) {
4371 $top.t insert end $f
4372 $top.t insert end "\n"
4373 }
4374 $top.t delete {end - 1c} end
4375 $top.t mark set insert 0.0
4376 }
4377 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4378 }
218a900b
AG
4379 }
4380
d93f1713
PT
4381 ${NS}::frame $top.buts
4382 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4383 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4384 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
218a900b
AG
4385 bind $top <Control-Return> [list newviewok $top $n]
4386 bind $top <F5> [list newviewok $top $n 1]
76f15947 4387 bind $top <Escape> [list destroy $top]
218a900b 4388 grid $top.buts.ok $top.buts.apply $top.buts.can
50b44ece
PM
4389 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4390 grid columnconfigure $top.buts 1 -weight 1 -uniform a
218a900b
AG
4391 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4392 pack $top.buts -in $top -side top -fill x
50b44ece
PM
4393 focus $top.t
4394}
4395
908c3585 4396proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
4397 set nmenu [$m index end]
4398 for {set i $first} {$i <= $nmenu} {incr i} {
e244588e
DL
4399 if {[$m entrycget $i -command] eq $cmd} {
4400 eval $m $op $i $argv
4401 break
4402 }
d16c0812 4403 }
da7c24dd
PM
4404}
4405
4406proc allviewmenus {n op args} {
687c8765 4407 # global viewhlmenu
908c3585 4408
3cd204e5 4409 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 4410 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
4411}
4412
218a900b 4413proc newviewok {top n {apply 0}} {
da7c24dd 4414 global nextviewnum newviewperm newviewname newishighlight
995f792b 4415 global viewname viewfiles viewperm viewchanged selectedview curview
218a900b 4416 global viewargs viewargscmd newviewopts viewhlmenu
50b44ece 4417
098dd8a3 4418 if {[catch {
e244588e 4419 set newargs [encode_view_opts $n]
098dd8a3 4420 } err]} {
e244588e
DL
4421 error_popup "[mc "Error in commit selection arguments:"] $err" $top
4422 return
098dd8a3 4423 }
50b44ece 4424 set files {}
d16c0812 4425 foreach f [split [$top.t get 0.0 end] "\n"] {
e244588e
DL
4426 set ft [string trim $f]
4427 if {$ft ne {}} {
4428 lappend files $ft
4429 }
50b44ece 4430 }
d16c0812 4431 if {![info exists viewfiles($n)]} {
e244588e
DL
4432 # creating a new view
4433 incr nextviewnum
4434 set viewname($n) $newviewname($n)
4435 set viewperm($n) $newviewopts($n,perm)
4436 set viewchanged($n) 1
4437 set viewfiles($n) $files
4438 set viewargs($n) $newargs
4439 set viewargscmd($n) $newviewopts($n,cmd)
4440 addviewmenu $n
4441 if {!$newishighlight} {
4442 run showview $n
4443 } else {
4444 run addvhighlight $n
4445 }
d16c0812 4446 } else {
e244588e
DL
4447 # editing an existing view
4448 set viewperm($n) $newviewopts($n,perm)
4449 set viewchanged($n) 1
4450 if {$newviewname($n) ne $viewname($n)} {
4451 set viewname($n) $newviewname($n)
4452 doviewmenu .bar.view 5 [list showview $n] \
4453 entryconf [list -label $viewname($n)]
4454 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4455 # entryconf [list -label $viewname($n) -value $viewname($n)]
4456 }
4457 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4458 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4459 set viewfiles($n) $files
4460 set viewargs($n) $newargs
4461 set viewargscmd($n) $newviewopts($n,cmd)
4462 if {$curview == $n} {
4463 run reloadcommits
4464 }
4465 }
d16c0812 4466 }
218a900b 4467 if {$apply} return
d16c0812 4468 catch {destroy $top}
50b44ece
PM
4469}
4470
4471proc delview {} {
995f792b 4472 global curview viewperm hlview selectedhlview viewchanged
50b44ece
PM
4473
4474 if {$curview == 0} return
908c3585 4475 if {[info exists hlview] && $hlview == $curview} {
e244588e
DL
4476 set selectedhlview [mc "None"]
4477 unset hlview
908c3585 4478 }
da7c24dd 4479 allviewmenus $curview delete
a90a6d24 4480 set viewperm($curview) 0
995f792b 4481 set viewchanged($curview) 1
50b44ece
PM
4482 showview 0
4483}
4484
da7c24dd 4485proc addviewmenu {n} {
908c3585 4486 global viewname viewhlmenu
da7c24dd
PM
4487
4488 .bar.view add radiobutton -label $viewname($n) \
e244588e 4489 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
4490 #$viewhlmenu add radiobutton -label $viewname($n) \
4491 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
4492}
4493
50b44ece 4494proc showview {n} {
3ed31a81 4495 global curview cached_commitrow ordertok
f5f3c2e2 4496 global displayorder parentlist rowidlist rowisopt rowfinal
7fcc92bf
PM
4497 global colormap rowtextx nextcolor canvxmax
4498 global numcommits viewcomplete
50b44ece 4499 global selectedline currentid canv canvy0
4fb0fa19 4500 global treediffs
3e76608d 4501 global pending_select mainheadid
0380081c 4502 global commitidx
3e76608d 4503 global selectedview
97645683 4504 global hlview selectedhlview commitinterest
50b44ece
PM
4505
4506 if {$n == $curview} return
4507 set selid {}
7fcc92bf
PM
4508 set ymax [lindex [$canv cget -scrollregion] 3]
4509 set span [$canv yview]
4510 set ytop [expr {[lindex $span 0] * $ymax}]
4511 set ybot [expr {[lindex $span 1] * $ymax}]
4512 set yscreen [expr {($ybot - $ytop) / 2}]
94b4a69f 4513 if {$selectedline ne {}} {
e244588e
DL
4514 set selid $currentid
4515 set y [yc $selectedline]
4516 if {$ytop < $y && $y < $ybot} {
4517 set yscreen [expr {$y - $ytop}]
4518 }
e507fd48 4519 } elseif {[info exists pending_select]} {
e244588e
DL
4520 set selid $pending_select
4521 unset pending_select
50b44ece
PM
4522 }
4523 unselectline
fdedbcfb 4524 normalline
009409fe 4525 unset -nocomplain treediffs
50b44ece 4526 clear_display
908c3585 4527 if {[info exists hlview] && $hlview == $n} {
e244588e
DL
4528 unset hlview
4529 set selectedhlview [mc "None"]
908c3585 4530 }
009409fe
PM
4531 unset -nocomplain commitinterest
4532 unset -nocomplain cached_commitrow
4533 unset -nocomplain ordertok
50b44ece
PM
4534
4535 set curview $n
a90a6d24 4536 set selectedview $n
d99b4b0d
GB
4537 .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4538 .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 4539
df904497 4540 run refill_reflist
7fcc92bf 4541 if {![info exists viewcomplete($n)]} {
e244588e
DL
4542 getcommits $selid
4543 return
50b44ece
PM
4544 }
4545
7fcc92bf
PM
4546 set displayorder {}
4547 set parentlist {}
4548 set rowidlist {}
4549 set rowisopt {}
4550 set rowfinal {}
f5f3c2e2 4551 set numcommits $commitidx($n)
22626ef4 4552
009409fe
PM
4553 unset -nocomplain colormap
4554 unset -nocomplain rowtextx
da7c24dd
PM
4555 set nextcolor 0
4556 set canvxmax [$canv cget -width]
50b44ece
PM
4557 set curview $n
4558 set row 0
50b44ece
PM
4559 setcanvscroll
4560 set yf 0
e507fd48 4561 set row {}
7fcc92bf 4562 if {$selid ne {} && [commitinview $selid $n]} {
e244588e
DL
4563 set row [rowofcommit $selid]
4564 # try to get the selected row in the same position on the screen
4565 set ymax [lindex [$canv cget -scrollregion] 3]
4566 set ytop [expr {[yc $row] - $yscreen}]
4567 if {$ytop < 0} {
4568 set ytop 0
4569 }
4570 set yf [expr {$ytop * 1.0 / $ymax}]
50b44ece
PM
4571 }
4572 allcanvs yview moveto $yf
4573 drawvisible
e507fd48 4574 if {$row ne {}} {
e244588e 4575 selectline $row 0
3e76608d 4576 } elseif {!$viewcomplete($n)} {
e244588e 4577 reset_pending_select $selid
e507fd48 4578 } else {
e244588e 4579 reset_pending_select {}
835e62ae 4580
e244588e
DL
4581 if {[commitinview $pending_select $curview]} {
4582 selectline [rowofcommit $pending_select] 1
4583 } else {
4584 set row [first_real_row]
4585 if {$row < $numcommits} {
4586 selectline $row 0
4587 }
4588 }
e507fd48 4589 }
7fcc92bf 4590 if {!$viewcomplete($n)} {
e244588e
DL
4591 if {$numcommits == 0} {
4592 show_status [mc "Reading commits..."]
4593 }
098dd8a3 4594 } elseif {$numcommits == 0} {
e244588e 4595 show_status [mc "No commits selected"]
2516dae2 4596 }
9922c5a3 4597 set_window_title
50b44ece
PM
4598}
4599
908c3585
PM
4600# Stuff relating to the highlighting facility
4601
476ca63d 4602proc ishighlighted {id} {
164ff275 4603 global vhighlights fhighlights nhighlights rhighlights
908c3585 4604
476ca63d 4605 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
e244588e 4606 return $nhighlights($id)
908c3585 4607 }
476ca63d 4608 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
e244588e 4609 return $vhighlights($id)
908c3585 4610 }
476ca63d 4611 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
e244588e 4612 return $fhighlights($id)
908c3585 4613 }
476ca63d 4614 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
e244588e 4615 return $rhighlights($id)
164ff275 4616 }
908c3585
PM
4617 return 0
4618}
4619
28593d3f 4620proc bolden {id font} {
b9fdba7f 4621 global canv linehtag currentid boldids need_redisplay markedid
908c3585 4622
d98d50e2
PM
4623 # need_redisplay = 1 means the display is stale and about to be redrawn
4624 if {$need_redisplay} return
28593d3f
PM
4625 lappend boldids $id
4626 $canv itemconf $linehtag($id) -font $font
4627 if {[info exists currentid] && $id eq $currentid} {
e244588e
DL
4628 $canv delete secsel
4629 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4630 -outline {{}} -tags secsel \
4631 -fill [$canv cget -selectbackground]]
4632 $canv lower $t
908c3585 4633 }
b9fdba7f 4634 if {[info exists markedid] && $id eq $markedid} {
e244588e 4635 make_idmark $id
b9fdba7f 4636 }
908c3585
PM
4637}
4638
28593d3f
PM
4639proc bolden_name {id font} {
4640 global canv2 linentag currentid boldnameids need_redisplay
908c3585 4641
d98d50e2 4642 if {$need_redisplay} return
28593d3f
PM
4643 lappend boldnameids $id
4644 $canv2 itemconf $linentag($id) -font $font
4645 if {[info exists currentid] && $id eq $currentid} {
e244588e
DL
4646 $canv2 delete secsel
4647 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4648 -outline {{}} -tags secsel \
4649 -fill [$canv2 cget -selectbackground]]
4650 $canv2 lower $t
908c3585
PM
4651 }
4652}
4653
4e7d6779 4654proc unbolden {} {
28593d3f 4655 global boldids
908c3585 4656
4e7d6779 4657 set stillbold {}
28593d3f 4658 foreach id $boldids {
e244588e
DL
4659 if {![ishighlighted $id]} {
4660 bolden $id mainfont
4661 } else {
4662 lappend stillbold $id
4663 }
908c3585 4664 }
28593d3f 4665 set boldids $stillbold
908c3585
PM
4666}
4667
4668proc addvhighlight {n} {
476ca63d 4669 global hlview viewcomplete curview vhl_done commitidx
da7c24dd
PM
4670
4671 if {[info exists hlview]} {
e244588e 4672 delvhighlight
da7c24dd
PM
4673 }
4674 set hlview $n
7fcc92bf 4675 if {$n != $curview && ![info exists viewcomplete($n)]} {
e244588e 4676 start_rev_list $n
908c3585
PM
4677 }
4678 set vhl_done $commitidx($hlview)
4679 if {$vhl_done > 0} {
e244588e 4680 drawvisible
da7c24dd
PM
4681 }
4682}
4683
908c3585
PM
4684proc delvhighlight {} {
4685 global hlview vhighlights
da7c24dd
PM
4686
4687 if {![info exists hlview]} return
4688 unset hlview
009409fe 4689 unset -nocomplain vhighlights
4e7d6779 4690 unbolden
da7c24dd
PM
4691}
4692
908c3585 4693proc vhighlightmore {} {
7fcc92bf 4694 global hlview vhl_done commitidx vhighlights curview
da7c24dd 4695
da7c24dd 4696 set max $commitidx($hlview)
908c3585
PM
4697 set vr [visiblerows]
4698 set r0 [lindex $vr 0]
4699 set r1 [lindex $vr 1]
4700 for {set i $vhl_done} {$i < $max} {incr i} {
e244588e
DL
4701 set id [commitonrow $i $hlview]
4702 if {[commitinview $id $curview]} {
4703 set row [rowofcommit $id]
4704 if {$r0 <= $row && $row <= $r1} {
4705 if {![highlighted $row]} {
4706 bolden $id mainfontbold
4707 }
4708 set vhighlights($id) 1
4709 }
4710 }
da7c24dd 4711 }
908c3585 4712 set vhl_done $max
ac1276ab 4713 return 0
908c3585
PM
4714}
4715
4716proc askvhighlight {row id} {
7fcc92bf 4717 global hlview vhighlights iddrawn
908c3585 4718
7fcc92bf 4719 if {[commitinview $id $hlview]} {
e244588e
DL
4720 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4721 bolden $id mainfontbold
4722 }
4723 set vhighlights($id) 1
908c3585 4724 } else {
e244588e 4725 set vhighlights($id) 0
908c3585
PM
4726 }
4727}
4728
687c8765 4729proc hfiles_change {} {
908c3585 4730 global highlight_files filehighlight fhighlights fh_serial
8b39e04f 4731 global highlight_paths
908c3585
PM
4732
4733 if {[info exists filehighlight]} {
e244588e
DL
4734 # delete previous highlights
4735 catch {close $filehighlight}
4736 unset filehighlight
4737 unset -nocomplain fhighlights
4738 unbolden
4739 unhighlight_filelist
908c3585 4740 }
63b79191 4741 set highlight_paths {}
908c3585
PM
4742 after cancel do_file_hl $fh_serial
4743 incr fh_serial
4744 if {$highlight_files ne {}} {
e244588e 4745 after 300 do_file_hl $fh_serial
908c3585
PM
4746 }
4747}
4748
687c8765
PM
4749proc gdttype_change {name ix op} {
4750 global gdttype highlight_files findstring findpattern
4751
bb3edc8b 4752 stopfinding
687c8765 4753 if {$findstring ne {}} {
e244588e
DL
4754 if {$gdttype eq [mc "containing:"]} {
4755 if {$highlight_files ne {}} {
4756 set highlight_files {}
4757 hfiles_change
4758 }
4759 findcom_change
4760 } else {
4761 if {$findpattern ne {}} {
4762 set findpattern {}
4763 findcom_change
4764 }
4765 set highlight_files $findstring
4766 hfiles_change
4767 }
4768 drawvisible
687c8765
PM
4769 }
4770 # enable/disable findtype/findloc menus too
4771}
4772
4773proc find_change {name ix op} {
4774 global gdttype findstring highlight_files
4775
bb3edc8b 4776 stopfinding
b007ee20 4777 if {$gdttype eq [mc "containing:"]} {
e244588e 4778 findcom_change
687c8765 4779 } else {
e244588e
DL
4780 if {$highlight_files ne $findstring} {
4781 set highlight_files $findstring
4782 hfiles_change
4783 }
687c8765
PM
4784 }
4785 drawvisible
4786}
4787
64b5f146 4788proc findcom_change args {
28593d3f 4789 global nhighlights boldnameids
687c8765
PM
4790 global findpattern findtype findstring gdttype
4791
bb3edc8b 4792 stopfinding
687c8765 4793 # delete previous highlights, if any
28593d3f 4794 foreach id $boldnameids {
e244588e 4795 bolden_name $id mainfont
687c8765 4796 }
28593d3f 4797 set boldnameids {}
009409fe 4798 unset -nocomplain nhighlights
687c8765
PM
4799 unbolden
4800 unmarkmatches
b007ee20 4801 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
e244588e 4802 set findpattern {}
b007ee20 4803 } elseif {$findtype eq [mc "Regexp"]} {
e244588e 4804 set findpattern $findstring
687c8765 4805 } else {
e244588e
DL
4806 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4807 $findstring]
4808 set findpattern "*$e*"
687c8765
PM
4809 }
4810}
4811
63b79191
PM
4812proc makepatterns {l} {
4813 set ret {}
4814 foreach e $l {
e244588e
DL
4815 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4816 if {[string index $ee end] eq "/"} {
4817 lappend ret "$ee*"
4818 } else {
4819 lappend ret $ee
4820 lappend ret "$ee/*"
4821 }
63b79191
PM
4822 }
4823 return $ret
4824}
4825
908c3585 4826proc do_file_hl {serial} {
4e7d6779 4827 global highlight_files filehighlight highlight_paths gdttype fhl_list
de665fd3 4828 global cdup findtype
908c3585 4829
b007ee20 4830 if {$gdttype eq [mc "touching paths:"]} {
e244588e
DL
4831 # If "exact" match then convert backslashes to forward slashes.
4832 # Most useful to support Windows-flavoured file paths.
4833 if {$findtype eq [mc "Exact"]} {
4834 set highlight_files [string map {"\\" "/"} $highlight_files]
4835 }
4836 if {[catch {set paths [shellsplit $highlight_files]}]} return
4837 set highlight_paths [makepatterns $paths]
4838 highlight_filelist
4839 set relative_paths {}
4840 foreach path $paths {
4841 lappend relative_paths [file join $cdup $path]
4842 }
4843 set gdtargs [concat -- $relative_paths]
b007ee20 4844 } elseif {$gdttype eq [mc "adding/removing string:"]} {
e244588e 4845 set gdtargs [list "-S$highlight_files"]
c33cb908 4846 } elseif {$gdttype eq [mc "changing lines matching:"]} {
e244588e 4847 set gdtargs [list "-G$highlight_files"]
687c8765 4848 } else {
e244588e
DL
4849 # must be "containing:", i.e. we're searching commit info
4850 return
60f7a7dc 4851 }
1ce09dd6 4852 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
4853 set filehighlight [open $cmd r+]
4854 fconfigure $filehighlight -blocking 0
7eb3cb9c 4855 filerun $filehighlight readfhighlight
4e7d6779 4856 set fhl_list {}
908c3585
PM
4857 drawvisible
4858 flushhighlights
4859}
4860
4861proc flushhighlights {} {
4e7d6779 4862 global filehighlight fhl_list
908c3585
PM
4863
4864 if {[info exists filehighlight]} {
e244588e
DL
4865 lappend fhl_list {}
4866 puts $filehighlight ""
4867 flush $filehighlight
908c3585
PM
4868 }
4869}
4870
4871proc askfilehighlight {row id} {
4e7d6779 4872 global filehighlight fhighlights fhl_list
908c3585 4873
4e7d6779 4874 lappend fhl_list $id
476ca63d 4875 set fhighlights($id) -1
908c3585
PM
4876 puts $filehighlight $id
4877}
4878
4879proc readfhighlight {} {
7fcc92bf 4880 global filehighlight fhighlights curview iddrawn
687c8765 4881 global fhl_list find_dirn
4e7d6779 4882
7eb3cb9c 4883 if {![info exists filehighlight]} {
e244588e 4884 return 0
7eb3cb9c
PM
4885 }
4886 set nr 0
4887 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
e244588e
DL
4888 set line [string trim $line]
4889 set i [lsearch -exact $fhl_list $line]
4890 if {$i < 0} continue
4891 for {set j 0} {$j < $i} {incr j} {
4892 set id [lindex $fhl_list $j]
4893 set fhighlights($id) 0
4894 }
4895 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4896 if {$line eq {}} continue
4897 if {![commitinview $line $curview]} continue
4898 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4899 bolden $line mainfontbold
4900 }
4901 set fhighlights($line) 1
908c3585 4902 }
4e7d6779 4903 if {[eof $filehighlight]} {
e244588e
DL
4904 # strange...
4905 puts "oops, git diff-tree died"
4906 catch {close $filehighlight}
4907 unset filehighlight
4908 return 0
908c3585 4909 }
687c8765 4910 if {[info exists find_dirn]} {
e244588e 4911 run findmore
908c3585 4912 }
687c8765 4913 return 1
908c3585
PM
4914}
4915
4fb0fa19 4916proc doesmatch {f} {
687c8765 4917 global findtype findpattern
4fb0fa19 4918
b007ee20 4919 if {$findtype eq [mc "Regexp"]} {
e244588e 4920 return [regexp $findpattern $f]
b007ee20 4921 } elseif {$findtype eq [mc "IgnCase"]} {
e244588e 4922 return [string match -nocase $findpattern $f]
4fb0fa19 4923 } else {
e244588e 4924 return [string match $findpattern $f]
4fb0fa19
PM
4925 }
4926}
4927
60f7a7dc 4928proc askfindhighlight {row id} {
9c311b32 4929 global nhighlights commitinfo iddrawn
4fb0fa19
PM
4930 global findloc
4931 global markingmatches
908c3585
PM
4932
4933 if {![info exists commitinfo($id)]} {
e244588e 4934 getcommit $id
908c3585 4935 }
60f7a7dc 4936 set info $commitinfo($id)
908c3585 4937 set isbold 0
585c27cb 4938 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
60f7a7dc 4939 foreach f $info ty $fldtypes {
e244588e
DL
4940 if {$ty eq ""} continue
4941 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4942 [doesmatch $f]} {
4943 if {$ty eq [mc "Author"]} {
4944 set isbold 2
4945 break
4946 }
4947 set isbold 1
4948 }
908c3585 4949 }
4fb0fa19 4950 if {$isbold && [info exists iddrawn($id)]} {
e244588e
DL
4951 if {![ishighlighted $id]} {
4952 bolden $id mainfontbold
4953 if {$isbold > 1} {
4954 bolden_name $id mainfontbold
4955 }
4956 }
4957 if {$markingmatches} {
4958 markrowmatches $row $id
4959 }
908c3585 4960 }
476ca63d 4961 set nhighlights($id) $isbold
da7c24dd
PM
4962}
4963
005a2f4e
PM
4964proc markrowmatches {row id} {
4965 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 4966
005a2f4e
PM
4967 set headline [lindex $commitinfo($id) 0]
4968 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
4969 $canv delete match$row
4970 $canv2 delete match$row
b007ee20 4971 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
e244588e
DL
4972 set m [findmatches $headline]
4973 if {$m ne {}} {
4974 markmatches $canv $row $headline $linehtag($id) $m \
4975 [$canv itemcget $linehtag($id) -font] $row
4976 }
4fb0fa19 4977 }
b007ee20 4978 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
e244588e
DL
4979 set m [findmatches $author]
4980 if {$m ne {}} {
4981 markmatches $canv2 $row $author $linentag($id) $m \
4982 [$canv2 itemcget $linentag($id) -font] $row
4983 }
4fb0fa19
PM
4984 }
4985}
4986
164ff275
PM
4987proc vrel_change {name ix op} {
4988 global highlight_related
4989
4990 rhighlight_none
b007ee20 4991 if {$highlight_related ne [mc "None"]} {
e244588e 4992 run drawvisible
164ff275
PM
4993 }
4994}
4995
4996# prepare for testing whether commits are descendents or ancestors of a
4997proc rhighlight_sel {a} {
4998 global descendent desc_todo ancestor anc_todo
476ca63d 4999 global highlight_related
164ff275 5000
009409fe 5001 unset -nocomplain descendent
164ff275 5002 set desc_todo [list $a]
009409fe 5003 unset -nocomplain ancestor
164ff275 5004 set anc_todo [list $a]
b007ee20 5005 if {$highlight_related ne [mc "None"]} {
e244588e
DL
5006 rhighlight_none
5007 run drawvisible
164ff275
PM
5008 }
5009}
5010
5011proc rhighlight_none {} {
5012 global rhighlights
5013
009409fe 5014 unset -nocomplain rhighlights
4e7d6779 5015 unbolden
164ff275
PM
5016}
5017
5018proc is_descendent {a} {
7fcc92bf 5019 global curview children descendent desc_todo
164ff275
PM
5020
5021 set v $curview
7fcc92bf 5022 set la [rowofcommit $a]
164ff275
PM
5023 set todo $desc_todo
5024 set leftover {}
5025 set done 0
5026 for {set i 0} {$i < [llength $todo]} {incr i} {
e244588e
DL
5027 set do [lindex $todo $i]
5028 if {[rowofcommit $do] < $la} {
5029 lappend leftover $do
5030 continue
5031 }
5032 foreach nk $children($v,$do) {
5033 if {![info exists descendent($nk)]} {
5034 set descendent($nk) 1
5035 lappend todo $nk
5036 if {$nk eq $a} {
5037 set done 1
5038 }
5039 }
5040 }
5041 if {$done} {
5042 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5043 return
5044 }
164ff275
PM
5045 }
5046 set descendent($a) 0
5047 set desc_todo $leftover
5048}
5049
5050proc is_ancestor {a} {
7fcc92bf 5051 global curview parents ancestor anc_todo
164ff275
PM
5052
5053 set v $curview
7fcc92bf 5054 set la [rowofcommit $a]
164ff275
PM
5055 set todo $anc_todo
5056 set leftover {}
5057 set done 0
5058 for {set i 0} {$i < [llength $todo]} {incr i} {
e244588e
DL
5059 set do [lindex $todo $i]
5060 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5061 lappend leftover $do
5062 continue
5063 }
5064 foreach np $parents($v,$do) {
5065 if {![info exists ancestor($np)]} {
5066 set ancestor($np) 1
5067 lappend todo $np
5068 if {$np eq $a} {
5069 set done 1
5070 }
5071 }
5072 }
5073 if {$done} {
5074 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5075 return
5076 }
164ff275
PM
5077 }
5078 set ancestor($a) 0
5079 set anc_todo $leftover
5080}
5081
5082proc askrelhighlight {row id} {
9c311b32 5083 global descendent highlight_related iddrawn rhighlights
164ff275
PM
5084 global selectedline ancestor
5085
94b4a69f 5086 if {$selectedline eq {}} return
164ff275 5087 set isbold 0
55e34436 5088 if {$highlight_related eq [mc "Descendant"] ||
e244588e
DL
5089 $highlight_related eq [mc "Not descendant"]} {
5090 if {![info exists descendent($id)]} {
5091 is_descendent $id
5092 }
5093 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5094 set isbold 1
5095 }
b007ee20 5096 } elseif {$highlight_related eq [mc "Ancestor"] ||
e244588e
DL
5097 $highlight_related eq [mc "Not ancestor"]} {
5098 if {![info exists ancestor($id)]} {
5099 is_ancestor $id
5100 }
5101 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5102 set isbold 1
5103 }
164ff275
PM
5104 }
5105 if {[info exists iddrawn($id)]} {
e244588e
DL
5106 if {$isbold && ![ishighlighted $id]} {
5107 bolden $id mainfontbold
5108 }
164ff275 5109 }
476ca63d 5110 set rhighlights($id) $isbold
164ff275
PM
5111}
5112
da7c24dd
PM
5113# Graph layout functions
5114
9f1afe05
PM
5115proc shortids {ids} {
5116 set res {}
5117 foreach id $ids {
e244588e
DL
5118 if {[llength $id] > 1} {
5119 lappend res [shortids $id]
5120 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5121 lappend res [string range $id 0 7]
5122 } else {
5123 lappend res $id
5124 }
9f1afe05
PM
5125 }
5126 return $res
5127}
5128
9f1afe05
PM
5129proc ntimes {n o} {
5130 set ret {}
0380081c
PM
5131 set o [list $o]
5132 for {set mask 1} {$mask <= $n} {incr mask $mask} {
e244588e
DL
5133 if {($n & $mask) != 0} {
5134 set ret [concat $ret $o]
5135 }
5136 set o [concat $o $o]
9f1afe05 5137 }
0380081c 5138 return $ret
9f1afe05
PM
5139}
5140
9257d8f7
PM
5141proc ordertoken {id} {
5142 global ordertok curview varcid varcstart varctok curview parents children
5143 global nullid nullid2
5144
5145 if {[info exists ordertok($id)]} {
e244588e 5146 return $ordertok($id)
9257d8f7
PM
5147 }
5148 set origid $id
5149 set todo {}
5150 while {1} {
e244588e
DL
5151 if {[info exists varcid($curview,$id)]} {
5152 set a $varcid($curview,$id)
5153 set p [lindex $varcstart($curview) $a]
5154 } else {
5155 set p [lindex $children($curview,$id) 0]
5156 }
5157 if {[info exists ordertok($p)]} {
5158 set tok $ordertok($p)
5159 break
5160 }
5161 set id [first_real_child $curview,$p]
5162 if {$id eq {}} {
5163 # it's a root
5164 set tok [lindex $varctok($curview) $varcid($curview,$p)]
5165 break
5166 }
5167 if {[llength $parents($curview,$id)] == 1} {
5168 lappend todo [list $p {}]
5169 } else {
5170 set j [lsearch -exact $parents($curview,$id) $p]
5171 if {$j < 0} {
5172 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5173 }
5174 lappend todo [list $p [strrep $j]]
5175 }
9257d8f7
PM
5176 }
5177 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
e244588e
DL
5178 set p [lindex $todo $i 0]
5179 append tok [lindex $todo $i 1]
5180 set ordertok($p) $tok
9257d8f7
PM
5181 }
5182 set ordertok($origid) $tok
5183 return $tok
5184}
5185
6e8c8707
PM
5186# Work out where id should go in idlist so that order-token
5187# values increase from left to right
5188proc idcol {idlist id {i 0}} {
9257d8f7 5189 set t [ordertoken $id]
e5b37ac1 5190 if {$i < 0} {
e244588e 5191 set i 0
e5b37ac1 5192 }
9257d8f7 5193 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
e244588e
DL
5194 if {$i > [llength $idlist]} {
5195 set i [llength $idlist]
5196 }
5197 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5198 incr i
6e8c8707 5199 } else {
e244588e
DL
5200 if {$t > [ordertoken [lindex $idlist $i]]} {
5201 while {[incr i] < [llength $idlist] &&
5202 $t >= [ordertoken [lindex $idlist $i]]} {}
5203 }
9f1afe05 5204 }
6e8c8707 5205 return $i
9f1afe05
PM
5206}
5207
5208proc initlayout {} {
7fcc92bf 5209 global rowidlist rowisopt rowfinal displayorder parentlist
da7c24dd 5210 global numcommits canvxmax canv
8f7d0cec 5211 global nextcolor
da7c24dd 5212 global colormap rowtextx
9f1afe05 5213
8f7d0cec
PM
5214 set numcommits 0
5215 set displayorder {}
79b2c75e 5216 set parentlist {}
8f7d0cec 5217 set nextcolor 0
0380081c
PM
5218 set rowidlist {}
5219 set rowisopt {}
f5f3c2e2 5220 set rowfinal {}
be0cd098 5221 set canvxmax [$canv cget -width]
009409fe
PM
5222 unset -nocomplain colormap
5223 unset -nocomplain rowtextx
ac1276ab 5224 setcanvscroll
be0cd098
PM
5225}
5226
5227proc setcanvscroll {} {
5228 global canv canv2 canv3 numcommits linespc canvxmax canvy0
ac1276ab 5229 global lastscrollset lastscrollrows
be0cd098
PM
5230
5231 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5232 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5233 $canv2 conf -scrollregion [list 0 0 0 $ymax]
5234 $canv3 conf -scrollregion [list 0 0 0 $ymax]
ac1276ab
PM
5235 set lastscrollset [clock clicks -milliseconds]
5236 set lastscrollrows $numcommits
9f1afe05
PM
5237}
5238
5239proc visiblerows {} {
5240 global canv numcommits linespc
5241
5242 set ymax [lindex [$canv cget -scrollregion] 3]
5243 if {$ymax eq {} || $ymax == 0} return
5244 set f [$canv yview]
5245 set y0 [expr {int([lindex $f 0] * $ymax)}]
5246 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5247 if {$r0 < 0} {
e244588e 5248 set r0 0
9f1afe05
PM
5249 }
5250 set y1 [expr {int([lindex $f 1] * $ymax)}]
5251 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5252 if {$r1 >= $numcommits} {
e244588e 5253 set r1 [expr {$numcommits - 1}]
9f1afe05
PM
5254 }
5255 return [list $r0 $r1]
5256}
5257
f5f3c2e2 5258proc layoutmore {} {
38dfe939 5259 global commitidx viewcomplete curview
94b4a69f 5260 global numcommits pending_select curview
d375ef9b 5261 global lastscrollset lastscrollrows
ac1276ab
PM
5262
5263 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
e244588e
DL
5264 [clock clicks -milliseconds] - $lastscrollset > 500} {
5265 setcanvscroll
a2c22362 5266 }
d94f8cd6 5267 if {[info exists pending_select] &&
e244588e
DL
5268 [commitinview $pending_select $curview]} {
5269 update
5270 selectline [rowofcommit $pending_select] 1
d94f8cd6 5271 }
ac1276ab 5272 drawvisible
219ea3a9
PM
5273}
5274
cdc8429c
PM
5275# With path limiting, we mightn't get the actual HEAD commit,
5276# so ask git rev-list what is the first ancestor of HEAD that
5277# touches a file in the path limit.
5278proc get_viewmainhead {view} {
5279 global viewmainheadid vfilelimit viewinstances mainheadid
5280
5281 catch {
e244588e
DL
5282 set rfd [open [concat | git rev-list -1 $mainheadid \
5283 -- $vfilelimit($view)] r]
5284 set j [reg_instance $rfd]
5285 lappend viewinstances($view) $j
5286 fconfigure $rfd -blocking 0
5287 filerun $rfd [list getviewhead $rfd $j $view]
5288 set viewmainheadid($curview) {}
cdc8429c
PM
5289 }
5290}
5291
5292# git rev-list should give us just 1 line to use as viewmainheadid($view)
5293proc getviewhead {fd inst view} {
5294 global viewmainheadid commfd curview viewinstances showlocalchanges
5295
5296 set id {}
5297 if {[gets $fd line] < 0} {
e244588e
DL
5298 if {![eof $fd]} {
5299 return 1
5300 }
cdc8429c 5301 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
e244588e 5302 set id $line
cdc8429c
PM
5303 }
5304 set viewmainheadid($view) $id
5305 close $fd
5306 unset commfd($inst)
5307 set i [lsearch -exact $viewinstances($view) $inst]
5308 if {$i >= 0} {
e244588e 5309 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
cdc8429c
PM
5310 }
5311 if {$showlocalchanges && $id ne {} && $view == $curview} {
e244588e 5312 doshowlocalchanges
cdc8429c
PM
5313 }
5314 return 0
5315}
5316
219ea3a9 5317proc doshowlocalchanges {} {
cdc8429c 5318 global curview viewmainheadid
219ea3a9 5319
cdc8429c
PM
5320 if {$viewmainheadid($curview) eq {}} return
5321 if {[commitinview $viewmainheadid($curview) $curview]} {
e244588e 5322 dodiffindex
38dfe939 5323 } else {
e244588e 5324 interestedin $viewmainheadid($curview) dodiffindex
219ea3a9
PM
5325 }
5326}
5327
5328proc dohidelocalchanges {} {
7fcc92bf 5329 global nullid nullid2 lserial curview
219ea3a9 5330
7fcc92bf 5331 if {[commitinview $nullid $curview]} {
e244588e 5332 removefakerow $nullid
8f489363 5333 }
7fcc92bf 5334 if {[commitinview $nullid2 $curview]} {
e244588e 5335 removefakerow $nullid2
219ea3a9
PM
5336 }
5337 incr lserial
5338}
5339
8f489363 5340# spawn off a process to do git diff-index --cached HEAD
219ea3a9 5341proc dodiffindex {} {
cdc8429c 5342 global lserial showlocalchanges vfilelimit curview
17f9836c 5343 global hasworktree git_version
219ea3a9 5344
74cb884f 5345 if {!$showlocalchanges || !$hasworktree} return
219ea3a9 5346 incr lserial
17f9836c 5347 if {[package vcompare $git_version "1.7.2"] >= 0} {
e244588e 5348 set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
17f9836c 5349 } else {
e244588e 5350 set cmd "|git diff-index --cached HEAD"
17f9836c 5351 }
cdc8429c 5352 if {$vfilelimit($curview) ne {}} {
e244588e 5353 set cmd [concat $cmd -- $vfilelimit($curview)]
cdc8429c
PM
5354 }
5355 set fd [open $cmd r]
219ea3a9 5356 fconfigure $fd -blocking 0
e439e092
AG
5357 set i [reg_instance $fd]
5358 filerun $fd [list readdiffindex $fd $lserial $i]
219ea3a9
PM
5359}
5360
e439e092 5361proc readdiffindex {fd serial inst} {
cdc8429c
PM
5362 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5363 global vfilelimit
219ea3a9 5364
8f489363 5365 set isdiff 1
219ea3a9 5366 if {[gets $fd line] < 0} {
e244588e
DL
5367 if {![eof $fd]} {
5368 return 1
5369 }
5370 set isdiff 0
219ea3a9
PM
5371 }
5372 # we only need to see one line and we don't really care what it says...
e439e092 5373 stop_instance $inst
219ea3a9 5374
24f7a667 5375 if {$serial != $lserial} {
e244588e 5376 return 0
8f489363
PM
5377 }
5378
24f7a667 5379 # now see if there are any local changes not checked in to the index
cdc8429c
PM
5380 set cmd "|git diff-files"
5381 if {$vfilelimit($curview) ne {}} {
e244588e 5382 set cmd [concat $cmd -- $vfilelimit($curview)]
cdc8429c
PM
5383 }
5384 set fd [open $cmd r]
24f7a667 5385 fconfigure $fd -blocking 0
e439e092
AG
5386 set i [reg_instance $fd]
5387 filerun $fd [list readdifffiles $fd $serial $i]
24f7a667
PM
5388
5389 if {$isdiff && ![commitinview $nullid2 $curview]} {
e244588e
DL
5390 # add the line for the changes in the index to the graph
5391 set hl [mc "Local changes checked in to index but not committed"]
5392 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5393 set commitdata($nullid2) "\n $hl\n"
5394 if {[commitinview $nullid $curview]} {
5395 removefakerow $nullid
5396 }
5397 insertfakerow $nullid2 $viewmainheadid($curview)
24f7a667 5398 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
e244588e
DL
5399 if {[commitinview $nullid $curview]} {
5400 removefakerow $nullid
5401 }
5402 removefakerow $nullid2
8f489363
PM
5403 }
5404 return 0
5405}
5406
e439e092 5407proc readdifffiles {fd serial inst} {
cdc8429c 5408 global viewmainheadid nullid nullid2 curview
8f489363
PM
5409 global commitinfo commitdata lserial
5410
5411 set isdiff 1
5412 if {[gets $fd line] < 0} {
e244588e
DL
5413 if {![eof $fd]} {
5414 return 1
5415 }
5416 set isdiff 0
8f489363
PM
5417 }
5418 # we only need to see one line and we don't really care what it says...
e439e092 5419 stop_instance $inst
8f489363 5420
24f7a667 5421 if {$serial != $lserial} {
e244588e 5422 return 0
24f7a667
PM
5423 }
5424
5425 if {$isdiff && ![commitinview $nullid $curview]} {
e244588e
DL
5426 # add the line for the local diff to the graph
5427 set hl [mc "Local uncommitted changes, not checked in to index"]
5428 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5429 set commitdata($nullid) "\n $hl\n"
5430 if {[commitinview $nullid2 $curview]} {
5431 set p $nullid2
5432 } else {
5433 set p $viewmainheadid($curview)
5434 }
5435 insertfakerow $nullid $p
24f7a667 5436 } elseif {!$isdiff && [commitinview $nullid $curview]} {
e244588e 5437 removefakerow $nullid
219ea3a9
PM
5438 }
5439 return 0
9f1afe05
PM
5440}
5441
8f0bc7e9 5442proc nextuse {id row} {
7fcc92bf 5443 global curview children
9f1afe05 5444
8f0bc7e9 5445 if {[info exists children($curview,$id)]} {
e244588e
DL
5446 foreach kid $children($curview,$id) {
5447 if {![commitinview $kid $curview]} {
5448 return -1
5449 }
5450 if {[rowofcommit $kid] > $row} {
5451 return [rowofcommit $kid]
5452 }
5453 }
8f0bc7e9 5454 }
7fcc92bf 5455 if {[commitinview $id $curview]} {
e244588e 5456 return [rowofcommit $id]
8f0bc7e9
PM
5457 }
5458 return -1
5459}
5460
f5f3c2e2 5461proc prevuse {id row} {
7fcc92bf 5462 global curview children
f5f3c2e2
PM
5463
5464 set ret -1
5465 if {[info exists children($curview,$id)]} {
e244588e
DL
5466 foreach kid $children($curview,$id) {
5467 if {![commitinview $kid $curview]} break
5468 if {[rowofcommit $kid] < $row} {
5469 set ret [rowofcommit $kid]
5470 }
5471 }
f5f3c2e2
PM
5472 }
5473 return $ret
5474}
5475
0380081c
PM
5476proc make_idlist {row} {
5477 global displayorder parentlist uparrowlen downarrowlen mingaplen
9257d8f7 5478 global commitidx curview children
9f1afe05 5479
0380081c
PM
5480 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5481 if {$r < 0} {
e244588e 5482 set r 0
8f0bc7e9 5483 }
0380081c
PM
5484 set ra [expr {$row - $downarrowlen}]
5485 if {$ra < 0} {
e244588e 5486 set ra 0
0380081c
PM
5487 }
5488 set rb [expr {$row + $uparrowlen}]
5489 if {$rb > $commitidx($curview)} {
e244588e 5490 set rb $commitidx($curview)
0380081c 5491 }
7fcc92bf 5492 make_disporder $r [expr {$rb + 1}]
0380081c
PM
5493 set ids {}
5494 for {} {$r < $ra} {incr r} {
e244588e
DL
5495 set nextid [lindex $displayorder [expr {$r + 1}]]
5496 foreach p [lindex $parentlist $r] {
5497 if {$p eq $nextid} continue
5498 set rn [nextuse $p $r]
5499 if {$rn >= $row &&
5500 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5501 lappend ids [list [ordertoken $p] $p]
5502 }
5503 }
0380081c
PM
5504 }
5505 for {} {$r < $row} {incr r} {
e244588e
DL
5506 set nextid [lindex $displayorder [expr {$r + 1}]]
5507 foreach p [lindex $parentlist $r] {
5508 if {$p eq $nextid} continue
5509 set rn [nextuse $p $r]
5510 if {$rn < 0 || $rn >= $row} {
5511 lappend ids [list [ordertoken $p] $p]
5512 }
5513 }
0380081c
PM
5514 }
5515 set id [lindex $displayorder $row]
9257d8f7 5516 lappend ids [list [ordertoken $id] $id]
0380081c 5517 while {$r < $rb} {
e244588e
DL
5518 foreach p [lindex $parentlist $r] {
5519 set firstkid [lindex $children($curview,$p) 0]
5520 if {[rowofcommit $firstkid] < $row} {
5521 lappend ids [list [ordertoken $p] $p]
5522 }
5523 }
5524 incr r
5525 set id [lindex $displayorder $r]
5526 if {$id ne {}} {
5527 set firstkid [lindex $children($curview,$id) 0]
5528 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5529 lappend ids [list [ordertoken $id] $id]
5530 }
5531 }
9f1afe05 5532 }
0380081c
PM
5533 set idlist {}
5534 foreach idx [lsort -unique $ids] {
e244588e 5535 lappend idlist [lindex $idx 1]
0380081c
PM
5536 }
5537 return $idlist
9f1afe05
PM
5538}
5539
f5f3c2e2
PM
5540proc rowsequal {a b} {
5541 while {[set i [lsearch -exact $a {}]] >= 0} {
e244588e 5542 set a [lreplace $a $i $i]
f5f3c2e2
PM
5543 }
5544 while {[set i [lsearch -exact $b {}]] >= 0} {
e244588e 5545 set b [lreplace $b $i $i]
f5f3c2e2
PM
5546 }
5547 return [expr {$a eq $b}]
9f1afe05
PM
5548}
5549
f5f3c2e2
PM
5550proc makeupline {id row rend col} {
5551 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 5552
f5f3c2e2 5553 for {set r $rend} {1} {set r $rstart} {
e244588e
DL
5554 set rstart [prevuse $id $r]
5555 if {$rstart < 0} return
5556 if {$rstart < $row} break
f5f3c2e2
PM
5557 }
5558 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
e244588e 5559 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 5560 }
f5f3c2e2 5561 for {set r $rstart} {[incr r] <= $row} {} {
e244588e
DL
5562 set idlist [lindex $rowidlist $r]
5563 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5564 set col [idcol $idlist $id $col]
5565 lset rowidlist $r [linsert $idlist $col $id]
5566 changedrow $r
5567 }
9f1afe05
PM
5568 }
5569}
5570
0380081c 5571proc layoutrows {row endrow} {
f5f3c2e2 5572 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
5573 global uparrowlen downarrowlen maxwidth mingaplen
5574 global children parentlist
7fcc92bf 5575 global commitidx viewcomplete curview
9f1afe05 5576
7fcc92bf 5577 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
0380081c
PM
5578 set idlist {}
5579 if {$row > 0} {
e244588e
DL
5580 set rm1 [expr {$row - 1}]
5581 foreach id [lindex $rowidlist $rm1] {
5582 if {$id ne {}} {
5583 lappend idlist $id
5584 }
5585 }
5586 set final [lindex $rowfinal $rm1]
79b2c75e 5587 }
0380081c 5588 for {} {$row < $endrow} {incr row} {
e244588e
DL
5589 set rm1 [expr {$row - 1}]
5590 if {$rm1 < 0 || $idlist eq {}} {
5591 set idlist [make_idlist $row]
5592 set final 1
5593 } else {
5594 set id [lindex $displayorder $rm1]
5595 set col [lsearch -exact $idlist $id]
5596 set idlist [lreplace $idlist $col $col]
5597 foreach p [lindex $parentlist $rm1] {
5598 if {[lsearch -exact $idlist $p] < 0} {
5599 set col [idcol $idlist $p $col]
5600 set idlist [linsert $idlist $col $p]
5601 # if not the first child, we have to insert a line going up
5602 if {$id ne [lindex $children($curview,$p) 0]} {
5603 makeupline $p $rm1 $row $col
5604 }
5605 }
5606 }
5607 set id [lindex $displayorder $row]
5608 if {$row > $downarrowlen} {
5609 set termrow [expr {$row - $downarrowlen - 1}]
5610 foreach p [lindex $parentlist $termrow] {
5611 set i [lsearch -exact $idlist $p]
5612 if {$i < 0} continue
5613 set nr [nextuse $p $termrow]
5614 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5615 set idlist [lreplace $idlist $i $i]
5616 }
5617 }
5618 }
5619 set col [lsearch -exact $idlist $id]
5620 if {$col < 0} {
5621 set col [idcol $idlist $id]
5622 set idlist [linsert $idlist $col $id]
5623 if {$children($curview,$id) ne {}} {
5624 makeupline $id $rm1 $row $col
5625 }
5626 }
5627 set r [expr {$row + $uparrowlen - 1}]
5628 if {$r < $commitidx($curview)} {
5629 set x $col
5630 foreach p [lindex $parentlist $r] {
5631 if {[lsearch -exact $idlist $p] >= 0} continue
5632 set fk [lindex $children($curview,$p) 0]
5633 if {[rowofcommit $fk] < $row} {
5634 set x [idcol $idlist $p $x]
5635 set idlist [linsert $idlist $x $p]
5636 }
5637 }
5638 if {[incr r] < $commitidx($curview)} {
5639 set p [lindex $displayorder $r]
5640 if {[lsearch -exact $idlist $p] < 0} {
5641 set fk [lindex $children($curview,$p) 0]
5642 if {$fk ne {} && [rowofcommit $fk] < $row} {
5643 set x [idcol $idlist $p $x]
5644 set idlist [linsert $idlist $x $p]
5645 }
5646 }
5647 }
5648 }
5649 }
5650 if {$final && !$viewcomplete($curview) &&
5651 $row + $uparrowlen + $mingaplen + $downarrowlen
5652 >= $commitidx($curview)} {
5653 set final 0
5654 }
5655 set l [llength $rowidlist]
5656 if {$row == $l} {
5657 lappend rowidlist $idlist
5658 lappend rowisopt 0
5659 lappend rowfinal $final
5660 } elseif {$row < $l} {
5661 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5662 lset rowidlist $row $idlist
5663 changedrow $row
5664 }
5665 lset rowfinal $row $final
5666 } else {
5667 set pad [ntimes [expr {$row - $l}] {}]
5668 set rowidlist [concat $rowidlist $pad]
5669 lappend rowidlist $idlist
5670 set rowfinal [concat $rowfinal $pad]
5671 lappend rowfinal $final
5672 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5673 }
9f1afe05 5674 }
0380081c 5675 return $row
9f1afe05
PM
5676}
5677
0380081c
PM
5678proc changedrow {row} {
5679 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 5680
0380081c
PM
5681 set l [llength $rowisopt]
5682 if {$row < $l} {
e244588e
DL
5683 lset rowisopt $row 0
5684 if {$row + 1 < $l} {
5685 lset rowisopt [expr {$row + 1}] 0
5686 if {$row + 2 < $l} {
5687 lset rowisopt [expr {$row + 2}] 0
5688 }
5689 }
0380081c
PM
5690 }
5691 set id [lindex $displayorder $row]
5692 if {[info exists iddrawn($id)]} {
e244588e 5693 set need_redisplay 1
9f1afe05
PM
5694 }
5695}
5696
5697proc insert_pad {row col npad} {
6e8c8707 5698 global rowidlist
9f1afe05
PM
5699
5700 set pad [ntimes $npad {}]
e341c06d
PM
5701 set idlist [lindex $rowidlist $row]
5702 set bef [lrange $idlist 0 [expr {$col - 1}]]
5703 set aft [lrange $idlist $col end]
5704 set i [lsearch -exact $aft {}]
5705 if {$i > 0} {
e244588e 5706 set aft [lreplace $aft $i $i]
e341c06d
PM
5707 }
5708 lset rowidlist $row [concat $bef $pad $aft]
0380081c 5709 changedrow $row
9f1afe05
PM
5710}
5711
5712proc optimize_rows {row col endrow} {
0380081c 5713 global rowidlist rowisopt displayorder curview children
9f1afe05 5714
6e8c8707 5715 if {$row < 1} {
e244588e 5716 set row 1
6e8c8707 5717 }
0380081c 5718 for {} {$row < $endrow} {incr row; set col 0} {
e244588e
DL
5719 if {[lindex $rowisopt $row]} continue
5720 set haspad 0
5721 set y0 [expr {$row - 1}]
5722 set ym [expr {$row - 2}]
5723 set idlist [lindex $rowidlist $row]
5724 set previdlist [lindex $rowidlist $y0]
5725 if {$idlist eq {} || $previdlist eq {}} continue
5726 if {$ym >= 0} {
5727 set pprevidlist [lindex $rowidlist $ym]
5728 if {$pprevidlist eq {}} continue
5729 } else {
5730 set pprevidlist {}
5731 }
5732 set x0 -1
5733 set xm -1
5734 for {} {$col < [llength $idlist]} {incr col} {
5735 set id [lindex $idlist $col]
5736 if {[lindex $previdlist $col] eq $id} continue
5737 if {$id eq {}} {
5738 set haspad 1
5739 continue
5740 }
5741 set x0 [lsearch -exact $previdlist $id]
5742 if {$x0 < 0} continue
5743 set z [expr {$x0 - $col}]
5744 set isarrow 0
5745 set z0 {}
5746 if {$ym >= 0} {
5747 set xm [lsearch -exact $pprevidlist $id]
5748 if {$xm >= 0} {
5749 set z0 [expr {$xm - $x0}]
5750 }
5751 }
5752 if {$z0 eq {}} {
5753 # if row y0 is the first child of $id then it's not an arrow
5754 if {[lindex $children($curview,$id) 0] ne
5755 [lindex $displayorder $y0]} {
5756 set isarrow 1
5757 }
5758 }
5759 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5760 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5761 set isarrow 1
5762 }
5763 # Looking at lines from this row to the previous row,
5764 # make them go straight up if they end in an arrow on
5765 # the previous row; otherwise make them go straight up
5766 # or at 45 degrees.
5767 if {$z < -1 || ($z < 0 && $isarrow)} {
5768 # Line currently goes left too much;
5769 # insert pads in the previous row, then optimize it
5770 set npad [expr {-1 - $z + $isarrow}]
5771 insert_pad $y0 $x0 $npad
5772 if {$y0 > 0} {
5773 optimize_rows $y0 $x0 $row
5774 }
5775 set previdlist [lindex $rowidlist $y0]
5776 set x0 [lsearch -exact $previdlist $id]
5777 set z [expr {$x0 - $col}]
5778 if {$z0 ne {}} {
5779 set pprevidlist [lindex $rowidlist $ym]
5780 set xm [lsearch -exact $pprevidlist $id]
5781 set z0 [expr {$xm - $x0}]
5782 }
5783 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5784 # Line currently goes right too much;
5785 # insert pads in this line
5786 set npad [expr {$z - 1 + $isarrow}]
5787 insert_pad $row $col $npad
5788 set idlist [lindex $rowidlist $row]
5789 incr col $npad
5790 set z [expr {$x0 - $col}]
5791 set haspad 1
5792 }
5793 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5794 # this line links to its first child on row $row-2
5795 set id [lindex $displayorder $ym]
5796 set xc [lsearch -exact $pprevidlist $id]
5797 if {$xc >= 0} {
5798 set z0 [expr {$xc - $x0}]
5799 }
5800 }
5801 # avoid lines jigging left then immediately right
5802 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5803 insert_pad $y0 $x0 1
5804 incr x0
5805 optimize_rows $y0 $x0 $row
5806 set previdlist [lindex $rowidlist $y0]
5807 }
5808 }
5809 if {!$haspad} {
5810 # Find the first column that doesn't have a line going right
5811 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5812 set id [lindex $idlist $col]
5813 if {$id eq {}} break
5814 set x0 [lsearch -exact $previdlist $id]
5815 if {$x0 < 0} {
5816 # check if this is the link to the first child
5817 set kid [lindex $displayorder $y0]
5818 if {[lindex $children($curview,$id) 0] eq $kid} {
5819 # it is, work out offset to child
5820 set x0 [lsearch -exact $previdlist $kid]
5821 }
5822 }
5823 if {$x0 <= $col} break
5824 }
5825 # Insert a pad at that column as long as it has a line and
5826 # isn't the last column
5827 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5828 set idlist [linsert $idlist $col {}]
5829 lset rowidlist $row $idlist
5830 changedrow $row
5831 }
5832 }
9f1afe05
PM
5833 }
5834}
5835
5836proc xc {row col} {
5837 global canvx0 linespc
5838 return [expr {$canvx0 + $col * $linespc}]
5839}
5840
5841proc yc {row} {
5842 global canvy0 linespc
5843 return [expr {$canvy0 + $row * $linespc}]
5844}
5845
c934a8a3
PM
5846proc linewidth {id} {
5847 global thickerline lthickness
5848
5849 set wid $lthickness
5850 if {[info exists thickerline] && $id eq $thickerline} {
e244588e 5851 set wid [expr {2 * $lthickness}]
c934a8a3
PM
5852 }
5853 return $wid
5854}
5855
50b44ece 5856proc rowranges {id} {
7fcc92bf 5857 global curview children uparrowlen downarrowlen
92ed666f 5858 global rowidlist
50b44ece 5859
92ed666f
PM
5860 set kids $children($curview,$id)
5861 if {$kids eq {}} {
e244588e 5862 return {}
66e46f37 5863 }
92ed666f
PM
5864 set ret {}
5865 lappend kids $id
5866 foreach child $kids {
e244588e
DL
5867 if {![commitinview $child $curview]} break
5868 set row [rowofcommit $child]
5869 if {![info exists prev]} {
5870 lappend ret [expr {$row + 1}]
5871 } else {
5872 if {$row <= $prevrow} {
5873 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5874 }
5875 # see if the line extends the whole way from prevrow to row
5876 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5877 [lsearch -exact [lindex $rowidlist \
5878 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5879 # it doesn't, see where it ends
5880 set r [expr {$prevrow + $downarrowlen}]
5881 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5882 while {[incr r -1] > $prevrow &&
5883 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5884 } else {
5885 while {[incr r] <= $row &&
5886 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5887 incr r -1
5888 }
5889 lappend ret $r
5890 # see where it starts up again
5891 set r [expr {$row - $uparrowlen}]
5892 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5893 while {[incr r] < $row &&
5894 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5895 } else {
5896 while {[incr r -1] >= $prevrow &&
5897 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5898 incr r
5899 }
5900 lappend ret $r
5901 }
5902 }
5903 if {$child eq $id} {
5904 lappend ret $row
5905 }
5906 set prev $child
5907 set prevrow $row
9f1afe05 5908 }
92ed666f 5909 return $ret
322a8cc9
PM
5910}
5911
5912proc drawlineseg {id row endrow arrowlow} {
5913 global rowidlist displayorder iddrawn linesegs
e341c06d 5914 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
5915
5916 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5917 set le [expr {$row + 1}]
5918 set arrowhigh 1
9f1afe05 5919 while {1} {
e244588e
DL
5920 set c [lsearch -exact [lindex $rowidlist $le] $id]
5921 if {$c < 0} {
5922 incr le -1
5923 break
5924 }
5925 lappend cols $c
5926 set x [lindex $displayorder $le]
5927 if {$x eq $id} {
5928 set arrowhigh 0
5929 break
5930 }
5931 if {[info exists iddrawn($x)] || $le == $endrow} {
5932 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5933 if {$c >= 0} {
5934 lappend cols $c
5935 set arrowhigh 0
5936 }
5937 break
5938 }
5939 incr le
9f1afe05 5940 }
322a8cc9 5941 if {$le <= $row} {
e244588e 5942 return $row
322a8cc9
PM
5943 }
5944
5945 set lines {}
5946 set i 0
5947 set joinhigh 0
5948 if {[info exists linesegs($id)]} {
e244588e
DL
5949 set lines $linesegs($id)
5950 foreach li $lines {
5951 set r0 [lindex $li 0]
5952 if {$r0 > $row} {
5953 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5954 set joinhigh 1
5955 }
5956 break
5957 }
5958 incr i
5959 }
322a8cc9
PM
5960 }
5961 set joinlow 0
5962 if {$i > 0} {
e244588e
DL
5963 set li [lindex $lines [expr {$i-1}]]
5964 set r1 [lindex $li 1]
5965 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5966 set joinlow 1
5967 }
322a8cc9
PM
5968 }
5969
5970 set x [lindex $cols [expr {$le - $row}]]
5971 set xp [lindex $cols [expr {$le - 1 - $row}]]
5972 set dir [expr {$xp - $x}]
5973 if {$joinhigh} {
e244588e
DL
5974 set ith [lindex $lines $i 2]
5975 set coords [$canv coords $ith]
5976 set ah [$canv itemcget $ith -arrow]
5977 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5978 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5979 if {$x2 ne {} && $x - $x2 == $dir} {
5980 set coords [lrange $coords 0 end-2]
5981 }
322a8cc9 5982 } else {
e244588e 5983 set coords [list [xc $le $x] [yc $le]]
322a8cc9
PM
5984 }
5985 if {$joinlow} {
e244588e
DL
5986 set itl [lindex $lines [expr {$i-1}] 2]
5987 set al [$canv itemcget $itl -arrow]
5988 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d 5989 } elseif {$arrowlow} {
e244588e
DL
5990 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5991 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5992 set arrowlow 0
5993 }
322a8cc9
PM
5994 }
5995 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5996 for {set y $le} {[incr y -1] > $row} {} {
e244588e
DL
5997 set x $xp
5998 set xp [lindex $cols [expr {$y - 1 - $row}]]
5999 set ndir [expr {$xp - $x}]
6000 if {$dir != $ndir || $xp < 0} {
6001 lappend coords [xc $y $x] [yc $y]
6002 }
6003 set dir $ndir
322a8cc9
PM
6004 }
6005 if {!$joinlow} {
e244588e
DL
6006 if {$xp < 0} {
6007 # join parent line to first child
6008 set ch [lindex $displayorder $row]
6009 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
6010 if {$xc < 0} {
6011 puts "oops: drawlineseg: child $ch not on row $row"
6012 } elseif {$xc != $x} {
6013 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
6014 set d [expr {int(0.5 * $linespc)}]
6015 set x1 [xc $row $x]
6016 if {$xc < $x} {
6017 set x2 [expr {$x1 - $d}]
6018 } else {
6019 set x2 [expr {$x1 + $d}]
6020 }
6021 set y2 [yc $row]
6022 set y1 [expr {$y2 + $d}]
6023 lappend coords $x1 $y1 $x2 $y2
6024 } elseif {$xc < $x - 1} {
6025 lappend coords [xc $row [expr {$x-1}]] [yc $row]
6026 } elseif {$xc > $x + 1} {
6027 lappend coords [xc $row [expr {$x+1}]] [yc $row]
6028 }
6029 set x $xc
6030 }
6031 lappend coords [xc $row $x] [yc $row]
6032 } else {
6033 set xn [xc $row $xp]
6034 set yn [yc $row]
6035 lappend coords $xn $yn
6036 }
6037 if {!$joinhigh} {
6038 assigncolor $id
6039 set t [$canv create line $coords -width [linewidth $id] \
6040 -fill $colormap($id) -tags lines.$id -arrow $arrow]
6041 $canv lower $t
6042 bindline $t $id
6043 set lines [linsert $lines $i [list $row $le $t]]
6044 } else {
6045 $canv coords $ith $coords
6046 if {$arrow ne $ah} {
6047 $canv itemconf $ith -arrow $arrow
6048 }
6049 lset lines $i 0 $row
6050 }
322a8cc9 6051 } else {
e244588e
DL
6052 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6053 set ndir [expr {$xo - $xp}]
6054 set clow [$canv coords $itl]
6055 if {$dir == $ndir} {
6056 set clow [lrange $clow 2 end]
6057 }
6058 set coords [concat $coords $clow]
6059 if {!$joinhigh} {
6060 lset lines [expr {$i-1}] 1 $le
6061 } else {
6062 # coalesce two pieces
6063 $canv delete $ith
6064 set b [lindex $lines [expr {$i-1}] 0]
6065 set e [lindex $lines $i 1]
6066 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6067 }
6068 $canv coords $itl $coords
6069 if {$arrow ne $al} {
6070 $canv itemconf $itl -arrow $arrow
6071 }
879e8b1a 6072 }
322a8cc9
PM
6073
6074 set linesegs($id) $lines
6075 return $le
9f1afe05
PM
6076}
6077
322a8cc9
PM
6078proc drawparentlinks {id row} {
6079 global rowidlist canv colormap curview parentlist
513a54dc 6080 global idpos linespc
9f1afe05 6081
322a8cc9
PM
6082 set rowids [lindex $rowidlist $row]
6083 set col [lsearch -exact $rowids $id]
6084 if {$col < 0} return
6085 set olds [lindex $parentlist $row]
9f1afe05
PM
6086 set row2 [expr {$row + 1}]
6087 set x [xc $row $col]
6088 set y [yc $row]
6089 set y2 [yc $row2]
e341c06d 6090 set d [expr {int(0.5 * $linespc)}]
513a54dc 6091 set ymid [expr {$y + $d}]
8f7d0cec 6092 set ids [lindex $rowidlist $row2]
9f1afe05
PM
6093 # rmx = right-most X coord used
6094 set rmx 0
9f1afe05 6095 foreach p $olds {
e244588e
DL
6096 set i [lsearch -exact $ids $p]
6097 if {$i < 0} {
6098 puts "oops, parent $p of $id not in list"
6099 continue
6100 }
6101 set x2 [xc $row2 $i]
6102 if {$x2 > $rmx} {
6103 set rmx $x2
6104 }
6105 set j [lsearch -exact $rowids $p]
6106 if {$j < 0} {
6107 # drawlineseg will do this one for us
6108 continue
6109 }
6110 assigncolor $p
6111 # should handle duplicated parents here...
6112 set coords [list $x $y]
6113 if {$i != $col} {
6114 # if attaching to a vertical segment, draw a smaller
6115 # slant for visual distinctness
6116 if {$i == $j} {
6117 if {$i < $col} {
6118 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6119 } else {
6120 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6121 }
6122 } elseif {$i < $col && $i < $j} {
6123 # segment slants towards us already
6124 lappend coords [xc $row $j] $y
6125 } else {
6126 if {$i < $col - 1} {
6127 lappend coords [expr {$x2 + $linespc}] $y
6128 } elseif {$i > $col + 1} {
6129 lappend coords [expr {$x2 - $linespc}] $y
6130 }
6131 lappend coords $x2 $y2
6132 }
6133 } else {
6134 lappend coords $x2 $y2
6135 }
6136 set t [$canv create line $coords -width [linewidth $p] \
6137 -fill $colormap($p) -tags lines.$p]
6138 $canv lower $t
6139 bindline $t $p
9f1afe05 6140 }
322a8cc9 6141 if {$rmx > [lindex $idpos($id) 1]} {
e244588e
DL
6142 lset idpos($id) 1 $rmx
6143 redrawtags $id
322a8cc9 6144 }
9f1afe05
PM
6145}
6146
c934a8a3 6147proc drawlines {id} {
322a8cc9 6148 global canv
9f1afe05 6149
322a8cc9 6150 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
6151}
6152
322a8cc9 6153proc drawcmittext {id row col} {
7fcc92bf
PM
6154 global linespc canv canv2 canv3 fgcolor curview
6155 global cmitlisted commitinfo rowidlist parentlist
9f1afe05 6156 global rowtextx idpos idtags idheads idotherrefs
0380081c 6157 global linehtag linentag linedtag selectedline
b9fdba7f 6158 global canvxmax boldids boldnameids fgcolor markedid
d277e89f 6159 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
252c52df
6160 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6161 global circleoutlinecolor
9f1afe05 6162
1407ade9 6163 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
7fcc92bf 6164 set listed $cmitlisted($curview,$id)
219ea3a9 6165 if {$id eq $nullid} {
e244588e 6166 set ofill $workingfilescirclecolor
8f489363 6167 } elseif {$id eq $nullid2} {
e244588e 6168 set ofill $indexcirclecolor
c11ff120 6169 } elseif {$id eq $mainheadid} {
e244588e 6170 set ofill $mainheadcirclecolor
219ea3a9 6171 } else {
e244588e 6172 set ofill [lindex $circlecolors $listed]
219ea3a9 6173 }
9f1afe05
PM
6174 set x [xc $row $col]
6175 set y [yc $row]
6176 set orad [expr {$linespc / 3}]
1407ade9 6177 if {$listed <= 2} {
e244588e
DL
6178 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6179 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6180 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
1407ade9 6181 } elseif {$listed == 3} {
e244588e
DL
6182 # triangle pointing left for left-side commits
6183 set t [$canv create polygon \
6184 [expr {$x - $orad}] $y \
6185 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6186 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6187 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
c961b228 6188 } else {
e244588e
DL
6189 # triangle pointing right for right-side commits
6190 set t [$canv create polygon \
6191 [expr {$x + $orad - 1}] $y \
6192 [expr {$x - $orad}] [expr {$y - $orad}] \
6193 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6194 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
c961b228 6195 }
c11ff120 6196 set circleitem($row) $t
9f1afe05
PM
6197 $canv raise $t
6198 $canv bind $t <1> {selcanvline {} %x %y}
322a8cc9
PM
6199 set rmx [llength [lindex $rowidlist $row]]
6200 set olds [lindex $parentlist $row]
6201 if {$olds ne {}} {
e244588e
DL
6202 set nextids [lindex $rowidlist [expr {$row + 1}]]
6203 foreach p $olds {
6204 set i [lsearch -exact $nextids $p]
6205 if {$i > $rmx} {
6206 set rmx $i
6207 }
6208 }
9f1afe05 6209 }
322a8cc9 6210 set xt [xc $row $rmx]
9f1afe05
PM
6211 set rowtextx($row) $xt
6212 set idpos($id) [list $x $xt $y]
6213 if {[info exists idtags($id)] || [info exists idheads($id)]
e244588e
DL
6214 || [info exists idotherrefs($id)]} {
6215 set xt [drawtags $id $x $xt $y]
9f1afe05 6216 }
36242490 6217 if {[lindex $commitinfo($id) 6] > 0} {
e244588e 6218 set xt [drawnotesign $xt $y]
36242490 6219 }
9f1afe05
PM
6220 set headline [lindex $commitinfo($id) 0]
6221 set name [lindex $commitinfo($id) 1]
6222 set date [lindex $commitinfo($id) 2]
6223 set date [formatdate $date]
9c311b32
PM
6224 set font mainfont
6225 set nfont mainfont
476ca63d 6226 set isbold [ishighlighted $id]
908c3585 6227 if {$isbold > 0} {
e244588e
DL
6228 lappend boldids $id
6229 set font mainfontbold
6230 if {$isbold > 1} {
6231 lappend boldnameids $id
6232 set nfont mainfontbold
6233 }
da7c24dd 6234 }
28593d3f 6235 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
e244588e 6236 -text $headline -font $font -tags text]
28593d3f
PM
6237 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6238 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
e244588e 6239 -text $name -font $nfont -tags text]
28593d3f 6240 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
e244588e 6241 -text $date -font mainfont -tags text]
94b4a69f 6242 if {$selectedline == $row} {
e244588e 6243 make_secsel $id
0380081c 6244 }
b9fdba7f 6245 if {[info exists markedid] && $markedid eq $id} {
e244588e 6246 make_idmark $id
b9fdba7f 6247 }
9c311b32 6248 set xr [expr {$xt + [font measure $font $headline]}]
be0cd098 6249 if {$xr > $canvxmax} {
e244588e
DL
6250 set canvxmax $xr
6251 setcanvscroll
be0cd098 6252 }
9f1afe05
PM
6253}
6254
6255proc drawcmitrow {row} {
0380081c 6256 global displayorder rowidlist nrows_drawn
005a2f4e 6257 global iddrawn markingmatches
7fcc92bf 6258 global commitinfo numcommits
687c8765 6259 global filehighlight fhighlights findpattern nhighlights
908c3585 6260 global hlview vhighlights
164ff275 6261 global highlight_related rhighlights
9f1afe05 6262
8f7d0cec 6263 if {$row >= $numcommits} return
9f1afe05
PM
6264
6265 set id [lindex $displayorder $row]
476ca63d 6266 if {[info exists hlview] && ![info exists vhighlights($id)]} {
e244588e 6267 askvhighlight $row $id
908c3585 6268 }
476ca63d 6269 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
e244588e 6270 askfilehighlight $row $id
908c3585 6271 }
476ca63d 6272 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
e244588e 6273 askfindhighlight $row $id
908c3585 6274 }
476ca63d 6275 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
e244588e 6276 askrelhighlight $row $id
164ff275 6277 }
005a2f4e 6278 if {![info exists iddrawn($id)]} {
e244588e
DL
6279 set col [lsearch -exact [lindex $rowidlist $row] $id]
6280 if {$col < 0} {
6281 puts "oops, row $row id $id not in list"
6282 return
6283 }
6284 if {![info exists commitinfo($id)]} {
6285 getcommit $id
6286 }
6287 assigncolor $id
6288 drawcmittext $id $row $col
6289 set iddrawn($id) 1
6290 incr nrows_drawn
9f1afe05 6291 }
005a2f4e 6292 if {$markingmatches} {
e244588e 6293 markrowmatches $row $id
9f1afe05 6294 }
9f1afe05
PM
6295}
6296
322a8cc9 6297proc drawcommits {row {endrow {}}} {
0380081c 6298 global numcommits iddrawn displayorder curview need_redisplay
f5f3c2e2 6299 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
9f1afe05 6300
9f1afe05 6301 if {$row < 0} {
e244588e 6302 set row 0
9f1afe05 6303 }
322a8cc9 6304 if {$endrow eq {}} {
e244588e 6305 set endrow $row
322a8cc9 6306 }
9f1afe05 6307 if {$endrow >= $numcommits} {
e244588e 6308 set endrow [expr {$numcommits - 1}]
9f1afe05 6309 }
322a8cc9 6310
0380081c
PM
6311 set rl1 [expr {$row - $downarrowlen - 3}]
6312 if {$rl1 < 0} {
e244588e 6313 set rl1 0
0380081c
PM
6314 }
6315 set ro1 [expr {$row - 3}]
6316 if {$ro1 < 0} {
e244588e 6317 set ro1 0
0380081c
PM
6318 }
6319 set r2 [expr {$endrow + $uparrowlen + 3}]
6320 if {$r2 > $numcommits} {
e244588e 6321 set r2 $numcommits
0380081c
PM
6322 }
6323 for {set r $rl1} {$r < $r2} {incr r} {
e244588e
DL
6324 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6325 if {$rl1 < $r} {
6326 layoutrows $rl1 $r
6327 }
6328 set rl1 [expr {$r + 1}]
6329 }
0380081c
PM
6330 }
6331 if {$rl1 < $r} {
e244588e 6332 layoutrows $rl1 $r
0380081c
PM
6333 }
6334 optimize_rows $ro1 0 $r2
6335 if {$need_redisplay || $nrows_drawn > 2000} {
e244588e 6336 clear_display
0380081c
PM
6337 }
6338
322a8cc9
PM
6339 # make the lines join to already-drawn rows either side
6340 set r [expr {$row - 1}]
6341 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
e244588e 6342 set r $row
322a8cc9
PM
6343 }
6344 set er [expr {$endrow + 1}]
6345 if {$er >= $numcommits ||
e244588e
DL
6346 ![info exists iddrawn([lindex $displayorder $er])]} {
6347 set er $endrow
322a8cc9
PM
6348 }
6349 for {} {$r <= $er} {incr r} {
e244588e
DL
6350 set id [lindex $displayorder $r]
6351 set wasdrawn [info exists iddrawn($id)]
6352 drawcmitrow $r
6353 if {$r == $er} break
6354 set nextid [lindex $displayorder [expr {$r + 1}]]
6355 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6356 drawparentlinks $id $r
6357
6358 set rowids [lindex $rowidlist $r]
6359 foreach lid $rowids {
6360 if {$lid eq {}} continue
6361 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6362 if {$lid eq $id} {
6363 # see if this is the first child of any of its parents
6364 foreach p [lindex $parentlist $r] {
6365 if {[lsearch -exact $rowids $p] < 0} {
6366 # make this line extend up to the child
6367 set lineend($p) [drawlineseg $p $r $er 0]
6368 }
6369 }
6370 } else {
6371 set lineend($lid) [drawlineseg $lid $r $er 1]
6372 }
6373 }
9f1afe05
PM
6374 }
6375}
6376
7fcc92bf
PM
6377proc undolayout {row} {
6378 global uparrowlen mingaplen downarrowlen
6379 global rowidlist rowisopt rowfinal need_redisplay
6380
6381 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6382 if {$r < 0} {
e244588e 6383 set r 0
7fcc92bf
PM
6384 }
6385 if {[llength $rowidlist] > $r} {
e244588e
DL
6386 incr r -1
6387 set rowidlist [lrange $rowidlist 0 $r]
6388 set rowfinal [lrange $rowfinal 0 $r]
6389 set rowisopt [lrange $rowisopt 0 $r]
6390 set need_redisplay 1
6391 run drawvisible
7fcc92bf
PM
6392 }
6393}
6394
31c0eaa8
PM
6395proc drawvisible {} {
6396 global canv linespc curview vrowmod selectedline targetrow targetid
42a671fc 6397 global need_redisplay cscroll numcommits
322a8cc9 6398
31c0eaa8 6399 set fs [$canv yview]
322a8cc9 6400 set ymax [lindex [$canv cget -scrollregion] 3]
5a7f577d 6401 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
31c0eaa8
PM
6402 set f0 [lindex $fs 0]
6403 set f1 [lindex $fs 1]
322a8cc9 6404 set y0 [expr {int($f0 * $ymax)}]
322a8cc9 6405 set y1 [expr {int($f1 * $ymax)}]
31c0eaa8
PM
6406
6407 if {[info exists targetid]} {
e244588e
DL
6408 if {[commitinview $targetid $curview]} {
6409 set r [rowofcommit $targetid]
6410 if {$r != $targetrow} {
6411 # Fix up the scrollregion and change the scrolling position
6412 # now that our target row has moved.
6413 set diff [expr {($r - $targetrow) * $linespc}]
6414 set targetrow $r
6415 setcanvscroll
6416 set ymax [lindex [$canv cget -scrollregion] 3]
6417 incr y0 $diff
6418 incr y1 $diff
6419 set f0 [expr {$y0 / $ymax}]
6420 set f1 [expr {$y1 / $ymax}]
6421 allcanvs yview moveto $f0
6422 $cscroll set $f0 $f1
6423 set need_redisplay 1
6424 }
6425 } else {
6426 unset targetid
6427 }
31c0eaa8
PM
6428 }
6429
6430 set row [expr {int(($y0 - 3) / $linespc) - 1}]
322a8cc9 6431 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
31c0eaa8 6432 if {$endrow >= $vrowmod($curview)} {
e244588e 6433 update_arcrows $curview
31c0eaa8 6434 }
94b4a69f 6435 if {$selectedline ne {} &&
e244588e
DL
6436 $row <= $selectedline && $selectedline <= $endrow} {
6437 set targetrow $selectedline
ac1276ab 6438 } elseif {[info exists targetid]} {
e244588e 6439 set targetrow [expr {int(($row + $endrow) / 2)}]
31c0eaa8 6440 }
ac1276ab 6441 if {[info exists targetrow]} {
e244588e
DL
6442 if {$targetrow >= $numcommits} {
6443 set targetrow [expr {$numcommits - 1}]
6444 }
6445 set targetid [commitonrow $targetrow]
42a671fc 6446 }
322a8cc9
PM
6447 drawcommits $row $endrow
6448}
6449
9f1afe05 6450proc clear_display {} {
0380081c 6451 global iddrawn linesegs need_redisplay nrows_drawn
164ff275 6452 global vhighlights fhighlights nhighlights rhighlights
28593d3f 6453 global linehtag linentag linedtag boldids boldnameids
9f1afe05
PM
6454
6455 allcanvs delete all
009409fe
PM
6456 unset -nocomplain iddrawn
6457 unset -nocomplain linesegs
6458 unset -nocomplain linehtag
6459 unset -nocomplain linentag
6460 unset -nocomplain linedtag
28593d3f
PM
6461 set boldids {}
6462 set boldnameids {}
009409fe
PM
6463 unset -nocomplain vhighlights
6464 unset -nocomplain fhighlights
6465 unset -nocomplain nhighlights
6466 unset -nocomplain rhighlights
0380081c
PM
6467 set need_redisplay 0
6468 set nrows_drawn 0
9f1afe05
PM
6469}
6470
50b44ece 6471proc findcrossings {id} {
6e8c8707 6472 global rowidlist parentlist numcommits displayorder
50b44ece
PM
6473
6474 set cross {}
6475 set ccross {}
6476 foreach {s e} [rowranges $id] {
e244588e
DL
6477 if {$e >= $numcommits} {
6478 set e [expr {$numcommits - 1}]
6479 }
6480 if {$e <= $s} continue
6481 for {set row $e} {[incr row -1] >= $s} {} {
6482 set x [lsearch -exact [lindex $rowidlist $row] $id]
6483 if {$x < 0} break
6484 set olds [lindex $parentlist $row]
6485 set kid [lindex $displayorder $row]
6486 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6487 if {$kidx < 0} continue
6488 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6489 foreach p $olds {
6490 set px [lsearch -exact $nextrow $p]
6491 if {$px < 0} continue
6492 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6493 if {[lsearch -exact $ccross $p] >= 0} continue
6494 if {$x == $px + ($kidx < $px? -1: 1)} {
6495 lappend ccross $p
6496 } elseif {[lsearch -exact $cross $p] < 0} {
6497 lappend cross $p
6498 }
6499 }
6500 }
6501 }
50b44ece
PM
6502 }
6503 return [concat $ccross {{}} $cross]
6504}
6505
e5c2d856 6506proc assigncolor {id} {
aa81d974 6507 global colormap colors nextcolor
7fcc92bf 6508 global parents children children curview
6c20ff34 6509
418c4c7b 6510 if {[info exists colormap($id)]} return
e5c2d856 6511 set ncolors [llength $colors]
da7c24dd 6512 if {[info exists children($curview,$id)]} {
e244588e 6513 set kids $children($curview,$id)
79b2c75e 6514 } else {
e244588e 6515 set kids {}
79b2c75e
PM
6516 }
6517 if {[llength $kids] == 1} {
e244588e
DL
6518 set child [lindex $kids 0]
6519 if {[info exists colormap($child)]
6520 && [llength $parents($curview,$child)] == 1} {
6521 set colormap($id) $colormap($child)
6522 return
6523 }
9ccbdfbf
PM
6524 }
6525 set badcolors {}
50b44ece
PM
6526 set origbad {}
6527 foreach x [findcrossings $id] {
e244588e
DL
6528 if {$x eq {}} {
6529 # delimiter between corner crossings and other crossings
6530 if {[llength $badcolors] >= $ncolors - 1} break
6531 set origbad $badcolors
6532 }
6533 if {[info exists colormap($x)]
6534 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6535 lappend badcolors $colormap($x)
6536 }
6c20ff34 6537 }
50b44ece 6538 if {[llength $badcolors] >= $ncolors} {
e244588e 6539 set badcolors $origbad
9ccbdfbf 6540 }
50b44ece 6541 set origbad $badcolors
6c20ff34 6542 if {[llength $badcolors] < $ncolors - 1} {
e244588e
DL
6543 foreach child $kids {
6544 if {[info exists colormap($child)]
6545 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6546 lappend badcolors $colormap($child)
6547 }
6548 foreach p $parents($curview,$child) {
6549 if {[info exists colormap($p)]
6550 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6551 lappend badcolors $colormap($p)
6552 }
6553 }
6554 }
6555 if {[llength $badcolors] >= $ncolors} {
6556 set badcolors $origbad
6557 }
9ccbdfbf
PM
6558 }
6559 for {set i 0} {$i <= $ncolors} {incr i} {
e244588e
DL
6560 set c [lindex $colors $nextcolor]
6561 if {[incr nextcolor] >= $ncolors} {
6562 set nextcolor 0
6563 }
6564 if {[lsearch -exact $badcolors $c]} break
e5c2d856 6565 }
9ccbdfbf 6566 set colormap($id) $c
e5c2d856
PM
6567}
6568
a823a911
PM
6569proc bindline {t id} {
6570 global canv
6571
a823a911
PM
6572 $canv bind $t <Enter> "lineenter %x %y $id"
6573 $canv bind $t <Motion> "linemotion %x %y $id"
6574 $canv bind $t <Leave> "lineleave $id"
fa4da7b3 6575 $canv bind $t <Button-1> "lineclick %x %y $id 1"
a823a911
PM
6576}
6577
4399fe33
PM
6578proc graph_pane_width {} {
6579 global use_ttk
6580
6581 if {$use_ttk} {
e244588e 6582 set g [.tf.histframe.pwclist sashpos 0]
4399fe33 6583 } else {
e244588e 6584 set g [.tf.histframe.pwclist sash coord 0]
4399fe33
PM
6585 }
6586 return [lindex $g 0]
6587}
6588
6589proc totalwidth {l font extra} {
6590 set tot 0
6591 foreach str $l {
e244588e 6592 set tot [expr {$tot + [font measure $font $str] + $extra}]
4399fe33
PM
6593 }
6594 return $tot
6595}
6596
bdbfbe3d 6597proc drawtags {id x xt y1} {
8a48571c 6598 global idtags idheads idotherrefs mainhead
bdbfbe3d 6599 global linespc lthickness
d277e89f 6600 global canv rowtextx curview fgcolor bgcolor ctxbut
252c52df
6601 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6602 global tagbgcolor tagfgcolor tagoutlinecolor
6603 global reflinecolor
bdbfbe3d
PM
6604
6605 set marks {}
6606 set ntags 0
f1d83ba3 6607 set nheads 0
4399fe33
PM
6608 set singletag 0
6609 set maxtags 3
6610 set maxtagpct 25
6611 set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6612 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6613 set extra [expr {$delta + $lthickness + $linespc}]
6614
bdbfbe3d 6615 if {[info exists idtags($id)]} {
e244588e
DL
6616 set marks $idtags($id)
6617 set ntags [llength $marks]
6618 if {$ntags > $maxtags ||
6619 [totalwidth $marks mainfont $extra] > $maxwidth} {
6620 # show just a single "n tags..." tag
6621 set singletag 1
6622 if {$ntags == 1} {
6623 set marks [list "tag..."]
6624 } else {
6625 set marks [list [format "%d tags..." $ntags]]
6626 }
6627 set ntags 1
6628 }
bdbfbe3d
PM
6629 }
6630 if {[info exists idheads($id)]} {
e244588e
DL
6631 set marks [concat $marks $idheads($id)]
6632 set nheads [llength $idheads($id)]
f1d83ba3
PM
6633 }
6634 if {[info exists idotherrefs($id)]} {
e244588e 6635 set marks [concat $marks $idotherrefs($id)]
bdbfbe3d
PM
6636 }
6637 if {$marks eq {}} {
e244588e 6638 return $xt
bdbfbe3d
PM
6639 }
6640
2ed49d54
JH
6641 set yt [expr {$y1 - 0.5 * $linespc}]
6642 set yb [expr {$yt + $linespc - 1}]
bdbfbe3d
PM
6643 set xvals {}
6644 set wvals {}
8a48571c 6645 set i -1
bdbfbe3d 6646 foreach tag $marks {
e244588e
DL
6647 incr i
6648 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6649 set wid [font measure mainfontbold $tag]
6650 } else {
6651 set wid [font measure mainfont $tag]
6652 }
6653 lappend xvals $xt
6654 lappend wvals $wid
6655 set xt [expr {$xt + $wid + $extra}]
bdbfbe3d
PM
6656 }
6657 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
e244588e 6658 -width $lthickness -fill $reflinecolor -tags tag.$id]
bdbfbe3d
PM
6659 $canv lower $t
6660 foreach tag $marks x $xvals wid $wvals {
e244588e
DL
6661 set tag_quoted [string map {% %%} $tag]
6662 set xl [expr {$x + $delta}]
6663 set xr [expr {$x + $delta + $wid + $lthickness}]
6664 set font mainfont
6665 if {[incr ntags -1] >= 0} {
6666 # draw a tag
6667 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6668 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6669 -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6670 -tags tag.$id]
6671 if {$singletag} {
6672 set tagclick [list showtags $id 1]
6673 } else {
6674 set tagclick [list showtag $tag_quoted 1]
6675 }
6676 $canv bind $t <1> $tagclick
6677 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6678 } else {
6679 # draw a head or other ref
6680 if {[incr nheads -1] >= 0} {
6681 set col $headbgcolor
6682 if {$tag eq $mainhead} {
6683 set font mainfontbold
6684 }
6685 } else {
6686 set col "#ddddff"
6687 }
6688 set xl [expr {$xl - $delta/2}]
6689 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6690 -width 1 -outline black -fill $col -tags tag.$id
6691 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6692 set rwid [font measure mainfont $remoteprefix]
6693 set xi [expr {$x + 1}]
6694 set yti [expr {$yt + 1}]
6695 set xri [expr {$x + $rwid}]
6696 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6697 -width 0 -fill $remotebgcolor -tags tag.$id
6698 }
6699 }
6700 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6701 -font $font -tags [list tag.$id text]]
6702 if {$ntags >= 0} {
6703 $canv bind $t <1> $tagclick
6704 } elseif {$nheads >= 0} {
6705 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6706 }
bdbfbe3d
PM
6707 }
6708 return $xt
6709}
6710
36242490
RZ
6711proc drawnotesign {xt y} {
6712 global linespc canv fgcolor
6713
6714 set orad [expr {$linespc / 3}]
6715 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
e244588e
DL
6716 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6717 -fill yellow -outline $fgcolor -width 1 -tags circle]
36242490
RZ
6718 set xt [expr {$xt + $orad * 3}]
6719 return $xt
6720}
6721
8d858d1a
PM
6722proc xcoord {i level ln} {
6723 global canvx0 xspc1 xspc2
6724
6725 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6726 if {$i > 0 && $i == $level} {
e244588e 6727 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
8d858d1a 6728 } elseif {$i > $level} {
e244588e 6729 set x [expr {$x + $xspc2 - $xspc1($ln)}]
8d858d1a
PM
6730 }
6731 return $x
6732}
9ccbdfbf 6733
098dd8a3 6734proc show_status {msg} {
9c311b32 6735 global canv fgcolor
098dd8a3
PM
6736
6737 clear_display
9922c5a3 6738 set_window_title
9c311b32 6739 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
e244588e 6740 -tags text -fill $fgcolor
098dd8a3
PM
6741}
6742
94a2eede
PM
6743# Don't change the text pane cursor if it is currently the hand cursor,
6744# showing that we are over a sha1 ID link.
6745proc settextcursor {c} {
6746 global ctext curtextcursor
6747
6748 if {[$ctext cget -cursor] == $curtextcursor} {
e244588e 6749 $ctext config -cursor $c
94a2eede
PM
6750 }
6751 set curtextcursor $c
9ccbdfbf
PM
6752}
6753
a137a90f
PM
6754proc nowbusy {what {name {}}} {
6755 global isbusy busyname statusw
da7c24dd
PM
6756
6757 if {[array names isbusy] eq {}} {
e244588e
DL
6758 . config -cursor watch
6759 settextcursor watch
da7c24dd
PM
6760 }
6761 set isbusy($what) 1
a137a90f
PM
6762 set busyname($what) $name
6763 if {$name ne {}} {
e244588e 6764 $statusw conf -text $name
a137a90f 6765 }
da7c24dd
PM
6766}
6767
6768proc notbusy {what} {
a137a90f 6769 global isbusy maincursor textcursor busyname statusw
da7c24dd 6770
a137a90f 6771 catch {
e244588e
DL
6772 unset isbusy($what)
6773 if {$busyname($what) ne {} &&
6774 [$statusw cget -text] eq $busyname($what)} {
6775 $statusw conf -text {}
6776 }
a137a90f 6777 }
da7c24dd 6778 if {[array names isbusy] eq {}} {
e244588e
DL
6779 . config -cursor $maincursor
6780 settextcursor $textcursor
da7c24dd
PM
6781 }
6782}
6783
df3d83b1 6784proc findmatches {f} {
4fb0fa19 6785 global findtype findstring
b007ee20 6786 if {$findtype == [mc "Regexp"]} {
e244588e 6787 set matches [regexp -indices -all -inline $findstring $f]
df3d83b1 6788 } else {
e244588e
DL
6789 set fs $findstring
6790 if {$findtype == [mc "IgnCase"]} {
6791 set f [string tolower $f]
6792 set fs [string tolower $fs]
6793 }
6794 set matches {}
6795 set i 0
6796 set l [string length $fs]
6797 while {[set j [string first $fs $f $i]] >= 0} {
6798 lappend matches [list $j [expr {$j+$l-1}]]
6799 set i [expr {$j + $l}]
6800 }
df3d83b1
PM
6801 }
6802 return $matches
6803}
6804
cca5d946 6805proc dofind {{dirn 1} {wrap 1}} {
4fb0fa19 6806 global findstring findstartline findcurline selectedline numcommits
cca5d946 6807 global gdttype filehighlight fh_serial find_dirn findallowwrap
b74fd579 6808
cca5d946 6809 if {[info exists find_dirn]} {
e244588e
DL
6810 if {$find_dirn == $dirn} return
6811 stopfinding
cca5d946 6812 }
df3d83b1 6813 focus .
4fb0fa19 6814 if {$findstring eq {} || $numcommits == 0} return
94b4a69f 6815 if {$selectedline eq {}} {
e244588e 6816 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
98f350e5 6817 } else {
e244588e 6818 set findstartline $selectedline
98f350e5 6819 }
4fb0fa19 6820 set findcurline $findstartline
b007ee20
CS
6821 nowbusy finding [mc "Searching"]
6822 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
e244588e
DL
6823 after cancel do_file_hl $fh_serial
6824 do_file_hl $fh_serial
98f350e5 6825 }
cca5d946
PM
6826 set find_dirn $dirn
6827 set findallowwrap $wrap
6828 run findmore
4fb0fa19
PM
6829}
6830
bb3edc8b
PM
6831proc stopfinding {} {
6832 global find_dirn findcurline fprogcoord
4fb0fa19 6833
bb3edc8b 6834 if {[info exists find_dirn]} {
e244588e
DL
6835 unset find_dirn
6836 unset findcurline
6837 notbusy finding
6838 set fprogcoord 0
6839 adjustprogress
4fb0fa19 6840 }
8a897742 6841 stopblaming
4fb0fa19
PM
6842}
6843
6844proc findmore {} {
687c8765 6845 global commitdata commitinfo numcommits findpattern findloc
7fcc92bf 6846 global findstartline findcurline findallowwrap
bb3edc8b 6847 global find_dirn gdttype fhighlights fprogcoord
cd2bcae7 6848 global curview varcorder vrownum varccommits vrowmod
4fb0fa19 6849
bb3edc8b 6850 if {![info exists find_dirn]} {
e244588e 6851 return 0
4fb0fa19 6852 }
585c27cb 6853 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
4fb0fa19 6854 set l $findcurline
cca5d946
PM
6855 set moretodo 0
6856 if {$find_dirn > 0} {
e244588e
DL
6857 incr l
6858 if {$l >= $numcommits} {
6859 set l 0
6860 }
6861 if {$l <= $findstartline} {
6862 set lim [expr {$findstartline + 1}]
6863 } else {
6864 set lim $numcommits
6865 set moretodo $findallowwrap
6866 }
4fb0fa19 6867 } else {
e244588e
DL
6868 if {$l == 0} {
6869 set l $numcommits
6870 }
6871 incr l -1
6872 if {$l >= $findstartline} {
6873 set lim [expr {$findstartline - 1}]
6874 } else {
6875 set lim -1
6876 set moretodo $findallowwrap
6877 }
687c8765 6878 }
cca5d946
PM
6879 set n [expr {($lim - $l) * $find_dirn}]
6880 if {$n > 500} {
e244588e
DL
6881 set n 500
6882 set moretodo 1
4fb0fa19 6883 }
cd2bcae7 6884 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
e244588e 6885 update_arcrows $curview
cd2bcae7 6886 }
687c8765
PM
6887 set found 0
6888 set domore 1
7fcc92bf
PM
6889 set ai [bsearch $vrownum($curview) $l]
6890 set a [lindex $varcorder($curview) $ai]
6891 set arow [lindex $vrownum($curview) $ai]
6892 set ids [lindex $varccommits($curview,$a)]
6893 set arowend [expr {$arow + [llength $ids]}]
b007ee20 6894 if {$gdttype eq [mc "containing:"]} {
e244588e
DL
6895 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6896 if {$l < $arow || $l >= $arowend} {
6897 incr ai $find_dirn
6898 set a [lindex $varcorder($curview) $ai]
6899 set arow [lindex $vrownum($curview) $ai]
6900 set ids [lindex $varccommits($curview,$a)]
6901 set arowend [expr {$arow + [llength $ids]}]
6902 }
6903 set id [lindex $ids [expr {$l - $arow}]]
6904 # shouldn't happen unless git log doesn't give all the commits...
6905 if {![info exists commitdata($id)] ||
6906 ![doesmatch $commitdata($id)]} {
6907 continue
6908 }
6909 if {![info exists commitinfo($id)]} {
6910 getcommit $id
6911 }
6912 set info $commitinfo($id)
6913 foreach f $info ty $fldtypes {
6914 if {$ty eq ""} continue
6915 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6916 [doesmatch $f]} {
6917 set found 1
6918 break
6919 }
6920 }
6921 if {$found} break
6922 }
687c8765 6923 } else {
e244588e
DL
6924 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6925 if {$l < $arow || $l >= $arowend} {
6926 incr ai $find_dirn
6927 set a [lindex $varcorder($curview) $ai]
6928 set arow [lindex $vrownum($curview) $ai]
6929 set ids [lindex $varccommits($curview,$a)]
6930 set arowend [expr {$arow + [llength $ids]}]
6931 }
6932 set id [lindex $ids [expr {$l - $arow}]]
6933 if {![info exists fhighlights($id)]} {
6934 # this sets fhighlights($id) to -1
6935 askfilehighlight $l $id
6936 }
6937 if {$fhighlights($id) > 0} {
6938 set found $domore
6939 break
6940 }
6941 if {$fhighlights($id) < 0} {
6942 if {$domore} {
6943 set domore 0
6944 set findcurline [expr {$l - $find_dirn}]
6945 }
6946 }
6947 }
98f350e5 6948 }
cca5d946 6949 if {$found || ($domore && !$moretodo)} {
e244588e
DL
6950 unset findcurline
6951 unset find_dirn
6952 notbusy finding
6953 set fprogcoord 0
6954 adjustprogress
6955 if {$found} {
6956 findselectline $l
6957 } else {
6958 bell
6959 }
6960 return 0
df3d83b1 6961 }
687c8765 6962 if {!$domore} {
e244588e 6963 flushhighlights
bb3edc8b 6964 } else {
e244588e 6965 set findcurline [expr {$l - $find_dirn}]
687c8765 6966 }
cca5d946 6967 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
bb3edc8b 6968 if {$n < 0} {
e244588e 6969 incr n $numcommits
df3d83b1 6970 }
bb3edc8b
PM
6971 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6972 adjustprogress
6973 return $domore
df3d83b1
PM
6974}
6975
6976proc findselectline {l} {
687c8765 6977 global findloc commentend ctext findcurline markingmatches gdttype
005a2f4e 6978
8b39e04f 6979 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
005a2f4e 6980 set findcurline $l
d698206c 6981 selectline $l 1
8b39e04f 6982 if {$markingmatches &&
e244588e
DL
6983 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6984 # highlight the matches in the comments
6985 set f [$ctext get 1.0 $commentend]
6986 set matches [findmatches $f]
6987 foreach match $matches {
6988 set start [lindex $match 0]
6989 set end [expr {[lindex $match 1] + 1}]
6990 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6991 }
98f350e5 6992 }
005a2f4e 6993 drawvisible
98f350e5
PM
6994}
6995
4fb0fa19 6996# mark the bits of a headline or author that match a find string
005a2f4e
PM
6997proc markmatches {canv l str tag matches font row} {
6998 global selectedline
6999
98f350e5
PM
7000 set bbox [$canv bbox $tag]
7001 set x0 [lindex $bbox 0]
7002 set y0 [lindex $bbox 1]
7003 set y1 [lindex $bbox 3]
7004 foreach match $matches {
e244588e
DL
7005 set start [lindex $match 0]
7006 set end [lindex $match 1]
7007 if {$start > $end} continue
7008 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
7009 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
7010 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
7011 [expr {$x0+$xlen+2}] $y1 \
7012 -outline {} -tags [list match$l matches] -fill yellow]
7013 $canv lower $t
7014 if {$row == $selectedline} {
7015 $canv raise $t secsel
7016 }
98f350e5
PM
7017 }
7018}
7019
7020proc unmarkmatches {} {
bb3edc8b 7021 global markingmatches
4fb0fa19 7022
98f350e5 7023 allcanvs delete matches
4fb0fa19 7024 set markingmatches 0
bb3edc8b 7025 stopfinding
98f350e5
PM
7026}
7027
c8dfbcf9 7028proc selcanvline {w x y} {
fa4da7b3 7029 global canv canvy0 ctext linespc
9f1afe05 7030 global rowtextx
1db95b00 7031 set ymax [lindex [$canv cget -scrollregion] 3]
cfb4563c 7032 if {$ymax == {}} return
1db95b00
PM
7033 set yfrac [lindex [$canv yview] 0]
7034 set y [expr {$y + $yfrac * $ymax}]
7035 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
7036 if {$l < 0} {
e244588e 7037 set l 0
1db95b00 7038 }
c8dfbcf9 7039 if {$w eq $canv} {
e244588e
DL
7040 set xmax [lindex [$canv cget -scrollregion] 2]
7041 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
7042 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
c8dfbcf9 7043 }
98f350e5 7044 unmarkmatches
d698206c 7045 selectline $l 1
5ad588de
PM
7046}
7047
b1ba39e7
LT
7048proc commit_descriptor {p} {
7049 global commitinfo
b0934489 7050 if {![info exists commitinfo($p)]} {
e244588e 7051 getcommit $p
b0934489 7052 }
b1ba39e7 7053 set l "..."
b0934489 7054 if {[llength $commitinfo($p)] > 1} {
e244588e 7055 set l [lindex $commitinfo($p) 0]
b1ba39e7 7056 }
b8ab2e17 7057 return "$p ($l)\n"
b1ba39e7
LT
7058}
7059
106288cb
PM
7060# append some text to the ctext widget, and make any SHA1 ID
7061# that we know about be a clickable link.
3441de5b 7062# Also look for URLs of the form "http[s]://..." and make them web links.
f1b86294 7063proc appendwithlinks {text tags} {
d375ef9b 7064 global ctext linknum curview
106288cb
PM
7065
7066 set start [$ctext index "end - 1c"]
f1b86294 7067 $ctext insert end $text $tags
6c9e2d18 7068 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
106288cb 7069 foreach l $links {
e244588e
DL
7070 set s [lindex $l 0]
7071 set e [lindex $l 1]
7072 set linkid [string range $text $s $e]
7073 incr e
7074 $ctext tag delete link$linknum
7075 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7076 setlink $linkid link$linknum
7077 incr linknum
106288cb 7078 }
3441de5b 7079 set wlinks [regexp -indices -all -inline -line \
e244588e 7080 {https?://[^[:space:]]+} $text]
3441de5b 7081 foreach l $wlinks {
e244588e
DL
7082 set s2 [lindex $l 0]
7083 set e2 [lindex $l 1]
7084 set url [string range $text $s2 $e2]
7085 incr e2
7086 $ctext tag delete link$linknum
7087 $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7088 setwlink $url link$linknum
7089 incr linknum
3441de5b 7090 }
97645683
PM
7091}
7092
7093proc setlink {id lk} {
d375ef9b 7094 global curview ctext pendinglinks
252c52df 7095 global linkfgcolor
97645683 7096
6c9e2d18
JM
7097 if {[string range $id 0 1] eq "-g"} {
7098 set id [string range $id 2 end]
7099 }
7100
d375ef9b
PM
7101 set known 0
7102 if {[string length $id] < 40} {
e244588e
DL
7103 set matches [longid $id]
7104 if {[llength $matches] > 0} {
7105 if {[llength $matches] > 1} return
7106 set known 1
7107 set id [lindex $matches 0]
7108 }
d375ef9b 7109 } else {
e244588e 7110 set known [commitinview $id $curview]
d375ef9b
PM
7111 }
7112 if {$known} {
e244588e
DL
7113 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7114 $ctext tag bind $lk <1> [list selbyid $id]
7115 $ctext tag bind $lk <Enter> {linkcursor %W 1}
7116 $ctext tag bind $lk <Leave> {linkcursor %W -1}
97645683 7117 } else {
e244588e
DL
7118 lappend pendinglinks($id) $lk
7119 interestedin $id {makelink %P}
97645683
PM
7120 }
7121}
7122
3441de5b
PM
7123proc setwlink {url lk} {
7124 global ctext
7125 global linkfgcolor
7126 global web_browser
7127
7128 if {$web_browser eq {}} return
7129 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7130 $ctext tag bind $lk <1> [list browseweb $url]
7131 $ctext tag bind $lk <Enter> {linkcursor %W 1}
7132 $ctext tag bind $lk <Leave> {linkcursor %W -1}
7133}
7134
6f63fc18
PM
7135proc appendshortlink {id {pre {}} {post {}}} {
7136 global ctext linknum
7137
7138 $ctext insert end $pre
7139 $ctext tag delete link$linknum
7140 $ctext insert end [string range $id 0 7] link$linknum
7141 $ctext insert end $post
7142 setlink $id link$linknum
7143 incr linknum
7144}
7145
97645683
PM
7146proc makelink {id} {
7147 global pendinglinks
7148
7149 if {![info exists pendinglinks($id)]} return
7150 foreach lk $pendinglinks($id) {
e244588e 7151 setlink $id $lk
97645683
PM
7152 }
7153 unset pendinglinks($id)
7154}
7155
7156proc linkcursor {w inc} {
7157 global linkentercount curtextcursor
7158
7159 if {[incr linkentercount $inc] > 0} {
e244588e 7160 $w configure -cursor hand2
97645683 7161 } else {
e244588e
DL
7162 $w configure -cursor $curtextcursor
7163 if {$linkentercount < 0} {
7164 set linkentercount 0
7165 }
97645683 7166 }
106288cb
PM
7167}
7168
3441de5b
PM
7169proc browseweb {url} {
7170 global web_browser
7171
7172 if {$web_browser eq {}} return
7173 # Use eval here in case $web_browser is a command plus some arguments
7174 if {[catch {eval exec $web_browser [list $url] &} err]} {
e244588e 7175 error_popup "[mc "Error starting web browser:"] $err"
3441de5b
PM
7176 }
7177}
7178
6e5f7203
RN
7179proc viewnextline {dir} {
7180 global canv linespc
7181
7182 $canv delete hover
7183 set ymax [lindex [$canv cget -scrollregion] 3]
7184 set wnow [$canv yview]
7185 set wtop [expr {[lindex $wnow 0] * $ymax}]
7186 set newtop [expr {$wtop + $dir * $linespc}]
7187 if {$newtop < 0} {
e244588e 7188 set newtop 0
6e5f7203 7189 } elseif {$newtop > $ymax} {
e244588e 7190 set newtop $ymax
6e5f7203
RN
7191 }
7192 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7193}
7194
ef030b85
PM
7195# add a list of tag or branch names at position pos
7196# returns the number of names inserted
e11f1233 7197proc appendrefs {pos ids var} {
bde4a0f9 7198 global ctext linknum curview $var maxrefs visiblerefs mainheadid
b8ab2e17 7199
ef030b85 7200 if {[catch {$ctext index $pos}]} {
e244588e 7201 return 0
ef030b85 7202 }
e11f1233
PM
7203 $ctext conf -state normal
7204 $ctext delete $pos "$pos lineend"
7205 set tags {}
7206 foreach id $ids {
e244588e
DL
7207 foreach tag [set $var\($id\)] {
7208 lappend tags [list $tag $id]
7209 }
e11f1233 7210 }
386befb7
PM
7211
7212 set sep {}
7213 set tags [lsort -index 0 -decreasing $tags]
7214 set nutags 0
7215
0a4dd8b8 7216 if {[llength $tags] > $maxrefs} {
e244588e
DL
7217 # If we are displaying heads, and there are too many,
7218 # see if there are some important heads to display.
7219 # Currently that are the current head and heads listed in $visiblerefs option
7220 set itags {}
7221 if {$var eq "idheads"} {
7222 set utags {}
7223 foreach ti $tags {
7224 set hname [lindex $ti 0]
7225 set id [lindex $ti 1]
7226 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7227 [llength $itags] < $maxrefs} {
7228 lappend itags $ti
7229 } else {
7230 lappend utags $ti
7231 }
7232 }
7233 set tags $utags
7234 }
7235 if {$itags ne {}} {
7236 set str [mc "and many more"]
7237 set sep " "
7238 } else {
7239 set str [mc "many"]
7240 }
7241 $ctext insert $pos "$str ([llength $tags])"
7242 set nutags [llength $tags]
7243 set tags $itags
386befb7
PM
7244 }
7245
7246 foreach ti $tags {
e244588e
DL
7247 set id [lindex $ti 1]
7248 set lk link$linknum
7249 incr linknum
7250 $ctext tag delete $lk
7251 $ctext insert $pos $sep
7252 $ctext insert $pos [lindex $ti 0] $lk
7253 setlink $id $lk
7254 set sep ", "
b8ab2e17 7255 }
d34835c9 7256 $ctext tag add wwrap "$pos linestart" "$pos lineend"
e11f1233 7257 $ctext conf -state disabled
386befb7 7258 return [expr {[llength $tags] + $nutags}]
b8ab2e17
PM
7259}
7260
e11f1233
PM
7261# called when we have finished computing the nearby tags
7262proc dispneartags {delay} {
7263 global selectedline currentid showneartags tagphase
ca6d8f58 7264
94b4a69f 7265 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
7266 after cancel dispnexttag
7267 if {$delay} {
e244588e
DL
7268 after 200 dispnexttag
7269 set tagphase -1
e11f1233 7270 } else {
e244588e
DL
7271 after idle dispnexttag
7272 set tagphase 0
ca6d8f58 7273 }
ca6d8f58
PM
7274}
7275
e11f1233
PM
7276proc dispnexttag {} {
7277 global selectedline currentid showneartags tagphase ctext
b8ab2e17 7278
94b4a69f 7279 if {$selectedline eq {} || !$showneartags} return
e11f1233 7280 switch -- $tagphase {
e244588e
DL
7281 0 {
7282 set dtags [desctags $currentid]
7283 if {$dtags ne {}} {
7284 appendrefs precedes $dtags idtags
7285 }
7286 }
7287 1 {
7288 set atags [anctags $currentid]
7289 if {$atags ne {}} {
7290 appendrefs follows $atags idtags
7291 }
7292 }
7293 2 {
7294 set dheads [descheads $currentid]
7295 if {$dheads ne {}} {
7296 if {[appendrefs branch $dheads idheads] > 1
7297 && [$ctext get "branch -3c"] eq "h"} {
7298 # turn "Branch" into "Branches"
7299 $ctext conf -state normal
7300 $ctext insert "branch -2c" "es"
7301 $ctext conf -state disabled
7302 }
7303 }
7304 }
ef030b85 7305 }
e11f1233 7306 if {[incr tagphase] <= 2} {
e244588e 7307 after idle dispnexttag
b8ab2e17 7308 }
b8ab2e17
PM
7309}
7310
28593d3f 7311proc make_secsel {id} {
0380081c
PM
7312 global linehtag linentag linedtag canv canv2 canv3
7313
28593d3f 7314 if {![info exists linehtag($id)]} return
0380081c 7315 $canv delete secsel
28593d3f 7316 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
e244588e 7317 -tags secsel -fill [$canv cget -selectbackground]]
0380081c
PM
7318 $canv lower $t
7319 $canv2 delete secsel
28593d3f 7320 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
e244588e 7321 -tags secsel -fill [$canv2 cget -selectbackground]]
0380081c
PM
7322 $canv2 lower $t
7323 $canv3 delete secsel
28593d3f 7324 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
e244588e 7325 -tags secsel -fill [$canv3 cget -selectbackground]]
0380081c
PM
7326 $canv3 lower $t
7327}
7328
b9fdba7f
PM
7329proc make_idmark {id} {
7330 global linehtag canv fgcolor
7331
7332 if {![info exists linehtag($id)]} return
7333 $canv delete markid
7334 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
e244588e 7335 -tags markid -outline $fgcolor]
b9fdba7f
PM
7336 $canv raise $t
7337}
7338
4135d36b 7339proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
0380081c 7340 global canv ctext commitinfo selectedline
7fcc92bf 7341 global canvy0 linespc parents children curview
7fcceed7 7342 global currentid sha1entry
9f1afe05 7343 global commentend idtags linknum
d94f8cd6 7344 global mergemax numcommits pending_select
e11f1233 7345 global cmitmode showneartags allcommits
c30acc77 7346 global targetrow targetid lastscrollrows
21ac8a8d 7347 global autoselect autosellen jump_to_here
9403bd02 7348 global vinlinediff
d698206c 7349
009409fe 7350 unset -nocomplain pending_select
84ba7345 7351 $canv delete hover
9843c307 7352 normalline
887c996e 7353 unsel_reflist
bb3edc8b 7354 stopfinding
8f7d0cec 7355 if {$l < 0 || $l >= $numcommits} return
ac1276ab
PM
7356 set id [commitonrow $l]
7357 set targetid $id
7358 set targetrow $l
c30acc77
PM
7359 set selectedline $l
7360 set currentid $id
7361 if {$lastscrollrows < $numcommits} {
e244588e 7362 setcanvscroll
c30acc77 7363 }
ac1276ab 7364
4135d36b
MK
7365 if {$cmitmode ne "patch" && $switch_to_patch} {
7366 set cmitmode "patch"
7367 }
7368
5ad588de 7369 set y [expr {$canvy0 + $l * $linespc}]
17386066 7370 set ymax [lindex [$canv cget -scrollregion] 3]
5842215e
PM
7371 set ytop [expr {$y - $linespc - 1}]
7372 set ybot [expr {$y + $linespc + 1}]
5ad588de 7373 set wnow [$canv yview]
2ed49d54
JH
7374 set wtop [expr {[lindex $wnow 0] * $ymax}]
7375 set wbot [expr {[lindex $wnow 1] * $ymax}]
5842215e
PM
7376 set wh [expr {$wbot - $wtop}]
7377 set newtop $wtop
17386066 7378 if {$ytop < $wtop} {
e244588e
DL
7379 if {$ybot < $wtop} {
7380 set newtop [expr {$y - $wh / 2.0}]
7381 } else {
7382 set newtop $ytop
7383 if {$newtop > $wtop - $linespc} {
7384 set newtop [expr {$wtop - $linespc}]
7385 }
7386 }
5842215e 7387 } elseif {$ybot > $wbot} {
e244588e
DL
7388 if {$ytop > $wbot} {
7389 set newtop [expr {$y - $wh / 2.0}]
7390 } else {
7391 set newtop [expr {$ybot - $wh}]
7392 if {$newtop < $wtop + $linespc} {
7393 set newtop [expr {$wtop + $linespc}]
7394 }
7395 }
5842215e
PM
7396 }
7397 if {$newtop != $wtop} {
e244588e
DL
7398 if {$newtop < 0} {
7399 set newtop 0
7400 }
7401 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7402 drawvisible
5ad588de 7403 }
d698206c 7404
28593d3f 7405 make_secsel $id
9f1afe05 7406
fa4da7b3 7407 if {$isnew} {
e244588e 7408 addtohistory [list selbyid $id 0] savecmitpos
d698206c
PM
7409 }
7410
98f350e5
PM
7411 $sha1entry delete 0 end
7412 $sha1entry insert 0 $id
95293b58 7413 if {$autoselect} {
e244588e 7414 $sha1entry selection range 0 $autosellen
95293b58 7415 }
164ff275 7416 rhighlight_sel $id
98f350e5 7417
5ad588de 7418 $ctext conf -state normal
3ea06f9f 7419 clear_ctext
106288cb 7420 set linknum 0
d76afb15 7421 if {![info exists commitinfo($id)]} {
e244588e 7422 getcommit $id
d76afb15 7423 }
1db95b00 7424 set info $commitinfo($id)
232475d3 7425 set date [formatdate [lindex $info 2]]
d990cedf 7426 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
232475d3 7427 set date [formatdate [lindex $info 4]]
d990cedf 7428 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
887fe3c4 7429 if {[info exists idtags($id)]} {
e244588e
DL
7430 $ctext insert end [mc "Tags:"]
7431 foreach tag $idtags($id) {
7432 $ctext insert end " $tag"
7433 }
7434 $ctext insert end "\n"
887fe3c4 7435 }
40b87ff8 7436
f1b86294 7437 set headers {}
7fcc92bf 7438 set olds $parents($curview,$id)
79b2c75e 7439 if {[llength $olds] > 1} {
e244588e
DL
7440 set np 0
7441 foreach p $olds {
7442 if {$np >= $mergemax} {
7443 set tag mmax
7444 } else {
7445 set tag m$np
7446 }
7447 $ctext insert end "[mc "Parent"]: " $tag
7448 appendwithlinks [commit_descriptor $p] {}
7449 incr np
7450 }
b77b0278 7451 } else {
e244588e
DL
7452 foreach p $olds {
7453 append headers "[mc "Parent"]: [commit_descriptor $p]"
7454 }
b1ba39e7 7455 }
b77b0278 7456
6a90bff1 7457 foreach c $children($curview,$id) {
e244588e 7458 append headers "[mc "Child"]: [commit_descriptor $c]"
8b192809 7459 }
d698206c
PM
7460
7461 # make anything that looks like a SHA1 ID be a clickable link
f1b86294 7462 appendwithlinks $headers {}
b8ab2e17 7463 if {$showneartags} {
e244588e
DL
7464 if {![info exists allcommits]} {
7465 getallcommits
7466 }
7467 $ctext insert end "[mc "Branch"]: "
7468 $ctext mark set branch "end -1c"
7469 $ctext mark gravity branch left
7470 $ctext insert end "\n[mc "Follows"]: "
7471 $ctext mark set follows "end -1c"
7472 $ctext mark gravity follows left
7473 $ctext insert end "\n[mc "Precedes"]: "
7474 $ctext mark set precedes "end -1c"
7475 $ctext mark gravity precedes left
7476 $ctext insert end "\n"
7477 dispneartags 1
b8ab2e17
PM
7478 }
7479 $ctext insert end "\n"
43c25074
PM
7480 set comment [lindex $info 5]
7481 if {[string first "\r" $comment] >= 0} {
e244588e 7482 set comment [string map {"\r" "\n "} $comment]
43c25074
PM
7483 }
7484 appendwithlinks $comment {comment}
d698206c 7485
df3d83b1 7486 $ctext tag remove found 1.0 end
5ad588de 7487 $ctext conf -state disabled
df3d83b1 7488 set commentend [$ctext index "end - 1c"]
5ad588de 7489
8a897742 7490 set jump_to_here $desired_loc
b007ee20 7491 init_flist [mc "Comments"]
f8b28a40 7492 if {$cmitmode eq "tree"} {
e244588e 7493 gettree $id
9403bd02 7494 } elseif {$vinlinediff($curview) == 1} {
e244588e 7495 showinlinediff $id
f8b28a40 7496 } elseif {[llength $olds] <= 1} {
e244588e 7497 startdiff $id
7b5ff7e7 7498 } else {
e244588e 7499 mergediff $id
3c461ffe
PM
7500 }
7501}
7502
6e5f7203
RN
7503proc selfirstline {} {
7504 unmarkmatches
7505 selectline 0 1
7506}
7507
7508proc sellastline {} {
7509 global numcommits
7510 unmarkmatches
7511 set l [expr {$numcommits - 1}]
7512 selectline $l 1
7513}
7514
3c461ffe
PM
7515proc selnextline {dir} {
7516 global selectedline
bd441de4 7517 focus .
94b4a69f 7518 if {$selectedline eq {}} return
2ed49d54 7519 set l [expr {$selectedline + $dir}]
3c461ffe 7520 unmarkmatches
d698206c
PM
7521 selectline $l 1
7522}
7523
6e5f7203
RN
7524proc selnextpage {dir} {
7525 global canv linespc selectedline numcommits
7526
7527 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7528 if {$lpp < 1} {
e244588e 7529 set lpp 1
6e5f7203
RN
7530 }
7531 allcanvs yview scroll [expr {$dir * $lpp}] units
e72ee5eb 7532 drawvisible
94b4a69f 7533 if {$selectedline eq {}} return
6e5f7203
RN
7534 set l [expr {$selectedline + $dir * $lpp}]
7535 if {$l < 0} {
e244588e 7536 set l 0
6e5f7203
RN
7537 } elseif {$l >= $numcommits} {
7538 set l [expr $numcommits - 1]
7539 }
7540 unmarkmatches
40b87ff8 7541 selectline $l 1
6e5f7203
RN
7542}
7543
fa4da7b3 7544proc unselectline {} {
50b44ece 7545 global selectedline currentid
fa4da7b3 7546
94b4a69f 7547 set selectedline {}
009409fe 7548 unset -nocomplain currentid
fa4da7b3 7549 allcanvs delete secsel
164ff275 7550 rhighlight_none
fa4da7b3
PM
7551}
7552
f8b28a40
PM
7553proc reselectline {} {
7554 global selectedline
7555
94b4a69f 7556 if {$selectedline ne {}} {
e244588e 7557 selectline $selectedline 0
f8b28a40
PM
7558 }
7559}
7560
354af6bd 7561proc addtohistory {cmd {saveproc {}}} {
2516dae2 7562 global history historyindex curview
fa4da7b3 7563
354af6bd
PM
7564 unset_posvars
7565 save_position
7566 set elt [list $curview $cmd $saveproc {}]
fa4da7b3 7567 if {$historyindex > 0
e244588e
DL
7568 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7569 return
fa4da7b3
PM
7570 }
7571
7572 if {$historyindex < [llength $history]} {
e244588e 7573 set history [lreplace $history $historyindex end $elt]
fa4da7b3 7574 } else {
e244588e 7575 lappend history $elt
fa4da7b3
PM
7576 }
7577 incr historyindex
7578 if {$historyindex > 1} {
e244588e 7579 .tf.bar.leftbut conf -state normal
fa4da7b3 7580 } else {
e244588e 7581 .tf.bar.leftbut conf -state disabled
fa4da7b3 7582 }
e9937d2a 7583 .tf.bar.rightbut conf -state disabled
fa4da7b3
PM
7584}
7585
354af6bd
PM
7586# save the scrolling position of the diff display pane
7587proc save_position {} {
7588 global historyindex history
7589
7590 if {$historyindex < 1} return
7591 set hi [expr {$historyindex - 1}]
7592 set fn [lindex $history $hi 2]
7593 if {$fn ne {}} {
e244588e 7594 lset history $hi 3 [eval $fn]
354af6bd
PM
7595 }
7596}
7597
7598proc unset_posvars {} {
7599 global last_posvars
7600
7601 if {[info exists last_posvars]} {
e244588e
DL
7602 foreach {var val} $last_posvars {
7603 global $var
7604 unset -nocomplain $var
7605 }
7606 unset last_posvars
354af6bd
PM
7607 }
7608}
7609
2516dae2 7610proc godo {elt} {
354af6bd 7611 global curview last_posvars
2516dae2
PM
7612
7613 set view [lindex $elt 0]
7614 set cmd [lindex $elt 1]
354af6bd 7615 set pv [lindex $elt 3]
2516dae2 7616 if {$curview != $view} {
e244588e 7617 showview $view
2516dae2 7618 }
354af6bd
PM
7619 unset_posvars
7620 foreach {var val} $pv {
e244588e
DL
7621 global $var
7622 set $var $val
354af6bd
PM
7623 }
7624 set last_posvars $pv
2516dae2
PM
7625 eval $cmd
7626}
7627
d698206c
PM
7628proc goback {} {
7629 global history historyindex
bd441de4 7630 focus .
d698206c
PM
7631
7632 if {$historyindex > 1} {
e244588e
DL
7633 save_position
7634 incr historyindex -1
7635 godo [lindex $history [expr {$historyindex - 1}]]
7636 .tf.bar.rightbut conf -state normal
d698206c
PM
7637 }
7638 if {$historyindex <= 1} {
e244588e 7639 .tf.bar.leftbut conf -state disabled
d698206c
PM
7640 }
7641}
7642
7643proc goforw {} {
7644 global history historyindex
bd441de4 7645 focus .
d698206c
PM
7646
7647 if {$historyindex < [llength $history]} {
e244588e
DL
7648 save_position
7649 set cmd [lindex $history $historyindex]
7650 incr historyindex
7651 godo $cmd
7652 .tf.bar.leftbut conf -state normal
d698206c
PM
7653 }
7654 if {$historyindex >= [llength $history]} {
e244588e 7655 .tf.bar.rightbut conf -state disabled
d698206c 7656 }
e2ed4324
PM
7657}
7658
d4ec30b2
MK
7659proc go_to_parent {i} {
7660 global parents curview targetid
7661 set ps $parents($curview,$targetid)
7662 if {[llength $ps] >= $i} {
e244588e 7663 selbyid [lindex $ps [expr $i - 1]]
d4ec30b2
MK
7664 }
7665}
7666
f8b28a40 7667proc gettree {id} {
8f489363
PM
7668 global treefilelist treeidlist diffids diffmergeid treepending
7669 global nullid nullid2
f8b28a40
PM
7670
7671 set diffids $id
009409fe 7672 unset -nocomplain diffmergeid
f8b28a40 7673 if {![info exists treefilelist($id)]} {
e244588e
DL
7674 if {![info exists treepending]} {
7675 if {$id eq $nullid} {
7676 set cmd [list | git ls-files]
7677 } elseif {$id eq $nullid2} {
7678 set cmd [list | git ls-files --stage -t]
7679 } else {
7680 set cmd [list | git ls-tree -r $id]
7681 }
7682 if {[catch {set gtf [open $cmd r]}]} {
7683 return
7684 }
7685 set treepending $id
7686 set treefilelist($id) {}
7687 set treeidlist($id) {}
7688 fconfigure $gtf -blocking 0 -encoding binary
7689 filerun $gtf [list gettreeline $gtf $id]
7690 }
f8b28a40 7691 } else {
e244588e 7692 setfilelist $id
f8b28a40
PM
7693 }
7694}
7695
7696proc gettreeline {gtf id} {
8f489363 7697 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
f8b28a40 7698
7eb3cb9c
PM
7699 set nl 0
7700 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
e244588e
DL
7701 if {$diffids eq $nullid} {
7702 set fname $line
7703 } else {
7704 set i [string first "\t" $line]
7705 if {$i < 0} continue
7706 set fname [string range $line [expr {$i+1}] end]
7707 set line [string range $line 0 [expr {$i-1}]]
7708 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7709 set sha1 [lindex $line 2]
7710 lappend treeidlist($id) $sha1
7711 }
7712 if {[string index $fname 0] eq "\""} {
7713 set fname [lindex $fname 0]
7714 }
7715 set fname [encoding convertfrom $fname]
7716 lappend treefilelist($id) $fname
7eb3cb9c
PM
7717 }
7718 if {![eof $gtf]} {
e244588e 7719 return [expr {$nl >= 1000? 2: 1}]
f8b28a40 7720 }
f8b28a40
PM
7721 close $gtf
7722 unset treepending
7723 if {$cmitmode ne "tree"} {
e244588e
DL
7724 if {![info exists diffmergeid]} {
7725 gettreediffs $diffids
7726 }
f8b28a40 7727 } elseif {$id ne $diffids} {
e244588e 7728 gettree $diffids
f8b28a40 7729 } else {
e244588e 7730 setfilelist $id
f8b28a40 7731 }
7eb3cb9c 7732 return 0
f8b28a40
PM
7733}
7734
7735proc showfile {f} {
8f489363 7736 global treefilelist treeidlist diffids nullid nullid2
7cdc3556 7737 global ctext_file_names ctext_file_lines
f8b28a40
PM
7738 global ctext commentend
7739
7740 set i [lsearch -exact $treefilelist($diffids) $f]
7741 if {$i < 0} {
e244588e
DL
7742 puts "oops, $f not in list for id $diffids"
7743 return
f8b28a40 7744 }
8f489363 7745 if {$diffids eq $nullid} {
e244588e
DL
7746 if {[catch {set bf [open $f r]} err]} {
7747 puts "oops, can't read $f: $err"
7748 return
7749 }
219ea3a9 7750 } else {
e244588e
DL
7751 set blob [lindex $treeidlist($diffids) $i]
7752 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7753 puts "oops, error reading blob $blob: $err"
7754 return
7755 }
f8b28a40 7756 }
09c7029d 7757 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7eb3cb9c 7758 filerun $bf [list getblobline $bf $diffids]
f8b28a40 7759 $ctext config -state normal
3ea06f9f 7760 clear_ctext $commentend
7cdc3556
AG
7761 lappend ctext_file_names $f
7762 lappend ctext_file_lines [lindex [split $commentend "."] 0]
f8b28a40
PM
7763 $ctext insert end "\n"
7764 $ctext insert end "$f\n" filesep
7765 $ctext config -state disabled
7766 $ctext yview $commentend
32f1b3e4 7767 settabs 0
f8b28a40
PM
7768}
7769
7770proc getblobline {bf id} {
7771 global diffids cmitmode ctext
7772
7773 if {$id ne $diffids || $cmitmode ne "tree"} {
e244588e
DL
7774 catch {close $bf}
7775 return 0
f8b28a40
PM
7776 }
7777 $ctext config -state normal
7eb3cb9c
PM
7778 set nl 0
7779 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
e244588e 7780 $ctext insert end "$line\n"
f8b28a40
PM
7781 }
7782 if {[eof $bf]} {
e244588e
DL
7783 global jump_to_here ctext_file_names commentend
7784
7785 # delete last newline
7786 $ctext delete "end - 2c" "end - 1c"
7787 close $bf
7788 if {$jump_to_here ne {} &&
7789 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7790 set lnum [expr {[lindex $jump_to_here 1] +
7791 [lindex [split $commentend .] 0]}]
7792 mark_ctext_line $lnum
7793 }
7794 $ctext config -state disabled
7795 return 0
f8b28a40
PM
7796 }
7797 $ctext config -state disabled
7eb3cb9c 7798 return [expr {$nl >= 1000? 2: 1}]
f8b28a40
PM
7799}
7800
8a897742 7801proc mark_ctext_line {lnum} {
e3e901be 7802 global ctext markbgcolor
8a897742
PM
7803
7804 $ctext tag delete omark
7805 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
e3e901be 7806 $ctext tag conf omark -background $markbgcolor
8a897742
PM
7807 $ctext see $lnum.0
7808}
7809
7fcc92bf 7810proc mergediff {id} {
8b07dca1 7811 global diffmergeid
2df6442f 7812 global diffids treediffs
8b07dca1 7813 global parents curview
e2ed4324 7814
3c461ffe 7815 set diffmergeid $id
7a1d9d14 7816 set diffids $id
2df6442f 7817 set treediffs($id) {}
7fcc92bf 7818 set np [llength $parents($curview,$id)]
32f1b3e4 7819 settabs $np
8b07dca1 7820 getblobdiffs $id
c8a4acbf
PM
7821}
7822
3c461ffe 7823proc startdiff {ids} {
8f489363 7824 global treediffs diffids treepending diffmergeid nullid nullid2
c8dfbcf9 7825
32f1b3e4 7826 settabs 1
4f2c2642 7827 set diffids $ids
009409fe 7828 unset -nocomplain diffmergeid
8f489363 7829 if {![info exists treediffs($ids)] ||
e244588e
DL
7830 [lsearch -exact $ids $nullid] >= 0 ||
7831 [lsearch -exact $ids $nullid2] >= 0} {
7832 if {![info exists treepending]} {
7833 gettreediffs $ids
7834 }
c8dfbcf9 7835 } else {
e244588e 7836 addtocflist $ids
c8dfbcf9
PM
7837 }
7838}
7839
9403bd02
TR
7840proc showinlinediff {ids} {
7841 global commitinfo commitdata ctext
7842 global treediffs
7843
7844 set info $commitinfo($ids)
7845 set diff [lindex $info 7]
7846 set difflines [split $diff "\n"]
7847
7848 initblobdiffvars
7849 set treediff {}
7850
7851 set inhdr 0
7852 foreach line $difflines {
e244588e
DL
7853 if {![string compare -length 5 "diff " $line]} {
7854 set inhdr 1
7855 } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7856 # offset also accounts for the b/ prefix
7857 lappend treediff [string range $line 6 end]
7858 set inhdr 0
7859 }
9403bd02
TR
7860 }
7861
7862 set treediffs($ids) $treediff
7863 add_flist $treediff
7864
7865 $ctext conf -state normal
7866 foreach line $difflines {
e244588e 7867 parseblobdiffline $ids $line
9403bd02
TR
7868 }
7869 maybe_scroll_ctext 1
7870 $ctext conf -state disabled
7871}
7872
65bb0bda
PT
7873# If the filename (name) is under any of the passed filter paths
7874# then return true to include the file in the listing.
7a39a17a 7875proc path_filter {filter name} {
65bb0bda 7876 set worktree [gitworktree]
7a39a17a 7877 foreach p $filter {
e244588e
DL
7878 set fq_p [file normalize $p]
7879 set fq_n [file normalize [file join $worktree $name]]
7880 if {[string match [file normalize $fq_p]* $fq_n]} {
7881 return 1
7882 }
7a39a17a
PM
7883 }
7884 return 0
7885}
7886
c8dfbcf9 7887proc addtocflist {ids} {
74a40c71 7888 global treediffs
7a39a17a 7889
74a40c71 7890 add_flist $treediffs($ids)
c8dfbcf9 7891 getblobdiffs $ids
d2610d11
PM
7892}
7893
219ea3a9 7894proc diffcmd {ids flags} {
17f9836c 7895 global log_showroot nullid nullid2 git_version
219ea3a9
PM
7896
7897 set i [lsearch -exact $ids $nullid]
8f489363 7898 set j [lsearch -exact $ids $nullid2]
219ea3a9 7899 if {$i >= 0} {
e244588e
DL
7900 if {[llength $ids] > 1 && $j < 0} {
7901 # comparing working directory with some specific revision
7902 set cmd [concat | git diff-index $flags]
7903 if {$i == 0} {
7904 lappend cmd -R [lindex $ids 1]
7905 } else {
7906 lappend cmd [lindex $ids 0]
7907 }
7908 } else {
7909 # comparing working directory with index
7910 set cmd [concat | git diff-files $flags]
7911 if {$j == 1} {
7912 lappend cmd -R
7913 }
7914 }
8f489363 7915 } elseif {$j >= 0} {
e244588e
DL
7916 if {[package vcompare $git_version "1.7.2"] >= 0} {
7917 set flags "$flags --ignore-submodules=dirty"
7918 }
7919 set cmd [concat | git diff-index --cached $flags]
7920 if {[llength $ids] > 1} {
7921 # comparing index with specific revision
7922 if {$j == 0} {
7923 lappend cmd -R [lindex $ids 1]
7924 } else {
7925 lappend cmd [lindex $ids 0]
7926 }
7927 } else {
7928 # comparing index with HEAD
7929 lappend cmd HEAD
7930 }
219ea3a9 7931 } else {
e244588e
DL
7932 if {$log_showroot} {
7933 lappend flags --root
7934 }
7935 set cmd [concat | git diff-tree -r $flags $ids]
219ea3a9
PM
7936 }
7937 return $cmd
7938}
7939
c8dfbcf9 7940proc gettreediffs {ids} {
2c8cd905 7941 global treediff treepending limitdiffs vfilelimit curview
219ea3a9 7942
2c8cd905
FC
7943 set cmd [diffcmd $ids {--no-commit-id}]
7944 if {$limitdiffs && $vfilelimit($curview) ne {}} {
e244588e 7945 set cmd [concat $cmd -- $vfilelimit($curview)]
2c8cd905
FC
7946 }
7947 if {[catch {set gdtf [open $cmd r]}]} return
7272131b 7948
c8dfbcf9 7949 set treepending $ids
3c461ffe 7950 set treediff {}
09c7029d 7951 fconfigure $gdtf -blocking 0 -encoding binary
7eb3cb9c 7952 filerun $gdtf [list gettreediffline $gdtf $ids]
d2610d11
PM
7953}
7954
c8dfbcf9 7955proc gettreediffline {gdtf ids} {
3c461ffe 7956 global treediff treediffs treepending diffids diffmergeid
39ee47ef 7957 global cmitmode vfilelimit curview limitdiffs perfile_attrs
3c461ffe 7958
7eb3cb9c 7959 set nr 0
4db09304 7960 set sublist {}
39ee47ef
PM
7961 set max 1000
7962 if {$perfile_attrs} {
e244588e
DL
7963 # cache_gitattr is slow, and even slower on win32 where we
7964 # have to invoke it for only about 30 paths at a time
7965 set max 500
7966 if {[tk windowingsystem] == "win32"} {
7967 set max 120
7968 }
39ee47ef
PM
7969 }
7970 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
e244588e
DL
7971 set i [string first "\t" $line]
7972 if {$i >= 0} {
7973 set file [string range $line [expr {$i+1}] end]
7974 if {[string index $file 0] eq "\""} {
7975 set file [lindex $file 0]
7976 }
7977 set file [encoding convertfrom $file]
7978 if {$file ne [lindex $treediff end]} {
7979 lappend treediff $file
7980 lappend sublist $file
7981 }
7982 }
7eb3cb9c 7983 }
39ee47ef 7984 if {$perfile_attrs} {
e244588e 7985 cache_gitattr encoding $sublist
39ee47ef 7986 }
7eb3cb9c 7987 if {![eof $gdtf]} {
e244588e 7988 return [expr {$nr >= $max? 2: 1}]
7eb3cb9c
PM
7989 }
7990 close $gdtf
2c8cd905 7991 set treediffs($ids) $treediff
7eb3cb9c 7992 unset treepending
e1160138 7993 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
e244588e 7994 gettree $diffids
7eb3cb9c 7995 } elseif {$ids != $diffids} {
e244588e
DL
7996 if {![info exists diffmergeid]} {
7997 gettreediffs $diffids
7998 }
7eb3cb9c 7999 } else {
e244588e 8000 addtocflist $ids
d2610d11 8001 }
7eb3cb9c 8002 return 0
d2610d11
PM
8003}
8004
890fae70
SP
8005# empty string or positive integer
8006proc diffcontextvalidate {v} {
8007 return [regexp {^(|[1-9][0-9]*)$} $v]
8008}
8009
8010proc diffcontextchange {n1 n2 op} {
8011 global diffcontextstring diffcontext
8012
8013 if {[string is integer -strict $diffcontextstring]} {
e244588e
DL
8014 if {$diffcontextstring >= 0} {
8015 set diffcontext $diffcontextstring
8016 reselectline
8017 }
890fae70
SP
8018 }
8019}
8020
b9b86007
SP
8021proc changeignorespace {} {
8022 reselectline
8023}
8024
ae4e3ff9
TR
8025proc changeworddiff {name ix op} {
8026 reselectline
8027}
8028
5de460a2
TR
8029proc initblobdiffvars {} {
8030 global diffencoding targetline diffnparents
8031 global diffinhdr currdiffsubmod diffseehere
8032 set targetline {}
8033 set diffnparents 0
8034 set diffinhdr 0
8035 set diffencoding [get_path_encoding {}]
8036 set currdiffsubmod ""
8037 set diffseehere -1
8038}
8039
c8dfbcf9 8040proc getblobdiffs {ids} {
8d73b242 8041 global blobdifffd diffids env
5de460a2 8042 global treediffs
890fae70 8043 global diffcontext
b9b86007 8044 global ignorespace
ae4e3ff9 8045 global worddiff
3ed31a81 8046 global limitdiffs vfilelimit curview
5de460a2 8047 global git_version
c8dfbcf9 8048
a8138733
PM
8049 set textconv {}
8050 if {[package vcompare $git_version "1.6.1"] >= 0} {
e244588e 8051 set textconv "--textconv"
a8138733 8052 }
5c838d23
JL
8053 set submodule {}
8054 if {[package vcompare $git_version "1.6.6"] >= 0} {
e244588e 8055 set submodule "--submodule"
5c838d23
JL
8056 }
8057 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
b9b86007 8058 if {$ignorespace} {
e244588e 8059 append cmd " -w"
b9b86007 8060 }
ae4e3ff9 8061 if {$worddiff ne [mc "Line diff"]} {
e244588e 8062 append cmd " --word-diff=porcelain"
ae4e3ff9 8063 }
3ed31a81 8064 if {$limitdiffs && $vfilelimit($curview) ne {}} {
e244588e 8065 set cmd [concat $cmd -- $vfilelimit($curview)]
7a39a17a
PM
8066 }
8067 if {[catch {set bdf [open $cmd r]} err]} {
e244588e
DL
8068 error_popup [mc "Error getting diffs: %s" $err]
8069 return
e5c2d856 8070 }
681c3290 8071 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
c8dfbcf9 8072 set blobdifffd($ids) $bdf
5de460a2 8073 initblobdiffvars
7eb3cb9c 8074 filerun $bdf [list getblobdiffline $bdf $diffids]
e5c2d856
PM
8075}
8076
354af6bd
PM
8077proc savecmitpos {} {
8078 global ctext cmitmode
8079
8080 if {$cmitmode eq "tree"} {
e244588e 8081 return {}
354af6bd
PM
8082 }
8083 return [list target_scrollpos [$ctext index @0,0]]
8084}
8085
8086proc savectextpos {} {
8087 global ctext
8088
8089 return [list target_scrollpos [$ctext index @0,0]]
8090}
8091
8092proc maybe_scroll_ctext {ateof} {
8093 global ctext target_scrollpos
8094
8095 if {![info exists target_scrollpos]} return
8096 if {!$ateof} {
e244588e
DL
8097 set nlines [expr {[winfo height $ctext]
8098 / [font metrics textfont -linespace]}]
8099 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
354af6bd
PM
8100 }
8101 $ctext yview $target_scrollpos
8102 unset target_scrollpos
8103}
8104
89b11d3b
PM
8105proc setinlist {var i val} {
8106 global $var
8107
8108 while {[llength [set $var]] < $i} {
e244588e 8109 lappend $var {}
89b11d3b
PM
8110 }
8111 if {[llength [set $var]] == $i} {
e244588e 8112 lappend $var $val
89b11d3b 8113 } else {
e244588e 8114 lset $var $i $val
89b11d3b
PM
8115 }
8116}
8117
9396cd38 8118proc makediffhdr {fname ids} {
8b07dca1 8119 global ctext curdiffstart treediffs diffencoding
8a897742 8120 global ctext_file_names jump_to_here targetline diffline
9396cd38 8121
8b07dca1
PM
8122 set fname [encoding convertfrom $fname]
8123 set diffencoding [get_path_encoding $fname]
9396cd38
PM
8124 set i [lsearch -exact $treediffs($ids) $fname]
8125 if {$i >= 0} {
e244588e 8126 setinlist difffilestart $i $curdiffstart
9396cd38 8127 }
48a81b7c 8128 lset ctext_file_names end $fname
9396cd38
PM
8129 set l [expr {(78 - [string length $fname]) / 2}]
8130 set pad [string range "----------------------------------------" 1 $l]
8131 $ctext insert $curdiffstart "$pad $fname $pad" filesep
8a897742
PM
8132 set targetline {}
8133 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
e244588e 8134 set targetline [lindex $jump_to_here 1]
8a897742
PM
8135 }
8136 set diffline 0
9396cd38
PM
8137}
8138
5de460a2
TR
8139proc blobdiffmaybeseehere {ateof} {
8140 global diffseehere
8141 if {$diffseehere >= 0} {
e244588e 8142 mark_ctext_line [lindex [split $diffseehere .] 0]
5de460a2 8143 }
1f3c8726 8144 maybe_scroll_ctext $ateof
5de460a2
TR
8145}
8146
c8dfbcf9 8147proc getblobdiffline {bdf ids} {
5de460a2
TR
8148 global diffids blobdifffd
8149 global ctext
c8dfbcf9 8150
7eb3cb9c 8151 set nr 0
e5c2d856 8152 $ctext conf -state normal
7eb3cb9c 8153 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
e244588e
DL
8154 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8155 # Older diff read. Abort it.
8156 catch {close $bdf}
8157 if {$ids != $diffids} {
8158 array unset blobdifffd $ids
8159 }
8160 return 0
8161 }
8162 parseblobdiffline $ids $line
5de460a2
TR
8163 }
8164 $ctext conf -state disabled
8165 blobdiffmaybeseehere [eof $bdf]
8166 if {[eof $bdf]} {
e244588e
DL
8167 catch {close $bdf}
8168 array unset blobdifffd $ids
8169 return 0
5de460a2
TR
8170 }
8171 return [expr {$nr >= 1000? 2: 1}]
8172}
8173
8174proc parseblobdiffline {ids line} {
8175 global ctext curdiffstart
8176 global diffnexthead diffnextnote difffilestart
8177 global ctext_file_names ctext_file_lines
8178 global diffinhdr treediffs mergemax diffnparents
8179 global diffencoding jump_to_here targetline diffline currdiffsubmod
8180 global worddiff diffseehere
8181
8182 if {![string compare -length 5 "diff " $line]} {
e244588e
DL
8183 if {![regexp {^diff (--cc|--git) } $line m type]} {
8184 set line [encoding convertfrom $line]
8185 $ctext insert end "$line\n" hunksep
8186 continue
8187 }
8188 # start of a new file
8189 set diffinhdr 1
8190 set currdiffsubmod ""
8191
8192 $ctext insert end "\n"
8193 set curdiffstart [$ctext index "end - 1c"]
8194 lappend ctext_file_names ""
8195 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8196 $ctext insert end "\n" filesep
8197
8198 if {$type eq "--cc"} {
8199 # start of a new file in a merge diff
8200 set fname [string range $line 10 end]
8201 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8202 lappend treediffs($ids) $fname
8203 add_flist [list $fname]
8204 }
8205
8206 } else {
8207 set line [string range $line 11 end]
8208 # If the name hasn't changed the length will be odd,
8209 # the middle char will be a space, and the two bits either
8210 # side will be a/name and b/name, or "a/name" and "b/name".
8211 # If the name has changed we'll get "rename from" and
8212 # "rename to" or "copy from" and "copy to" lines following
8213 # this, and we'll use them to get the filenames.
8214 # This complexity is necessary because spaces in the
8215 # filename(s) don't get escaped.
8216 set l [string length $line]
8217 set i [expr {$l / 2}]
8218 if {!(($l & 1) && [string index $line $i] eq " " &&
8219 [string range $line 2 [expr {$i - 1}]] eq \
8220 [string range $line [expr {$i + 3}] end])} {
8221 return
8222 }
8223 # unescape if quoted and chop off the a/ from the front
8224 if {[string index $line 0] eq "\""} {
8225 set fname [string range [lindex $line 0] 2 end]
8226 } else {
8227 set fname [string range $line 2 [expr {$i - 1}]]
8228 }
8229 }
8230 makediffhdr $fname $ids
5de460a2
TR
8231
8232 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
e244588e
DL
8233 set fname [encoding convertfrom [string range $line 16 end]]
8234 $ctext insert end "\n"
8235 set curdiffstart [$ctext index "end - 1c"]
8236 lappend ctext_file_names $fname
8237 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8238 $ctext insert end "$line\n" filesep
8239 set i [lsearch -exact $treediffs($ids) $fname]
8240 if {$i >= 0} {
8241 setinlist difffilestart $i $curdiffstart
8242 }
5de460a2
TR
8243
8244 } elseif {![string compare -length 2 "@@" $line]} {
e244588e
DL
8245 regexp {^@@+} $line ats
8246 set line [encoding convertfrom $diffencoding $line]
8247 $ctext insert end "$line\n" hunksep
8248 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8249 set diffline $nl
8250 }
8251 set diffnparents [expr {[string length $ats] - 1}]
8252 set diffinhdr 0
9396cd38 8253
5de460a2 8254 } elseif {![string compare -length 10 "Submodule " $line]} {
e244588e
DL
8255 # start of a new submodule
8256 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8257 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8258 } else {
8259 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8260 }
8261 if {$currdiffsubmod != $fname} {
8262 $ctext insert end "\n"; # Add newline after commit message
8263 }
8264 if {$currdiffsubmod != $fname} {
8265 set curdiffstart [$ctext index "end - 1c"]
8266 lappend ctext_file_names ""
8267 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8268 makediffhdr $fname $ids
8269 set currdiffsubmod $fname
8270 $ctext insert end "\n$line\n" filesep
8271 } else {
8272 $ctext insert end "$line\n" filesep
8273 }
9ea831a2 8274 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} {
e244588e
DL
8275 set line [encoding convertfrom $diffencoding $line]
8276 $ctext insert end "$line\n" dresult
9ea831a2 8277 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} {
e244588e
DL
8278 set line [encoding convertfrom $diffencoding $line]
8279 $ctext insert end "$line\n" d0
5de460a2 8280 } elseif {$diffinhdr} {
e244588e
DL
8281 if {![string compare -length 12 "rename from " $line]} {
8282 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8283 if {[string index $fname 0] eq "\""} {
8284 set fname [lindex $fname 0]
8285 }
8286 set fname [encoding convertfrom $fname]
8287 set i [lsearch -exact $treediffs($ids) $fname]
8288 if {$i >= 0} {
8289 setinlist difffilestart $i $curdiffstart
8290 }
8291 } elseif {![string compare -length 10 $line "rename to "] ||
8292 ![string compare -length 8 $line "copy to "]} {
8293 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8294 if {[string index $fname 0] eq "\""} {
8295 set fname [lindex $fname 0]
8296 }
8297 makediffhdr $fname $ids
8298 } elseif {[string compare -length 3 $line "---"] == 0} {
8299 # do nothing
8300 return
8301 } elseif {[string compare -length 3 $line "+++"] == 0} {
8302 set diffinhdr 0
8303 return
8304 }
8305 $ctext insert end "$line\n" filesep
9396cd38 8306
5de460a2 8307 } else {
e244588e
DL
8308 set line [string map {\x1A ^Z} \
8309 [encoding convertfrom $diffencoding $line]]
8310 # parse the prefix - one ' ', '-' or '+' for each parent
8311 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8312 set tag [expr {$diffnparents > 1? "m": "d"}]
8313 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8314 set words_pre_markup ""
8315 set words_post_markup ""
8316 if {[string trim $prefix " -+"] eq {}} {
8317 # prefix only has " ", "-" and "+" in it: normal diff line
8318 set num [string first "-" $prefix]
8319 if {$dowords} {
8320 set line [string range $line 1 end]
8321 }
8322 if {$num >= 0} {
8323 # removed line, first parent with line is $num
8324 if {$num >= $mergemax} {
8325 set num "max"
8326 }
8327 if {$dowords && $worddiff eq [mc "Markup words"]} {
8328 $ctext insert end "\[-$line-\]" $tag$num
8329 } else {
8330 $ctext insert end "$line" $tag$num
8331 }
8332 if {!$dowords} {
8333 $ctext insert end "\n" $tag$num
8334 }
8335 } else {
8336 set tags {}
8337 if {[string first "+" $prefix] >= 0} {
8338 # added line
8339 lappend tags ${tag}result
8340 if {$diffnparents > 1} {
8341 set num [string first " " $prefix]
8342 if {$num >= 0} {
8343 if {$num >= $mergemax} {
8344 set num "max"
8345 }
8346 lappend tags m$num
8347 }
8348 }
8349 set words_pre_markup "{+"
8350 set words_post_markup "+}"
8351 }
8352 if {$targetline ne {}} {
8353 if {$diffline == $targetline} {
8354 set diffseehere [$ctext index "end - 1 chars"]
8355 set targetline {}
8356 } else {
8357 incr diffline
8358 }
8359 }
8360 if {$dowords && $worddiff eq [mc "Markup words"]} {
8361 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8362 } else {
8363 $ctext insert end "$line" $tags
8364 }
8365 if {!$dowords} {
8366 $ctext insert end "\n" $tags
8367 }
8368 }
8369 } elseif {$dowords && $prefix eq "~"} {
8370 $ctext insert end "\n" {}
8371 } else {
8372 # "\ No newline at end of file",
8373 # or something else we don't recognize
8374 $ctext insert end "$line\n" hunksep
8375 }
e5c2d856 8376 }
e5c2d856
PM
8377}
8378
a8d610a2
PM
8379proc changediffdisp {} {
8380 global ctext diffelide
8381
8382 $ctext tag conf d0 -elide [lindex $diffelide 0]
8b07dca1 8383 $ctext tag conf dresult -elide [lindex $diffelide 1]
a8d610a2
PM
8384}
8385
b967135d
SH
8386proc highlightfile {cline} {
8387 global cflist cflist_top
f4c54b3c 8388
ce837c9d
SH
8389 if {![info exists cflist_top]} return
8390
f4c54b3c
PM
8391 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8392 $cflist tag add highlight $cline.0 "$cline.0 lineend"
8393 $cflist see $cline.0
8394 set cflist_top $cline
8395}
8396
b967135d 8397proc highlightfile_for_scrollpos {topidx} {
978904bf 8398 global cmitmode difffilestart
b967135d 8399
978904bf 8400 if {$cmitmode eq "tree"} return
b967135d
SH
8401 if {![info exists difffilestart]} return
8402
8403 set top [lindex [split $topidx .] 0]
8404 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
e244588e 8405 highlightfile 0
b967135d 8406 } else {
e244588e 8407 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
b967135d
SH
8408 }
8409}
8410
67c22874 8411proc prevfile {} {
f4c54b3c
PM
8412 global difffilestart ctext cmitmode
8413
8414 if {$cmitmode eq "tree"} return
8415 set prev 0.0
67c22874
OH
8416 set here [$ctext index @0,0]
8417 foreach loc $difffilestart {
e244588e
DL
8418 if {[$ctext compare $loc >= $here]} {
8419 $ctext yview $prev
8420 return
8421 }
8422 set prev $loc
67c22874 8423 }
b967135d 8424 $ctext yview $prev
67c22874
OH
8425}
8426
39ad8570 8427proc nextfile {} {
f4c54b3c
PM
8428 global difffilestart ctext cmitmode
8429
8430 if {$cmitmode eq "tree"} return
39ad8570 8431 set here [$ctext index @0,0]
7fcceed7 8432 foreach loc $difffilestart {
e244588e
DL
8433 if {[$ctext compare $loc > $here]} {
8434 $ctext yview $loc
8435 return
8436 }
39ad8570 8437 }
1db95b00
PM
8438}
8439
3ea06f9f
PM
8440proc clear_ctext {{first 1.0}} {
8441 global ctext smarktop smarkbot
7cdc3556 8442 global ctext_file_names ctext_file_lines
97645683 8443 global pendinglinks
3ea06f9f 8444
1902c270
PM
8445 set l [lindex [split $first .] 0]
8446 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
e244588e 8447 set smarktop $l
3ea06f9f 8448 }
1902c270 8449 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
e244588e 8450 set smarkbot $l
3ea06f9f
PM
8451 }
8452 $ctext delete $first end
97645683 8453 if {$first eq "1.0"} {
e244588e 8454 unset -nocomplain pendinglinks
97645683 8455 }
7cdc3556
AG
8456 set ctext_file_names {}
8457 set ctext_file_lines {}
3ea06f9f
PM
8458}
8459
32f1b3e4 8460proc settabs {{firstab {}}} {
9c311b32 8461 global firsttabstop tabstop ctext have_tk85
32f1b3e4
PM
8462
8463 if {$firstab ne {} && $have_tk85} {
e244588e 8464 set firsttabstop $firstab
32f1b3e4 8465 }
9c311b32 8466 set w [font measure textfont "0"]
32f1b3e4 8467 if {$firsttabstop != 0} {
e244588e
DL
8468 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8469 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
32f1b3e4 8470 } elseif {$have_tk85 || $tabstop != 8} {
e244588e 8471 $ctext conf -tabs [expr {$tabstop * $w}]
32f1b3e4 8472 } else {
e244588e 8473 $ctext conf -tabs {}
32f1b3e4 8474 }
3ea06f9f
PM
8475}
8476
8477proc incrsearch {name ix op} {
1902c270 8478 global ctext searchstring searchdirn
3ea06f9f 8479
1902c270 8480 if {[catch {$ctext index anchor}]} {
e244588e
DL
8481 # no anchor set, use start of selection, or of visible area
8482 set sel [$ctext tag ranges sel]
8483 if {$sel ne {}} {
8484 $ctext mark set anchor [lindex $sel 0]
8485 } elseif {$searchdirn eq "-forwards"} {
8486 $ctext mark set anchor @0,0
8487 } else {
8488 $ctext mark set anchor @0,[winfo height $ctext]
8489 }
1902c270 8490 }
3ea06f9f 8491 if {$searchstring ne {}} {
e244588e
DL
8492 set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8493 if {$here ne {}} {
8494 $ctext see $here
8495 set mend "$here + $mlen c"
8496 $ctext tag remove sel 1.0 end
8497 $ctext tag add sel $here $mend
8498 suppress_highlighting_file_for_current_scrollpos
8499 highlightfile_for_scrollpos $here
8500 }
3ea06f9f 8501 }
c4614994 8502 rehighlight_search_results
3ea06f9f
PM
8503}
8504
8505proc dosearch {} {
1902c270 8506 global sstring ctext searchstring searchdirn
3ea06f9f
PM
8507
8508 focus $sstring
8509 $sstring icursor end
1902c270
PM
8510 set searchdirn -forwards
8511 if {$searchstring ne {}} {
e244588e
DL
8512 set sel [$ctext tag ranges sel]
8513 if {$sel ne {}} {
8514 set start "[lindex $sel 0] + 1c"
8515 } elseif {[catch {set start [$ctext index anchor]}]} {
8516 set start "@0,0"
8517 }
8518 set match [$ctext search -count mlen -- $searchstring $start]
8519 $ctext tag remove sel 1.0 end
8520 if {$match eq {}} {
8521 bell
8522 return
8523 }
8524 $ctext see $match
8525 suppress_highlighting_file_for_current_scrollpos
8526 highlightfile_for_scrollpos $match
8527 set mend "$match + $mlen c"
8528 $ctext tag add sel $match $mend
8529 $ctext mark unset anchor
8530 rehighlight_search_results
1902c270
PM
8531 }
8532}
8533
8534proc dosearchback {} {
8535 global sstring ctext searchstring searchdirn
8536
8537 focus $sstring
8538 $sstring icursor end
8539 set searchdirn -backwards
8540 if {$searchstring ne {}} {
e244588e
DL
8541 set sel [$ctext tag ranges sel]
8542 if {$sel ne {}} {
8543 set start [lindex $sel 0]
8544 } elseif {[catch {set start [$ctext index anchor]}]} {
8545 set start @0,[winfo height $ctext]
8546 }
8547 set match [$ctext search -backwards -count ml -- $searchstring $start]
8548 $ctext tag remove sel 1.0 end
8549 if {$match eq {}} {
8550 bell
8551 return
8552 }
8553 $ctext see $match
8554 suppress_highlighting_file_for_current_scrollpos
8555 highlightfile_for_scrollpos $match
8556 set mend "$match + $ml c"
8557 $ctext tag add sel $match $mend
8558 $ctext mark unset anchor
8559 rehighlight_search_results
c4614994
SH
8560 }
8561}
8562
8563proc rehighlight_search_results {} {
8564 global ctext searchstring
8565
8566 $ctext tag remove found 1.0 end
8567 $ctext tag remove currentsearchhit 1.0 end
8568
8569 if {$searchstring ne {}} {
e244588e 8570 searchmarkvisible 1
3ea06f9f 8571 }
3ea06f9f
PM
8572}
8573
8574proc searchmark {first last} {
8575 global ctext searchstring
8576
c4614994
SH
8577 set sel [$ctext tag ranges sel]
8578
3ea06f9f
PM
8579 set mend $first.0
8580 while {1} {
e244588e
DL
8581 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8582 if {$match eq {}} break
8583 set mend "$match + $mlen c"
8584 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8585 $ctext tag add currentsearchhit $match $mend
8586 } else {
8587 $ctext tag add found $match $mend
8588 }
3ea06f9f
PM
8589 }
8590}
8591
8592proc searchmarkvisible {doall} {
8593 global ctext smarktop smarkbot
8594
8595 set topline [lindex [split [$ctext index @0,0] .] 0]
8596 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8597 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
e244588e
DL
8598 # no overlap with previous
8599 searchmark $topline $botline
8600 set smarktop $topline
8601 set smarkbot $botline
3ea06f9f 8602 } else {
e244588e
DL
8603 if {$topline < $smarktop} {
8604 searchmark $topline [expr {$smarktop-1}]
8605 set smarktop $topline
8606 }
8607 if {$botline > $smarkbot} {
8608 searchmark [expr {$smarkbot+1}] $botline
8609 set smarkbot $botline
8610 }
3ea06f9f
PM
8611 }
8612}
8613
b967135d
SH
8614proc suppress_highlighting_file_for_current_scrollpos {} {
8615 global ctext suppress_highlighting_file_for_this_scrollpos
8616
8617 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8618}
8619
3ea06f9f 8620proc scrolltext {f0 f1} {
b967135d
SH
8621 global searchstring cmitmode ctext
8622 global suppress_highlighting_file_for_this_scrollpos
8623
978904bf
SH
8624 set topidx [$ctext index @0,0]
8625 if {![info exists suppress_highlighting_file_for_this_scrollpos]
e244588e
DL
8626 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8627 highlightfile_for_scrollpos $topidx
b967135d
SH
8628 }
8629
009409fe 8630 unset -nocomplain suppress_highlighting_file_for_this_scrollpos
3ea06f9f 8631
8809d691 8632 .bleft.bottom.sb set $f0 $f1
3ea06f9f 8633 if {$searchstring ne {}} {
e244588e 8634 searchmarkvisible 0
3ea06f9f
PM
8635 }
8636}
8637
1d10f36d 8638proc setcoords {} {
9c311b32 8639 global linespc charspc canvx0 canvy0
f6075eba 8640 global xspc1 xspc2 lthickness
8d858d1a 8641
9c311b32
PM
8642 set linespc [font metrics mainfont -linespace]
8643 set charspc [font measure mainfont "m"]
9f1afe05
PM
8644 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8645 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
f6075eba 8646 set lthickness [expr {int($linespc / 9) + 1}]
8d858d1a
PM
8647 set xspc1(0) $linespc
8648 set xspc2 $linespc
9a40c50c 8649}
1db95b00 8650
1d10f36d 8651proc redisplay {} {
be0cd098 8652 global canv
9f1afe05
PM
8653 global selectedline
8654
8655 set ymax [lindex [$canv cget -scrollregion] 3]
8656 if {$ymax eq {} || $ymax == 0} return
8657 set span [$canv yview]
8658 clear_display
be0cd098 8659 setcanvscroll
9f1afe05
PM
8660 allcanvs yview moveto [lindex $span 0]
8661 drawvisible
94b4a69f 8662 if {$selectedline ne {}} {
e244588e
DL
8663 selectline $selectedline 0
8664 allcanvs yview moveto [lindex $span 0]
1d10f36d
PM
8665 }
8666}
8667
0ed1dd3c
PM
8668proc parsefont {f n} {
8669 global fontattr
8670
8671 set fontattr($f,family) [lindex $n 0]
8672 set s [lindex $n 1]
8673 if {$s eq {} || $s == 0} {
e244588e 8674 set s 10
0ed1dd3c 8675 } elseif {$s < 0} {
e244588e 8676 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
9c311b32 8677 }
0ed1dd3c
PM
8678 set fontattr($f,size) $s
8679 set fontattr($f,weight) normal
8680 set fontattr($f,slant) roman
8681 foreach style [lrange $n 2 end] {
e244588e
DL
8682 switch -- $style {
8683 "normal" -
8684 "bold" {set fontattr($f,weight) $style}
8685 "roman" -
8686 "italic" {set fontattr($f,slant) $style}
8687 }
9c311b32 8688 }
0ed1dd3c
PM
8689}
8690
8691proc fontflags {f {isbold 0}} {
8692 global fontattr
8693
8694 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
e244588e
DL
8695 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8696 -slant $fontattr($f,slant)]
0ed1dd3c
PM
8697}
8698
8699proc fontname {f} {
8700 global fontattr
8701
8702 set n [list $fontattr($f,family) $fontattr($f,size)]
8703 if {$fontattr($f,weight) eq "bold"} {
e244588e 8704 lappend n "bold"
9c311b32 8705 }
0ed1dd3c 8706 if {$fontattr($f,slant) eq "italic"} {
e244588e 8707 lappend n "italic"
9c311b32 8708 }
0ed1dd3c 8709 return $n
9c311b32
PM
8710}
8711
1d10f36d 8712proc incrfont {inc} {
7fcc92bf 8713 global mainfont textfont ctext canv cflist showrefstop
0ed1dd3c
PM
8714 global stopped entries fontattr
8715
1d10f36d 8716 unmarkmatches
0ed1dd3c 8717 set s $fontattr(mainfont,size)
9c311b32
PM
8718 incr s $inc
8719 if {$s < 1} {
e244588e 8720 set s 1
9c311b32 8721 }
0ed1dd3c 8722 set fontattr(mainfont,size) $s
9c311b32
PM
8723 font config mainfont -size $s
8724 font config mainfontbold -size $s
0ed1dd3c
PM
8725 set mainfont [fontname mainfont]
8726 set s $fontattr(textfont,size)
9c311b32
PM
8727 incr s $inc
8728 if {$s < 1} {
e244588e 8729 set s 1
9c311b32 8730 }
0ed1dd3c 8731 set fontattr(textfont,size) $s
9c311b32
PM
8732 font config textfont -size $s
8733 font config textfontbold -size $s
0ed1dd3c 8734 set textfont [fontname textfont]
1d10f36d 8735 setcoords
32f1b3e4 8736 settabs
1d10f36d
PM
8737 redisplay
8738}
1db95b00 8739
ee3dc72e
PM
8740proc clearsha1 {} {
8741 global sha1entry sha1string
8742 if {[string length $sha1string] == 40} {
e244588e 8743 $sha1entry delete 0 end
ee3dc72e
PM
8744 }
8745}
8746
887fe3c4
PM
8747proc sha1change {n1 n2 op} {
8748 global sha1string currentid sha1but
8749 if {$sha1string == {}
e244588e
DL
8750 || ([info exists currentid] && $sha1string == $currentid)} {
8751 set state disabled
887fe3c4 8752 } else {
e244588e 8753 set state normal
887fe3c4
PM
8754 }
8755 if {[$sha1but cget -state] == $state} return
8756 if {$state == "normal"} {
e244588e 8757 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
887fe3c4 8758 } else {
e244588e 8759 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
887fe3c4
PM
8760 }
8761}
8762
8763proc gotocommit {} {
7fcc92bf 8764 global sha1string tagids headids curview varcid
f3b8b3ce 8765
887fe3c4 8766 if {$sha1string == {}
e244588e 8767 || ([info exists currentid] && $sha1string == $currentid)} return
887fe3c4 8768 if {[info exists tagids($sha1string)]} {
e244588e 8769 set id $tagids($sha1string)
e1007129 8770 } elseif {[info exists headids($sha1string)]} {
e244588e 8771 set id $headids($sha1string)
887fe3c4 8772 } else {
e244588e
DL
8773 set id [string tolower $sha1string]
8774 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8775 set matches [longid $id]
8776 if {$matches ne {}} {
8777 if {[llength $matches] > 1} {
8778 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8779 return
8780 }
8781 set id [lindex $matches 0]
8782 }
8783 } else {
8784 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8785 error_popup [mc "Revision %s is not known" $sha1string]
8786 return
8787 }
8788 }
887fe3c4 8789 }
7fcc92bf 8790 if {[commitinview $id $curview]} {
e244588e
DL
8791 selectline [rowofcommit $id] 1
8792 return
887fe3c4 8793 }
f3b8b3ce 8794 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
e244588e 8795 set msg [mc "SHA1 id %s is not known" $sha1string]
887fe3c4 8796 } else {
e244588e 8797 set msg [mc "Revision %s is not in the current view" $sha1string]
887fe3c4 8798 }
d990cedf 8799 error_popup $msg
887fe3c4
PM
8800}
8801
84ba7345
PM
8802proc lineenter {x y id} {
8803 global hoverx hovery hoverid hovertimer
8804 global commitinfo canv
8805
8ed16484 8806 if {![info exists commitinfo($id)] && ![getcommit $id]} return
84ba7345
PM
8807 set hoverx $x
8808 set hovery $y
8809 set hoverid $id
8810 if {[info exists hovertimer]} {
e244588e 8811 after cancel $hovertimer
84ba7345
PM
8812 }
8813 set hovertimer [after 500 linehover]
8814 $canv delete hover
8815}
8816
8817proc linemotion {x y id} {
8818 global hoverx hovery hoverid hovertimer
8819
8820 if {[info exists hoverid] && $id == $hoverid} {
e244588e
DL
8821 set hoverx $x
8822 set hovery $y
8823 if {[info exists hovertimer]} {
8824 after cancel $hovertimer
8825 }
8826 set hovertimer [after 500 linehover]
84ba7345
PM
8827 }
8828}
8829
8830proc lineleave {id} {
8831 global hoverid hovertimer canv
8832
8833 if {[info exists hoverid] && $id == $hoverid} {
e244588e
DL
8834 $canv delete hover
8835 if {[info exists hovertimer]} {
8836 after cancel $hovertimer
8837 unset hovertimer
8838 }
8839 unset hoverid
84ba7345
PM
8840 }
8841}
8842
8843proc linehover {} {
8844 global hoverx hovery hoverid hovertimer
8845 global canv linespc lthickness
252c52df
8846 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8847
9c311b32 8848 global commitinfo
84ba7345
PM
8849
8850 set text [lindex $commitinfo($hoverid) 0]
8851 set ymax [lindex [$canv cget -scrollregion] 3]
8852 if {$ymax == {}} return
8853 set yfrac [lindex [$canv yview] 0]
8854 set x [expr {$hoverx + 2 * $linespc}]
8855 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8856 set x0 [expr {$x - 2 * $lthickness}]
8857 set y0 [expr {$y - 2 * $lthickness}]
9c311b32 8858 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
84ba7345
PM
8859 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8860 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
e244588e
DL
8861 -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8862 -width 1 -tags hover]
84ba7345 8863 $canv raise $t
f8a2c0d1 8864 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
e244588e 8865 -font mainfont -fill $linehoverfgcolor]
84ba7345
PM
8866 $canv raise $t
8867}
8868
9843c307 8869proc clickisonarrow {id y} {
50b44ece 8870 global lthickness
9843c307 8871
50b44ece 8872 set ranges [rowranges $id]
9843c307 8873 set thresh [expr {2 * $lthickness + 6}]
50b44ece 8874 set n [expr {[llength $ranges] - 1}]
f6342480 8875 for {set i 1} {$i < $n} {incr i} {
e244588e
DL
8876 set row [lindex $ranges $i]
8877 if {abs([yc $row] - $y) < $thresh} {
8878 return $i
8879 }
9843c307
PM
8880 }
8881 return {}
8882}
8883
f6342480 8884proc arrowjump {id n y} {
50b44ece 8885 global canv
9843c307 8886
f6342480
PM
8887 # 1 <-> 2, 3 <-> 4, etc...
8888 set n [expr {(($n - 1) ^ 1) + 1}]
50b44ece 8889 set row [lindex [rowranges $id] $n]
f6342480 8890 set yt [yc $row]
9843c307
PM
8891 set ymax [lindex [$canv cget -scrollregion] 3]
8892 if {$ymax eq {} || $ymax <= 0} return
8893 set view [$canv yview]
8894 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8895 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8896 if {$yfrac < 0} {
e244588e 8897 set yfrac 0
9843c307 8898 }
f6342480 8899 allcanvs yview moveto $yfrac
9843c307
PM
8900}
8901
fa4da7b3 8902proc lineclick {x y id isnew} {
7fcc92bf 8903 global ctext commitinfo children canv thickerline curview
c8dfbcf9 8904
8ed16484 8905 if {![info exists commitinfo($id)] && ![getcommit $id]} return
c8dfbcf9 8906 unmarkmatches
fa4da7b3 8907 unselectline
9843c307
PM
8908 normalline
8909 $canv delete hover
8910 # draw this line thicker than normal
9843c307 8911 set thickerline $id
c934a8a3 8912 drawlines $id
fa4da7b3 8913 if {$isnew} {
e244588e
DL
8914 set ymax [lindex [$canv cget -scrollregion] 3]
8915 if {$ymax eq {}} return
8916 set yfrac [lindex [$canv yview] 0]
8917 set y [expr {$y + $yfrac * $ymax}]
9843c307
PM
8918 }
8919 set dirn [clickisonarrow $id $y]
8920 if {$dirn ne {}} {
e244588e
DL
8921 arrowjump $id $dirn $y
8922 return
9843c307
PM
8923 }
8924
8925 if {$isnew} {
e244588e 8926 addtohistory [list lineclick $x $y $id 0] savectextpos
fa4da7b3 8927 }
c8dfbcf9
PM
8928 # fill the details pane with info about this line
8929 $ctext conf -state normal
3ea06f9f 8930 clear_ctext
32f1b3e4 8931 settabs 0
d990cedf 8932 $ctext insert end "[mc "Parent"]:\t"
97645683
PM
8933 $ctext insert end $id link0
8934 setlink $id link0
c8dfbcf9 8935 set info $commitinfo($id)
fa4da7b3 8936 $ctext insert end "\n\t[lindex $info 0]\n"
d990cedf 8937 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
232475d3 8938 set date [formatdate [lindex $info 2]]
d990cedf 8939 $ctext insert end "\t[mc "Date"]:\t$date\n"
da7c24dd 8940 set kids $children($curview,$id)
79b2c75e 8941 if {$kids ne {}} {
e244588e
DL
8942 $ctext insert end "\n[mc "Children"]:"
8943 set i 0
8944 foreach child $kids {
8945 incr i
8946 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8947 set info $commitinfo($child)
8948 $ctext insert end "\n\t"
8949 $ctext insert end $child link$i
8950 setlink $child link$i
8951 $ctext insert end "\n\t[lindex $info 0]"
8952 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8953 set date [formatdate [lindex $info 2]]
8954 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8955 }
c8dfbcf9 8956 }
354af6bd 8957 maybe_scroll_ctext 1
c8dfbcf9 8958 $ctext conf -state disabled
7fcceed7 8959 init_flist {}
c8dfbcf9
PM
8960}
8961
9843c307
PM
8962proc normalline {} {
8963 global thickerline
8964 if {[info exists thickerline]} {
e244588e
DL
8965 set id $thickerline
8966 unset thickerline
8967 drawlines $id
9843c307
PM
8968 }
8969}
8970
354af6bd 8971proc selbyid {id {isnew 1}} {
7fcc92bf
PM
8972 global curview
8973 if {[commitinview $id $curview]} {
e244588e 8974 selectline [rowofcommit $id] $isnew
c8dfbcf9
PM
8975 }
8976}
8977
8978proc mstime {} {
8979 global startmstime
8980 if {![info exists startmstime]} {
e244588e 8981 set startmstime [clock clicks -milliseconds]
c8dfbcf9
PM
8982 }
8983 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8984}
8985
8986proc rowmenu {x y id} {
7fcc92bf 8987 global rowctxmenu selectedline rowmenuid curview
b9fdba7f 8988 global nullid nullid2 fakerowmenu mainhead markedid
c8dfbcf9 8989
bb3edc8b 8990 stopfinding
219ea3a9 8991 set rowmenuid $id
94b4a69f 8992 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
e244588e 8993 set state disabled
c8dfbcf9 8994 } else {
e244588e 8995 set state normal
c8dfbcf9 8996 }
6febdede 8997 if {[info exists markedid] && $markedid ne $id} {
e244588e 8998 set mstate normal
6febdede 8999 } else {
e244588e 9000 set mstate disabled
6febdede 9001 }
8f489363 9002 if {$id ne $nullid && $id ne $nullid2} {
e244588e
DL
9003 set menu $rowctxmenu
9004 if {$mainhead ne {}} {
9005 $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
9006 } else {
9007 $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
9008 }
9009 $menu entryconfigure 10 -state $mstate
9010 $menu entryconfigure 11 -state $mstate
9011 $menu entryconfigure 12 -state $mstate
219ea3a9 9012 } else {
e244588e 9013 set menu $fakerowmenu
219ea3a9 9014 }
f2d0bbbd
PM
9015 $menu entryconfigure [mca "Diff this -> selected"] -state $state
9016 $menu entryconfigure [mca "Diff selected -> this"] -state $state
9017 $menu entryconfigure [mca "Make patch"] -state $state
6febdede
PM
9018 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
9019 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
219ea3a9 9020 tk_popup $menu $x $y
c8dfbcf9
PM
9021}
9022
b9fdba7f
PM
9023proc markhere {} {
9024 global rowmenuid markedid canv
9025
9026 set markedid $rowmenuid
9027 make_idmark $markedid
9028}
9029
9030proc gotomark {} {
9031 global markedid
9032
9033 if {[info exists markedid]} {
e244588e 9034 selbyid $markedid
b9fdba7f
PM
9035 }
9036}
9037
9038proc replace_by_kids {l r} {
9039 global curview children
9040
9041 set id [commitonrow $r]
9042 set l [lreplace $l 0 0]
9043 foreach kid $children($curview,$id) {
e244588e 9044 lappend l [rowofcommit $kid]
b9fdba7f
PM
9045 }
9046 return [lsort -integer -decreasing -unique $l]
9047}
9048
9049proc find_common_desc {} {
9050 global markedid rowmenuid curview children
9051
9052 if {![info exists markedid]} return
9053 if {![commitinview $markedid $curview] ||
e244588e 9054 ![commitinview $rowmenuid $curview]} return
b9fdba7f
PM
9055 #set t1 [clock clicks -milliseconds]
9056 set l1 [list [rowofcommit $markedid]]
9057 set l2 [list [rowofcommit $rowmenuid]]
9058 while 1 {
e244588e
DL
9059 set r1 [lindex $l1 0]
9060 set r2 [lindex $l2 0]
9061 if {$r1 eq {} || $r2 eq {}} break
9062 if {$r1 == $r2} {
9063 selectline $r1 1
9064 break
9065 }
9066 if {$r1 > $r2} {
9067 set l1 [replace_by_kids $l1 $r1]
9068 } else {
9069 set l2 [replace_by_kids $l2 $r2]
9070 }
b9fdba7f
PM
9071 }
9072 #set t2 [clock clicks -milliseconds]
9073 #puts "took [expr {$t2-$t1}]ms"
9074}
9075
010509f2
PM
9076proc compare_commits {} {
9077 global markedid rowmenuid curview children
9078
9079 if {![info exists markedid]} return
9080 if {![commitinview $markedid $curview]} return
9081 addtohistory [list do_cmp_commits $markedid $rowmenuid]
9082 do_cmp_commits $markedid $rowmenuid
9083}
9084
9085proc getpatchid {id} {
9086 global patchids
9087
9088 if {![info exists patchids($id)]} {
e244588e
DL
9089 set cmd [diffcmd [list $id] {-p --root}]
9090 # trim off the initial "|"
9091 set cmd [lrange $cmd 1 end]
9092 if {[catch {
9093 set x [eval exec $cmd | git patch-id]
9094 set patchids($id) [lindex $x 0]
9095 }]} {
9096 set patchids($id) "error"
9097 }
010509f2
PM
9098 }
9099 return $patchids($id)
9100}
9101
9102proc do_cmp_commits {a b} {
9103 global ctext curview parents children patchids commitinfo
9104
9105 $ctext conf -state normal
9106 clear_ctext
9107 init_flist {}
9108 for {set i 0} {$i < 100} {incr i} {
e244588e
DL
9109 set skipa 0
9110 set skipb 0
9111 if {[llength $parents($curview,$a)] > 1} {
9112 appendshortlink $a [mc "Skipping merge commit "] "\n"
9113 set skipa 1
9114 } else {
9115 set patcha [getpatchid $a]
9116 }
9117 if {[llength $parents($curview,$b)] > 1} {
9118 appendshortlink $b [mc "Skipping merge commit "] "\n"
9119 set skipb 1
9120 } else {
9121 set patchb [getpatchid $b]
9122 }
9123 if {!$skipa && !$skipb} {
9124 set heada [lindex $commitinfo($a) 0]
9125 set headb [lindex $commitinfo($b) 0]
9126 if {$patcha eq "error"} {
9127 appendshortlink $a [mc "Error getting patch ID for "] \
9128 [mc " - stopping\n"]
9129 break
9130 }
9131 if {$patchb eq "error"} {
9132 appendshortlink $b [mc "Error getting patch ID for "] \
9133 [mc " - stopping\n"]
9134 break
9135 }
9136 if {$patcha eq $patchb} {
9137 if {$heada eq $headb} {
9138 appendshortlink $a [mc "Commit "]
9139 appendshortlink $b " == " " $heada\n"
9140 } else {
9141 appendshortlink $a [mc "Commit "] " $heada\n"
9142 appendshortlink $b [mc " is the same patch as\n "] \
9143 " $headb\n"
9144 }
9145 set skipa 1
9146 set skipb 1
9147 } else {
9148 $ctext insert end "\n"
9149 appendshortlink $a [mc "Commit "] " $heada\n"
9150 appendshortlink $b [mc " differs from\n "] \
9151 " $headb\n"
9152 $ctext insert end [mc "Diff of commits:\n\n"]
9153 $ctext conf -state disabled
9154 update
9155 diffcommits $a $b
9156 return
9157 }
9158 }
9159 if {$skipa} {
9160 set kids [real_children $curview,$a]
9161 if {[llength $kids] != 1} {
9162 $ctext insert end "\n"
9163 appendshortlink $a [mc "Commit "] \
9164 [mc " has %s children - stopping\n" [llength $kids]]
9165 break
9166 }
9167 set a [lindex $kids 0]
9168 }
9169 if {$skipb} {
9170 set kids [real_children $curview,$b]
9171 if {[llength $kids] != 1} {
9172 appendshortlink $b [mc "Commit "] \
9173 [mc " has %s children - stopping\n" [llength $kids]]
9174 break
9175 }
9176 set b [lindex $kids 0]
9177 }
010509f2
PM
9178 }
9179 $ctext conf -state disabled
9180}
9181
c21398be 9182proc diffcommits {a b} {
a1d383c5 9183 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
c21398be
PM
9184
9185 set tmpdir [gitknewtmpdir]
9186 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9187 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9188 if {[catch {
e244588e
DL
9189 exec git diff-tree -p --pretty $a >$fna
9190 exec git diff-tree -p --pretty $b >$fnb
c21398be 9191 } err]} {
e244588e
DL
9192 error_popup [mc "Error writing commit to file: %s" $err]
9193 return
c21398be
PM
9194 }
9195 if {[catch {
e244588e 9196 set fd [open "| diff -U$diffcontext $fna $fnb" r]
c21398be 9197 } err]} {
e244588e
DL
9198 error_popup [mc "Error diffing commits: %s" $err]
9199 return
c21398be
PM
9200 }
9201 set diffids [list commits $a $b]
9202 set blobdifffd($diffids) $fd
9203 set diffinhdr 0
a1d383c5 9204 set currdiffsubmod ""
c21398be
PM
9205 filerun $fd [list getblobdiffline $fd $diffids]
9206}
9207
c8dfbcf9 9208proc diffvssel {dirn} {
7fcc92bf 9209 global rowmenuid selectedline
c8dfbcf9 9210
94b4a69f 9211 if {$selectedline eq {}} return
c8dfbcf9 9212 if {$dirn} {
e244588e
DL
9213 set oldid [commitonrow $selectedline]
9214 set newid $rowmenuid
c8dfbcf9 9215 } else {
e244588e
DL
9216 set oldid $rowmenuid
9217 set newid [commitonrow $selectedline]
c8dfbcf9 9218 }
354af6bd 9219 addtohistory [list doseldiff $oldid $newid] savectextpos
fa4da7b3
PM
9220 doseldiff $oldid $newid
9221}
9222
6febdede
PM
9223proc diffvsmark {dirn} {
9224 global rowmenuid markedid
9225
9226 if {![info exists markedid]} return
9227 if {$dirn} {
e244588e
DL
9228 set oldid $markedid
9229 set newid $rowmenuid
6febdede 9230 } else {
e244588e
DL
9231 set oldid $rowmenuid
9232 set newid $markedid
6febdede
PM
9233 }
9234 addtohistory [list doseldiff $oldid $newid] savectextpos
9235 doseldiff $oldid $newid
9236}
9237
fa4da7b3 9238proc doseldiff {oldid newid} {
7fcceed7 9239 global ctext
fa4da7b3
PM
9240 global commitinfo
9241
c8dfbcf9 9242 $ctext conf -state normal
3ea06f9f 9243 clear_ctext
d990cedf
CS
9244 init_flist [mc "Top"]
9245 $ctext insert end "[mc "From"] "
97645683
PM
9246 $ctext insert end $oldid link0
9247 setlink $oldid link0
fa4da7b3 9248 $ctext insert end "\n "
c8dfbcf9 9249 $ctext insert end [lindex $commitinfo($oldid) 0]
d990cedf 9250 $ctext insert end "\n\n[mc "To"] "
97645683
PM
9251 $ctext insert end $newid link1
9252 setlink $newid link1
fa4da7b3 9253 $ctext insert end "\n "
c8dfbcf9
PM
9254 $ctext insert end [lindex $commitinfo($newid) 0]
9255 $ctext insert end "\n"
9256 $ctext conf -state disabled
c8dfbcf9 9257 $ctext tag remove found 1.0 end
d327244a 9258 startdiff [list $oldid $newid]
c8dfbcf9
PM
9259}
9260
74daedb6 9261proc mkpatch {} {
d93f1713 9262 global rowmenuid currentid commitinfo patchtop patchnum NS
74daedb6
PM
9263
9264 if {![info exists currentid]} return
9265 set oldid $currentid
9266 set oldhead [lindex $commitinfo($oldid) 0]
9267 set newid $rowmenuid
9268 set newhead [lindex $commitinfo($newid) 0]
9269 set top .patch
9270 set patchtop $top
9271 catch {destroy $top}
d93f1713 9272 ttk_toplevel $top
e7d64008 9273 make_transient $top .
d93f1713 9274 ${NS}::label $top.title -text [mc "Generate patch"]
4a2139f5 9275 grid $top.title - -pady 10
d93f1713
PT
9276 ${NS}::label $top.from -text [mc "From:"]
9277 ${NS}::entry $top.fromsha1 -width 40
74daedb6
PM
9278 $top.fromsha1 insert 0 $oldid
9279 $top.fromsha1 conf -state readonly
9280 grid $top.from $top.fromsha1 -sticky w
d93f1713 9281 ${NS}::entry $top.fromhead -width 60
74daedb6
PM
9282 $top.fromhead insert 0 $oldhead
9283 $top.fromhead conf -state readonly
9284 grid x $top.fromhead -sticky w
d93f1713
PT
9285 ${NS}::label $top.to -text [mc "To:"]
9286 ${NS}::entry $top.tosha1 -width 40
74daedb6
PM
9287 $top.tosha1 insert 0 $newid
9288 $top.tosha1 conf -state readonly
9289 grid $top.to $top.tosha1 -sticky w
d93f1713 9290 ${NS}::entry $top.tohead -width 60
74daedb6
PM
9291 $top.tohead insert 0 $newhead
9292 $top.tohead conf -state readonly
9293 grid x $top.tohead -sticky w
d93f1713
PT
9294 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9295 grid $top.rev x -pady 10 -padx 5
9296 ${NS}::label $top.flab -text [mc "Output file:"]
9297 ${NS}::entry $top.fname -width 60
74daedb6
PM
9298 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9299 incr patchnum
bdbfbe3d 9300 grid $top.flab $top.fname -sticky w
d93f1713
PT
9301 ${NS}::frame $top.buts
9302 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9303 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
76f15947
AG
9304 bind $top <Key-Return> mkpatchgo
9305 bind $top <Key-Escape> mkpatchcan
74daedb6
PM
9306 grid $top.buts.gen $top.buts.can
9307 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9308 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9309 grid $top.buts - -pady 10 -sticky ew
bdbfbe3d 9310 focus $top.fname
74daedb6
PM
9311}
9312
9313proc mkpatchrev {} {
9314 global patchtop
9315
9316 set oldid [$patchtop.fromsha1 get]
9317 set oldhead [$patchtop.fromhead get]
9318 set newid [$patchtop.tosha1 get]
9319 set newhead [$patchtop.tohead get]
9320 foreach e [list fromsha1 fromhead tosha1 tohead] \
e244588e
DL
9321 v [list $newid $newhead $oldid $oldhead] {
9322 $patchtop.$e conf -state normal
9323 $patchtop.$e delete 0 end
9324 $patchtop.$e insert 0 $v
9325 $patchtop.$e conf -state readonly
74daedb6
PM
9326 }
9327}
9328
9329proc mkpatchgo {} {
8f489363 9330 global patchtop nullid nullid2
74daedb6
PM
9331
9332 set oldid [$patchtop.fromsha1 get]
9333 set newid [$patchtop.tosha1 get]
9334 set fname [$patchtop.fname get]
8f489363 9335 set cmd [diffcmd [list $oldid $newid] -p]
d372e216
PM
9336 # trim off the initial "|"
9337 set cmd [lrange $cmd 1 end]
219ea3a9
PM
9338 lappend cmd >$fname &
9339 if {[catch {eval exec $cmd} err]} {
e244588e 9340 error_popup "[mc "Error creating patch:"] $err" $patchtop
74daedb6
PM
9341 }
9342 catch {destroy $patchtop}
9343 unset patchtop
9344}
9345
9346proc mkpatchcan {} {
9347 global patchtop
9348
9349 catch {destroy $patchtop}
9350 unset patchtop
9351}
9352
bdbfbe3d 9353proc mktag {} {
d93f1713 9354 global rowmenuid mktagtop commitinfo NS
bdbfbe3d
PM
9355
9356 set top .maketag
9357 set mktagtop $top
9358 catch {destroy $top}
d93f1713 9359 ttk_toplevel $top
e7d64008 9360 make_transient $top .
d93f1713 9361 ${NS}::label $top.title -text [mc "Create tag"]
4a2139f5 9362 grid $top.title - -pady 10
d93f1713
PT
9363 ${NS}::label $top.id -text [mc "ID:"]
9364 ${NS}::entry $top.sha1 -width 40
bdbfbe3d
PM
9365 $top.sha1 insert 0 $rowmenuid
9366 $top.sha1 conf -state readonly
9367 grid $top.id $top.sha1 -sticky w
d93f1713 9368 ${NS}::entry $top.head -width 60
bdbfbe3d
PM
9369 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9370 $top.head conf -state readonly
9371 grid x $top.head -sticky w
d93f1713
PT
9372 ${NS}::label $top.tlab -text [mc "Tag name:"]
9373 ${NS}::entry $top.tag -width 60
bdbfbe3d 9374 grid $top.tlab $top.tag -sticky w
dfb891e3
DD
9375 ${NS}::label $top.op -text [mc "Tag message is optional"]
9376 grid $top.op -columnspan 2 -sticky we
9377 ${NS}::label $top.mlab -text [mc "Tag message:"]
9378 ${NS}::entry $top.msg -width 60
9379 grid $top.mlab $top.msg -sticky w
d93f1713
PT
9380 ${NS}::frame $top.buts
9381 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9382 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
76f15947
AG
9383 bind $top <Key-Return> mktaggo
9384 bind $top <Key-Escape> mktagcan
bdbfbe3d
PM
9385 grid $top.buts.gen $top.buts.can
9386 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9387 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9388 grid $top.buts - -pady 10 -sticky ew
9389 focus $top.tag
9390}
9391
9392proc domktag {} {
9393 global mktagtop env tagids idtags
bdbfbe3d
PM
9394
9395 set id [$mktagtop.sha1 get]
9396 set tag [$mktagtop.tag get]
dfb891e3 9397 set msg [$mktagtop.msg get]
bdbfbe3d 9398 if {$tag == {}} {
e244588e
DL
9399 error_popup [mc "No tag name specified"] $mktagtop
9400 return 0
bdbfbe3d
PM
9401 }
9402 if {[info exists tagids($tag)]} {
e244588e
DL
9403 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9404 return 0
bdbfbe3d
PM
9405 }
9406 if {[catch {
e244588e
DL
9407 if {$msg != {}} {
9408 exec git tag -a -m $msg $tag $id
9409 } else {
9410 exec git tag $tag $id
9411 }
bdbfbe3d 9412 } err]} {
e244588e
DL
9413 error_popup "[mc "Error creating tag:"] $err" $mktagtop
9414 return 0
bdbfbe3d
PM
9415 }
9416
9417 set tagids($tag) $id
9418 lappend idtags($id) $tag
f1d83ba3 9419 redrawtags $id
ceadfe90 9420 addedtag $id
887c996e
PM
9421 dispneartags 0
9422 run refill_reflist
84a76f18 9423 return 1
f1d83ba3
PM
9424}
9425
9426proc redrawtags {id} {
b9fdba7f 9427 global canv linehtag idpos currentid curview cmitlisted markedid
c11ff120 9428 global canvxmax iddrawn circleitem mainheadid circlecolors
252c52df 9429 global mainheadcirclecolor
f1d83ba3 9430
7fcc92bf 9431 if {![commitinview $id $curview]} return
322a8cc9 9432 if {![info exists iddrawn($id)]} return
fc2a256f 9433 set row [rowofcommit $id]
c11ff120 9434 if {$id eq $mainheadid} {
e244588e 9435 set ofill $mainheadcirclecolor
c11ff120 9436 } else {
e244588e 9437 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
c11ff120
PM
9438 }
9439 $canv itemconf $circleitem($row) -fill $ofill
bdbfbe3d
PM
9440 $canv delete tag.$id
9441 set xt [eval drawtags $id $idpos($id)]
28593d3f
PM
9442 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9443 set text [$canv itemcget $linehtag($id) -text]
9444 set font [$canv itemcget $linehtag($id) -font]
fc2a256f 9445 set xr [expr {$xt + [font measure $font $text]}]
b8ab2e17 9446 if {$xr > $canvxmax} {
e244588e
DL
9447 set canvxmax $xr
9448 setcanvscroll
b8ab2e17 9449 }
fc2a256f 9450 if {[info exists currentid] && $currentid == $id} {
e244588e 9451 make_secsel $id
bdbfbe3d 9452 }
b9fdba7f 9453 if {[info exists markedid] && $markedid eq $id} {
e244588e 9454 make_idmark $id
b9fdba7f 9455 }
bdbfbe3d
PM
9456}
9457
9458proc mktagcan {} {
9459 global mktagtop
9460
9461 catch {destroy $mktagtop}
9462 unset mktagtop
9463}
9464
9465proc mktaggo {} {
84a76f18 9466 if {![domktag]} return
bdbfbe3d
PM
9467 mktagcan
9468}
9469
b8b60957 9470proc copyreference {} {
d835dbb9
BB
9471 global rowmenuid autosellen
9472
9473 set format "%h (\"%s\", %ad)"
9474 set cmd [list git show -s --pretty=format:$format --date=short]
9475 if {$autosellen < 40} {
9476 lappend cmd --abbrev=$autosellen
9477 }
b8b60957 9478 set reference [eval exec $cmd $rowmenuid]
d835dbb9
BB
9479
9480 clipboard clear
b8b60957 9481 clipboard append $reference
d835dbb9
BB
9482}
9483
4a2139f5 9484proc writecommit {} {
d93f1713 9485 global rowmenuid wrcomtop commitinfo wrcomcmd NS
4a2139f5
PM
9486
9487 set top .writecommit
9488 set wrcomtop $top
9489 catch {destroy $top}
d93f1713 9490 ttk_toplevel $top
e7d64008 9491 make_transient $top .
d93f1713 9492 ${NS}::label $top.title -text [mc "Write commit to file"]
4a2139f5 9493 grid $top.title - -pady 10
d93f1713
PT
9494 ${NS}::label $top.id -text [mc "ID:"]
9495 ${NS}::entry $top.sha1 -width 40
4a2139f5
PM
9496 $top.sha1 insert 0 $rowmenuid
9497 $top.sha1 conf -state readonly
9498 grid $top.id $top.sha1 -sticky w
d93f1713 9499 ${NS}::entry $top.head -width 60
4a2139f5
PM
9500 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9501 $top.head conf -state readonly
9502 grid x $top.head -sticky w
d93f1713
PT
9503 ${NS}::label $top.clab -text [mc "Command:"]
9504 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
4a2139f5 9505 grid $top.clab $top.cmd -sticky w -pady 10
d93f1713
PT
9506 ${NS}::label $top.flab -text [mc "Output file:"]
9507 ${NS}::entry $top.fname -width 60
4a2139f5
PM
9508 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9509 grid $top.flab $top.fname -sticky w
d93f1713
PT
9510 ${NS}::frame $top.buts
9511 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9512 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
76f15947
AG
9513 bind $top <Key-Return> wrcomgo
9514 bind $top <Key-Escape> wrcomcan
4a2139f5
PM
9515 grid $top.buts.gen $top.buts.can
9516 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9517 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9518 grid $top.buts - -pady 10 -sticky ew
9519 focus $top.fname
9520}
9521
9522proc wrcomgo {} {
9523 global wrcomtop
9524
9525 set id [$wrcomtop.sha1 get]
9526 set cmd "echo $id | [$wrcomtop.cmd get]"
9527 set fname [$wrcomtop.fname get]
9528 if {[catch {exec sh -c $cmd >$fname &} err]} {
e244588e 9529 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
4a2139f5
PM
9530 }
9531 catch {destroy $wrcomtop}
9532 unset wrcomtop
9533}
9534
9535proc wrcomcan {} {
9536 global wrcomtop
9537
9538 catch {destroy $wrcomtop}
9539 unset wrcomtop
9540}
9541
d6ac1a86 9542proc mkbranch {} {
5a046c52
RG
9543 global NS rowmenuid
9544
9545 set top .branchdialog
9546
9547 set val(name) ""
9548 set val(id) $rowmenuid
9549 set val(command) [list mkbrgo $top]
9550
9551 set ui(title) [mc "Create branch"]
9552 set ui(accept) [mc "Create"]
9553
9554 branchdia $top val ui
9555}
9556
9557proc mvbranch {} {
9558 global NS
9559 global headmenuid headmenuhead
9560
9561 set top .branchdialog
9562
9563 set val(name) $headmenuhead
9564 set val(id) $headmenuid
9565 set val(command) [list mvbrgo $top $headmenuhead]
9566
9567 set ui(title) [mc "Rename branch %s" $headmenuhead]
9568 set ui(accept) [mc "Rename"]
9569
9570 branchdia $top val ui
9571}
9572
9573proc branchdia {top valvar uivar} {
7f00f4c0 9574 global NS commitinfo
5a046c52 9575 upvar $valvar val $uivar ui
d6ac1a86 9576
d6ac1a86 9577 catch {destroy $top}
d93f1713 9578 ttk_toplevel $top
e7d64008 9579 make_transient $top .
5a046c52 9580 ${NS}::label $top.title -text $ui(title)
d6ac1a86 9581 grid $top.title - -pady 10
d93f1713
PT
9582 ${NS}::label $top.id -text [mc "ID:"]
9583 ${NS}::entry $top.sha1 -width 40
5a046c52 9584 $top.sha1 insert 0 $val(id)
d6ac1a86
PM
9585 $top.sha1 conf -state readonly
9586 grid $top.id $top.sha1 -sticky w
7f00f4c0
RG
9587 ${NS}::entry $top.head -width 60
9588 $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9589 $top.head conf -state readonly
9590 grid x $top.head -sticky ew
9591 grid columnconfigure $top 1 -weight 1
d93f1713
PT
9592 ${NS}::label $top.nlab -text [mc "Name:"]
9593 ${NS}::entry $top.name -width 40
5a046c52 9594 $top.name insert 0 $val(name)
d6ac1a86 9595 grid $top.nlab $top.name -sticky w
d93f1713 9596 ${NS}::frame $top.buts
5a046c52 9597 ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
d93f1713 9598 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
5a046c52 9599 bind $top <Key-Return> $val(command)
76f15947 9600 bind $top <Key-Escape> "catch {destroy $top}"
d6ac1a86
PM
9601 grid $top.buts.go $top.buts.can
9602 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9603 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9604 grid $top.buts - -pady 10 -sticky ew
9605 focus $top.name
9606}
9607
9608proc mkbrgo {top} {
9609 global headids idheads
9610
9611 set name [$top.name get]
9612 set id [$top.sha1 get]
bee866fa
AG
9613 set cmdargs {}
9614 set old_id {}
d6ac1a86 9615 if {$name eq {}} {
e244588e
DL
9616 error_popup [mc "Please specify a name for the new branch"] $top
9617 return
d6ac1a86 9618 }
bee866fa 9619 if {[info exists headids($name)]} {
e244588e
DL
9620 if {![confirm_popup [mc \
9621 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9622 return
9623 }
9624 set old_id $headids($name)
9625 lappend cmdargs -f
bee866fa 9626 }
d6ac1a86 9627 catch {destroy $top}
bee866fa 9628 lappend cmdargs $name $id
d6ac1a86
PM
9629 nowbusy newbranch
9630 update
9631 if {[catch {
e244588e 9632 eval exec git branch $cmdargs
d6ac1a86 9633 } err]} {
e244588e
DL
9634 notbusy newbranch
9635 error_popup $err
d6ac1a86 9636 } else {
e244588e
DL
9637 notbusy newbranch
9638 if {$old_id ne {}} {
9639 movehead $id $name
9640 movedhead $id $name
9641 redrawtags $old_id
9642 redrawtags $id
9643 } else {
9644 set headids($name) $id
9645 lappend idheads($id) $name
9646 addedhead $id $name
9647 redrawtags $id
9648 }
9649 dispneartags 0
9650 run refill_reflist
d6ac1a86
PM
9651 }
9652}
9653
5a046c52
RG
9654proc mvbrgo {top prevname} {
9655 global headids idheads mainhead mainheadid
9656
9657 set name [$top.name get]
9658 set id [$top.sha1 get]
9659 set cmdargs {}
9660 if {$name eq $prevname} {
e244588e
DL
9661 catch {destroy $top}
9662 return
5a046c52
RG
9663 }
9664 if {$name eq {}} {
e244588e
DL
9665 error_popup [mc "Please specify a new name for the branch"] $top
9666 return
5a046c52
RG
9667 }
9668 catch {destroy $top}
9669 lappend cmdargs -m $prevname $name
9670 nowbusy renamebranch
9671 update
9672 if {[catch {
e244588e 9673 eval exec git branch $cmdargs
5a046c52 9674 } err]} {
e244588e
DL
9675 notbusy renamebranch
9676 error_popup $err
5a046c52 9677 } else {
e244588e
DL
9678 notbusy renamebranch
9679 removehead $id $prevname
9680 removedhead $id $prevname
9681 set headids($name) $id
9682 lappend idheads($id) $name
9683 addedhead $id $name
9684 if {$prevname eq $mainhead} {
9685 set mainhead $name
9686 set mainheadid $id
9687 }
9688 redrawtags $id
9689 dispneartags 0
9690 run refill_reflist
5a046c52
RG
9691 }
9692}
9693
15e35055
AG
9694proc exec_citool {tool_args {baseid {}}} {
9695 global commitinfo env
9696
9697 set save_env [array get env GIT_AUTHOR_*]
9698
9699 if {$baseid ne {}} {
e244588e
DL
9700 if {![info exists commitinfo($baseid)]} {
9701 getcommit $baseid
9702 }
9703 set author [lindex $commitinfo($baseid) 1]
9704 set date [lindex $commitinfo($baseid) 2]
9705 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9706 $author author name email]
9707 && $date ne {}} {
9708 set env(GIT_AUTHOR_NAME) $name
9709 set env(GIT_AUTHOR_EMAIL) $email
9710 set env(GIT_AUTHOR_DATE) $date
9711 }
15e35055
AG
9712 }
9713
9714 eval exec git citool $tool_args &
9715
9716 array unset env GIT_AUTHOR_*
9717 array set env $save_env
9718}
9719
ca6d8f58 9720proc cherrypick {} {
468bcaed 9721 global rowmenuid curview
b8a938cf 9722 global mainhead mainheadid
da616db5 9723 global gitdir
ca6d8f58 9724
e11f1233
PM
9725 set oldhead [exec git rev-parse HEAD]
9726 set dheads [descheads $rowmenuid]
9727 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
e244588e
DL
9728 set ok [confirm_popup [mc "Commit %s is already\
9729 included in branch %s -- really re-apply it?" \
9730 [string range $rowmenuid 0 7] $mainhead]]
9731 if {!$ok} return
ca6d8f58 9732 }
d990cedf 9733 nowbusy cherrypick [mc "Cherry-picking"]
ca6d8f58 9734 update
ca6d8f58
PM
9735 # Unfortunately git-cherry-pick writes stuff to stderr even when
9736 # no error occurs, and exec takes that as an indication of error...
9737 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
e244588e
DL
9738 notbusy cherrypick
9739 if {[regexp -line \
9740 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9741 $err msg fname]} {
9742 error_popup [mc "Cherry-pick failed because of local changes\
9743 to file '%s'.\nPlease commit, reset or stash\
9744 your changes and try again." $fname]
9745 } elseif {[regexp -line \
9746 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9747 $err]} {
9748 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9749 conflict.\nDo you wish to run git citool to\
9750 resolve it?"]]} {
9751 # Force citool to read MERGE_MSG
9752 file delete [file join $gitdir "GITGUI_MSG"]
9753 exec_citool {} $rowmenuid
9754 }
9755 } else {
9756 error_popup $err
9757 }
9758 run updatecommits
9759 return
ca6d8f58
PM
9760 }
9761 set newhead [exec git rev-parse HEAD]
9762 if {$newhead eq $oldhead} {
e244588e
DL
9763 notbusy cherrypick
9764 error_popup [mc "No changes committed"]
9765 return
ca6d8f58 9766 }
e11f1233 9767 addnewchild $newhead $oldhead
7fcc92bf 9768 if {[commitinview $oldhead $curview]} {
e244588e
DL
9769 # XXX this isn't right if we have a path limit...
9770 insertrow $newhead $oldhead $curview
9771 if {$mainhead ne {}} {
9772 movehead $newhead $mainhead
9773 movedhead $newhead $mainhead
9774 }
9775 set mainheadid $newhead
9776 redrawtags $oldhead
9777 redrawtags $newhead
9778 selbyid $newhead
ca6d8f58
PM
9779 }
9780 notbusy cherrypick
9781}
9782
8f3ff933
KF
9783proc revert {} {
9784 global rowmenuid curview
9785 global mainhead mainheadid
9786 global gitdir
9787
9788 set oldhead [exec git rev-parse HEAD]
9789 set dheads [descheads $rowmenuid]
9790 if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9791 set ok [confirm_popup [mc "Commit %s is not\
9792 included in branch %s -- really revert it?" \
9793 [string range $rowmenuid 0 7] $mainhead]]
9794 if {!$ok} return
9795 }
9796 nowbusy revert [mc "Reverting"]
9797 update
9798
9799 if [catch {exec git revert --no-edit $rowmenuid} err] {
9800 notbusy revert
9801 if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9802 $err match files] {
9803 regsub {\n( |\t)+} $files "\n" files
9804 error_popup [mc "Revert failed because of local changes to\
9805 the following files:%s Please commit, reset or stash \
9806 your changes and try again." $files]
9807 } elseif [regexp {error: could not revert} $err] {
9808 if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9809 Do you wish to run git citool to resolve it?"]] {
9810 # Force citool to read MERGE_MSG
9811 file delete [file join $gitdir "GITGUI_MSG"]
9812 exec_citool {} $rowmenuid
9813 }
9814 } else { error_popup $err }
9815 run updatecommits
9816 return
9817 }
9818
9819 set newhead [exec git rev-parse HEAD]
9820 if { $newhead eq $oldhead } {
9821 notbusy revert
9822 error_popup [mc "No changes committed"]
9823 return
9824 }
9825
9826 addnewchild $newhead $oldhead
9827
9828 if [commitinview $oldhead $curview] {
9829 # XXX this isn't right if we have a path limit...
9830 insertrow $newhead $oldhead $curview
9831 if {$mainhead ne {}} {
9832 movehead $newhead $mainhead
9833 movedhead $newhead $mainhead
9834 }
9835 set mainheadid $newhead
9836 redrawtags $oldhead
9837 redrawtags $newhead
9838 selbyid $newhead
9839 }
9840
9841 notbusy revert
9842}
9843
6fb735ae 9844proc resethead {} {
d93f1713 9845 global mainhead rowmenuid confirm_ok resettype NS
6fb735ae
PM
9846
9847 set confirm_ok 0
9848 set w ".confirmreset"
d93f1713 9849 ttk_toplevel $w
e7d64008 9850 make_transient $w .
d990cedf 9851 wm title $w [mc "Confirm reset"]
d93f1713 9852 ${NS}::label $w.m -text \
e244588e 9853 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
6fb735ae 9854 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 9855 ${NS}::labelframe $w.f -text [mc "Reset type:"]
6fb735ae 9856 set resettype mixed
d93f1713 9857 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
e244588e 9858 -text [mc "Soft: Leave working tree and index untouched"]
6fb735ae 9859 grid $w.f.soft -sticky w
d93f1713 9860 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
e244588e 9861 -text [mc "Mixed: Leave working tree untouched, reset index"]
6fb735ae 9862 grid $w.f.mixed -sticky w
d93f1713 9863 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
e244588e 9864 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6fb735ae 9865 grid $w.f.hard -sticky w
d93f1713
PT
9866 pack $w.f -side top -fill x -padx 4
9867 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6fb735ae 9868 pack $w.ok -side left -fill x -padx 20 -pady 20
d93f1713 9869 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
76f15947 9870 bind $w <Key-Escape> [list destroy $w]
6fb735ae
PM
9871 pack $w.cancel -side right -fill x -padx 20 -pady 20
9872 bind $w <Visibility> "grab $w; focus $w"
9873 tkwait window $w
9874 if {!$confirm_ok} return
706d6c3e 9875 if {[catch {set fd [open \
e244588e
DL
9876 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9877 error_popup $err
6fb735ae 9878 } else {
e244588e
DL
9879 dohidelocalchanges
9880 filerun $fd [list readresetstat $fd]
9881 nowbusy reset [mc "Resetting"]
9882 selbyid $rowmenuid
706d6c3e
PM
9883 }
9884}
9885
a137a90f
PM
9886proc readresetstat {fd} {
9887 global mainhead mainheadid showlocalchanges rprogcoord
706d6c3e
PM
9888
9889 if {[gets $fd line] >= 0} {
e244588e
DL
9890 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9891 set rprogcoord [expr {1.0 * $m / $n}]
9892 adjustprogress
9893 }
9894 return 1
706d6c3e 9895 }
a137a90f
PM
9896 set rprogcoord 0
9897 adjustprogress
706d6c3e
PM
9898 notbusy reset
9899 if {[catch {close $fd} err]} {
e244588e 9900 error_popup $err
706d6c3e
PM
9901 }
9902 set oldhead $mainheadid
9903 set newhead [exec git rev-parse HEAD]
9904 if {$newhead ne $oldhead} {
e244588e
DL
9905 movehead $newhead $mainhead
9906 movedhead $newhead $mainhead
9907 set mainheadid $newhead
9908 redrawtags $oldhead
9909 redrawtags $newhead
6fb735ae
PM
9910 }
9911 if {$showlocalchanges} {
e244588e 9912 doshowlocalchanges
6fb735ae 9913 }
706d6c3e 9914 return 0
6fb735ae
PM
9915}
9916
10299152
PM
9917# context menu for a head
9918proc headmenu {x y id head} {
02e6a060 9919 global headmenuid headmenuhead headctxmenu mainhead headids
10299152 9920
bb3edc8b 9921 stopfinding
10299152
PM
9922 set headmenuid $id
9923 set headmenuhead $head
5a046c52 9924 array set state {0 normal 1 normal 2 normal}
70a5fc44 9925 if {[string match "remotes/*" $head]} {
e244588e
DL
9926 set localhead [string range $head [expr [string last / $head] + 1] end]
9927 if {[info exists headids($localhead)]} {
9928 set state(0) disabled
9929 }
9930 array set state {1 disabled 2 disabled}
70a5fc44 9931 }
00609463 9932 if {$head eq $mainhead} {
e244588e 9933 array set state {0 disabled 2 disabled}
5a046c52
RG
9934 }
9935 foreach i {0 1 2} {
e244588e 9936 $headctxmenu entryconfigure $i -state $state($i)
00609463 9937 }
10299152
PM
9938 tk_popup $headctxmenu $x $y
9939}
9940
9941proc cobranch {} {
c11ff120 9942 global headmenuid headmenuhead headids
cdc8429c 9943 global showlocalchanges
10299152
PM
9944
9945 # check the tree is clean first??
02e6a060
RG
9946 set newhead $headmenuhead
9947 set command [list | git checkout]
9948 if {[string match "remotes/*" $newhead]} {
e244588e
DL
9949 set remote $newhead
9950 set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9951 # The following check is redundant - the menu option should
9952 # be disabled to begin with...
9953 if {[info exists headids($newhead)]} {
9954 error_popup [mc "A local branch named %s exists already" $newhead]
9955 return
9956 }
9957 lappend command -b $newhead --track $remote
02e6a060 9958 } else {
e244588e 9959 lappend command $newhead
02e6a060
RG
9960 }
9961 lappend command 2>@1
d990cedf 9962 nowbusy checkout [mc "Checking out"]
10299152 9963 update
219ea3a9 9964 dohidelocalchanges
10299152 9965 if {[catch {
e244588e 9966 set fd [open $command r]
10299152 9967 } err]} {
e244588e
DL
9968 notbusy checkout
9969 error_popup $err
9970 if {$showlocalchanges} {
9971 dodiffindex
9972 }
10299152 9973 } else {
e244588e 9974 filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
08ba820f
PM
9975 }
9976}
9977
9978proc readcheckoutstat {fd newhead newheadid} {
02e6a060 9979 global mainhead mainheadid headids idheads showlocalchanges progresscoords
cdc8429c 9980 global viewmainheadid curview
08ba820f
PM
9981
9982 if {[gets $fd line] >= 0} {
e244588e
DL
9983 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9984 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9985 adjustprogress
9986 }
9987 return 1
08ba820f
PM
9988 }
9989 set progresscoords {0 0}
9990 adjustprogress
9991 notbusy checkout
9992 if {[catch {close $fd} err]} {
e244588e
DL
9993 error_popup $err
9994 return
08ba820f 9995 }
c11ff120 9996 set oldmainid $mainheadid
02e6a060 9997 if {! [info exists headids($newhead)]} {
e244588e
DL
9998 set headids($newhead) $newheadid
9999 lappend idheads($newheadid) $newhead
10000 addedhead $newheadid $newhead
02e6a060 10001 }
08ba820f
PM
10002 set mainhead $newhead
10003 set mainheadid $newheadid
cdc8429c 10004 set viewmainheadid($curview) $newheadid
c11ff120 10005 redrawtags $oldmainid
08ba820f
PM
10006 redrawtags $newheadid
10007 selbyid $newheadid
6fb735ae 10008 if {$showlocalchanges} {
e244588e 10009 dodiffindex
10299152
PM
10010 }
10011}
10012
10013proc rmbranch {} {
e11f1233 10014 global headmenuid headmenuhead mainhead
b1054ac9 10015 global idheads
10299152
PM
10016
10017 set head $headmenuhead
10018 set id $headmenuid
00609463 10019 # this check shouldn't be needed any more...
10299152 10020 if {$head eq $mainhead} {
e244588e
DL
10021 error_popup [mc "Cannot delete the currently checked-out branch"]
10022 return
10299152 10023 }
e11f1233 10024 set dheads [descheads $id]
d7b16113 10025 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
e244588e
DL
10026 # the stuff on this branch isn't on any other branch
10027 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
10028 branch.\nReally delete branch %s?" $head $head]]} return
10299152
PM
10029 }
10030 nowbusy rmbranch
10031 update
10032 if {[catch {exec git branch -D $head} err]} {
e244588e
DL
10033 notbusy rmbranch
10034 error_popup $err
10035 return
10299152 10036 }
e11f1233 10037 removehead $id $head
ca6d8f58 10038 removedhead $id $head
10299152
PM
10039 redrawtags $id
10040 notbusy rmbranch
e11f1233 10041 dispneartags 0
887c996e
PM
10042 run refill_reflist
10043}
10044
10045# Display a list of tags and heads
10046proc showrefs {} {
d93f1713 10047 global showrefstop bgcolor fgcolor selectbgcolor NS
9c311b32 10048 global bglist fglist reflistfilter reflist maincursor
887c996e
PM
10049
10050 set top .showrefs
10051 set showrefstop $top
10052 if {[winfo exists $top]} {
e244588e
DL
10053 raise $top
10054 refill_reflist
10055 return
887c996e 10056 }
d93f1713 10057 ttk_toplevel $top
d990cedf 10058 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
e7d64008 10059 make_transient $top .
887c996e 10060 text $top.list -background $bgcolor -foreground $fgcolor \
e244588e
DL
10061 -selectbackground $selectbgcolor -font mainfont \
10062 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10063 -width 30 -height 20 -cursor $maincursor \
10064 -spacing1 1 -spacing3 1 -state disabled
887c996e 10065 $top.list tag configure highlight -background $selectbgcolor
eb859df8 10066 if {![lsearch -exact $bglist $top.list]} {
e244588e
DL
10067 lappend bglist $top.list
10068 lappend fglist $top.list
eb859df8 10069 }
d93f1713
PT
10070 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10071 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
887c996e
PM
10072 grid $top.list $top.ysb -sticky nsew
10073 grid $top.xsb x -sticky ew
d93f1713
PT
10074 ${NS}::frame $top.f
10075 ${NS}::label $top.f.l -text "[mc "Filter"]: "
10076 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
887c996e
PM
10077 set reflistfilter "*"
10078 trace add variable reflistfilter write reflistfilter_change
10079 pack $top.f.e -side right -fill x -expand 1
10080 pack $top.f.l -side left
10081 grid $top.f - -sticky ew -pady 2
d93f1713 10082 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
76f15947 10083 bind $top <Key-Escape> [list destroy $top]
887c996e
PM
10084 grid $top.close -
10085 grid columnconfigure $top 0 -weight 1
10086 grid rowconfigure $top 0 -weight 1
10087 bind $top.list <1> {break}
10088 bind $top.list <B1-Motion> {break}
10089 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10090 set reflist {}
10091 refill_reflist
10092}
10093
10094proc sel_reflist {w x y} {
10095 global showrefstop reflist headids tagids otherrefids
10096
10097 if {![winfo exists $showrefstop]} return
10098 set l [lindex [split [$w index "@$x,$y"] "."] 0]
10099 set ref [lindex $reflist [expr {$l-1}]]
10100 set n [lindex $ref 0]
10101 switch -- [lindex $ref 1] {
e244588e
DL
10102 "H" {selbyid $headids($n)}
10103 "R" {selbyid $headids($n)}
10104 "T" {selbyid $tagids($n)}
10105 "o" {selbyid $otherrefids($n)}
887c996e
PM
10106 }
10107 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10108}
10109
10110proc unsel_reflist {} {
10111 global showrefstop
10112
10113 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10114 $showrefstop.list tag remove highlight 0.0 end
10115}
10116
10117proc reflistfilter_change {n1 n2 op} {
10118 global reflistfilter
10119
10120 after cancel refill_reflist
10121 after 200 refill_reflist
10122}
10123
10124proc refill_reflist {} {
10125 global reflist reflistfilter showrefstop headids tagids otherrefids
d375ef9b 10126 global curview
887c996e
PM
10127
10128 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10129 set refs {}
10130 foreach n [array names headids] {
e244588e
DL
10131 if {[string match $reflistfilter $n]} {
10132 if {[commitinview $headids($n) $curview]} {
10133 if {[string match "remotes/*" $n]} {
10134 lappend refs [list $n R]
10135 } else {
10136 lappend refs [list $n H]
10137 }
10138 } else {
10139 interestedin $headids($n) {run refill_reflist}
10140 }
10141 }
887c996e
PM
10142 }
10143 foreach n [array names tagids] {
e244588e
DL
10144 if {[string match $reflistfilter $n]} {
10145 if {[commitinview $tagids($n) $curview]} {
10146 lappend refs [list $n T]
10147 } else {
10148 interestedin $tagids($n) {run refill_reflist}
10149 }
10150 }
887c996e
PM
10151 }
10152 foreach n [array names otherrefids] {
e244588e
DL
10153 if {[string match $reflistfilter $n]} {
10154 if {[commitinview $otherrefids($n) $curview]} {
10155 lappend refs [list $n o]
10156 } else {
10157 interestedin $otherrefids($n) {run refill_reflist}
10158 }
10159 }
887c996e
PM
10160 }
10161 set refs [lsort -index 0 $refs]
10162 if {$refs eq $reflist} return
10163
10164 # Update the contents of $showrefstop.list according to the
10165 # differences between $reflist (old) and $refs (new)
10166 $showrefstop.list conf -state normal
10167 $showrefstop.list insert end "\n"
10168 set i 0
10169 set j 0
10170 while {$i < [llength $reflist] || $j < [llength $refs]} {
e244588e
DL
10171 if {$i < [llength $reflist]} {
10172 if {$j < [llength $refs]} {
10173 set cmp [string compare [lindex $reflist $i 0] \
10174 [lindex $refs $j 0]]
10175 if {$cmp == 0} {
10176 set cmp [string compare [lindex $reflist $i 1] \
10177 [lindex $refs $j 1]]
10178 }
10179 } else {
10180 set cmp -1
10181 }
10182 } else {
10183 set cmp 1
10184 }
10185 switch -- $cmp {
10186 -1 {
10187 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10188 incr i
10189 }
10190 0 {
10191 incr i
10192 incr j
10193 }
10194 1 {
10195 set l [expr {$j + 1}]
10196 $showrefstop.list image create $l.0 -align baseline \
10197 -image reficon-[lindex $refs $j 1] -padx 2
10198 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10199 incr j
10200 }
10201 }
887c996e
PM
10202 }
10203 set reflist $refs
10204 # delete last newline
10205 $showrefstop.list delete end-2c end-1c
10206 $showrefstop.list conf -state disabled
10299152
PM
10207}
10208
b8ab2e17
PM
10209# Stuff for finding nearby tags
10210proc getallcommits {} {
5cd15b6b
PM
10211 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10212 global idheads idtags idotherrefs allparents tagobjid
da616db5 10213 global gitdir
f1d83ba3 10214
a69b2d1a 10215 if {![info exists allcommits]} {
e244588e
DL
10216 set nextarc 0
10217 set allcommits 0
10218 set seeds {}
10219 set allcwait 0
10220 set cachedarcs 0
10221 set allccache [file join $gitdir "gitk.cache"]
10222 if {![catch {
10223 set f [open $allccache r]
10224 set allcwait 1
10225 getcache $f
10226 }]} return
a69b2d1a 10227 }
2d71bccc 10228
5cd15b6b 10229 if {$allcwait} {
e244588e 10230 return
5cd15b6b
PM
10231 }
10232 set cmd [list | git rev-list --parents]
10233 set allcupdate [expr {$seeds ne {}}]
10234 if {!$allcupdate} {
e244588e 10235 set ids "--all"
5cd15b6b 10236 } else {
e244588e
DL
10237 set refs [concat [array names idheads] [array names idtags] \
10238 [array names idotherrefs]]
10239 set ids {}
10240 set tagobjs {}
10241 foreach name [array names tagobjid] {
10242 lappend tagobjs $tagobjid($name)
10243 }
10244 foreach id [lsort -unique $refs] {
10245 if {![info exists allparents($id)] &&
10246 [lsearch -exact $tagobjs $id] < 0} {
10247 lappend ids $id
10248 }
10249 }
10250 if {$ids ne {}} {
10251 foreach id $seeds {
10252 lappend ids "^$id"
10253 }
bb5cb23d 10254 lappend ids "--"
e244588e 10255 }
5cd15b6b
PM
10256 }
10257 if {$ids ne {}} {
bb5cb23d
JS
10258 if {$ids eq "--all"} {
10259 set cmd [concat $cmd "--all"]
10260 } else {
10261 set cmd [concat $cmd --stdin "<<[join $ids "\\n"]"]
10262 }
10263 set fd [open $cmd r]
e244588e
DL
10264 fconfigure $fd -blocking 0
10265 incr allcommits
10266 nowbusy allcommits
10267 filerun $fd [list getallclines $fd]
5cd15b6b 10268 } else {
e244588e 10269 dispneartags 0
2d71bccc 10270 }
e11f1233
PM
10271}
10272
10273# Since most commits have 1 parent and 1 child, we group strings of
10274# such commits into "arcs" joining branch/merge points (BMPs), which
10275# are commits that either don't have 1 parent or don't have 1 child.
10276#
10277# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10278# arcout(id) - outgoing arcs for BMP
10279# arcids(a) - list of IDs on arc including end but not start
10280# arcstart(a) - BMP ID at start of arc
10281# arcend(a) - BMP ID at end of arc
10282# growing(a) - arc a is still growing
10283# arctags(a) - IDs out of arcids (excluding end) that have tags
10284# archeads(a) - IDs out of arcids (excluding end) that have heads
10285# The start of an arc is at the descendent end, so "incoming" means
10286# coming from descendents, and "outgoing" means going towards ancestors.
10287
10288proc getallclines {fd} {
5cd15b6b 10289 global allparents allchildren idtags idheads nextarc
e11f1233 10290 global arcnos arcids arctags arcout arcend arcstart archeads growing
5cd15b6b 10291 global seeds allcommits cachedarcs allcupdate
d93f1713 10292
e11f1233 10293 set nid 0
7eb3cb9c 10294 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
e244588e
DL
10295 set id [lindex $line 0]
10296 if {[info exists allparents($id)]} {
10297 # seen it already
10298 continue
10299 }
10300 set cachedarcs 0
10301 set olds [lrange $line 1 end]
10302 set allparents($id) $olds
10303 if {![info exists allchildren($id)]} {
10304 set allchildren($id) {}
10305 set arcnos($id) {}
10306 lappend seeds $id
10307 } else {
10308 set a $arcnos($id)
10309 if {[llength $olds] == 1 && [llength $a] == 1} {
10310 lappend arcids($a) $id
10311 if {[info exists idtags($id)]} {
10312 lappend arctags($a) $id
10313 }
10314 if {[info exists idheads($id)]} {
10315 lappend archeads($a) $id
10316 }
10317 if {[info exists allparents($olds)]} {
10318 # seen parent already
10319 if {![info exists arcout($olds)]} {
10320 splitarc $olds
10321 }
10322 lappend arcids($a) $olds
10323 set arcend($a) $olds
10324 unset growing($a)
10325 }
10326 lappend allchildren($olds) $id
10327 lappend arcnos($olds) $a
10328 continue
10329 }
10330 }
10331 foreach a $arcnos($id) {
10332 lappend arcids($a) $id
10333 set arcend($a) $id
10334 unset growing($a)
10335 }
10336
10337 set ao {}
10338 foreach p $olds {
10339 lappend allchildren($p) $id
10340 set a [incr nextarc]
10341 set arcstart($a) $id
10342 set archeads($a) {}
10343 set arctags($a) {}
10344 set archeads($a) {}
10345 set arcids($a) {}
10346 lappend ao $a
10347 set growing($a) 1
10348 if {[info exists allparents($p)]} {
10349 # seen it already, may need to make a new branch
10350 if {![info exists arcout($p)]} {
10351 splitarc $p
10352 }
10353 lappend arcids($a) $p
10354 set arcend($a) $p
10355 unset growing($a)
10356 }
10357 lappend arcnos($p) $a
10358 }
10359 set arcout($id) $ao
f1d83ba3 10360 }
f3326b66 10361 if {$nid > 0} {
e244588e
DL
10362 global cached_dheads cached_dtags cached_atags
10363 unset -nocomplain cached_dheads
10364 unset -nocomplain cached_dtags
10365 unset -nocomplain cached_atags
f3326b66 10366 }
7eb3cb9c 10367 if {![eof $fd]} {
e244588e 10368 return [expr {$nid >= 1000? 2: 1}]
7eb3cb9c 10369 }
5cd15b6b
PM
10370 set cacheok 1
10371 if {[catch {
e244588e
DL
10372 fconfigure $fd -blocking 1
10373 close $fd
5cd15b6b 10374 } err]} {
e244588e
DL
10375 # got an error reading the list of commits
10376 # if we were updating, try rereading the whole thing again
10377 if {$allcupdate} {
10378 incr allcommits -1
10379 dropcache $err
10380 return
10381 }
10382 error_popup "[mc "Error reading commit topology information;\
10383 branch and preceding/following tag information\
10384 will be incomplete."]\n($err)"
10385 set cacheok 0
5cd15b6b 10386 }
e11f1233 10387 if {[incr allcommits -1] == 0} {
e244588e
DL
10388 notbusy allcommits
10389 if {$cacheok} {
10390 run savecache
10391 }
e11f1233
PM
10392 }
10393 dispneartags 0
7eb3cb9c 10394 return 0
b8ab2e17
PM
10395}
10396
e11f1233
PM
10397proc recalcarc {a} {
10398 global arctags archeads arcids idtags idheads
b8ab2e17 10399
e11f1233
PM
10400 set at {}
10401 set ah {}
10402 foreach id [lrange $arcids($a) 0 end-1] {
e244588e
DL
10403 if {[info exists idtags($id)]} {
10404 lappend at $id
10405 }
10406 if {[info exists idheads($id)]} {
10407 lappend ah $id
10408 }
f1d83ba3 10409 }
e11f1233
PM
10410 set arctags($a) $at
10411 set archeads($a) $ah
b8ab2e17
PM
10412}
10413
e11f1233 10414proc splitarc {p} {
5cd15b6b 10415 global arcnos arcids nextarc arctags archeads idtags idheads
e11f1233 10416 global arcstart arcend arcout allparents growing
cec7bece 10417
e11f1233
PM
10418 set a $arcnos($p)
10419 if {[llength $a] != 1} {
e244588e
DL
10420 puts "oops splitarc called but [llength $a] arcs already"
10421 return
e11f1233
PM
10422 }
10423 set a [lindex $a 0]
10424 set i [lsearch -exact $arcids($a) $p]
10425 if {$i < 0} {
e244588e
DL
10426 puts "oops splitarc $p not in arc $a"
10427 return
e11f1233
PM
10428 }
10429 set na [incr nextarc]
10430 if {[info exists arcend($a)]} {
e244588e 10431 set arcend($na) $arcend($a)
e11f1233 10432 } else {
e244588e
DL
10433 set l [lindex $allparents([lindex $arcids($a) end]) 0]
10434 set j [lsearch -exact $arcnos($l) $a]
10435 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
e11f1233
PM
10436 }
10437 set tail [lrange $arcids($a) [expr {$i+1}] end]
10438 set arcids($a) [lrange $arcids($a) 0 $i]
10439 set arcend($a) $p
10440 set arcstart($na) $p
10441 set arcout($p) $na
10442 set arcids($na) $tail
10443 if {[info exists growing($a)]} {
e244588e
DL
10444 set growing($na) 1
10445 unset growing($a)
e11f1233 10446 }
e11f1233
PM
10447
10448 foreach id $tail {
e244588e
DL
10449 if {[llength $arcnos($id)] == 1} {
10450 set arcnos($id) $na
10451 } else {
10452 set j [lsearch -exact $arcnos($id) $a]
10453 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10454 }
e11f1233
PM
10455 }
10456
10457 # reconstruct tags and heads lists
10458 if {$arctags($a) ne {} || $archeads($a) ne {}} {
e244588e
DL
10459 recalcarc $a
10460 recalcarc $na
e11f1233 10461 } else {
e244588e
DL
10462 set arctags($na) {}
10463 set archeads($na) {}
e11f1233
PM
10464 }
10465}
10466
10467# Update things for a new commit added that is a child of one
10468# existing commit. Used when cherry-picking.
10469proc addnewchild {id p} {
5cd15b6b 10470 global allparents allchildren idtags nextarc
e11f1233 10471 global arcnos arcids arctags arcout arcend arcstart archeads growing
719c2b9d 10472 global seeds allcommits
e11f1233 10473
3ebba3c7 10474 if {![info exists allcommits] || ![info exists arcnos($p)]} return
e11f1233
PM
10475 set allparents($id) [list $p]
10476 set allchildren($id) {}
10477 set arcnos($id) {}
10478 lappend seeds $id
e11f1233
PM
10479 lappend allchildren($p) $id
10480 set a [incr nextarc]
10481 set arcstart($a) $id
10482 set archeads($a) {}
10483 set arctags($a) {}
10484 set arcids($a) [list $p]
10485 set arcend($a) $p
10486 if {![info exists arcout($p)]} {
e244588e 10487 splitarc $p
e11f1233
PM
10488 }
10489 lappend arcnos($p) $a
10490 set arcout($id) [list $a]
10491}
10492
5cd15b6b
PM
10493# This implements a cache for the topology information.
10494# The cache saves, for each arc, the start and end of the arc,
10495# the ids on the arc, and the outgoing arcs from the end.
10496proc readcache {f} {
10497 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10498 global idtags idheads allparents cachedarcs possible_seeds seeds growing
10499 global allcwait
10500
10501 set a $nextarc
10502 set lim $cachedarcs
10503 if {$lim - $a > 500} {
e244588e 10504 set lim [expr {$a + 500}]
5cd15b6b
PM
10505 }
10506 if {[catch {
e244588e
DL
10507 if {$a == $lim} {
10508 # finish reading the cache and setting up arctags, etc.
10509 set line [gets $f]
10510 if {$line ne "1"} {error "bad final version"}
10511 close $f
10512 foreach id [array names idtags] {
10513 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10514 [llength $allparents($id)] == 1} {
10515 set a [lindex $arcnos($id) 0]
10516 if {$arctags($a) eq {}} {
10517 recalcarc $a
10518 }
10519 }
10520 }
10521 foreach id [array names idheads] {
10522 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10523 [llength $allparents($id)] == 1} {
10524 set a [lindex $arcnos($id) 0]
10525 if {$archeads($a) eq {}} {
10526 recalcarc $a
10527 }
10528 }
10529 }
10530 foreach id [lsort -unique $possible_seeds] {
10531 if {$arcnos($id) eq {}} {
10532 lappend seeds $id
10533 }
10534 }
10535 set allcwait 0
10536 } else {
10537 while {[incr a] <= $lim} {
10538 set line [gets $f]
10539 if {[llength $line] != 3} {error "bad line"}
10540 set s [lindex $line 0]
10541 set arcstart($a) $s
10542 lappend arcout($s) $a
10543 if {![info exists arcnos($s)]} {
10544 lappend possible_seeds $s
10545 set arcnos($s) {}
10546 }
10547 set e [lindex $line 1]
10548 if {$e eq {}} {
10549 set growing($a) 1
10550 } else {
10551 set arcend($a) $e
10552 if {![info exists arcout($e)]} {
10553 set arcout($e) {}
10554 }
10555 }
10556 set arcids($a) [lindex $line 2]
10557 foreach id $arcids($a) {
10558 lappend allparents($s) $id
10559 set s $id
10560 lappend arcnos($id) $a
10561 }
10562 if {![info exists allparents($s)]} {
10563 set allparents($s) {}
10564 }
10565 set arctags($a) {}
10566 set archeads($a) {}
10567 }
10568 set nextarc [expr {$a - 1}]
10569 }
5cd15b6b 10570 } err]} {
e244588e
DL
10571 dropcache $err
10572 return 0
5cd15b6b
PM
10573 }
10574 if {!$allcwait} {
e244588e 10575 getallcommits
5cd15b6b
PM
10576 }
10577 return $allcwait
10578}
10579
10580proc getcache {f} {
10581 global nextarc cachedarcs possible_seeds
10582
10583 if {[catch {
e244588e
DL
10584 set line [gets $f]
10585 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10586 # make sure it's an integer
10587 set cachedarcs [expr {int([lindex $line 1])}]
10588 if {$cachedarcs < 0} {error "bad number of arcs"}
10589 set nextarc 0
10590 set possible_seeds {}
10591 run readcache $f
5cd15b6b 10592 } err]} {
e244588e 10593 dropcache $err
5cd15b6b
PM
10594 }
10595 return 0
10596}
10597
10598proc dropcache {err} {
10599 global allcwait nextarc cachedarcs seeds
10600
10601 #puts "dropping cache ($err)"
10602 foreach v {arcnos arcout arcids arcstart arcend growing \
e244588e
DL
10603 arctags archeads allparents allchildren} {
10604 global $v
10605 unset -nocomplain $v
5cd15b6b
PM
10606 }
10607 set allcwait 0
10608 set nextarc 0
10609 set cachedarcs 0
10610 set seeds {}
10611 getallcommits
10612}
10613
10614proc writecache {f} {
10615 global cachearc cachedarcs allccache
10616 global arcstart arcend arcnos arcids arcout
10617
10618 set a $cachearc
10619 set lim $cachedarcs
10620 if {$lim - $a > 1000} {
e244588e 10621 set lim [expr {$a + 1000}]
5cd15b6b
PM
10622 }
10623 if {[catch {
e244588e
DL
10624 while {[incr a] <= $lim} {
10625 if {[info exists arcend($a)]} {
10626 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10627 } else {
10628 puts $f [list $arcstart($a) {} $arcids($a)]
10629 }
10630 }
5cd15b6b 10631 } err]} {
e244588e
DL
10632 catch {close $f}
10633 catch {file delete $allccache}
10634 #puts "writing cache failed ($err)"
10635 return 0
5cd15b6b
PM
10636 }
10637 set cachearc [expr {$a - 1}]
10638 if {$a > $cachedarcs} {
e244588e
DL
10639 puts $f "1"
10640 close $f
10641 return 0
5cd15b6b
PM
10642 }
10643 return 1
10644}
10645
10646proc savecache {} {
10647 global nextarc cachedarcs cachearc allccache
10648
10649 if {$nextarc == $cachedarcs} return
10650 set cachearc 0
10651 set cachedarcs $nextarc
10652 catch {
e244588e
DL
10653 set f [open $allccache w]
10654 puts $f [list 1 $cachedarcs]
10655 run writecache $f
5cd15b6b
PM
10656 }
10657}
10658
e11f1233
PM
10659# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10660# or 0 if neither is true.
10661proc anc_or_desc {a b} {
10662 global arcout arcstart arcend arcnos cached_isanc
10663
10664 if {$arcnos($a) eq $arcnos($b)} {
e244588e
DL
10665 # Both are on the same arc(s); either both are the same BMP,
10666 # or if one is not a BMP, the other is also not a BMP or is
10667 # the BMP at end of the arc (and it only has 1 incoming arc).
10668 # Or both can be BMPs with no incoming arcs.
10669 if {$a eq $b || $arcnos($a) eq {}} {
10670 return 0
10671 }
10672 # assert {[llength $arcnos($a)] == 1}
10673 set arc [lindex $arcnos($a) 0]
10674 set i [lsearch -exact $arcids($arc) $a]
10675 set j [lsearch -exact $arcids($arc) $b]
10676 if {$i < 0 || $i > $j} {
10677 return 1
10678 } else {
10679 return -1
10680 }
cec7bece 10681 }
e11f1233
PM
10682
10683 if {![info exists arcout($a)]} {
e244588e
DL
10684 set arc [lindex $arcnos($a) 0]
10685 if {[info exists arcend($arc)]} {
10686 set aend $arcend($arc)
10687 } else {
10688 set aend {}
10689 }
10690 set a $arcstart($arc)
e11f1233 10691 } else {
e244588e 10692 set aend $a
e11f1233
PM
10693 }
10694 if {![info exists arcout($b)]} {
e244588e
DL
10695 set arc [lindex $arcnos($b) 0]
10696 if {[info exists arcend($arc)]} {
10697 set bend $arcend($arc)
10698 } else {
10699 set bend {}
10700 }
10701 set b $arcstart($arc)
e11f1233 10702 } else {
e244588e 10703 set bend $b
cec7bece 10704 }
e11f1233 10705 if {$a eq $bend} {
e244588e 10706 return 1
e11f1233
PM
10707 }
10708 if {$b eq $aend} {
e244588e 10709 return -1
e11f1233
PM
10710 }
10711 if {[info exists cached_isanc($a,$bend)]} {
e244588e
DL
10712 if {$cached_isanc($a,$bend)} {
10713 return 1
10714 }
e11f1233
PM
10715 }
10716 if {[info exists cached_isanc($b,$aend)]} {
e244588e
DL
10717 if {$cached_isanc($b,$aend)} {
10718 return -1
10719 }
10720 if {[info exists cached_isanc($a,$bend)]} {
10721 return 0
10722 }
cec7bece 10723 }
cec7bece 10724
e11f1233
PM
10725 set todo [list $a $b]
10726 set anc($a) a
10727 set anc($b) b
10728 for {set i 0} {$i < [llength $todo]} {incr i} {
e244588e
DL
10729 set x [lindex $todo $i]
10730 if {$anc($x) eq {}} {
10731 continue
10732 }
10733 foreach arc $arcnos($x) {
10734 set xd $arcstart($arc)
10735 if {$xd eq $bend} {
10736 set cached_isanc($a,$bend) 1
10737 set cached_isanc($b,$aend) 0
10738 return 1
10739 } elseif {$xd eq $aend} {
10740 set cached_isanc($b,$aend) 1
10741 set cached_isanc($a,$bend) 0
10742 return -1
10743 }
10744 if {![info exists anc($xd)]} {
10745 set anc($xd) $anc($x)
10746 lappend todo $xd
10747 } elseif {$anc($xd) ne $anc($x)} {
10748 set anc($xd) {}
10749 }
10750 }
e11f1233
PM
10751 }
10752 set cached_isanc($a,$bend) 0
10753 set cached_isanc($b,$aend) 0
10754 return 0
10755}
b8ab2e17 10756
e11f1233
PM
10757# This identifies whether $desc has an ancestor that is
10758# a growing tip of the graph and which is not an ancestor of $anc
10759# and returns 0 if so and 1 if not.
10760# If we subsequently discover a tag on such a growing tip, and that
10761# turns out to be a descendent of $anc (which it could, since we
10762# don't necessarily see children before parents), then $desc
10763# isn't a good choice to display as a descendent tag of
10764# $anc (since it is the descendent of another tag which is
10765# a descendent of $anc). Similarly, $anc isn't a good choice to
10766# display as a ancestor tag of $desc.
10767#
10768proc is_certain {desc anc} {
10769 global arcnos arcout arcstart arcend growing problems
10770
10771 set certain {}
10772 if {[llength $arcnos($anc)] == 1} {
e244588e
DL
10773 # tags on the same arc are certain
10774 if {$arcnos($desc) eq $arcnos($anc)} {
10775 return 1
10776 }
10777 if {![info exists arcout($anc)]} {
10778 # if $anc is partway along an arc, use the start of the arc instead
10779 set a [lindex $arcnos($anc) 0]
10780 set anc $arcstart($a)
10781 }
e11f1233
PM
10782 }
10783 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
e244588e 10784 set x $desc
e11f1233 10785 } else {
e244588e
DL
10786 set a [lindex $arcnos($desc) 0]
10787 set x $arcend($a)
e11f1233
PM
10788 }
10789 if {$x == $anc} {
e244588e 10790 return 1
e11f1233
PM
10791 }
10792 set anclist [list $x]
10793 set dl($x) 1
10794 set nnh 1
10795 set ngrowanc 0
10796 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
e244588e
DL
10797 set x [lindex $anclist $i]
10798 if {$dl($x)} {
10799 incr nnh -1
10800 }
10801 set done($x) 1
10802 foreach a $arcout($x) {
10803 if {[info exists growing($a)]} {
10804 if {![info exists growanc($x)] && $dl($x)} {
10805 set growanc($x) 1
10806 incr ngrowanc
10807 }
10808 } else {
10809 set y $arcend($a)
10810 if {[info exists dl($y)]} {
10811 if {$dl($y)} {
10812 if {!$dl($x)} {
10813 set dl($y) 0
10814 if {![info exists done($y)]} {
10815 incr nnh -1
10816 }
10817 if {[info exists growanc($x)]} {
10818 incr ngrowanc -1
10819 }
10820 set xl [list $y]
10821 for {set k 0} {$k < [llength $xl]} {incr k} {
10822 set z [lindex $xl $k]
10823 foreach c $arcout($z) {
10824 if {[info exists arcend($c)]} {
10825 set v $arcend($c)
10826 if {[info exists dl($v)] && $dl($v)} {
10827 set dl($v) 0
10828 if {![info exists done($v)]} {
10829 incr nnh -1
10830 }
10831 if {[info exists growanc($v)]} {
10832 incr ngrowanc -1
10833 }
10834 lappend xl $v
10835 }
10836 }
10837 }
10838 }
10839 }
10840 }
10841 } elseif {$y eq $anc || !$dl($x)} {
10842 set dl($y) 0
10843 lappend anclist $y
10844 } else {
10845 set dl($y) 1
10846 lappend anclist $y
10847 incr nnh
10848 }
10849 }
10850 }
b8ab2e17 10851 }
e11f1233 10852 foreach x [array names growanc] {
e244588e
DL
10853 if {$dl($x)} {
10854 return 0
10855 }
10856 return 0
b8ab2e17 10857 }
e11f1233 10858 return 1
b8ab2e17
PM
10859}
10860
e11f1233
PM
10861proc validate_arctags {a} {
10862 global arctags idtags
b8ab2e17 10863
e11f1233
PM
10864 set i -1
10865 set na $arctags($a)
10866 foreach id $arctags($a) {
e244588e
DL
10867 incr i
10868 if {![info exists idtags($id)]} {
10869 set na [lreplace $na $i $i]
10870 incr i -1
10871 }
e11f1233
PM
10872 }
10873 set arctags($a) $na
10874}
10875
10876proc validate_archeads {a} {
10877 global archeads idheads
10878
10879 set i -1
10880 set na $archeads($a)
10881 foreach id $archeads($a) {
e244588e
DL
10882 incr i
10883 if {![info exists idheads($id)]} {
10884 set na [lreplace $na $i $i]
10885 incr i -1
10886 }
e11f1233
PM
10887 }
10888 set archeads($a) $na
10889}
10890
10891# Return the list of IDs that have tags that are descendents of id,
10892# ignoring IDs that are descendents of IDs already reported.
10893proc desctags {id} {
10894 global arcnos arcstart arcids arctags idtags allparents
10895 global growing cached_dtags
10896
10897 if {![info exists allparents($id)]} {
e244588e 10898 return {}
e11f1233
PM
10899 }
10900 set t1 [clock clicks -milliseconds]
10901 set argid $id
10902 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
e244588e
DL
10903 # part-way along an arc; check that arc first
10904 set a [lindex $arcnos($id) 0]
10905 if {$arctags($a) ne {}} {
10906 validate_arctags $a
10907 set i [lsearch -exact $arcids($a) $id]
10908 set tid {}
10909 foreach t $arctags($a) {
10910 set j [lsearch -exact $arcids($a) $t]
10911 if {$j >= $i} break
10912 set tid $t
10913 }
10914 if {$tid ne {}} {
10915 return $tid
10916 }
10917 }
10918 set id $arcstart($a)
10919 if {[info exists idtags($id)]} {
10920 return $id
10921 }
e11f1233
PM
10922 }
10923 if {[info exists cached_dtags($id)]} {
e244588e 10924 return $cached_dtags($id)
e11f1233
PM
10925 }
10926
10927 set origid $id
10928 set todo [list $id]
10929 set queued($id) 1
10930 set nc 1
10931 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
e244588e
DL
10932 set id [lindex $todo $i]
10933 set done($id) 1
10934 set ta [info exists hastaggedancestor($id)]
10935 if {!$ta} {
10936 incr nc -1
10937 }
10938 # ignore tags on starting node
10939 if {!$ta && $i > 0} {
10940 if {[info exists idtags($id)]} {
10941 set tagloc($id) $id
10942 set ta 1
10943 } elseif {[info exists cached_dtags($id)]} {
10944 set tagloc($id) $cached_dtags($id)
10945 set ta 1
10946 }
10947 }
10948 foreach a $arcnos($id) {
10949 set d $arcstart($a)
10950 if {!$ta && $arctags($a) ne {}} {
10951 validate_arctags $a
10952 if {$arctags($a) ne {}} {
10953 lappend tagloc($id) [lindex $arctags($a) end]
10954 }
10955 }
10956 if {$ta || $arctags($a) ne {}} {
10957 set tomark [list $d]
10958 for {set j 0} {$j < [llength $tomark]} {incr j} {
10959 set dd [lindex $tomark $j]
10960 if {![info exists hastaggedancestor($dd)]} {
10961 if {[info exists done($dd)]} {
10962 foreach b $arcnos($dd) {
10963 lappend tomark $arcstart($b)
10964 }
10965 if {[info exists tagloc($dd)]} {
10966 unset tagloc($dd)
10967 }
10968 } elseif {[info exists queued($dd)]} {
10969 incr nc -1
10970 }
10971 set hastaggedancestor($dd) 1
10972 }
10973 }
10974 }
10975 if {![info exists queued($d)]} {
10976 lappend todo $d
10977 set queued($d) 1
10978 if {![info exists hastaggedancestor($d)]} {
10979 incr nc
10980 }
10981 }
10982 }
f1d83ba3 10983 }
e11f1233
PM
10984 set tags {}
10985 foreach id [array names tagloc] {
e244588e
DL
10986 if {![info exists hastaggedancestor($id)]} {
10987 foreach t $tagloc($id) {
10988 if {[lsearch -exact $tags $t] < 0} {
10989 lappend tags $t
10990 }
10991 }
10992 }
e11f1233
PM
10993 }
10994 set t2 [clock clicks -milliseconds]
10995 set loopix $i
f1d83ba3 10996
e11f1233
PM
10997 # remove tags that are descendents of other tags
10998 for {set i 0} {$i < [llength $tags]} {incr i} {
e244588e
DL
10999 set a [lindex $tags $i]
11000 for {set j 0} {$j < $i} {incr j} {
11001 set b [lindex $tags $j]
11002 set r [anc_or_desc $a $b]
11003 if {$r == 1} {
11004 set tags [lreplace $tags $j $j]
11005 incr j -1
11006 incr i -1
11007 } elseif {$r == -1} {
11008 set tags [lreplace $tags $i $i]
11009 incr i -1
11010 break
11011 }
11012 }
ceadfe90
PM
11013 }
11014
e11f1233 11015 if {[array names growing] ne {}} {
e244588e
DL
11016 # graph isn't finished, need to check if any tag could get
11017 # eclipsed by another tag coming later. Simply ignore any
11018 # tags that could later get eclipsed.
11019 set ctags {}
11020 foreach t $tags {
11021 if {[is_certain $t $origid]} {
11022 lappend ctags $t
11023 }
11024 }
11025 if {$tags eq $ctags} {
11026 set cached_dtags($origid) $tags
11027 } else {
11028 set tags $ctags
11029 }
e11f1233 11030 } else {
e244588e 11031 set cached_dtags($origid) $tags
e11f1233
PM
11032 }
11033 set t3 [clock clicks -milliseconds]
11034 if {0 && $t3 - $t1 >= 100} {
e244588e
DL
11035 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
11036 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
ceadfe90 11037 }
e11f1233
PM
11038 return $tags
11039}
ceadfe90 11040
e11f1233
PM
11041proc anctags {id} {
11042 global arcnos arcids arcout arcend arctags idtags allparents
11043 global growing cached_atags
11044
11045 if {![info exists allparents($id)]} {
e244588e 11046 return {}
e11f1233
PM
11047 }
11048 set t1 [clock clicks -milliseconds]
11049 set argid $id
11050 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
e244588e
DL
11051 # part-way along an arc; check that arc first
11052 set a [lindex $arcnos($id) 0]
11053 if {$arctags($a) ne {}} {
11054 validate_arctags $a
11055 set i [lsearch -exact $arcids($a) $id]
11056 foreach t $arctags($a) {
11057 set j [lsearch -exact $arcids($a) $t]
11058 if {$j > $i} {
11059 return $t
11060 }
11061 }
11062 }
11063 if {![info exists arcend($a)]} {
11064 return {}
11065 }
11066 set id $arcend($a)
11067 if {[info exists idtags($id)]} {
11068 return $id
11069 }
e11f1233
PM
11070 }
11071 if {[info exists cached_atags($id)]} {
e244588e 11072 return $cached_atags($id)
e11f1233
PM
11073 }
11074
11075 set origid $id
11076 set todo [list $id]
11077 set queued($id) 1
11078 set taglist {}
11079 set nc 1
11080 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
e244588e
DL
11081 set id [lindex $todo $i]
11082 set done($id) 1
11083 set td [info exists hastaggeddescendent($id)]
11084 if {!$td} {
11085 incr nc -1
11086 }
11087 # ignore tags on starting node
11088 if {!$td && $i > 0} {
11089 if {[info exists idtags($id)]} {
11090 set tagloc($id) $id
11091 set td 1
11092 } elseif {[info exists cached_atags($id)]} {
11093 set tagloc($id) $cached_atags($id)
11094 set td 1
11095 }
11096 }
11097 foreach a $arcout($id) {
11098 if {!$td && $arctags($a) ne {}} {
11099 validate_arctags $a
11100 if {$arctags($a) ne {}} {
11101 lappend tagloc($id) [lindex $arctags($a) 0]
11102 }
11103 }
11104 if {![info exists arcend($a)]} continue
11105 set d $arcend($a)
11106 if {$td || $arctags($a) ne {}} {
11107 set tomark [list $d]
11108 for {set j 0} {$j < [llength $tomark]} {incr j} {
11109 set dd [lindex $tomark $j]
11110 if {![info exists hastaggeddescendent($dd)]} {
11111 if {[info exists done($dd)]} {
11112 foreach b $arcout($dd) {
11113 if {[info exists arcend($b)]} {
11114 lappend tomark $arcend($b)
11115 }
11116 }
11117 if {[info exists tagloc($dd)]} {
11118 unset tagloc($dd)
11119 }
11120 } elseif {[info exists queued($dd)]} {
11121 incr nc -1
11122 }
11123 set hastaggeddescendent($dd) 1
11124 }
11125 }
11126 }
11127 if {![info exists queued($d)]} {
11128 lappend todo $d
11129 set queued($d) 1
11130 if {![info exists hastaggeddescendent($d)]} {
11131 incr nc
11132 }
11133 }
11134 }
e11f1233
PM
11135 }
11136 set t2 [clock clicks -milliseconds]
11137 set loopix $i
11138 set tags {}
11139 foreach id [array names tagloc] {
e244588e
DL
11140 if {![info exists hastaggeddescendent($id)]} {
11141 foreach t $tagloc($id) {
11142 if {[lsearch -exact $tags $t] < 0} {
11143 lappend tags $t
11144 }
11145 }
11146 }
ceadfe90 11147 }
ceadfe90 11148
e11f1233
PM
11149 # remove tags that are ancestors of other tags
11150 for {set i 0} {$i < [llength $tags]} {incr i} {
e244588e
DL
11151 set a [lindex $tags $i]
11152 for {set j 0} {$j < $i} {incr j} {
11153 set b [lindex $tags $j]
11154 set r [anc_or_desc $a $b]
11155 if {$r == -1} {
11156 set tags [lreplace $tags $j $j]
11157 incr j -1
11158 incr i -1
11159 } elseif {$r == 1} {
11160 set tags [lreplace $tags $i $i]
11161 incr i -1
11162 break
11163 }
11164 }
e11f1233
PM
11165 }
11166
11167 if {[array names growing] ne {}} {
e244588e
DL
11168 # graph isn't finished, need to check if any tag could get
11169 # eclipsed by another tag coming later. Simply ignore any
11170 # tags that could later get eclipsed.
11171 set ctags {}
11172 foreach t $tags {
11173 if {[is_certain $origid $t]} {
11174 lappend ctags $t
11175 }
11176 }
11177 if {$tags eq $ctags} {
11178 set cached_atags($origid) $tags
11179 } else {
11180 set tags $ctags
11181 }
e11f1233 11182 } else {
e244588e 11183 set cached_atags($origid) $tags
e11f1233
PM
11184 }
11185 set t3 [clock clicks -milliseconds]
11186 if {0 && $t3 - $t1 >= 100} {
e244588e
DL
11187 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11188 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
d6ac1a86 11189 }
e11f1233 11190 return $tags
d6ac1a86
PM
11191}
11192
e11f1233
PM
11193# Return the list of IDs that have heads that are descendents of id,
11194# including id itself if it has a head.
11195proc descheads {id} {
11196 global arcnos arcstart arcids archeads idheads cached_dheads
d809fb17 11197 global allparents arcout
ca6d8f58 11198
e11f1233 11199 if {![info exists allparents($id)]} {
e244588e 11200 return {}
e11f1233 11201 }
f3326b66 11202 set aret {}
d809fb17 11203 if {![info exists arcout($id)]} {
e244588e
DL
11204 # part-way along an arc; check it first
11205 set a [lindex $arcnos($id) 0]
11206 if {$archeads($a) ne {}} {
11207 validate_archeads $a
11208 set i [lsearch -exact $arcids($a) $id]
11209 foreach t $archeads($a) {
11210 set j [lsearch -exact $arcids($a) $t]
11211 if {$j > $i} break
11212 lappend aret $t
11213 }
11214 }
11215 set id $arcstart($a)
ca6d8f58 11216 }
e11f1233
PM
11217 set origid $id
11218 set todo [list $id]
11219 set seen($id) 1
f3326b66 11220 set ret {}
e11f1233 11221 for {set i 0} {$i < [llength $todo]} {incr i} {
e244588e
DL
11222 set id [lindex $todo $i]
11223 if {[info exists cached_dheads($id)]} {
11224 set ret [concat $ret $cached_dheads($id)]
11225 } else {
11226 if {[info exists idheads($id)]} {
11227 lappend ret $id
11228 }
11229 foreach a $arcnos($id) {
11230 if {$archeads($a) ne {}} {
11231 validate_archeads $a
11232 if {$archeads($a) ne {}} {
11233 set ret [concat $ret $archeads($a)]
11234 }
11235 }
11236 set d $arcstart($a)
11237 if {![info exists seen($d)]} {
11238 lappend todo $d
11239 set seen($d) 1
11240 }
11241 }
11242 }
10299152 11243 }
e11f1233
PM
11244 set ret [lsort -unique $ret]
11245 set cached_dheads($origid) $ret
f3326b66 11246 return [concat $ret $aret]
10299152
PM
11247}
11248
e11f1233
PM
11249proc addedtag {id} {
11250 global arcnos arcout cached_dtags cached_atags
ca6d8f58 11251
e11f1233
PM
11252 if {![info exists arcnos($id)]} return
11253 if {![info exists arcout($id)]} {
e244588e 11254 recalcarc [lindex $arcnos($id) 0]
ca6d8f58 11255 }
009409fe
PM
11256 unset -nocomplain cached_dtags
11257 unset -nocomplain cached_atags
ca6d8f58
PM
11258}
11259
e11f1233
PM
11260proc addedhead {hid head} {
11261 global arcnos arcout cached_dheads
11262
11263 if {![info exists arcnos($hid)]} return
11264 if {![info exists arcout($hid)]} {
e244588e 11265 recalcarc [lindex $arcnos($hid) 0]
e11f1233 11266 }
009409fe 11267 unset -nocomplain cached_dheads
e11f1233
PM
11268}
11269
11270proc removedhead {hid head} {
11271 global cached_dheads
11272
009409fe 11273 unset -nocomplain cached_dheads
e11f1233
PM
11274}
11275
11276proc movedhead {hid head} {
11277 global arcnos arcout cached_dheads
cec7bece 11278
e11f1233
PM
11279 if {![info exists arcnos($hid)]} return
11280 if {![info exists arcout($hid)]} {
e244588e 11281 recalcarc [lindex $arcnos($hid) 0]
cec7bece 11282 }
009409fe 11283 unset -nocomplain cached_dheads
e11f1233
PM
11284}
11285
11286proc changedrefs {} {
587277fe 11287 global cached_dheads cached_dtags cached_atags cached_tagcontent
e11f1233
PM
11288 global arctags archeads arcnos arcout idheads idtags
11289
11290 foreach id [concat [array names idheads] [array names idtags]] {
e244588e
DL
11291 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11292 set a [lindex $arcnos($id) 0]
11293 if {![info exists donearc($a)]} {
11294 recalcarc $a
11295 set donearc($a) 1
11296 }
11297 }
cec7bece 11298 }
009409fe
PM
11299 unset -nocomplain cached_tagcontent
11300 unset -nocomplain cached_dtags
11301 unset -nocomplain cached_atags
11302 unset -nocomplain cached_dheads
cec7bece
PM
11303}
11304
f1d83ba3 11305proc rereadrefs {} {
fc2a256f 11306 global idtags idheads idotherrefs mainheadid
f1d83ba3
PM
11307
11308 set refids [concat [array names idtags] \
e244588e 11309 [array names idheads] [array names idotherrefs]]
f1d83ba3 11310 foreach id $refids {
e244588e
DL
11311 if {![info exists ref($id)]} {
11312 set ref($id) [listrefs $id]
11313 }
f1d83ba3 11314 }
fc2a256f 11315 set oldmainhead $mainheadid
f1d83ba3 11316 readrefs
cec7bece 11317 changedrefs
f1d83ba3 11318 set refids [lsort -unique [concat $refids [array names idtags] \
e244588e 11319 [array names idheads] [array names idotherrefs]]]
f1d83ba3 11320 foreach id $refids {
e244588e
DL
11321 set v [listrefs $id]
11322 if {![info exists ref($id)] || $ref($id) != $v} {
11323 redrawtags $id
11324 }
f1d83ba3 11325 }
c11ff120 11326 if {$oldmainhead ne $mainheadid} {
e244588e
DL
11327 redrawtags $oldmainhead
11328 redrawtags $mainheadid
c11ff120 11329 }
887c996e 11330 run refill_reflist
f1d83ba3
PM
11331}
11332
2e1ded44
JH
11333proc listrefs {id} {
11334 global idtags idheads idotherrefs
11335
11336 set x {}
11337 if {[info exists idtags($id)]} {
e244588e 11338 set x $idtags($id)
2e1ded44
JH
11339 }
11340 set y {}
11341 if {[info exists idheads($id)]} {
e244588e 11342 set y $idheads($id)
2e1ded44
JH
11343 }
11344 set z {}
11345 if {[info exists idotherrefs($id)]} {
e244588e 11346 set z $idotherrefs($id)
2e1ded44
JH
11347 }
11348 return [list $x $y $z]
11349}
11350
4399fe33
PM
11351proc add_tag_ctext {tag} {
11352 global ctext cached_tagcontent tagids
11353
11354 if {![info exists cached_tagcontent($tag)]} {
e244588e
DL
11355 catch {
11356 set cached_tagcontent($tag) [exec git cat-file -p $tag]
11357 }
4399fe33
PM
11358 }
11359 $ctext insert end "[mc "Tag"]: $tag\n" bold
11360 if {[info exists cached_tagcontent($tag)]} {
e244588e 11361 set text $cached_tagcontent($tag)
4399fe33 11362 } else {
e244588e 11363 set text "[mc "Id"]: $tagids($tag)"
4399fe33
PM
11364 }
11365 appendwithlinks $text {}
11366}
11367
106288cb 11368proc showtag {tag isnew} {
587277fe 11369 global ctext cached_tagcontent tagids linknum tagobjid
106288cb
PM
11370
11371 if {$isnew} {
e244588e 11372 addtohistory [list showtag $tag 0] savectextpos
106288cb
PM
11373 }
11374 $ctext conf -state normal
3ea06f9f 11375 clear_ctext
32f1b3e4 11376 settabs 0
106288cb 11377 set linknum 0
4399fe33
PM
11378 add_tag_ctext $tag
11379 maybe_scroll_ctext 1
11380 $ctext conf -state disabled
11381 init_flist {}
11382}
11383
11384proc showtags {id isnew} {
11385 global idtags ctext linknum
11386
11387 if {$isnew} {
e244588e 11388 addtohistory [list showtags $id 0] savectextpos
62d3ea65 11389 }
4399fe33
PM
11390 $ctext conf -state normal
11391 clear_ctext
11392 settabs 0
11393 set linknum 0
11394 set sep {}
11395 foreach tag $idtags($id) {
e244588e
DL
11396 $ctext insert end $sep
11397 add_tag_ctext $tag
11398 set sep "\n\n"
106288cb 11399 }
a80e82f6 11400 maybe_scroll_ctext 1
106288cb 11401 $ctext conf -state disabled
7fcceed7 11402 init_flist {}
106288cb
PM
11403}
11404
1d10f36d
PM
11405proc doquit {} {
11406 global stopped
314f5de1
TA
11407 global gitktmpdir
11408
1d10f36d 11409 set stopped 100
b6047c5a 11410 savestuff .
1d10f36d 11411 destroy .
314f5de1
TA
11412
11413 if {[info exists gitktmpdir]} {
e244588e 11414 catch {file delete -force $gitktmpdir}
314f5de1 11415 }
1d10f36d 11416}
1db95b00 11417
9a7558f3 11418proc mkfontdisp {font top which} {
d93f1713 11419 global fontattr fontpref $font NS use_ttk
9a7558f3
PM
11420
11421 set fontpref($font) [set $font]
d93f1713 11422 ${NS}::button $top.${font}but -text $which \
e244588e 11423 -command [list choosefont $font $which]
d93f1713 11424 ${NS}::label $top.$font -relief flat -font $font \
e244588e 11425 -text $fontattr($font,family) -justify left
9a7558f3
PM
11426 grid x $top.${font}but $top.$font -sticky w
11427}
11428
11429proc choosefont {font which} {
11430 global fontparam fontlist fonttop fontattr
d93f1713 11431 global prefstop NS
9a7558f3
PM
11432
11433 set fontparam(which) $which
11434 set fontparam(font) $font
11435 set fontparam(family) [font actual $font -family]
11436 set fontparam(size) $fontattr($font,size)
11437 set fontparam(weight) $fontattr($font,weight)
11438 set fontparam(slant) $fontattr($font,slant)
11439 set top .gitkfont
11440 set fonttop $top
11441 if {![winfo exists $top]} {
e244588e
DL
11442 font create sample
11443 eval font config sample [font actual $font]
11444 ttk_toplevel $top
11445 make_transient $top $prefstop
11446 wm title $top [mc "Gitk font chooser"]
11447 ${NS}::label $top.l -textvariable fontparam(which)
11448 pack $top.l -side top
11449 set fontlist [lsort [font families]]
11450 ${NS}::frame $top.f
11451 listbox $top.f.fam -listvariable fontlist \
11452 -yscrollcommand [list $top.f.sb set]
11453 bind $top.f.fam <<ListboxSelect>> selfontfam
11454 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11455 pack $top.f.sb -side right -fill y
11456 pack $top.f.fam -side left -fill both -expand 1
11457 pack $top.f -side top -fill both -expand 1
11458 ${NS}::frame $top.g
11459 spinbox $top.g.size -from 4 -to 40 -width 4 \
11460 -textvariable fontparam(size) \
11461 -validatecommand {string is integer -strict %s}
11462 checkbutton $top.g.bold -padx 5 \
11463 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11464 -variable fontparam(weight) -onvalue bold -offvalue normal
11465 checkbutton $top.g.ital -padx 5 \
11466 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
11467 -variable fontparam(slant) -onvalue italic -offvalue roman
11468 pack $top.g.size $top.g.bold $top.g.ital -side left
11469 pack $top.g -side top
11470 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11471 -background white
11472 $top.c create text 100 25 -anchor center -text $which -font sample \
11473 -fill black -tags text
11474 bind $top.c <Configure> [list centertext $top.c]
11475 pack $top.c -side top -fill x
11476 ${NS}::frame $top.buts
11477 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11478 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11479 bind $top <Key-Return> fontok
11480 bind $top <Key-Escape> fontcan
11481 grid $top.buts.ok $top.buts.can
11482 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11483 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11484 pack $top.buts -side bottom -fill x
11485 trace add variable fontparam write chg_fontparam
9a7558f3 11486 } else {
e244588e
DL
11487 raise $top
11488 $top.c itemconf text -text $which
9a7558f3
PM
11489 }
11490 set i [lsearch -exact $fontlist $fontparam(family)]
11491 if {$i >= 0} {
e244588e
DL
11492 $top.f.fam selection set $i
11493 $top.f.fam see $i
9a7558f3
PM
11494 }
11495}
11496
11497proc centertext {w} {
11498 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11499}
11500
11501proc fontok {} {
11502 global fontparam fontpref prefstop
11503
11504 set f $fontparam(font)
11505 set fontpref($f) [list $fontparam(family) $fontparam(size)]
11506 if {$fontparam(weight) eq "bold"} {
e244588e 11507 lappend fontpref($f) "bold"
9a7558f3
PM
11508 }
11509 if {$fontparam(slant) eq "italic"} {
e244588e 11510 lappend fontpref($f) "italic"
9a7558f3 11511 }
39ddf99c 11512 set w $prefstop.notebook.fonts.$f
9a7558f3 11513 $w conf -text $fontparam(family) -font $fontpref($f)
d93f1713 11514
9a7558f3
PM
11515 fontcan
11516}
11517
11518proc fontcan {} {
11519 global fonttop fontparam
11520
11521 if {[info exists fonttop]} {
e244588e
DL
11522 catch {destroy $fonttop}
11523 catch {font delete sample}
11524 unset fonttop
11525 unset fontparam
9a7558f3
PM
11526 }
11527}
11528
d93f1713
PT
11529if {[package vsatisfies [package provide Tk] 8.6]} {
11530 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11531 # function to make use of it.
11532 proc choosefont {font which} {
e244588e
DL
11533 tk fontchooser configure -title $which -font $font \
11534 -command [list on_choosefont $font $which]
11535 tk fontchooser show
d93f1713
PT
11536 }
11537 proc on_choosefont {font which newfont} {
e244588e
DL
11538 global fontparam
11539 puts stderr "$font $newfont"
11540 array set f [font actual $newfont]
11541 set fontparam(which) $which
11542 set fontparam(font) $font
11543 set fontparam(family) $f(-family)
11544 set fontparam(size) $f(-size)
11545 set fontparam(weight) $f(-weight)
11546 set fontparam(slant) $f(-slant)
11547 fontok
d93f1713
PT
11548 }
11549}
11550
9a7558f3
PM
11551proc selfontfam {} {
11552 global fonttop fontparam
11553
11554 set i [$fonttop.f.fam curselection]
11555 if {$i ne {}} {
e244588e 11556 set fontparam(family) [$fonttop.f.fam get $i]
9a7558f3
PM
11557 }
11558}
11559
11560proc chg_fontparam {v sub op} {
11561 global fontparam
11562
11563 font config sample -$sub $fontparam($sub)
11564}
11565
44acce0b
PT
11566# Create a property sheet tab page
11567proc create_prefs_page {w} {
11568 global NS
11569 set parent [join [lrange [split $w .] 0 end-1] .]
11570 if {[winfo class $parent] eq "TNotebook"} {
e244588e 11571 ${NS}::frame $w
44acce0b 11572 } else {
e244588e 11573 ${NS}::labelframe $w
44acce0b
PT
11574 }
11575}
11576
11577proc prefspage_general {notebook} {
11578 global NS maxwidth maxgraphpct showneartags showlocalchanges
11579 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
3441de5b 11580 global hideremotes want_ttk have_ttk maxrefs web_browser
44acce0b
PT
11581
11582 set page [create_prefs_page $notebook.general]
11583
11584 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11585 grid $page.ldisp - -sticky w -pady 10
11586 ${NS}::label $page.spacer -text " "
11587 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11588 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11589 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
8a1692f6 11590 #xgettext:no-tcl-format
44acce0b
PT
11591 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11592 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11593 grid x $page.maxpctl $page.maxpct -sticky w
11594 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
e244588e 11595 -variable showlocalchanges
44acce0b
PT
11596 grid x $page.showlocal -sticky w
11597 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
e244588e 11598 -variable autoselect
44acce0b
PT
11599 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11600 grid x $page.autoselect $page.autosellen -sticky w
11601 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
e244588e 11602 -variable hideremotes
44acce0b
PT
11603 grid x $page.hideremotes -sticky w
11604
11605 ${NS}::label $page.ddisp -text [mc "Diff display options"]
11606 grid $page.ddisp - -sticky w -pady 10
11607 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11608 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11609 grid x $page.tabstopl $page.tabstop -sticky w
d34835c9 11610 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
e244588e 11611 -variable showneartags
44acce0b 11612 grid x $page.ntag -sticky w
d34835c9
PM
11613 ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11614 spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11615 grid x $page.maxrefsl $page.maxrefs -sticky w
44acce0b 11616 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
e244588e 11617 -variable limitdiffs
44acce0b
PT
11618 grid x $page.ldiff -sticky w
11619 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
e244588e 11620 -variable perfile_attrs
44acce0b
PT
11621 grid x $page.lattr -sticky w
11622
11623 ${NS}::entry $page.extdifft -textvariable extdifftool
11624 ${NS}::frame $page.extdifff
11625 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11626 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11627 pack $page.extdifff.l $page.extdifff.b -side left
11628 pack configure $page.extdifff.l -padx 10
11629 grid x $page.extdifff $page.extdifft -sticky ew
11630
3441de5b
PM
11631 ${NS}::entry $page.webbrowser -textvariable web_browser
11632 ${NS}::frame $page.webbrowserf
11633 ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11634 pack $page.webbrowserf.l -side left
11635 pack configure $page.webbrowserf.l -padx 10
11636 grid x $page.webbrowserf $page.webbrowser -sticky ew
11637
44acce0b
PT
11638 ${NS}::label $page.lgen -text [mc "General options"]
11639 grid $page.lgen - -sticky w -pady 10
11640 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
e244588e 11641 -text [mc "Use themed widgets"]
44acce0b 11642 if {$have_ttk} {
e244588e 11643 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
44acce0b 11644 } else {
e244588e 11645 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
44acce0b
PT
11646 }
11647 grid x $page.want_ttk $page.ttk_note -sticky w
11648 return $page
11649}
11650
11651proc prefspage_colors {notebook} {
11652 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
113ce124 11653 global diffbgcolors
44acce0b
PT
11654
11655 set page [create_prefs_page $notebook.colors]
11656
11657 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11658 grid $page.cdisp - -sticky w -pady 10
11659 label $page.ui -padx 40 -relief sunk -background $uicolor
11660 ${NS}::button $page.uibut -text [mc "Interface"] \
11661 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11662 grid x $page.uibut $page.ui -sticky w
11663 label $page.bg -padx 40 -relief sunk -background $bgcolor
11664 ${NS}::button $page.bgbut -text [mc "Background"] \
e244588e 11665 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
44acce0b
PT
11666 grid x $page.bgbut $page.bg -sticky w
11667 label $page.fg -padx 40 -relief sunk -background $fgcolor
11668 ${NS}::button $page.fgbut -text [mc "Foreground"] \
e244588e 11669 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
44acce0b
PT
11670 grid x $page.fgbut $page.fg -sticky w
11671 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11672 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
e244588e
DL
11673 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11674 [list $ctext tag conf d0 -foreground]]
44acce0b 11675 grid x $page.diffoldbut $page.diffold -sticky w
113ce124
SD
11676 label $page.diffoldbg -padx 40 -relief sunk -background [lindex $diffbgcolors 0]
11677 ${NS}::button $page.diffoldbgbut -text [mc "Diff: old lines bg"] \
e244588e
DL
11678 -command [list choosecolor diffbgcolors 0 $page.diffoldbg \
11679 [mc "diff old lines bg"] \
11680 [list $ctext tag conf d0 -background]]
113ce124 11681 grid x $page.diffoldbgbut $page.diffoldbg -sticky w
44acce0b
PT
11682 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11683 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
e244588e
DL
11684 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11685 [list $ctext tag conf dresult -foreground]]
44acce0b 11686 grid x $page.diffnewbut $page.diffnew -sticky w
113ce124
SD
11687 label $page.diffnewbg -padx 40 -relief sunk -background [lindex $diffbgcolors 1]
11688 ${NS}::button $page.diffnewbgbut -text [mc "Diff: new lines bg"] \
e244588e
DL
11689 -command [list choosecolor diffbgcolors 1 $page.diffnewbg \
11690 [mc "diff new lines bg"] \
11691 [list $ctext tag conf dresult -background]]
113ce124 11692 grid x $page.diffnewbgbut $page.diffnewbg -sticky w
44acce0b
PT
11693 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11694 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
e244588e
DL
11695 -command [list choosecolor diffcolors 2 $page.hunksep \
11696 [mc "diff hunk header"] \
11697 [list $ctext tag conf hunksep -foreground]]
44acce0b
PT
11698 grid x $page.hunksepbut $page.hunksep -sticky w
11699 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11700 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
e244588e
DL
11701 -command [list choosecolor markbgcolor {} $page.markbgsep \
11702 [mc "marked line background"] \
11703 [list $ctext tag conf omark -background]]
44acce0b
PT
11704 grid x $page.markbgbut $page.markbgsep -sticky w
11705 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11706 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
e244588e 11707 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
44acce0b
PT
11708 grid x $page.selbgbut $page.selbgsep -sticky w
11709 return $page
11710}
11711
11712proc prefspage_fonts {notebook} {
11713 global NS
11714 set page [create_prefs_page $notebook.fonts]
11715 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11716 grid $page.cfont - -sticky w -pady 10
11717 mkfontdisp mainfont $page [mc "Main font"]
11718 mkfontdisp textfont $page [mc "Diff display font"]
11719 mkfontdisp uifont $page [mc "User interface font"]
11720 return $page
11721}
11722
712fcc08 11723proc doprefs {} {
d93f1713 11724 global maxwidth maxgraphpct use_ttk NS
219ea3a9 11725 global oldprefs prefstop showneartags showlocalchanges
5497f7a2 11726 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
21ac8a8d 11727 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
0cc08ff7 11728 global hideremotes want_ttk have_ttk
232475d3 11729
712fcc08
PM
11730 set top .gitkprefs
11731 set prefstop $top
11732 if {[winfo exists $top]} {
e244588e
DL
11733 raise $top
11734 return
757f17bc 11735 }
3de07118 11736 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
e244588e
DL
11737 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11738 set oldprefs($v) [set $v]
232475d3 11739 }
d93f1713 11740 ttk_toplevel $top
d990cedf 11741 wm title $top [mc "Gitk preferences"]
e7d64008 11742 make_transient $top .
44acce0b
PT
11743
11744 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
e244588e 11745 set notebook [ttk::notebook $top.notebook]
0cc08ff7 11746 } else {
e244588e 11747 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
44acce0b
PT
11748 }
11749
11750 lappend pages [prefspage_general $notebook] [mc "General"]
11751 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11752 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
28cb7074 11753 set col 0
44acce0b 11754 foreach {page title} $pages {
e244588e
DL
11755 if {$use_notebook} {
11756 $notebook add $page -text $title
11757 } else {
11758 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11759 -text $title -command [list raise $page]]
11760 $page configure -text $title
11761 grid $btn -row 0 -column [incr col] -sticky w
11762 grid $page -row 1 -column 0 -sticky news -columnspan 100
11763 }
44acce0b
PT
11764 }
11765
11766 if {!$use_notebook} {
e244588e
DL
11767 grid columnconfigure $notebook 0 -weight 1
11768 grid rowconfigure $notebook 1 -weight 1
11769 raise [lindex $pages 0]
44acce0b
PT
11770 }
11771
11772 grid $notebook -sticky news -padx 2 -pady 2
11773 grid rowconfigure $top 0 -weight 1
11774 grid columnconfigure $top 0 -weight 1
9a7558f3 11775
d93f1713
PT
11776 ${NS}::frame $top.buts
11777 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11778 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
76f15947
AG
11779 bind $top <Key-Return> prefsok
11780 bind $top <Key-Escape> prefscan
712fcc08
PM
11781 grid $top.buts.ok $top.buts.can
11782 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11783 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11784 grid $top.buts - - -pady 10 -sticky ew
d93f1713 11785 grid columnconfigure $top 2 -weight 1
44acce0b 11786 bind $top <Visibility> [list focus $top.buts.ok]
712fcc08
PM
11787}
11788
314f5de1
TA
11789proc choose_extdiff {} {
11790 global extdifftool
11791
b56e0a9a 11792 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
314f5de1 11793 if {$prog ne {}} {
e244588e 11794 set extdifftool $prog
314f5de1
TA
11795 }
11796}
11797
f8a2c0d1
PM
11798proc choosecolor {v vi w x cmd} {
11799 global $v
11800
11801 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
e244588e 11802 -title [mc "Gitk: choose color for %s" $x]]
f8a2c0d1
PM
11803 if {$c eq {}} return
11804 $w conf -background $c
11805 lset $v $vi $c
11806 eval $cmd $c
11807}
11808
60378c0c
ML
11809proc setselbg {c} {
11810 global bglist cflist
11811 foreach w $bglist {
e244588e
DL
11812 if {[winfo exists $w]} {
11813 $w configure -selectbackground $c
11814 }
60378c0c
ML
11815 }
11816 $cflist tag configure highlight \
e244588e 11817 -background [$cflist cget -selectbackground]
60378c0c
ML
11818 allcanvs itemconf secsel -fill $c
11819}
11820
51a7e8b6
PM
11821# This sets the background color and the color scheme for the whole UI.
11822# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11823# if we don't specify one ourselves, which makes the checkbuttons and
11824# radiobuttons look bad. This chooses white for selectColor if the
11825# background color is light, or black if it is dark.
5497f7a2 11826proc setui {c} {
2e58c944 11827 if {[tk windowingsystem] eq "win32"} { return }
51a7e8b6
PM
11828 set bg [winfo rgb . $c]
11829 set selc black
11830 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
e244588e 11831 set selc white
51a7e8b6
PM
11832 }
11833 tk_setPalette background $c selectColor $selc
5497f7a2
GR
11834}
11835
f8a2c0d1
PM
11836proc setbg {c} {
11837 global bglist
11838
11839 foreach w $bglist {
e244588e
DL
11840 if {[winfo exists $w]} {
11841 $w conf -background $c
11842 }
f8a2c0d1
PM
11843 }
11844}
11845
11846proc setfg {c} {
11847 global fglist canv
11848
11849 foreach w $fglist {
e244588e
DL
11850 if {[winfo exists $w]} {
11851 $w conf -foreground $c
11852 }
f8a2c0d1
PM
11853 }
11854 allcanvs itemconf text -fill $c
11855 $canv itemconf circle -outline $c
b9fdba7f 11856 $canv itemconf markid -outline $c
f8a2c0d1
PM
11857}
11858
712fcc08 11859proc prefscan {} {
94503918 11860 global oldprefs prefstop
712fcc08 11861
3de07118 11862 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
e244588e
DL
11863 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11864 global $v
11865 set $v $oldprefs($v)
712fcc08
PM
11866 }
11867 catch {destroy $prefstop}
11868 unset prefstop
9a7558f3 11869 fontcan
712fcc08
PM
11870}
11871
11872proc prefsok {} {
11873 global maxwidth maxgraphpct
219ea3a9 11874 global oldprefs prefstop showneartags showlocalchanges
9a7558f3 11875 global fontpref mainfont textfont uifont
39ee47ef 11876 global limitdiffs treediffs perfile_attrs
ffe15297 11877 global hideremotes
712fcc08
PM
11878
11879 catch {destroy $prefstop}
11880 unset prefstop
9a7558f3
PM
11881 fontcan
11882 set fontchanged 0
11883 if {$mainfont ne $fontpref(mainfont)} {
e244588e
DL
11884 set mainfont $fontpref(mainfont)
11885 parsefont mainfont $mainfont
11886 eval font configure mainfont [fontflags mainfont]
11887 eval font configure mainfontbold [fontflags mainfont 1]
11888 setcoords
11889 set fontchanged 1
9a7558f3
PM
11890 }
11891 if {$textfont ne $fontpref(textfont)} {
e244588e
DL
11892 set textfont $fontpref(textfont)
11893 parsefont textfont $textfont
11894 eval font configure textfont [fontflags textfont]
11895 eval font configure textfontbold [fontflags textfont 1]
9a7558f3
PM
11896 }
11897 if {$uifont ne $fontpref(uifont)} {
e244588e
DL
11898 set uifont $fontpref(uifont)
11899 parsefont uifont $uifont
11900 eval font configure uifont [fontflags uifont]
9a7558f3 11901 }
32f1b3e4 11902 settabs
219ea3a9 11903 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
e244588e
DL
11904 if {$showlocalchanges} {
11905 doshowlocalchanges
11906 } else {
11907 dohidelocalchanges
11908 }
219ea3a9 11909 }
39ee47ef 11910 if {$limitdiffs != $oldprefs(limitdiffs) ||
e244588e
DL
11911 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11912 # treediffs elements are limited by path;
11913 # won't have encodings cached if perfile_attrs was just turned on
11914 unset -nocomplain treediffs
74a40c71 11915 }
9a7558f3 11916 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
e244588e
DL
11917 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11918 redisplay
7a39a17a 11919 } elseif {$showneartags != $oldprefs(showneartags) ||
e244588e
DL
11920 $limitdiffs != $oldprefs(limitdiffs)} {
11921 reselectline
712fcc08 11922 }
ffe15297 11923 if {$hideremotes != $oldprefs(hideremotes)} {
e244588e 11924 rereadrefs
ffe15297 11925 }
712fcc08
PM
11926}
11927
11928proc formatdate {d} {
e8b5f4be 11929 global datetimeformat
219ea3a9 11930 if {$d ne {}} {
e244588e
DL
11931 # If $datetimeformat includes a timezone, display in the
11932 # timezone of the argument. Otherwise, display in local time.
11933 if {[string match {*%[zZ]*} $datetimeformat]} {
11934 if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11935 # Tcl < 8.5 does not support -timezone. Emulate it by
11936 # setting TZ (e.g. TZ=<-0430>+04:30).
11937 global env
11938 if {[info exists env(TZ)]} {
11939 set savedTZ $env(TZ)
11940 }
11941 set zone [lindex $d 1]
11942 set sign [string map {+ - - +} [string index $zone 0]]
11943 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11944 set d [clock format [lindex $d 0] -format $datetimeformat]
11945 if {[info exists savedTZ]} {
11946 set env(TZ) $savedTZ
11947 } else {
11948 unset env(TZ)
11949 }
11950 }
11951 } else {
11952 set d [clock format [lindex $d 0] -format $datetimeformat]
11953 }
219ea3a9
PM
11954 }
11955 return $d
232475d3
PM
11956}
11957
fd8ccbec 11958# This list of encoding names and aliases is distilled from
d05b08cd 11959# https://www.iana.org/assignments/character-sets.
fd8ccbec
PM
11960# Not all of them are supported by Tcl.
11961set encoding_aliases {
11962 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11963 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11964 { ISO-10646-UTF-1 csISO10646UTF1 }
11965 { ISO_646.basic:1983 ref csISO646basic1983 }
11966 { INVARIANT csINVARIANT }
11967 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11968 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11969 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11970 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11971 { NATS-DANO iso-ir-9-1 csNATSDANO }
11972 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11973 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11974 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11975 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11976 { ISO-2022-KR csISO2022KR }
11977 { EUC-KR csEUCKR }
11978 { ISO-2022-JP csISO2022JP }
11979 { ISO-2022-JP-2 csISO2022JP2 }
11980 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11981 csISO13JISC6220jp }
11982 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11983 { IT iso-ir-15 ISO646-IT csISO15Italian }
11984 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11985 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11986 { greek7-old iso-ir-18 csISO18Greek7Old }
11987 { latin-greek iso-ir-19 csISO19LatinGreek }
11988 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11989 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11990 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11991 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11992 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11993 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11994 { INIS iso-ir-49 csISO49INIS }
11995 { INIS-8 iso-ir-50 csISO50INIS8 }
11996 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11997 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11998 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11999 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
12000 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
12001 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
12002 csISO60Norwegian1 }
12003 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
12004 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
12005 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
12006 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
12007 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
12008 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
12009 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
12010 { greek7 iso-ir-88 csISO88Greek7 }
12011 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
12012 { iso-ir-90 csISO90 }
12013 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
12014 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
12015 csISO92JISC62991984b }
12016 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
12017 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
12018 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
12019 csISO95JIS62291984handadd }
12020 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
12021 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
12022 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
12023 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
12024 CP819 csISOLatin1 }
12025 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
12026 { T.61-7bit iso-ir-102 csISO102T617bit }
12027 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
12028 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
12029 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
12030 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
12031 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
12032 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
12033 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
12034 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
12035 arabic csISOLatinArabic }
12036 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
12037 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
12038 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
12039 greek greek8 csISOLatinGreek }
12040 { T.101-G2 iso-ir-128 csISO128T101G2 }
12041 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
12042 csISOLatinHebrew }
12043 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
12044 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
12045 { CSN_369103 iso-ir-139 csISO139CSN369103 }
12046 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
12047 { ISO_6937-2-add iso-ir-142 csISOTextComm }
12048 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
12049 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
12050 csISOLatinCyrillic }
12051 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
12052 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
12053 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
12054 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
12055 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
12056 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
12057 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
12058 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
12059 { ISO_10367-box iso-ir-155 csISO10367Box }
12060 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
12061 { latin-lap lap iso-ir-158 csISO158Lap }
12062 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
12063 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
12064 { us-dk csUSDK }
12065 { dk-us csDKUS }
12066 { JIS_X0201 X0201 csHalfWidthKatakana }
12067 { KSC5636 ISO646-KR csKSC5636 }
12068 { ISO-10646-UCS-2 csUnicode }
12069 { ISO-10646-UCS-4 csUCS4 }
12070 { DEC-MCS dec csDECMCS }
12071 { hp-roman8 roman8 r8 csHPRoman8 }
12072 { macintosh mac csMacintosh }
12073 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12074 csIBM037 }
12075 { IBM038 EBCDIC-INT cp038 csIBM038 }
12076 { IBM273 CP273 csIBM273 }
12077 { IBM274 EBCDIC-BE CP274 csIBM274 }
12078 { IBM275 EBCDIC-BR cp275 csIBM275 }
12079 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12080 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12081 { IBM280 CP280 ebcdic-cp-it csIBM280 }
12082 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12083 { IBM284 CP284 ebcdic-cp-es csIBM284 }
12084 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12085 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12086 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12087 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12088 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12089 { IBM424 cp424 ebcdic-cp-he csIBM424 }
12090 { IBM437 cp437 437 csPC8CodePage437 }
12091 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12092 { IBM775 cp775 csPC775Baltic }
12093 { IBM850 cp850 850 csPC850Multilingual }
12094 { IBM851 cp851 851 csIBM851 }
12095 { IBM852 cp852 852 csPCp852 }
12096 { IBM855 cp855 855 csIBM855 }
12097 { IBM857 cp857 857 csIBM857 }
12098 { IBM860 cp860 860 csIBM860 }
12099 { IBM861 cp861 861 cp-is csIBM861 }
12100 { IBM862 cp862 862 csPC862LatinHebrew }
12101 { IBM863 cp863 863 csIBM863 }
12102 { IBM864 cp864 csIBM864 }
12103 { IBM865 cp865 865 csIBM865 }
12104 { IBM866 cp866 866 csIBM866 }
12105 { IBM868 CP868 cp-ar csIBM868 }
12106 { IBM869 cp869 869 cp-gr csIBM869 }
12107 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12108 { IBM871 CP871 ebcdic-cp-is csIBM871 }
12109 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12110 { IBM891 cp891 csIBM891 }
12111 { IBM903 cp903 csIBM903 }
12112 { IBM904 cp904 904 csIBBM904 }
12113 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12114 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12115 { IBM1026 CP1026 csIBM1026 }
12116 { EBCDIC-AT-DE csIBMEBCDICATDE }
12117 { EBCDIC-AT-DE-A csEBCDICATDEA }
12118 { EBCDIC-CA-FR csEBCDICCAFR }
12119 { EBCDIC-DK-NO csEBCDICDKNO }
12120 { EBCDIC-DK-NO-A csEBCDICDKNOA }
12121 { EBCDIC-FI-SE csEBCDICFISE }
12122 { EBCDIC-FI-SE-A csEBCDICFISEA }
12123 { EBCDIC-FR csEBCDICFR }
12124 { EBCDIC-IT csEBCDICIT }
12125 { EBCDIC-PT csEBCDICPT }
12126 { EBCDIC-ES csEBCDICES }
12127 { EBCDIC-ES-A csEBCDICESA }
12128 { EBCDIC-ES-S csEBCDICESS }
12129 { EBCDIC-UK csEBCDICUK }
12130 { EBCDIC-US csEBCDICUS }
12131 { UNKNOWN-8BIT csUnknown8BiT }
12132 { MNEMONIC csMnemonic }
12133 { MNEM csMnem }
12134 { VISCII csVISCII }
12135 { VIQR csVIQR }
12136 { KOI8-R csKOI8R }
12137 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12138 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12139 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12140 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12141 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12142 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12143 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12144 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12145 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12146 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12147 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12148 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12149 { IBM1047 IBM-1047 }
12150 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12151 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12152 { UNICODE-1-1 csUnicode11 }
12153 { CESU-8 csCESU-8 }
12154 { BOCU-1 csBOCU-1 }
12155 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12156 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12157 l8 }
12158 { ISO-8859-15 ISO_8859-15 Latin-9 }
12159 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12160 { GBK CP936 MS936 windows-936 }
12161 { JIS_Encoding csJISEncoding }
09c7029d 12162 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
fd8ccbec
PM
12163 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12164 EUC-JP }
12165 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12166 { ISO-10646-UCS-Basic csUnicodeASCII }
12167 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12168 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12169 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12170 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12171 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12172 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12173 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12174 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12175 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12176 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12177 { Adobe-Standard-Encoding csAdobeStandardEncoding }
12178 { Ventura-US csVenturaUS }
12179 { Ventura-International csVenturaInternational }
12180 { PC8-Danish-Norwegian csPC8DanishNorwegian }
12181 { PC8-Turkish csPC8Turkish }
12182 { IBM-Symbols csIBMSymbols }
12183 { IBM-Thai csIBMThai }
12184 { HP-Legal csHPLegal }
12185 { HP-Pi-font csHPPiFont }
12186 { HP-Math8 csHPMath8 }
12187 { Adobe-Symbol-Encoding csHPPSMath }
12188 { HP-DeskTop csHPDesktop }
12189 { Ventura-Math csVenturaMath }
12190 { Microsoft-Publishing csMicrosoftPublishing }
12191 { Windows-31J csWindows31J }
12192 { GB2312 csGB2312 }
12193 { Big5 csBig5 }
12194}
12195
12196proc tcl_encoding {enc} {
39ee47ef
PM
12197 global encoding_aliases tcl_encoding_cache
12198 if {[info exists tcl_encoding_cache($enc)]} {
e244588e 12199 return $tcl_encoding_cache($enc)
39ee47ef 12200 }
fd8ccbec
PM
12201 set names [encoding names]
12202 set lcnames [string tolower $names]
12203 set enc [string tolower $enc]
12204 set i [lsearch -exact $lcnames $enc]
12205 if {$i < 0} {
e244588e
DL
12206 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12207 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12208 set i [lsearch -exact $lcnames $encx]
12209 }
fd8ccbec
PM
12210 }
12211 if {$i < 0} {
e244588e
DL
12212 foreach l $encoding_aliases {
12213 set ll [string tolower $l]
12214 if {[lsearch -exact $ll $enc] < 0} continue
12215 # look through the aliases for one that tcl knows about
12216 foreach e $ll {
12217 set i [lsearch -exact $lcnames $e]
12218 if {$i < 0} {
12219 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12220 set i [lsearch -exact $lcnames $ex]
12221 }
12222 }
12223 if {$i >= 0} break
12224 }
12225 break
12226 }
fd8ccbec 12227 }
39ee47ef 12228 set tclenc {}
fd8ccbec 12229 if {$i >= 0} {
e244588e 12230 set tclenc [lindex $names $i]
fd8ccbec 12231 }
39ee47ef
PM
12232 set tcl_encoding_cache($enc) $tclenc
12233 return $tclenc
fd8ccbec
PM
12234}
12235
09c7029d 12236proc gitattr {path attr default} {
39ee47ef
PM
12237 global path_attr_cache
12238 if {[info exists path_attr_cache($attr,$path)]} {
e244588e 12239 set r $path_attr_cache($attr,$path)
39ee47ef 12240 } else {
e244588e
DL
12241 set r "unspecified"
12242 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12243 regexp "(.*): $attr: (.*)" $line m f r
12244 }
12245 set path_attr_cache($attr,$path) $r
39ee47ef
PM
12246 }
12247 if {$r eq "unspecified"} {
e244588e 12248 return $default
39ee47ef
PM
12249 }
12250 return $r
09c7029d
AG
12251}
12252
4db09304 12253proc cache_gitattr {attr pathlist} {
39ee47ef
PM
12254 global path_attr_cache
12255 set newlist {}
12256 foreach path $pathlist {
e244588e
DL
12257 if {![info exists path_attr_cache($attr,$path)]} {
12258 lappend newlist $path
12259 }
39ee47ef
PM
12260 }
12261 set lim 1000
12262 if {[tk windowingsystem] == "win32"} {
e244588e
DL
12263 # windows has a 32k limit on the arguments to a command...
12264 set lim 30
39ee47ef
PM
12265 }
12266 while {$newlist ne {}} {
e244588e
DL
12267 set head [lrange $newlist 0 [expr {$lim - 1}]]
12268 set newlist [lrange $newlist $lim end]
12269 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12270 foreach row [split $rlist "\n"] {
12271 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12272 if {[string index $path 0] eq "\""} {
12273 set path [encoding convertfrom [lindex $path 0]]
12274 }
12275 set path_attr_cache($attr,$path) $value
12276 }
12277 }
12278 }
39ee47ef 12279 }
4db09304
AG
12280}
12281
09c7029d 12282proc get_path_encoding {path} {
39ee47ef
PM
12283 global gui_encoding perfile_attrs
12284 set tcl_enc $gui_encoding
12285 if {$path ne {} && $perfile_attrs} {
e244588e
DL
12286 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12287 if {$enc2 ne {}} {
12288 set tcl_enc $enc2
12289 }
39ee47ef
PM
12290 }
12291 return $tcl_enc
09c7029d
AG
12292}
12293
ef87a480
AH
12294## For msgcat loading, first locate the installation location.
12295if { [info exists ::env(GITK_MSGSDIR)] } {
12296 ## Msgsdir was manually set in the environment.
12297 set gitk_msgsdir $::env(GITK_MSGSDIR)
12298} else {
12299 ## Let's guess the prefix from argv0.
12300 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12301 set gitk_libdir [file join $gitk_prefix share gitk lib]
12302 set gitk_msgsdir [file join $gitk_libdir msgs]
12303 unset gitk_prefix
12304}
12305
12306## Internationalization (i18n) through msgcat and gettext. See
12307## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12308package require msgcat
12309namespace import ::msgcat::mc
12310## And eventually load the actual message catalog
12311::msgcat::mcload $gitk_msgsdir
12312
5d7589d4
PM
12313# First check that Tcl/Tk is recent enough
12314if {[catch {package require Tk 8.4} err]} {
ef87a480 12315 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
e244588e 12316 Gitk requires at least Tcl/Tk 8.4."]
5d7589d4
PM
12317 exit 1
12318}
12319
76bf6ff9
TS
12320# on OSX bring the current Wish process window to front
12321if {[tk windowingsystem] eq "aqua"} {
12322 exec osascript -e [format {
12323 tell application "System Events"
12324 set frontmost of processes whose unix id is %d to true
12325 end tell
12326 } [pid] ]
12327}
12328
0ae10357
AO
12329# Unset GIT_TRACE var if set
12330if { [info exists ::env(GIT_TRACE)] } {
12331 unset ::env(GIT_TRACE)
12332}
12333
1d10f36d 12334# defaults...
e203d1dc 12335set wrcomcmd "git diff-tree --stdin -p --pretty=email"
671bc153 12336
fd8ccbec 12337set gitencoding {}
671bc153 12338catch {
27cb61ca 12339 set gitencoding [exec git config --get i18n.commitencoding]
671bc153 12340}
590915da
AG
12341catch {
12342 set gitencoding [exec git config --get i18n.logoutputencoding]
12343}
671bc153 12344if {$gitencoding == ""} {
fd8ccbec
PM
12345 set gitencoding "utf-8"
12346}
12347set tclencoding [tcl_encoding $gitencoding]
12348if {$tclencoding == {}} {
12349 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
671bc153 12350}
1db95b00 12351
09c7029d
AG
12352set gui_encoding [encoding system]
12353catch {
39ee47ef
PM
12354 set enc [exec git config --get gui.encoding]
12355 if {$enc ne {}} {
e244588e
DL
12356 set tclenc [tcl_encoding $enc]
12357 if {$tclenc ne {}} {
12358 set gui_encoding $tclenc
12359 } else {
12360 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12361 }
39ee47ef 12362 }
09c7029d
AG
12363}
12364
b2b76d10
MK
12365set log_showroot true
12366catch {
12367 set log_showroot [exec git config --bool --get log.showroot]
12368}
12369
5fdcbb13
DS
12370if {[tk windowingsystem] eq "aqua"} {
12371 set mainfont {{Lucida Grande} 9}
12372 set textfont {Monaco 9}
12373 set uifont {{Lucida Grande} 9 bold}
5c9096f7
JN
12374} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12375 # fontconfig!
12376 set mainfont {sans 9}
12377 set textfont {monospace 9}
12378 set uifont {sans 9 bold}
5fdcbb13
DS
12379} else {
12380 set mainfont {Helvetica 9}
12381 set textfont {Courier 9}
12382 set uifont {Helvetica 9 bold}
12383}
7e12f1a6 12384set tabstop 8
b74fd579 12385set findmergefiles 0
8d858d1a 12386set maxgraphpct 50
f6075eba 12387set maxwidth 16
232475d3 12388set revlistorder 0
757f17bc 12389set fastdate 0
6e8c8707
PM
12390set uparrowlen 5
12391set downarrowlen 5
12392set mingaplen 100
f8b28a40 12393set cmitmode "patch"
f1b86294 12394set wrapcomment "none"
b8ab2e17 12395set showneartags 1
ffe15297 12396set hideremotes 0
0a4dd8b8 12397set maxrefs 20
bde4a0f9 12398set visiblerefs {"master"}
322a8cc9 12399set maxlinelen 200
219ea3a9 12400set showlocalchanges 1
7a39a17a 12401set limitdiffs 1
e8b5f4be 12402set datetimeformat "%Y-%m-%d %H:%M:%S"
95293b58 12403set autoselect 1
21ac8a8d 12404set autosellen 40
39ee47ef 12405set perfile_attrs 0
0cc08ff7 12406set want_ttk 1
1d10f36d 12407
5fdcbb13
DS
12408if {[tk windowingsystem] eq "aqua"} {
12409 set extdifftool "opendiff"
12410} else {
12411 set extdifftool "meld"
12412}
314f5de1 12413
6e8fda5f 12414set colors {"#00ff00" red blue magenta darkgrey brown orange}
1924d1bc
PT
12415if {[tk windowingsystem] eq "win32"} {
12416 set uicolor SystemButtonFace
252c52df
12417 set uifgcolor SystemButtonText
12418 set uifgdisabledcolor SystemDisabledText
1924d1bc 12419 set bgcolor SystemWindow
252c52df 12420 set fgcolor SystemWindowText
1924d1bc 12421 set selectbgcolor SystemHighlight
3441de5b 12422 set web_browser "cmd /c start"
1924d1bc
PT
12423} else {
12424 set uicolor grey85
252c52df
12425 set uifgcolor black
12426 set uifgdisabledcolor "#999"
1924d1bc
PT
12427 set bgcolor white
12428 set fgcolor black
12429 set selectbgcolor gray85
3441de5b 12430 if {[tk windowingsystem] eq "aqua"} {
e244588e 12431 set web_browser "open"
3441de5b 12432 } else {
e244588e 12433 set web_browser "xdg-open"
3441de5b 12434 }
1924d1bc 12435}
113ce124
SD
12436set diffcolors {"#c30000" "#009800" blue}
12437set diffbgcolors {"#fff3f3" "#f0fff0"}
890fae70 12438set diffcontext 3
6e8fda5f 12439set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
b9b86007 12440set ignorespace 0
ae4e3ff9 12441set worddiff ""
e3e901be 12442set markbgcolor "#e0e0ff"
1d10f36d 12443
6e8fda5f 12444set headbgcolor "#00ff00"
252c52df
12445set headfgcolor black
12446set headoutlinecolor black
12447set remotebgcolor #ffddaa
12448set tagbgcolor yellow
12449set tagfgcolor black
12450set tagoutlinecolor black
12451set reflinecolor black
12452set filesepbgcolor #aaaaaa
12453set filesepfgcolor black
12454set linehoverbgcolor #ffff80
12455set linehoverfgcolor black
12456set linehoveroutlinecolor black
12457set mainheadcirclecolor yellow
12458set workingfilescirclecolor red
6e8fda5f 12459set indexcirclecolor "#00ff00"
c11ff120 12460set circlecolors {white blue gray blue blue}
252c52df
12461set linkfgcolor blue
12462set circleoutlinecolor $fgcolor
12463set foundbgcolor yellow
12464set currentsearchhitbgcolor orange
c11ff120 12465
d277e89f
PM
12466# button for popping up context menus
12467if {[tk windowingsystem] eq "aqua"} {
12468 set ctxbut <Button-2>
12469} else {
12470 set ctxbut <Button-3>
12471}
12472
8f863398
AH
12473catch {
12474 # follow the XDG base directory specification by default. See
65175d9e 12475 # https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html
8f863398 12476 if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
e244588e
DL
12477 # XDG_CONFIG_HOME environment variable is set
12478 set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12479 set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
8f863398 12480 } else {
e244588e
DL
12481 # default XDG_CONFIG_HOME
12482 set config_file "~/.config/git/gitk"
12483 set config_file_tmp "~/.config/git/gitk-tmp"
8f863398
AH
12484 }
12485 if {![file exists $config_file]} {
e244588e
DL
12486 # for backward compatibility use the old config file if it exists
12487 if {[file exists "~/.gitk"]} {
12488 set config_file "~/.gitk"
12489 set config_file_tmp "~/.gitk-tmp"
12490 } elseif {![file exists [file dirname $config_file]]} {
12491 file mkdir [file dirname $config_file]
12492 }
8f863398
AH
12493 }
12494 source $config_file
12495}
eaf7e835 12496config_check_tmp_exists 50
1d10f36d 12497
9fabefb1
MK
12498set config_variables {
12499 mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12500 cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12501 hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12502 bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12503 markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12504 extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12505 remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12506 filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12507 linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
113ce124 12508 indexcirclecolor circlecolors linkfgcolor circleoutlinecolor diffbgcolors
3441de5b 12509 web_browser
9fabefb1 12510}
995f792b
MK
12511foreach var $config_variables {
12512 config_init_trace $var
12513 trace add variable $var write config_variable_change_cb
12514}
9fabefb1 12515
0ed1dd3c
PM
12516parsefont mainfont $mainfont
12517eval font create mainfont [fontflags mainfont]
12518eval font create mainfontbold [fontflags mainfont 1]
12519
12520parsefont textfont $textfont
12521eval font create textfont [fontflags textfont]
12522eval font create textfontbold [fontflags textfont 1]
12523
12524parsefont uifont $uifont
12525eval font create uifont [fontflags uifont]
17386066 12526
51a7e8b6 12527setui $uicolor
5497f7a2 12528
b039f0a6
PM
12529setoptions
12530
cdaee5db 12531# check that we can find a .git directory somewhere...
86e847bc 12532if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
d990cedf 12533 show_error {} . [mc "Cannot find a git repository here."]
6c87d60c
AR
12534 exit 1
12535}
cdaee5db 12536
39816d60
AG
12537set selecthead {}
12538set selectheadid {}
12539
1d10f36d 12540set revtreeargs {}
cdaee5db
PM
12541set cmdline_files {}
12542set i 0
2d480856 12543set revtreeargscmd {}
1d10f36d 12544foreach arg $argv {
2d480856 12545 switch -glob -- $arg {
e244588e
DL
12546 "" { }
12547 "--" {
12548 set cmdline_files [lrange $argv [expr {$i + 1}] end]
12549 break
12550 }
12551 "--select-commit=*" {
12552 set selecthead [string range $arg 16 end]
12553 }
12554 "--argscmd=*" {
12555 set revtreeargscmd [string range $arg 10 end]
12556 }
12557 default {
12558 lappend revtreeargs $arg
12559 }
1d10f36d 12560 }
cdaee5db 12561 incr i
1db95b00 12562}
1d10f36d 12563
39816d60
AG
12564if {$selecthead eq "HEAD"} {
12565 set selecthead {}
12566}
12567
cdaee5db 12568if {$i >= [llength $argv] && $revtreeargs ne {}} {
3ed31a81 12569 # no -- on command line, but some arguments (other than --argscmd)
098dd8a3 12570 if {[catch {
e244588e
DL
12571 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12572 set cmdline_files [split $f "\n"]
12573 set n [llength $cmdline_files]
12574 set revtreeargs [lrange $revtreeargs 0 end-$n]
12575 # Unfortunately git rev-parse doesn't produce an error when
12576 # something is both a revision and a filename. To be consistent
12577 # with git log and git rev-list, check revtreeargs for filenames.
12578 foreach arg $revtreeargs {
12579 if {[file exists $arg]} {
12580 show_error {} . [mc "Ambiguous argument '%s': both revision\
12581 and filename" $arg]
12582 exit 1
12583 }
12584 }
098dd8a3 12585 } err]} {
e244588e
DL
12586 # unfortunately we get both stdout and stderr in $err,
12587 # so look for "fatal:".
12588 set i [string first "fatal:" $err]
12589 if {$i > 0} {
12590 set err [string range $err [expr {$i + 6}] end]
12591 }
12592 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12593 exit 1
098dd8a3
PM
12594 }
12595}
12596
219ea3a9 12597set nullid "0000000000000000000000000000000000000000"
8f489363 12598set nullid2 "0000000000000000000000000000000000000001"
314f5de1 12599set nullfile "/dev/null"
8f489363 12600
32f1b3e4 12601set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
0cc08ff7
PM
12602if {![info exists have_ttk]} {
12603 set have_ttk [llength [info commands ::ttk::style]]
d93f1713 12604}
0cc08ff7 12605set use_ttk [expr {$have_ttk && $want_ttk}]
d93f1713 12606set NS [expr {$use_ttk ? "ttk" : ""}]
0cc08ff7 12607
6cb73c84
GB
12608if {$use_ttk} {
12609 setttkstyle
12610}
12611
7add5aff 12612regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
219ea3a9 12613
7defefb1
KS
12614set show_notes {}
12615if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12616 set show_notes "--show-notes"
12617}
12618
3878e636
ZJS
12619set appname "gitk"
12620
7eb3cb9c 12621set runq {}
d698206c
PM
12622set history {}
12623set historyindex 0
908c3585 12624set fh_serial 0
908c3585 12625set nhl_names {}
63b79191 12626set highlight_paths {}
687c8765 12627set findpattern {}
1902c270 12628set searchdirn -forwards
28593d3f
PM
12629set boldids {}
12630set boldnameids {}
a8d610a2 12631set diffelide {0 0}
4fb0fa19 12632set markingmatches 0
97645683 12633set linkentercount 0
0380081c
PM
12634set need_redisplay 0
12635set nrows_drawn 0
32f1b3e4 12636set firsttabstop 0
9f1afe05 12637
50b44ece
PM
12638set nextviewnum 1
12639set curview 0
a90a6d24 12640set selectedview 0
b007ee20
CS
12641set selectedhlview [mc "None"]
12642set highlight_related [mc "None"]
687c8765 12643set highlight_files {}
50b44ece 12644set viewfiles(0) {}
a90a6d24 12645set viewperm(0) 0
995f792b 12646set viewchanged(0) 0
098dd8a3 12647set viewargs(0) {}
2d480856 12648set viewargscmd(0) {}
50b44ece 12649
94b4a69f 12650set selectedline {}
6df7403a 12651set numcommits 0
7fcc92bf 12652set loginstance 0
098dd8a3 12653set cmdlineok 0
1d10f36d 12654set stopped 0
0fba86b3 12655set stuffsaved 0
74daedb6 12656set patchnum 0
219ea3a9 12657set lserial 0
74cb884f 12658set hasworktree [hasworktree]
c332f445 12659set cdup {}
74cb884f 12660if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
c332f445
MZ
12661 set cdup [exec git rev-parse --show-cdup]
12662}
e272a779 12663set worktree [gitworktree]
1d10f36d 12664setcoords
d94f8cd6 12665makewindow
37871b73
GB
12666catch {
12667 image create photo gitlogo -width 16 -height 16
12668
12669 image create photo gitlogominus -width 4 -height 2
12670 gitlogominus put #C00000 -to 0 0 4 2
12671 gitlogo copy gitlogominus -to 1 5
12672 gitlogo copy gitlogominus -to 6 5
12673 gitlogo copy gitlogominus -to 11 5
12674 image delete gitlogominus
12675
12676 image create photo gitlogoplus -width 4 -height 4
12677 gitlogoplus put #008000 -to 1 0 3 4
12678 gitlogoplus put #008000 -to 0 1 4 3
12679 gitlogo copy gitlogoplus -to 1 9
12680 gitlogo copy gitlogoplus -to 6 9
12681 gitlogo copy gitlogoplus -to 11 9
12682 image delete gitlogoplus
12683
d38d7d49
SB
12684 image create photo gitlogo32 -width 32 -height 32
12685 gitlogo32 copy gitlogo -zoom 2 2
12686
12687 wm iconphoto . -default gitlogo gitlogo32
37871b73 12688}
0eafba14
PM
12689# wait for the window to become visible
12690tkwait visibility .
9922c5a3 12691set_window_title
478afad6 12692update
887fe3c4 12693readrefs
a8aaf19c 12694
2d480856 12695if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
50b44ece
PM
12696 # create a view for the files/dirs specified on the command line
12697 set curview 1
a90a6d24 12698 set selectedview 1
50b44ece 12699 set nextviewnum 2
d990cedf 12700 set viewname(1) [mc "Command line"]
50b44ece 12701 set viewfiles(1) $cmdline_files
098dd8a3 12702 set viewargs(1) $revtreeargs
2d480856 12703 set viewargscmd(1) $revtreeargscmd
a90a6d24 12704 set viewperm(1) 0
995f792b 12705 set viewchanged(1) 0
3ed31a81 12706 set vdatemode(1) 0
da7c24dd 12707 addviewmenu 1
28de5685
BB
12708 .bar.view entryconf [mca "&Edit view..."] -state normal
12709 .bar.view entryconf [mca "&Delete view"] -state normal
50b44ece 12710}
a90a6d24
PM
12711
12712if {[info exists permviews]} {
12713 foreach v $permviews {
e244588e
DL
12714 set n $nextviewnum
12715 incr nextviewnum
12716 set viewname($n) [lindex $v 0]
12717 set viewfiles($n) [lindex $v 1]
12718 set viewargs($n) [lindex $v 2]
12719 set viewargscmd($n) [lindex $v 3]
12720 set viewperm($n) 1
12721 set viewchanged($n) 0
12722 addviewmenu $n
a90a6d24
PM
12723 }
12724}
e4df519f
JS
12725
12726if {[tk windowingsystem] eq "win32"} {
12727 focus -force .
12728}
12729
567c34e0 12730getcommits {}
adab0dab
PT
12731
12732# Local variables:
12733# mode: tcl
12734# indent-tabs-mode: t
12735# tab-width: 8
12736# End: