]> git.ipfire.org Git - thirdparty/git.git/blame - gitk
gitk: Highlight current search hit in orange
[thirdparty/git.git] / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
9e026d39 3exec wish "$0" -- "$@"
1db95b00 4
bb3e86a1 5# Copyright © 2005-2011 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" &&
14 [exec git rev-parse --is-inside-git-dir] == "false"}]
15}
16
3878e636
ZJS
17proc reponame {} {
18 global gitdir
19 set n [file normalize $gitdir]
20 if {[string match "*/.git" $n]} {
21 set n [string range $n 0 end-5]
22 }
23 return [file tail $n]
24}
25
65bb0bda
PT
26proc gitworktree {} {
27 variable _gitworktree
28 if {[info exists _gitworktree]} {
29 return $_gitworktree
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) }]} {
37 catch {set _gitworktree [exec git config --get core.worktree]}
38 if {$_gitworktree eq ""} {
39 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
40 }
41 }
42 }
43 return $_gitworktree
44}
45
7eb3cb9c
PM
46# A simple scheduler for compute-intensive stuff.
47# The aim is to make sure that event handlers for GUI actions can
48# run at least every 50-100 ms. Unfortunately fileevent handlers are
49# run before X event handlers, so reading from a fast source can
50# make the GUI completely unresponsive.
51proc run args {
df75e86d 52 global isonrunq runq currunq
7eb3cb9c
PM
53
54 set script $args
55 if {[info exists isonrunq($script)]} return
df75e86d 56 if {$runq eq {} && ![info exists currunq]} {
7eb3cb9c
PM
57 after idle dorunq
58 }
59 lappend runq [list {} $script]
60 set isonrunq($script) 1
61}
62
63proc filerun {fd script} {
64 fileevent $fd readable [list filereadable $fd $script]
65}
66
67proc filereadable {fd script} {
df75e86d 68 global runq currunq
7eb3cb9c
PM
69
70 fileevent $fd readable {}
df75e86d 71 if {$runq eq {} && ![info exists currunq]} {
7eb3cb9c
PM
72 after idle dorunq
73 }
74 lappend runq [list $fd $script]
75}
76
7fcc92bf
PM
77proc nukefile {fd} {
78 global runq
79
80 for {set i 0} {$i < [llength $runq]} {} {
81 if {[lindex $runq $i 0] eq $fd} {
82 set runq [lreplace $runq $i $i]
83 } else {
84 incr i
85 }
86 }
87}
88
7eb3cb9c 89proc dorunq {} {
df75e86d 90 global isonrunq runq currunq
7eb3cb9c
PM
91
92 set tstart [clock clicks -milliseconds]
93 set t0 $tstart
7fcc92bf 94 while {[llength $runq] > 0} {
7eb3cb9c
PM
95 set fd [lindex $runq 0 0]
96 set script [lindex $runq 0 1]
df75e86d
AG
97 set currunq [lindex $runq 0]
98 set runq [lrange $runq 1 end]
7eb3cb9c 99 set repeat [eval $script]
df75e86d 100 unset currunq
7eb3cb9c
PM
101 set t1 [clock clicks -milliseconds]
102 set t [expr {$t1 - $t0}]
7eb3cb9c
PM
103 if {$repeat ne {} && $repeat} {
104 if {$fd eq {} || $repeat == 2} {
105 # script returns 1 if it wants to be readded
106 # file readers return 2 if they could do more straight away
107 lappend runq [list $fd $script]
108 } else {
109 fileevent $fd readable [list filereadable $fd $script]
110 }
111 } elseif {$fd eq {}} {
112 unset isonrunq($script)
113 }
114 set t0 $t1
115 if {$t1 - $tstart >= 80} break
116 }
117 if {$runq ne {}} {
118 after idle dorunq
119 }
120}
121
e439e092
AG
122proc reg_instance {fd} {
123 global commfd leftover loginstance
124
125 set i [incr loginstance]
126 set commfd($i) $fd
127 set leftover($i) {}
128 return $i
129}
130
3ed31a81
PM
131proc unmerged_files {files} {
132 global nr_unmerged
133
134 # find the list of unmerged files
135 set mlist {}
136 set nr_unmerged 0
137 if {[catch {
138 set fd [open "| git ls-files -u" r]
139 } err]} {
140 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
141 exit 1
142 }
143 while {[gets $fd line] >= 0} {
144 set i [string first "\t" $line]
145 if {$i < 0} continue
146 set fname [string range $line [expr {$i+1}] end]
147 if {[lsearch -exact $mlist $fname] >= 0} continue
148 incr nr_unmerged
149 if {$files eq {} || [path_filter $files $fname]} {
150 lappend mlist $fname
151 }
152 }
153 catch {close $fd}
154 return $mlist
155}
156
157proc parseviewargs {n arglist} {
c2f2dab9 158 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
ae4e3ff9 159 global worddiff git_version
3ed31a81
PM
160
161 set vdatemode($n) 0
162 set vmergeonly($n) 0
ee66e089
PM
163 set glflags {}
164 set diffargs {}
165 set nextisval 0
166 set revargs {}
167 set origargs $arglist
168 set allknown 1
169 set filtered 0
170 set i -1
171 foreach arg $arglist {
172 incr i
173 if {$nextisval} {
174 lappend glflags $arg
175 set nextisval 0
176 continue
177 }
3ed31a81
PM
178 switch -glob -- $arg {
179 "-d" -
180 "--date-order" {
181 set vdatemode($n) 1
ee66e089
PM
182 # remove from origargs in case we hit an unknown option
183 set origargs [lreplace $origargs $i $i]
184 incr i -1
185 }
ee66e089
PM
186 "-[puabwcrRBMC]" -
187 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
188 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
189 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
190 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
191 "--ignore-space-change" - "-U*" - "--unified=*" {
29582284
PM
192 # These request or affect diff output, which we don't want.
193 # Some could be used to set our defaults for diff display.
ee66e089
PM
194 lappend diffargs $arg
195 }
ee66e089 196 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
ae4e3ff9 197 "--name-only" - "--name-status" - "--color" -
ee66e089
PM
198 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
199 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
200 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
201 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
202 "--objects" - "--objects-edge" - "--reverse" {
29582284
PM
203 # These cause our parsing of git log's output to fail, or else
204 # they're options we want to set ourselves, so ignore them.
ee66e089 205 }
ae4e3ff9
TR
206 "--color-words*" - "--word-diff=color" {
207 # These trigger a word diff in the console interface,
208 # so help the user by enabling our own support
209 if {[package vcompare $git_version "1.7.2"] >= 0} {
210 set worddiff [mc "Color words"]
211 }
212 }
213 "--word-diff*" {
214 if {[package vcompare $git_version "1.7.2"] >= 0} {
215 set worddiff [mc "Markup words"]
216 }
217 }
ee66e089
PM
218 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
219 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
220 "--full-history" - "--dense" - "--sparse" -
221 "--follow" - "--left-right" - "--encoding=*" {
29582284 222 # These are harmless, and some are even useful
ee66e089
PM
223 lappend glflags $arg
224 }
ee66e089
PM
225 "--diff-filter=*" - "--no-merges" - "--unpacked" -
226 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
227 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
228 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
229 "--remove-empty" - "--first-parent" - "--cherry-pick" -
f687aaa8
DS
230 "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
231 "--simplify-by-decoration" {
29582284 232 # These mean that we get a subset of the commits
ee66e089
PM
233 set filtered 1
234 lappend glflags $arg
235 }
ee66e089 236 "-n" {
29582284
PM
237 # This appears to be the only one that has a value as a
238 # separate word following it
ee66e089
PM
239 set filtered 1
240 set nextisval 1
241 lappend glflags $arg
242 }
6e7e87c7 243 "--not" - "--all" {
ee66e089 244 lappend revargs $arg
3ed31a81
PM
245 }
246 "--merge" {
247 set vmergeonly($n) 1
ee66e089
PM
248 # git rev-parse doesn't understand --merge
249 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
250 }
c2f2dab9
CC
251 "--no-replace-objects" {
252 set env(GIT_NO_REPLACE_OBJECTS) "1"
253 }
ee66e089 254 "-*" {
29582284 255 # Other flag arguments including -<n>
ee66e089
PM
256 if {[string is digit -strict [string range $arg 1 end]]} {
257 set filtered 1
258 } else {
259 # a flag argument that we don't recognize;
260 # that means we can't optimize
261 set allknown 0
262 }
263 lappend glflags $arg
3ed31a81
PM
264 }
265 default {
29582284 266 # Non-flag arguments specify commits or ranges of commits
ee66e089
PM
267 if {[string match "*...*" $arg]} {
268 lappend revargs --gitk-symmetric-diff-marker
269 }
270 lappend revargs $arg
271 }
272 }
273 }
274 set vdflags($n) $diffargs
275 set vflags($n) $glflags
276 set vrevs($n) $revargs
277 set vfiltered($n) $filtered
278 set vorigargs($n) $origargs
279 return $allknown
280}
281
282proc parseviewrevs {view revs} {
283 global vposids vnegids
284
285 if {$revs eq {}} {
286 set revs HEAD
287 }
288 if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
289 # we get stdout followed by stderr in $err
290 # for an unknown rev, git rev-parse echoes it and then errors out
291 set errlines [split $err "\n"]
292 set badrev {}
293 for {set l 0} {$l < [llength $errlines]} {incr l} {
294 set line [lindex $errlines $l]
295 if {!([string length $line] == 40 && [string is xdigit $line])} {
296 if {[string match "fatal:*" $line]} {
297 if {[string match "fatal: ambiguous argument*" $line]
298 && $badrev ne {}} {
299 if {[llength $badrev] == 1} {
300 set err "unknown revision $badrev"
301 } else {
302 set err "unknown revisions: [join $badrev ", "]"
303 }
304 } else {
305 set err [join [lrange $errlines $l end] "\n"]
306 }
307 break
308 }
309 lappend badrev $line
310 }
d93f1713 311 }
3945d2c0 312 error_popup "[mc "Error parsing revisions:"] $err"
ee66e089
PM
313 return {}
314 }
315 set ret {}
316 set pos {}
317 set neg {}
318 set sdm 0
319 foreach id [split $ids "\n"] {
320 if {$id eq "--gitk-symmetric-diff-marker"} {
321 set sdm 4
322 } elseif {[string match "^*" $id]} {
323 if {$sdm != 1} {
324 lappend ret $id
325 if {$sdm == 3} {
326 set sdm 0
327 }
328 }
329 lappend neg [string range $id 1 end]
330 } else {
331 if {$sdm != 2} {
332 lappend ret $id
333 } else {
2b1fbf90 334 lset ret end $id...[lindex $ret end]
3ed31a81 335 }
ee66e089 336 lappend pos $id
3ed31a81 337 }
ee66e089 338 incr sdm -1
3ed31a81 339 }
ee66e089
PM
340 set vposids($view) $pos
341 set vnegids($view) $neg
342 return $ret
3ed31a81
PM
343}
344
f9e0b6fb 345# Start off a git log process and arrange to read its output
da7c24dd 346proc start_rev_list {view} {
6df7403a 347 global startmsecs commitidx viewcomplete curview
e439e092 348 global tclencoding
ee66e089 349 global viewargs viewargscmd viewfiles vfilelimit
d375ef9b 350 global showlocalchanges
e439e092 351 global viewactive viewinstances vmergeonly
cdc8429c 352 global mainheadid viewmainheadid viewmainheadid_orig
ee66e089 353 global vcanopt vflags vrevs vorigargs
7defefb1 354 global show_notes
9ccbdfbf 355
9ccbdfbf 356 set startmsecs [clock clicks -milliseconds]
da7c24dd 357 set commitidx($view) 0
3ed31a81
PM
358 # these are set this way for the error exits
359 set viewcomplete($view) 1
360 set viewactive($view) 0
7fcc92bf
PM
361 varcinit $view
362
2d480856
YD
363 set args $viewargs($view)
364 if {$viewargscmd($view) ne {}} {
365 if {[catch {
366 set str [exec sh -c $viewargscmd($view)]
367 } err]} {
3945d2c0 368 error_popup "[mc "Error executing --argscmd command:"] $err"
3ed31a81 369 return 0
2d480856
YD
370 }
371 set args [concat $args [split $str "\n"]]
372 }
ee66e089 373 set vcanopt($view) [parseviewargs $view $args]
3ed31a81
PM
374
375 set files $viewfiles($view)
376 if {$vmergeonly($view)} {
377 set files [unmerged_files $files]
378 if {$files eq {}} {
379 global nr_unmerged
380 if {$nr_unmerged == 0} {
381 error_popup [mc "No files selected: --merge specified but\
382 no files are unmerged."]
383 } else {
384 error_popup [mc "No files selected: --merge specified but\
385 no unmerged files are within file limit."]
386 }
387 return 0
388 }
389 }
390 set vfilelimit($view) $files
391
ee66e089
PM
392 if {$vcanopt($view)} {
393 set revs [parseviewrevs $view $vrevs($view)]
394 if {$revs eq {}} {
395 return 0
396 }
397 set args [concat $vflags($view) $revs]
398 } else {
399 set args $vorigargs($view)
400 }
401
418c4c7b 402 if {[catch {
7defefb1
KS
403 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
404 --parents --boundary $args "--" $files] r]
418c4c7b 405 } err]} {
00abadb9 406 error_popup "[mc "Error executing git log:"] $err"
3ed31a81 407 return 0
1d10f36d 408 }
e439e092 409 set i [reg_instance $fd]
7fcc92bf 410 set viewinstances($view) [list $i]
cdc8429c
PM
411 set viewmainheadid($view) $mainheadid
412 set viewmainheadid_orig($view) $mainheadid
413 if {$files ne {} && $mainheadid ne {}} {
414 get_viewmainhead $view
415 }
416 if {$showlocalchanges && $viewmainheadid($view) ne {}} {
417 interestedin $viewmainheadid($view) dodiffindex
3e6b893f 418 }
86da5b6c 419 fconfigure $fd -blocking 0 -translation lf -eofchar {}
fd8ccbec 420 if {$tclencoding != {}} {
da7c24dd 421 fconfigure $fd -encoding $tclencoding
fd8ccbec 422 }
f806f0fb 423 filerun $fd [list getcommitlines $fd $i $view 0]
d990cedf 424 nowbusy $view [mc "Reading"]
3ed31a81
PM
425 set viewcomplete($view) 0
426 set viewactive($view) 1
427 return 1
38ad0910
PM
428}
429
e2f90ee4
AG
430proc stop_instance {inst} {
431 global commfd leftover
432
433 set fd $commfd($inst)
434 catch {
435 set pid [pid $fd]
b6326e92
AG
436
437 if {$::tcl_platform(platform) eq {windows}} {
438 exec kill -f $pid
439 } else {
440 exec kill $pid
441 }
e2f90ee4
AG
442 }
443 catch {close $fd}
444 nukefile $fd
445 unset commfd($inst)
446 unset leftover($inst)
447}
448
449proc stop_backends {} {
450 global commfd
451
452 foreach inst [array names commfd] {
453 stop_instance $inst
454 }
455}
456
7fcc92bf 457proc stop_rev_list {view} {
e2f90ee4 458 global viewinstances
22626ef4 459
7fcc92bf 460 foreach inst $viewinstances($view) {
e2f90ee4 461 stop_instance $inst
22626ef4 462 }
7fcc92bf 463 set viewinstances($view) {}
22626ef4
PM
464}
465
567c34e0 466proc reset_pending_select {selid} {
39816d60 467 global pending_select mainheadid selectheadid
567c34e0
AG
468
469 if {$selid ne {}} {
470 set pending_select $selid
39816d60
AG
471 } elseif {$selectheadid ne {}} {
472 set pending_select $selectheadid
567c34e0
AG
473 } else {
474 set pending_select $mainheadid
475 }
476}
477
478proc getcommits {selid} {
3ed31a81 479 global canv curview need_redisplay viewactive
38ad0910 480
da7c24dd 481 initlayout
3ed31a81 482 if {[start_rev_list $curview]} {
567c34e0 483 reset_pending_select $selid
3ed31a81
PM
484 show_status [mc "Reading commits..."]
485 set need_redisplay 1
486 } else {
487 show_status [mc "No commits selected"]
488 }
1d10f36d
PM
489}
490
7fcc92bf 491proc updatecommits {} {
ee66e089 492 global curview vcanopt vorigargs vfilelimit viewinstances
e439e092
AG
493 global viewactive viewcomplete tclencoding
494 global startmsecs showneartags showlocalchanges
cdc8429c 495 global mainheadid viewmainheadid viewmainheadid_orig pending_select
74cb884f 496 global hasworktree
ee66e089 497 global varcid vposids vnegids vflags vrevs
7defefb1 498 global show_notes
7fcc92bf 499
74cb884f 500 set hasworktree [hasworktree]
fc2a256f 501 rereadrefs
cdc8429c
PM
502 set view $curview
503 if {$mainheadid ne $viewmainheadid_orig($view)} {
504 if {$showlocalchanges} {
eb5f8c9c
PM
505 dohidelocalchanges
506 }
cdc8429c
PM
507 set viewmainheadid($view) $mainheadid
508 set viewmainheadid_orig($view) $mainheadid
509 if {$vfilelimit($view) ne {}} {
510 get_viewmainhead $view
eb5f8c9c
PM
511 }
512 }
cdc8429c
PM
513 if {$showlocalchanges} {
514 doshowlocalchanges
515 }
ee66e089
PM
516 if {$vcanopt($view)} {
517 set oldpos $vposids($view)
518 set oldneg $vnegids($view)
519 set revs [parseviewrevs $view $vrevs($view)]
520 if {$revs eq {}} {
521 return
522 }
523 # note: getting the delta when negative refs change is hard,
524 # and could require multiple git log invocations, so in that
525 # case we ask git log for all the commits (not just the delta)
526 if {$oldneg eq $vnegids($view)} {
527 set newrevs {}
528 set npos 0
529 # take out positive refs that we asked for before or
530 # that we have already seen
531 foreach rev $revs {
532 if {[string length $rev] == 40} {
533 if {[lsearch -exact $oldpos $rev] < 0
534 && ![info exists varcid($view,$rev)]} {
535 lappend newrevs $rev
536 incr npos
537 }
538 } else {
539 lappend $newrevs $rev
540 }
541 }
542 if {$npos == 0} return
543 set revs $newrevs
544 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
545 }
546 set args [concat $vflags($view) $revs --not $oldpos]
547 } else {
548 set args $vorigargs($view)
549 }
7fcc92bf 550 if {[catch {
7defefb1
KS
551 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
552 --parents --boundary $args "--" $vfilelimit($view)] r]
7fcc92bf 553 } err]} {
3945d2c0 554 error_popup "[mc "Error executing git log:"] $err"
ee66e089 555 return
7fcc92bf
PM
556 }
557 if {$viewactive($view) == 0} {
558 set startmsecs [clock clicks -milliseconds]
559 }
e439e092 560 set i [reg_instance $fd]
7fcc92bf 561 lappend viewinstances($view) $i
7fcc92bf
PM
562 fconfigure $fd -blocking 0 -translation lf -eofchar {}
563 if {$tclencoding != {}} {
564 fconfigure $fd -encoding $tclencoding
565 }
f806f0fb 566 filerun $fd [list getcommitlines $fd $i $view 1]
7fcc92bf
PM
567 incr viewactive($view)
568 set viewcomplete($view) 0
567c34e0 569 reset_pending_select {}
b56e0a9a 570 nowbusy $view [mc "Reading"]
7fcc92bf
PM
571 if {$showneartags} {
572 getallcommits
573 }
574}
575
576proc reloadcommits {} {
577 global curview viewcomplete selectedline currentid thickerline
578 global showneartags treediffs commitinterest cached_commitrow
6df7403a 579 global targetid
7fcc92bf 580
567c34e0
AG
581 set selid {}
582 if {$selectedline ne {}} {
583 set selid $currentid
584 }
585
7fcc92bf
PM
586 if {!$viewcomplete($curview)} {
587 stop_rev_list $curview
7fcc92bf
PM
588 }
589 resetvarcs $curview
94b4a69f 590 set selectedline {}
7fcc92bf
PM
591 catch {unset currentid}
592 catch {unset thickerline}
593 catch {unset treediffs}
594 readrefs
595 changedrefs
596 if {$showneartags} {
597 getallcommits
598 }
599 clear_display
600 catch {unset commitinterest}
601 catch {unset cached_commitrow}
42a671fc 602 catch {unset targetid}
7fcc92bf 603 setcanvscroll
567c34e0 604 getcommits $selid
e7297a1c 605 return 0
7fcc92bf
PM
606}
607
6e8c8707
PM
608# This makes a string representation of a positive integer which
609# sorts as a string in numerical order
610proc strrep {n} {
611 if {$n < 16} {
612 return [format "%x" $n]
613 } elseif {$n < 256} {
614 return [format "x%.2x" $n]
615 } elseif {$n < 65536} {
616 return [format "y%.4x" $n]
617 }
618 return [format "z%.8x" $n]
619}
620
7fcc92bf
PM
621# Procedures used in reordering commits from git log (without
622# --topo-order) into the order for display.
623
624proc varcinit {view} {
f3ea5ede
PM
625 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
626 global vtokmod varcmod vrowmod varcix vlastins
7fcc92bf 627
7fcc92bf
PM
628 set varcstart($view) {{}}
629 set vupptr($view) {0}
630 set vdownptr($view) {0}
631 set vleftptr($view) {0}
f3ea5ede 632 set vbackptr($view) {0}
7fcc92bf
PM
633 set varctok($view) {{}}
634 set varcrow($view) {{}}
635 set vtokmod($view) {}
636 set varcmod($view) 0
e5b37ac1 637 set vrowmod($view) 0
7fcc92bf 638 set varcix($view) {{}}
f3ea5ede 639 set vlastins($view) {0}
7fcc92bf
PM
640}
641
642proc resetvarcs {view} {
643 global varcid varccommits parents children vseedcount ordertok
22387f23 644 global vshortids
7fcc92bf
PM
645
646 foreach vid [array names varcid $view,*] {
647 unset varcid($vid)
648 unset children($vid)
649 unset parents($vid)
650 }
22387f23
PM
651 foreach vid [array names vshortids $view,*] {
652 unset vshortids($vid)
653 }
7fcc92bf
PM
654 # some commits might have children but haven't been seen yet
655 foreach vid [array names children $view,*] {
656 unset children($vid)
657 }
658 foreach va [array names varccommits $view,*] {
659 unset varccommits($va)
660 }
661 foreach vd [array names vseedcount $view,*] {
662 unset vseedcount($vd)
663 }
9257d8f7 664 catch {unset ordertok}
7fcc92bf
PM
665}
666
468bcaed
PM
667# returns a list of the commits with no children
668proc seeds {v} {
669 global vdownptr vleftptr varcstart
670
671 set ret {}
672 set a [lindex $vdownptr($v) 0]
673 while {$a != 0} {
674 lappend ret [lindex $varcstart($v) $a]
675 set a [lindex $vleftptr($v) $a]
676 }
677 return $ret
678}
679
7fcc92bf 680proc newvarc {view id} {
3ed31a81 681 global varcid varctok parents children vdatemode
f3ea5ede
PM
682 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
683 global commitdata commitinfo vseedcount varccommits vlastins
7fcc92bf
PM
684
685 set a [llength $varctok($view)]
686 set vid $view,$id
3ed31a81 687 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
7fcc92bf
PM
688 if {![info exists commitinfo($id)]} {
689 parsecommit $id $commitdata($id) 1
690 }
f5974d97 691 set cdate [lindex [lindex $commitinfo($id) 4] 0]
7fcc92bf
PM
692 if {![string is integer -strict $cdate]} {
693 set cdate 0
694 }
695 if {![info exists vseedcount($view,$cdate)]} {
696 set vseedcount($view,$cdate) -1
697 }
698 set c [incr vseedcount($view,$cdate)]
699 set cdate [expr {$cdate ^ 0xffffffff}]
700 set tok "s[strrep $cdate][strrep $c]"
7fcc92bf
PM
701 } else {
702 set tok {}
f3ea5ede
PM
703 }
704 set ka 0
705 if {[llength $children($vid)] > 0} {
706 set kid [lindex $children($vid) end]
707 set k $varcid($view,$kid)
708 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
709 set ki $kid
710 set ka $k
711 set tok [lindex $varctok($view) $k]
7fcc92bf 712 }
f3ea5ede
PM
713 }
714 if {$ka != 0} {
7fcc92bf
PM
715 set i [lsearch -exact $parents($view,$ki) $id]
716 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
7fcc92bf
PM
717 append tok [strrep $j]
718 }
f3ea5ede
PM
719 set c [lindex $vlastins($view) $ka]
720 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
721 set c $ka
722 set b [lindex $vdownptr($view) $ka]
723 } else {
724 set b [lindex $vleftptr($view) $c]
725 }
726 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
727 set c $b
728 set b [lindex $vleftptr($view) $c]
729 }
730 if {$c == $ka} {
731 lset vdownptr($view) $ka $a
732 lappend vbackptr($view) 0
733 } else {
734 lset vleftptr($view) $c $a
735 lappend vbackptr($view) $c
736 }
737 lset vlastins($view) $ka $a
738 lappend vupptr($view) $ka
739 lappend vleftptr($view) $b
740 if {$b != 0} {
741 lset vbackptr($view) $b $a
742 }
7fcc92bf
PM
743 lappend varctok($view) $tok
744 lappend varcstart($view) $id
745 lappend vdownptr($view) 0
746 lappend varcrow($view) {}
747 lappend varcix($view) {}
e5b37ac1 748 set varccommits($view,$a) {}
f3ea5ede 749 lappend vlastins($view) 0
7fcc92bf
PM
750 return $a
751}
752
753proc splitvarc {p v} {
52b8ea93 754 global varcid varcstart varccommits varctok vtokmod
f3ea5ede 755 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
7fcc92bf
PM
756
757 set oa $varcid($v,$p)
52b8ea93 758 set otok [lindex $varctok($v) $oa]
7fcc92bf
PM
759 set ac $varccommits($v,$oa)
760 set i [lsearch -exact $varccommits($v,$oa) $p]
761 if {$i <= 0} return
762 set na [llength $varctok($v)]
763 # "%" sorts before "0"...
52b8ea93 764 set tok "$otok%[strrep $i]"
7fcc92bf
PM
765 lappend varctok($v) $tok
766 lappend varcrow($v) {}
767 lappend varcix($v) {}
768 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
769 set varccommits($v,$na) [lrange $ac $i end]
770 lappend varcstart($v) $p
771 foreach id $varccommits($v,$na) {
772 set varcid($v,$id) $na
773 }
774 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
841ea824 775 lappend vlastins($v) [lindex $vlastins($v) $oa]
7fcc92bf 776 lset vdownptr($v) $oa $na
841ea824 777 lset vlastins($v) $oa 0
7fcc92bf
PM
778 lappend vupptr($v) $oa
779 lappend vleftptr($v) 0
f3ea5ede 780 lappend vbackptr($v) 0
7fcc92bf
PM
781 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
782 lset vupptr($v) $b $na
783 }
52b8ea93
PM
784 if {[string compare $otok $vtokmod($v)] <= 0} {
785 modify_arc $v $oa
786 }
7fcc92bf
PM
787}
788
789proc renumbervarc {a v} {
790 global parents children varctok varcstart varccommits
3ed31a81 791 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
7fcc92bf
PM
792
793 set t1 [clock clicks -milliseconds]
794 set todo {}
795 set isrelated($a) 1
f3ea5ede 796 set kidchanged($a) 1
7fcc92bf
PM
797 set ntot 0
798 while {$a != 0} {
799 if {[info exists isrelated($a)]} {
800 lappend todo $a
801 set id [lindex $varccommits($v,$a) end]
802 foreach p $parents($v,$id) {
803 if {[info exists varcid($v,$p)]} {
804 set isrelated($varcid($v,$p)) 1
805 }
806 }
807 }
808 incr ntot
809 set b [lindex $vdownptr($v) $a]
810 if {$b == 0} {
811 while {$a != 0} {
812 set b [lindex $vleftptr($v) $a]
813 if {$b != 0} break
814 set a [lindex $vupptr($v) $a]
815 }
816 }
817 set a $b
818 }
819 foreach a $todo {
f3ea5ede 820 if {![info exists kidchanged($a)]} continue
7fcc92bf 821 set id [lindex $varcstart($v) $a]
f3ea5ede
PM
822 if {[llength $children($v,$id)] > 1} {
823 set children($v,$id) [lsort -command [list vtokcmp $v] \
824 $children($v,$id)]
825 }
826 set oldtok [lindex $varctok($v) $a]
3ed31a81 827 if {!$vdatemode($v)} {
f3ea5ede
PM
828 set tok {}
829 } else {
830 set tok $oldtok
831 }
832 set ka 0
c8c9f3d9
PM
833 set kid [last_real_child $v,$id]
834 if {$kid ne {}} {
f3ea5ede
PM
835 set k $varcid($v,$kid)
836 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
837 set ki $kid
838 set ka $k
839 set tok [lindex $varctok($v) $k]
7fcc92bf
PM
840 }
841 }
f3ea5ede 842 if {$ka != 0} {
7fcc92bf
PM
843 set i [lsearch -exact $parents($v,$ki) $id]
844 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
845 append tok [strrep $j]
7fcc92bf 846 }
f3ea5ede
PM
847 if {$tok eq $oldtok} {
848 continue
849 }
850 set id [lindex $varccommits($v,$a) end]
851 foreach p $parents($v,$id) {
852 if {[info exists varcid($v,$p)]} {
853 set kidchanged($varcid($v,$p)) 1
854 } else {
855 set sortkids($p) 1
856 }
857 }
858 lset varctok($v) $a $tok
7fcc92bf
PM
859 set b [lindex $vupptr($v) $a]
860 if {$b != $ka} {
9257d8f7
PM
861 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
862 modify_arc $v $ka
38dfe939 863 }
9257d8f7
PM
864 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
865 modify_arc $v $b
38dfe939 866 }
f3ea5ede
PM
867 set c [lindex $vbackptr($v) $a]
868 set d [lindex $vleftptr($v) $a]
869 if {$c == 0} {
870 lset vdownptr($v) $b $d
7fcc92bf 871 } else {
f3ea5ede
PM
872 lset vleftptr($v) $c $d
873 }
874 if {$d != 0} {
875 lset vbackptr($v) $d $c
7fcc92bf 876 }
841ea824
PM
877 if {[lindex $vlastins($v) $b] == $a} {
878 lset vlastins($v) $b $c
879 }
7fcc92bf 880 lset vupptr($v) $a $ka
f3ea5ede
PM
881 set c [lindex $vlastins($v) $ka]
882 if {$c == 0 || \
883 [string compare $tok [lindex $varctok($v) $c]] < 0} {
884 set c $ka
885 set b [lindex $vdownptr($v) $ka]
886 } else {
887 set b [lindex $vleftptr($v) $c]
888 }
889 while {$b != 0 && \
890 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
891 set c $b
892 set b [lindex $vleftptr($v) $c]
7fcc92bf 893 }
f3ea5ede
PM
894 if {$c == $ka} {
895 lset vdownptr($v) $ka $a
896 lset vbackptr($v) $a 0
897 } else {
898 lset vleftptr($v) $c $a
899 lset vbackptr($v) $a $c
7fcc92bf 900 }
f3ea5ede
PM
901 lset vleftptr($v) $a $b
902 if {$b != 0} {
903 lset vbackptr($v) $b $a
904 }
905 lset vlastins($v) $ka $a
906 }
907 }
908 foreach id [array names sortkids] {
909 if {[llength $children($v,$id)] > 1} {
910 set children($v,$id) [lsort -command [list vtokcmp $v] \
911 $children($v,$id)]
7fcc92bf
PM
912 }
913 }
914 set t2 [clock clicks -milliseconds]
915 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
916}
917
f806f0fb
PM
918# Fix up the graph after we have found out that in view $v,
919# $p (a commit that we have already seen) is actually the parent
920# of the last commit in arc $a.
7fcc92bf 921proc fix_reversal {p a v} {
24f7a667 922 global varcid varcstart varctok vupptr
7fcc92bf
PM
923
924 set pa $varcid($v,$p)
925 if {$p ne [lindex $varcstart($v) $pa]} {
926 splitvarc $p $v
927 set pa $varcid($v,$p)
928 }
24f7a667
PM
929 # seeds always need to be renumbered
930 if {[lindex $vupptr($v) $pa] == 0 ||
931 [string compare [lindex $varctok($v) $a] \
932 [lindex $varctok($v) $pa]] > 0} {
7fcc92bf
PM
933 renumbervarc $pa $v
934 }
935}
936
937proc insertrow {id p v} {
b8a938cf
PM
938 global cmitlisted children parents varcid varctok vtokmod
939 global varccommits ordertok commitidx numcommits curview
22387f23 940 global targetid targetrow vshortids
b8a938cf
PM
941
942 readcommit $id
943 set vid $v,$id
944 set cmitlisted($vid) 1
945 set children($vid) {}
946 set parents($vid) [list $p]
947 set a [newvarc $v $id]
948 set varcid($vid) $a
22387f23 949 lappend vshortids($v,[string range $id 0 3]) $id
b8a938cf
PM
950 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
951 modify_arc $v $a
952 }
953 lappend varccommits($v,$a) $id
954 set vp $v,$p
955 if {[llength [lappend children($vp) $id]] > 1} {
956 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
957 catch {unset ordertok}
958 }
959 fix_reversal $p $a $v
960 incr commitidx($v)
961 if {$v == $curview} {
962 set numcommits $commitidx($v)
963 setcanvscroll
964 if {[info exists targetid]} {
965 if {![comes_before $targetid $p]} {
966 incr targetrow
967 }
968 }
969 }
970}
971
972proc insertfakerow {id p} {
9257d8f7 973 global varcid varccommits parents children cmitlisted
b8a938cf 974 global commitidx varctok vtokmod targetid targetrow curview numcommits
7fcc92bf 975
b8a938cf 976 set v $curview
7fcc92bf
PM
977 set a $varcid($v,$p)
978 set i [lsearch -exact $varccommits($v,$a) $p]
979 if {$i < 0} {
b8a938cf 980 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
7fcc92bf
PM
981 return
982 }
983 set children($v,$id) {}
984 set parents($v,$id) [list $p]
985 set varcid($v,$id) $a
9257d8f7 986 lappend children($v,$p) $id
7fcc92bf 987 set cmitlisted($v,$id) 1
b8a938cf 988 set numcommits [incr commitidx($v)]
7fcc92bf
PM
989 # note we deliberately don't update varcstart($v) even if $i == 0
990 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
c9cfdc96 991 modify_arc $v $a $i
42a671fc
PM
992 if {[info exists targetid]} {
993 if {![comes_before $targetid $p]} {
994 incr targetrow
995 }
996 }
b8a938cf 997 setcanvscroll
9257d8f7 998 drawvisible
7fcc92bf
PM
999}
1000
b8a938cf 1001proc removefakerow {id} {
9257d8f7 1002 global varcid varccommits parents children commitidx
fc2a256f 1003 global varctok vtokmod cmitlisted currentid selectedline
b8a938cf 1004 global targetid curview numcommits
7fcc92bf 1005
b8a938cf 1006 set v $curview
7fcc92bf 1007 if {[llength $parents($v,$id)] != 1} {
b8a938cf 1008 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
7fcc92bf
PM
1009 return
1010 }
1011 set p [lindex $parents($v,$id) 0]
1012 set a $varcid($v,$id)
1013 set i [lsearch -exact $varccommits($v,$a) $id]
1014 if {$i < 0} {
b8a938cf 1015 puts "oops: removefakerow can't find [shortids $id] on arc $a"
7fcc92bf
PM
1016 return
1017 }
1018 unset varcid($v,$id)
1019 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1020 unset parents($v,$id)
1021 unset children($v,$id)
1022 unset cmitlisted($v,$id)
b8a938cf 1023 set numcommits [incr commitidx($v) -1]
7fcc92bf
PM
1024 set j [lsearch -exact $children($v,$p) $id]
1025 if {$j >= 0} {
1026 set children($v,$p) [lreplace $children($v,$p) $j $j]
1027 }
c9cfdc96 1028 modify_arc $v $a $i
fc2a256f
PM
1029 if {[info exist currentid] && $id eq $currentid} {
1030 unset currentid
94b4a69f 1031 set selectedline {}
fc2a256f 1032 }
42a671fc
PM
1033 if {[info exists targetid] && $targetid eq $id} {
1034 set targetid $p
1035 }
b8a938cf 1036 setcanvscroll
9257d8f7 1037 drawvisible
7fcc92bf
PM
1038}
1039
aa43561a
PM
1040proc real_children {vp} {
1041 global children nullid nullid2
1042
1043 set kids {}
1044 foreach id $children($vp) {
1045 if {$id ne $nullid && $id ne $nullid2} {
1046 lappend kids $id
1047 }
1048 }
1049 return $kids
1050}
1051
c8c9f3d9
PM
1052proc first_real_child {vp} {
1053 global children nullid nullid2
1054
1055 foreach id $children($vp) {
1056 if {$id ne $nullid && $id ne $nullid2} {
1057 return $id
1058 }
1059 }
1060 return {}
1061}
1062
1063proc last_real_child {vp} {
1064 global children nullid nullid2
1065
1066 set kids $children($vp)
1067 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1068 set id [lindex $kids $i]
1069 if {$id ne $nullid && $id ne $nullid2} {
1070 return $id
1071 }
1072 }
1073 return {}
1074}
1075
7fcc92bf
PM
1076proc vtokcmp {v a b} {
1077 global varctok varcid
1078
1079 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1080 [lindex $varctok($v) $varcid($v,$b)]]
1081}
1082
c9cfdc96
PM
1083# This assumes that if lim is not given, the caller has checked that
1084# arc a's token is less than $vtokmod($v)
e5b37ac1
PM
1085proc modify_arc {v a {lim {}}} {
1086 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
9257d8f7 1087
c9cfdc96
PM
1088 if {$lim ne {}} {
1089 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1090 if {$c > 0} return
1091 if {$c == 0} {
1092 set r [lindex $varcrow($v) $a]
1093 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1094 }
1095 }
9257d8f7
PM
1096 set vtokmod($v) [lindex $varctok($v) $a]
1097 set varcmod($v) $a
1098 if {$v == $curview} {
1099 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1100 set a [lindex $vupptr($v) $a]
e5b37ac1 1101 set lim {}
9257d8f7 1102 }
e5b37ac1
PM
1103 set r 0
1104 if {$a != 0} {
1105 if {$lim eq {}} {
1106 set lim [llength $varccommits($v,$a)]
1107 }
1108 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1109 }
1110 set vrowmod($v) $r
0c27886e 1111 undolayout $r
9257d8f7
PM
1112 }
1113}
1114
7fcc92bf 1115proc update_arcrows {v} {
e5b37ac1 1116 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
24f7a667 1117 global varcid vrownum varcorder varcix varccommits
7fcc92bf 1118 global vupptr vdownptr vleftptr varctok
24f7a667 1119 global displayorder parentlist curview cached_commitrow
7fcc92bf 1120
c9cfdc96
PM
1121 if {$vrowmod($v) == $commitidx($v)} return
1122 if {$v == $curview} {
1123 if {[llength $displayorder] > $vrowmod($v)} {
1124 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1125 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1126 }
1127 catch {unset cached_commitrow}
1128 }
7fcc92bf
PM
1129 set narctot [expr {[llength $varctok($v)] - 1}]
1130 set a $varcmod($v)
1131 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1132 # go up the tree until we find something that has a row number,
1133 # or we get to a seed
1134 set a [lindex $vupptr($v) $a]
1135 }
1136 if {$a == 0} {
1137 set a [lindex $vdownptr($v) 0]
1138 if {$a == 0} return
1139 set vrownum($v) {0}
1140 set varcorder($v) [list $a]
1141 lset varcix($v) $a 0
1142 lset varcrow($v) $a 0
1143 set arcn 0
1144 set row 0
1145 } else {
1146 set arcn [lindex $varcix($v) $a]
7fcc92bf
PM
1147 if {[llength $vrownum($v)] > $arcn + 1} {
1148 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1149 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1150 }
1151 set row [lindex $varcrow($v) $a]
1152 }
7fcc92bf
PM
1153 while {1} {
1154 set p $a
1155 incr row [llength $varccommits($v,$a)]
1156 # go down if possible
1157 set b [lindex $vdownptr($v) $a]
1158 if {$b == 0} {
1159 # if not, go left, or go up until we can go left
1160 while {$a != 0} {
1161 set b [lindex $vleftptr($v) $a]
1162 if {$b != 0} break
1163 set a [lindex $vupptr($v) $a]
1164 }
1165 if {$a == 0} break
1166 }
1167 set a $b
1168 incr arcn
1169 lappend vrownum($v) $row
1170 lappend varcorder($v) $a
1171 lset varcix($v) $a $arcn
1172 lset varcrow($v) $a $row
1173 }
e5b37ac1
PM
1174 set vtokmod($v) [lindex $varctok($v) $p]
1175 set varcmod($v) $p
1176 set vrowmod($v) $row
7fcc92bf
PM
1177 if {[info exists currentid]} {
1178 set selectedline [rowofcommit $currentid]
1179 }
7fcc92bf
PM
1180}
1181
1182# Test whether view $v contains commit $id
1183proc commitinview {id v} {
1184 global varcid
1185
1186 return [info exists varcid($v,$id)]
1187}
1188
1189# Return the row number for commit $id in the current view
1190proc rowofcommit {id} {
1191 global varcid varccommits varcrow curview cached_commitrow
9257d8f7 1192 global varctok vtokmod
7fcc92bf 1193
7fcc92bf
PM
1194 set v $curview
1195 if {![info exists varcid($v,$id)]} {
1196 puts "oops rowofcommit no arc for [shortids $id]"
1197 return {}
1198 }
1199 set a $varcid($v,$id)
fc2a256f 1200 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
9257d8f7
PM
1201 update_arcrows $v
1202 }
31c0eaa8
PM
1203 if {[info exists cached_commitrow($id)]} {
1204 return $cached_commitrow($id)
1205 }
7fcc92bf
PM
1206 set i [lsearch -exact $varccommits($v,$a) $id]
1207 if {$i < 0} {
1208 puts "oops didn't find commit [shortids $id] in arc $a"
1209 return {}
1210 }
1211 incr i [lindex $varcrow($v) $a]
1212 set cached_commitrow($id) $i
1213 return $i
1214}
1215
42a671fc
PM
1216# Returns 1 if a is on an earlier row than b, otherwise 0
1217proc comes_before {a b} {
1218 global varcid varctok curview
1219
1220 set v $curview
1221 if {$a eq $b || ![info exists varcid($v,$a)] || \
1222 ![info exists varcid($v,$b)]} {
1223 return 0
1224 }
1225 if {$varcid($v,$a) != $varcid($v,$b)} {
1226 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1227 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1228 }
1229 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1230}
1231
7fcc92bf
PM
1232proc bsearch {l elt} {
1233 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1234 return 0
1235 }
1236 set lo 0
1237 set hi [llength $l]
1238 while {$hi - $lo > 1} {
1239 set mid [expr {int(($lo + $hi) / 2)}]
1240 set t [lindex $l $mid]
1241 if {$elt < $t} {
1242 set hi $mid
1243 } elseif {$elt > $t} {
1244 set lo $mid
1245 } else {
1246 return $mid
1247 }
1248 }
1249 return $lo
1250}
1251
1252# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1253proc make_disporder {start end} {
1254 global vrownum curview commitidx displayorder parentlist
e5b37ac1 1255 global varccommits varcorder parents vrowmod varcrow
7fcc92bf
PM
1256 global d_valid_start d_valid_end
1257
e5b37ac1 1258 if {$end > $vrowmod($curview)} {
9257d8f7
PM
1259 update_arcrows $curview
1260 }
7fcc92bf
PM
1261 set ai [bsearch $vrownum($curview) $start]
1262 set start [lindex $vrownum($curview) $ai]
1263 set narc [llength $vrownum($curview)]
1264 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1265 set a [lindex $varcorder($curview) $ai]
1266 set l [llength $displayorder]
1267 set al [llength $varccommits($curview,$a)]
1268 if {$l < $r + $al} {
1269 if {$l < $r} {
1270 set pad [ntimes [expr {$r - $l}] {}]
1271 set displayorder [concat $displayorder $pad]
1272 set parentlist [concat $parentlist $pad]
1273 } elseif {$l > $r} {
1274 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1275 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1276 }
1277 foreach id $varccommits($curview,$a) {
1278 lappend displayorder $id
1279 lappend parentlist $parents($curview,$id)
1280 }
17529cf9 1281 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
7fcc92bf
PM
1282 set i $r
1283 foreach id $varccommits($curview,$a) {
1284 lset displayorder $i $id
1285 lset parentlist $i $parents($curview,$id)
1286 incr i
1287 }
1288 }
1289 incr r $al
1290 }
1291}
1292
1293proc commitonrow {row} {
1294 global displayorder
1295
1296 set id [lindex $displayorder $row]
1297 if {$id eq {}} {
1298 make_disporder $row [expr {$row + 1}]
1299 set id [lindex $displayorder $row]
1300 }
1301 return $id
1302}
1303
1304proc closevarcs {v} {
1305 global varctok varccommits varcid parents children
d375ef9b 1306 global cmitlisted commitidx vtokmod
7fcc92bf
PM
1307
1308 set missing_parents 0
1309 set scripts {}
1310 set narcs [llength $varctok($v)]
1311 for {set a 1} {$a < $narcs} {incr a} {
1312 set id [lindex $varccommits($v,$a) end]
1313 foreach p $parents($v,$id) {
1314 if {[info exists varcid($v,$p)]} continue
1315 # add p as a new commit
1316 incr missing_parents
1317 set cmitlisted($v,$p) 0
1318 set parents($v,$p) {}
1319 if {[llength $children($v,$p)] == 1 &&
1320 [llength $parents($v,$id)] == 1} {
1321 set b $a
1322 } else {
1323 set b [newvarc $v $p]
1324 }
1325 set varcid($v,$p) $b
9257d8f7
PM
1326 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1327 modify_arc $v $b
7fcc92bf 1328 }
e5b37ac1 1329 lappend varccommits($v,$b) $p
7fcc92bf 1330 incr commitidx($v)
d375ef9b 1331 set scripts [check_interest $p $scripts]
7fcc92bf
PM
1332 }
1333 }
1334 if {$missing_parents > 0} {
7fcc92bf
PM
1335 foreach s $scripts {
1336 eval $s
1337 }
1338 }
1339}
1340
f806f0fb
PM
1341# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1342# Assumes we already have an arc for $rwid.
1343proc rewrite_commit {v id rwid} {
1344 global children parents varcid varctok vtokmod varccommits
1345
1346 foreach ch $children($v,$id) {
1347 # make $rwid be $ch's parent in place of $id
1348 set i [lsearch -exact $parents($v,$ch) $id]
1349 if {$i < 0} {
1350 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1351 }
1352 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1353 # add $ch to $rwid's children and sort the list if necessary
1354 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1355 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1356 $children($v,$rwid)]
1357 }
1358 # fix the graph after joining $id to $rwid
1359 set a $varcid($v,$ch)
1360 fix_reversal $rwid $a $v
c9cfdc96
PM
1361 # parentlist is wrong for the last element of arc $a
1362 # even if displayorder is right, hence the 3rd arg here
1363 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
f806f0fb
PM
1364 }
1365}
1366
d375ef9b
PM
1367# Mechanism for registering a command to be executed when we come
1368# across a particular commit. To handle the case when only the
1369# prefix of the commit is known, the commitinterest array is now
1370# indexed by the first 4 characters of the ID. Each element is a
1371# list of id, cmd pairs.
1372proc interestedin {id cmd} {
1373 global commitinterest
1374
1375 lappend commitinterest([string range $id 0 3]) $id $cmd
1376}
1377
1378proc check_interest {id scripts} {
1379 global commitinterest
1380
1381 set prefix [string range $id 0 3]
1382 if {[info exists commitinterest($prefix)]} {
1383 set newlist {}
1384 foreach {i script} $commitinterest($prefix) {
1385 if {[string match "$i*" $id]} {
1386 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1387 } else {
1388 lappend newlist $i $script
1389 }
1390 }
1391 if {$newlist ne {}} {
1392 set commitinterest($prefix) $newlist
1393 } else {
1394 unset commitinterest($prefix)
1395 }
1396 }
1397 return $scripts
1398}
1399
f806f0fb 1400proc getcommitlines {fd inst view updating} {
d375ef9b 1401 global cmitlisted leftover
3ed31a81 1402 global commitidx commitdata vdatemode
7fcc92bf 1403 global parents children curview hlview
468bcaed 1404 global idpending ordertok
22387f23 1405 global varccommits varcid varctok vtokmod vfilelimit vshortids
9ccbdfbf 1406
d1e46756 1407 set stuff [read $fd 500000]
005a2f4e 1408 # git log doesn't terminate the last commit with a null...
7fcc92bf 1409 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
005a2f4e
PM
1410 set stuff "\0"
1411 }
b490a991 1412 if {$stuff == {}} {
7eb3cb9c
PM
1413 if {![eof $fd]} {
1414 return 1
1415 }
6df7403a 1416 global commfd viewcomplete viewactive viewname
7fcc92bf
PM
1417 global viewinstances
1418 unset commfd($inst)
1419 set i [lsearch -exact $viewinstances($view) $inst]
1420 if {$i >= 0} {
1421 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
b0cdca99 1422 }
f0654861 1423 # set it blocking so we wait for the process to terminate
da7c24dd 1424 fconfigure $fd -blocking 1
098dd8a3
PM
1425 if {[catch {close $fd} err]} {
1426 set fv {}
1427 if {$view != $curview} {
1428 set fv " for the \"$viewname($view)\" view"
da7c24dd 1429 }
098dd8a3
PM
1430 if {[string range $err 0 4] == "usage"} {
1431 set err "Gitk: error reading commits$fv:\
f9e0b6fb 1432 bad arguments to git log."
098dd8a3
PM
1433 if {$viewname($view) eq "Command line"} {
1434 append err \
f9e0b6fb 1435 " (Note: arguments to gitk are passed to git log\
098dd8a3
PM
1436 to allow selection of commits to be displayed.)"
1437 }
1438 } else {
1439 set err "Error reading commits$fv: $err"
1440 }
1441 error_popup $err
1d10f36d 1442 }
7fcc92bf
PM
1443 if {[incr viewactive($view) -1] <= 0} {
1444 set viewcomplete($view) 1
1445 # Check if we have seen any ids listed as parents that haven't
1446 # appeared in the list
1447 closevarcs $view
1448 notbusy $view
7fcc92bf 1449 }
098dd8a3 1450 if {$view == $curview} {
ac1276ab 1451 run chewcommits
9a40c50c 1452 }
7eb3cb9c 1453 return 0
9a40c50c 1454 }
b490a991 1455 set start 0
8f7d0cec 1456 set gotsome 0
7fcc92bf 1457 set scripts {}
b490a991
PM
1458 while 1 {
1459 set i [string first "\0" $stuff $start]
1460 if {$i < 0} {
7fcc92bf 1461 append leftover($inst) [string range $stuff $start end]
9f1afe05 1462 break
9ccbdfbf 1463 }
b490a991 1464 if {$start == 0} {
7fcc92bf 1465 set cmit $leftover($inst)
8f7d0cec 1466 append cmit [string range $stuff 0 [expr {$i - 1}]]
7fcc92bf 1467 set leftover($inst) {}
8f7d0cec
PM
1468 } else {
1469 set cmit [string range $stuff $start [expr {$i - 1}]]
b490a991
PM
1470 }
1471 set start [expr {$i + 1}]
e5ea701b
PM
1472 set j [string first "\n" $cmit]
1473 set ok 0
16c1ff96 1474 set listed 1
c961b228
PM
1475 if {$j >= 0 && [string match "commit *" $cmit]} {
1476 set ids [string range $cmit 7 [expr {$j - 1}]]
1407ade9 1477 if {[string match {[-^<>]*} $ids]} {
c961b228
PM
1478 switch -- [string index $ids 0] {
1479 "-" {set listed 0}
1407ade9
LT
1480 "^" {set listed 2}
1481 "<" {set listed 3}
1482 ">" {set listed 4}
c961b228 1483 }
16c1ff96
PM
1484 set ids [string range $ids 1 end]
1485 }
e5ea701b
PM
1486 set ok 1
1487 foreach id $ids {
8f7d0cec 1488 if {[string length $id] != 40} {
e5ea701b
PM
1489 set ok 0
1490 break
1491 }
1492 }
1493 }
1494 if {!$ok} {
7e952e79
PM
1495 set shortcmit $cmit
1496 if {[string length $shortcmit] > 80} {
1497 set shortcmit "[string range $shortcmit 0 80]..."
1498 }
d990cedf 1499 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
b490a991
PM
1500 exit 1
1501 }
e5ea701b 1502 set id [lindex $ids 0]
7fcc92bf 1503 set vid $view,$id
f806f0fb 1504
22387f23
PM
1505 lappend vshortids($view,[string range $id 0 3]) $id
1506
f806f0fb 1507 if {!$listed && $updating && ![info exists varcid($vid)] &&
3ed31a81 1508 $vfilelimit($view) ne {}} {
f806f0fb
PM
1509 # git log doesn't rewrite parents for unlisted commits
1510 # when doing path limiting, so work around that here
1511 # by working out the rewritten parent with git rev-list
1512 # and if we already know about it, using the rewritten
1513 # parent as a substitute parent for $id's children.
1514 if {![catch {
1515 set rwid [exec git rev-list --first-parent --max-count=1 \
3ed31a81 1516 $id -- $vfilelimit($view)]
f806f0fb
PM
1517 }]} {
1518 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1519 # use $rwid in place of $id
1520 rewrite_commit $view $id $rwid
1521 continue
1522 }
1523 }
1524 }
1525
f1bf4ee6
PM
1526 set a 0
1527 if {[info exists varcid($vid)]} {
1528 if {$cmitlisted($vid) || !$listed} continue
1529 set a $varcid($vid)
1530 }
16c1ff96
PM
1531 if {$listed} {
1532 set olds [lrange $ids 1 end]
16c1ff96
PM
1533 } else {
1534 set olds {}
1535 }
f7a3e8d2 1536 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
7fcc92bf
PM
1537 set cmitlisted($vid) $listed
1538 set parents($vid) $olds
7fcc92bf
PM
1539 if {![info exists children($vid)]} {
1540 set children($vid) {}
f1bf4ee6 1541 } elseif {$a == 0 && [llength $children($vid)] == 1} {
f3ea5ede
PM
1542 set k [lindex $children($vid) 0]
1543 if {[llength $parents($view,$k)] == 1 &&
3ed31a81 1544 (!$vdatemode($view) ||
f3ea5ede
PM
1545 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1546 set a $varcid($view,$k)
7fcc92bf 1547 }
da7c24dd 1548 }
7fcc92bf
PM
1549 if {$a == 0} {
1550 # new arc
1551 set a [newvarc $view $id]
1552 }
e5b37ac1
PM
1553 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1554 modify_arc $view $a
1555 }
f1bf4ee6
PM
1556 if {![info exists varcid($vid)]} {
1557 set varcid($vid) $a
1558 lappend varccommits($view,$a) $id
1559 incr commitidx($view)
1560 }
e5b37ac1 1561
7fcc92bf
PM
1562 set i 0
1563 foreach p $olds {
1564 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1565 set vp $view,$p
1566 if {[llength [lappend children($vp) $id]] > 1 &&
1567 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1568 set children($vp) [lsort -command [list vtokcmp $view] \
1569 $children($vp)]
9257d8f7 1570 catch {unset ordertok}
7fcc92bf 1571 }
f3ea5ede
PM
1572 if {[info exists varcid($view,$p)]} {
1573 fix_reversal $p $a $view
1574 }
7fcc92bf
PM
1575 }
1576 incr i
1577 }
7fcc92bf 1578
d375ef9b 1579 set scripts [check_interest $id $scripts]
8f7d0cec
PM
1580 set gotsome 1
1581 }
1582 if {$gotsome} {
ac1276ab
PM
1583 global numcommits hlview
1584
1585 if {$view == $curview} {
1586 set numcommits $commitidx($view)
1587 run chewcommits
1588 }
1589 if {[info exists hlview] && $view == $hlview} {
1590 # we never actually get here...
1591 run vhighlightmore
1592 }
7fcc92bf
PM
1593 foreach s $scripts {
1594 eval $s
1595 }
9ccbdfbf 1596 }
7eb3cb9c 1597 return 2
9ccbdfbf
PM
1598}
1599
ac1276ab 1600proc chewcommits {} {
f5f3c2e2 1601 global curview hlview viewcomplete
7fcc92bf 1602 global pending_select
7eb3cb9c 1603
ac1276ab
PM
1604 layoutmore
1605 if {$viewcomplete($curview)} {
1606 global commitidx varctok
1607 global numcommits startmsecs
ac1276ab
PM
1608
1609 if {[info exists pending_select]} {
835e62ae
AG
1610 update
1611 reset_pending_select {}
1612
1613 if {[commitinview $pending_select $curview]} {
1614 selectline [rowofcommit $pending_select] 1
1615 } else {
1616 set row [first_real_row]
1617 selectline $row 1
1618 }
7eb3cb9c 1619 }
ac1276ab
PM
1620 if {$commitidx($curview) > 0} {
1621 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1622 #puts "overall $ms ms for $numcommits commits"
1623 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1624 } else {
1625 show_status [mc "No commits selected"]
1626 }
1627 notbusy layout
b664550c 1628 }
f5f3c2e2 1629 return 0
1db95b00
PM
1630}
1631
590915da
AG
1632proc do_readcommit {id} {
1633 global tclencoding
1634
1635 # Invoke git-log to handle automatic encoding conversion
1636 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1637 # Read the results using i18n.logoutputencoding
1638 fconfigure $fd -translation lf -eofchar {}
1639 if {$tclencoding != {}} {
1640 fconfigure $fd -encoding $tclencoding
1641 }
1642 set contents [read $fd]
1643 close $fd
1644 # Remove the heading line
1645 regsub {^commit [0-9a-f]+\n} $contents {} contents
1646
1647 return $contents
1648}
1649
1db95b00 1650proc readcommit {id} {
590915da
AG
1651 if {[catch {set contents [do_readcommit $id]}]} return
1652 parsecommit $id $contents 1
b490a991
PM
1653}
1654
8f7d0cec 1655proc parsecommit {id contents listed} {
ef73896b 1656 global commitinfo
b5c2f306
SV
1657
1658 set inhdr 1
1659 set comment {}
1660 set headline {}
1661 set auname {}
1662 set audate {}
1663 set comname {}
1664 set comdate {}
232475d3
PM
1665 set hdrend [string first "\n\n" $contents]
1666 if {$hdrend < 0} {
1667 # should never happen...
1668 set hdrend [string length $contents]
1669 }
1670 set header [string range $contents 0 [expr {$hdrend - 1}]]
1671 set comment [string range $contents [expr {$hdrend + 2}] end]
1672 foreach line [split $header "\n"] {
61f57cb0 1673 set line [split $line " "]
232475d3
PM
1674 set tag [lindex $line 0]
1675 if {$tag == "author"} {
f5974d97 1676 set audate [lrange $line end-1 end]
61f57cb0 1677 set auname [join [lrange $line 1 end-2] " "]
232475d3 1678 } elseif {$tag == "committer"} {
f5974d97 1679 set comdate [lrange $line end-1 end]
61f57cb0 1680 set comname [join [lrange $line 1 end-2] " "]
1db95b00
PM
1681 }
1682 }
232475d3 1683 set headline {}
43c25074
PM
1684 # take the first non-blank line of the comment as the headline
1685 set headline [string trimleft $comment]
1686 set i [string first "\n" $headline]
232475d3 1687 if {$i >= 0} {
43c25074
PM
1688 set headline [string range $headline 0 $i]
1689 }
1690 set headline [string trimright $headline]
1691 set i [string first "\r" $headline]
1692 if {$i >= 0} {
1693 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
1694 }
1695 if {!$listed} {
f9e0b6fb 1696 # git log indents the comment by 4 spaces;
8974c6f9 1697 # if we got this via git cat-file, add the indentation
232475d3
PM
1698 set newcomment {}
1699 foreach line [split $comment "\n"] {
1700 append newcomment " "
1701 append newcomment $line
f6e2869f 1702 append newcomment "\n"
232475d3
PM
1703 }
1704 set comment $newcomment
1db95b00 1705 }
36242490 1706 set hasnote [string first "\nNotes:\n" $contents]
e5c2d856 1707 set commitinfo($id) [list $headline $auname $audate \
36242490 1708 $comname $comdate $comment $hasnote]
1db95b00
PM
1709}
1710
f7a3e8d2 1711proc getcommit {id} {
79b2c75e 1712 global commitdata commitinfo
8ed16484 1713
f7a3e8d2
PM
1714 if {[info exists commitdata($id)]} {
1715 parsecommit $id $commitdata($id) 1
8ed16484
PM
1716 } else {
1717 readcommit $id
1718 if {![info exists commitinfo($id)]} {
d990cedf 1719 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
1720 }
1721 }
1722 return 1
1723}
1724
d375ef9b
PM
1725# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1726# and are present in the current view.
1727# This is fairly slow...
1728proc longid {prefix} {
22387f23 1729 global varcid curview vshortids
d375ef9b
PM
1730
1731 set ids {}
22387f23
PM
1732 if {[string length $prefix] >= 4} {
1733 set vshortid $curview,[string range $prefix 0 3]
1734 if {[info exists vshortids($vshortid)]} {
1735 foreach id $vshortids($vshortid) {
1736 if {[string match "$prefix*" $id]} {
1737 if {[lsearch -exact $ids $id] < 0} {
1738 lappend ids $id
1739 if {[llength $ids] >= 2} break
1740 }
1741 }
1742 }
1743 }
1744 } else {
1745 foreach match [array names varcid "$curview,$prefix*"] {
1746 lappend ids [lindex [split $match ","] 1]
1747 if {[llength $ids] >= 2} break
1748 }
d375ef9b
PM
1749 }
1750 return $ids
1751}
1752
887fe3c4 1753proc readrefs {} {
62d3ea65 1754 global tagids idtags headids idheads tagobjid
219ea3a9 1755 global otherrefids idotherrefs mainhead mainheadid
39816d60 1756 global selecthead selectheadid
ffe15297 1757 global hideremotes
106288cb 1758
b5c2f306
SV
1759 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1760 catch {unset $v}
1761 }
62d3ea65
PM
1762 set refd [open [list | git show-ref -d] r]
1763 while {[gets $refd line] >= 0} {
1764 if {[string index $line 40] ne " "} continue
1765 set id [string range $line 0 39]
1766 set ref [string range $line 41 end]
1767 if {![string match "refs/*" $ref]} continue
1768 set name [string range $ref 5 end]
1769 if {[string match "remotes/*" $name]} {
ffe15297 1770 if {![string match "*/HEAD" $name] && !$hideremotes} {
62d3ea65
PM
1771 set headids($name) $id
1772 lappend idheads($id) $name
f1d83ba3 1773 }
62d3ea65
PM
1774 } elseif {[string match "heads/*" $name]} {
1775 set name [string range $name 6 end]
36a7cad6
JH
1776 set headids($name) $id
1777 lappend idheads($id) $name
62d3ea65
PM
1778 } elseif {[string match "tags/*" $name]} {
1779 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1780 # which is what we want since the former is the commit ID
1781 set name [string range $name 5 end]
1782 if {[string match "*^{}" $name]} {
1783 set name [string range $name 0 end-3]
1784 } else {
1785 set tagobjid($name) $id
1786 }
1787 set tagids($name) $id
1788 lappend idtags($id) $name
36a7cad6
JH
1789 } else {
1790 set otherrefids($name) $id
1791 lappend idotherrefs($id) $name
f1d83ba3
PM
1792 }
1793 }
062d671f 1794 catch {close $refd}
8a48571c 1795 set mainhead {}
219ea3a9 1796 set mainheadid {}
8a48571c 1797 catch {
c11ff120 1798 set mainheadid [exec git rev-parse HEAD]
8a48571c
PM
1799 set thehead [exec git symbolic-ref HEAD]
1800 if {[string match "refs/heads/*" $thehead]} {
1801 set mainhead [string range $thehead 11 end]
1802 }
1803 }
39816d60
AG
1804 set selectheadid {}
1805 if {$selecthead ne {}} {
1806 catch {
1807 set selectheadid [exec git rev-parse --verify $selecthead]
1808 }
1809 }
887fe3c4
PM
1810}
1811
8f489363
PM
1812# skip over fake commits
1813proc first_real_row {} {
7fcc92bf 1814 global nullid nullid2 numcommits
8f489363
PM
1815
1816 for {set row 0} {$row < $numcommits} {incr row} {
7fcc92bf 1817 set id [commitonrow $row]
8f489363
PM
1818 if {$id ne $nullid && $id ne $nullid2} {
1819 break
1820 }
1821 }
1822 return $row
1823}
1824
e11f1233
PM
1825# update things for a head moved to a child of its previous location
1826proc movehead {id name} {
1827 global headids idheads
1828
1829 removehead $headids($name) $name
1830 set headids($name) $id
1831 lappend idheads($id) $name
1832}
1833
1834# update things when a head has been removed
1835proc removehead {id name} {
1836 global headids idheads
1837
1838 if {$idheads($id) eq $name} {
1839 unset idheads($id)
1840 } else {
1841 set i [lsearch -exact $idheads($id) $name]
1842 if {$i >= 0} {
1843 set idheads($id) [lreplace $idheads($id) $i $i]
1844 }
1845 }
1846 unset headids($name)
1847}
1848
d93f1713
PT
1849proc ttk_toplevel {w args} {
1850 global use_ttk
1851 eval [linsert $args 0 ::toplevel $w]
1852 if {$use_ttk} {
1853 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1854 }
1855 return $w
1856}
1857
e7d64008
AG
1858proc make_transient {window origin} {
1859 global have_tk85
1860
1861 # In MacOS Tk 8.4 transient appears to work by setting
1862 # overrideredirect, which is utterly useless, since the
1863 # windows get no border, and are not even kept above
1864 # the parent.
1865 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1866
1867 wm transient $window $origin
1868
1869 # Windows fails to place transient windows normally, so
1870 # schedule a callback to center them on the parent.
1871 if {[tk windowingsystem] eq {win32}} {
1872 after idle [list tk::PlaceWindow $window widget $origin]
1873 }
1874}
1875
8d849957 1876proc show_error {w top msg {mc mc}} {
d93f1713 1877 global NS
3cb1f9c9 1878 if {![info exists NS]} {set NS ""}
d93f1713 1879 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
df3d83b1
PM
1880 message $w.m -text $msg -justify center -aspect 400
1881 pack $w.m -side top -fill x -padx 20 -pady 20
7a0ebbf8 1882 ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
df3d83b1 1883 pack $w.ok -side bottom -fill x
e54be9e3
PM
1884 bind $top <Visibility> "grab $top; focus $top"
1885 bind $top <Key-Return> "destroy $top"
76f15947
AG
1886 bind $top <Key-space> "destroy $top"
1887 bind $top <Key-Escape> "destroy $top"
e54be9e3 1888 tkwait window $top
df3d83b1
PM
1889}
1890
84a76f18 1891proc error_popup {msg {owner .}} {
d93f1713
PT
1892 if {[tk windowingsystem] eq "win32"} {
1893 tk_messageBox -icon error -type ok -title [wm title .] \
1894 -parent $owner -message $msg
1895 } else {
1896 set w .error
1897 ttk_toplevel $w
1898 make_transient $w $owner
1899 show_error $w $w $msg
1900 }
098dd8a3
PM
1901}
1902
84a76f18 1903proc confirm_popup {msg {owner .}} {
d93f1713 1904 global confirm_ok NS
10299152
PM
1905 set confirm_ok 0
1906 set w .confirm
d93f1713 1907 ttk_toplevel $w
e7d64008 1908 make_transient $w $owner
10299152
PM
1909 message $w.m -text $msg -justify center -aspect 400
1910 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1911 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1912 pack $w.ok -side left -fill x
d93f1713 1913 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1914 pack $w.cancel -side right -fill x
1915 bind $w <Visibility> "grab $w; focus $w"
76f15947
AG
1916 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1917 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1918 bind $w <Key-Escape> "destroy $w"
d93f1713 1919 tk::PlaceWindow $w widget $owner
10299152
PM
1920 tkwait window $w
1921 return $confirm_ok
1922}
1923
b039f0a6 1924proc setoptions {} {
d93f1713
PT
1925 if {[tk windowingsystem] ne "win32"} {
1926 option add *Panedwindow.showHandle 1 startupFile
1927 option add *Panedwindow.sashRelief raised startupFile
1928 if {[tk windowingsystem] ne "aqua"} {
1929 option add *Menu.font uifont startupFile
1930 }
1931 } else {
1932 option add *Menu.TearOff 0 startupFile
1933 }
b039f0a6
PM
1934 option add *Button.font uifont startupFile
1935 option add *Checkbutton.font uifont startupFile
1936 option add *Radiobutton.font uifont startupFile
b039f0a6
PM
1937 option add *Menubutton.font uifont startupFile
1938 option add *Label.font uifont startupFile
1939 option add *Message.font uifont startupFile
b9b142ff
MH
1940 option add *Entry.font textfont startupFile
1941 option add *Text.font textfont startupFile
d93f1713 1942 option add *Labelframe.font uifont startupFile
0933b04e 1943 option add *Spinbox.font textfont startupFile
207ad7b8 1944 option add *Listbox.font mainfont startupFile
b039f0a6
PM
1945}
1946
79056034
PM
1947# Make a menu and submenus.
1948# m is the window name for the menu, items is the list of menu items to add.
1949# Each item is a list {mc label type description options...}
1950# mc is ignored; it's so we can put mc there to alert xgettext
1951# label is the string that appears in the menu
1952# type is cascade, command or radiobutton (should add checkbutton)
1953# description depends on type; it's the sublist for cascade, the
1954# command to invoke for command, or {variable value} for radiobutton
f2d0bbbd
PM
1955proc makemenu {m items} {
1956 menu $m
cea07cf8
AG
1957 if {[tk windowingsystem] eq {aqua}} {
1958 set Meta1 Cmd
1959 } else {
1960 set Meta1 Ctrl
1961 }
f2d0bbbd 1962 foreach i $items {
79056034
PM
1963 set name [mc [lindex $i 1]]
1964 set type [lindex $i 2]
1965 set thing [lindex $i 3]
f2d0bbbd
PM
1966 set params [list $type]
1967 if {$name ne {}} {
1968 set u [string first "&" [string map {&& x} $name]]
1969 lappend params -label [string map {&& & & {}} $name]
1970 if {$u >= 0} {
1971 lappend params -underline $u
1972 }
1973 }
1974 switch -- $type {
1975 "cascade" {
79056034 1976 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
f2d0bbbd
PM
1977 lappend params -menu $m.$submenu
1978 }
1979 "command" {
1980 lappend params -command $thing
1981 }
1982 "radiobutton" {
1983 lappend params -variable [lindex $thing 0] \
1984 -value [lindex $thing 1]
1985 }
1986 }
cea07cf8
AG
1987 set tail [lrange $i 4 end]
1988 regsub -all {\yMeta1\y} $tail $Meta1 tail
1989 eval $m add $params $tail
f2d0bbbd
PM
1990 if {$type eq "cascade"} {
1991 makemenu $m.$submenu $thing
1992 }
1993 }
1994}
1995
1996# translate string and remove ampersands
1997proc mca {str} {
1998 return [string map {&& & & {}} [mc $str]]
1999}
2000
d93f1713
PT
2001proc makedroplist {w varname args} {
2002 global use_ttk
2003 if {$use_ttk} {
3cb1f9c9
PT
2004 set width 0
2005 foreach label $args {
2006 set cx [string length $label]
2007 if {$cx > $width} {set width $cx}
2008 }
2009 set gm [ttk::combobox $w -width $width -state readonly\
d93f1713
PT
2010 -textvariable $varname -values $args]
2011 } else {
2012 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2013 }
2014 return $gm
2015}
2016
d94f8cd6 2017proc makewindow {} {
31c0eaa8 2018 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 2019 global tabstop
b74fd579 2020 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 2021 global entries sha1entry sha1string sha1but
890fae70 2022 global diffcontextstring diffcontext
b9b86007 2023 global ignorespace
94a2eede 2024 global maincursor textcursor curtextcursor
219ea3a9 2025 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 2026 global highlight_files gdttype
3ea06f9f 2027 global searchstring sstring
60378c0c 2028 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
bb3edc8b
PM
2029 global headctxmenu progresscanv progressitem progresscoords statusw
2030 global fprogitem fprogcoord lastprogupdate progupdatepending
6df7403a 2031 global rprogitem rprogcoord rownumsel numcommits
d93f1713 2032 global have_tk85 use_ttk NS
ae4e3ff9
TR
2033 global git_version
2034 global worddiff
9a40c50c 2035
79056034
PM
2036 # The "mc" arguments here are purely so that xgettext
2037 # sees the following string as needing to be translated
5fdcbb13
DS
2038 set file {
2039 mc "File" cascade {
79056034 2040 {mc "Update" command updatecommits -accelerator F5}
a135f214 2041 {mc "Reload" command reloadcommits -accelerator Shift-F5}
79056034 2042 {mc "Reread references" command rereadrefs}
cea07cf8 2043 {mc "List references" command showrefs -accelerator F2}
7fb0abb1
AG
2044 {xx "" separator}
2045 {mc "Start git gui" command {exec git gui &}}
2046 {xx "" separator}
cea07cf8 2047 {mc "Quit" command doquit -accelerator Meta1-Q}
f2d0bbbd 2048 }}
5fdcbb13
DS
2049 set edit {
2050 mc "Edit" cascade {
79056034 2051 {mc "Preferences" command doprefs}
f2d0bbbd 2052 }}
5fdcbb13
DS
2053 set view {
2054 mc "View" cascade {
cea07cf8
AG
2055 {mc "New view..." command {newview 0} -accelerator Shift-F4}
2056 {mc "Edit view..." command editview -state disabled -accelerator F4}
79056034
PM
2057 {mc "Delete view" command delview -state disabled}
2058 {xx "" separator}
2059 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
f2d0bbbd 2060 }}
5fdcbb13
DS
2061 if {[tk windowingsystem] ne "aqua"} {
2062 set help {
2063 mc "Help" cascade {
2064 {mc "About gitk" command about}
2065 {mc "Key bindings" command keys}
2066 }}
2067 set bar [list $file $edit $view $help]
2068 } else {
2069 proc ::tk::mac::ShowPreferences {} {doprefs}
2070 proc ::tk::mac::Quit {} {doquit}
2071 lset file end [lreplace [lindex $file end] end-1 end]
2072 set apple {
2073 xx "Apple" cascade {
79056034 2074 {mc "About gitk" command about}
5fdcbb13
DS
2075 {xx "" separator}
2076 }}
2077 set help {
2078 mc "Help" cascade {
79056034 2079 {mc "Key bindings" command keys}
f2d0bbbd 2080 }}
5fdcbb13 2081 set bar [list $apple $file $view $help]
f2d0bbbd 2082 }
5fdcbb13 2083 makemenu .bar $bar
9a40c50c
PM
2084 . configure -menu .bar
2085
d93f1713
PT
2086 if {$use_ttk} {
2087 # cover the non-themed toplevel with a themed frame.
2088 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2089 }
2090
e9937d2a 2091 # the gui has upper and lower half, parts of a paned window.
d93f1713 2092 ${NS}::panedwindow .ctop -orient vertical
e9937d2a
JH
2093
2094 # possibly use assumed geometry
9ca72f4f 2095 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
2096 set geometry(topheight) [expr {15 * $linespc}]
2097 set geometry(topwidth) [expr {80 * $charspc}]
2098 set geometry(botheight) [expr {15 * $linespc}]
2099 set geometry(botwidth) [expr {50 * $charspc}]
d93f1713
PT
2100 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2101 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
e9937d2a
JH
2102 }
2103
2104 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
d93f1713
PT
2105 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2106 ${NS}::frame .tf.histframe
2107 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2108 if {!$use_ttk} {
2109 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2110 }
e9937d2a
JH
2111
2112 # create three canvases
2113 set cscroll .tf.histframe.csb
2114 set canv .tf.histframe.pwclist.canv
9ca72f4f 2115 canvas $canv \
60378c0c 2116 -selectbackground $selectbgcolor \
f8a2c0d1 2117 -background $bgcolor -bd 0 \
9f1afe05 2118 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
2119 .tf.histframe.pwclist add $canv
2120 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 2121 canvas $canv2 \
60378c0c 2122 -selectbackground $selectbgcolor \
f8a2c0d1 2123 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
2124 .tf.histframe.pwclist add $canv2
2125 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 2126 canvas $canv3 \
60378c0c 2127 -selectbackground $selectbgcolor \
f8a2c0d1 2128 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 2129 .tf.histframe.pwclist add $canv3
d93f1713
PT
2130 if {$use_ttk} {
2131 bind .tf.histframe.pwclist <Map> {
2132 bind %W <Map> {}
2133 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2134 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2135 }
2136 } else {
2137 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2138 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2139 }
e9937d2a
JH
2140
2141 # a scroll bar to rule them
d93f1713
PT
2142 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2143 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
e9937d2a
JH
2144 pack $cscroll -side right -fill y
2145 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 2146 lappend bglist $canv $canv2 $canv3
e9937d2a 2147 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 2148
e9937d2a 2149 # we have two button bars at bottom of top frame. Bar 1
d93f1713
PT
2150 ${NS}::frame .tf.bar
2151 ${NS}::frame .tf.lbar -height 15
e9937d2a
JH
2152
2153 set sha1entry .tf.bar.sha1
887fe3c4 2154 set entries $sha1entry
e9937d2a 2155 set sha1but .tf.bar.sha1label
0359ba72 2156 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
b039f0a6 2157 -command gotocommit -width 8
887fe3c4 2158 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 2159 pack .tf.bar.sha1label -side left
d93f1713 2160 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 2161 trace add variable sha1string write sha1change
98f350e5 2162 pack $sha1entry -side left -pady 2
d698206c
PM
2163
2164 image create bitmap bm-left -data {
2165 #define left_width 16
2166 #define left_height 16
2167 static unsigned char left_bits[] = {
2168 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2169 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2170 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2171 }
2172 image create bitmap bm-right -data {
2173 #define right_width 16
2174 #define right_height 16
2175 static unsigned char right_bits[] = {
2176 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2177 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2178 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2179 }
d93f1713 2180 ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
d698206c 2181 -state disabled -width 26
e9937d2a 2182 pack .tf.bar.leftbut -side left -fill y
d93f1713 2183 ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
d698206c 2184 -state disabled -width 26
e9937d2a 2185 pack .tf.bar.rightbut -side left -fill y
d698206c 2186
d93f1713 2187 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
6df7403a 2188 set rownumsel {}
d93f1713 2189 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
6df7403a 2190 -relief sunken -anchor e
d93f1713
PT
2191 ${NS}::label .tf.bar.rowlabel2 -text "/"
2192 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
6df7403a
PM
2193 -relief sunken -anchor e
2194 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2195 -side left
d93f1713
PT
2196 if {!$use_ttk} {
2197 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2198 }
6df7403a 2199 global selectedline
94b4a69f 2200 trace add variable selectedline write selectedline_change
6df7403a 2201
bb3edc8b
PM
2202 # Status label and progress bar
2203 set statusw .tf.bar.status
d93f1713 2204 ${NS}::label $statusw -width 15 -relief sunken
bb3edc8b 2205 pack $statusw -side left -padx 5
d93f1713
PT
2206 if {$use_ttk} {
2207 set progresscanv [ttk::progressbar .tf.bar.progress]
2208 } else {
2209 set h [expr {[font metrics uifont -linespace] + 2}]
2210 set progresscanv .tf.bar.progress
2211 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2212 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2213 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2214 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2215 }
2216 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
bb3edc8b
PM
2217 set progresscoords {0 0}
2218 set fprogcoord 0
a137a90f 2219 set rprogcoord 0
bb3edc8b
PM
2220 bind $progresscanv <Configure> adjustprogress
2221 set lastprogupdate [clock clicks -milliseconds]
2222 set progupdatepending 0
2223
687c8765 2224 # build up the bottom bar of upper window
d93f1713
PT
2225 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2226 ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2227 ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2228 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
687c8765
PM
2229 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2230 -side left -fill y
b007ee20 2231 set gdttype [mc "containing:"]
3cb1f9c9 2232 set gm [makedroplist .tf.lbar.gdttype gdttype \
b007ee20
CS
2233 [mc "containing:"] \
2234 [mc "touching paths:"] \
2235 [mc "adding/removing string:"]]
687c8765 2236 trace add variable gdttype write gdttype_change
687c8765
PM
2237 pack .tf.lbar.gdttype -side left -fill y
2238
98f350e5 2239 set findstring {}
687c8765 2240 set fstring .tf.lbar.findstring
887fe3c4 2241 lappend entries $fstring
b9b142ff 2242 ${NS}::entry $fstring -width 30 -textvariable findstring
60f7a7dc 2243 trace add variable findstring write find_change
b007ee20 2244 set findtype [mc "Exact"]
d93f1713
PT
2245 set findtypemenu [makedroplist .tf.lbar.findtype \
2246 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 2247 trace add variable findtype write findcom_change
b007ee20 2248 set findloc [mc "All fields"]
d93f1713 2249 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
b007ee20 2250 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 2251 trace add variable findloc write find_change
687c8765
PM
2252 pack .tf.lbar.findloc -side right
2253 pack .tf.lbar.findtype -side right
2254 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
2255
2256 # Finish putting the upper half of the viewer together
2257 pack .tf.lbar -in .tf -side bottom -fill x
2258 pack .tf.bar -in .tf -side bottom -fill x
2259 pack .tf.histframe -fill both -side top -expand 1
2260 .ctop add .tf
d93f1713
PT
2261 if {!$use_ttk} {
2262 .ctop paneconfigure .tf -height $geometry(topheight)
2263 .ctop paneconfigure .tf -width $geometry(topwidth)
2264 }
e9937d2a
JH
2265
2266 # now build up the bottom
d93f1713 2267 ${NS}::panedwindow .pwbottom -orient horizontal
e9937d2a
JH
2268
2269 # lower left, a text box over search bar, scroll bar to the right
2270 # if we know window height, then that will set the lower text height, otherwise
2271 # we set lower text height which will drive window height
2272 if {[info exists geometry(main)]} {
d93f1713 2273 ${NS}::frame .bleft -width $geometry(botwidth)
e9937d2a 2274 } else {
d93f1713 2275 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
e9937d2a 2276 }
d93f1713
PT
2277 ${NS}::frame .bleft.top
2278 ${NS}::frame .bleft.mid
2279 ${NS}::frame .bleft.bottom
e9937d2a 2280
d93f1713 2281 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
2282 pack .bleft.top.search -side left -padx 5
2283 set sstring .bleft.top.sstring
d93f1713 2284 set searchstring ""
b9b142ff 2285 ${NS}::entry $sstring -width 20 -textvariable searchstring
3ea06f9f
PM
2286 lappend entries $sstring
2287 trace add variable searchstring write incrsearch
2288 pack $sstring -side left -expand 1 -fill x
d93f1713 2289 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 2290 -command changediffdisp -variable diffelide -value {0 0}
d93f1713 2291 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 2292 -command changediffdisp -variable diffelide -value {0 1}
d93f1713 2293 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 2294 -command changediffdisp -variable diffelide -value {1 0}
d93f1713 2295 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
a8d610a2 2296 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
0933b04e 2297 spinbox .bleft.mid.diffcontext -width 5 \
a41ddbb6 2298 -from 0 -increment 1 -to 10000000 \
890fae70
SP
2299 -validate all -validatecommand "diffcontextvalidate %P" \
2300 -textvariable diffcontextstring
2301 .bleft.mid.diffcontext set $diffcontext
2302 trace add variable diffcontextstring write diffcontextchange
2303 lappend entries .bleft.mid.diffcontext
2304 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
d93f1713 2305 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
b9b86007
SP
2306 -command changeignorespace -variable ignorespace
2307 pack .bleft.mid.ignspace -side left -padx 5
ae4e3ff9
TR
2308
2309 set worddiff [mc "Line diff"]
2310 if {[package vcompare $git_version "1.7.2"] >= 0} {
2311 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2312 [mc "Markup words"] [mc "Color words"]
2313 trace add variable worddiff write changeworddiff
2314 pack .bleft.mid.worddiff -side left -padx 5
2315 }
2316
8809d691 2317 set ctext .bleft.bottom.ctext
f8a2c0d1 2318 text $ctext -background $bgcolor -foreground $fgcolor \
9c311b32 2319 -state disabled -font textfont \
8809d691
PK
2320 -yscrollcommand scrolltext -wrap none \
2321 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4
PM
2322 if {$have_tk85} {
2323 $ctext conf -tabstyle wordprocessor
2324 }
d93f1713
PT
2325 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2326 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
e9937d2a 2327 pack .bleft.top -side top -fill x
a8d610a2 2328 pack .bleft.mid -side top -fill x
8809d691
PK
2329 grid $ctext .bleft.bottom.sb -sticky nsew
2330 grid .bleft.bottom.sbhorizontal -sticky ew
2331 grid columnconfigure .bleft.bottom 0 -weight 1
2332 grid rowconfigure .bleft.bottom 0 -weight 1
2333 grid rowconfigure .bleft.bottom 1 -weight 0
2334 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
2335 lappend bglist $ctext
2336 lappend fglist $ctext
d2610d11 2337
f1b86294 2338 $ctext tag conf comment -wrap $wrapcomment
9c311b32 2339 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
f8a2c0d1
PM
2340 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2341 $ctext tag conf d0 -fore [lindex $diffcolors 0]
8b07dca1 2342 $ctext tag conf dresult -fore [lindex $diffcolors 1]
712fcc08
PM
2343 $ctext tag conf m0 -fore red
2344 $ctext tag conf m1 -fore blue
2345 $ctext tag conf m2 -fore green
2346 $ctext tag conf m3 -fore purple
2347 $ctext tag conf m4 -fore brown
b77b0278
PM
2348 $ctext tag conf m5 -fore "#009090"
2349 $ctext tag conf m6 -fore magenta
2350 $ctext tag conf m7 -fore "#808000"
2351 $ctext tag conf m8 -fore "#009000"
2352 $ctext tag conf m9 -fore "#ff0080"
2353 $ctext tag conf m10 -fore cyan
2354 $ctext tag conf m11 -fore "#b07070"
2355 $ctext tag conf m12 -fore "#70b0f0"
2356 $ctext tag conf m13 -fore "#70f0b0"
2357 $ctext tag conf m14 -fore "#f0b070"
2358 $ctext tag conf m15 -fore "#ff70b0"
712fcc08 2359 $ctext tag conf mmax -fore darkgrey
b77b0278 2360 set mergemax 16
9c311b32
PM
2361 $ctext tag conf mresult -font textfontbold
2362 $ctext tag conf msep -font textfontbold
712fcc08 2363 $ctext tag conf found -back yellow
c4614994 2364 $ctext tag conf currentsearchhit -back orange
e5c2d856 2365
e9937d2a 2366 .pwbottom add .bleft
d93f1713
PT
2367 if {!$use_ttk} {
2368 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2369 }
e9937d2a
JH
2370
2371 # lower right
d93f1713
PT
2372 ${NS}::frame .bright
2373 ${NS}::frame .bright.mode
2374 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 2375 -command reselectline -variable cmitmode -value "patch"
d93f1713 2376 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 2377 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
2378 grid .bright.mode.patch .bright.mode.tree -sticky ew
2379 pack .bright.mode -side top -fill x
2380 set cflist .bright.cfiles
9c311b32 2381 set indent [font measure mainfont "nn"]
e9937d2a 2382 text $cflist \
60378c0c 2383 -selectbackground $selectbgcolor \
f8a2c0d1 2384 -background $bgcolor -foreground $fgcolor \
9c311b32 2385 -font mainfont \
7fcceed7 2386 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 2387 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
2388 -cursor [. cget -cursor] \
2389 -spacing1 1 -spacing3 1
f8a2c0d1
PM
2390 lappend bglist $cflist
2391 lappend fglist $cflist
d93f1713 2392 ${NS}::scrollbar .bright.sb -command "$cflist yview"
e9937d2a 2393 pack .bright.sb -side right -fill y
d2610d11 2394 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
2395 $cflist tag configure highlight \
2396 -background [$cflist cget -selectbackground]
9c311b32 2397 $cflist tag configure bold -font mainfontbold
d2610d11 2398
e9937d2a
JH
2399 .pwbottom add .bright
2400 .ctop add .pwbottom
1db95b00 2401
b9bee115 2402 # restore window width & height if known
e9937d2a 2403 if {[info exists geometry(main)]} {
b9bee115
PM
2404 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2405 if {$w > [winfo screenwidth .]} {
2406 set w [winfo screenwidth .]
2407 }
2408 if {$h > [winfo screenheight .]} {
2409 set h [winfo screenheight .]
2410 }
2411 wm geometry . "${w}x$h"
2412 }
e9937d2a
JH
2413 }
2414
c876dbad
PT
2415 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2416 wm state . $geometry(state)
2417 }
2418
d23d98d3
SP
2419 if {[tk windowingsystem] eq {aqua}} {
2420 set M1B M1
5fdcbb13 2421 set ::BM "3"
d23d98d3
SP
2422 } else {
2423 set M1B Control
5fdcbb13 2424 set ::BM "2"
d23d98d3
SP
2425 }
2426
d93f1713
PT
2427 if {$use_ttk} {
2428 bind .ctop <Map> {
2429 bind %W <Map> {}
2430 %W sashpos 0 $::geometry(topheight)
2431 }
2432 bind .pwbottom <Map> {
2433 bind %W <Map> {}
2434 %W sashpos 0 $::geometry(botwidth)
2435 }
2436 }
2437
e9937d2a
JH
2438 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2439 pack .ctop -fill both -expand 1
c8dfbcf9
PM
2440 bindall <1> {selcanvline %W %x %y}
2441 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
2442 if {[tk windowingsystem] == "win32"} {
2443 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2444 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2445 } else {
2446 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2447 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
5dd57d51
JS
2448 if {[tk windowingsystem] eq "aqua"} {
2449 bindall <MouseWheel> {
2450 set delta [expr {- (%D)}]
2451 allcanvs yview scroll $delta units
2452 }
5fdcbb13
DS
2453 bindall <Shift-MouseWheel> {
2454 set delta [expr {- (%D)}]
2455 $canv xview scroll $delta units
2456 }
5dd57d51 2457 }
314c3093 2458 }
5fdcbb13
DS
2459 bindall <$::BM> "canvscan mark %W %x %y"
2460 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
decd0a1e
JL
2461 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2462 bind . <$M1B-Key-w> doquit
6e5f7203
RN
2463 bindkey <Home> selfirstline
2464 bindkey <End> sellastline
17386066
PM
2465 bind . <Key-Up> "selnextline -1"
2466 bind . <Key-Down> "selnextline 1"
cca5d946
PM
2467 bind . <Shift-Key-Up> "dofind -1 0"
2468 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
2469 bindkey <Key-Right> "goforw"
2470 bindkey <Key-Left> "goback"
2471 bind . <Key-Prior> "selnextpage -1"
2472 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
2473 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2474 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2475 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2476 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2477 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2478 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
2479 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2480 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2481 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
2482 bindkey p "selnextline -1"
2483 bindkey n "selnextline 1"
6e2dda35
RS
2484 bindkey z "goback"
2485 bindkey x "goforw"
811c70fc
JN
2486 bindkey k "selnextline -1"
2487 bindkey j "selnextline 1"
2488 bindkey h "goback"
6e2dda35 2489 bindkey l "goforw"
f4c54b3c 2490 bindkey b prevfile
cfb4563c
PM
2491 bindkey d "$ctext yview scroll 18 units"
2492 bindkey u "$ctext yview scroll -18 units"
97bed034 2493 bindkey / {focus $fstring}
b6e192db 2494 bindkey <Key-KP_Divide> {focus $fstring}
cca5d946
PM
2495 bindkey <Key-Return> {dofind 1 1}
2496 bindkey ? {dofind -1 1}
39ad8570 2497 bindkey f nextfile
cea07cf8 2498 bind . <F5> updatecommits
a135f214 2499 bind . <Shift-F5> reloadcommits
cea07cf8
AG
2500 bind . <F2> showrefs
2501 bind . <Shift-F4> {newview 0}
2502 catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
2503 bind . <F4> edit_or_newview
d23d98d3 2504 bind . <$M1B-q> doquit
cca5d946
PM
2505 bind . <$M1B-f> {dofind 1 1}
2506 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
2507 bind . <$M1B-r> dosearchback
2508 bind . <$M1B-s> dosearch
2509 bind . <$M1B-equal> {incrfont 1}
646f3a14 2510 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
2511 bind . <$M1B-KP_Add> {incrfont 1}
2512 bind . <$M1B-minus> {incrfont -1}
2513 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 2514 wm protocol . WM_DELETE_WINDOW doquit
e2f90ee4 2515 bind . <Destroy> {stop_backends}
df3d83b1 2516 bind . <Button-1> "click %W"
cca5d946 2517 bind $fstring <Key-Return> {dofind 1 1}
968ce45c 2518 bind $sha1entry <Key-Return> {gotocommit; break}
ee3dc72e 2519 bind $sha1entry <<PasteSelection>> clearsha1
7fcceed7
PM
2520 bind $cflist <1> {sel_flist %W %x %y; break}
2521 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 2522 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
d277e89f
PM
2523 global ctxbut
2524 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
7cdc3556 2525 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
4adcbea0 2526 bind $ctext <Button-1> {focus %W}
c4614994 2527 bind $ctext <<Selection>> rehighlight_search_results
ea13cba1
PM
2528
2529 set maincursor [. cget -cursor]
2530 set textcursor [$ctext cget -cursor]
94a2eede 2531 set curtextcursor $textcursor
84ba7345 2532
c8dfbcf9 2533 set rowctxmenu .rowctxmenu
f2d0bbbd 2534 makemenu $rowctxmenu {
79056034
PM
2535 {mc "Diff this -> selected" command {diffvssel 0}}
2536 {mc "Diff selected -> this" command {diffvssel 1}}
2537 {mc "Make patch" command mkpatch}
2538 {mc "Create tag" command mktag}
2539 {mc "Write commit to file" command writecommit}
2540 {mc "Create new branch" command mkbranch}
2541 {mc "Cherry-pick this commit" command cherrypick}
2542 {mc "Reset HEAD branch to here" command resethead}
b9fdba7f
PM
2543 {mc "Mark this commit" command markhere}
2544 {mc "Return to mark" command gotomark}
2545 {mc "Find descendant of this and mark" command find_common_desc}
010509f2 2546 {mc "Compare with marked commit" command compare_commits}
6febdede
PM
2547 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2548 {mc "Diff marked commit -> this" command {diffvsmark 1}}
f2d0bbbd
PM
2549 }
2550 $rowctxmenu configure -tearoff 0
10299152 2551
219ea3a9 2552 set fakerowmenu .fakerowmenu
f2d0bbbd 2553 makemenu $fakerowmenu {
79056034
PM
2554 {mc "Diff this -> selected" command {diffvssel 0}}
2555 {mc "Diff selected -> this" command {diffvssel 1}}
2556 {mc "Make patch" command mkpatch}
6febdede
PM
2557 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2558 {mc "Diff marked commit -> this" command {diffvsmark 1}}
f2d0bbbd
PM
2559 }
2560 $fakerowmenu configure -tearoff 0
219ea3a9 2561
10299152 2562 set headctxmenu .headctxmenu
f2d0bbbd 2563 makemenu $headctxmenu {
79056034
PM
2564 {mc "Check out this branch" command cobranch}
2565 {mc "Remove this branch" command rmbranch}
f2d0bbbd
PM
2566 }
2567 $headctxmenu configure -tearoff 0
3244729a
PM
2568
2569 global flist_menu
2570 set flist_menu .flistctxmenu
f2d0bbbd 2571 makemenu $flist_menu {
79056034
PM
2572 {mc "Highlight this too" command {flist_hl 0}}
2573 {mc "Highlight this only" command {flist_hl 1}}
2574 {mc "External diff" command {external_diff}}
2575 {mc "Blame parent commit" command {external_blame 1}}
f2d0bbbd
PM
2576 }
2577 $flist_menu configure -tearoff 0
7cdc3556
AG
2578
2579 global diff_menu
2580 set diff_menu .diffctxmenu
2581 makemenu $diff_menu {
8a897742 2582 {mc "Show origin of this line" command show_line_source}
7cdc3556
AG
2583 {mc "Run git gui blame on this line" command {external_blame_diff}}
2584 }
2585 $diff_menu configure -tearoff 0
df3d83b1
PM
2586}
2587
314c3093
ML
2588# Windows sends all mouse wheel events to the current focused window, not
2589# the one where the mouse hovers, so bind those events here and redirect
2590# to the correct window
2591proc windows_mousewheel_redirector {W X Y D} {
2592 global canv canv2 canv3
2593 set w [winfo containing -displayof $W $X $Y]
2594 if {$w ne ""} {
2595 set u [expr {$D < 0 ? 5 : -5}]
2596 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2597 allcanvs yview scroll $u units
2598 } else {
2599 catch {
2600 $w yview scroll $u units
2601 }
2602 }
2603 }
2604}
2605
6df7403a
PM
2606# Update row number label when selectedline changes
2607proc selectedline_change {n1 n2 op} {
2608 global selectedline rownumsel
2609
94b4a69f 2610 if {$selectedline eq {}} {
6df7403a
PM
2611 set rownumsel {}
2612 } else {
2613 set rownumsel [expr {$selectedline + 1}]
2614 }
2615}
2616
be0cd098
PM
2617# mouse-2 makes all windows scan vertically, but only the one
2618# the cursor is in scans horizontally
2619proc canvscan {op w x y} {
2620 global canv canv2 canv3
2621 foreach c [list $canv $canv2 $canv3] {
2622 if {$c == $w} {
2623 $c scan $op $x $y
2624 } else {
2625 $c scan $op 0 $y
2626 }
2627 }
2628}
2629
9f1afe05
PM
2630proc scrollcanv {cscroll f0 f1} {
2631 $cscroll set $f0 $f1
31c0eaa8 2632 drawvisible
908c3585 2633 flushhighlights
9f1afe05
PM
2634}
2635
df3d83b1
PM
2636# when we make a key binding for the toplevel, make sure
2637# it doesn't get triggered when that key is pressed in the
2638# find string entry widget.
2639proc bindkey {ev script} {
887fe3c4 2640 global entries
df3d83b1
PM
2641 bind . $ev $script
2642 set escript [bind Entry $ev]
2643 if {$escript == {}} {
2644 set escript [bind Entry <Key>]
2645 }
887fe3c4
PM
2646 foreach e $entries {
2647 bind $e $ev "$escript; break"
2648 }
df3d83b1
PM
2649}
2650
2651# set the focus back to the toplevel for any click outside
887fe3c4 2652# the entry widgets
df3d83b1 2653proc click {w} {
bd441de4
ML
2654 global ctext entries
2655 foreach e [concat $entries $ctext] {
887fe3c4 2656 if {$w == $e} return
df3d83b1 2657 }
887fe3c4 2658 focus .
0fba86b3
PM
2659}
2660
bb3edc8b
PM
2661# Adjust the progress bar for a change in requested extent or canvas size
2662proc adjustprogress {} {
2663 global progresscanv progressitem progresscoords
2664 global fprogitem fprogcoord lastprogupdate progupdatepending
d93f1713
PT
2665 global rprogitem rprogcoord use_ttk
2666
2667 if {$use_ttk} {
2668 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2669 return
2670 }
bb3edc8b
PM
2671
2672 set w [expr {[winfo width $progresscanv] - 4}]
2673 set x0 [expr {$w * [lindex $progresscoords 0]}]
2674 set x1 [expr {$w * [lindex $progresscoords 1]}]
2675 set h [winfo height $progresscanv]
2676 $progresscanv coords $progressitem $x0 0 $x1 $h
2677 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 2678 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
2679 set now [clock clicks -milliseconds]
2680 if {$now >= $lastprogupdate + 100} {
2681 set progupdatepending 0
2682 update
2683 } elseif {!$progupdatepending} {
2684 set progupdatepending 1
2685 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2686 }
2687}
2688
2689proc doprogupdate {} {
2690 global lastprogupdate progupdatepending
2691
2692 if {$progupdatepending} {
2693 set progupdatepending 0
2694 set lastprogupdate [clock clicks -milliseconds]
2695 update
2696 }
2697}
2698
0fba86b3 2699proc savestuff {w} {
32f1b3e4 2700 global canv canv2 canv3 mainfont textfont uifont tabstop
712fcc08 2701 global stuffsaved findmergefiles maxgraphpct
219ea3a9 2702 global maxwidth showneartags showlocalchanges
2d480856 2703 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
7a39a17a 2704 global cmitmode wrapcomment datetimeformat limitdiffs
5497f7a2 2705 global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
21ac8a8d 2706 global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
0cc08ff7 2707 global hideremotes want_ttk
4ef17537 2708
0fba86b3 2709 if {$stuffsaved} return
df3d83b1 2710 if {![winfo viewable .]} return
0fba86b3 2711 catch {
9bedb0e1 2712 if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
0fba86b3 2713 set f [open "~/.gitk-new" w]
9832e4f2
PM
2714 if {$::tcl_platform(platform) eq {windows}} {
2715 file attributes "~/.gitk-new" -hidden true
2716 }
f0654861
PM
2717 puts $f [list set mainfont $mainfont]
2718 puts $f [list set textfont $textfont]
4840be66 2719 puts $f [list set uifont $uifont]
7e12f1a6 2720 puts $f [list set tabstop $tabstop]
f0654861 2721 puts $f [list set findmergefiles $findmergefiles]
8d858d1a 2722 puts $f [list set maxgraphpct $maxgraphpct]
04c13d38 2723 puts $f [list set maxwidth $maxwidth]
f8b28a40 2724 puts $f [list set cmitmode $cmitmode]
f1b86294 2725 puts $f [list set wrapcomment $wrapcomment]
95293b58 2726 puts $f [list set autoselect $autoselect]
21ac8a8d 2727 puts $f [list set autosellen $autosellen]
b8ab2e17 2728 puts $f [list set showneartags $showneartags]
ffe15297 2729 puts $f [list set hideremotes $hideremotes]
219ea3a9 2730 puts $f [list set showlocalchanges $showlocalchanges]
e8b5f4be 2731 puts $f [list set datetimeformat $datetimeformat]
7a39a17a 2732 puts $f [list set limitdiffs $limitdiffs]
5497f7a2 2733 puts $f [list set uicolor $uicolor]
0cc08ff7 2734 puts $f [list set want_ttk $want_ttk]
f8a2c0d1
PM
2735 puts $f [list set bgcolor $bgcolor]
2736 puts $f [list set fgcolor $fgcolor]
2737 puts $f [list set colors $colors]
2738 puts $f [list set diffcolors $diffcolors]
e3e901be 2739 puts $f [list set markbgcolor $markbgcolor]
890fae70 2740 puts $f [list set diffcontext $diffcontext]
60378c0c 2741 puts $f [list set selectbgcolor $selectbgcolor]
314f5de1 2742 puts $f [list set extdifftool $extdifftool]
39ee47ef 2743 puts $f [list set perfile_attrs $perfile_attrs]
e9937d2a 2744
b6047c5a 2745 puts $f "set geometry(main) [wm geometry .]"
c876dbad 2746 puts $f "set geometry(state) [wm state .]"
e9937d2a
JH
2747 puts $f "set geometry(topwidth) [winfo width .tf]"
2748 puts $f "set geometry(topheight) [winfo height .tf]"
d93f1713
PT
2749 if {$use_ttk} {
2750 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2751 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2752 } else {
2753 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2754 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2755 }
e9937d2a
JH
2756 puts $f "set geometry(botwidth) [winfo width .bleft]"
2757 puts $f "set geometry(botheight) [winfo height .bleft]"
2758
a90a6d24
PM
2759 puts -nonewline $f "set permviews {"
2760 for {set v 0} {$v < $nextviewnum} {incr v} {
2761 if {$viewperm($v)} {
2d480856 2762 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
a90a6d24
PM
2763 }
2764 }
2765 puts $f "}"
0fba86b3
PM
2766 close $f
2767 file rename -force "~/.gitk-new" "~/.gitk"
2768 }
2769 set stuffsaved 1
1db95b00
PM
2770}
2771
43bddeb4 2772proc resizeclistpanes {win w} {
d93f1713 2773 global oldwidth use_ttk
418c4c7b 2774 if {[info exists oldwidth($win)]} {
d93f1713
PT
2775 if {$use_ttk} {
2776 set s0 [$win sashpos 0]
2777 set s1 [$win sashpos 1]
2778 } else {
2779 set s0 [$win sash coord 0]
2780 set s1 [$win sash coord 1]
2781 }
43bddeb4
PM
2782 if {$w < 60} {
2783 set sash0 [expr {int($w/2 - 2)}]
2784 set sash1 [expr {int($w*5/6 - 2)}]
2785 } else {
2786 set factor [expr {1.0 * $w / $oldwidth($win)}]
2787 set sash0 [expr {int($factor * [lindex $s0 0])}]
2788 set sash1 [expr {int($factor * [lindex $s1 0])}]
2789 if {$sash0 < 30} {
2790 set sash0 30
2791 }
2792 if {$sash1 < $sash0 + 20} {
2ed49d54 2793 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
2794 }
2795 if {$sash1 > $w - 10} {
2ed49d54 2796 set sash1 [expr {$w - 10}]
43bddeb4 2797 if {$sash0 > $sash1 - 20} {
2ed49d54 2798 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
2799 }
2800 }
2801 }
d93f1713
PT
2802 if {$use_ttk} {
2803 $win sashpos 0 $sash0
2804 $win sashpos 1 $sash1
2805 } else {
2806 $win sash place 0 $sash0 [lindex $s0 1]
2807 $win sash place 1 $sash1 [lindex $s1 1]
2808 }
43bddeb4
PM
2809 }
2810 set oldwidth($win) $w
2811}
2812
2813proc resizecdetpanes {win w} {
d93f1713 2814 global oldwidth use_ttk
418c4c7b 2815 if {[info exists oldwidth($win)]} {
d93f1713
PT
2816 if {$use_ttk} {
2817 set s0 [$win sashpos 0]
2818 } else {
2819 set s0 [$win sash coord 0]
2820 }
43bddeb4
PM
2821 if {$w < 60} {
2822 set sash0 [expr {int($w*3/4 - 2)}]
2823 } else {
2824 set factor [expr {1.0 * $w / $oldwidth($win)}]
2825 set sash0 [expr {int($factor * [lindex $s0 0])}]
2826 if {$sash0 < 45} {
2827 set sash0 45
2828 }
2829 if {$sash0 > $w - 15} {
2ed49d54 2830 set sash0 [expr {$w - 15}]
43bddeb4
PM
2831 }
2832 }
d93f1713
PT
2833 if {$use_ttk} {
2834 $win sashpos 0 $sash0
2835 } else {
2836 $win sash place 0 $sash0 [lindex $s0 1]
2837 }
43bddeb4
PM
2838 }
2839 set oldwidth($win) $w
2840}
2841
b5721c72
PM
2842proc allcanvs args {
2843 global canv canv2 canv3
2844 eval $canv $args
2845 eval $canv2 $args
2846 eval $canv3 $args
2847}
2848
2849proc bindall {event action} {
2850 global canv canv2 canv3
2851 bind $canv $event $action
2852 bind $canv2 $event $action
2853 bind $canv3 $event $action
2854}
2855
9a40c50c 2856proc about {} {
d93f1713 2857 global uifont NS
9a40c50c
PM
2858 set w .about
2859 if {[winfo exists $w]} {
2860 raise $w
2861 return
2862 }
d93f1713 2863 ttk_toplevel $w
d990cedf 2864 wm title $w [mc "About gitk"]
e7d64008 2865 make_transient $w .
d990cedf 2866 message $w.m -text [mc "
9f1afe05 2867Gitk - a commit viewer for git
9a40c50c 2868
bb3e86a1 2869Copyright \u00a9 2005-2011 Paul Mackerras
9a40c50c 2870
d990cedf 2871Use and redistribute under the terms of the GNU General Public License"] \
3a950e9a
ER
2872 -justify center -aspect 400 -border 2 -bg white -relief groove
2873 pack $w.m -side top -fill x -padx 2 -pady 2
d93f1713 2874 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 2875 pack $w.ok -side bottom
3a950e9a
ER
2876 bind $w <Visibility> "focus $w.ok"
2877 bind $w <Key-Escape> "destroy $w"
2878 bind $w <Key-Return> "destroy $w"
d93f1713 2879 tk::PlaceWindow $w widget .
9a40c50c
PM
2880}
2881
4e95e1f7 2882proc keys {} {
d93f1713 2883 global NS
4e95e1f7
PM
2884 set w .keys
2885 if {[winfo exists $w]} {
2886 raise $w
2887 return
2888 }
d23d98d3
SP
2889 if {[tk windowingsystem] eq {aqua}} {
2890 set M1T Cmd
2891 } else {
2892 set M1T Ctrl
2893 }
d93f1713 2894 ttk_toplevel $w
d990cedf 2895 wm title $w [mc "Gitk key bindings"]
e7d64008 2896 make_transient $w .
3d2c998e
MB
2897 message $w.m -text "
2898[mc "Gitk key bindings:"]
2899
2900[mc "<%s-Q> Quit" $M1T]
decd0a1e 2901[mc "<%s-W> Close window" $M1T]
3d2c998e
MB
2902[mc "<Home> Move to first commit"]
2903[mc "<End> Move to last commit"]
811c70fc
JN
2904[mc "<Up>, p, k Move up one commit"]
2905[mc "<Down>, n, j Move down one commit"]
2906[mc "<Left>, z, h Go back in history list"]
3d2c998e
MB
2907[mc "<Right>, x, l Go forward in history list"]
2908[mc "<PageUp> Move up one page in commit list"]
2909[mc "<PageDown> Move down one page in commit list"]
2910[mc "<%s-Home> Scroll to top of commit list" $M1T]
2911[mc "<%s-End> Scroll to bottom of commit list" $M1T]
2912[mc "<%s-Up> Scroll commit list up one line" $M1T]
2913[mc "<%s-Down> Scroll commit list down one line" $M1T]
2914[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2915[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2916[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2917[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2918[mc "<Delete>, b Scroll diff view up one page"]
2919[mc "<Backspace> Scroll diff view up one page"]
2920[mc "<Space> Scroll diff view down one page"]
2921[mc "u Scroll diff view up 18 lines"]
2922[mc "d Scroll diff view down 18 lines"]
2923[mc "<%s-F> Find" $M1T]
2924[mc "<%s-G> Move to next find hit" $M1T]
2925[mc "<Return> Move to next find hit"]
97bed034 2926[mc "/ Focus the search box"]
3d2c998e
MB
2927[mc "? Move to previous find hit"]
2928[mc "f Scroll diff view to next file"]
2929[mc "<%s-S> Search for next hit in diff view" $M1T]
2930[mc "<%s-R> Search for previous hit in diff view" $M1T]
2931[mc "<%s-KP+> Increase font size" $M1T]
2932[mc "<%s-plus> Increase font size" $M1T]
2933[mc "<%s-KP-> Decrease font size" $M1T]
2934[mc "<%s-minus> Decrease font size" $M1T]
2935[mc "<F5> Update"]
2936" \
3a950e9a
ER
2937 -justify left -bg white -border 2 -relief groove
2938 pack $w.m -side top -fill both -padx 2 -pady 2
d93f1713 2939 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
76f15947 2940 bind $w <Key-Escape> [list destroy $w]
4e95e1f7 2941 pack $w.ok -side bottom
3a950e9a
ER
2942 bind $w <Visibility> "focus $w.ok"
2943 bind $w <Key-Escape> "destroy $w"
2944 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
2945}
2946
7fcceed7
PM
2947# Procedures for manipulating the file list window at the
2948# bottom right of the overall window.
f8b28a40
PM
2949
2950proc treeview {w l openlevs} {
2951 global treecontents treediropen treeheight treeparent treeindex
2952
2953 set ix 0
2954 set treeindex() 0
2955 set lev 0
2956 set prefix {}
2957 set prefixend -1
2958 set prefendstack {}
2959 set htstack {}
2960 set ht 0
2961 set treecontents() {}
2962 $w conf -state normal
2963 foreach f $l {
2964 while {[string range $f 0 $prefixend] ne $prefix} {
2965 if {$lev <= $openlevs} {
2966 $w mark set e:$treeindex($prefix) "end -1c"
2967 $w mark gravity e:$treeindex($prefix) left
2968 }
2969 set treeheight($prefix) $ht
2970 incr ht [lindex $htstack end]
2971 set htstack [lreplace $htstack end end]
2972 set prefixend [lindex $prefendstack end]
2973 set prefendstack [lreplace $prefendstack end end]
2974 set prefix [string range $prefix 0 $prefixend]
2975 incr lev -1
2976 }
2977 set tail [string range $f [expr {$prefixend+1}] end]
2978 while {[set slash [string first "/" $tail]] >= 0} {
2979 lappend htstack $ht
2980 set ht 0
2981 lappend prefendstack $prefixend
2982 incr prefixend [expr {$slash + 1}]
2983 set d [string range $tail 0 $slash]
2984 lappend treecontents($prefix) $d
2985 set oldprefix $prefix
2986 append prefix $d
2987 set treecontents($prefix) {}
2988 set treeindex($prefix) [incr ix]
2989 set treeparent($prefix) $oldprefix
2990 set tail [string range $tail [expr {$slash+1}] end]
2991 if {$lev <= $openlevs} {
2992 set ht 1
2993 set treediropen($prefix) [expr {$lev < $openlevs}]
2994 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2995 $w mark set d:$ix "end -1c"
2996 $w mark gravity d:$ix left
2997 set str "\n"
2998 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2999 $w insert end $str
3000 $w image create end -align center -image $bm -padx 1 \
3001 -name a:$ix
45a9d505 3002 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
3003 $w mark set s:$ix "end -1c"
3004 $w mark gravity s:$ix left
3005 }
3006 incr lev
3007 }
3008 if {$tail ne {}} {
3009 if {$lev <= $openlevs} {
3010 incr ht
3011 set str "\n"
3012 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3013 $w insert end $str
45a9d505 3014 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
3015 }
3016 lappend treecontents($prefix) $tail
3017 }
3018 }
3019 while {$htstack ne {}} {
3020 set treeheight($prefix) $ht
3021 incr ht [lindex $htstack end]
3022 set htstack [lreplace $htstack end end]
096e96b4
BD
3023 set prefixend [lindex $prefendstack end]
3024 set prefendstack [lreplace $prefendstack end end]
3025 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
3026 }
3027 $w conf -state disabled
3028}
3029
3030proc linetoelt {l} {
3031 global treeheight treecontents
3032
3033 set y 2
3034 set prefix {}
3035 while {1} {
3036 foreach e $treecontents($prefix) {
3037 if {$y == $l} {
3038 return "$prefix$e"
3039 }
3040 set n 1
3041 if {[string index $e end] eq "/"} {
3042 set n $treeheight($prefix$e)
3043 if {$y + $n > $l} {
3044 append prefix $e
3045 incr y
3046 break
3047 }
3048 }
3049 incr y $n
3050 }
3051 }
3052}
3053
45a9d505
PM
3054proc highlight_tree {y prefix} {
3055 global treeheight treecontents cflist
3056
3057 foreach e $treecontents($prefix) {
3058 set path $prefix$e
3059 if {[highlight_tag $path] ne {}} {
3060 $cflist tag add bold $y.0 "$y.0 lineend"
3061 }
3062 incr y
3063 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3064 set y [highlight_tree $y $path]
3065 }
3066 }
3067 return $y
3068}
3069
f8b28a40
PM
3070proc treeclosedir {w dir} {
3071 global treediropen treeheight treeparent treeindex
3072
3073 set ix $treeindex($dir)
3074 $w conf -state normal
3075 $w delete s:$ix e:$ix
3076 set treediropen($dir) 0
3077 $w image configure a:$ix -image tri-rt
3078 $w conf -state disabled
3079 set n [expr {1 - $treeheight($dir)}]
3080 while {$dir ne {}} {
3081 incr treeheight($dir) $n
3082 set dir $treeparent($dir)
3083 }
3084}
3085
3086proc treeopendir {w dir} {
3087 global treediropen treeheight treeparent treecontents treeindex
3088
3089 set ix $treeindex($dir)
3090 $w conf -state normal
3091 $w image configure a:$ix -image tri-dn
3092 $w mark set e:$ix s:$ix
3093 $w mark gravity e:$ix right
3094 set lev 0
3095 set str "\n"
3096 set n [llength $treecontents($dir)]
3097 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3098 incr lev
3099 append str "\t"
3100 incr treeheight($x) $n
3101 }
3102 foreach e $treecontents($dir) {
45a9d505 3103 set de $dir$e
f8b28a40 3104 if {[string index $e end] eq "/"} {
f8b28a40
PM
3105 set iy $treeindex($de)
3106 $w mark set d:$iy e:$ix
3107 $w mark gravity d:$iy left
3108 $w insert e:$ix $str
3109 set treediropen($de) 0
3110 $w image create e:$ix -align center -image tri-rt -padx 1 \
3111 -name a:$iy
45a9d505 3112 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3113 $w mark set s:$iy e:$ix
3114 $w mark gravity s:$iy left
3115 set treeheight($de) 1
3116 } else {
3117 $w insert e:$ix $str
45a9d505 3118 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3119 }
3120 }
b8a640ee 3121 $w mark gravity e:$ix right
f8b28a40
PM
3122 $w conf -state disabled
3123 set treediropen($dir) 1
3124 set top [lindex [split [$w index @0,0] .] 0]
3125 set ht [$w cget -height]
3126 set l [lindex [split [$w index s:$ix] .] 0]
3127 if {$l < $top} {
3128 $w yview $l.0
3129 } elseif {$l + $n + 1 > $top + $ht} {
3130 set top [expr {$l + $n + 2 - $ht}]
3131 if {$l < $top} {
3132 set top $l
3133 }
3134 $w yview $top.0
3135 }
3136}
3137
3138proc treeclick {w x y} {
3139 global treediropen cmitmode ctext cflist cflist_top
3140
3141 if {$cmitmode ne "tree"} return
3142 if {![info exists cflist_top]} return
3143 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3144 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3145 $cflist tag add highlight $l.0 "$l.0 lineend"
3146 set cflist_top $l
3147 if {$l == 1} {
3148 $ctext yview 1.0
3149 return
3150 }
3151 set e [linetoelt $l]
3152 if {[string index $e end] ne "/"} {
3153 showfile $e
3154 } elseif {$treediropen($e)} {
3155 treeclosedir $w $e
3156 } else {
3157 treeopendir $w $e
3158 }
3159}
3160
3161proc setfilelist {id} {
8a897742 3162 global treefilelist cflist jump_to_here
f8b28a40
PM
3163
3164 treeview $cflist $treefilelist($id) 0
8a897742
PM
3165 if {$jump_to_here ne {}} {
3166 set f [lindex $jump_to_here 0]
3167 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3168 showfile $f
3169 }
3170 }
f8b28a40
PM
3171}
3172
3173image create bitmap tri-rt -background black -foreground blue -data {
3174 #define tri-rt_width 13
3175 #define tri-rt_height 13
3176 static unsigned char tri-rt_bits[] = {
3177 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3178 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3179 0x00, 0x00};
3180} -maskdata {
3181 #define tri-rt-mask_width 13
3182 #define tri-rt-mask_height 13
3183 static unsigned char tri-rt-mask_bits[] = {
3184 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3185 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3186 0x08, 0x00};
3187}
3188image create bitmap tri-dn -background black -foreground blue -data {
3189 #define tri-dn_width 13
3190 #define tri-dn_height 13
3191 static unsigned char tri-dn_bits[] = {
3192 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3193 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3194 0x00, 0x00};
3195} -maskdata {
3196 #define tri-dn-mask_width 13
3197 #define tri-dn-mask_height 13
3198 static unsigned char tri-dn-mask_bits[] = {
3199 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3200 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3201 0x00, 0x00};
3202}
3203
887c996e
PM
3204image create bitmap reficon-T -background black -foreground yellow -data {
3205 #define tagicon_width 13
3206 #define tagicon_height 9
3207 static unsigned char tagicon_bits[] = {
3208 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3209 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3210} -maskdata {
3211 #define tagicon-mask_width 13
3212 #define tagicon-mask_height 9
3213 static unsigned char tagicon-mask_bits[] = {
3214 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3215 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3216}
3217set rectdata {
3218 #define headicon_width 13
3219 #define headicon_height 9
3220 static unsigned char headicon_bits[] = {
3221 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3222 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3223}
3224set rectmask {
3225 #define headicon-mask_width 13
3226 #define headicon-mask_height 9
3227 static unsigned char headicon-mask_bits[] = {
3228 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3229 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3230}
3231image create bitmap reficon-H -background black -foreground green \
3232 -data $rectdata -maskdata $rectmask
3233image create bitmap reficon-o -background black -foreground "#ddddff" \
3234 -data $rectdata -maskdata $rectmask
3235
7fcceed7 3236proc init_flist {first} {
7fcc92bf 3237 global cflist cflist_top difffilestart
7fcceed7
PM
3238
3239 $cflist conf -state normal
3240 $cflist delete 0.0 end
3241 if {$first ne {}} {
3242 $cflist insert end $first
3243 set cflist_top 1
7fcceed7
PM
3244 $cflist tag add highlight 1.0 "1.0 lineend"
3245 } else {
3246 catch {unset cflist_top}
3247 }
3248 $cflist conf -state disabled
3249 set difffilestart {}
3250}
3251
63b79191
PM
3252proc highlight_tag {f} {
3253 global highlight_paths
3254
3255 foreach p $highlight_paths {
3256 if {[string match $p $f]} {
3257 return "bold"
3258 }
3259 }
3260 return {}
3261}
3262
3263proc highlight_filelist {} {
45a9d505 3264 global cmitmode cflist
63b79191 3265
45a9d505
PM
3266 $cflist conf -state normal
3267 if {$cmitmode ne "tree"} {
63b79191
PM
3268 set end [lindex [split [$cflist index end] .] 0]
3269 for {set l 2} {$l < $end} {incr l} {
3270 set line [$cflist get $l.0 "$l.0 lineend"]
3271 if {[highlight_tag $line] ne {}} {
3272 $cflist tag add bold $l.0 "$l.0 lineend"
3273 }
3274 }
45a9d505
PM
3275 } else {
3276 highlight_tree 2 {}
63b79191 3277 }
45a9d505 3278 $cflist conf -state disabled
63b79191
PM
3279}
3280
3281proc unhighlight_filelist {} {
45a9d505 3282 global cflist
63b79191 3283
45a9d505
PM
3284 $cflist conf -state normal
3285 $cflist tag remove bold 1.0 end
3286 $cflist conf -state disabled
63b79191
PM
3287}
3288
f8b28a40 3289proc add_flist {fl} {
45a9d505 3290 global cflist
7fcceed7 3291
45a9d505
PM
3292 $cflist conf -state normal
3293 foreach f $fl {
3294 $cflist insert end "\n"
3295 $cflist insert end $f [highlight_tag $f]
7fcceed7 3296 }
45a9d505 3297 $cflist conf -state disabled
7fcceed7
PM
3298}
3299
3300proc sel_flist {w x y} {
45a9d505 3301 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 3302
f8b28a40 3303 if {$cmitmode eq "tree"} return
7fcceed7
PM
3304 if {![info exists cflist_top]} return
3305 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
3306 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3307 $cflist tag add highlight $l.0 "$l.0 lineend"
3308 set cflist_top $l
f8b28a40
PM
3309 if {$l == 1} {
3310 $ctext yview 1.0
3311 } else {
3312 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 3313 }
b967135d 3314 suppress_highlighting_file_for_current_scrollpos
7fcceed7
PM
3315}
3316
3244729a
PM
3317proc pop_flist_menu {w X Y x y} {
3318 global ctext cflist cmitmode flist_menu flist_menu_file
3319 global treediffs diffids
3320
bb3edc8b 3321 stopfinding
3244729a
PM
3322 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3323 if {$l <= 1} return
3324 if {$cmitmode eq "tree"} {
3325 set e [linetoelt $l]
3326 if {[string index $e end] eq "/"} return
3327 } else {
3328 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3329 }
3330 set flist_menu_file $e
314f5de1
TA
3331 set xdiffstate "normal"
3332 if {$cmitmode eq "tree"} {
3333 set xdiffstate "disabled"
3334 }
3335 # Disable "External diff" item in tree mode
3336 $flist_menu entryconf 2 -state $xdiffstate
3244729a
PM
3337 tk_popup $flist_menu $X $Y
3338}
3339
7cdc3556
AG
3340proc find_ctext_fileinfo {line} {
3341 global ctext_file_names ctext_file_lines
3342
3343 set ok [bsearch $ctext_file_lines $line]
3344 set tline [lindex $ctext_file_lines $ok]
3345
3346 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3347 return {}
3348 } else {
3349 return [list [lindex $ctext_file_names $ok] $tline]
3350 }
3351}
3352
3353proc pop_diff_menu {w X Y x y} {
3354 global ctext diff_menu flist_menu_file
3355 global diff_menu_txtpos diff_menu_line
3356 global diff_menu_filebase
3357
7cdc3556
AG
3358 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3359 set diff_menu_line [lindex $diff_menu_txtpos 0]
190ec52c
PM
3360 # don't pop up the menu on hunk-separator or file-separator lines
3361 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3362 return
3363 }
3364 stopfinding
7cdc3556
AG
3365 set f [find_ctext_fileinfo $diff_menu_line]
3366 if {$f eq {}} return
3367 set flist_menu_file [lindex $f 0]
3368 set diff_menu_filebase [lindex $f 1]
3369 tk_popup $diff_menu $X $Y
3370}
3371
3244729a 3372proc flist_hl {only} {
bb3edc8b 3373 global flist_menu_file findstring gdttype
3244729a
PM
3374
3375 set x [shellquote $flist_menu_file]
b007ee20 3376 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 3377 set findstring $x
3244729a 3378 } else {
bb3edc8b 3379 append findstring " " $x
3244729a 3380 }
b007ee20 3381 set gdttype [mc "touching paths:"]
3244729a
PM
3382}
3383
c21398be
PM
3384proc gitknewtmpdir {} {
3385 global diffnum gitktmpdir gitdir
3386
3387 if {![info exists gitktmpdir]} {
929f577e 3388 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
c21398be
PM
3389 if {[catch {file mkdir $gitktmpdir} err]} {
3390 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3391 unset gitktmpdir
3392 return {}
3393 }
3394 set diffnum 0
3395 }
3396 incr diffnum
3397 set diffdir [file join $gitktmpdir $diffnum]
3398 if {[catch {file mkdir $diffdir} err]} {
3399 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3400 return {}
3401 }
3402 return $diffdir
3403}
3404
314f5de1
TA
3405proc save_file_from_commit {filename output what} {
3406 global nullfile
3407
3408 if {[catch {exec git show $filename -- > $output} err]} {
3409 if {[string match "fatal: bad revision *" $err]} {
3410 return $nullfile
3411 }
3945d2c0 3412 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
314f5de1
TA
3413 return {}
3414 }
3415 return $output
3416}
3417
3418proc external_diff_get_one_file {diffid filename diffdir} {
3419 global nullid nullid2 nullfile
784b7e2f 3420 global worktree
314f5de1
TA
3421
3422 if {$diffid == $nullid} {
784b7e2f 3423 set difffile [file join $worktree $filename]
314f5de1
TA
3424 if {[file exists $difffile]} {
3425 return $difffile
3426 }
3427 return $nullfile
3428 }
3429 if {$diffid == $nullid2} {
3430 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3431 return [save_file_from_commit :$filename $difffile index]
3432 }
3433 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3434 return [save_file_from_commit $diffid:$filename $difffile \
3435 "revision $diffid"]
3436}
3437
3438proc external_diff {} {
c21398be 3439 global nullid nullid2
314f5de1
TA
3440 global flist_menu_file
3441 global diffids
c21398be 3442 global extdifftool
314f5de1
TA
3443
3444 if {[llength $diffids] == 1} {
3445 # no reference commit given
3446 set diffidto [lindex $diffids 0]
3447 if {$diffidto eq $nullid} {
3448 # diffing working copy with index
3449 set diffidfrom $nullid2
3450 } elseif {$diffidto eq $nullid2} {
3451 # diffing index with HEAD
3452 set diffidfrom "HEAD"
3453 } else {
3454 # use first parent commit
3455 global parentlist selectedline
3456 set diffidfrom [lindex $parentlist $selectedline 0]
3457 }
3458 } else {
3459 set diffidfrom [lindex $diffids 0]
3460 set diffidto [lindex $diffids 1]
3461 }
3462
3463 # make sure that several diffs wont collide
c21398be
PM
3464 set diffdir [gitknewtmpdir]
3465 if {$diffdir eq {}} return
314f5de1
TA
3466
3467 # gather files to diff
3468 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3469 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3470
3471 if {$difffromfile ne {} && $difftofile ne {}} {
b575b2f1
PT
3472 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3473 if {[catch {set fl [open |$cmd r]} err]} {
314f5de1 3474 file delete -force $diffdir
3945d2c0 3475 error_popup "$extdifftool: [mc "command failed:"] $err"
314f5de1
TA
3476 } else {
3477 fconfigure $fl -blocking 0
3478 filerun $fl [list delete_at_eof $fl $diffdir]
3479 }
3480 }
3481}
3482
7cdc3556
AG
3483proc find_hunk_blamespec {base line} {
3484 global ctext
3485
3486 # Find and parse the hunk header
3487 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3488 if {$s_lix eq {}} return
3489
3490 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3491 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3492 s_line old_specs osz osz1 new_line nsz]} {
3493 return
3494 }
3495
3496 # base lines for the parents
3497 set base_lines [list $new_line]
3498 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3499 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3500 old_spec old_line osz]} {
3501 return
3502 }
3503 lappend base_lines $old_line
3504 }
3505
3506 # Now scan the lines to determine offset within the hunk
7cdc3556
AG
3507 set max_parent [expr {[llength $base_lines]-2}]
3508 set dline 0
3509 set s_lno [lindex [split $s_lix "."] 0]
3510
190ec52c
PM
3511 # Determine if the line is removed
3512 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3513 if {[string match {[-+ ]*} $chunk]} {
7cdc3556
AG
3514 set removed_idx [string first "-" $chunk]
3515 # Choose a parent index
190ec52c
PM
3516 if {$removed_idx >= 0} {
3517 set parent $removed_idx
3518 } else {
3519 set unchanged_idx [string first " " $chunk]
3520 if {$unchanged_idx >= 0} {
3521 set parent $unchanged_idx
7cdc3556 3522 } else {
190ec52c
PM
3523 # blame the current commit
3524 set parent -1
7cdc3556
AG
3525 }
3526 }
3527 # then count other lines that belong to it
190ec52c
PM
3528 for {set i $line} {[incr i -1] > $s_lno} {} {
3529 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3530 # Determine if the line is removed
3531 set removed_idx [string first "-" $chunk]
3532 if {$parent >= 0} {
3533 set code [string index $chunk $parent]
3534 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3535 incr dline
3536 }
3537 } else {
3538 if {$removed_idx < 0} {
3539 incr dline
3540 }
7cdc3556
AG
3541 }
3542 }
190ec52c
PM
3543 incr parent
3544 } else {
3545 set parent 0
7cdc3556
AG
3546 }
3547
7cdc3556
AG
3548 incr dline [lindex $base_lines $parent]
3549 return [list $parent $dline]
3550}
3551
3552proc external_blame_diff {} {
8b07dca1 3553 global currentid cmitmode
7cdc3556
AG
3554 global diff_menu_txtpos diff_menu_line
3555 global diff_menu_filebase flist_menu_file
3556
3557 if {$cmitmode eq "tree"} {
3558 set parent_idx 0
190ec52c 3559 set line [expr {$diff_menu_line - $diff_menu_filebase}]
7cdc3556
AG
3560 } else {
3561 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3562 if {$hinfo ne {}} {
3563 set parent_idx [lindex $hinfo 0]
3564 set line [lindex $hinfo 1]
3565 } else {
3566 set parent_idx 0
3567 set line 0
3568 }
3569 }
3570
3571 external_blame $parent_idx $line
3572}
3573
fc4977e1
PM
3574# Find the SHA1 ID of the blob for file $fname in the index
3575# at stage 0 or 2
3576proc index_sha1 {fname} {
3577 set f [open [list | git ls-files -s $fname] r]
3578 while {[gets $f line] >= 0} {
3579 set info [lindex [split $line "\t"] 0]
3580 set stage [lindex $info 2]
3581 if {$stage eq "0" || $stage eq "2"} {
3582 close $f
3583 return [lindex $info 1]
3584 }
3585 }
3586 close $f
3587 return {}
3588}
3589
9712b81a
PM
3590# Turn an absolute path into one relative to the current directory
3591proc make_relative {f} {
a4390ace
MH
3592 if {[file pathtype $f] eq "relative"} {
3593 return $f
3594 }
9712b81a
PM
3595 set elts [file split $f]
3596 set here [file split [pwd]]
3597 set ei 0
3598 set hi 0
3599 set res {}
3600 foreach d $here {
3601 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3602 lappend res ".."
3603 } else {
3604 incr ei
3605 }
3606 incr hi
3607 }
3608 set elts [concat $res [lrange $elts $ei end]]
3609 return [eval file join $elts]
3610}
3611
7cdc3556 3612proc external_blame {parent_idx {line {}}} {
0a2a9793 3613 global flist_menu_file cdup
77aa0ae8
AG
3614 global nullid nullid2
3615 global parentlist selectedline currentid
3616
3617 if {$parent_idx > 0} {
3618 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3619 } else {
3620 set base_commit $currentid
3621 }
3622
3623 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3624 error_popup [mc "No such commit"]
3625 return
3626 }
3627
7cdc3556
AG
3628 set cmdline [list git gui blame]
3629 if {$line ne {} && $line > 1} {
3630 lappend cmdline "--line=$line"
3631 }
0a2a9793 3632 set f [file join $cdup $flist_menu_file]
9712b81a
PM
3633 # Unfortunately it seems git gui blame doesn't like
3634 # being given an absolute path...
3635 set f [make_relative $f]
3636 lappend cmdline $base_commit $f
7cdc3556 3637 if {[catch {eval exec $cmdline &} err]} {
3945d2c0 3638 error_popup "[mc "git gui blame: command failed:"] $err"
77aa0ae8
AG
3639 }
3640}
3641
8a897742
PM
3642proc show_line_source {} {
3643 global cmitmode currentid parents curview blamestuff blameinst
3644 global diff_menu_line diff_menu_filebase flist_menu_file
9b6adf34 3645 global nullid nullid2 gitdir cdup
8a897742 3646
fc4977e1 3647 set from_index {}
8a897742
PM
3648 if {$cmitmode eq "tree"} {
3649 set id $currentid
3650 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3651 } else {
3652 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3653 if {$h eq {}} return
3654 set pi [lindex $h 0]
3655 if {$pi == 0} {
3656 mark_ctext_line $diff_menu_line
3657 return
3658 }
fc4977e1
PM
3659 incr pi -1
3660 if {$currentid eq $nullid} {
3661 if {$pi > 0} {
3662 # must be a merge in progress...
3663 if {[catch {
3664 # get the last line from .git/MERGE_HEAD
3665 set f [open [file join $gitdir MERGE_HEAD] r]
3666 set id [lindex [split [read $f] "\n"] end-1]
3667 close $f
3668 } err]} {
3669 error_popup [mc "Couldn't read merge head: %s" $err]
3670 return
3671 }
3672 } elseif {$parents($curview,$currentid) eq $nullid2} {
3673 # need to do the blame from the index
3674 if {[catch {
3675 set from_index [index_sha1 $flist_menu_file]
3676 } err]} {
3677 error_popup [mc "Error reading index: %s" $err]
3678 return
3679 }
9712b81a
PM
3680 } else {
3681 set id $parents($curview,$currentid)
fc4977e1
PM
3682 }
3683 } else {
3684 set id [lindex $parents($curview,$currentid) $pi]
3685 }
8a897742
PM
3686 set line [lindex $h 1]
3687 }
fc4977e1
PM
3688 set blameargs {}
3689 if {$from_index ne {}} {
3690 lappend blameargs | git cat-file blob $from_index
3691 }
3692 lappend blameargs | git blame -p -L$line,+1
3693 if {$from_index ne {}} {
3694 lappend blameargs --contents -
3695 } else {
3696 lappend blameargs $id
3697 }
9b6adf34 3698 lappend blameargs -- [file join $cdup $flist_menu_file]
8a897742 3699 if {[catch {
fc4977e1 3700 set f [open $blameargs r]
8a897742
PM
3701 } err]} {
3702 error_popup [mc "Couldn't start git blame: %s" $err]
3703 return
3704 }
f3413079 3705 nowbusy blaming [mc "Searching"]
8a897742
PM
3706 fconfigure $f -blocking 0
3707 set i [reg_instance $f]
3708 set blamestuff($i) {}
3709 set blameinst $i
3710 filerun $f [list read_line_source $f $i]
3711}
3712
3713proc stopblaming {} {
3714 global blameinst
3715
3716 if {[info exists blameinst]} {
3717 stop_instance $blameinst
3718 unset blameinst
f3413079 3719 notbusy blaming
8a897742
PM
3720 }
3721}
3722
3723proc read_line_source {fd inst} {
fc4977e1 3724 global blamestuff curview commfd blameinst nullid nullid2
8a897742
PM
3725
3726 while {[gets $fd line] >= 0} {
3727 lappend blamestuff($inst) $line
3728 }
3729 if {![eof $fd]} {
3730 return 1
3731 }
3732 unset commfd($inst)
3733 unset blameinst
f3413079 3734 notbusy blaming
8a897742
PM
3735 fconfigure $fd -blocking 1
3736 if {[catch {close $fd} err]} {
3737 error_popup [mc "Error running git blame: %s" $err]
3738 return 0
3739 }
3740
3741 set fname {}
3742 set line [split [lindex $blamestuff($inst) 0] " "]
3743 set id [lindex $line 0]
3744 set lnum [lindex $line 1]
3745 if {[string length $id] == 40 && [string is xdigit $id] &&
3746 [string is digit -strict $lnum]} {
3747 # look for "filename" line
3748 foreach l $blamestuff($inst) {
3749 if {[string match "filename *" $l]} {
3750 set fname [string range $l 9 end]
3751 break
3752 }
3753 }
3754 }
3755 if {$fname ne {}} {
3756 # all looks good, select it
fc4977e1
PM
3757 if {$id eq $nullid} {
3758 # blame uses all-zeroes to mean not committed,
3759 # which would mean a change in the index
3760 set id $nullid2
3761 }
8a897742
PM
3762 if {[commitinview $id $curview]} {
3763 selectline [rowofcommit $id] 1 [list $fname $lnum]
3764 } else {
3765 error_popup [mc "That line comes from commit %s, \
3766 which is not in this view" [shortids $id]]
3767 }
3768 } else {
3769 puts "oops couldn't parse git blame output"
3770 }
3771 return 0
3772}
3773
314f5de1
TA
3774# delete $dir when we see eof on $f (presumably because the child has exited)
3775proc delete_at_eof {f dir} {
3776 while {[gets $f line] >= 0} {}
3777 if {[eof $f]} {
3778 if {[catch {close $f} err]} {
3945d2c0 3779 error_popup "[mc "External diff viewer failed:"] $err"
314f5de1
TA
3780 }
3781 file delete -force $dir
3782 return 0
3783 }
3784 return 1
3785}
3786
098dd8a3
PM
3787# Functions for adding and removing shell-type quoting
3788
3789proc shellquote {str} {
3790 if {![string match "*\['\"\\ \t]*" $str]} {
3791 return $str
3792 }
3793 if {![string match "*\['\"\\]*" $str]} {
3794 return "\"$str\""
3795 }
3796 if {![string match "*'*" $str]} {
3797 return "'$str'"
3798 }
3799 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3800}
3801
3802proc shellarglist {l} {
3803 set str {}
3804 foreach a $l {
3805 if {$str ne {}} {
3806 append str " "
3807 }
3808 append str [shellquote $a]
3809 }
3810 return $str
3811}
3812
3813proc shelldequote {str} {
3814 set ret {}
3815 set used -1
3816 while {1} {
3817 incr used
3818 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3819 append ret [string range $str $used end]
3820 set used [string length $str]
3821 break
3822 }
3823 set first [lindex $first 0]
3824 set ch [string index $str $first]
3825 if {$first > $used} {
3826 append ret [string range $str $used [expr {$first - 1}]]
3827 set used $first
3828 }
3829 if {$ch eq " " || $ch eq "\t"} break
3830 incr used
3831 if {$ch eq "'"} {
3832 set first [string first "'" $str $used]
3833 if {$first < 0} {
3834 error "unmatched single-quote"
3835 }
3836 append ret [string range $str $used [expr {$first - 1}]]
3837 set used $first
3838 continue
3839 }
3840 if {$ch eq "\\"} {
3841 if {$used >= [string length $str]} {
3842 error "trailing backslash"
3843 }
3844 append ret [string index $str $used]
3845 continue
3846 }
3847 # here ch == "\""
3848 while {1} {
3849 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3850 error "unmatched double-quote"
3851 }
3852 set first [lindex $first 0]
3853 set ch [string index $str $first]
3854 if {$first > $used} {
3855 append ret [string range $str $used [expr {$first - 1}]]
3856 set used $first
3857 }
3858 if {$ch eq "\""} break
3859 incr used
3860 append ret [string index $str $used]
3861 incr used
3862 }
3863 }
3864 return [list $used $ret]
3865}
3866
3867proc shellsplit {str} {
3868 set l {}
3869 while {1} {
3870 set str [string trimleft $str]
3871 if {$str eq {}} break
3872 set dq [shelldequote $str]
3873 set n [lindex $dq 0]
3874 set word [lindex $dq 1]
3875 set str [string range $str $n end]
3876 lappend l $word
3877 }
3878 return $l
3879}
3880
7fcceed7
PM
3881# Code to implement multiple views
3882
da7c24dd 3883proc newview {ishighlight} {
218a900b
AG
3884 global nextviewnum newviewname newishighlight
3885 global revtreeargs viewargscmd newviewopts curview
50b44ece 3886
da7c24dd 3887 set newishighlight $ishighlight
50b44ece
PM
3888 set top .gitkview
3889 if {[winfo exists $top]} {
3890 raise $top
3891 return
3892 }
5d11f794 3893 decode_view_opts $nextviewnum $revtreeargs
a3a1f579 3894 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
218a900b
AG
3895 set newviewopts($nextviewnum,perm) 0
3896 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
d990cedf 3897 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
3898}
3899
218a900b 3900set known_view_options {
13d40b61
EN
3901 {perm b . {} {mc "Remember this view"}}
3902 {reflabel l + {} {mc "References (space separated list):"}}
3903 {refs t15 .. {} {mc "Branches & tags:"}}
3904 {allrefs b *. "--all" {mc "All refs"}}
3905 {branches b . "--branches" {mc "All (local) branches"}}
3906 {tags b . "--tags" {mc "All tags"}}
3907 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3908 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3909 {author t15 .. "--author=*" {mc "Author:"}}
3910 {committer t15 . "--committer=*" {mc "Committer:"}}
3911 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3912 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3913 {changes_l l + {} {mc "Changes to Files:"}}
3914 {pickaxe_s r0 . {} {mc "Fixed String"}}
3915 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3916 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3917 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3918 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3919 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3920 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3921 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3922 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3923 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3924 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3925 {lright b . "--left-right" {mc "Mark branch sides"}}
3926 {first b . "--first-parent" {mc "Limit to first parent"}}
f687aaa8 3927 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
13d40b61
EN
3928 {args t50 *. {} {mc "Additional arguments to git log:"}}
3929 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
3930 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
218a900b
AG
3931 }
3932
e7feb695 3933# Convert $newviewopts($n, ...) into args for git log.
218a900b
AG
3934proc encode_view_opts {n} {
3935 global known_view_options newviewopts
3936
3937 set rargs [list]
3938 foreach opt $known_view_options {
3939 set patterns [lindex $opt 3]
3940 if {$patterns eq {}} continue
3941 set pattern [lindex $patterns 0]
3942
218a900b 3943 if {[lindex $opt 1] eq "b"} {
13d40b61 3944 set val $newviewopts($n,[lindex $opt 0])
218a900b
AG
3945 if {$val} {
3946 lappend rargs $pattern
3947 }
13d40b61
EN
3948 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
3949 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
3950 set val $newviewopts($n,$button_id)
3951 if {$val eq $value} {
3952 lappend rargs $pattern
3953 }
218a900b 3954 } else {
13d40b61 3955 set val $newviewopts($n,[lindex $opt 0])
218a900b
AG
3956 set val [string trim $val]
3957 if {$val ne {}} {
3958 set pfix [string range $pattern 0 end-1]
3959 lappend rargs $pfix$val
3960 }
3961 }
3962 }
13d40b61 3963 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
218a900b
AG
3964 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3965}
3966
e7feb695 3967# Fill $newviewopts($n, ...) based on args for git log.
218a900b
AG
3968proc decode_view_opts {n view_args} {
3969 global known_view_options newviewopts
3970
3971 foreach opt $known_view_options {
13d40b61 3972 set id [lindex $opt 0]
218a900b 3973 if {[lindex $opt 1] eq "b"} {
13d40b61
EN
3974 # Checkboxes
3975 set val 0
3976 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
3977 # Radiobuttons
3978 regexp {^(.*_)} $id uselessvar id
218a900b
AG
3979 set val 0
3980 } else {
13d40b61 3981 # Text fields
218a900b
AG
3982 set val {}
3983 }
13d40b61 3984 set newviewopts($n,$id) $val
218a900b
AG
3985 }
3986 set oargs [list]
13d40b61 3987 set refargs [list]
218a900b
AG
3988 foreach arg $view_args {
3989 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3990 && ![info exists found(limit)]} {
3991 set newviewopts($n,limit) $cnt
3992 set found(limit) 1
3993 continue
3994 }
3995 catch { unset val }
3996 foreach opt $known_view_options {
3997 set id [lindex $opt 0]
3998 if {[info exists found($id)]} continue
3999 foreach pattern [lindex $opt 3] {
4000 if {![string match $pattern $arg]} continue
13d40b61
EN
4001 if {[lindex $opt 1] eq "b"} {
4002 # Check buttons
4003 set val 1
4004 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4005 # Radio buttons
4006 regexp {^(.*_)} $id uselessvar id
4007 set val $num
4008 } else {
4009 # Text input fields
218a900b
AG
4010 set size [string length $pattern]
4011 set val [string range $arg [expr {$size-1}] end]
218a900b
AG
4012 }
4013 set newviewopts($n,$id) $val
4014 set found($id) 1
4015 break
4016 }
4017 if {[info exists val]} break
4018 }
4019 if {[info exists val]} continue
13d40b61
EN
4020 if {[regexp {^-} $arg]} {
4021 lappend oargs $arg
4022 } else {
4023 lappend refargs $arg
4024 }
218a900b 4025 }
13d40b61 4026 set newviewopts($n,refs) [shellarglist $refargs]
218a900b
AG
4027 set newviewopts($n,args) [shellarglist $oargs]
4028}
4029
cea07cf8
AG
4030proc edit_or_newview {} {
4031 global curview
4032
4033 if {$curview > 0} {
4034 editview
4035 } else {
4036 newview 0
4037 }
4038}
4039
d16c0812
PM
4040proc editview {} {
4041 global curview
218a900b
AG
4042 global viewname viewperm newviewname newviewopts
4043 global viewargs viewargscmd
d16c0812
PM
4044
4045 set top .gitkvedit-$curview
4046 if {[winfo exists $top]} {
4047 raise $top
4048 return
4049 }
5d11f794 4050 decode_view_opts $curview $viewargs($curview)
218a900b
AG
4051 set newviewname($curview) $viewname($curview)
4052 set newviewopts($curview,perm) $viewperm($curview)
4053 set newviewopts($curview,cmd) $viewargscmd($curview)
b56e0a9a 4054 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
d16c0812
PM
4055}
4056
4057proc vieweditor {top n title} {
218a900b 4058 global newviewname newviewopts viewfiles bgcolor
d93f1713 4059 global known_view_options NS
d16c0812 4060
d93f1713 4061 ttk_toplevel $top
e0a01995 4062 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
e7d64008 4063 make_transient $top .
218a900b
AG
4064
4065 # View name
d93f1713 4066 ${NS}::frame $top.nfr
eae7d64a 4067 ${NS}::label $top.nl -text [mc "View Name"]
d93f1713 4068 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
218a900b 4069 pack $top.nfr -in $top -fill x -pady 5 -padx 3
13d40b61
EN
4070 pack $top.nl -in $top.nfr -side left -padx {0 5}
4071 pack $top.name -in $top.nfr -side left -padx {0 25}
218a900b
AG
4072
4073 # View options
4074 set cframe $top.nfr
4075 set cexpand 0
4076 set cnt 0
4077 foreach opt $known_view_options {
4078 set id [lindex $opt 0]
4079 set type [lindex $opt 1]
4080 set flags [lindex $opt 2]
4081 set title [eval [lindex $opt 4]]
4082 set lxpad 0
4083
4084 if {$flags eq "+" || $flags eq "*"} {
4085 set cframe $top.fr$cnt
4086 incr cnt
d93f1713 4087 ${NS}::frame $cframe
218a900b
AG
4088 pack $cframe -in $top -fill x -pady 3 -padx 3
4089 set cexpand [expr {$flags eq "*"}]
13d40b61
EN
4090 } elseif {$flags eq ".." || $flags eq "*."} {
4091 set cframe $top.fr$cnt
4092 incr cnt
eae7d64a 4093 ${NS}::frame $cframe
13d40b61
EN
4094 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4095 set cexpand [expr {$flags eq "*."}]
218a900b
AG
4096 } else {
4097 set lxpad 5
4098 }
4099
13d40b61 4100 if {$type eq "l"} {
eae7d64a 4101 ${NS}::label $cframe.l_$id -text $title
13d40b61
EN
4102 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4103 } elseif {$type eq "b"} {
d93f1713 4104 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
218a900b
AG
4105 pack $cframe.c_$id -in $cframe -side left \
4106 -padx [list $lxpad 0] -expand $cexpand -anchor w
13d40b61
EN
4107 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4108 regexp {^(.*_)} $id uselessvar button_id
eae7d64a 4109 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
13d40b61
EN
4110 pack $cframe.c_$id -in $cframe -side left \
4111 -padx [list $lxpad 0] -expand $cexpand -anchor w
218a900b 4112 } elseif {[regexp {^t(\d+)$} $type type sz]} {
d93f1713
PT
4113 ${NS}::label $cframe.l_$id -text $title
4114 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
4115 -textvariable newviewopts($n,$id)
4116 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4117 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4118 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
d93f1713
PT
4119 ${NS}::label $cframe.l_$id -text $title
4120 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
4121 -textvariable newviewopts($n,$id)
4122 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4123 pack $cframe.e_$id -in $cframe -side top -fill x
13d40b61 4124 } elseif {$type eq "path"} {
eae7d64a 4125 ${NS}::label $top.l -text $title
13d40b61 4126 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
b9b142ff 4127 text $top.t -width 40 -height 5 -background $bgcolor
13d40b61
EN
4128 if {[info exists viewfiles($n)]} {
4129 foreach f $viewfiles($n) {
4130 $top.t insert end $f
4131 $top.t insert end "\n"
4132 }
4133 $top.t delete {end - 1c} end
4134 $top.t mark set insert 0.0
4135 }
4136 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
218a900b
AG
4137 }
4138 }
4139
d93f1713
PT
4140 ${NS}::frame $top.buts
4141 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4142 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4143 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
218a900b
AG
4144 bind $top <Control-Return> [list newviewok $top $n]
4145 bind $top <F5> [list newviewok $top $n 1]
76f15947 4146 bind $top <Escape> [list destroy $top]
218a900b 4147 grid $top.buts.ok $top.buts.apply $top.buts.can
50b44ece
PM
4148 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4149 grid columnconfigure $top.buts 1 -weight 1 -uniform a
218a900b
AG
4150 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4151 pack $top.buts -in $top -side top -fill x
50b44ece
PM
4152 focus $top.t
4153}
4154
908c3585 4155proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
4156 set nmenu [$m index end]
4157 for {set i $first} {$i <= $nmenu} {incr i} {
4158 if {[$m entrycget $i -command] eq $cmd} {
908c3585 4159 eval $m $op $i $argv
da7c24dd 4160 break
d16c0812
PM
4161 }
4162 }
da7c24dd
PM
4163}
4164
4165proc allviewmenus {n op args} {
687c8765 4166 # global viewhlmenu
908c3585 4167
3cd204e5 4168 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 4169 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
4170}
4171
218a900b 4172proc newviewok {top n {apply 0}} {
da7c24dd 4173 global nextviewnum newviewperm newviewname newishighlight
d16c0812 4174 global viewname viewfiles viewperm selectedview curview
218a900b 4175 global viewargs viewargscmd newviewopts viewhlmenu
50b44ece 4176
098dd8a3 4177 if {[catch {
218a900b 4178 set newargs [encode_view_opts $n]
098dd8a3 4179 } err]} {
84a76f18 4180 error_popup "[mc "Error in commit selection arguments:"] $err" $top
098dd8a3
PM
4181 return
4182 }
50b44ece 4183 set files {}
d16c0812 4184 foreach f [split [$top.t get 0.0 end] "\n"] {
50b44ece
PM
4185 set ft [string trim $f]
4186 if {$ft ne {}} {
4187 lappend files $ft
4188 }
4189 }
d16c0812
PM
4190 if {![info exists viewfiles($n)]} {
4191 # creating a new view
4192 incr nextviewnum
4193 set viewname($n) $newviewname($n)
218a900b 4194 set viewperm($n) $newviewopts($n,perm)
d16c0812 4195 set viewfiles($n) $files
098dd8a3 4196 set viewargs($n) $newargs
218a900b 4197 set viewargscmd($n) $newviewopts($n,cmd)
da7c24dd
PM
4198 addviewmenu $n
4199 if {!$newishighlight} {
7eb3cb9c 4200 run showview $n
da7c24dd 4201 } else {
7eb3cb9c 4202 run addvhighlight $n
da7c24dd 4203 }
d16c0812
PM
4204 } else {
4205 # editing an existing view
218a900b 4206 set viewperm($n) $newviewopts($n,perm)
d16c0812
PM
4207 if {$newviewname($n) ne $viewname($n)} {
4208 set viewname($n) $newviewname($n)
3cd204e5 4209 doviewmenu .bar.view 5 [list showview $n] \
908c3585 4210 entryconf [list -label $viewname($n)]
687c8765
PM
4211 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4212 # entryconf [list -label $viewname($n) -value $viewname($n)]
d16c0812 4213 }
2d480856 4214 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
218a900b 4215 $newviewopts($n,cmd) ne $viewargscmd($n)} {
d16c0812 4216 set viewfiles($n) $files
098dd8a3 4217 set viewargs($n) $newargs
218a900b 4218 set viewargscmd($n) $newviewopts($n,cmd)
d16c0812 4219 if {$curview == $n} {
7fcc92bf 4220 run reloadcommits
d16c0812
PM
4221 }
4222 }
4223 }
218a900b 4224 if {$apply} return
d16c0812 4225 catch {destroy $top}
50b44ece
PM
4226}
4227
4228proc delview {} {
7fcc92bf 4229 global curview viewperm hlview selectedhlview
50b44ece
PM
4230
4231 if {$curview == 0} return
908c3585 4232 if {[info exists hlview] && $hlview == $curview} {
b007ee20 4233 set selectedhlview [mc "None"]
908c3585
PM
4234 unset hlview
4235 }
da7c24dd 4236 allviewmenus $curview delete
a90a6d24 4237 set viewperm($curview) 0
50b44ece
PM
4238 showview 0
4239}
4240
da7c24dd 4241proc addviewmenu {n} {
908c3585 4242 global viewname viewhlmenu
da7c24dd
PM
4243
4244 .bar.view add radiobutton -label $viewname($n) \
4245 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
4246 #$viewhlmenu add radiobutton -label $viewname($n) \
4247 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
4248}
4249
50b44ece 4250proc showview {n} {
3ed31a81 4251 global curview cached_commitrow ordertok
f5f3c2e2 4252 global displayorder parentlist rowidlist rowisopt rowfinal
7fcc92bf
PM
4253 global colormap rowtextx nextcolor canvxmax
4254 global numcommits viewcomplete
50b44ece 4255 global selectedline currentid canv canvy0
4fb0fa19 4256 global treediffs
3e76608d 4257 global pending_select mainheadid
0380081c 4258 global commitidx
3e76608d 4259 global selectedview
97645683 4260 global hlview selectedhlview commitinterest
50b44ece
PM
4261
4262 if {$n == $curview} return
4263 set selid {}
7fcc92bf
PM
4264 set ymax [lindex [$canv cget -scrollregion] 3]
4265 set span [$canv yview]
4266 set ytop [expr {[lindex $span 0] * $ymax}]
4267 set ybot [expr {[lindex $span 1] * $ymax}]
4268 set yscreen [expr {($ybot - $ytop) / 2}]
94b4a69f 4269 if {$selectedline ne {}} {
50b44ece
PM
4270 set selid $currentid
4271 set y [yc $selectedline]
50b44ece
PM
4272 if {$ytop < $y && $y < $ybot} {
4273 set yscreen [expr {$y - $ytop}]
50b44ece 4274 }
e507fd48
PM
4275 } elseif {[info exists pending_select]} {
4276 set selid $pending_select
4277 unset pending_select
50b44ece
PM
4278 }
4279 unselectline
fdedbcfb 4280 normalline
50b44ece
PM
4281 catch {unset treediffs}
4282 clear_display
908c3585
PM
4283 if {[info exists hlview] && $hlview == $n} {
4284 unset hlview
b007ee20 4285 set selectedhlview [mc "None"]
908c3585 4286 }
97645683 4287 catch {unset commitinterest}
7fcc92bf 4288 catch {unset cached_commitrow}
9257d8f7 4289 catch {unset ordertok}
50b44ece
PM
4290
4291 set curview $n
a90a6d24 4292 set selectedview $n
f2d0bbbd
PM
4293 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4294 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 4295
df904497 4296 run refill_reflist
7fcc92bf 4297 if {![info exists viewcomplete($n)]} {
567c34e0 4298 getcommits $selid
50b44ece
PM
4299 return
4300 }
4301
7fcc92bf
PM
4302 set displayorder {}
4303 set parentlist {}
4304 set rowidlist {}
4305 set rowisopt {}
4306 set rowfinal {}
f5f3c2e2 4307 set numcommits $commitidx($n)
22626ef4 4308
50b44ece
PM
4309 catch {unset colormap}
4310 catch {unset rowtextx}
da7c24dd
PM
4311 set nextcolor 0
4312 set canvxmax [$canv cget -width]
50b44ece
PM
4313 set curview $n
4314 set row 0
50b44ece
PM
4315 setcanvscroll
4316 set yf 0
e507fd48 4317 set row {}
7fcc92bf
PM
4318 if {$selid ne {} && [commitinview $selid $n]} {
4319 set row [rowofcommit $selid]
50b44ece
PM
4320 # try to get the selected row in the same position on the screen
4321 set ymax [lindex [$canv cget -scrollregion] 3]
4322 set ytop [expr {[yc $row] - $yscreen}]
4323 if {$ytop < 0} {
4324 set ytop 0
4325 }
4326 set yf [expr {$ytop * 1.0 / $ymax}]
4327 }
4328 allcanvs yview moveto $yf
4329 drawvisible
e507fd48
PM
4330 if {$row ne {}} {
4331 selectline $row 0
3e76608d 4332 } elseif {!$viewcomplete($n)} {
567c34e0 4333 reset_pending_select $selid
e507fd48 4334 } else {
835e62ae
AG
4335 reset_pending_select {}
4336
4337 if {[commitinview $pending_select $curview]} {
4338 selectline [rowofcommit $pending_select] 1
4339 } else {
4340 set row [first_real_row]
4341 if {$row < $numcommits} {
4342 selectline $row 0
4343 }
e507fd48
PM
4344 }
4345 }
7fcc92bf
PM
4346 if {!$viewcomplete($n)} {
4347 if {$numcommits == 0} {
d990cedf 4348 show_status [mc "Reading commits..."]
d16c0812 4349 }
098dd8a3 4350 } elseif {$numcommits == 0} {
d990cedf 4351 show_status [mc "No commits selected"]
2516dae2 4352 }
50b44ece
PM
4353}
4354
908c3585
PM
4355# Stuff relating to the highlighting facility
4356
476ca63d 4357proc ishighlighted {id} {
164ff275 4358 global vhighlights fhighlights nhighlights rhighlights
908c3585 4359
476ca63d
PM
4360 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4361 return $nhighlights($id)
908c3585 4362 }
476ca63d
PM
4363 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4364 return $vhighlights($id)
908c3585 4365 }
476ca63d
PM
4366 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4367 return $fhighlights($id)
908c3585 4368 }
476ca63d
PM
4369 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4370 return $rhighlights($id)
164ff275 4371 }
908c3585
PM
4372 return 0
4373}
4374
28593d3f 4375proc bolden {id font} {
b9fdba7f 4376 global canv linehtag currentid boldids need_redisplay markedid
908c3585 4377
d98d50e2
PM
4378 # need_redisplay = 1 means the display is stale and about to be redrawn
4379 if {$need_redisplay} return
28593d3f
PM
4380 lappend boldids $id
4381 $canv itemconf $linehtag($id) -font $font
4382 if {[info exists currentid] && $id eq $currentid} {
908c3585 4383 $canv delete secsel
28593d3f 4384 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
908c3585
PM
4385 -outline {{}} -tags secsel \
4386 -fill [$canv cget -selectbackground]]
4387 $canv lower $t
4388 }
b9fdba7f
PM
4389 if {[info exists markedid] && $id eq $markedid} {
4390 make_idmark $id
4391 }
908c3585
PM
4392}
4393
28593d3f
PM
4394proc bolden_name {id font} {
4395 global canv2 linentag currentid boldnameids need_redisplay
908c3585 4396
d98d50e2 4397 if {$need_redisplay} return
28593d3f
PM
4398 lappend boldnameids $id
4399 $canv2 itemconf $linentag($id) -font $font
4400 if {[info exists currentid] && $id eq $currentid} {
908c3585 4401 $canv2 delete secsel
28593d3f 4402 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
908c3585
PM
4403 -outline {{}} -tags secsel \
4404 -fill [$canv2 cget -selectbackground]]
4405 $canv2 lower $t
4406 }
4407}
4408
4e7d6779 4409proc unbolden {} {
28593d3f 4410 global boldids
908c3585 4411
4e7d6779 4412 set stillbold {}
28593d3f
PM
4413 foreach id $boldids {
4414 if {![ishighlighted $id]} {
4415 bolden $id mainfont
4e7d6779 4416 } else {
28593d3f 4417 lappend stillbold $id
908c3585
PM
4418 }
4419 }
28593d3f 4420 set boldids $stillbold
908c3585
PM
4421}
4422
4423proc addvhighlight {n} {
476ca63d 4424 global hlview viewcomplete curview vhl_done commitidx
da7c24dd
PM
4425
4426 if {[info exists hlview]} {
908c3585 4427 delvhighlight
da7c24dd
PM
4428 }
4429 set hlview $n
7fcc92bf 4430 if {$n != $curview && ![info exists viewcomplete($n)]} {
da7c24dd 4431 start_rev_list $n
908c3585
PM
4432 }
4433 set vhl_done $commitidx($hlview)
4434 if {$vhl_done > 0} {
4435 drawvisible
da7c24dd
PM
4436 }
4437}
4438
908c3585
PM
4439proc delvhighlight {} {
4440 global hlview vhighlights
da7c24dd
PM
4441
4442 if {![info exists hlview]} return
4443 unset hlview
4e7d6779
PM
4444 catch {unset vhighlights}
4445 unbolden
da7c24dd
PM
4446}
4447
908c3585 4448proc vhighlightmore {} {
7fcc92bf 4449 global hlview vhl_done commitidx vhighlights curview
da7c24dd 4450
da7c24dd 4451 set max $commitidx($hlview)
908c3585
PM
4452 set vr [visiblerows]
4453 set r0 [lindex $vr 0]
4454 set r1 [lindex $vr 1]
4455 for {set i $vhl_done} {$i < $max} {incr i} {
7fcc92bf
PM
4456 set id [commitonrow $i $hlview]
4457 if {[commitinview $id $curview]} {
4458 set row [rowofcommit $id]
908c3585
PM
4459 if {$r0 <= $row && $row <= $r1} {
4460 if {![highlighted $row]} {
28593d3f 4461 bolden $id mainfontbold
da7c24dd 4462 }
476ca63d 4463 set vhighlights($id) 1
da7c24dd
PM
4464 }
4465 }
4466 }
908c3585 4467 set vhl_done $max
ac1276ab 4468 return 0
908c3585
PM
4469}
4470
4471proc askvhighlight {row id} {
7fcc92bf 4472 global hlview vhighlights iddrawn
908c3585 4473
7fcc92bf 4474 if {[commitinview $id $hlview]} {
476ca63d 4475 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
28593d3f 4476 bolden $id mainfontbold
908c3585 4477 }
476ca63d 4478 set vhighlights($id) 1
908c3585 4479 } else {
476ca63d 4480 set vhighlights($id) 0
908c3585
PM
4481 }
4482}
4483
687c8765 4484proc hfiles_change {} {
908c3585 4485 global highlight_files filehighlight fhighlights fh_serial
8b39e04f 4486 global highlight_paths
908c3585
PM
4487
4488 if {[info exists filehighlight]} {
4489 # delete previous highlights
4490 catch {close $filehighlight}
4491 unset filehighlight
4e7d6779
PM
4492 catch {unset fhighlights}
4493 unbolden
63b79191 4494 unhighlight_filelist
908c3585 4495 }
63b79191 4496 set highlight_paths {}
908c3585
PM
4497 after cancel do_file_hl $fh_serial
4498 incr fh_serial
4499 if {$highlight_files ne {}} {
4500 after 300 do_file_hl $fh_serial
4501 }
4502}
4503
687c8765
PM
4504proc gdttype_change {name ix op} {
4505 global gdttype highlight_files findstring findpattern
4506
bb3edc8b 4507 stopfinding
687c8765 4508 if {$findstring ne {}} {
b007ee20 4509 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4510 if {$highlight_files ne {}} {
4511 set highlight_files {}
4512 hfiles_change
4513 }
4514 findcom_change
4515 } else {
4516 if {$findpattern ne {}} {
4517 set findpattern {}
4518 findcom_change
4519 }
4520 set highlight_files $findstring
4521 hfiles_change
4522 }
4523 drawvisible
4524 }
4525 # enable/disable findtype/findloc menus too
4526}
4527
4528proc find_change {name ix op} {
4529 global gdttype findstring highlight_files
4530
bb3edc8b 4531 stopfinding
b007ee20 4532 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4533 findcom_change
4534 } else {
4535 if {$highlight_files ne $findstring} {
4536 set highlight_files $findstring
4537 hfiles_change
4538 }
4539 }
4540 drawvisible
4541}
4542
64b5f146 4543proc findcom_change args {
28593d3f 4544 global nhighlights boldnameids
687c8765
PM
4545 global findpattern findtype findstring gdttype
4546
bb3edc8b 4547 stopfinding
687c8765 4548 # delete previous highlights, if any
28593d3f
PM
4549 foreach id $boldnameids {
4550 bolden_name $id mainfont
687c8765 4551 }
28593d3f 4552 set boldnameids {}
687c8765
PM
4553 catch {unset nhighlights}
4554 unbolden
4555 unmarkmatches
b007ee20 4556 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
687c8765 4557 set findpattern {}
b007ee20 4558 } elseif {$findtype eq [mc "Regexp"]} {
687c8765
PM
4559 set findpattern $findstring
4560 } else {
4561 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4562 $findstring]
4563 set findpattern "*$e*"
4564 }
4565}
4566
63b79191
PM
4567proc makepatterns {l} {
4568 set ret {}
4569 foreach e $l {
4570 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4571 if {[string index $ee end] eq "/"} {
4572 lappend ret "$ee*"
4573 } else {
4574 lappend ret $ee
4575 lappend ret "$ee/*"
4576 }
4577 }
4578 return $ret
4579}
4580
908c3585 4581proc do_file_hl {serial} {
4e7d6779 4582 global highlight_files filehighlight highlight_paths gdttype fhl_list
de665fd3 4583 global cdup findtype
908c3585 4584
b007ee20 4585 if {$gdttype eq [mc "touching paths:"]} {
de665fd3
YK
4586 # If "exact" match then convert backslashes to forward slashes.
4587 # Most useful to support Windows-flavoured file paths.
4588 if {$findtype eq [mc "Exact"]} {
4589 set highlight_files [string map {"\\" "/"} $highlight_files]
4590 }
60f7a7dc
PM
4591 if {[catch {set paths [shellsplit $highlight_files]}]} return
4592 set highlight_paths [makepatterns $paths]
4593 highlight_filelist
c332f445
MZ
4594 set relative_paths {}
4595 foreach path $paths {
4596 lappend relative_paths [file join $cdup $path]
4597 }
4598 set gdtargs [concat -- $relative_paths]
b007ee20 4599 } elseif {$gdttype eq [mc "adding/removing string:"]} {
60f7a7dc 4600 set gdtargs [list "-S$highlight_files"]
687c8765
PM
4601 } else {
4602 # must be "containing:", i.e. we're searching commit info
4603 return
60f7a7dc 4604 }
1ce09dd6 4605 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
4606 set filehighlight [open $cmd r+]
4607 fconfigure $filehighlight -blocking 0
7eb3cb9c 4608 filerun $filehighlight readfhighlight
4e7d6779 4609 set fhl_list {}
908c3585
PM
4610 drawvisible
4611 flushhighlights
4612}
4613
4614proc flushhighlights {} {
4e7d6779 4615 global filehighlight fhl_list
908c3585
PM
4616
4617 if {[info exists filehighlight]} {
4e7d6779 4618 lappend fhl_list {}
908c3585
PM
4619 puts $filehighlight ""
4620 flush $filehighlight
4621 }
4622}
4623
4624proc askfilehighlight {row id} {
4e7d6779 4625 global filehighlight fhighlights fhl_list
908c3585 4626
4e7d6779 4627 lappend fhl_list $id
476ca63d 4628 set fhighlights($id) -1
908c3585
PM
4629 puts $filehighlight $id
4630}
4631
4632proc readfhighlight {} {
7fcc92bf 4633 global filehighlight fhighlights curview iddrawn
687c8765 4634 global fhl_list find_dirn
4e7d6779 4635
7eb3cb9c
PM
4636 if {![info exists filehighlight]} {
4637 return 0
4638 }
4639 set nr 0
4640 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4e7d6779
PM
4641 set line [string trim $line]
4642 set i [lsearch -exact $fhl_list $line]
4643 if {$i < 0} continue
4644 for {set j 0} {$j < $i} {incr j} {
4645 set id [lindex $fhl_list $j]
476ca63d 4646 set fhighlights($id) 0
908c3585 4647 }
4e7d6779
PM
4648 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4649 if {$line eq {}} continue
7fcc92bf 4650 if {![commitinview $line $curview]} continue
476ca63d 4651 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
28593d3f 4652 bolden $line mainfontbold
4e7d6779 4653 }
476ca63d 4654 set fhighlights($line) 1
908c3585 4655 }
4e7d6779
PM
4656 if {[eof $filehighlight]} {
4657 # strange...
1ce09dd6 4658 puts "oops, git diff-tree died"
4e7d6779
PM
4659 catch {close $filehighlight}
4660 unset filehighlight
7eb3cb9c 4661 return 0
908c3585 4662 }
687c8765 4663 if {[info exists find_dirn]} {
cca5d946 4664 run findmore
908c3585 4665 }
687c8765 4666 return 1
908c3585
PM
4667}
4668
4fb0fa19 4669proc doesmatch {f} {
687c8765 4670 global findtype findpattern
4fb0fa19 4671
b007ee20 4672 if {$findtype eq [mc "Regexp"]} {
687c8765 4673 return [regexp $findpattern $f]
b007ee20 4674 } elseif {$findtype eq [mc "IgnCase"]} {
4fb0fa19
PM
4675 return [string match -nocase $findpattern $f]
4676 } else {
4677 return [string match $findpattern $f]
4678 }
4679}
4680
60f7a7dc 4681proc askfindhighlight {row id} {
9c311b32 4682 global nhighlights commitinfo iddrawn
4fb0fa19
PM
4683 global findloc
4684 global markingmatches
908c3585
PM
4685
4686 if {![info exists commitinfo($id)]} {
4687 getcommit $id
4688 }
60f7a7dc 4689 set info $commitinfo($id)
908c3585 4690 set isbold 0
585c27cb 4691 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
60f7a7dc 4692 foreach f $info ty $fldtypes {
585c27cb 4693 if {$ty eq ""} continue
b007ee20 4694 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4fb0fa19 4695 [doesmatch $f]} {
b007ee20 4696 if {$ty eq [mc "Author"]} {
60f7a7dc 4697 set isbold 2
4fb0fa19 4698 break
60f7a7dc 4699 }
4fb0fa19 4700 set isbold 1
908c3585
PM
4701 }
4702 }
4fb0fa19 4703 if {$isbold && [info exists iddrawn($id)]} {
476ca63d 4704 if {![ishighlighted $id]} {
28593d3f 4705 bolden $id mainfontbold
4fb0fa19 4706 if {$isbold > 1} {
28593d3f 4707 bolden_name $id mainfontbold
4fb0fa19 4708 }
908c3585 4709 }
4fb0fa19 4710 if {$markingmatches} {
005a2f4e 4711 markrowmatches $row $id
908c3585
PM
4712 }
4713 }
476ca63d 4714 set nhighlights($id) $isbold
da7c24dd
PM
4715}
4716
005a2f4e
PM
4717proc markrowmatches {row id} {
4718 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 4719
005a2f4e
PM
4720 set headline [lindex $commitinfo($id) 0]
4721 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
4722 $canv delete match$row
4723 $canv2 delete match$row
b007ee20 4724 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
005a2f4e
PM
4725 set m [findmatches $headline]
4726 if {$m ne {}} {
28593d3f
PM
4727 markmatches $canv $row $headline $linehtag($id) $m \
4728 [$canv itemcget $linehtag($id) -font] $row
005a2f4e 4729 }
4fb0fa19 4730 }
b007ee20 4731 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
005a2f4e
PM
4732 set m [findmatches $author]
4733 if {$m ne {}} {
28593d3f
PM
4734 markmatches $canv2 $row $author $linentag($id) $m \
4735 [$canv2 itemcget $linentag($id) -font] $row
005a2f4e 4736 }
4fb0fa19
PM
4737 }
4738}
4739
164ff275
PM
4740proc vrel_change {name ix op} {
4741 global highlight_related
4742
4743 rhighlight_none
b007ee20 4744 if {$highlight_related ne [mc "None"]} {
7eb3cb9c 4745 run drawvisible
164ff275
PM
4746 }
4747}
4748
4749# prepare for testing whether commits are descendents or ancestors of a
4750proc rhighlight_sel {a} {
4751 global descendent desc_todo ancestor anc_todo
476ca63d 4752 global highlight_related
164ff275
PM
4753
4754 catch {unset descendent}
4755 set desc_todo [list $a]
4756 catch {unset ancestor}
4757 set anc_todo [list $a]
b007ee20 4758 if {$highlight_related ne [mc "None"]} {
164ff275 4759 rhighlight_none
7eb3cb9c 4760 run drawvisible
164ff275
PM
4761 }
4762}
4763
4764proc rhighlight_none {} {
4765 global rhighlights
4766
4e7d6779
PM
4767 catch {unset rhighlights}
4768 unbolden
164ff275
PM
4769}
4770
4771proc is_descendent {a} {
7fcc92bf 4772 global curview children descendent desc_todo
164ff275
PM
4773
4774 set v $curview
7fcc92bf 4775 set la [rowofcommit $a]
164ff275
PM
4776 set todo $desc_todo
4777 set leftover {}
4778 set done 0
4779 for {set i 0} {$i < [llength $todo]} {incr i} {
4780 set do [lindex $todo $i]
7fcc92bf 4781 if {[rowofcommit $do] < $la} {
164ff275
PM
4782 lappend leftover $do
4783 continue
4784 }
4785 foreach nk $children($v,$do) {
4786 if {![info exists descendent($nk)]} {
4787 set descendent($nk) 1
4788 lappend todo $nk
4789 if {$nk eq $a} {
4790 set done 1
4791 }
4792 }
4793 }
4794 if {$done} {
4795 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4796 return
4797 }
4798 }
4799 set descendent($a) 0
4800 set desc_todo $leftover
4801}
4802
4803proc is_ancestor {a} {
7fcc92bf 4804 global curview parents ancestor anc_todo
164ff275
PM
4805
4806 set v $curview
7fcc92bf 4807 set la [rowofcommit $a]
164ff275
PM
4808 set todo $anc_todo
4809 set leftover {}
4810 set done 0
4811 for {set i 0} {$i < [llength $todo]} {incr i} {
4812 set do [lindex $todo $i]
7fcc92bf 4813 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
164ff275
PM
4814 lappend leftover $do
4815 continue
4816 }
7fcc92bf 4817 foreach np $parents($v,$do) {
164ff275
PM
4818 if {![info exists ancestor($np)]} {
4819 set ancestor($np) 1
4820 lappend todo $np
4821 if {$np eq $a} {
4822 set done 1
4823 }
4824 }
4825 }
4826 if {$done} {
4827 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4828 return
4829 }
4830 }
4831 set ancestor($a) 0
4832 set anc_todo $leftover
4833}
4834
4835proc askrelhighlight {row id} {
9c311b32 4836 global descendent highlight_related iddrawn rhighlights
164ff275
PM
4837 global selectedline ancestor
4838
94b4a69f 4839 if {$selectedline eq {}} return
164ff275 4840 set isbold 0
55e34436
CS
4841 if {$highlight_related eq [mc "Descendant"] ||
4842 $highlight_related eq [mc "Not descendant"]} {
164ff275
PM
4843 if {![info exists descendent($id)]} {
4844 is_descendent $id
4845 }
55e34436 4846 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
164ff275
PM
4847 set isbold 1
4848 }
b007ee20
CS
4849 } elseif {$highlight_related eq [mc "Ancestor"] ||
4850 $highlight_related eq [mc "Not ancestor"]} {
164ff275
PM
4851 if {![info exists ancestor($id)]} {
4852 is_ancestor $id
4853 }
b007ee20 4854 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
164ff275
PM
4855 set isbold 1
4856 }
4857 }
4858 if {[info exists iddrawn($id)]} {
476ca63d 4859 if {$isbold && ![ishighlighted $id]} {
28593d3f 4860 bolden $id mainfontbold
164ff275
PM
4861 }
4862 }
476ca63d 4863 set rhighlights($id) $isbold
164ff275
PM
4864}
4865
da7c24dd
PM
4866# Graph layout functions
4867
9f1afe05
PM
4868proc shortids {ids} {
4869 set res {}
4870 foreach id $ids {
4871 if {[llength $id] > 1} {
4872 lappend res [shortids $id]
4873 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4874 lappend res [string range $id 0 7]
4875 } else {
4876 lappend res $id
4877 }
4878 }
4879 return $res
4880}
4881
9f1afe05
PM
4882proc ntimes {n o} {
4883 set ret {}
0380081c
PM
4884 set o [list $o]
4885 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4886 if {($n & $mask) != 0} {
4887 set ret [concat $ret $o]
9f1afe05 4888 }
0380081c 4889 set o [concat $o $o]
9f1afe05 4890 }
0380081c 4891 return $ret
9f1afe05
PM
4892}
4893
9257d8f7
PM
4894proc ordertoken {id} {
4895 global ordertok curview varcid varcstart varctok curview parents children
4896 global nullid nullid2
4897
4898 if {[info exists ordertok($id)]} {
4899 return $ordertok($id)
4900 }
4901 set origid $id
4902 set todo {}
4903 while {1} {
4904 if {[info exists varcid($curview,$id)]} {
4905 set a $varcid($curview,$id)
4906 set p [lindex $varcstart($curview) $a]
4907 } else {
4908 set p [lindex $children($curview,$id) 0]
4909 }
4910 if {[info exists ordertok($p)]} {
4911 set tok $ordertok($p)
4912 break
4913 }
c8c9f3d9
PM
4914 set id [first_real_child $curview,$p]
4915 if {$id eq {}} {
9257d8f7 4916 # it's a root
46308ea1 4917 set tok [lindex $varctok($curview) $varcid($curview,$p)]
9257d8f7
PM
4918 break
4919 }
9257d8f7
PM
4920 if {[llength $parents($curview,$id)] == 1} {
4921 lappend todo [list $p {}]
4922 } else {
4923 set j [lsearch -exact $parents($curview,$id) $p]
4924 if {$j < 0} {
4925 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4926 }
4927 lappend todo [list $p [strrep $j]]
4928 }
4929 }
4930 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4931 set p [lindex $todo $i 0]
4932 append tok [lindex $todo $i 1]
4933 set ordertok($p) $tok
4934 }
4935 set ordertok($origid) $tok
4936 return $tok
4937}
4938
6e8c8707
PM
4939# Work out where id should go in idlist so that order-token
4940# values increase from left to right
4941proc idcol {idlist id {i 0}} {
9257d8f7 4942 set t [ordertoken $id]
e5b37ac1
PM
4943 if {$i < 0} {
4944 set i 0
4945 }
9257d8f7 4946 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
6e8c8707
PM
4947 if {$i > [llength $idlist]} {
4948 set i [llength $idlist]
9f1afe05 4949 }
9257d8f7 4950 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
6e8c8707
PM
4951 incr i
4952 } else {
9257d8f7 4953 if {$t > [ordertoken [lindex $idlist $i]]} {
6e8c8707 4954 while {[incr i] < [llength $idlist] &&
9257d8f7 4955 $t >= [ordertoken [lindex $idlist $i]]} {}
9f1afe05 4956 }
9f1afe05 4957 }
6e8c8707 4958 return $i
9f1afe05
PM
4959}
4960
4961proc initlayout {} {
7fcc92bf 4962 global rowidlist rowisopt rowfinal displayorder parentlist
da7c24dd 4963 global numcommits canvxmax canv
8f7d0cec 4964 global nextcolor
da7c24dd 4965 global colormap rowtextx
9f1afe05 4966
8f7d0cec
PM
4967 set numcommits 0
4968 set displayorder {}
79b2c75e 4969 set parentlist {}
8f7d0cec 4970 set nextcolor 0
0380081c
PM
4971 set rowidlist {}
4972 set rowisopt {}
f5f3c2e2 4973 set rowfinal {}
be0cd098 4974 set canvxmax [$canv cget -width]
50b44ece
PM
4975 catch {unset colormap}
4976 catch {unset rowtextx}
ac1276ab 4977 setcanvscroll
be0cd098
PM
4978}
4979
4980proc setcanvscroll {} {
4981 global canv canv2 canv3 numcommits linespc canvxmax canvy0
ac1276ab 4982 global lastscrollset lastscrollrows
be0cd098
PM
4983
4984 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4985 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4986 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4987 $canv3 conf -scrollregion [list 0 0 0 $ymax]
ac1276ab
PM
4988 set lastscrollset [clock clicks -milliseconds]
4989 set lastscrollrows $numcommits
9f1afe05
PM
4990}
4991
4992proc visiblerows {} {
4993 global canv numcommits linespc
4994
4995 set ymax [lindex [$canv cget -scrollregion] 3]
4996 if {$ymax eq {} || $ymax == 0} return
4997 set f [$canv yview]
4998 set y0 [expr {int([lindex $f 0] * $ymax)}]
4999 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5000 if {$r0 < 0} {
5001 set r0 0
5002 }
5003 set y1 [expr {int([lindex $f 1] * $ymax)}]
5004 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5005 if {$r1 >= $numcommits} {
5006 set r1 [expr {$numcommits - 1}]
5007 }
5008 return [list $r0 $r1]
5009}
5010
f5f3c2e2 5011proc layoutmore {} {
38dfe939 5012 global commitidx viewcomplete curview
94b4a69f 5013 global numcommits pending_select curview
d375ef9b 5014 global lastscrollset lastscrollrows
ac1276ab
PM
5015
5016 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5017 [clock clicks -milliseconds] - $lastscrollset > 500} {
a2c22362
PM
5018 setcanvscroll
5019 }
d94f8cd6 5020 if {[info exists pending_select] &&
7fcc92bf 5021 [commitinview $pending_select $curview]} {
567c34e0 5022 update
7fcc92bf 5023 selectline [rowofcommit $pending_select] 1
d94f8cd6 5024 }
ac1276ab 5025 drawvisible
219ea3a9
PM
5026}
5027
cdc8429c
PM
5028# With path limiting, we mightn't get the actual HEAD commit,
5029# so ask git rev-list what is the first ancestor of HEAD that
5030# touches a file in the path limit.
5031proc get_viewmainhead {view} {
5032 global viewmainheadid vfilelimit viewinstances mainheadid
5033
5034 catch {
5035 set rfd [open [concat | git rev-list -1 $mainheadid \
5036 -- $vfilelimit($view)] r]
5037 set j [reg_instance $rfd]
5038 lappend viewinstances($view) $j
5039 fconfigure $rfd -blocking 0
5040 filerun $rfd [list getviewhead $rfd $j $view]
5041 set viewmainheadid($curview) {}
5042 }
5043}
5044
5045# git rev-list should give us just 1 line to use as viewmainheadid($view)
5046proc getviewhead {fd inst view} {
5047 global viewmainheadid commfd curview viewinstances showlocalchanges
5048
5049 set id {}
5050 if {[gets $fd line] < 0} {
5051 if {![eof $fd]} {
5052 return 1
5053 }
5054 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5055 set id $line
5056 }
5057 set viewmainheadid($view) $id
5058 close $fd
5059 unset commfd($inst)
5060 set i [lsearch -exact $viewinstances($view) $inst]
5061 if {$i >= 0} {
5062 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5063 }
5064 if {$showlocalchanges && $id ne {} && $view == $curview} {
5065 doshowlocalchanges
5066 }
5067 return 0
5068}
5069
219ea3a9 5070proc doshowlocalchanges {} {
cdc8429c 5071 global curview viewmainheadid
219ea3a9 5072
cdc8429c
PM
5073 if {$viewmainheadid($curview) eq {}} return
5074 if {[commitinview $viewmainheadid($curview) $curview]} {
219ea3a9 5075 dodiffindex
38dfe939 5076 } else {
cdc8429c 5077 interestedin $viewmainheadid($curview) dodiffindex
219ea3a9
PM
5078 }
5079}
5080
5081proc dohidelocalchanges {} {
7fcc92bf 5082 global nullid nullid2 lserial curview
219ea3a9 5083
7fcc92bf 5084 if {[commitinview $nullid $curview]} {
b8a938cf 5085 removefakerow $nullid
8f489363 5086 }
7fcc92bf 5087 if {[commitinview $nullid2 $curview]} {
b8a938cf 5088 removefakerow $nullid2
219ea3a9
PM
5089 }
5090 incr lserial
5091}
5092
8f489363 5093# spawn off a process to do git diff-index --cached HEAD
219ea3a9 5094proc dodiffindex {} {
cdc8429c 5095 global lserial showlocalchanges vfilelimit curview
74cb884f 5096 global hasworktree
219ea3a9 5097
74cb884f 5098 if {!$showlocalchanges || !$hasworktree} return
219ea3a9 5099 incr lserial
cdc8429c
PM
5100 set cmd "|git diff-index --cached HEAD"
5101 if {$vfilelimit($curview) ne {}} {
5102 set cmd [concat $cmd -- $vfilelimit($curview)]
5103 }
5104 set fd [open $cmd r]
219ea3a9 5105 fconfigure $fd -blocking 0
e439e092
AG
5106 set i [reg_instance $fd]
5107 filerun $fd [list readdiffindex $fd $lserial $i]
219ea3a9
PM
5108}
5109
e439e092 5110proc readdiffindex {fd serial inst} {
cdc8429c
PM
5111 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5112 global vfilelimit
219ea3a9 5113
8f489363 5114 set isdiff 1
219ea3a9 5115 if {[gets $fd line] < 0} {
8f489363
PM
5116 if {![eof $fd]} {
5117 return 1
219ea3a9 5118 }
8f489363 5119 set isdiff 0
219ea3a9
PM
5120 }
5121 # we only need to see one line and we don't really care what it says...
e439e092 5122 stop_instance $inst
219ea3a9 5123
24f7a667
PM
5124 if {$serial != $lserial} {
5125 return 0
8f489363
PM
5126 }
5127
24f7a667 5128 # now see if there are any local changes not checked in to the index
cdc8429c
PM
5129 set cmd "|git diff-files"
5130 if {$vfilelimit($curview) ne {}} {
5131 set cmd [concat $cmd -- $vfilelimit($curview)]
5132 }
5133 set fd [open $cmd r]
24f7a667 5134 fconfigure $fd -blocking 0
e439e092
AG
5135 set i [reg_instance $fd]
5136 filerun $fd [list readdifffiles $fd $serial $i]
24f7a667
PM
5137
5138 if {$isdiff && ![commitinview $nullid2 $curview]} {
8f489363 5139 # add the line for the changes in the index to the graph
d990cedf 5140 set hl [mc "Local changes checked in to index but not committed"]
8f489363
PM
5141 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5142 set commitdata($nullid2) "\n $hl\n"
fc2a256f 5143 if {[commitinview $nullid $curview]} {
b8a938cf 5144 removefakerow $nullid
fc2a256f 5145 }
cdc8429c 5146 insertfakerow $nullid2 $viewmainheadid($curview)
24f7a667 5147 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
cdc8429c
PM
5148 if {[commitinview $nullid $curview]} {
5149 removefakerow $nullid
5150 }
b8a938cf 5151 removefakerow $nullid2
8f489363
PM
5152 }
5153 return 0
5154}
5155
e439e092 5156proc readdifffiles {fd serial inst} {
cdc8429c 5157 global viewmainheadid nullid nullid2 curview
8f489363
PM
5158 global commitinfo commitdata lserial
5159
5160 set isdiff 1
5161 if {[gets $fd line] < 0} {
5162 if {![eof $fd]} {
5163 return 1
5164 }
5165 set isdiff 0
5166 }
5167 # we only need to see one line and we don't really care what it says...
e439e092 5168 stop_instance $inst
8f489363 5169
24f7a667
PM
5170 if {$serial != $lserial} {
5171 return 0
5172 }
5173
5174 if {$isdiff && ![commitinview $nullid $curview]} {
219ea3a9 5175 # add the line for the local diff to the graph
d990cedf 5176 set hl [mc "Local uncommitted changes, not checked in to index"]
219ea3a9
PM
5177 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5178 set commitdata($nullid) "\n $hl\n"
7fcc92bf
PM
5179 if {[commitinview $nullid2 $curview]} {
5180 set p $nullid2
5181 } else {
cdc8429c 5182 set p $viewmainheadid($curview)
7fcc92bf 5183 }
b8a938cf 5184 insertfakerow $nullid $p
24f7a667 5185 } elseif {!$isdiff && [commitinview $nullid $curview]} {
b8a938cf 5186 removefakerow $nullid
219ea3a9
PM
5187 }
5188 return 0
9f1afe05
PM
5189}
5190
8f0bc7e9 5191proc nextuse {id row} {
7fcc92bf 5192 global curview children
9f1afe05 5193
8f0bc7e9
PM
5194 if {[info exists children($curview,$id)]} {
5195 foreach kid $children($curview,$id) {
7fcc92bf 5196 if {![commitinview $kid $curview]} {
0380081c
PM
5197 return -1
5198 }
7fcc92bf
PM
5199 if {[rowofcommit $kid] > $row} {
5200 return [rowofcommit $kid]
9f1afe05 5201 }
9f1afe05 5202 }
8f0bc7e9 5203 }
7fcc92bf
PM
5204 if {[commitinview $id $curview]} {
5205 return [rowofcommit $id]
8f0bc7e9
PM
5206 }
5207 return -1
5208}
5209
f5f3c2e2 5210proc prevuse {id row} {
7fcc92bf 5211 global curview children
f5f3c2e2
PM
5212
5213 set ret -1
5214 if {[info exists children($curview,$id)]} {
5215 foreach kid $children($curview,$id) {
7fcc92bf
PM
5216 if {![commitinview $kid $curview]} break
5217 if {[rowofcommit $kid] < $row} {
5218 set ret [rowofcommit $kid]
7b459a1c 5219 }
7b459a1c 5220 }
f5f3c2e2
PM
5221 }
5222 return $ret
5223}
5224
0380081c
PM
5225proc make_idlist {row} {
5226 global displayorder parentlist uparrowlen downarrowlen mingaplen
9257d8f7 5227 global commitidx curview children
9f1afe05 5228
0380081c
PM
5229 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5230 if {$r < 0} {
5231 set r 0
8f0bc7e9 5232 }
0380081c
PM
5233 set ra [expr {$row - $downarrowlen}]
5234 if {$ra < 0} {
5235 set ra 0
5236 }
5237 set rb [expr {$row + $uparrowlen}]
5238 if {$rb > $commitidx($curview)} {
5239 set rb $commitidx($curview)
5240 }
7fcc92bf 5241 make_disporder $r [expr {$rb + 1}]
0380081c
PM
5242 set ids {}
5243 for {} {$r < $ra} {incr r} {
5244 set nextid [lindex $displayorder [expr {$r + 1}]]
5245 foreach p [lindex $parentlist $r] {
5246 if {$p eq $nextid} continue
5247 set rn [nextuse $p $r]
5248 if {$rn >= $row &&
5249 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
9257d8f7 5250 lappend ids [list [ordertoken $p] $p]
9f1afe05 5251 }
9f1afe05 5252 }
0380081c
PM
5253 }
5254 for {} {$r < $row} {incr r} {
5255 set nextid [lindex $displayorder [expr {$r + 1}]]
5256 foreach p [lindex $parentlist $r] {
5257 if {$p eq $nextid} continue
5258 set rn [nextuse $p $r]
5259 if {$rn < 0 || $rn >= $row} {
9257d8f7 5260 lappend ids [list [ordertoken $p] $p]
9f1afe05 5261 }
9f1afe05 5262 }
0380081c
PM
5263 }
5264 set id [lindex $displayorder $row]
9257d8f7 5265 lappend ids [list [ordertoken $id] $id]
0380081c
PM
5266 while {$r < $rb} {
5267 foreach p [lindex $parentlist $r] {
5268 set firstkid [lindex $children($curview,$p) 0]
7fcc92bf 5269 if {[rowofcommit $firstkid] < $row} {
9257d8f7 5270 lappend ids [list [ordertoken $p] $p]
9f1afe05 5271 }
9f1afe05 5272 }
0380081c
PM
5273 incr r
5274 set id [lindex $displayorder $r]
5275 if {$id ne {}} {
5276 set firstkid [lindex $children($curview,$id) 0]
7fcc92bf 5277 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
9257d8f7 5278 lappend ids [list [ordertoken $id] $id]
0380081c 5279 }
9f1afe05 5280 }
9f1afe05 5281 }
0380081c
PM
5282 set idlist {}
5283 foreach idx [lsort -unique $ids] {
5284 lappend idlist [lindex $idx 1]
5285 }
5286 return $idlist
9f1afe05
PM
5287}
5288
f5f3c2e2
PM
5289proc rowsequal {a b} {
5290 while {[set i [lsearch -exact $a {}]] >= 0} {
5291 set a [lreplace $a $i $i]
5292 }
5293 while {[set i [lsearch -exact $b {}]] >= 0} {
5294 set b [lreplace $b $i $i]
5295 }
5296 return [expr {$a eq $b}]
9f1afe05
PM
5297}
5298
f5f3c2e2
PM
5299proc makeupline {id row rend col} {
5300 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 5301
f5f3c2e2
PM
5302 for {set r $rend} {1} {set r $rstart} {
5303 set rstart [prevuse $id $r]
5304 if {$rstart < 0} return
5305 if {$rstart < $row} break
5306 }
5307 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5308 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 5309 }
f5f3c2e2
PM
5310 for {set r $rstart} {[incr r] <= $row} {} {
5311 set idlist [lindex $rowidlist $r]
5312 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5313 set col [idcol $idlist $id $col]
5314 lset rowidlist $r [linsert $idlist $col $id]
5315 changedrow $r
5316 }
9f1afe05
PM
5317 }
5318}
5319
0380081c 5320proc layoutrows {row endrow} {
f5f3c2e2 5321 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
5322 global uparrowlen downarrowlen maxwidth mingaplen
5323 global children parentlist
7fcc92bf 5324 global commitidx viewcomplete curview
9f1afe05 5325
7fcc92bf 5326 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
0380081c
PM
5327 set idlist {}
5328 if {$row > 0} {
f56782ae
PM
5329 set rm1 [expr {$row - 1}]
5330 foreach id [lindex $rowidlist $rm1] {
0380081c
PM
5331 if {$id ne {}} {
5332 lappend idlist $id
5333 }
5334 }
f56782ae 5335 set final [lindex $rowfinal $rm1]
79b2c75e 5336 }
0380081c
PM
5337 for {} {$row < $endrow} {incr row} {
5338 set rm1 [expr {$row - 1}]
f56782ae 5339 if {$rm1 < 0 || $idlist eq {}} {
0380081c 5340 set idlist [make_idlist $row]
f5f3c2e2 5341 set final 1
0380081c
PM
5342 } else {
5343 set id [lindex $displayorder $rm1]
5344 set col [lsearch -exact $idlist $id]
5345 set idlist [lreplace $idlist $col $col]
5346 foreach p [lindex $parentlist $rm1] {
5347 if {[lsearch -exact $idlist $p] < 0} {
5348 set col [idcol $idlist $p $col]
5349 set idlist [linsert $idlist $col $p]
f5f3c2e2
PM
5350 # if not the first child, we have to insert a line going up
5351 if {$id ne [lindex $children($curview,$p) 0]} {
5352 makeupline $p $rm1 $row $col
5353 }
0380081c
PM
5354 }
5355 }
5356 set id [lindex $displayorder $row]
5357 if {$row > $downarrowlen} {
5358 set termrow [expr {$row - $downarrowlen - 1}]
5359 foreach p [lindex $parentlist $termrow] {
5360 set i [lsearch -exact $idlist $p]
5361 if {$i < 0} continue
5362 set nr [nextuse $p $termrow]
5363 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5364 set idlist [lreplace $idlist $i $i]
5365 }
5366 }
5367 }
5368 set col [lsearch -exact $idlist $id]
5369 if {$col < 0} {
5370 set col [idcol $idlist $id]
5371 set idlist [linsert $idlist $col $id]
f5f3c2e2
PM
5372 if {$children($curview,$id) ne {}} {
5373 makeupline $id $rm1 $row $col
5374 }
0380081c
PM
5375 }
5376 set r [expr {$row + $uparrowlen - 1}]
5377 if {$r < $commitidx($curview)} {
5378 set x $col
5379 foreach p [lindex $parentlist $r] {
5380 if {[lsearch -exact $idlist $p] >= 0} continue
5381 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5382 if {[rowofcommit $fk] < $row} {
0380081c
PM
5383 set x [idcol $idlist $p $x]
5384 set idlist [linsert $idlist $x $p]
5385 }
5386 }
5387 if {[incr r] < $commitidx($curview)} {
5388 set p [lindex $displayorder $r]
5389 if {[lsearch -exact $idlist $p] < 0} {
5390 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5391 if {$fk ne {} && [rowofcommit $fk] < $row} {
0380081c
PM
5392 set x [idcol $idlist $p $x]
5393 set idlist [linsert $idlist $x $p]
5394 }
5395 }
5396 }
5397 }
5398 }
f5f3c2e2
PM
5399 if {$final && !$viewcomplete($curview) &&
5400 $row + $uparrowlen + $mingaplen + $downarrowlen
5401 >= $commitidx($curview)} {
5402 set final 0
5403 }
0380081c
PM
5404 set l [llength $rowidlist]
5405 if {$row == $l} {
5406 lappend rowidlist $idlist
5407 lappend rowisopt 0
f5f3c2e2 5408 lappend rowfinal $final
0380081c 5409 } elseif {$row < $l} {
f5f3c2e2 5410 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
0380081c
PM
5411 lset rowidlist $row $idlist
5412 changedrow $row
5413 }
f56782ae 5414 lset rowfinal $row $final
0380081c 5415 } else {
f5f3c2e2
PM
5416 set pad [ntimes [expr {$row - $l}] {}]
5417 set rowidlist [concat $rowidlist $pad]
0380081c 5418 lappend rowidlist $idlist
f5f3c2e2
PM
5419 set rowfinal [concat $rowfinal $pad]
5420 lappend rowfinal $final
0380081c
PM
5421 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5422 }
9f1afe05 5423 }
0380081c 5424 return $row
9f1afe05
PM
5425}
5426
0380081c
PM
5427proc changedrow {row} {
5428 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 5429
0380081c
PM
5430 set l [llength $rowisopt]
5431 if {$row < $l} {
5432 lset rowisopt $row 0
5433 if {$row + 1 < $l} {
5434 lset rowisopt [expr {$row + 1}] 0
5435 if {$row + 2 < $l} {
5436 lset rowisopt [expr {$row + 2}] 0
5437 }
5438 }
5439 }
5440 set id [lindex $displayorder $row]
5441 if {[info exists iddrawn($id)]} {
5442 set need_redisplay 1
9f1afe05
PM
5443 }
5444}
5445
5446proc insert_pad {row col npad} {
6e8c8707 5447 global rowidlist
9f1afe05
PM
5448
5449 set pad [ntimes $npad {}]
e341c06d
PM
5450 set idlist [lindex $rowidlist $row]
5451 set bef [lrange $idlist 0 [expr {$col - 1}]]
5452 set aft [lrange $idlist $col end]
5453 set i [lsearch -exact $aft {}]
5454 if {$i > 0} {
5455 set aft [lreplace $aft $i $i]
5456 }
5457 lset rowidlist $row [concat $bef $pad $aft]
0380081c 5458 changedrow $row
9f1afe05
PM
5459}
5460
5461proc optimize_rows {row col endrow} {
0380081c 5462 global rowidlist rowisopt displayorder curview children
9f1afe05 5463
6e8c8707
PM
5464 if {$row < 1} {
5465 set row 1
5466 }
0380081c
PM
5467 for {} {$row < $endrow} {incr row; set col 0} {
5468 if {[lindex $rowisopt $row]} continue
9f1afe05 5469 set haspad 0
6e8c8707
PM
5470 set y0 [expr {$row - 1}]
5471 set ym [expr {$row - 2}]
0380081c
PM
5472 set idlist [lindex $rowidlist $row]
5473 set previdlist [lindex $rowidlist $y0]
5474 if {$idlist eq {} || $previdlist eq {}} continue
5475 if {$ym >= 0} {
5476 set pprevidlist [lindex $rowidlist $ym]
5477 if {$pprevidlist eq {}} continue
5478 } else {
5479 set pprevidlist {}
5480 }
6e8c8707
PM
5481 set x0 -1
5482 set xm -1
5483 for {} {$col < [llength $idlist]} {incr col} {
5484 set id [lindex $idlist $col]
5485 if {[lindex $previdlist $col] eq $id} continue
5486 if {$id eq {}} {
9f1afe05
PM
5487 set haspad 1
5488 continue
5489 }
6e8c8707
PM
5490 set x0 [lsearch -exact $previdlist $id]
5491 if {$x0 < 0} continue
5492 set z [expr {$x0 - $col}]
9f1afe05 5493 set isarrow 0
6e8c8707
PM
5494 set z0 {}
5495 if {$ym >= 0} {
5496 set xm [lsearch -exact $pprevidlist $id]
5497 if {$xm >= 0} {
5498 set z0 [expr {$xm - $x0}]
5499 }
5500 }
9f1afe05 5501 if {$z0 eq {}} {
92ed666f
PM
5502 # if row y0 is the first child of $id then it's not an arrow
5503 if {[lindex $children($curview,$id) 0] ne
5504 [lindex $displayorder $y0]} {
9f1afe05
PM
5505 set isarrow 1
5506 }
5507 }
e341c06d
PM
5508 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5509 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5510 set isarrow 1
5511 }
3fc4279a
PM
5512 # Looking at lines from this row to the previous row,
5513 # make them go straight up if they end in an arrow on
5514 # the previous row; otherwise make them go straight up
5515 # or at 45 degrees.
9f1afe05 5516 if {$z < -1 || ($z < 0 && $isarrow)} {
3fc4279a
PM
5517 # Line currently goes left too much;
5518 # insert pads in the previous row, then optimize it
9f1afe05 5519 set npad [expr {-1 - $z + $isarrow}]
9f1afe05
PM
5520 insert_pad $y0 $x0 $npad
5521 if {$y0 > 0} {
5522 optimize_rows $y0 $x0 $row
5523 }
6e8c8707
PM
5524 set previdlist [lindex $rowidlist $y0]
5525 set x0 [lsearch -exact $previdlist $id]
5526 set z [expr {$x0 - $col}]
5527 if {$z0 ne {}} {
5528 set pprevidlist [lindex $rowidlist $ym]
5529 set xm [lsearch -exact $pprevidlist $id]
5530 set z0 [expr {$xm - $x0}]
5531 }
9f1afe05 5532 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3fc4279a 5533 # Line currently goes right too much;
6e8c8707 5534 # insert pads in this line
9f1afe05 5535 set npad [expr {$z - 1 + $isarrow}]
e341c06d
PM
5536 insert_pad $row $col $npad
5537 set idlist [lindex $rowidlist $row]
9f1afe05 5538 incr col $npad
6e8c8707 5539 set z [expr {$x0 - $col}]
9f1afe05
PM
5540 set haspad 1
5541 }
6e8c8707 5542 if {$z0 eq {} && !$isarrow && $ym >= 0} {
eb447a12 5543 # this line links to its first child on row $row-2
6e8c8707
PM
5544 set id [lindex $displayorder $ym]
5545 set xc [lsearch -exact $pprevidlist $id]
eb447a12
PM
5546 if {$xc >= 0} {
5547 set z0 [expr {$xc - $x0}]
5548 }
5549 }
3fc4279a 5550 # avoid lines jigging left then immediately right
9f1afe05
PM
5551 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5552 insert_pad $y0 $x0 1
6e8c8707
PM
5553 incr x0
5554 optimize_rows $y0 $x0 $row
5555 set previdlist [lindex $rowidlist $y0]
9f1afe05
PM
5556 }
5557 }
5558 if {!$haspad} {
3fc4279a 5559 # Find the first column that doesn't have a line going right
9f1afe05 5560 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
6e8c8707
PM
5561 set id [lindex $idlist $col]
5562 if {$id eq {}} break
5563 set x0 [lsearch -exact $previdlist $id]
5564 if {$x0 < 0} {
eb447a12 5565 # check if this is the link to the first child
92ed666f
PM
5566 set kid [lindex $displayorder $y0]
5567 if {[lindex $children($curview,$id) 0] eq $kid} {
eb447a12 5568 # it is, work out offset to child
92ed666f 5569 set x0 [lsearch -exact $previdlist $kid]
eb447a12
PM
5570 }
5571 }
6e8c8707 5572 if {$x0 <= $col} break
9f1afe05 5573 }
3fc4279a 5574 # Insert a pad at that column as long as it has a line and
6e8c8707
PM
5575 # isn't the last column
5576 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
9f1afe05 5577 set idlist [linsert $idlist $col {}]
0380081c
PM
5578 lset rowidlist $row $idlist
5579 changedrow $row
9f1afe05
PM
5580 }
5581 }
9f1afe05
PM
5582 }
5583}
5584
5585proc xc {row col} {
5586 global canvx0 linespc
5587 return [expr {$canvx0 + $col * $linespc}]
5588}
5589
5590proc yc {row} {
5591 global canvy0 linespc
5592 return [expr {$canvy0 + $row * $linespc}]
5593}
5594
c934a8a3
PM
5595proc linewidth {id} {
5596 global thickerline lthickness
5597
5598 set wid $lthickness
5599 if {[info exists thickerline] && $id eq $thickerline} {
5600 set wid [expr {2 * $lthickness}]
5601 }
5602 return $wid
5603}
5604
50b44ece 5605proc rowranges {id} {
7fcc92bf 5606 global curview children uparrowlen downarrowlen
92ed666f 5607 global rowidlist
50b44ece 5608
92ed666f
PM
5609 set kids $children($curview,$id)
5610 if {$kids eq {}} {
5611 return {}
66e46f37 5612 }
92ed666f
PM
5613 set ret {}
5614 lappend kids $id
5615 foreach child $kids {
7fcc92bf
PM
5616 if {![commitinview $child $curview]} break
5617 set row [rowofcommit $child]
92ed666f
PM
5618 if {![info exists prev]} {
5619 lappend ret [expr {$row + 1}]
322a8cc9 5620 } else {
92ed666f 5621 if {$row <= $prevrow} {
7fcc92bf 5622 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
92ed666f
PM
5623 }
5624 # see if the line extends the whole way from prevrow to row
5625 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5626 [lsearch -exact [lindex $rowidlist \
5627 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5628 # it doesn't, see where it ends
5629 set r [expr {$prevrow + $downarrowlen}]
5630 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5631 while {[incr r -1] > $prevrow &&
5632 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5633 } else {
5634 while {[incr r] <= $row &&
5635 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5636 incr r -1
5637 }
5638 lappend ret $r
5639 # see where it starts up again
5640 set r [expr {$row - $uparrowlen}]
5641 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5642 while {[incr r] < $row &&
5643 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5644 } else {
5645 while {[incr r -1] >= $prevrow &&
5646 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5647 incr r
5648 }
5649 lappend ret $r
5650 }
5651 }
5652 if {$child eq $id} {
5653 lappend ret $row
322a8cc9 5654 }
7fcc92bf 5655 set prev $child
92ed666f 5656 set prevrow $row
9f1afe05 5657 }
92ed666f 5658 return $ret
322a8cc9
PM
5659}
5660
5661proc drawlineseg {id row endrow arrowlow} {
5662 global rowidlist displayorder iddrawn linesegs
e341c06d 5663 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
5664
5665 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5666 set le [expr {$row + 1}]
5667 set arrowhigh 1
9f1afe05 5668 while {1} {
322a8cc9
PM
5669 set c [lsearch -exact [lindex $rowidlist $le] $id]
5670 if {$c < 0} {
5671 incr le -1
5672 break
5673 }
5674 lappend cols $c
5675 set x [lindex $displayorder $le]
5676 if {$x eq $id} {
5677 set arrowhigh 0
5678 break
9f1afe05 5679 }
322a8cc9
PM
5680 if {[info exists iddrawn($x)] || $le == $endrow} {
5681 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5682 if {$c >= 0} {
5683 lappend cols $c
5684 set arrowhigh 0
5685 }
5686 break
5687 }
5688 incr le
9f1afe05 5689 }
322a8cc9
PM
5690 if {$le <= $row} {
5691 return $row
5692 }
5693
5694 set lines {}
5695 set i 0
5696 set joinhigh 0
5697 if {[info exists linesegs($id)]} {
5698 set lines $linesegs($id)
5699 foreach li $lines {
5700 set r0 [lindex $li 0]
5701 if {$r0 > $row} {
5702 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5703 set joinhigh 1
5704 }
5705 break
5706 }
5707 incr i
5708 }
5709 }
5710 set joinlow 0
5711 if {$i > 0} {
5712 set li [lindex $lines [expr {$i-1}]]
5713 set r1 [lindex $li 1]
5714 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5715 set joinlow 1
5716 }
5717 }
5718
5719 set x [lindex $cols [expr {$le - $row}]]
5720 set xp [lindex $cols [expr {$le - 1 - $row}]]
5721 set dir [expr {$xp - $x}]
5722 if {$joinhigh} {
5723 set ith [lindex $lines $i 2]
5724 set coords [$canv coords $ith]
5725 set ah [$canv itemcget $ith -arrow]
5726 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5727 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5728 if {$x2 ne {} && $x - $x2 == $dir} {
5729 set coords [lrange $coords 0 end-2]
5730 }
5731 } else {
5732 set coords [list [xc $le $x] [yc $le]]
5733 }
5734 if {$joinlow} {
5735 set itl [lindex $lines [expr {$i-1}] 2]
5736 set al [$canv itemcget $itl -arrow]
5737 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d
PM
5738 } elseif {$arrowlow} {
5739 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5740 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5741 set arrowlow 0
5742 }
322a8cc9
PM
5743 }
5744 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5745 for {set y $le} {[incr y -1] > $row} {} {
5746 set x $xp
5747 set xp [lindex $cols [expr {$y - 1 - $row}]]
5748 set ndir [expr {$xp - $x}]
5749 if {$dir != $ndir || $xp < 0} {
5750 lappend coords [xc $y $x] [yc $y]
5751 }
5752 set dir $ndir
5753 }
5754 if {!$joinlow} {
5755 if {$xp < 0} {
5756 # join parent line to first child
5757 set ch [lindex $displayorder $row]
5758 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5759 if {$xc < 0} {
5760 puts "oops: drawlineseg: child $ch not on row $row"
e341c06d
PM
5761 } elseif {$xc != $x} {
5762 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5763 set d [expr {int(0.5 * $linespc)}]
5764 set x1 [xc $row $x]
5765 if {$xc < $x} {
5766 set x2 [expr {$x1 - $d}]
5767 } else {
5768 set x2 [expr {$x1 + $d}]
5769 }
5770 set y2 [yc $row]
5771 set y1 [expr {$y2 + $d}]
5772 lappend coords $x1 $y1 $x2 $y2
5773 } elseif {$xc < $x - 1} {
322a8cc9
PM
5774 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5775 } elseif {$xc > $x + 1} {
5776 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5777 }
5778 set x $xc
eb447a12 5779 }
322a8cc9
PM
5780 lappend coords [xc $row $x] [yc $row]
5781 } else {
5782 set xn [xc $row $xp]
5783 set yn [yc $row]
e341c06d 5784 lappend coords $xn $yn
322a8cc9
PM
5785 }
5786 if {!$joinhigh} {
322a8cc9
PM
5787 assigncolor $id
5788 set t [$canv create line $coords -width [linewidth $id] \
5789 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5790 $canv lower $t
5791 bindline $t $id
5792 set lines [linsert $lines $i [list $row $le $t]]
5793 } else {
5794 $canv coords $ith $coords
5795 if {$arrow ne $ah} {
5796 $canv itemconf $ith -arrow $arrow
5797 }
5798 lset lines $i 0 $row
5799 }
5800 } else {
5801 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5802 set ndir [expr {$xo - $xp}]
5803 set clow [$canv coords $itl]
5804 if {$dir == $ndir} {
5805 set clow [lrange $clow 2 end]
5806 }
5807 set coords [concat $coords $clow]
5808 if {!$joinhigh} {
5809 lset lines [expr {$i-1}] 1 $le
322a8cc9
PM
5810 } else {
5811 # coalesce two pieces
5812 $canv delete $ith
5813 set b [lindex $lines [expr {$i-1}] 0]
5814 set e [lindex $lines $i 1]
5815 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5816 }
5817 $canv coords $itl $coords
5818 if {$arrow ne $al} {
5819 $canv itemconf $itl -arrow $arrow
879e8b1a
PM
5820 }
5821 }
322a8cc9
PM
5822
5823 set linesegs($id) $lines
5824 return $le
9f1afe05
PM
5825}
5826
322a8cc9
PM
5827proc drawparentlinks {id row} {
5828 global rowidlist canv colormap curview parentlist
513a54dc 5829 global idpos linespc
9f1afe05 5830
322a8cc9
PM
5831 set rowids [lindex $rowidlist $row]
5832 set col [lsearch -exact $rowids $id]
5833 if {$col < 0} return
5834 set olds [lindex $parentlist $row]
9f1afe05
PM
5835 set row2 [expr {$row + 1}]
5836 set x [xc $row $col]
5837 set y [yc $row]
5838 set y2 [yc $row2]
e341c06d 5839 set d [expr {int(0.5 * $linespc)}]
513a54dc 5840 set ymid [expr {$y + $d}]
8f7d0cec 5841 set ids [lindex $rowidlist $row2]
9f1afe05
PM
5842 # rmx = right-most X coord used
5843 set rmx 0
9f1afe05 5844 foreach p $olds {
f3408449
PM
5845 set i [lsearch -exact $ids $p]
5846 if {$i < 0} {
5847 puts "oops, parent $p of $id not in list"
5848 continue
5849 }
5850 set x2 [xc $row2 $i]
5851 if {$x2 > $rmx} {
5852 set rmx $x2
5853 }
513a54dc
PM
5854 set j [lsearch -exact $rowids $p]
5855 if {$j < 0} {
eb447a12
PM
5856 # drawlineseg will do this one for us
5857 continue
5858 }
9f1afe05
PM
5859 assigncolor $p
5860 # should handle duplicated parents here...
5861 set coords [list $x $y]
513a54dc
PM
5862 if {$i != $col} {
5863 # if attaching to a vertical segment, draw a smaller
5864 # slant for visual distinctness
5865 if {$i == $j} {
5866 if {$i < $col} {
5867 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5868 } else {
5869 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5870 }
5871 } elseif {$i < $col && $i < $j} {
5872 # segment slants towards us already
5873 lappend coords [xc $row $j] $y
5874 } else {
5875 if {$i < $col - 1} {
5876 lappend coords [expr {$x2 + $linespc}] $y
5877 } elseif {$i > $col + 1} {
5878 lappend coords [expr {$x2 - $linespc}] $y
5879 }
5880 lappend coords $x2 $y2
5881 }
5882 } else {
5883 lappend coords $x2 $y2
9f1afe05 5884 }
c934a8a3 5885 set t [$canv create line $coords -width [linewidth $p] \
9f1afe05
PM
5886 -fill $colormap($p) -tags lines.$p]
5887 $canv lower $t
5888 bindline $t $p
5889 }
322a8cc9
PM
5890 if {$rmx > [lindex $idpos($id) 1]} {
5891 lset idpos($id) 1 $rmx
5892 redrawtags $id
5893 }
9f1afe05
PM
5894}
5895
c934a8a3 5896proc drawlines {id} {
322a8cc9 5897 global canv
9f1afe05 5898
322a8cc9 5899 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
5900}
5901
322a8cc9 5902proc drawcmittext {id row col} {
7fcc92bf
PM
5903 global linespc canv canv2 canv3 fgcolor curview
5904 global cmitlisted commitinfo rowidlist parentlist
9f1afe05 5905 global rowtextx idpos idtags idheads idotherrefs
0380081c 5906 global linehtag linentag linedtag selectedline
b9fdba7f 5907 global canvxmax boldids boldnameids fgcolor markedid
d277e89f 5908 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
9f1afe05 5909
1407ade9 5910 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
7fcc92bf 5911 set listed $cmitlisted($curview,$id)
219ea3a9
PM
5912 if {$id eq $nullid} {
5913 set ofill red
8f489363 5914 } elseif {$id eq $nullid2} {
ef3192b8 5915 set ofill green
c11ff120
PM
5916 } elseif {$id eq $mainheadid} {
5917 set ofill yellow
219ea3a9 5918 } else {
c11ff120 5919 set ofill [lindex $circlecolors $listed]
219ea3a9 5920 }
9f1afe05
PM
5921 set x [xc $row $col]
5922 set y [yc $row]
5923 set orad [expr {$linespc / 3}]
1407ade9 5924 if {$listed <= 2} {
c961b228
PM
5925 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5926 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5927 -fill $ofill -outline $fgcolor -width 1 -tags circle]
1407ade9 5928 } elseif {$listed == 3} {
c961b228
PM
5929 # triangle pointing left for left-side commits
5930 set t [$canv create polygon \
5931 [expr {$x - $orad}] $y \
5932 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5933 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5934 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5935 } else {
5936 # triangle pointing right for right-side commits
5937 set t [$canv create polygon \
5938 [expr {$x + $orad - 1}] $y \
5939 [expr {$x - $orad}] [expr {$y - $orad}] \
5940 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5941 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5942 }
c11ff120 5943 set circleitem($row) $t
9f1afe05
PM
5944 $canv raise $t
5945 $canv bind $t <1> {selcanvline {} %x %y}
322a8cc9
PM
5946 set rmx [llength [lindex $rowidlist $row]]
5947 set olds [lindex $parentlist $row]
5948 if {$olds ne {}} {
5949 set nextids [lindex $rowidlist [expr {$row + 1}]]
5950 foreach p $olds {
5951 set i [lsearch -exact $nextids $p]
5952 if {$i > $rmx} {
5953 set rmx $i
5954 }
5955 }
9f1afe05 5956 }
322a8cc9 5957 set xt [xc $row $rmx]
9f1afe05
PM
5958 set rowtextx($row) $xt
5959 set idpos($id) [list $x $xt $y]
5960 if {[info exists idtags($id)] || [info exists idheads($id)]
5961 || [info exists idotherrefs($id)]} {
5962 set xt [drawtags $id $x $xt $y]
5963 }
36242490
RZ
5964 if {[lindex $commitinfo($id) 6] > 0} {
5965 set xt [drawnotesign $xt $y]
5966 }
9f1afe05
PM
5967 set headline [lindex $commitinfo($id) 0]
5968 set name [lindex $commitinfo($id) 1]
5969 set date [lindex $commitinfo($id) 2]
5970 set date [formatdate $date]
9c311b32
PM
5971 set font mainfont
5972 set nfont mainfont
476ca63d 5973 set isbold [ishighlighted $id]
908c3585 5974 if {$isbold > 0} {
28593d3f 5975 lappend boldids $id
9c311b32 5976 set font mainfontbold
908c3585 5977 if {$isbold > 1} {
28593d3f 5978 lappend boldnameids $id
9c311b32 5979 set nfont mainfontbold
908c3585 5980 }
da7c24dd 5981 }
28593d3f
PM
5982 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5983 -text $headline -font $font -tags text]
5984 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5985 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5986 -text $name -font $nfont -tags text]
5987 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5988 -text $date -font mainfont -tags text]
94b4a69f 5989 if {$selectedline == $row} {
28593d3f 5990 make_secsel $id
0380081c 5991 }
b9fdba7f
PM
5992 if {[info exists markedid] && $markedid eq $id} {
5993 make_idmark $id
5994 }
9c311b32 5995 set xr [expr {$xt + [font measure $font $headline]}]
be0cd098
PM
5996 if {$xr > $canvxmax} {
5997 set canvxmax $xr
5998 setcanvscroll
5999 }
9f1afe05
PM
6000}
6001
6002proc drawcmitrow {row} {
0380081c 6003 global displayorder rowidlist nrows_drawn
005a2f4e 6004 global iddrawn markingmatches
7fcc92bf 6005 global commitinfo numcommits
687c8765 6006 global filehighlight fhighlights findpattern nhighlights
908c3585 6007 global hlview vhighlights
164ff275 6008 global highlight_related rhighlights
9f1afe05 6009
8f7d0cec 6010 if {$row >= $numcommits} return
9f1afe05
PM
6011
6012 set id [lindex $displayorder $row]
476ca63d 6013 if {[info exists hlview] && ![info exists vhighlights($id)]} {
908c3585
PM
6014 askvhighlight $row $id
6015 }
476ca63d 6016 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
908c3585
PM
6017 askfilehighlight $row $id
6018 }
476ca63d 6019 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
60f7a7dc 6020 askfindhighlight $row $id
908c3585 6021 }
476ca63d 6022 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
164ff275
PM
6023 askrelhighlight $row $id
6024 }
005a2f4e
PM
6025 if {![info exists iddrawn($id)]} {
6026 set col [lsearch -exact [lindex $rowidlist $row] $id]
6027 if {$col < 0} {
6028 puts "oops, row $row id $id not in list"
6029 return
6030 }
6031 if {![info exists commitinfo($id)]} {
6032 getcommit $id
6033 }
6034 assigncolor $id
6035 drawcmittext $id $row $col
6036 set iddrawn($id) 1
0380081c 6037 incr nrows_drawn
9f1afe05 6038 }
005a2f4e
PM
6039 if {$markingmatches} {
6040 markrowmatches $row $id
9f1afe05 6041 }
9f1afe05
PM
6042}
6043
322a8cc9 6044proc drawcommits {row {endrow {}}} {
0380081c 6045 global numcommits iddrawn displayorder curview need_redisplay
f5f3c2e2 6046 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
9f1afe05 6047
9f1afe05
PM
6048 if {$row < 0} {
6049 set row 0
6050 }
322a8cc9
PM
6051 if {$endrow eq {}} {
6052 set endrow $row
6053 }
9f1afe05
PM
6054 if {$endrow >= $numcommits} {
6055 set endrow [expr {$numcommits - 1}]
6056 }
322a8cc9 6057
0380081c
PM
6058 set rl1 [expr {$row - $downarrowlen - 3}]
6059 if {$rl1 < 0} {
6060 set rl1 0
6061 }
6062 set ro1 [expr {$row - 3}]
6063 if {$ro1 < 0} {
6064 set ro1 0
6065 }
6066 set r2 [expr {$endrow + $uparrowlen + 3}]
6067 if {$r2 > $numcommits} {
6068 set r2 $numcommits
6069 }
6070 for {set r $rl1} {$r < $r2} {incr r} {
f5f3c2e2 6071 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
0380081c
PM
6072 if {$rl1 < $r} {
6073 layoutrows $rl1 $r
6074 }
6075 set rl1 [expr {$r + 1}]
6076 }
6077 }
6078 if {$rl1 < $r} {
6079 layoutrows $rl1 $r
6080 }
6081 optimize_rows $ro1 0 $r2
6082 if {$need_redisplay || $nrows_drawn > 2000} {
6083 clear_display
0380081c
PM
6084 }
6085
322a8cc9
PM
6086 # make the lines join to already-drawn rows either side
6087 set r [expr {$row - 1}]
6088 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6089 set r $row
6090 }
6091 set er [expr {$endrow + 1}]
6092 if {$er >= $numcommits ||
6093 ![info exists iddrawn([lindex $displayorder $er])]} {
6094 set er $endrow
6095 }
6096 for {} {$r <= $er} {incr r} {
6097 set id [lindex $displayorder $r]
6098 set wasdrawn [info exists iddrawn($id)]
4fb0fa19 6099 drawcmitrow $r
322a8cc9
PM
6100 if {$r == $er} break
6101 set nextid [lindex $displayorder [expr {$r + 1}]]
e5ef6f95 6102 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
322a8cc9
PM
6103 drawparentlinks $id $r
6104
322a8cc9
PM
6105 set rowids [lindex $rowidlist $r]
6106 foreach lid $rowids {
6107 if {$lid eq {}} continue
e5ef6f95 6108 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
322a8cc9
PM
6109 if {$lid eq $id} {
6110 # see if this is the first child of any of its parents
6111 foreach p [lindex $parentlist $r] {
6112 if {[lsearch -exact $rowids $p] < 0} {
6113 # make this line extend up to the child
e5ef6f95 6114 set lineend($p) [drawlineseg $p $r $er 0]
322a8cc9
PM
6115 }
6116 }
e5ef6f95
PM
6117 } else {
6118 set lineend($lid) [drawlineseg $lid $r $er 1]
322a8cc9
PM
6119 }
6120 }
9f1afe05
PM
6121 }
6122}
6123
7fcc92bf
PM
6124proc undolayout {row} {
6125 global uparrowlen mingaplen downarrowlen
6126 global rowidlist rowisopt rowfinal need_redisplay
6127
6128 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6129 if {$r < 0} {
6130 set r 0
6131 }
6132 if {[llength $rowidlist] > $r} {
6133 incr r -1
6134 set rowidlist [lrange $rowidlist 0 $r]
6135 set rowfinal [lrange $rowfinal 0 $r]
6136 set rowisopt [lrange $rowisopt 0 $r]
6137 set need_redisplay 1
6138 run drawvisible
6139 }
6140}
6141
31c0eaa8
PM
6142proc drawvisible {} {
6143 global canv linespc curview vrowmod selectedline targetrow targetid
42a671fc 6144 global need_redisplay cscroll numcommits
322a8cc9 6145
31c0eaa8 6146 set fs [$canv yview]
322a8cc9 6147 set ymax [lindex [$canv cget -scrollregion] 3]
5a7f577d 6148 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
31c0eaa8
PM
6149 set f0 [lindex $fs 0]
6150 set f1 [lindex $fs 1]
322a8cc9 6151 set y0 [expr {int($f0 * $ymax)}]
322a8cc9 6152 set y1 [expr {int($f1 * $ymax)}]
31c0eaa8
PM
6153
6154 if {[info exists targetid]} {
42a671fc
PM
6155 if {[commitinview $targetid $curview]} {
6156 set r [rowofcommit $targetid]
6157 if {$r != $targetrow} {
6158 # Fix up the scrollregion and change the scrolling position
6159 # now that our target row has moved.
6160 set diff [expr {($r - $targetrow) * $linespc}]
6161 set targetrow $r
6162 setcanvscroll
6163 set ymax [lindex [$canv cget -scrollregion] 3]
6164 incr y0 $diff
6165 incr y1 $diff
6166 set f0 [expr {$y0 / $ymax}]
6167 set f1 [expr {$y1 / $ymax}]
6168 allcanvs yview moveto $f0
6169 $cscroll set $f0 $f1
6170 set need_redisplay 1
6171 }
6172 } else {
6173 unset targetid
31c0eaa8
PM
6174 }
6175 }
6176
6177 set row [expr {int(($y0 - 3) / $linespc) - 1}]
322a8cc9 6178 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
31c0eaa8
PM
6179 if {$endrow >= $vrowmod($curview)} {
6180 update_arcrows $curview
6181 }
94b4a69f 6182 if {$selectedline ne {} &&
31c0eaa8
PM
6183 $row <= $selectedline && $selectedline <= $endrow} {
6184 set targetrow $selectedline
ac1276ab 6185 } elseif {[info exists targetid]} {
31c0eaa8
PM
6186 set targetrow [expr {int(($row + $endrow) / 2)}]
6187 }
ac1276ab
PM
6188 if {[info exists targetrow]} {
6189 if {$targetrow >= $numcommits} {
6190 set targetrow [expr {$numcommits - 1}]
6191 }
6192 set targetid [commitonrow $targetrow]
42a671fc 6193 }
322a8cc9
PM
6194 drawcommits $row $endrow
6195}
6196
9f1afe05 6197proc clear_display {} {
0380081c 6198 global iddrawn linesegs need_redisplay nrows_drawn
164ff275 6199 global vhighlights fhighlights nhighlights rhighlights
28593d3f 6200 global linehtag linentag linedtag boldids boldnameids
9f1afe05
PM
6201
6202 allcanvs delete all
6203 catch {unset iddrawn}
322a8cc9 6204 catch {unset linesegs}
94503a66
PM
6205 catch {unset linehtag}
6206 catch {unset linentag}
6207 catch {unset linedtag}
28593d3f
PM
6208 set boldids {}
6209 set boldnameids {}
908c3585
PM
6210 catch {unset vhighlights}
6211 catch {unset fhighlights}
6212 catch {unset nhighlights}
164ff275 6213 catch {unset rhighlights}
0380081c
PM
6214 set need_redisplay 0
6215 set nrows_drawn 0
9f1afe05
PM
6216}
6217
50b44ece 6218proc findcrossings {id} {
6e8c8707 6219 global rowidlist parentlist numcommits displayorder
50b44ece
PM
6220
6221 set cross {}
6222 set ccross {}
6223 foreach {s e} [rowranges $id] {
6224 if {$e >= $numcommits} {
6225 set e [expr {$numcommits - 1}]
50b44ece 6226 }
d94f8cd6 6227 if {$e <= $s} continue
50b44ece 6228 for {set row $e} {[incr row -1] >= $s} {} {
6e8c8707
PM
6229 set x [lsearch -exact [lindex $rowidlist $row] $id]
6230 if {$x < 0} break
50b44ece
PM
6231 set olds [lindex $parentlist $row]
6232 set kid [lindex $displayorder $row]
6233 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6234 if {$kidx < 0} continue
6235 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6236 foreach p $olds {
6237 set px [lsearch -exact $nextrow $p]
6238 if {$px < 0} continue
6239 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6240 if {[lsearch -exact $ccross $p] >= 0} continue
6241 if {$x == $px + ($kidx < $px? -1: 1)} {
6242 lappend ccross $p
6243 } elseif {[lsearch -exact $cross $p] < 0} {
6244 lappend cross $p
6245 }
6246 }
6247 }
50b44ece
PM
6248 }
6249 }
6250 return [concat $ccross {{}} $cross]
6251}
6252
e5c2d856 6253proc assigncolor {id} {
aa81d974 6254 global colormap colors nextcolor
7fcc92bf 6255 global parents children children curview
6c20ff34 6256
418c4c7b 6257 if {[info exists colormap($id)]} return
e5c2d856 6258 set ncolors [llength $colors]
da7c24dd
PM
6259 if {[info exists children($curview,$id)]} {
6260 set kids $children($curview,$id)
79b2c75e
PM
6261 } else {
6262 set kids {}
6263 }
6264 if {[llength $kids] == 1} {
6265 set child [lindex $kids 0]
9ccbdfbf 6266 if {[info exists colormap($child)]
7fcc92bf 6267 && [llength $parents($curview,$child)] == 1} {
9ccbdfbf
PM
6268 set colormap($id) $colormap($child)
6269 return
e5c2d856 6270 }
9ccbdfbf
PM
6271 }
6272 set badcolors {}
50b44ece
PM
6273 set origbad {}
6274 foreach x [findcrossings $id] {
6275 if {$x eq {}} {
6276 # delimiter between corner crossings and other crossings
6277 if {[llength $badcolors] >= $ncolors - 1} break
6278 set origbad $badcolors
e5c2d856 6279 }
50b44ece
PM
6280 if {[info exists colormap($x)]
6281 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6282 lappend badcolors $colormap($x)
6c20ff34
PM
6283 }
6284 }
50b44ece
PM
6285 if {[llength $badcolors] >= $ncolors} {
6286 set badcolors $origbad
9ccbdfbf 6287 }
50b44ece 6288 set origbad $badcolors
6c20ff34 6289 if {[llength $badcolors] < $ncolors - 1} {
79b2c75e 6290 foreach child $kids {
6c20ff34
PM
6291 if {[info exists colormap($child)]
6292 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6293 lappend badcolors $colormap($child)
6294 }
7fcc92bf 6295 foreach p $parents($curview,$child) {
79b2c75e
PM
6296 if {[info exists colormap($p)]
6297 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6298 lappend badcolors $colormap($p)
6c20ff34
PM
6299 }
6300 }
6301 }
6302 if {[llength $badcolors] >= $ncolors} {
6303 set badcolors $origbad
6304 }
9ccbdfbf
PM
6305 }
6306 for {set i 0} {$i <= $ncolors} {incr i} {
6307 set c [lindex $colors $nextcolor]
6308 if {[incr nextcolor] >= $ncolors} {
6309 set nextcolor 0
e5c2d856 6310 }
9ccbdfbf 6311 if {[lsearch -exact $badcolors $c]} break
e5c2d856 6312 }
9ccbdfbf 6313 set colormap($id) $c
e5c2d856
PM
6314}
6315
a823a911
PM
6316proc bindline {t id} {
6317 global canv
6318
a823a911
PM
6319 $canv bind $t <Enter> "lineenter %x %y $id"
6320 $canv bind $t <Motion> "linemotion %x %y $id"
6321 $canv bind $t <Leave> "lineleave $id"
fa4da7b3 6322 $canv bind $t <Button-1> "lineclick %x %y $id 1"
a823a911
PM
6323}
6324
bdbfbe3d 6325proc drawtags {id x xt y1} {
8a48571c 6326 global idtags idheads idotherrefs mainhead
bdbfbe3d 6327 global linespc lthickness
d277e89f 6328 global canv rowtextx curview fgcolor bgcolor ctxbut
bdbfbe3d
PM
6329
6330 set marks {}
6331 set ntags 0
f1d83ba3 6332 set nheads 0
bdbfbe3d
PM
6333 if {[info exists idtags($id)]} {
6334 set marks $idtags($id)
6335 set ntags [llength $marks]
6336 }
6337 if {[info exists idheads($id)]} {
6338 set marks [concat $marks $idheads($id)]
f1d83ba3
PM
6339 set nheads [llength $idheads($id)]
6340 }
6341 if {[info exists idotherrefs($id)]} {
6342 set marks [concat $marks $idotherrefs($id)]
bdbfbe3d
PM
6343 }
6344 if {$marks eq {}} {
6345 return $xt
6346 }
6347
6348 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2ed49d54
JH
6349 set yt [expr {$y1 - 0.5 * $linespc}]
6350 set yb [expr {$yt + $linespc - 1}]
bdbfbe3d
PM
6351 set xvals {}
6352 set wvals {}
8a48571c 6353 set i -1
bdbfbe3d 6354 foreach tag $marks {
8a48571c
PM
6355 incr i
6356 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
9c311b32 6357 set wid [font measure mainfontbold $tag]
8a48571c 6358 } else {
9c311b32 6359 set wid [font measure mainfont $tag]
8a48571c 6360 }
bdbfbe3d
PM
6361 lappend xvals $xt
6362 lappend wvals $wid
6363 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6364 }
6365 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6366 -width $lthickness -fill black -tags tag.$id]
6367 $canv lower $t
6368 foreach tag $marks x $xvals wid $wvals {
8dd60f54 6369 set tag_quoted [string map {% %%} $tag]
2ed49d54
JH
6370 set xl [expr {$x + $delta}]
6371 set xr [expr {$x + $delta + $wid + $lthickness}]
9c311b32 6372 set font mainfont
bdbfbe3d
PM
6373 if {[incr ntags -1] >= 0} {
6374 # draw a tag
2ed49d54
JH
6375 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6376 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
106288cb 6377 -width 1 -outline black -fill yellow -tags tag.$id]
8dd60f54 6378 $canv bind $t <1> [list showtag $tag_quoted 1]
7fcc92bf 6379 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
bdbfbe3d 6380 } else {
f1d83ba3
PM
6381 # draw a head or other ref
6382 if {[incr nheads -1] >= 0} {
6383 set col green
8a48571c 6384 if {$tag eq $mainhead} {
9c311b32 6385 set font mainfontbold
8a48571c 6386 }
f1d83ba3
PM
6387 } else {
6388 set col "#ddddff"
6389 }
2ed49d54 6390 set xl [expr {$xl - $delta/2}]
bdbfbe3d 6391 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
f1d83ba3 6392 -width 1 -outline black -fill $col -tags tag.$id
a970fcf2 6393 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
9c311b32 6394 set rwid [font measure mainfont $remoteprefix]
a970fcf2
JW
6395 set xi [expr {$x + 1}]
6396 set yti [expr {$yt + 1}]
6397 set xri [expr {$x + $rwid}]
6398 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6399 -width 0 -fill "#ffddaa" -tags tag.$id
6400 }
bdbfbe3d 6401 }
f8a2c0d1 6402 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
8a48571c 6403 -font $font -tags [list tag.$id text]]
106288cb 6404 if {$ntags >= 0} {
8dd60f54 6405 $canv bind $t <1> [list showtag $tag_quoted 1]
10299152 6406 } elseif {$nheads >= 0} {
8dd60f54 6407 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
106288cb 6408 }
bdbfbe3d
PM
6409 }
6410 return $xt
6411}
6412
36242490
RZ
6413proc drawnotesign {xt y} {
6414 global linespc canv fgcolor
6415
6416 set orad [expr {$linespc / 3}]
6417 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6418 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6419 -fill yellow -outline $fgcolor -width 1 -tags circle]
6420 set xt [expr {$xt + $orad * 3}]
6421 return $xt
6422}
6423
8d858d1a
PM
6424proc xcoord {i level ln} {
6425 global canvx0 xspc1 xspc2
6426
6427 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6428 if {$i > 0 && $i == $level} {
6429 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6430 } elseif {$i > $level} {
6431 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6432 }
6433 return $x
6434}
9ccbdfbf 6435
098dd8a3 6436proc show_status {msg} {
9c311b32 6437 global canv fgcolor
098dd8a3
PM
6438
6439 clear_display
9c311b32 6440 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
f8a2c0d1 6441 -tags text -fill $fgcolor
098dd8a3
PM
6442}
6443
94a2eede
PM
6444# Don't change the text pane cursor if it is currently the hand cursor,
6445# showing that we are over a sha1 ID link.
6446proc settextcursor {c} {
6447 global ctext curtextcursor
6448
6449 if {[$ctext cget -cursor] == $curtextcursor} {
6450 $ctext config -cursor $c
6451 }
6452 set curtextcursor $c
9ccbdfbf
PM
6453}
6454
a137a90f
PM
6455proc nowbusy {what {name {}}} {
6456 global isbusy busyname statusw
da7c24dd
PM
6457
6458 if {[array names isbusy] eq {}} {
6459 . config -cursor watch
6460 settextcursor watch
6461 }
6462 set isbusy($what) 1
a137a90f
PM
6463 set busyname($what) $name
6464 if {$name ne {}} {
6465 $statusw conf -text $name
6466 }
da7c24dd
PM
6467}
6468
6469proc notbusy {what} {
a137a90f 6470 global isbusy maincursor textcursor busyname statusw
da7c24dd 6471
a137a90f
PM
6472 catch {
6473 unset isbusy($what)
6474 if {$busyname($what) ne {} &&
6475 [$statusw cget -text] eq $busyname($what)} {
6476 $statusw conf -text {}
6477 }
6478 }
da7c24dd
PM
6479 if {[array names isbusy] eq {}} {
6480 . config -cursor $maincursor
6481 settextcursor $textcursor
6482 }
6483}
6484
df3d83b1 6485proc findmatches {f} {
4fb0fa19 6486 global findtype findstring
b007ee20 6487 if {$findtype == [mc "Regexp"]} {
4fb0fa19 6488 set matches [regexp -indices -all -inline $findstring $f]
df3d83b1 6489 } else {
4fb0fa19 6490 set fs $findstring
b007ee20 6491 if {$findtype == [mc "IgnCase"]} {
4fb0fa19
PM
6492 set f [string tolower $f]
6493 set fs [string tolower $fs]
df3d83b1
PM
6494 }
6495 set matches {}
6496 set i 0
4fb0fa19
PM
6497 set l [string length $fs]
6498 while {[set j [string first $fs $f $i]] >= 0} {
6499 lappend matches [list $j [expr {$j+$l-1}]]
6500 set i [expr {$j + $l}]
df3d83b1
PM
6501 }
6502 }
6503 return $matches
6504}
6505
cca5d946 6506proc dofind {{dirn 1} {wrap 1}} {
4fb0fa19 6507 global findstring findstartline findcurline selectedline numcommits
cca5d946 6508 global gdttype filehighlight fh_serial find_dirn findallowwrap
b74fd579 6509
cca5d946
PM
6510 if {[info exists find_dirn]} {
6511 if {$find_dirn == $dirn} return
6512 stopfinding
6513 }
df3d83b1 6514 focus .
4fb0fa19 6515 if {$findstring eq {} || $numcommits == 0} return
94b4a69f 6516 if {$selectedline eq {}} {
cca5d946 6517 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
98f350e5 6518 } else {
4fb0fa19 6519 set findstartline $selectedline
98f350e5 6520 }
4fb0fa19 6521 set findcurline $findstartline
b007ee20
CS
6522 nowbusy finding [mc "Searching"]
6523 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
687c8765
PM
6524 after cancel do_file_hl $fh_serial
6525 do_file_hl $fh_serial
98f350e5 6526 }
cca5d946
PM
6527 set find_dirn $dirn
6528 set findallowwrap $wrap
6529 run findmore
4fb0fa19
PM
6530}
6531
bb3edc8b
PM
6532proc stopfinding {} {
6533 global find_dirn findcurline fprogcoord
4fb0fa19 6534
bb3edc8b
PM
6535 if {[info exists find_dirn]} {
6536 unset find_dirn
6537 unset findcurline
6538 notbusy finding
6539 set fprogcoord 0
6540 adjustprogress
4fb0fa19 6541 }
8a897742 6542 stopblaming
4fb0fa19
PM
6543}
6544
6545proc findmore {} {
687c8765 6546 global commitdata commitinfo numcommits findpattern findloc
7fcc92bf 6547 global findstartline findcurline findallowwrap
bb3edc8b 6548 global find_dirn gdttype fhighlights fprogcoord
cd2bcae7 6549 global curview varcorder vrownum varccommits vrowmod
4fb0fa19 6550
bb3edc8b 6551 if {![info exists find_dirn]} {
4fb0fa19
PM
6552 return 0
6553 }
585c27cb 6554 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
4fb0fa19 6555 set l $findcurline
cca5d946
PM
6556 set moretodo 0
6557 if {$find_dirn > 0} {
6558 incr l
6559 if {$l >= $numcommits} {
6560 set l 0
6561 }
6562 if {$l <= $findstartline} {
6563 set lim [expr {$findstartline + 1}]
6564 } else {
6565 set lim $numcommits
6566 set moretodo $findallowwrap
8ed16484 6567 }
4fb0fa19 6568 } else {
cca5d946
PM
6569 if {$l == 0} {
6570 set l $numcommits
98f350e5 6571 }
cca5d946
PM
6572 incr l -1
6573 if {$l >= $findstartline} {
6574 set lim [expr {$findstartline - 1}]
bb3edc8b 6575 } else {
cca5d946
PM
6576 set lim -1
6577 set moretodo $findallowwrap
bb3edc8b 6578 }
687c8765 6579 }
cca5d946
PM
6580 set n [expr {($lim - $l) * $find_dirn}]
6581 if {$n > 500} {
6582 set n 500
6583 set moretodo 1
4fb0fa19 6584 }
cd2bcae7
PM
6585 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6586 update_arcrows $curview
6587 }
687c8765
PM
6588 set found 0
6589 set domore 1
7fcc92bf
PM
6590 set ai [bsearch $vrownum($curview) $l]
6591 set a [lindex $varcorder($curview) $ai]
6592 set arow [lindex $vrownum($curview) $ai]
6593 set ids [lindex $varccommits($curview,$a)]
6594 set arowend [expr {$arow + [llength $ids]}]
b007ee20 6595 if {$gdttype eq [mc "containing:"]} {
cca5d946 6596 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6597 if {$l < $arow || $l >= $arowend} {
6598 incr ai $find_dirn
6599 set a [lindex $varcorder($curview) $ai]
6600 set arow [lindex $vrownum($curview) $ai]
6601 set ids [lindex $varccommits($curview,$a)]
6602 set arowend [expr {$arow + [llength $ids]}]
6603 }
6604 set id [lindex $ids [expr {$l - $arow}]]
cca5d946 6605 # shouldn't happen unless git log doesn't give all the commits...
7fcc92bf
PM
6606 if {![info exists commitdata($id)] ||
6607 ![doesmatch $commitdata($id)]} {
6608 continue
6609 }
687c8765
PM
6610 if {![info exists commitinfo($id)]} {
6611 getcommit $id
6612 }
6613 set info $commitinfo($id)
6614 foreach f $info ty $fldtypes {
585c27cb 6615 if {$ty eq ""} continue
b007ee20 6616 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
687c8765
PM
6617 [doesmatch $f]} {
6618 set found 1
6619 break
6620 }
6621 }
6622 if {$found} break
4fb0fa19 6623 }
687c8765 6624 } else {
cca5d946 6625 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6626 if {$l < $arow || $l >= $arowend} {
6627 incr ai $find_dirn
6628 set a [lindex $varcorder($curview) $ai]
6629 set arow [lindex $vrownum($curview) $ai]
6630 set ids [lindex $varccommits($curview,$a)]
6631 set arowend [expr {$arow + [llength $ids]}]
6632 }
6633 set id [lindex $ids [expr {$l - $arow}]]
476ca63d
PM
6634 if {![info exists fhighlights($id)]} {
6635 # this sets fhighlights($id) to -1
687c8765 6636 askfilehighlight $l $id
cd2bcae7 6637 }
476ca63d 6638 if {$fhighlights($id) > 0} {
cd2bcae7
PM
6639 set found $domore
6640 break
6641 }
476ca63d 6642 if {$fhighlights($id) < 0} {
687c8765
PM
6643 if {$domore} {
6644 set domore 0
cca5d946 6645 set findcurline [expr {$l - $find_dirn}]
687c8765 6646 }
98f350e5
PM
6647 }
6648 }
6649 }
cca5d946 6650 if {$found || ($domore && !$moretodo)} {
4fb0fa19 6651 unset findcurline
687c8765 6652 unset find_dirn
4fb0fa19 6653 notbusy finding
bb3edc8b
PM
6654 set fprogcoord 0
6655 adjustprogress
6656 if {$found} {
6657 findselectline $l
6658 } else {
6659 bell
6660 }
4fb0fa19 6661 return 0
df3d83b1 6662 }
687c8765
PM
6663 if {!$domore} {
6664 flushhighlights
bb3edc8b 6665 } else {
cca5d946 6666 set findcurline [expr {$l - $find_dirn}]
687c8765 6667 }
cca5d946 6668 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
bb3edc8b
PM
6669 if {$n < 0} {
6670 incr n $numcommits
df3d83b1 6671 }
bb3edc8b
PM
6672 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6673 adjustprogress
6674 return $domore
df3d83b1
PM
6675}
6676
6677proc findselectline {l} {
687c8765 6678 global findloc commentend ctext findcurline markingmatches gdttype
005a2f4e 6679
8b39e04f 6680 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
005a2f4e 6681 set findcurline $l
d698206c 6682 selectline $l 1
8b39e04f
PM
6683 if {$markingmatches &&
6684 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
df3d83b1
PM
6685 # highlight the matches in the comments
6686 set f [$ctext get 1.0 $commentend]
6687 set matches [findmatches $f]
6688 foreach match $matches {
6689 set start [lindex $match 0]
2ed49d54 6690 set end [expr {[lindex $match 1] + 1}]
df3d83b1
PM
6691 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6692 }
98f350e5 6693 }
005a2f4e 6694 drawvisible
98f350e5
PM
6695}
6696
4fb0fa19 6697# mark the bits of a headline or author that match a find string
005a2f4e
PM
6698proc markmatches {canv l str tag matches font row} {
6699 global selectedline
6700
98f350e5
PM
6701 set bbox [$canv bbox $tag]
6702 set x0 [lindex $bbox 0]
6703 set y0 [lindex $bbox 1]
6704 set y1 [lindex $bbox 3]
6705 foreach match $matches {
6706 set start [lindex $match 0]
6707 set end [lindex $match 1]
6708 if {$start > $end} continue
2ed49d54
JH
6709 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6710 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6711 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6712 [expr {$x0+$xlen+2}] $y1 \
4fb0fa19 6713 -outline {} -tags [list match$l matches] -fill yellow]
98f350e5 6714 $canv lower $t
94b4a69f 6715 if {$row == $selectedline} {
005a2f4e
PM
6716 $canv raise $t secsel
6717 }
98f350e5
PM
6718 }
6719}
6720
6721proc unmarkmatches {} {
bb3edc8b 6722 global markingmatches
4fb0fa19 6723
98f350e5 6724 allcanvs delete matches
4fb0fa19 6725 set markingmatches 0
bb3edc8b 6726 stopfinding
98f350e5
PM
6727}
6728
c8dfbcf9 6729proc selcanvline {w x y} {
fa4da7b3 6730 global canv canvy0 ctext linespc
9f1afe05 6731 global rowtextx
1db95b00 6732 set ymax [lindex [$canv cget -scrollregion] 3]
cfb4563c 6733 if {$ymax == {}} return
1db95b00
PM
6734 set yfrac [lindex [$canv yview] 0]
6735 set y [expr {$y + $yfrac * $ymax}]
6736 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6737 if {$l < 0} {
6738 set l 0
6739 }
c8dfbcf9 6740 if {$w eq $canv} {
fc2a256f
PM
6741 set xmax [lindex [$canv cget -scrollregion] 2]
6742 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6743 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
c8dfbcf9 6744 }
98f350e5 6745 unmarkmatches
d698206c 6746 selectline $l 1
5ad588de
PM
6747}
6748
b1ba39e7
LT
6749proc commit_descriptor {p} {
6750 global commitinfo
b0934489
PM
6751 if {![info exists commitinfo($p)]} {
6752 getcommit $p
6753 }
b1ba39e7 6754 set l "..."
b0934489 6755 if {[llength $commitinfo($p)] > 1} {
b1ba39e7
LT
6756 set l [lindex $commitinfo($p) 0]
6757 }
b8ab2e17 6758 return "$p ($l)\n"
b1ba39e7
LT
6759}
6760
106288cb
PM
6761# append some text to the ctext widget, and make any SHA1 ID
6762# that we know about be a clickable link.
f1b86294 6763proc appendwithlinks {text tags} {
d375ef9b 6764 global ctext linknum curview
106288cb
PM
6765
6766 set start [$ctext index "end - 1c"]
f1b86294 6767 $ctext insert end $text $tags
6c9e2d18 6768 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
106288cb
PM
6769 foreach l $links {
6770 set s [lindex $l 0]
6771 set e [lindex $l 1]
6772 set linkid [string range $text $s $e]
106288cb 6773 incr e
c73adce2 6774 $ctext tag delete link$linknum
106288cb 6775 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
97645683 6776 setlink $linkid link$linknum
106288cb
PM
6777 incr linknum
6778 }
97645683
PM
6779}
6780
6781proc setlink {id lk} {
d375ef9b 6782 global curview ctext pendinglinks
97645683 6783
6c9e2d18
JM
6784 if {[string range $id 0 1] eq "-g"} {
6785 set id [string range $id 2 end]
6786 }
6787
d375ef9b
PM
6788 set known 0
6789 if {[string length $id] < 40} {
6790 set matches [longid $id]
6791 if {[llength $matches] > 0} {
6792 if {[llength $matches] > 1} return
6793 set known 1
6794 set id [lindex $matches 0]
6795 }
6796 } else {
6797 set known [commitinview $id $curview]
6798 }
6799 if {$known} {
97645683 6800 $ctext tag conf $lk -foreground blue -underline 1
d375ef9b 6801 $ctext tag bind $lk <1> [list selbyid $id]
97645683
PM
6802 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6803 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6804 } else {
6805 lappend pendinglinks($id) $lk
d375ef9b 6806 interestedin $id {makelink %P}
97645683
PM
6807 }
6808}
6809
6f63fc18
PM
6810proc appendshortlink {id {pre {}} {post {}}} {
6811 global ctext linknum
6812
6813 $ctext insert end $pre
6814 $ctext tag delete link$linknum
6815 $ctext insert end [string range $id 0 7] link$linknum
6816 $ctext insert end $post
6817 setlink $id link$linknum
6818 incr linknum
6819}
6820
97645683
PM
6821proc makelink {id} {
6822 global pendinglinks
6823
6824 if {![info exists pendinglinks($id)]} return
6825 foreach lk $pendinglinks($id) {
6826 setlink $id $lk
6827 }
6828 unset pendinglinks($id)
6829}
6830
6831proc linkcursor {w inc} {
6832 global linkentercount curtextcursor
6833
6834 if {[incr linkentercount $inc] > 0} {
6835 $w configure -cursor hand2
6836 } else {
6837 $w configure -cursor $curtextcursor
6838 if {$linkentercount < 0} {
6839 set linkentercount 0
6840 }
6841 }
106288cb
PM
6842}
6843
6e5f7203
RN
6844proc viewnextline {dir} {
6845 global canv linespc
6846
6847 $canv delete hover
6848 set ymax [lindex [$canv cget -scrollregion] 3]
6849 set wnow [$canv yview]
6850 set wtop [expr {[lindex $wnow 0] * $ymax}]
6851 set newtop [expr {$wtop + $dir * $linespc}]
6852 if {$newtop < 0} {
6853 set newtop 0
6854 } elseif {$newtop > $ymax} {
6855 set newtop $ymax
6856 }
6857 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6858}
6859
ef030b85
PM
6860# add a list of tag or branch names at position pos
6861# returns the number of names inserted
e11f1233 6862proc appendrefs {pos ids var} {
7fcc92bf 6863 global ctext linknum curview $var maxrefs
b8ab2e17 6864
ef030b85
PM
6865 if {[catch {$ctext index $pos}]} {
6866 return 0
6867 }
e11f1233
PM
6868 $ctext conf -state normal
6869 $ctext delete $pos "$pos lineend"
6870 set tags {}
6871 foreach id $ids {
6872 foreach tag [set $var\($id\)] {
6873 lappend tags [list $tag $id]
6874 }
6875 }
0a4dd8b8 6876 if {[llength $tags] > $maxrefs} {
84b4b832 6877 $ctext insert $pos "[mc "many"] ([llength $tags])"
0a4dd8b8
PM
6878 } else {
6879 set tags [lsort -index 0 -decreasing $tags]
6880 set sep {}
6881 foreach ti $tags {
6882 set id [lindex $ti 1]
6883 set lk link$linknum
6884 incr linknum
6885 $ctext tag delete $lk
6886 $ctext insert $pos $sep
6887 $ctext insert $pos [lindex $ti 0] $lk
97645683 6888 setlink $id $lk
0a4dd8b8 6889 set sep ", "
b8ab2e17 6890 }
b8ab2e17 6891 }
e11f1233 6892 $ctext conf -state disabled
ef030b85 6893 return [llength $tags]
b8ab2e17
PM
6894}
6895
e11f1233
PM
6896# called when we have finished computing the nearby tags
6897proc dispneartags {delay} {
6898 global selectedline currentid showneartags tagphase
ca6d8f58 6899
94b4a69f 6900 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
6901 after cancel dispnexttag
6902 if {$delay} {
6903 after 200 dispnexttag
6904 set tagphase -1
6905 } else {
6906 after idle dispnexttag
6907 set tagphase 0
ca6d8f58 6908 }
ca6d8f58
PM
6909}
6910
e11f1233
PM
6911proc dispnexttag {} {
6912 global selectedline currentid showneartags tagphase ctext
b8ab2e17 6913
94b4a69f 6914 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
6915 switch -- $tagphase {
6916 0 {
6917 set dtags [desctags $currentid]
6918 if {$dtags ne {}} {
6919 appendrefs precedes $dtags idtags
6920 }
6921 }
6922 1 {
6923 set atags [anctags $currentid]
6924 if {$atags ne {}} {
6925 appendrefs follows $atags idtags
6926 }
6927 }
6928 2 {
6929 set dheads [descheads $currentid]
6930 if {$dheads ne {}} {
6931 if {[appendrefs branch $dheads idheads] > 1
6932 && [$ctext get "branch -3c"] eq "h"} {
6933 # turn "Branch" into "Branches"
6934 $ctext conf -state normal
6935 $ctext insert "branch -2c" "es"
6936 $ctext conf -state disabled
6937 }
6938 }
ef030b85
PM
6939 }
6940 }
e11f1233
PM
6941 if {[incr tagphase] <= 2} {
6942 after idle dispnexttag
b8ab2e17 6943 }
b8ab2e17
PM
6944}
6945
28593d3f 6946proc make_secsel {id} {
0380081c
PM
6947 global linehtag linentag linedtag canv canv2 canv3
6948
28593d3f 6949 if {![info exists linehtag($id)]} return
0380081c 6950 $canv delete secsel
28593d3f 6951 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
0380081c
PM
6952 -tags secsel -fill [$canv cget -selectbackground]]
6953 $canv lower $t
6954 $canv2 delete secsel
28593d3f 6955 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
0380081c
PM
6956 -tags secsel -fill [$canv2 cget -selectbackground]]
6957 $canv2 lower $t
6958 $canv3 delete secsel
28593d3f 6959 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
0380081c
PM
6960 -tags secsel -fill [$canv3 cget -selectbackground]]
6961 $canv3 lower $t
6962}
6963
b9fdba7f
PM
6964proc make_idmark {id} {
6965 global linehtag canv fgcolor
6966
6967 if {![info exists linehtag($id)]} return
6968 $canv delete markid
6969 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6970 -tags markid -outline $fgcolor]
6971 $canv raise $t
6972}
6973
8a897742 6974proc selectline {l isnew {desired_loc {}}} {
0380081c 6975 global canv ctext commitinfo selectedline
7fcc92bf 6976 global canvy0 linespc parents children curview
7fcceed7 6977 global currentid sha1entry
9f1afe05 6978 global commentend idtags linknum
d94f8cd6 6979 global mergemax numcommits pending_select
e11f1233 6980 global cmitmode showneartags allcommits
c30acc77 6981 global targetrow targetid lastscrollrows
21ac8a8d 6982 global autoselect autosellen jump_to_here
d698206c 6983
d94f8cd6 6984 catch {unset pending_select}
84ba7345 6985 $canv delete hover
9843c307 6986 normalline
887c996e 6987 unsel_reflist
bb3edc8b 6988 stopfinding
8f7d0cec 6989 if {$l < 0 || $l >= $numcommits} return
ac1276ab
PM
6990 set id [commitonrow $l]
6991 set targetid $id
6992 set targetrow $l
c30acc77
PM
6993 set selectedline $l
6994 set currentid $id
6995 if {$lastscrollrows < $numcommits} {
6996 setcanvscroll
6997 }
ac1276ab 6998
5ad588de 6999 set y [expr {$canvy0 + $l * $linespc}]
17386066 7000 set ymax [lindex [$canv cget -scrollregion] 3]
5842215e
PM
7001 set ytop [expr {$y - $linespc - 1}]
7002 set ybot [expr {$y + $linespc + 1}]
5ad588de 7003 set wnow [$canv yview]
2ed49d54
JH
7004 set wtop [expr {[lindex $wnow 0] * $ymax}]
7005 set wbot [expr {[lindex $wnow 1] * $ymax}]
5842215e
PM
7006 set wh [expr {$wbot - $wtop}]
7007 set newtop $wtop
17386066 7008 if {$ytop < $wtop} {
5842215e
PM
7009 if {$ybot < $wtop} {
7010 set newtop [expr {$y - $wh / 2.0}]
7011 } else {
7012 set newtop $ytop
7013 if {$newtop > $wtop - $linespc} {
7014 set newtop [expr {$wtop - $linespc}]
7015 }
17386066 7016 }
5842215e
PM
7017 } elseif {$ybot > $wbot} {
7018 if {$ytop > $wbot} {
7019 set newtop [expr {$y - $wh / 2.0}]
7020 } else {
7021 set newtop [expr {$ybot - $wh}]
7022 if {$newtop < $wtop + $linespc} {
7023 set newtop [expr {$wtop + $linespc}]
7024 }
17386066 7025 }
5842215e
PM
7026 }
7027 if {$newtop != $wtop} {
7028 if {$newtop < 0} {
7029 set newtop 0
7030 }
2ed49d54 7031 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
9f1afe05 7032 drawvisible
5ad588de 7033 }
d698206c 7034
28593d3f 7035 make_secsel $id
9f1afe05 7036
fa4da7b3 7037 if {$isnew} {
354af6bd 7038 addtohistory [list selbyid $id 0] savecmitpos
d698206c
PM
7039 }
7040
98f350e5
PM
7041 $sha1entry delete 0 end
7042 $sha1entry insert 0 $id
95293b58 7043 if {$autoselect} {
21ac8a8d 7044 $sha1entry selection range 0 $autosellen
95293b58 7045 }
164ff275 7046 rhighlight_sel $id
98f350e5 7047
5ad588de 7048 $ctext conf -state normal
3ea06f9f 7049 clear_ctext
106288cb 7050 set linknum 0
d76afb15
PM
7051 if {![info exists commitinfo($id)]} {
7052 getcommit $id
7053 }
1db95b00 7054 set info $commitinfo($id)
232475d3 7055 set date [formatdate [lindex $info 2]]
d990cedf 7056 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
232475d3 7057 set date [formatdate [lindex $info 4]]
d990cedf 7058 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
887fe3c4 7059 if {[info exists idtags($id)]} {
d990cedf 7060 $ctext insert end [mc "Tags:"]
887fe3c4
PM
7061 foreach tag $idtags($id) {
7062 $ctext insert end " $tag"
7063 }
7064 $ctext insert end "\n"
7065 }
40b87ff8 7066
f1b86294 7067 set headers {}
7fcc92bf 7068 set olds $parents($curview,$id)
79b2c75e 7069 if {[llength $olds] > 1} {
b77b0278 7070 set np 0
79b2c75e 7071 foreach p $olds {
b77b0278
PM
7072 if {$np >= $mergemax} {
7073 set tag mmax
7074 } else {
7075 set tag m$np
7076 }
d990cedf 7077 $ctext insert end "[mc "Parent"]: " $tag
f1b86294 7078 appendwithlinks [commit_descriptor $p] {}
b77b0278
PM
7079 incr np
7080 }
7081 } else {
79b2c75e 7082 foreach p $olds {
d990cedf 7083 append headers "[mc "Parent"]: [commit_descriptor $p]"
b1ba39e7
LT
7084 }
7085 }
b77b0278 7086
6a90bff1 7087 foreach c $children($curview,$id) {
d990cedf 7088 append headers "[mc "Child"]: [commit_descriptor $c]"
8b192809 7089 }
d698206c
PM
7090
7091 # make anything that looks like a SHA1 ID be a clickable link
f1b86294 7092 appendwithlinks $headers {}
b8ab2e17
PM
7093 if {$showneartags} {
7094 if {![info exists allcommits]} {
7095 getallcommits
7096 }
d990cedf 7097 $ctext insert end "[mc "Branch"]: "
ef030b85
PM
7098 $ctext mark set branch "end -1c"
7099 $ctext mark gravity branch left
d990cedf 7100 $ctext insert end "\n[mc "Follows"]: "
b8ab2e17
PM
7101 $ctext mark set follows "end -1c"
7102 $ctext mark gravity follows left
d990cedf 7103 $ctext insert end "\n[mc "Precedes"]: "
b8ab2e17
PM
7104 $ctext mark set precedes "end -1c"
7105 $ctext mark gravity precedes left
b8ab2e17 7106 $ctext insert end "\n"
e11f1233 7107 dispneartags 1
b8ab2e17
PM
7108 }
7109 $ctext insert end "\n"
43c25074
PM
7110 set comment [lindex $info 5]
7111 if {[string first "\r" $comment] >= 0} {
7112 set comment [string map {"\r" "\n "} $comment]
7113 }
7114 appendwithlinks $comment {comment}
d698206c 7115
df3d83b1 7116 $ctext tag remove found 1.0 end
5ad588de 7117 $ctext conf -state disabled
df3d83b1 7118 set commentend [$ctext index "end - 1c"]
5ad588de 7119
8a897742 7120 set jump_to_here $desired_loc
b007ee20 7121 init_flist [mc "Comments"]
f8b28a40
PM
7122 if {$cmitmode eq "tree"} {
7123 gettree $id
7124 } elseif {[llength $olds] <= 1} {
d327244a 7125 startdiff $id
7b5ff7e7 7126 } else {
7fcc92bf 7127 mergediff $id
3c461ffe
PM
7128 }
7129}
7130
6e5f7203
RN
7131proc selfirstline {} {
7132 unmarkmatches
7133 selectline 0 1
7134}
7135
7136proc sellastline {} {
7137 global numcommits
7138 unmarkmatches
7139 set l [expr {$numcommits - 1}]
7140 selectline $l 1
7141}
7142
3c461ffe
PM
7143proc selnextline {dir} {
7144 global selectedline
bd441de4 7145 focus .
94b4a69f 7146 if {$selectedline eq {}} return
2ed49d54 7147 set l [expr {$selectedline + $dir}]
3c461ffe 7148 unmarkmatches
d698206c
PM
7149 selectline $l 1
7150}
7151
6e5f7203
RN
7152proc selnextpage {dir} {
7153 global canv linespc selectedline numcommits
7154
7155 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7156 if {$lpp < 1} {
7157 set lpp 1
7158 }
7159 allcanvs yview scroll [expr {$dir * $lpp}] units
e72ee5eb 7160 drawvisible
94b4a69f 7161 if {$selectedline eq {}} return
6e5f7203
RN
7162 set l [expr {$selectedline + $dir * $lpp}]
7163 if {$l < 0} {
7164 set l 0
7165 } elseif {$l >= $numcommits} {
7166 set l [expr $numcommits - 1]
7167 }
7168 unmarkmatches
40b87ff8 7169 selectline $l 1
6e5f7203
RN
7170}
7171
fa4da7b3 7172proc unselectline {} {
50b44ece 7173 global selectedline currentid
fa4da7b3 7174
94b4a69f 7175 set selectedline {}
50b44ece 7176 catch {unset currentid}
fa4da7b3 7177 allcanvs delete secsel
164ff275 7178 rhighlight_none
fa4da7b3
PM
7179}
7180
f8b28a40
PM
7181proc reselectline {} {
7182 global selectedline
7183
94b4a69f 7184 if {$selectedline ne {}} {
f8b28a40
PM
7185 selectline $selectedline 0
7186 }
7187}
7188
354af6bd 7189proc addtohistory {cmd {saveproc {}}} {
2516dae2 7190 global history historyindex curview
fa4da7b3 7191
354af6bd
PM
7192 unset_posvars
7193 save_position
7194 set elt [list $curview $cmd $saveproc {}]
fa4da7b3 7195 if {$historyindex > 0
2516dae2 7196 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
fa4da7b3
PM
7197 return
7198 }
7199
7200 if {$historyindex < [llength $history]} {
2516dae2 7201 set history [lreplace $history $historyindex end $elt]
fa4da7b3 7202 } else {
2516dae2 7203 lappend history $elt
fa4da7b3
PM
7204 }
7205 incr historyindex
7206 if {$historyindex > 1} {
e9937d2a 7207 .tf.bar.leftbut conf -state normal
fa4da7b3 7208 } else {
e9937d2a 7209 .tf.bar.leftbut conf -state disabled
fa4da7b3 7210 }
e9937d2a 7211 .tf.bar.rightbut conf -state disabled
fa4da7b3
PM
7212}
7213
354af6bd
PM
7214# save the scrolling position of the diff display pane
7215proc save_position {} {
7216 global historyindex history
7217
7218 if {$historyindex < 1} return
7219 set hi [expr {$historyindex - 1}]
7220 set fn [lindex $history $hi 2]
7221 if {$fn ne {}} {
7222 lset history $hi 3 [eval $fn]
7223 }
7224}
7225
7226proc unset_posvars {} {
7227 global last_posvars
7228
7229 if {[info exists last_posvars]} {
7230 foreach {var val} $last_posvars {
7231 global $var
7232 catch {unset $var}
7233 }
7234 unset last_posvars
7235 }
7236}
7237
2516dae2 7238proc godo {elt} {
354af6bd 7239 global curview last_posvars
2516dae2
PM
7240
7241 set view [lindex $elt 0]
7242 set cmd [lindex $elt 1]
354af6bd 7243 set pv [lindex $elt 3]
2516dae2
PM
7244 if {$curview != $view} {
7245 showview $view
7246 }
354af6bd
PM
7247 unset_posvars
7248 foreach {var val} $pv {
7249 global $var
7250 set $var $val
7251 }
7252 set last_posvars $pv
2516dae2
PM
7253 eval $cmd
7254}
7255
d698206c
PM
7256proc goback {} {
7257 global history historyindex
bd441de4 7258 focus .
d698206c
PM
7259
7260 if {$historyindex > 1} {
354af6bd 7261 save_position
d698206c 7262 incr historyindex -1
2516dae2 7263 godo [lindex $history [expr {$historyindex - 1}]]
e9937d2a 7264 .tf.bar.rightbut conf -state normal
d698206c
PM
7265 }
7266 if {$historyindex <= 1} {
e9937d2a 7267 .tf.bar.leftbut conf -state disabled
d698206c
PM
7268 }
7269}
7270
7271proc goforw {} {
7272 global history historyindex
bd441de4 7273 focus .
d698206c
PM
7274
7275 if {$historyindex < [llength $history]} {
354af6bd 7276 save_position
fa4da7b3 7277 set cmd [lindex $history $historyindex]
d698206c 7278 incr historyindex
2516dae2 7279 godo $cmd
e9937d2a 7280 .tf.bar.leftbut conf -state normal
d698206c
PM
7281 }
7282 if {$historyindex >= [llength $history]} {
e9937d2a 7283 .tf.bar.rightbut conf -state disabled
d698206c 7284 }
e2ed4324
PM
7285}
7286
f8b28a40 7287proc gettree {id} {
8f489363
PM
7288 global treefilelist treeidlist diffids diffmergeid treepending
7289 global nullid nullid2
f8b28a40
PM
7290
7291 set diffids $id
7292 catch {unset diffmergeid}
7293 if {![info exists treefilelist($id)]} {
7294 if {![info exists treepending]} {
8f489363
PM
7295 if {$id eq $nullid} {
7296 set cmd [list | git ls-files]
7297 } elseif {$id eq $nullid2} {
7298 set cmd [list | git ls-files --stage -t]
219ea3a9 7299 } else {
8f489363 7300 set cmd [list | git ls-tree -r $id]
219ea3a9
PM
7301 }
7302 if {[catch {set gtf [open $cmd r]}]} {
f8b28a40
PM
7303 return
7304 }
7305 set treepending $id
7306 set treefilelist($id) {}
7307 set treeidlist($id) {}
09c7029d 7308 fconfigure $gtf -blocking 0 -encoding binary
7eb3cb9c 7309 filerun $gtf [list gettreeline $gtf $id]
f8b28a40
PM
7310 }
7311 } else {
7312 setfilelist $id
7313 }
7314}
7315
7316proc gettreeline {gtf id} {
8f489363 7317 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
f8b28a40 7318
7eb3cb9c
PM
7319 set nl 0
7320 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
8f489363
PM
7321 if {$diffids eq $nullid} {
7322 set fname $line
7323 } else {
9396cd38
PM
7324 set i [string first "\t" $line]
7325 if {$i < 0} continue
9396cd38 7326 set fname [string range $line [expr {$i+1}] end]
f31fa2c0
PM
7327 set line [string range $line 0 [expr {$i-1}]]
7328 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7329 set sha1 [lindex $line 2]
219ea3a9 7330 lappend treeidlist($id) $sha1
219ea3a9 7331 }
09c7029d
AG
7332 if {[string index $fname 0] eq "\""} {
7333 set fname [lindex $fname 0]
7334 }
7335 set fname [encoding convertfrom $fname]
7eb3cb9c
PM
7336 lappend treefilelist($id) $fname
7337 }
7338 if {![eof $gtf]} {
7339 return [expr {$nl >= 1000? 2: 1}]
f8b28a40 7340 }
f8b28a40
PM
7341 close $gtf
7342 unset treepending
7343 if {$cmitmode ne "tree"} {
7344 if {![info exists diffmergeid]} {
7345 gettreediffs $diffids
7346 }
7347 } elseif {$id ne $diffids} {
7348 gettree $diffids
7349 } else {
7350 setfilelist $id
7351 }
7eb3cb9c 7352 return 0
f8b28a40
PM
7353}
7354
7355proc showfile {f} {
8f489363 7356 global treefilelist treeidlist diffids nullid nullid2
7cdc3556 7357 global ctext_file_names ctext_file_lines
f8b28a40
PM
7358 global ctext commentend
7359
7360 set i [lsearch -exact $treefilelist($diffids) $f]
7361 if {$i < 0} {
7362 puts "oops, $f not in list for id $diffids"
7363 return
7364 }
8f489363
PM
7365 if {$diffids eq $nullid} {
7366 if {[catch {set bf [open $f r]} err]} {
7367 puts "oops, can't read $f: $err"
219ea3a9
PM
7368 return
7369 }
7370 } else {
8f489363
PM
7371 set blob [lindex $treeidlist($diffids) $i]
7372 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7373 puts "oops, error reading blob $blob: $err"
219ea3a9
PM
7374 return
7375 }
f8b28a40 7376 }
09c7029d 7377 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7eb3cb9c 7378 filerun $bf [list getblobline $bf $diffids]
f8b28a40 7379 $ctext config -state normal
3ea06f9f 7380 clear_ctext $commentend
7cdc3556
AG
7381 lappend ctext_file_names $f
7382 lappend ctext_file_lines [lindex [split $commentend "."] 0]
f8b28a40
PM
7383 $ctext insert end "\n"
7384 $ctext insert end "$f\n" filesep
7385 $ctext config -state disabled
7386 $ctext yview $commentend
32f1b3e4 7387 settabs 0
f8b28a40
PM
7388}
7389
7390proc getblobline {bf id} {
7391 global diffids cmitmode ctext
7392
7393 if {$id ne $diffids || $cmitmode ne "tree"} {
7394 catch {close $bf}
7eb3cb9c 7395 return 0
f8b28a40
PM
7396 }
7397 $ctext config -state normal
7eb3cb9c
PM
7398 set nl 0
7399 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
f8b28a40
PM
7400 $ctext insert end "$line\n"
7401 }
7402 if {[eof $bf]} {
8a897742
PM
7403 global jump_to_here ctext_file_names commentend
7404
f8b28a40
PM
7405 # delete last newline
7406 $ctext delete "end - 2c" "end - 1c"
7407 close $bf
8a897742
PM
7408 if {$jump_to_here ne {} &&
7409 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7410 set lnum [expr {[lindex $jump_to_here 1] +
7411 [lindex [split $commentend .] 0]}]
7412 mark_ctext_line $lnum
7413 }
120ea892 7414 $ctext config -state disabled
7eb3cb9c 7415 return 0
f8b28a40
PM
7416 }
7417 $ctext config -state disabled
7eb3cb9c 7418 return [expr {$nl >= 1000? 2: 1}]
f8b28a40
PM
7419}
7420
8a897742 7421proc mark_ctext_line {lnum} {
e3e901be 7422 global ctext markbgcolor
8a897742
PM
7423
7424 $ctext tag delete omark
7425 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
e3e901be 7426 $ctext tag conf omark -background $markbgcolor
8a897742
PM
7427 $ctext see $lnum.0
7428}
7429
7fcc92bf 7430proc mergediff {id} {
8b07dca1 7431 global diffmergeid
2df6442f 7432 global diffids treediffs
8b07dca1 7433 global parents curview
e2ed4324 7434
3c461ffe 7435 set diffmergeid $id
7a1d9d14 7436 set diffids $id
2df6442f 7437 set treediffs($id) {}
7fcc92bf 7438 set np [llength $parents($curview,$id)]
32f1b3e4 7439 settabs $np
8b07dca1 7440 getblobdiffs $id
c8a4acbf
PM
7441}
7442
3c461ffe 7443proc startdiff {ids} {
8f489363 7444 global treediffs diffids treepending diffmergeid nullid nullid2
c8dfbcf9 7445
32f1b3e4 7446 settabs 1
4f2c2642 7447 set diffids $ids
3c461ffe 7448 catch {unset diffmergeid}
8f489363
PM
7449 if {![info exists treediffs($ids)] ||
7450 [lsearch -exact $ids $nullid] >= 0 ||
7451 [lsearch -exact $ids $nullid2] >= 0} {
c8dfbcf9 7452 if {![info exists treepending]} {
14c9dbd6 7453 gettreediffs $ids
c8dfbcf9
PM
7454 }
7455 } else {
14c9dbd6 7456 addtocflist $ids
c8dfbcf9
PM
7457 }
7458}
7459
65bb0bda
PT
7460# If the filename (name) is under any of the passed filter paths
7461# then return true to include the file in the listing.
7a39a17a 7462proc path_filter {filter name} {
65bb0bda 7463 set worktree [gitworktree]
7a39a17a 7464 foreach p $filter {
65bb0bda
PT
7465 set fq_p [file normalize $p]
7466 set fq_n [file normalize [file join $worktree $name]]
7467 if {[string match [file normalize $fq_p]* $fq_n]} {
7468 return 1
7a39a17a
PM
7469 }
7470 }
7471 return 0
7472}
7473
c8dfbcf9 7474proc addtocflist {ids} {
74a40c71 7475 global treediffs
7a39a17a 7476
74a40c71 7477 add_flist $treediffs($ids)
c8dfbcf9 7478 getblobdiffs $ids
d2610d11
PM
7479}
7480
219ea3a9 7481proc diffcmd {ids flags} {
b2b76d10 7482 global log_showroot nullid nullid2
219ea3a9
PM
7483
7484 set i [lsearch -exact $ids $nullid]
8f489363 7485 set j [lsearch -exact $ids $nullid2]
219ea3a9 7486 if {$i >= 0} {
8f489363
PM
7487 if {[llength $ids] > 1 && $j < 0} {
7488 # comparing working directory with some specific revision
7489 set cmd [concat | git diff-index $flags]
7490 if {$i == 0} {
7491 lappend cmd -R [lindex $ids 1]
7492 } else {
7493 lappend cmd [lindex $ids 0]
7494 }
7495 } else {
7496 # comparing working directory with index
7497 set cmd [concat | git diff-files $flags]
7498 if {$j == 1} {
7499 lappend cmd -R
7500 }
7501 }
7502 } elseif {$j >= 0} {
7503 set cmd [concat | git diff-index --cached $flags]
219ea3a9 7504 if {[llength $ids] > 1} {
8f489363 7505 # comparing index with specific revision
90a77925 7506 if {$j == 0} {
219ea3a9
PM
7507 lappend cmd -R [lindex $ids 1]
7508 } else {
7509 lappend cmd [lindex $ids 0]
7510 }
7511 } else {
8f489363 7512 # comparing index with HEAD
219ea3a9
PM
7513 lappend cmd HEAD
7514 }
7515 } else {
b2b76d10
MK
7516 if {$log_showroot} {
7517 lappend flags --root
7518 }
8f489363 7519 set cmd [concat | git diff-tree -r $flags $ids]
219ea3a9
PM
7520 }
7521 return $cmd
7522}
7523
c8dfbcf9 7524proc gettreediffs {ids} {
79b2c75e 7525 global treediff treepending
219ea3a9 7526
7272131b
AG
7527 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7528
c8dfbcf9 7529 set treepending $ids
3c461ffe 7530 set treediff {}
09c7029d 7531 fconfigure $gdtf -blocking 0 -encoding binary
7eb3cb9c 7532 filerun $gdtf [list gettreediffline $gdtf $ids]
d2610d11
PM
7533}
7534
c8dfbcf9 7535proc gettreediffline {gdtf ids} {
3c461ffe 7536 global treediff treediffs treepending diffids diffmergeid
39ee47ef 7537 global cmitmode vfilelimit curview limitdiffs perfile_attrs
3c461ffe 7538
7eb3cb9c 7539 set nr 0
4db09304 7540 set sublist {}
39ee47ef
PM
7541 set max 1000
7542 if {$perfile_attrs} {
7543 # cache_gitattr is slow, and even slower on win32 where we
7544 # have to invoke it for only about 30 paths at a time
7545 set max 500
7546 if {[tk windowingsystem] == "win32"} {
7547 set max 120
7548 }
7549 }
7550 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
9396cd38
PM
7551 set i [string first "\t" $line]
7552 if {$i >= 0} {
7553 set file [string range $line [expr {$i+1}] end]
7554 if {[string index $file 0] eq "\""} {
7555 set file [lindex $file 0]
7556 }
09c7029d 7557 set file [encoding convertfrom $file]
48a81b7c
PM
7558 if {$file ne [lindex $treediff end]} {
7559 lappend treediff $file
7560 lappend sublist $file
7561 }
9396cd38 7562 }
7eb3cb9c 7563 }
39ee47ef
PM
7564 if {$perfile_attrs} {
7565 cache_gitattr encoding $sublist
7566 }
7eb3cb9c 7567 if {![eof $gdtf]} {
39ee47ef 7568 return [expr {$nr >= $max? 2: 1}]
7eb3cb9c
PM
7569 }
7570 close $gdtf
3ed31a81 7571 if {$limitdiffs && $vfilelimit($curview) ne {}} {
74a40c71
PM
7572 set flist {}
7573 foreach f $treediff {
3ed31a81 7574 if {[path_filter $vfilelimit($curview) $f]} {
74a40c71
PM
7575 lappend flist $f
7576 }
7577 }
7578 set treediffs($ids) $flist
7579 } else {
7580 set treediffs($ids) $treediff
7581 }
7eb3cb9c 7582 unset treepending
e1160138 7583 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7eb3cb9c
PM
7584 gettree $diffids
7585 } elseif {$ids != $diffids} {
7586 if {![info exists diffmergeid]} {
7587 gettreediffs $diffids
b74fd579 7588 }
7eb3cb9c
PM
7589 } else {
7590 addtocflist $ids
d2610d11 7591 }
7eb3cb9c 7592 return 0
d2610d11
PM
7593}
7594
890fae70
SP
7595# empty string or positive integer
7596proc diffcontextvalidate {v} {
7597 return [regexp {^(|[1-9][0-9]*)$} $v]
7598}
7599
7600proc diffcontextchange {n1 n2 op} {
7601 global diffcontextstring diffcontext
7602
7603 if {[string is integer -strict $diffcontextstring]} {
a41ddbb6 7604 if {$diffcontextstring >= 0} {
890fae70
SP
7605 set diffcontext $diffcontextstring
7606 reselectline
7607 }
7608 }
7609}
7610
b9b86007
SP
7611proc changeignorespace {} {
7612 reselectline
7613}
7614
ae4e3ff9
TR
7615proc changeworddiff {name ix op} {
7616 reselectline
7617}
7618
c8dfbcf9 7619proc getblobdiffs {ids} {
8d73b242 7620 global blobdifffd diffids env
7eb3cb9c 7621 global diffinhdr treediffs
890fae70 7622 global diffcontext
b9b86007 7623 global ignorespace
ae4e3ff9 7624 global worddiff
3ed31a81 7625 global limitdiffs vfilelimit curview
8b07dca1 7626 global diffencoding targetline diffnparents
a1d383c5 7627 global git_version currdiffsubmod
c8dfbcf9 7628
a8138733
PM
7629 set textconv {}
7630 if {[package vcompare $git_version "1.6.1"] >= 0} {
7631 set textconv "--textconv"
7632 }
5c838d23
JL
7633 set submodule {}
7634 if {[package vcompare $git_version "1.6.6"] >= 0} {
7635 set submodule "--submodule"
7636 }
7637 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
b9b86007
SP
7638 if {$ignorespace} {
7639 append cmd " -w"
7640 }
ae4e3ff9
TR
7641 if {$worddiff ne [mc "Line diff"]} {
7642 append cmd " --word-diff=porcelain"
7643 }
3ed31a81
PM
7644 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7645 set cmd [concat $cmd -- $vfilelimit($curview)]
7a39a17a
PM
7646 }
7647 if {[catch {set bdf [open $cmd r]} err]} {
8b07dca1 7648 error_popup [mc "Error getting diffs: %s" $err]
e5c2d856
PM
7649 return
7650 }
8a897742 7651 set targetline {}
8b07dca1 7652 set diffnparents 0
4f2c2642 7653 set diffinhdr 0
09c7029d 7654 set diffencoding [get_path_encoding {}]
681c3290 7655 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
c8dfbcf9 7656 set blobdifffd($ids) $bdf
a1d383c5 7657 set currdiffsubmod ""
7eb3cb9c 7658 filerun $bdf [list getblobdiffline $bdf $diffids]
e5c2d856
PM
7659}
7660
354af6bd
PM
7661proc savecmitpos {} {
7662 global ctext cmitmode
7663
7664 if {$cmitmode eq "tree"} {
7665 return {}
7666 }
7667 return [list target_scrollpos [$ctext index @0,0]]
7668}
7669
7670proc savectextpos {} {
7671 global ctext
7672
7673 return [list target_scrollpos [$ctext index @0,0]]
7674}
7675
7676proc maybe_scroll_ctext {ateof} {
7677 global ctext target_scrollpos
7678
7679 if {![info exists target_scrollpos]} return
7680 if {!$ateof} {
7681 set nlines [expr {[winfo height $ctext]
7682 / [font metrics textfont -linespace]}]
7683 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7684 }
7685 $ctext yview $target_scrollpos
7686 unset target_scrollpos
7687}
7688
89b11d3b
PM
7689proc setinlist {var i val} {
7690 global $var
7691
7692 while {[llength [set $var]] < $i} {
7693 lappend $var {}
7694 }
7695 if {[llength [set $var]] == $i} {
7696 lappend $var $val
7697 } else {
7698 lset $var $i $val
7699 }
7700}
7701
9396cd38 7702proc makediffhdr {fname ids} {
8b07dca1 7703 global ctext curdiffstart treediffs diffencoding
8a897742 7704 global ctext_file_names jump_to_here targetline diffline
9396cd38 7705
8b07dca1
PM
7706 set fname [encoding convertfrom $fname]
7707 set diffencoding [get_path_encoding $fname]
9396cd38
PM
7708 set i [lsearch -exact $treediffs($ids) $fname]
7709 if {$i >= 0} {
7710 setinlist difffilestart $i $curdiffstart
7711 }
48a81b7c 7712 lset ctext_file_names end $fname
9396cd38
PM
7713 set l [expr {(78 - [string length $fname]) / 2}]
7714 set pad [string range "----------------------------------------" 1 $l]
7715 $ctext insert $curdiffstart "$pad $fname $pad" filesep
8a897742
PM
7716 set targetline {}
7717 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7718 set targetline [lindex $jump_to_here 1]
7719 }
7720 set diffline 0
9396cd38
PM
7721}
7722
c8dfbcf9 7723proc getblobdiffline {bdf ids} {
9396cd38 7724 global diffids blobdifffd ctext curdiffstart
7eab2933 7725 global diffnexthead diffnextnote difffilestart
7cdc3556 7726 global ctext_file_names ctext_file_lines
8b07dca1 7727 global diffinhdr treediffs mergemax diffnparents
a1d383c5 7728 global diffencoding jump_to_here targetline diffline currdiffsubmod
ae4e3ff9 7729 global worddiff
c8dfbcf9 7730
7eb3cb9c 7731 set nr 0
e5c2d856 7732 $ctext conf -state normal
7eb3cb9c
PM
7733 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7734 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
c21398be 7735 catch {close $bdf}
7eb3cb9c 7736 return 0
89b11d3b 7737 }
8b07dca1
PM
7738 if {![string compare -length 5 "diff " $line]} {
7739 if {![regexp {^diff (--cc|--git) } $line m type]} {
7740 set line [encoding convertfrom $line]
7741 $ctext insert end "$line\n" hunksep
7742 continue
7743 }
7eb3cb9c 7744 # start of a new file
8b07dca1 7745 set diffinhdr 1
7eb3cb9c 7746 $ctext insert end "\n"
9396cd38 7747 set curdiffstart [$ctext index "end - 1c"]
7cdc3556
AG
7748 lappend ctext_file_names ""
7749 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
9396cd38 7750 $ctext insert end "\n" filesep
8b07dca1
PM
7751
7752 if {$type eq "--cc"} {
7753 # start of a new file in a merge diff
7754 set fname [string range $line 10 end]
7755 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7756 lappend treediffs($ids) $fname
7757 add_flist [list $fname]
7758 }
7759
9396cd38 7760 } else {
8b07dca1
PM
7761 set line [string range $line 11 end]
7762 # If the name hasn't changed the length will be odd,
7763 # the middle char will be a space, and the two bits either
7764 # side will be a/name and b/name, or "a/name" and "b/name".
7765 # If the name has changed we'll get "rename from" and
7766 # "rename to" or "copy from" and "copy to" lines following
7767 # this, and we'll use them to get the filenames.
7768 # This complexity is necessary because spaces in the
7769 # filename(s) don't get escaped.
7770 set l [string length $line]
7771 set i [expr {$l / 2}]
7772 if {!(($l & 1) && [string index $line $i] eq " " &&
7773 [string range $line 2 [expr {$i - 1}]] eq \
7774 [string range $line [expr {$i + 3}] end])} {
7775 continue
7776 }
7777 # unescape if quoted and chop off the a/ from the front
7778 if {[string index $line 0] eq "\""} {
7779 set fname [string range [lindex $line 0] 2 end]
7780 } else {
7781 set fname [string range $line 2 [expr {$i - 1}]]
7782 }
7eb3cb9c 7783 }
9396cd38
PM
7784 makediffhdr $fname $ids
7785
48a81b7c
PM
7786 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7787 set fname [encoding convertfrom [string range $line 16 end]]
7788 $ctext insert end "\n"
7789 set curdiffstart [$ctext index "end - 1c"]
7790 lappend ctext_file_names $fname
7791 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7792 $ctext insert end "$line\n" filesep
7793 set i [lsearch -exact $treediffs($ids) $fname]
7794 if {$i >= 0} {
7795 setinlist difffilestart $i $curdiffstart
7796 }
7797
8b07dca1
PM
7798 } elseif {![string compare -length 2 "@@" $line]} {
7799 regexp {^@@+} $line ats
09c7029d 7800 set line [encoding convertfrom $diffencoding $line]
7eb3cb9c 7801 $ctext insert end "$line\n" hunksep
8b07dca1
PM
7802 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7803 set diffline $nl
7804 }
7805 set diffnparents [expr {[string length $ats] - 1}]
7eb3cb9c 7806 set diffinhdr 0
9396cd38 7807
5c838d23
JL
7808 } elseif {![string compare -length 10 "Submodule " $line]} {
7809 # start of a new submodule
a1d383c5
JL
7810 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7811 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7812 } else {
7813 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7814 }
7815 if {$currdiffsubmod != $fname} {
5c838d23
JL
7816 $ctext insert end "\n"; # Add newline after commit message
7817 }
7818 set curdiffstart [$ctext index "end - 1c"]
7819 lappend ctext_file_names ""
a1d383c5
JL
7820 if {$currdiffsubmod != $fname} {
7821 lappend ctext_file_lines $fname
7822 makediffhdr $fname $ids
7823 set currdiffsubmod $fname
7824 $ctext insert end "\n$line\n" filesep
7825 } else {
7826 $ctext insert end "$line\n" filesep
7827 }
5c838d23 7828 } elseif {![string compare -length 3 " >" $line]} {
a1d383c5 7829 set $currdiffsubmod ""
1f2cecfd 7830 set line [encoding convertfrom $diffencoding $line]
5c838d23
JL
7831 $ctext insert end "$line\n" dresult
7832 } elseif {![string compare -length 3 " <" $line]} {
a1d383c5 7833 set $currdiffsubmod ""
1f2cecfd 7834 set line [encoding convertfrom $diffencoding $line]
5c838d23 7835 $ctext insert end "$line\n" d0
9396cd38 7836 } elseif {$diffinhdr} {
5e85ec4c 7837 if {![string compare -length 12 "rename from " $line]} {
d1cb298b 7838 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
9396cd38
PM
7839 if {[string index $fname 0] eq "\""} {
7840 set fname [lindex $fname 0]
7841 }
09c7029d 7842 set fname [encoding convertfrom $fname]
9396cd38
PM
7843 set i [lsearch -exact $treediffs($ids) $fname]
7844 if {$i >= 0} {
7845 setinlist difffilestart $i $curdiffstart
7846 }
d1cb298b
JS
7847 } elseif {![string compare -length 10 $line "rename to "] ||
7848 ![string compare -length 8 $line "copy to "]} {
7849 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
9396cd38
PM
7850 if {[string index $fname 0] eq "\""} {
7851 set fname [lindex $fname 0]
7852 }
7853 makediffhdr $fname $ids
7854 } elseif {[string compare -length 3 $line "---"] == 0} {
7855 # do nothing
7856 continue
7857 } elseif {[string compare -length 3 $line "+++"] == 0} {
7858 set diffinhdr 0
7859 continue
7860 }
7861 $ctext insert end "$line\n" filesep
7862
e5c2d856 7863 } else {
681c3290
PT
7864 set line [string map {\x1A ^Z} \
7865 [encoding convertfrom $diffencoding $line]]
8b07dca1
PM
7866 # parse the prefix - one ' ', '-' or '+' for each parent
7867 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7868 set tag [expr {$diffnparents > 1? "m": "d"}]
ae4e3ff9
TR
7869 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7870 set words_pre_markup ""
7871 set words_post_markup ""
8b07dca1
PM
7872 if {[string trim $prefix " -+"] eq {}} {
7873 # prefix only has " ", "-" and "+" in it: normal diff line
7874 set num [string first "-" $prefix]
ae4e3ff9
TR
7875 if {$dowords} {
7876 set line [string range $line 1 end]
7877 }
8b07dca1
PM
7878 if {$num >= 0} {
7879 # removed line, first parent with line is $num
7880 if {$num >= $mergemax} {
7881 set num "max"
7882 }
ae4e3ff9
TR
7883 if {$dowords && $worddiff eq [mc "Markup words"]} {
7884 $ctext insert end "\[-$line-\]" $tag$num
7885 } else {
7886 $ctext insert end "$line" $tag$num
7887 }
7888 if {!$dowords} {
7889 $ctext insert end "\n" $tag$num
7890 }
8b07dca1
PM
7891 } else {
7892 set tags {}
7893 if {[string first "+" $prefix] >= 0} {
7894 # added line
7895 lappend tags ${tag}result
7896 if {$diffnparents > 1} {
7897 set num [string first " " $prefix]
7898 if {$num >= 0} {
7899 if {$num >= $mergemax} {
7900 set num "max"
7901 }
7902 lappend tags m$num
7903 }
7904 }
ae4e3ff9
TR
7905 set words_pre_markup "{+"
7906 set words_post_markup "+}"
8b07dca1
PM
7907 }
7908 if {$targetline ne {}} {
7909 if {$diffline == $targetline} {
7910 set seehere [$ctext index "end - 1 chars"]
7911 set targetline {}
7912 } else {
7913 incr diffline
7914 }
7915 }
ae4e3ff9
TR
7916 if {$dowords && $worddiff eq [mc "Markup words"]} {
7917 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7918 } else {
7919 $ctext insert end "$line" $tags
7920 }
7921 if {!$dowords} {
7922 $ctext insert end "\n" $tags
7923 }
8b07dca1 7924 }
ae4e3ff9
TR
7925 } elseif {$dowords && $prefix eq "~"} {
7926 $ctext insert end "\n" {}
7eb3cb9c 7927 } else {
9396cd38
PM
7928 # "\ No newline at end of file",
7929 # or something else we don't recognize
7930 $ctext insert end "$line\n" hunksep
e5c2d856 7931 }
e5c2d856
PM
7932 }
7933 }
8b07dca1
PM
7934 if {[info exists seehere]} {
7935 mark_ctext_line [lindex [split $seehere .] 0]
7936 }
354af6bd 7937 maybe_scroll_ctext [eof $bdf]
e5c2d856 7938 $ctext conf -state disabled
7eb3cb9c 7939 if {[eof $bdf]} {
c21398be 7940 catch {close $bdf}
7eb3cb9c 7941 return 0
c8dfbcf9 7942 }
7eb3cb9c 7943 return [expr {$nr >= 1000? 2: 1}]
e5c2d856
PM
7944}
7945
a8d610a2
PM
7946proc changediffdisp {} {
7947 global ctext diffelide
7948
7949 $ctext tag conf d0 -elide [lindex $diffelide 0]
8b07dca1 7950 $ctext tag conf dresult -elide [lindex $diffelide 1]
a8d610a2
PM
7951}
7952
b967135d
SH
7953proc highlightfile {cline} {
7954 global cflist cflist_top
f4c54b3c 7955
f4c54b3c
PM
7956 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7957 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7958 $cflist see $cline.0
7959 set cflist_top $cline
7960}
7961
b967135d
SH
7962proc highlightfile_for_scrollpos {topidx} {
7963 global difffilestart
7964
7965 if {![info exists difffilestart]} return
7966
7967 set top [lindex [split $topidx .] 0]
7968 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
7969 highlightfile 0
7970 } else {
7971 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
7972 }
7973}
7974
67c22874 7975proc prevfile {} {
f4c54b3c
PM
7976 global difffilestart ctext cmitmode
7977
7978 if {$cmitmode eq "tree"} return
7979 set prev 0.0
67c22874
OH
7980 set here [$ctext index @0,0]
7981 foreach loc $difffilestart {
7982 if {[$ctext compare $loc >= $here]} {
b967135d 7983 $ctext yview $prev
67c22874
OH
7984 return
7985 }
7986 set prev $loc
7987 }
b967135d 7988 $ctext yview $prev
67c22874
OH
7989}
7990
39ad8570 7991proc nextfile {} {
f4c54b3c
PM
7992 global difffilestart ctext cmitmode
7993
7994 if {$cmitmode eq "tree"} return
39ad8570 7995 set here [$ctext index @0,0]
7fcceed7
PM
7996 foreach loc $difffilestart {
7997 if {[$ctext compare $loc > $here]} {
b967135d 7998 $ctext yview $loc
67c22874 7999 return
39ad8570
PM
8000 }
8001 }
1db95b00
PM
8002}
8003
3ea06f9f
PM
8004proc clear_ctext {{first 1.0}} {
8005 global ctext smarktop smarkbot
7cdc3556 8006 global ctext_file_names ctext_file_lines
97645683 8007 global pendinglinks
3ea06f9f 8008
1902c270
PM
8009 set l [lindex [split $first .] 0]
8010 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8011 set smarktop $l
3ea06f9f 8012 }
1902c270
PM
8013 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8014 set smarkbot $l
3ea06f9f
PM
8015 }
8016 $ctext delete $first end
97645683
PM
8017 if {$first eq "1.0"} {
8018 catch {unset pendinglinks}
8019 }
7cdc3556
AG
8020 set ctext_file_names {}
8021 set ctext_file_lines {}
3ea06f9f
PM
8022}
8023
32f1b3e4 8024proc settabs {{firstab {}}} {
9c311b32 8025 global firsttabstop tabstop ctext have_tk85
32f1b3e4
PM
8026
8027 if {$firstab ne {} && $have_tk85} {
8028 set firsttabstop $firstab
8029 }
9c311b32 8030 set w [font measure textfont "0"]
32f1b3e4 8031 if {$firsttabstop != 0} {
64b5f146
PM
8032 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8033 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
32f1b3e4
PM
8034 } elseif {$have_tk85 || $tabstop != 8} {
8035 $ctext conf -tabs [expr {$tabstop * $w}]
8036 } else {
8037 $ctext conf -tabs {}
8038 }
3ea06f9f
PM
8039}
8040
8041proc incrsearch {name ix op} {
1902c270 8042 global ctext searchstring searchdirn
3ea06f9f 8043
1902c270
PM
8044 if {[catch {$ctext index anchor}]} {
8045 # no anchor set, use start of selection, or of visible area
8046 set sel [$ctext tag ranges sel]
8047 if {$sel ne {}} {
8048 $ctext mark set anchor [lindex $sel 0]
8049 } elseif {$searchdirn eq "-forwards"} {
8050 $ctext mark set anchor @0,0
8051 } else {
8052 $ctext mark set anchor @0,[winfo height $ctext]
8053 }
8054 }
3ea06f9f 8055 if {$searchstring ne {}} {
1902c270
PM
8056 set here [$ctext search $searchdirn -- $searchstring anchor]
8057 if {$here ne {}} {
8058 $ctext see $here
b967135d
SH
8059 suppress_highlighting_file_for_current_scrollpos
8060 highlightfile_for_scrollpos $here
1902c270 8061 }
3ea06f9f 8062 }
c4614994 8063 rehighlight_search_results
3ea06f9f
PM
8064}
8065
8066proc dosearch {} {
1902c270 8067 global sstring ctext searchstring searchdirn
3ea06f9f
PM
8068
8069 focus $sstring
8070 $sstring icursor end
1902c270
PM
8071 set searchdirn -forwards
8072 if {$searchstring ne {}} {
8073 set sel [$ctext tag ranges sel]
8074 if {$sel ne {}} {
8075 set start "[lindex $sel 0] + 1c"
8076 } elseif {[catch {set start [$ctext index anchor]}]} {
8077 set start "@0,0"
8078 }
8079 set match [$ctext search -count mlen -- $searchstring $start]
8080 $ctext tag remove sel 1.0 end
8081 if {$match eq {}} {
8082 bell
8083 return
8084 }
8085 $ctext see $match
b967135d
SH
8086 suppress_highlighting_file_for_current_scrollpos
8087 highlightfile_for_scrollpos $match
1902c270
PM
8088 set mend "$match + $mlen c"
8089 $ctext tag add sel $match $mend
8090 $ctext mark unset anchor
c4614994 8091 rehighlight_search_results
1902c270
PM
8092 }
8093}
8094
8095proc dosearchback {} {
8096 global sstring ctext searchstring searchdirn
8097
8098 focus $sstring
8099 $sstring icursor end
8100 set searchdirn -backwards
8101 if {$searchstring ne {}} {
8102 set sel [$ctext tag ranges sel]
8103 if {$sel ne {}} {
8104 set start [lindex $sel 0]
8105 } elseif {[catch {set start [$ctext index anchor]}]} {
8106 set start @0,[winfo height $ctext]
8107 }
8108 set match [$ctext search -backwards -count ml -- $searchstring $start]
8109 $ctext tag remove sel 1.0 end
8110 if {$match eq {}} {
8111 bell
8112 return
8113 }
8114 $ctext see $match
b967135d
SH
8115 suppress_highlighting_file_for_current_scrollpos
8116 highlightfile_for_scrollpos $match
1902c270
PM
8117 set mend "$match + $ml c"
8118 $ctext tag add sel $match $mend
8119 $ctext mark unset anchor
c4614994
SH
8120 rehighlight_search_results
8121 }
8122}
8123
8124proc rehighlight_search_results {} {
8125 global ctext searchstring
8126
8127 $ctext tag remove found 1.0 end
8128 $ctext tag remove currentsearchhit 1.0 end
8129
8130 if {$searchstring ne {}} {
8131 searchmarkvisible 1
3ea06f9f 8132 }
3ea06f9f
PM
8133}
8134
8135proc searchmark {first last} {
8136 global ctext searchstring
8137
c4614994
SH
8138 set sel [$ctext tag ranges sel]
8139
3ea06f9f
PM
8140 set mend $first.0
8141 while {1} {
8142 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8143 if {$match eq {}} break
8144 set mend "$match + $mlen c"
c4614994
SH
8145 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8146 $ctext tag add currentsearchhit $match $mend
8147 } else {
8148 $ctext tag add found $match $mend
8149 }
3ea06f9f
PM
8150 }
8151}
8152
8153proc searchmarkvisible {doall} {
8154 global ctext smarktop smarkbot
8155
8156 set topline [lindex [split [$ctext index @0,0] .] 0]
8157 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8158 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8159 # no overlap with previous
8160 searchmark $topline $botline
8161 set smarktop $topline
8162 set smarkbot $botline
8163 } else {
8164 if {$topline < $smarktop} {
8165 searchmark $topline [expr {$smarktop-1}]
8166 set smarktop $topline
8167 }
8168 if {$botline > $smarkbot} {
8169 searchmark [expr {$smarkbot+1}] $botline
8170 set smarkbot $botline
8171 }
8172 }
8173}
8174
b967135d
SH
8175proc suppress_highlighting_file_for_current_scrollpos {} {
8176 global ctext suppress_highlighting_file_for_this_scrollpos
8177
8178 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8179}
8180
3ea06f9f 8181proc scrolltext {f0 f1} {
b967135d
SH
8182 global searchstring cmitmode ctext
8183 global suppress_highlighting_file_for_this_scrollpos
8184
8185 if {$cmitmode ne "tree"} {
8186 set topidx [$ctext index @0,0]
8187 if {![info exists suppress_highlighting_file_for_this_scrollpos]
8188 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8189 highlightfile_for_scrollpos $topidx
8190 }
8191 }
8192
8193 catch {unset suppress_highlighting_file_for_this_scrollpos}
3ea06f9f 8194
8809d691 8195 .bleft.bottom.sb set $f0 $f1
3ea06f9f
PM
8196 if {$searchstring ne {}} {
8197 searchmarkvisible 0
8198 }
8199}
8200
1d10f36d 8201proc setcoords {} {
9c311b32 8202 global linespc charspc canvx0 canvy0
f6075eba 8203 global xspc1 xspc2 lthickness
8d858d1a 8204
9c311b32
PM
8205 set linespc [font metrics mainfont -linespace]
8206 set charspc [font measure mainfont "m"]
9f1afe05
PM
8207 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8208 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
f6075eba 8209 set lthickness [expr {int($linespc / 9) + 1}]
8d858d1a
PM
8210 set xspc1(0) $linespc
8211 set xspc2 $linespc
9a40c50c 8212}
1db95b00 8213
1d10f36d 8214proc redisplay {} {
be0cd098 8215 global canv
9f1afe05
PM
8216 global selectedline
8217
8218 set ymax [lindex [$canv cget -scrollregion] 3]
8219 if {$ymax eq {} || $ymax == 0} return
8220 set span [$canv yview]
8221 clear_display
be0cd098 8222 setcanvscroll
9f1afe05
PM
8223 allcanvs yview moveto [lindex $span 0]
8224 drawvisible
94b4a69f 8225 if {$selectedline ne {}} {
9f1afe05 8226 selectline $selectedline 0
ca6d8f58 8227 allcanvs yview moveto [lindex $span 0]
1d10f36d
PM
8228 }
8229}
8230
0ed1dd3c
PM
8231proc parsefont {f n} {
8232 global fontattr
8233
8234 set fontattr($f,family) [lindex $n 0]
8235 set s [lindex $n 1]
8236 if {$s eq {} || $s == 0} {
8237 set s 10
8238 } elseif {$s < 0} {
8239 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
9c311b32 8240 }
0ed1dd3c
PM
8241 set fontattr($f,size) $s
8242 set fontattr($f,weight) normal
8243 set fontattr($f,slant) roman
8244 foreach style [lrange $n 2 end] {
8245 switch -- $style {
8246 "normal" -
8247 "bold" {set fontattr($f,weight) $style}
8248 "roman" -
8249 "italic" {set fontattr($f,slant) $style}
8250 }
9c311b32 8251 }
0ed1dd3c
PM
8252}
8253
8254proc fontflags {f {isbold 0}} {
8255 global fontattr
8256
8257 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8258 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8259 -slant $fontattr($f,slant)]
8260}
8261
8262proc fontname {f} {
8263 global fontattr
8264
8265 set n [list $fontattr($f,family) $fontattr($f,size)]
8266 if {$fontattr($f,weight) eq "bold"} {
8267 lappend n "bold"
9c311b32 8268 }
0ed1dd3c
PM
8269 if {$fontattr($f,slant) eq "italic"} {
8270 lappend n "italic"
9c311b32 8271 }
0ed1dd3c 8272 return $n
9c311b32
PM
8273}
8274
1d10f36d 8275proc incrfont {inc} {
7fcc92bf 8276 global mainfont textfont ctext canv cflist showrefstop
0ed1dd3c
PM
8277 global stopped entries fontattr
8278
1d10f36d 8279 unmarkmatches
0ed1dd3c 8280 set s $fontattr(mainfont,size)
9c311b32
PM
8281 incr s $inc
8282 if {$s < 1} {
8283 set s 1
8284 }
0ed1dd3c 8285 set fontattr(mainfont,size) $s
9c311b32
PM
8286 font config mainfont -size $s
8287 font config mainfontbold -size $s
0ed1dd3c
PM
8288 set mainfont [fontname mainfont]
8289 set s $fontattr(textfont,size)
9c311b32
PM
8290 incr s $inc
8291 if {$s < 1} {
8292 set s 1
8293 }
0ed1dd3c 8294 set fontattr(textfont,size) $s
9c311b32
PM
8295 font config textfont -size $s
8296 font config textfontbold -size $s
0ed1dd3c 8297 set textfont [fontname textfont]
1d10f36d 8298 setcoords
32f1b3e4 8299 settabs
1d10f36d
PM
8300 redisplay
8301}
1db95b00 8302
ee3dc72e
PM
8303proc clearsha1 {} {
8304 global sha1entry sha1string
8305 if {[string length $sha1string] == 40} {
8306 $sha1entry delete 0 end
8307 }
8308}
8309
887fe3c4
PM
8310proc sha1change {n1 n2 op} {
8311 global sha1string currentid sha1but
8312 if {$sha1string == {}
8313 || ([info exists currentid] && $sha1string == $currentid)} {
8314 set state disabled
8315 } else {
8316 set state normal
8317 }
8318 if {[$sha1but cget -state] == $state} return
8319 if {$state == "normal"} {
d990cedf 8320 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
887fe3c4 8321 } else {
d990cedf 8322 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
887fe3c4
PM
8323 }
8324}
8325
8326proc gotocommit {} {
7fcc92bf 8327 global sha1string tagids headids curview varcid
f3b8b3ce 8328
887fe3c4
PM
8329 if {$sha1string == {}
8330 || ([info exists currentid] && $sha1string == $currentid)} return
8331 if {[info exists tagids($sha1string)]} {
8332 set id $tagids($sha1string)
e1007129
SR
8333 } elseif {[info exists headids($sha1string)]} {
8334 set id $headids($sha1string)
887fe3c4
PM
8335 } else {
8336 set id [string tolower $sha1string]
f3b8b3ce 8337 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
d375ef9b 8338 set matches [longid $id]
f3b8b3ce
PM
8339 if {$matches ne {}} {
8340 if {[llength $matches] > 1} {
d990cedf 8341 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
f3b8b3ce
PM
8342 return
8343 }
d375ef9b 8344 set id [lindex $matches 0]
f3b8b3ce 8345 }
9bf3acfa
TR
8346 } else {
8347 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8348 error_popup [mc "Revision %s is not known" $sha1string]
8349 return
8350 }
f3b8b3ce 8351 }
887fe3c4 8352 }
7fcc92bf
PM
8353 if {[commitinview $id $curview]} {
8354 selectline [rowofcommit $id] 1
887fe3c4
PM
8355 return
8356 }
f3b8b3ce 8357 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
d990cedf 8358 set msg [mc "SHA1 id %s is not known" $sha1string]
887fe3c4 8359 } else {
9bf3acfa 8360 set msg [mc "Revision %s is not in the current view" $sha1string]
887fe3c4 8361 }
d990cedf 8362 error_popup $msg
887fe3c4
PM
8363}
8364
84ba7345
PM
8365proc lineenter {x y id} {
8366 global hoverx hovery hoverid hovertimer
8367 global commitinfo canv
8368
8ed16484 8369 if {![info exists commitinfo($id)] && ![getcommit $id]} return
84ba7345
PM
8370 set hoverx $x
8371 set hovery $y
8372 set hoverid $id
8373 if {[info exists hovertimer]} {
8374 after cancel $hovertimer
8375 }
8376 set hovertimer [after 500 linehover]
8377 $canv delete hover
8378}
8379
8380proc linemotion {x y id} {
8381 global hoverx hovery hoverid hovertimer
8382
8383 if {[info exists hoverid] && $id == $hoverid} {
8384 set hoverx $x
8385 set hovery $y
8386 if {[info exists hovertimer]} {
8387 after cancel $hovertimer
8388 }
8389 set hovertimer [after 500 linehover]
8390 }
8391}
8392
8393proc lineleave {id} {
8394 global hoverid hovertimer canv
8395
8396 if {[info exists hoverid] && $id == $hoverid} {
8397 $canv delete hover
8398 if {[info exists hovertimer]} {
8399 after cancel $hovertimer
8400 unset hovertimer
8401 }
8402 unset hoverid
8403 }
8404}
8405
8406proc linehover {} {
8407 global hoverx hovery hoverid hovertimer
8408 global canv linespc lthickness
9c311b32 8409 global commitinfo
84ba7345
PM
8410
8411 set text [lindex $commitinfo($hoverid) 0]
8412 set ymax [lindex [$canv cget -scrollregion] 3]
8413 if {$ymax == {}} return
8414 set yfrac [lindex [$canv yview] 0]
8415 set x [expr {$hoverx + 2 * $linespc}]
8416 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8417 set x0 [expr {$x - 2 * $lthickness}]
8418 set y0 [expr {$y - 2 * $lthickness}]
9c311b32 8419 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
84ba7345
PM
8420 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8421 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8422 -fill \#ffff80 -outline black -width 1 -tags hover]
8423 $canv raise $t
f8a2c0d1 8424 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
9c311b32 8425 -font mainfont]
84ba7345
PM
8426 $canv raise $t
8427}
8428
9843c307 8429proc clickisonarrow {id y} {
50b44ece 8430 global lthickness
9843c307 8431
50b44ece 8432 set ranges [rowranges $id]
9843c307 8433 set thresh [expr {2 * $lthickness + 6}]
50b44ece 8434 set n [expr {[llength $ranges] - 1}]
f6342480 8435 for {set i 1} {$i < $n} {incr i} {
50b44ece 8436 set row [lindex $ranges $i]
f6342480
PM
8437 if {abs([yc $row] - $y) < $thresh} {
8438 return $i
9843c307
PM
8439 }
8440 }
8441 return {}
8442}
8443
f6342480 8444proc arrowjump {id n y} {
50b44ece 8445 global canv
9843c307 8446
f6342480
PM
8447 # 1 <-> 2, 3 <-> 4, etc...
8448 set n [expr {(($n - 1) ^ 1) + 1}]
50b44ece 8449 set row [lindex [rowranges $id] $n]
f6342480 8450 set yt [yc $row]
9843c307
PM
8451 set ymax [lindex [$canv cget -scrollregion] 3]
8452 if {$ymax eq {} || $ymax <= 0} return
8453 set view [$canv yview]
8454 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8455 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8456 if {$yfrac < 0} {
8457 set yfrac 0
8458 }
f6342480 8459 allcanvs yview moveto $yfrac
9843c307
PM
8460}
8461
fa4da7b3 8462proc lineclick {x y id isnew} {
7fcc92bf 8463 global ctext commitinfo children canv thickerline curview
c8dfbcf9 8464
8ed16484 8465 if {![info exists commitinfo($id)] && ![getcommit $id]} return
c8dfbcf9 8466 unmarkmatches
fa4da7b3 8467 unselectline
9843c307
PM
8468 normalline
8469 $canv delete hover
8470 # draw this line thicker than normal
9843c307 8471 set thickerline $id
c934a8a3 8472 drawlines $id
fa4da7b3 8473 if {$isnew} {
9843c307
PM
8474 set ymax [lindex [$canv cget -scrollregion] 3]
8475 if {$ymax eq {}} return
8476 set yfrac [lindex [$canv yview] 0]
8477 set y [expr {$y + $yfrac * $ymax}]
8478 }
8479 set dirn [clickisonarrow $id $y]
8480 if {$dirn ne {}} {
8481 arrowjump $id $dirn $y
8482 return
8483 }
8484
8485 if {$isnew} {
354af6bd 8486 addtohistory [list lineclick $x $y $id 0] savectextpos
fa4da7b3 8487 }
c8dfbcf9
PM
8488 # fill the details pane with info about this line
8489 $ctext conf -state normal
3ea06f9f 8490 clear_ctext
32f1b3e4 8491 settabs 0
d990cedf 8492 $ctext insert end "[mc "Parent"]:\t"
97645683
PM
8493 $ctext insert end $id link0
8494 setlink $id link0
c8dfbcf9 8495 set info $commitinfo($id)
fa4da7b3 8496 $ctext insert end "\n\t[lindex $info 0]\n"
d990cedf 8497 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
232475d3 8498 set date [formatdate [lindex $info 2]]
d990cedf 8499 $ctext insert end "\t[mc "Date"]:\t$date\n"
da7c24dd 8500 set kids $children($curview,$id)
79b2c75e 8501 if {$kids ne {}} {
d990cedf 8502 $ctext insert end "\n[mc "Children"]:"
fa4da7b3 8503 set i 0
79b2c75e 8504 foreach child $kids {
fa4da7b3 8505 incr i
8ed16484 8506 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
c8dfbcf9 8507 set info $commitinfo($child)
fa4da7b3 8508 $ctext insert end "\n\t"
97645683
PM
8509 $ctext insert end $child link$i
8510 setlink $child link$i
fa4da7b3 8511 $ctext insert end "\n\t[lindex $info 0]"
d990cedf 8512 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
232475d3 8513 set date [formatdate [lindex $info 2]]
d990cedf 8514 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
c8dfbcf9
PM
8515 }
8516 }
354af6bd 8517 maybe_scroll_ctext 1
c8dfbcf9 8518 $ctext conf -state disabled
7fcceed7 8519 init_flist {}
c8dfbcf9
PM
8520}
8521
9843c307
PM
8522proc normalline {} {
8523 global thickerline
8524 if {[info exists thickerline]} {
c934a8a3 8525 set id $thickerline
9843c307 8526 unset thickerline
c934a8a3 8527 drawlines $id
9843c307
PM
8528 }
8529}
8530
354af6bd 8531proc selbyid {id {isnew 1}} {
7fcc92bf
PM
8532 global curview
8533 if {[commitinview $id $curview]} {
354af6bd 8534 selectline [rowofcommit $id] $isnew
c8dfbcf9
PM
8535 }
8536}
8537
8538proc mstime {} {
8539 global startmstime
8540 if {![info exists startmstime]} {
8541 set startmstime [clock clicks -milliseconds]
8542 }
8543 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8544}
8545
8546proc rowmenu {x y id} {
7fcc92bf 8547 global rowctxmenu selectedline rowmenuid curview
b9fdba7f 8548 global nullid nullid2 fakerowmenu mainhead markedid
c8dfbcf9 8549
bb3edc8b 8550 stopfinding
219ea3a9 8551 set rowmenuid $id
94b4a69f 8552 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
c8dfbcf9
PM
8553 set state disabled
8554 } else {
8555 set state normal
8556 }
6febdede
PM
8557 if {[info exists markedid] && $markedid ne $id} {
8558 set mstate normal
8559 } else {
8560 set mstate disabled
8561 }
8f489363 8562 if {$id ne $nullid && $id ne $nullid2} {
219ea3a9 8563 set menu $rowctxmenu
5e3502da 8564 if {$mainhead ne {}} {
da12e59d 8565 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
5e3502da
MB
8566 } else {
8567 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8568 }
6febdede
PM
8569 $menu entryconfigure 9 -state $mstate
8570 $menu entryconfigure 10 -state $mstate
8571 $menu entryconfigure 11 -state $mstate
219ea3a9
PM
8572 } else {
8573 set menu $fakerowmenu
8574 }
f2d0bbbd
PM
8575 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8576 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8577 $menu entryconfigure [mca "Make patch"] -state $state
6febdede
PM
8578 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8579 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
219ea3a9 8580 tk_popup $menu $x $y
c8dfbcf9
PM
8581}
8582
b9fdba7f
PM
8583proc markhere {} {
8584 global rowmenuid markedid canv
8585
8586 set markedid $rowmenuid
8587 make_idmark $markedid
8588}
8589
8590proc gotomark {} {
8591 global markedid
8592
8593 if {[info exists markedid]} {
8594 selbyid $markedid
8595 }
8596}
8597
8598proc replace_by_kids {l r} {
8599 global curview children
8600
8601 set id [commitonrow $r]
8602 set l [lreplace $l 0 0]
8603 foreach kid $children($curview,$id) {
8604 lappend l [rowofcommit $kid]
8605 }
8606 return [lsort -integer -decreasing -unique $l]
8607}
8608
8609proc find_common_desc {} {
8610 global markedid rowmenuid curview children
8611
8612 if {![info exists markedid]} return
8613 if {![commitinview $markedid $curview] ||
8614 ![commitinview $rowmenuid $curview]} return
8615 #set t1 [clock clicks -milliseconds]
8616 set l1 [list [rowofcommit $markedid]]
8617 set l2 [list [rowofcommit $rowmenuid]]
8618 while 1 {
8619 set r1 [lindex $l1 0]
8620 set r2 [lindex $l2 0]
8621 if {$r1 eq {} || $r2 eq {}} break
8622 if {$r1 == $r2} {
8623 selectline $r1 1
8624 break
8625 }
8626 if {$r1 > $r2} {
8627 set l1 [replace_by_kids $l1 $r1]
8628 } else {
8629 set l2 [replace_by_kids $l2 $r2]
8630 }
8631 }
8632 #set t2 [clock clicks -milliseconds]
8633 #puts "took [expr {$t2-$t1}]ms"
8634}
8635
010509f2
PM
8636proc compare_commits {} {
8637 global markedid rowmenuid curview children
8638
8639 if {![info exists markedid]} return
8640 if {![commitinview $markedid $curview]} return
8641 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8642 do_cmp_commits $markedid $rowmenuid
8643}
8644
8645proc getpatchid {id} {
8646 global patchids
8647
8648 if {![info exists patchids($id)]} {
6f63fc18
PM
8649 set cmd [diffcmd [list $id] {-p --root}]
8650 # trim off the initial "|"
8651 set cmd [lrange $cmd 1 end]
8652 if {[catch {
8653 set x [eval exec $cmd | git patch-id]
8654 set patchids($id) [lindex $x 0]
8655 }]} {
8656 set patchids($id) "error"
8657 }
010509f2
PM
8658 }
8659 return $patchids($id)
8660}
8661
8662proc do_cmp_commits {a b} {
8663 global ctext curview parents children patchids commitinfo
8664
8665 $ctext conf -state normal
8666 clear_ctext
8667 init_flist {}
8668 for {set i 0} {$i < 100} {incr i} {
010509f2
PM
8669 set skipa 0
8670 set skipb 0
8671 if {[llength $parents($curview,$a)] > 1} {
6f63fc18 8672 appendshortlink $a [mc "Skipping merge commit "] "\n"
010509f2
PM
8673 set skipa 1
8674 } else {
8675 set patcha [getpatchid $a]
8676 }
8677 if {[llength $parents($curview,$b)] > 1} {
6f63fc18 8678 appendshortlink $b [mc "Skipping merge commit "] "\n"
010509f2
PM
8679 set skipb 1
8680 } else {
8681 set patchb [getpatchid $b]
8682 }
8683 if {!$skipa && !$skipb} {
8684 set heada [lindex $commitinfo($a) 0]
8685 set headb [lindex $commitinfo($b) 0]
6f63fc18
PM
8686 if {$patcha eq "error"} {
8687 appendshortlink $a [mc "Error getting patch ID for "] \
8688 [mc " - stopping\n"]
8689 break
8690 }
8691 if {$patchb eq "error"} {
8692 appendshortlink $b [mc "Error getting patch ID for "] \
8693 [mc " - stopping\n"]
8694 break
8695 }
010509f2
PM
8696 if {$patcha eq $patchb} {
8697 if {$heada eq $headb} {
6f63fc18
PM
8698 appendshortlink $a [mc "Commit "]
8699 appendshortlink $b " == " " $heada\n"
010509f2 8700 } else {
6f63fc18
PM
8701 appendshortlink $a [mc "Commit "] " $heada\n"
8702 appendshortlink $b [mc " is the same patch as\n "] \
8703 " $headb\n"
010509f2
PM
8704 }
8705 set skipa 1
8706 set skipb 1
8707 } else {
8708 $ctext insert end "\n"
6f63fc18
PM
8709 appendshortlink $a [mc "Commit "] " $heada\n"
8710 appendshortlink $b [mc " differs from\n "] \
8711 " $headb\n"
c21398be
PM
8712 $ctext insert end [mc "Diff of commits:\n\n"]
8713 $ctext conf -state disabled
8714 update
8715 diffcommits $a $b
8716 return
010509f2
PM
8717 }
8718 }
8719 if {$skipa} {
aa43561a
PM
8720 set kids [real_children $curview,$a]
8721 if {[llength $kids] != 1} {
010509f2 8722 $ctext insert end "\n"
6f63fc18 8723 appendshortlink $a [mc "Commit "] \
aa43561a 8724 [mc " has %s children - stopping\n" [llength $kids]]
010509f2
PM
8725 break
8726 }
aa43561a 8727 set a [lindex $kids 0]
010509f2
PM
8728 }
8729 if {$skipb} {
aa43561a
PM
8730 set kids [real_children $curview,$b]
8731 if {[llength $kids] != 1} {
6f63fc18 8732 appendshortlink $b [mc "Commit "] \
aa43561a 8733 [mc " has %s children - stopping\n" [llength $kids]]
010509f2
PM
8734 break
8735 }
aa43561a 8736 set b [lindex $kids 0]
010509f2
PM
8737 }
8738 }
8739 $ctext conf -state disabled
8740}
8741
c21398be 8742proc diffcommits {a b} {
a1d383c5 8743 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
c21398be
PM
8744
8745 set tmpdir [gitknewtmpdir]
8746 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8747 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8748 if {[catch {
8749 exec git diff-tree -p --pretty $a >$fna
8750 exec git diff-tree -p --pretty $b >$fnb
8751 } err]} {
8752 error_popup [mc "Error writing commit to file: %s" $err]
8753 return
8754 }
8755 if {[catch {
8756 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8757 } err]} {
8758 error_popup [mc "Error diffing commits: %s" $err]
8759 return
8760 }
8761 set diffids [list commits $a $b]
8762 set blobdifffd($diffids) $fd
8763 set diffinhdr 0
a1d383c5 8764 set currdiffsubmod ""
c21398be
PM
8765 filerun $fd [list getblobdiffline $fd $diffids]
8766}
8767
c8dfbcf9 8768proc diffvssel {dirn} {
7fcc92bf 8769 global rowmenuid selectedline
c8dfbcf9 8770
94b4a69f 8771 if {$selectedline eq {}} return
c8dfbcf9 8772 if {$dirn} {
7fcc92bf 8773 set oldid [commitonrow $selectedline]
c8dfbcf9
PM
8774 set newid $rowmenuid
8775 } else {
8776 set oldid $rowmenuid
7fcc92bf 8777 set newid [commitonrow $selectedline]
c8dfbcf9 8778 }
354af6bd 8779 addtohistory [list doseldiff $oldid $newid] savectextpos
fa4da7b3
PM
8780 doseldiff $oldid $newid
8781}
8782
6febdede
PM
8783proc diffvsmark {dirn} {
8784 global rowmenuid markedid
8785
8786 if {![info exists markedid]} return
8787 if {$dirn} {
8788 set oldid $markedid
8789 set newid $rowmenuid
8790 } else {
8791 set oldid $rowmenuid
8792 set newid $markedid
8793 }
8794 addtohistory [list doseldiff $oldid $newid] savectextpos
8795 doseldiff $oldid $newid
8796}
8797
fa4da7b3 8798proc doseldiff {oldid newid} {
7fcceed7 8799 global ctext
fa4da7b3
PM
8800 global commitinfo
8801
c8dfbcf9 8802 $ctext conf -state normal
3ea06f9f 8803 clear_ctext
d990cedf
CS
8804 init_flist [mc "Top"]
8805 $ctext insert end "[mc "From"] "
97645683
PM
8806 $ctext insert end $oldid link0
8807 setlink $oldid link0
fa4da7b3 8808 $ctext insert end "\n "
c8dfbcf9 8809 $ctext insert end [lindex $commitinfo($oldid) 0]
d990cedf 8810 $ctext insert end "\n\n[mc "To"] "
97645683
PM
8811 $ctext insert end $newid link1
8812 setlink $newid link1
fa4da7b3 8813 $ctext insert end "\n "
c8dfbcf9
PM
8814 $ctext insert end [lindex $commitinfo($newid) 0]
8815 $ctext insert end "\n"
8816 $ctext conf -state disabled
c8dfbcf9 8817 $ctext tag remove found 1.0 end
d327244a 8818 startdiff [list $oldid $newid]
c8dfbcf9
PM
8819}
8820
74daedb6 8821proc mkpatch {} {
d93f1713 8822 global rowmenuid currentid commitinfo patchtop patchnum NS
74daedb6
PM
8823
8824 if {![info exists currentid]} return
8825 set oldid $currentid
8826 set oldhead [lindex $commitinfo($oldid) 0]
8827 set newid $rowmenuid
8828 set newhead [lindex $commitinfo($newid) 0]
8829 set top .patch
8830 set patchtop $top
8831 catch {destroy $top}
d93f1713 8832 ttk_toplevel $top
e7d64008 8833 make_transient $top .
d93f1713 8834 ${NS}::label $top.title -text [mc "Generate patch"]
4a2139f5 8835 grid $top.title - -pady 10
d93f1713
PT
8836 ${NS}::label $top.from -text [mc "From:"]
8837 ${NS}::entry $top.fromsha1 -width 40
74daedb6
PM
8838 $top.fromsha1 insert 0 $oldid
8839 $top.fromsha1 conf -state readonly
8840 grid $top.from $top.fromsha1 -sticky w
d93f1713 8841 ${NS}::entry $top.fromhead -width 60
74daedb6
PM
8842 $top.fromhead insert 0 $oldhead
8843 $top.fromhead conf -state readonly
8844 grid x $top.fromhead -sticky w
d93f1713
PT
8845 ${NS}::label $top.to -text [mc "To:"]
8846 ${NS}::entry $top.tosha1 -width 40
74daedb6
PM
8847 $top.tosha1 insert 0 $newid
8848 $top.tosha1 conf -state readonly
8849 grid $top.to $top.tosha1 -sticky w
d93f1713 8850 ${NS}::entry $top.tohead -width 60
74daedb6
PM
8851 $top.tohead insert 0 $newhead
8852 $top.tohead conf -state readonly
8853 grid x $top.tohead -sticky w
d93f1713
PT
8854 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8855 grid $top.rev x -pady 10 -padx 5
8856 ${NS}::label $top.flab -text [mc "Output file:"]
8857 ${NS}::entry $top.fname -width 60
74daedb6
PM
8858 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8859 incr patchnum
bdbfbe3d 8860 grid $top.flab $top.fname -sticky w
d93f1713
PT
8861 ${NS}::frame $top.buts
8862 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8863 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
76f15947
AG
8864 bind $top <Key-Return> mkpatchgo
8865 bind $top <Key-Escape> mkpatchcan
74daedb6
PM
8866 grid $top.buts.gen $top.buts.can
8867 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8868 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8869 grid $top.buts - -pady 10 -sticky ew
bdbfbe3d 8870 focus $top.fname
74daedb6
PM
8871}
8872
8873proc mkpatchrev {} {
8874 global patchtop
8875
8876 set oldid [$patchtop.fromsha1 get]
8877 set oldhead [$patchtop.fromhead get]
8878 set newid [$patchtop.tosha1 get]
8879 set newhead [$patchtop.tohead get]
8880 foreach e [list fromsha1 fromhead tosha1 tohead] \
8881 v [list $newid $newhead $oldid $oldhead] {
8882 $patchtop.$e conf -state normal
8883 $patchtop.$e delete 0 end
8884 $patchtop.$e insert 0 $v
8885 $patchtop.$e conf -state readonly
8886 }
8887}
8888
8889proc mkpatchgo {} {
8f489363 8890 global patchtop nullid nullid2
74daedb6
PM
8891
8892 set oldid [$patchtop.fromsha1 get]
8893 set newid [$patchtop.tosha1 get]
8894 set fname [$patchtop.fname get]
8f489363 8895 set cmd [diffcmd [list $oldid $newid] -p]
d372e216
PM
8896 # trim off the initial "|"
8897 set cmd [lrange $cmd 1 end]
219ea3a9
PM
8898 lappend cmd >$fname &
8899 if {[catch {eval exec $cmd} err]} {
84a76f18 8900 error_popup "[mc "Error creating patch:"] $err" $patchtop
74daedb6
PM
8901 }
8902 catch {destroy $patchtop}
8903 unset patchtop
8904}
8905
8906proc mkpatchcan {} {
8907 global patchtop
8908
8909 catch {destroy $patchtop}
8910 unset patchtop
8911}
8912
bdbfbe3d 8913proc mktag {} {
d93f1713 8914 global rowmenuid mktagtop commitinfo NS
bdbfbe3d
PM
8915
8916 set top .maketag
8917 set mktagtop $top
8918 catch {destroy $top}
d93f1713 8919 ttk_toplevel $top
e7d64008 8920 make_transient $top .
d93f1713 8921 ${NS}::label $top.title -text [mc "Create tag"]
4a2139f5 8922 grid $top.title - -pady 10
d93f1713
PT
8923 ${NS}::label $top.id -text [mc "ID:"]
8924 ${NS}::entry $top.sha1 -width 40
bdbfbe3d
PM
8925 $top.sha1 insert 0 $rowmenuid
8926 $top.sha1 conf -state readonly
8927 grid $top.id $top.sha1 -sticky w
d93f1713 8928 ${NS}::entry $top.head -width 60
bdbfbe3d
PM
8929 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8930 $top.head conf -state readonly
8931 grid x $top.head -sticky w
d93f1713
PT
8932 ${NS}::label $top.tlab -text [mc "Tag name:"]
8933 ${NS}::entry $top.tag -width 60
bdbfbe3d 8934 grid $top.tlab $top.tag -sticky w
dfb891e3
DD
8935 ${NS}::label $top.op -text [mc "Tag message is optional"]
8936 grid $top.op -columnspan 2 -sticky we
8937 ${NS}::label $top.mlab -text [mc "Tag message:"]
8938 ${NS}::entry $top.msg -width 60
8939 grid $top.mlab $top.msg -sticky w
d93f1713
PT
8940 ${NS}::frame $top.buts
8941 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8942 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
76f15947
AG
8943 bind $top <Key-Return> mktaggo
8944 bind $top <Key-Escape> mktagcan
bdbfbe3d
PM
8945 grid $top.buts.gen $top.buts.can
8946 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8947 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8948 grid $top.buts - -pady 10 -sticky ew
8949 focus $top.tag
8950}
8951
8952proc domktag {} {
8953 global mktagtop env tagids idtags
bdbfbe3d
PM
8954
8955 set id [$mktagtop.sha1 get]
8956 set tag [$mktagtop.tag get]
dfb891e3 8957 set msg [$mktagtop.msg get]
bdbfbe3d 8958 if {$tag == {}} {
84a76f18
AG
8959 error_popup [mc "No tag name specified"] $mktagtop
8960 return 0
bdbfbe3d
PM
8961 }
8962 if {[info exists tagids($tag)]} {
84a76f18
AG
8963 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8964 return 0
bdbfbe3d
PM
8965 }
8966 if {[catch {
dfb891e3
DD
8967 if {$msg != {}} {
8968 exec git tag -a -m $msg $tag $id
8969 } else {
8970 exec git tag $tag $id
8971 }
bdbfbe3d 8972 } err]} {
84a76f18
AG
8973 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8974 return 0
bdbfbe3d
PM
8975 }
8976
8977 set tagids($tag) $id
8978 lappend idtags($id) $tag
f1d83ba3 8979 redrawtags $id
ceadfe90 8980 addedtag $id
887c996e
PM
8981 dispneartags 0
8982 run refill_reflist
84a76f18 8983 return 1
f1d83ba3
PM
8984}
8985
8986proc redrawtags {id} {
b9fdba7f 8987 global canv linehtag idpos currentid curview cmitlisted markedid
c11ff120 8988 global canvxmax iddrawn circleitem mainheadid circlecolors
f1d83ba3 8989
7fcc92bf 8990 if {![commitinview $id $curview]} return
322a8cc9 8991 if {![info exists iddrawn($id)]} return
fc2a256f 8992 set row [rowofcommit $id]
c11ff120
PM
8993 if {$id eq $mainheadid} {
8994 set ofill yellow
8995 } else {
8996 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8997 }
8998 $canv itemconf $circleitem($row) -fill $ofill
bdbfbe3d
PM
8999 $canv delete tag.$id
9000 set xt [eval drawtags $id $idpos($id)]
28593d3f
PM
9001 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9002 set text [$canv itemcget $linehtag($id) -text]
9003 set font [$canv itemcget $linehtag($id) -font]
fc2a256f 9004 set xr [expr {$xt + [font measure $font $text]}]
b8ab2e17
PM
9005 if {$xr > $canvxmax} {
9006 set canvxmax $xr
9007 setcanvscroll
9008 }
fc2a256f 9009 if {[info exists currentid] && $currentid == $id} {
28593d3f 9010 make_secsel $id
bdbfbe3d 9011 }
b9fdba7f
PM
9012 if {[info exists markedid] && $markedid eq $id} {
9013 make_idmark $id
9014 }
bdbfbe3d
PM
9015}
9016
9017proc mktagcan {} {
9018 global mktagtop
9019
9020 catch {destroy $mktagtop}
9021 unset mktagtop
9022}
9023
9024proc mktaggo {} {
84a76f18 9025 if {![domktag]} return
bdbfbe3d
PM
9026 mktagcan
9027}
9028
4a2139f5 9029proc writecommit {} {
d93f1713 9030 global rowmenuid wrcomtop commitinfo wrcomcmd NS
4a2139f5
PM
9031
9032 set top .writecommit
9033 set wrcomtop $top
9034 catch {destroy $top}
d93f1713 9035 ttk_toplevel $top
e7d64008 9036 make_transient $top .
d93f1713 9037 ${NS}::label $top.title -text [mc "Write commit to file"]
4a2139f5 9038 grid $top.title - -pady 10
d93f1713
PT
9039 ${NS}::label $top.id -text [mc "ID:"]
9040 ${NS}::entry $top.sha1 -width 40
4a2139f5
PM
9041 $top.sha1 insert 0 $rowmenuid
9042 $top.sha1 conf -state readonly
9043 grid $top.id $top.sha1 -sticky w
d93f1713 9044 ${NS}::entry $top.head -width 60
4a2139f5
PM
9045 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9046 $top.head conf -state readonly
9047 grid x $top.head -sticky w
d93f1713
PT
9048 ${NS}::label $top.clab -text [mc "Command:"]
9049 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
4a2139f5 9050 grid $top.clab $top.cmd -sticky w -pady 10
d93f1713
PT
9051 ${NS}::label $top.flab -text [mc "Output file:"]
9052 ${NS}::entry $top.fname -width 60
4a2139f5
PM
9053 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9054 grid $top.flab $top.fname -sticky w
d93f1713
PT
9055 ${NS}::frame $top.buts
9056 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9057 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
76f15947
AG
9058 bind $top <Key-Return> wrcomgo
9059 bind $top <Key-Escape> wrcomcan
4a2139f5
PM
9060 grid $top.buts.gen $top.buts.can
9061 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9062 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9063 grid $top.buts - -pady 10 -sticky ew
9064 focus $top.fname
9065}
9066
9067proc wrcomgo {} {
9068 global wrcomtop
9069
9070 set id [$wrcomtop.sha1 get]
9071 set cmd "echo $id | [$wrcomtop.cmd get]"
9072 set fname [$wrcomtop.fname get]
9073 if {[catch {exec sh -c $cmd >$fname &} err]} {
84a76f18 9074 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
4a2139f5
PM
9075 }
9076 catch {destroy $wrcomtop}
9077 unset wrcomtop
9078}
9079
9080proc wrcomcan {} {
9081 global wrcomtop
9082
9083 catch {destroy $wrcomtop}
9084 unset wrcomtop
9085}
9086
d6ac1a86 9087proc mkbranch {} {
d93f1713 9088 global rowmenuid mkbrtop NS
d6ac1a86
PM
9089
9090 set top .makebranch
9091 catch {destroy $top}
d93f1713 9092 ttk_toplevel $top
e7d64008 9093 make_transient $top .
d93f1713 9094 ${NS}::label $top.title -text [mc "Create new branch"]
d6ac1a86 9095 grid $top.title - -pady 10
d93f1713
PT
9096 ${NS}::label $top.id -text [mc "ID:"]
9097 ${NS}::entry $top.sha1 -width 40
d6ac1a86
PM
9098 $top.sha1 insert 0 $rowmenuid
9099 $top.sha1 conf -state readonly
9100 grid $top.id $top.sha1 -sticky w
d93f1713
PT
9101 ${NS}::label $top.nlab -text [mc "Name:"]
9102 ${NS}::entry $top.name -width 40
d6ac1a86 9103 grid $top.nlab $top.name -sticky w
d93f1713
PT
9104 ${NS}::frame $top.buts
9105 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9106 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
76f15947
AG
9107 bind $top <Key-Return> [list mkbrgo $top]
9108 bind $top <Key-Escape> "catch {destroy $top}"
d6ac1a86
PM
9109 grid $top.buts.go $top.buts.can
9110 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9111 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9112 grid $top.buts - -pady 10 -sticky ew
9113 focus $top.name
9114}
9115
9116proc mkbrgo {top} {
9117 global headids idheads
9118
9119 set name [$top.name get]
9120 set id [$top.sha1 get]
bee866fa
AG
9121 set cmdargs {}
9122 set old_id {}
d6ac1a86 9123 if {$name eq {}} {
84a76f18 9124 error_popup [mc "Please specify a name for the new branch"] $top
d6ac1a86
PM
9125 return
9126 }
bee866fa
AG
9127 if {[info exists headids($name)]} {
9128 if {![confirm_popup [mc \
84a76f18 9129 "Branch '%s' already exists. Overwrite?" $name] $top]} {
bee866fa
AG
9130 return
9131 }
9132 set old_id $headids($name)
9133 lappend cmdargs -f
9134 }
d6ac1a86 9135 catch {destroy $top}
bee866fa 9136 lappend cmdargs $name $id
d6ac1a86
PM
9137 nowbusy newbranch
9138 update
9139 if {[catch {
bee866fa 9140 eval exec git branch $cmdargs
d6ac1a86
PM
9141 } err]} {
9142 notbusy newbranch
9143 error_popup $err
9144 } else {
d6ac1a86 9145 notbusy newbranch
bee866fa
AG
9146 if {$old_id ne {}} {
9147 movehead $id $name
9148 movedhead $id $name
9149 redrawtags $old_id
9150 redrawtags $id
9151 } else {
9152 set headids($name) $id
9153 lappend idheads($id) $name
9154 addedhead $id $name
9155 redrawtags $id
9156 }
e11f1233 9157 dispneartags 0
887c996e 9158 run refill_reflist
d6ac1a86
PM
9159 }
9160}
9161
15e35055
AG
9162proc exec_citool {tool_args {baseid {}}} {
9163 global commitinfo env
9164
9165 set save_env [array get env GIT_AUTHOR_*]
9166
9167 if {$baseid ne {}} {
9168 if {![info exists commitinfo($baseid)]} {
9169 getcommit $baseid
9170 }
9171 set author [lindex $commitinfo($baseid) 1]
9172 set date [lindex $commitinfo($baseid) 2]
9173 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9174 $author author name email]
9175 && $date ne {}} {
9176 set env(GIT_AUTHOR_NAME) $name
9177 set env(GIT_AUTHOR_EMAIL) $email
9178 set env(GIT_AUTHOR_DATE) $date
9179 }
9180 }
9181
9182 eval exec git citool $tool_args &
9183
9184 array unset env GIT_AUTHOR_*
9185 array set env $save_env
9186}
9187
ca6d8f58 9188proc cherrypick {} {
468bcaed 9189 global rowmenuid curview
b8a938cf 9190 global mainhead mainheadid
da616db5 9191 global gitdir
ca6d8f58 9192
e11f1233
PM
9193 set oldhead [exec git rev-parse HEAD]
9194 set dheads [descheads $rowmenuid]
9195 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
d990cedf
CS
9196 set ok [confirm_popup [mc "Commit %s is already\
9197 included in branch %s -- really re-apply it?" \
9198 [string range $rowmenuid 0 7] $mainhead]]
ca6d8f58
PM
9199 if {!$ok} return
9200 }
d990cedf 9201 nowbusy cherrypick [mc "Cherry-picking"]
ca6d8f58 9202 update
ca6d8f58
PM
9203 # Unfortunately git-cherry-pick writes stuff to stderr even when
9204 # no error occurs, and exec takes that as an indication of error...
9205 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9206 notbusy cherrypick
15e35055 9207 if {[regexp -line \
887a791f
PM
9208 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9209 $err msg fname]} {
9210 error_popup [mc "Cherry-pick failed because of local changes\
9211 to file '%s'.\nPlease commit, reset or stash\
9212 your changes and try again." $fname]
9213 } elseif {[regexp -line \
b74307f6 9214 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
887a791f
PM
9215 $err]} {
9216 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9217 conflict.\nDo you wish to run git citool to\
9218 resolve it?"]]} {
9219 # Force citool to read MERGE_MSG
da616db5 9220 file delete [file join $gitdir "GITGUI_MSG"]
887a791f
PM
9221 exec_citool {} $rowmenuid
9222 }
15e35055
AG
9223 } else {
9224 error_popup $err
9225 }
887a791f 9226 run updatecommits
ca6d8f58
PM
9227 return
9228 }
9229 set newhead [exec git rev-parse HEAD]
9230 if {$newhead eq $oldhead} {
9231 notbusy cherrypick
d990cedf 9232 error_popup [mc "No changes committed"]
ca6d8f58
PM
9233 return
9234 }
e11f1233 9235 addnewchild $newhead $oldhead
7fcc92bf 9236 if {[commitinview $oldhead $curview]} {
cdc8429c 9237 # XXX this isn't right if we have a path limit...
7fcc92bf 9238 insertrow $newhead $oldhead $curview
ca6d8f58 9239 if {$mainhead ne {}} {
e11f1233 9240 movehead $newhead $mainhead
ca6d8f58
PM
9241 movedhead $newhead $mainhead
9242 }
c11ff120 9243 set mainheadid $newhead
ca6d8f58
PM
9244 redrawtags $oldhead
9245 redrawtags $newhead
46308ea1 9246 selbyid $newhead
ca6d8f58
PM
9247 }
9248 notbusy cherrypick
9249}
9250
6fb735ae 9251proc resethead {} {
d93f1713 9252 global mainhead rowmenuid confirm_ok resettype NS
6fb735ae
PM
9253
9254 set confirm_ok 0
9255 set w ".confirmreset"
d93f1713 9256 ttk_toplevel $w
e7d64008 9257 make_transient $w .
d990cedf 9258 wm title $w [mc "Confirm reset"]
d93f1713
PT
9259 ${NS}::label $w.m -text \
9260 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
6fb735ae 9261 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 9262 ${NS}::labelframe $w.f -text [mc "Reset type:"]
6fb735ae 9263 set resettype mixed
d93f1713 9264 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
d990cedf 9265 -text [mc "Soft: Leave working tree and index untouched"]
6fb735ae 9266 grid $w.f.soft -sticky w
d93f1713 9267 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
d990cedf 9268 -text [mc "Mixed: Leave working tree untouched, reset index"]
6fb735ae 9269 grid $w.f.mixed -sticky w
d93f1713 9270 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
d990cedf 9271 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6fb735ae 9272 grid $w.f.hard -sticky w
d93f1713
PT
9273 pack $w.f -side top -fill x -padx 4
9274 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6fb735ae 9275 pack $w.ok -side left -fill x -padx 20 -pady 20
d93f1713 9276 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
76f15947 9277 bind $w <Key-Escape> [list destroy $w]
6fb735ae
PM
9278 pack $w.cancel -side right -fill x -padx 20 -pady 20
9279 bind $w <Visibility> "grab $w; focus $w"
9280 tkwait window $w
9281 if {!$confirm_ok} return
706d6c3e 9282 if {[catch {set fd [open \
08ba820f 9283 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
6fb735ae
PM
9284 error_popup $err
9285 } else {
706d6c3e 9286 dohidelocalchanges
a137a90f 9287 filerun $fd [list readresetstat $fd]
d990cedf 9288 nowbusy reset [mc "Resetting"]
46308ea1 9289 selbyid $rowmenuid
706d6c3e
PM
9290 }
9291}
9292
a137a90f
PM
9293proc readresetstat {fd} {
9294 global mainhead mainheadid showlocalchanges rprogcoord
706d6c3e
PM
9295
9296 if {[gets $fd line] >= 0} {
9297 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
a137a90f
PM
9298 set rprogcoord [expr {1.0 * $m / $n}]
9299 adjustprogress
706d6c3e
PM
9300 }
9301 return 1
9302 }
a137a90f
PM
9303 set rprogcoord 0
9304 adjustprogress
706d6c3e
PM
9305 notbusy reset
9306 if {[catch {close $fd} err]} {
9307 error_popup $err
9308 }
9309 set oldhead $mainheadid
9310 set newhead [exec git rev-parse HEAD]
9311 if {$newhead ne $oldhead} {
9312 movehead $newhead $mainhead
9313 movedhead $newhead $mainhead
9314 set mainheadid $newhead
6fb735ae 9315 redrawtags $oldhead
706d6c3e 9316 redrawtags $newhead
6fb735ae
PM
9317 }
9318 if {$showlocalchanges} {
9319 doshowlocalchanges
9320 }
706d6c3e 9321 return 0
6fb735ae
PM
9322}
9323
10299152
PM
9324# context menu for a head
9325proc headmenu {x y id head} {
00609463 9326 global headmenuid headmenuhead headctxmenu mainhead
10299152 9327
bb3edc8b 9328 stopfinding
10299152
PM
9329 set headmenuid $id
9330 set headmenuhead $head
00609463 9331 set state normal
70a5fc44
SC
9332 if {[string match "remotes/*" $head]} {
9333 set state disabled
9334 }
00609463
PM
9335 if {$head eq $mainhead} {
9336 set state disabled
9337 }
9338 $headctxmenu entryconfigure 0 -state $state
9339 $headctxmenu entryconfigure 1 -state $state
10299152
PM
9340 tk_popup $headctxmenu $x $y
9341}
9342
9343proc cobranch {} {
c11ff120 9344 global headmenuid headmenuhead headids
cdc8429c 9345 global showlocalchanges
10299152
PM
9346
9347 # check the tree is clean first??
d990cedf 9348 nowbusy checkout [mc "Checking out"]
10299152 9349 update
219ea3a9 9350 dohidelocalchanges
10299152 9351 if {[catch {
08ba820f 9352 set fd [open [list | git checkout $headmenuhead 2>@1] r]
10299152
PM
9353 } err]} {
9354 notbusy checkout
9355 error_popup $err
08ba820f
PM
9356 if {$showlocalchanges} {
9357 dodiffindex
9358 }
10299152 9359 } else {
08ba820f
PM
9360 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9361 }
9362}
9363
9364proc readcheckoutstat {fd newhead newheadid} {
9365 global mainhead mainheadid headids showlocalchanges progresscoords
cdc8429c 9366 global viewmainheadid curview
08ba820f
PM
9367
9368 if {[gets $fd line] >= 0} {
9369 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9370 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9371 adjustprogress
10299152 9372 }
08ba820f
PM
9373 return 1
9374 }
9375 set progresscoords {0 0}
9376 adjustprogress
9377 notbusy checkout
9378 if {[catch {close $fd} err]} {
9379 error_popup $err
9380 }
c11ff120 9381 set oldmainid $mainheadid
08ba820f
PM
9382 set mainhead $newhead
9383 set mainheadid $newheadid
cdc8429c 9384 set viewmainheadid($curview) $newheadid
c11ff120 9385 redrawtags $oldmainid
08ba820f
PM
9386 redrawtags $newheadid
9387 selbyid $newheadid
6fb735ae
PM
9388 if {$showlocalchanges} {
9389 dodiffindex
10299152
PM
9390 }
9391}
9392
9393proc rmbranch {} {
e11f1233 9394 global headmenuid headmenuhead mainhead
b1054ac9 9395 global idheads
10299152
PM
9396
9397 set head $headmenuhead
9398 set id $headmenuid
00609463 9399 # this check shouldn't be needed any more...
10299152 9400 if {$head eq $mainhead} {
d990cedf 9401 error_popup [mc "Cannot delete the currently checked-out branch"]
10299152
PM
9402 return
9403 }
e11f1233 9404 set dheads [descheads $id]
d7b16113 9405 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
10299152 9406 # the stuff on this branch isn't on any other branch
d990cedf
CS
9407 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9408 branch.\nReally delete branch %s?" $head $head]]} return
10299152
PM
9409 }
9410 nowbusy rmbranch
9411 update
9412 if {[catch {exec git branch -D $head} err]} {
9413 notbusy rmbranch
9414 error_popup $err
9415 return
9416 }
e11f1233 9417 removehead $id $head
ca6d8f58 9418 removedhead $id $head
10299152
PM
9419 redrawtags $id
9420 notbusy rmbranch
e11f1233 9421 dispneartags 0
887c996e
PM
9422 run refill_reflist
9423}
9424
9425# Display a list of tags and heads
9426proc showrefs {} {
d93f1713 9427 global showrefstop bgcolor fgcolor selectbgcolor NS
9c311b32 9428 global bglist fglist reflistfilter reflist maincursor
887c996e
PM
9429
9430 set top .showrefs
9431 set showrefstop $top
9432 if {[winfo exists $top]} {
9433 raise $top
9434 refill_reflist
9435 return
9436 }
d93f1713 9437 ttk_toplevel $top
d990cedf 9438 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
e7d64008 9439 make_transient $top .
887c996e 9440 text $top.list -background $bgcolor -foreground $fgcolor \
9c311b32 9441 -selectbackground $selectbgcolor -font mainfont \
887c996e
PM
9442 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9443 -width 30 -height 20 -cursor $maincursor \
9444 -spacing1 1 -spacing3 1 -state disabled
9445 $top.list tag configure highlight -background $selectbgcolor
9446 lappend bglist $top.list
9447 lappend fglist $top.list
d93f1713
PT
9448 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9449 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
887c996e
PM
9450 grid $top.list $top.ysb -sticky nsew
9451 grid $top.xsb x -sticky ew
d93f1713
PT
9452 ${NS}::frame $top.f
9453 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9454 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
887c996e
PM
9455 set reflistfilter "*"
9456 trace add variable reflistfilter write reflistfilter_change
9457 pack $top.f.e -side right -fill x -expand 1
9458 pack $top.f.l -side left
9459 grid $top.f - -sticky ew -pady 2
d93f1713 9460 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
76f15947 9461 bind $top <Key-Escape> [list destroy $top]
887c996e
PM
9462 grid $top.close -
9463 grid columnconfigure $top 0 -weight 1
9464 grid rowconfigure $top 0 -weight 1
9465 bind $top.list <1> {break}
9466 bind $top.list <B1-Motion> {break}
9467 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9468 set reflist {}
9469 refill_reflist
9470}
9471
9472proc sel_reflist {w x y} {
9473 global showrefstop reflist headids tagids otherrefids
9474
9475 if {![winfo exists $showrefstop]} return
9476 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9477 set ref [lindex $reflist [expr {$l-1}]]
9478 set n [lindex $ref 0]
9479 switch -- [lindex $ref 1] {
9480 "H" {selbyid $headids($n)}
9481 "T" {selbyid $tagids($n)}
9482 "o" {selbyid $otherrefids($n)}
9483 }
9484 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9485}
9486
9487proc unsel_reflist {} {
9488 global showrefstop
9489
9490 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9491 $showrefstop.list tag remove highlight 0.0 end
9492}
9493
9494proc reflistfilter_change {n1 n2 op} {
9495 global reflistfilter
9496
9497 after cancel refill_reflist
9498 after 200 refill_reflist
9499}
9500
9501proc refill_reflist {} {
9502 global reflist reflistfilter showrefstop headids tagids otherrefids
d375ef9b 9503 global curview
887c996e
PM
9504
9505 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9506 set refs {}
9507 foreach n [array names headids] {
9508 if {[string match $reflistfilter $n]} {
7fcc92bf 9509 if {[commitinview $headids($n) $curview]} {
887c996e
PM
9510 lappend refs [list $n H]
9511 } else {
d375ef9b 9512 interestedin $headids($n) {run refill_reflist}
887c996e
PM
9513 }
9514 }
9515 }
9516 foreach n [array names tagids] {
9517 if {[string match $reflistfilter $n]} {
7fcc92bf 9518 if {[commitinview $tagids($n) $curview]} {
887c996e
PM
9519 lappend refs [list $n T]
9520 } else {
d375ef9b 9521 interestedin $tagids($n) {run refill_reflist}
887c996e
PM
9522 }
9523 }
9524 }
9525 foreach n [array names otherrefids] {
9526 if {[string match $reflistfilter $n]} {
7fcc92bf 9527 if {[commitinview $otherrefids($n) $curview]} {
887c996e
PM
9528 lappend refs [list $n o]
9529 } else {
d375ef9b 9530 interestedin $otherrefids($n) {run refill_reflist}
887c996e
PM
9531 }
9532 }
9533 }
9534 set refs [lsort -index 0 $refs]
9535 if {$refs eq $reflist} return
9536
9537 # Update the contents of $showrefstop.list according to the
9538 # differences between $reflist (old) and $refs (new)
9539 $showrefstop.list conf -state normal
9540 $showrefstop.list insert end "\n"
9541 set i 0
9542 set j 0
9543 while {$i < [llength $reflist] || $j < [llength $refs]} {
9544 if {$i < [llength $reflist]} {
9545 if {$j < [llength $refs]} {
9546 set cmp [string compare [lindex $reflist $i 0] \
9547 [lindex $refs $j 0]]
9548 if {$cmp == 0} {
9549 set cmp [string compare [lindex $reflist $i 1] \
9550 [lindex $refs $j 1]]
9551 }
9552 } else {
9553 set cmp -1
9554 }
9555 } else {
9556 set cmp 1
9557 }
9558 switch -- $cmp {
9559 -1 {
9560 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9561 incr i
9562 }
9563 0 {
9564 incr i
9565 incr j
9566 }
9567 1 {
9568 set l [expr {$j + 1}]
9569 $showrefstop.list image create $l.0 -align baseline \
9570 -image reficon-[lindex $refs $j 1] -padx 2
9571 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9572 incr j
9573 }
9574 }
9575 }
9576 set reflist $refs
9577 # delete last newline
9578 $showrefstop.list delete end-2c end-1c
9579 $showrefstop.list conf -state disabled
10299152
PM
9580}
9581
b8ab2e17
PM
9582# Stuff for finding nearby tags
9583proc getallcommits {} {
5cd15b6b
PM
9584 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9585 global idheads idtags idotherrefs allparents tagobjid
da616db5 9586 global gitdir
f1d83ba3 9587
a69b2d1a 9588 if {![info exists allcommits]} {
a69b2d1a
PM
9589 set nextarc 0
9590 set allcommits 0
9591 set seeds {}
5cd15b6b
PM
9592 set allcwait 0
9593 set cachedarcs 0
da616db5 9594 set allccache [file join $gitdir "gitk.cache"]
5cd15b6b
PM
9595 if {![catch {
9596 set f [open $allccache r]
9597 set allcwait 1
9598 getcache $f
9599 }]} return
a69b2d1a 9600 }
2d71bccc 9601
5cd15b6b
PM
9602 if {$allcwait} {
9603 return
9604 }
9605 set cmd [list | git rev-list --parents]
9606 set allcupdate [expr {$seeds ne {}}]
9607 if {!$allcupdate} {
9608 set ids "--all"
9609 } else {
9610 set refs [concat [array names idheads] [array names idtags] \
9611 [array names idotherrefs]]
9612 set ids {}
9613 set tagobjs {}
9614 foreach name [array names tagobjid] {
9615 lappend tagobjs $tagobjid($name)
9616 }
9617 foreach id [lsort -unique $refs] {
9618 if {![info exists allparents($id)] &&
9619 [lsearch -exact $tagobjs $id] < 0} {
9620 lappend ids $id
9621 }
9622 }
9623 if {$ids ne {}} {
9624 foreach id $seeds {
9625 lappend ids "^$id"
9626 }
9627 }
9628 }
9629 if {$ids ne {}} {
9630 set fd [open [concat $cmd $ids] r]
9631 fconfigure $fd -blocking 0
9632 incr allcommits
9633 nowbusy allcommits
9634 filerun $fd [list getallclines $fd]
9635 } else {
9636 dispneartags 0
2d71bccc 9637 }
e11f1233
PM
9638}
9639
9640# Since most commits have 1 parent and 1 child, we group strings of
9641# such commits into "arcs" joining branch/merge points (BMPs), which
9642# are commits that either don't have 1 parent or don't have 1 child.
9643#
9644# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9645# arcout(id) - outgoing arcs for BMP
9646# arcids(a) - list of IDs on arc including end but not start
9647# arcstart(a) - BMP ID at start of arc
9648# arcend(a) - BMP ID at end of arc
9649# growing(a) - arc a is still growing
9650# arctags(a) - IDs out of arcids (excluding end) that have tags
9651# archeads(a) - IDs out of arcids (excluding end) that have heads
9652# The start of an arc is at the descendent end, so "incoming" means
9653# coming from descendents, and "outgoing" means going towards ancestors.
9654
9655proc getallclines {fd} {
5cd15b6b 9656 global allparents allchildren idtags idheads nextarc
e11f1233 9657 global arcnos arcids arctags arcout arcend arcstart archeads growing
5cd15b6b 9658 global seeds allcommits cachedarcs allcupdate
d93f1713 9659
e11f1233 9660 set nid 0
7eb3cb9c 9661 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
e11f1233
PM
9662 set id [lindex $line 0]
9663 if {[info exists allparents($id)]} {
9664 # seen it already
9665 continue
9666 }
5cd15b6b 9667 set cachedarcs 0
e11f1233
PM
9668 set olds [lrange $line 1 end]
9669 set allparents($id) $olds
9670 if {![info exists allchildren($id)]} {
9671 set allchildren($id) {}
9672 set arcnos($id) {}
9673 lappend seeds $id
9674 } else {
9675 set a $arcnos($id)
9676 if {[llength $olds] == 1 && [llength $a] == 1} {
9677 lappend arcids($a) $id
9678 if {[info exists idtags($id)]} {
9679 lappend arctags($a) $id
b8ab2e17 9680 }
e11f1233
PM
9681 if {[info exists idheads($id)]} {
9682 lappend archeads($a) $id
9683 }
9684 if {[info exists allparents($olds)]} {
9685 # seen parent already
9686 if {![info exists arcout($olds)]} {
9687 splitarc $olds
9688 }
9689 lappend arcids($a) $olds
9690 set arcend($a) $olds
9691 unset growing($a)
9692 }
9693 lappend allchildren($olds) $id
9694 lappend arcnos($olds) $a
9695 continue
9696 }
9697 }
e11f1233
PM
9698 foreach a $arcnos($id) {
9699 lappend arcids($a) $id
9700 set arcend($a) $id
9701 unset growing($a)
9702 }
9703
9704 set ao {}
9705 foreach p $olds {
9706 lappend allchildren($p) $id
9707 set a [incr nextarc]
9708 set arcstart($a) $id
9709 set archeads($a) {}
9710 set arctags($a) {}
9711 set archeads($a) {}
9712 set arcids($a) {}
9713 lappend ao $a
9714 set growing($a) 1
9715 if {[info exists allparents($p)]} {
9716 # seen it already, may need to make a new branch
9717 if {![info exists arcout($p)]} {
9718 splitarc $p
9719 }
9720 lappend arcids($a) $p
9721 set arcend($a) $p
9722 unset growing($a)
9723 }
9724 lappend arcnos($p) $a
9725 }
9726 set arcout($id) $ao
f1d83ba3 9727 }
f3326b66
PM
9728 if {$nid > 0} {
9729 global cached_dheads cached_dtags cached_atags
9730 catch {unset cached_dheads}
9731 catch {unset cached_dtags}
9732 catch {unset cached_atags}
9733 }
7eb3cb9c
PM
9734 if {![eof $fd]} {
9735 return [expr {$nid >= 1000? 2: 1}]
9736 }
5cd15b6b
PM
9737 set cacheok 1
9738 if {[catch {
9739 fconfigure $fd -blocking 1
9740 close $fd
9741 } err]} {
9742 # got an error reading the list of commits
9743 # if we were updating, try rereading the whole thing again
9744 if {$allcupdate} {
9745 incr allcommits -1
9746 dropcache $err
9747 return
9748 }
d990cedf 9749 error_popup "[mc "Error reading commit topology information;\
5cd15b6b 9750 branch and preceding/following tag information\
d990cedf 9751 will be incomplete."]\n($err)"
5cd15b6b
PM
9752 set cacheok 0
9753 }
e11f1233
PM
9754 if {[incr allcommits -1] == 0} {
9755 notbusy allcommits
5cd15b6b
PM
9756 if {$cacheok} {
9757 run savecache
9758 }
e11f1233
PM
9759 }
9760 dispneartags 0
7eb3cb9c 9761 return 0
b8ab2e17
PM
9762}
9763
e11f1233
PM
9764proc recalcarc {a} {
9765 global arctags archeads arcids idtags idheads
b8ab2e17 9766
e11f1233
PM
9767 set at {}
9768 set ah {}
9769 foreach id [lrange $arcids($a) 0 end-1] {
9770 if {[info exists idtags($id)]} {
9771 lappend at $id
9772 }
9773 if {[info exists idheads($id)]} {
9774 lappend ah $id
b8ab2e17 9775 }
f1d83ba3 9776 }
e11f1233
PM
9777 set arctags($a) $at
9778 set archeads($a) $ah
b8ab2e17
PM
9779}
9780
e11f1233 9781proc splitarc {p} {
5cd15b6b 9782 global arcnos arcids nextarc arctags archeads idtags idheads
e11f1233 9783 global arcstart arcend arcout allparents growing
cec7bece 9784
e11f1233
PM
9785 set a $arcnos($p)
9786 if {[llength $a] != 1} {
9787 puts "oops splitarc called but [llength $a] arcs already"
9788 return
9789 }
9790 set a [lindex $a 0]
9791 set i [lsearch -exact $arcids($a) $p]
9792 if {$i < 0} {
9793 puts "oops splitarc $p not in arc $a"
9794 return
9795 }
9796 set na [incr nextarc]
9797 if {[info exists arcend($a)]} {
9798 set arcend($na) $arcend($a)
9799 } else {
9800 set l [lindex $allparents([lindex $arcids($a) end]) 0]
9801 set j [lsearch -exact $arcnos($l) $a]
9802 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9803 }
9804 set tail [lrange $arcids($a) [expr {$i+1}] end]
9805 set arcids($a) [lrange $arcids($a) 0 $i]
9806 set arcend($a) $p
9807 set arcstart($na) $p
9808 set arcout($p) $na
9809 set arcids($na) $tail
9810 if {[info exists growing($a)]} {
9811 set growing($na) 1
9812 unset growing($a)
9813 }
e11f1233
PM
9814
9815 foreach id $tail {
9816 if {[llength $arcnos($id)] == 1} {
9817 set arcnos($id) $na
cec7bece 9818 } else {
e11f1233
PM
9819 set j [lsearch -exact $arcnos($id) $a]
9820 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
cec7bece 9821 }
e11f1233
PM
9822 }
9823
9824 # reconstruct tags and heads lists
9825 if {$arctags($a) ne {} || $archeads($a) ne {}} {
9826 recalcarc $a
9827 recalcarc $na
9828 } else {
9829 set arctags($na) {}
9830 set archeads($na) {}
9831 }
9832}
9833
9834# Update things for a new commit added that is a child of one
9835# existing commit. Used when cherry-picking.
9836proc addnewchild {id p} {
5cd15b6b 9837 global allparents allchildren idtags nextarc
e11f1233 9838 global arcnos arcids arctags arcout arcend arcstart archeads growing
719c2b9d 9839 global seeds allcommits
e11f1233 9840
3ebba3c7 9841 if {![info exists allcommits] || ![info exists arcnos($p)]} return
e11f1233
PM
9842 set allparents($id) [list $p]
9843 set allchildren($id) {}
9844 set arcnos($id) {}
9845 lappend seeds $id
e11f1233
PM
9846 lappend allchildren($p) $id
9847 set a [incr nextarc]
9848 set arcstart($a) $id
9849 set archeads($a) {}
9850 set arctags($a) {}
9851 set arcids($a) [list $p]
9852 set arcend($a) $p
9853 if {![info exists arcout($p)]} {
9854 splitarc $p
9855 }
9856 lappend arcnos($p) $a
9857 set arcout($id) [list $a]
9858}
9859
5cd15b6b
PM
9860# This implements a cache for the topology information.
9861# The cache saves, for each arc, the start and end of the arc,
9862# the ids on the arc, and the outgoing arcs from the end.
9863proc readcache {f} {
9864 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9865 global idtags idheads allparents cachedarcs possible_seeds seeds growing
9866 global allcwait
9867
9868 set a $nextarc
9869 set lim $cachedarcs
9870 if {$lim - $a > 500} {
9871 set lim [expr {$a + 500}]
9872 }
9873 if {[catch {
9874 if {$a == $lim} {
9875 # finish reading the cache and setting up arctags, etc.
9876 set line [gets $f]
9877 if {$line ne "1"} {error "bad final version"}
9878 close $f
9879 foreach id [array names idtags] {
9880 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9881 [llength $allparents($id)] == 1} {
9882 set a [lindex $arcnos($id) 0]
9883 if {$arctags($a) eq {}} {
9884 recalcarc $a
9885 }
9886 }
9887 }
9888 foreach id [array names idheads] {
9889 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9890 [llength $allparents($id)] == 1} {
9891 set a [lindex $arcnos($id) 0]
9892 if {$archeads($a) eq {}} {
9893 recalcarc $a
9894 }
9895 }
9896 }
9897 foreach id [lsort -unique $possible_seeds] {
9898 if {$arcnos($id) eq {}} {
9899 lappend seeds $id
9900 }
9901 }
9902 set allcwait 0
9903 } else {
9904 while {[incr a] <= $lim} {
9905 set line [gets $f]
9906 if {[llength $line] != 3} {error "bad line"}
9907 set s [lindex $line 0]
9908 set arcstart($a) $s
9909 lappend arcout($s) $a
9910 if {![info exists arcnos($s)]} {
9911 lappend possible_seeds $s
9912 set arcnos($s) {}
9913 }
9914 set e [lindex $line 1]
9915 if {$e eq {}} {
9916 set growing($a) 1
9917 } else {
9918 set arcend($a) $e
9919 if {![info exists arcout($e)]} {
9920 set arcout($e) {}
9921 }
9922 }
9923 set arcids($a) [lindex $line 2]
9924 foreach id $arcids($a) {
9925 lappend allparents($s) $id
9926 set s $id
9927 lappend arcnos($id) $a
9928 }
9929 if {![info exists allparents($s)]} {
9930 set allparents($s) {}
9931 }
9932 set arctags($a) {}
9933 set archeads($a) {}
9934 }
9935 set nextarc [expr {$a - 1}]
9936 }
9937 } err]} {
9938 dropcache $err
9939 return 0
9940 }
9941 if {!$allcwait} {
9942 getallcommits
9943 }
9944 return $allcwait
9945}
9946
9947proc getcache {f} {
9948 global nextarc cachedarcs possible_seeds
9949
9950 if {[catch {
9951 set line [gets $f]
9952 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9953 # make sure it's an integer
9954 set cachedarcs [expr {int([lindex $line 1])}]
9955 if {$cachedarcs < 0} {error "bad number of arcs"}
9956 set nextarc 0
9957 set possible_seeds {}
9958 run readcache $f
9959 } err]} {
9960 dropcache $err
9961 }
9962 return 0
9963}
9964
9965proc dropcache {err} {
9966 global allcwait nextarc cachedarcs seeds
9967
9968 #puts "dropping cache ($err)"
9969 foreach v {arcnos arcout arcids arcstart arcend growing \
9970 arctags archeads allparents allchildren} {
9971 global $v
9972 catch {unset $v}
9973 }
9974 set allcwait 0
9975 set nextarc 0
9976 set cachedarcs 0
9977 set seeds {}
9978 getallcommits
9979}
9980
9981proc writecache {f} {
9982 global cachearc cachedarcs allccache
9983 global arcstart arcend arcnos arcids arcout
9984
9985 set a $cachearc
9986 set lim $cachedarcs
9987 if {$lim - $a > 1000} {
9988 set lim [expr {$a + 1000}]
9989 }
9990 if {[catch {
9991 while {[incr a] <= $lim} {
9992 if {[info exists arcend($a)]} {
9993 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9994 } else {
9995 puts $f [list $arcstart($a) {} $arcids($a)]
9996 }
9997 }
9998 } err]} {
9999 catch {close $f}
10000 catch {file delete $allccache}
10001 #puts "writing cache failed ($err)"
10002 return 0
10003 }
10004 set cachearc [expr {$a - 1}]
10005 if {$a > $cachedarcs} {
10006 puts $f "1"
10007 close $f
10008 return 0
10009 }
10010 return 1
10011}
10012
10013proc savecache {} {
10014 global nextarc cachedarcs cachearc allccache
10015
10016 if {$nextarc == $cachedarcs} return
10017 set cachearc 0
10018 set cachedarcs $nextarc
10019 catch {
10020 set f [open $allccache w]
10021 puts $f [list 1 $cachedarcs]
10022 run writecache $f
10023 }
10024}
10025
e11f1233
PM
10026# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10027# or 0 if neither is true.
10028proc anc_or_desc {a b} {
10029 global arcout arcstart arcend arcnos cached_isanc
10030
10031 if {$arcnos($a) eq $arcnos($b)} {
10032 # Both are on the same arc(s); either both are the same BMP,
10033 # or if one is not a BMP, the other is also not a BMP or is
10034 # the BMP at end of the arc (and it only has 1 incoming arc).
69c0b5d2
PM
10035 # Or both can be BMPs with no incoming arcs.
10036 if {$a eq $b || $arcnos($a) eq {}} {
e11f1233 10037 return 0
cec7bece 10038 }
e11f1233
PM
10039 # assert {[llength $arcnos($a)] == 1}
10040 set arc [lindex $arcnos($a) 0]
10041 set i [lsearch -exact $arcids($arc) $a]
10042 set j [lsearch -exact $arcids($arc) $b]
10043 if {$i < 0 || $i > $j} {
10044 return 1
10045 } else {
10046 return -1
cec7bece
PM
10047 }
10048 }
e11f1233
PM
10049
10050 if {![info exists arcout($a)]} {
10051 set arc [lindex $arcnos($a) 0]
10052 if {[info exists arcend($arc)]} {
10053 set aend $arcend($arc)
10054 } else {
10055 set aend {}
cec7bece 10056 }
e11f1233
PM
10057 set a $arcstart($arc)
10058 } else {
10059 set aend $a
10060 }
10061 if {![info exists arcout($b)]} {
10062 set arc [lindex $arcnos($b) 0]
10063 if {[info exists arcend($arc)]} {
10064 set bend $arcend($arc)
10065 } else {
10066 set bend {}
cec7bece 10067 }
e11f1233
PM
10068 set b $arcstart($arc)
10069 } else {
10070 set bend $b
cec7bece 10071 }
e11f1233
PM
10072 if {$a eq $bend} {
10073 return 1
10074 }
10075 if {$b eq $aend} {
10076 return -1
10077 }
10078 if {[info exists cached_isanc($a,$bend)]} {
10079 if {$cached_isanc($a,$bend)} {
10080 return 1
10081 }
10082 }
10083 if {[info exists cached_isanc($b,$aend)]} {
10084 if {$cached_isanc($b,$aend)} {
10085 return -1
10086 }
10087 if {[info exists cached_isanc($a,$bend)]} {
10088 return 0
10089 }
cec7bece 10090 }
cec7bece 10091
e11f1233
PM
10092 set todo [list $a $b]
10093 set anc($a) a
10094 set anc($b) b
10095 for {set i 0} {$i < [llength $todo]} {incr i} {
10096 set x [lindex $todo $i]
10097 if {$anc($x) eq {}} {
10098 continue
10099 }
10100 foreach arc $arcnos($x) {
10101 set xd $arcstart($arc)
10102 if {$xd eq $bend} {
10103 set cached_isanc($a,$bend) 1
10104 set cached_isanc($b,$aend) 0
10105 return 1
10106 } elseif {$xd eq $aend} {
10107 set cached_isanc($b,$aend) 1
10108 set cached_isanc($a,$bend) 0
10109 return -1
10110 }
10111 if {![info exists anc($xd)]} {
10112 set anc($xd) $anc($x)
10113 lappend todo $xd
10114 } elseif {$anc($xd) ne $anc($x)} {
10115 set anc($xd) {}
10116 }
10117 }
10118 }
10119 set cached_isanc($a,$bend) 0
10120 set cached_isanc($b,$aend) 0
10121 return 0
10122}
b8ab2e17 10123
e11f1233
PM
10124# This identifies whether $desc has an ancestor that is
10125# a growing tip of the graph and which is not an ancestor of $anc
10126# and returns 0 if so and 1 if not.
10127# If we subsequently discover a tag on such a growing tip, and that
10128# turns out to be a descendent of $anc (which it could, since we
10129# don't necessarily see children before parents), then $desc
10130# isn't a good choice to display as a descendent tag of
10131# $anc (since it is the descendent of another tag which is
10132# a descendent of $anc). Similarly, $anc isn't a good choice to
10133# display as a ancestor tag of $desc.
10134#
10135proc is_certain {desc anc} {
10136 global arcnos arcout arcstart arcend growing problems
10137
10138 set certain {}
10139 if {[llength $arcnos($anc)] == 1} {
10140 # tags on the same arc are certain
10141 if {$arcnos($desc) eq $arcnos($anc)} {
10142 return 1
b8ab2e17 10143 }
e11f1233
PM
10144 if {![info exists arcout($anc)]} {
10145 # if $anc is partway along an arc, use the start of the arc instead
10146 set a [lindex $arcnos($anc) 0]
10147 set anc $arcstart($a)
b8ab2e17 10148 }
e11f1233
PM
10149 }
10150 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10151 set x $desc
10152 } else {
10153 set a [lindex $arcnos($desc) 0]
10154 set x $arcend($a)
10155 }
10156 if {$x == $anc} {
10157 return 1
10158 }
10159 set anclist [list $x]
10160 set dl($x) 1
10161 set nnh 1
10162 set ngrowanc 0
10163 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10164 set x [lindex $anclist $i]
10165 if {$dl($x)} {
10166 incr nnh -1
10167 }
10168 set done($x) 1
10169 foreach a $arcout($x) {
10170 if {[info exists growing($a)]} {
10171 if {![info exists growanc($x)] && $dl($x)} {
10172 set growanc($x) 1
10173 incr ngrowanc
10174 }
10175 } else {
10176 set y $arcend($a)
10177 if {[info exists dl($y)]} {
10178 if {$dl($y)} {
10179 if {!$dl($x)} {
10180 set dl($y) 0
10181 if {![info exists done($y)]} {
10182 incr nnh -1
10183 }
10184 if {[info exists growanc($x)]} {
10185 incr ngrowanc -1
10186 }
10187 set xl [list $y]
10188 for {set k 0} {$k < [llength $xl]} {incr k} {
10189 set z [lindex $xl $k]
10190 foreach c $arcout($z) {
10191 if {[info exists arcend($c)]} {
10192 set v $arcend($c)
10193 if {[info exists dl($v)] && $dl($v)} {
10194 set dl($v) 0
10195 if {![info exists done($v)]} {
10196 incr nnh -1
10197 }
10198 if {[info exists growanc($v)]} {
10199 incr ngrowanc -1
10200 }
10201 lappend xl $v
10202 }
10203 }
10204 }
10205 }
10206 }
10207 }
10208 } elseif {$y eq $anc || !$dl($x)} {
10209 set dl($y) 0
10210 lappend anclist $y
10211 } else {
10212 set dl($y) 1
10213 lappend anclist $y
10214 incr nnh
10215 }
10216 }
b8ab2e17
PM
10217 }
10218 }
e11f1233
PM
10219 foreach x [array names growanc] {
10220 if {$dl($x)} {
10221 return 0
b8ab2e17 10222 }
7eb3cb9c 10223 return 0
b8ab2e17 10224 }
e11f1233 10225 return 1
b8ab2e17
PM
10226}
10227
e11f1233
PM
10228proc validate_arctags {a} {
10229 global arctags idtags
b8ab2e17 10230
e11f1233
PM
10231 set i -1
10232 set na $arctags($a)
10233 foreach id $arctags($a) {
10234 incr i
10235 if {![info exists idtags($id)]} {
10236 set na [lreplace $na $i $i]
10237 incr i -1
10238 }
10239 }
10240 set arctags($a) $na
10241}
10242
10243proc validate_archeads {a} {
10244 global archeads idheads
10245
10246 set i -1
10247 set na $archeads($a)
10248 foreach id $archeads($a) {
10249 incr i
10250 if {![info exists idheads($id)]} {
10251 set na [lreplace $na $i $i]
10252 incr i -1
10253 }
10254 }
10255 set archeads($a) $na
10256}
10257
10258# Return the list of IDs that have tags that are descendents of id,
10259# ignoring IDs that are descendents of IDs already reported.
10260proc desctags {id} {
10261 global arcnos arcstart arcids arctags idtags allparents
10262 global growing cached_dtags
10263
10264 if {![info exists allparents($id)]} {
10265 return {}
10266 }
10267 set t1 [clock clicks -milliseconds]
10268 set argid $id
10269 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10270 # part-way along an arc; check that arc first
10271 set a [lindex $arcnos($id) 0]
10272 if {$arctags($a) ne {}} {
10273 validate_arctags $a
10274 set i [lsearch -exact $arcids($a) $id]
10275 set tid {}
10276 foreach t $arctags($a) {
10277 set j [lsearch -exact $arcids($a) $t]
10278 if {$j >= $i} break
10279 set tid $t
b8ab2e17 10280 }
e11f1233
PM
10281 if {$tid ne {}} {
10282 return $tid
b8ab2e17
PM
10283 }
10284 }
e11f1233
PM
10285 set id $arcstart($a)
10286 if {[info exists idtags($id)]} {
10287 return $id
10288 }
10289 }
10290 if {[info exists cached_dtags($id)]} {
10291 return $cached_dtags($id)
10292 }
10293
10294 set origid $id
10295 set todo [list $id]
10296 set queued($id) 1
10297 set nc 1
10298 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10299 set id [lindex $todo $i]
10300 set done($id) 1
10301 set ta [info exists hastaggedancestor($id)]
10302 if {!$ta} {
10303 incr nc -1
10304 }
10305 # ignore tags on starting node
10306 if {!$ta && $i > 0} {
10307 if {[info exists idtags($id)]} {
10308 set tagloc($id) $id
10309 set ta 1
10310 } elseif {[info exists cached_dtags($id)]} {
10311 set tagloc($id) $cached_dtags($id)
10312 set ta 1
10313 }
10314 }
10315 foreach a $arcnos($id) {
10316 set d $arcstart($a)
10317 if {!$ta && $arctags($a) ne {}} {
10318 validate_arctags $a
10319 if {$arctags($a) ne {}} {
10320 lappend tagloc($id) [lindex $arctags($a) end]
10321 }
10322 }
10323 if {$ta || $arctags($a) ne {}} {
10324 set tomark [list $d]
10325 for {set j 0} {$j < [llength $tomark]} {incr j} {
10326 set dd [lindex $tomark $j]
10327 if {![info exists hastaggedancestor($dd)]} {
10328 if {[info exists done($dd)]} {
10329 foreach b $arcnos($dd) {
10330 lappend tomark $arcstart($b)
10331 }
10332 if {[info exists tagloc($dd)]} {
10333 unset tagloc($dd)
10334 }
10335 } elseif {[info exists queued($dd)]} {
10336 incr nc -1
10337 }
10338 set hastaggedancestor($dd) 1
10339 }
10340 }
10341 }
10342 if {![info exists queued($d)]} {
10343 lappend todo $d
10344 set queued($d) 1
10345 if {![info exists hastaggedancestor($d)]} {
10346 incr nc
10347 }
10348 }
b8ab2e17 10349 }
f1d83ba3 10350 }
e11f1233
PM
10351 set tags {}
10352 foreach id [array names tagloc] {
10353 if {![info exists hastaggedancestor($id)]} {
10354 foreach t $tagloc($id) {
10355 if {[lsearch -exact $tags $t] < 0} {
10356 lappend tags $t
10357 }
10358 }
10359 }
10360 }
10361 set t2 [clock clicks -milliseconds]
10362 set loopix $i
f1d83ba3 10363
e11f1233
PM
10364 # remove tags that are descendents of other tags
10365 for {set i 0} {$i < [llength $tags]} {incr i} {
10366 set a [lindex $tags $i]
10367 for {set j 0} {$j < $i} {incr j} {
10368 set b [lindex $tags $j]
10369 set r [anc_or_desc $a $b]
10370 if {$r == 1} {
10371 set tags [lreplace $tags $j $j]
10372 incr j -1
10373 incr i -1
10374 } elseif {$r == -1} {
10375 set tags [lreplace $tags $i $i]
10376 incr i -1
10377 break
ceadfe90
PM
10378 }
10379 }
10380 }
10381
e11f1233
PM
10382 if {[array names growing] ne {}} {
10383 # graph isn't finished, need to check if any tag could get
10384 # eclipsed by another tag coming later. Simply ignore any
10385 # tags that could later get eclipsed.
10386 set ctags {}
10387 foreach t $tags {
10388 if {[is_certain $t $origid]} {
10389 lappend ctags $t
10390 }
ceadfe90 10391 }
e11f1233
PM
10392 if {$tags eq $ctags} {
10393 set cached_dtags($origid) $tags
10394 } else {
10395 set tags $ctags
ceadfe90 10396 }
e11f1233
PM
10397 } else {
10398 set cached_dtags($origid) $tags
10399 }
10400 set t3 [clock clicks -milliseconds]
10401 if {0 && $t3 - $t1 >= 100} {
10402 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10403 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
ceadfe90 10404 }
e11f1233
PM
10405 return $tags
10406}
ceadfe90 10407
e11f1233
PM
10408proc anctags {id} {
10409 global arcnos arcids arcout arcend arctags idtags allparents
10410 global growing cached_atags
10411
10412 if {![info exists allparents($id)]} {
10413 return {}
10414 }
10415 set t1 [clock clicks -milliseconds]
10416 set argid $id
10417 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10418 # part-way along an arc; check that arc first
10419 set a [lindex $arcnos($id) 0]
10420 if {$arctags($a) ne {}} {
10421 validate_arctags $a
10422 set i [lsearch -exact $arcids($a) $id]
10423 foreach t $arctags($a) {
10424 set j [lsearch -exact $arcids($a) $t]
10425 if {$j > $i} {
10426 return $t
10427 }
10428 }
ceadfe90 10429 }
e11f1233
PM
10430 if {![info exists arcend($a)]} {
10431 return {}
10432 }
10433 set id $arcend($a)
10434 if {[info exists idtags($id)]} {
10435 return $id
10436 }
10437 }
10438 if {[info exists cached_atags($id)]} {
10439 return $cached_atags($id)
10440 }
10441
10442 set origid $id
10443 set todo [list $id]
10444 set queued($id) 1
10445 set taglist {}
10446 set nc 1
10447 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10448 set id [lindex $todo $i]
10449 set done($id) 1
10450 set td [info exists hastaggeddescendent($id)]
10451 if {!$td} {
10452 incr nc -1
10453 }
10454 # ignore tags on starting node
10455 if {!$td && $i > 0} {
10456 if {[info exists idtags($id)]} {
10457 set tagloc($id) $id
10458 set td 1
10459 } elseif {[info exists cached_atags($id)]} {
10460 set tagloc($id) $cached_atags($id)
10461 set td 1
10462 }
10463 }
10464 foreach a $arcout($id) {
10465 if {!$td && $arctags($a) ne {}} {
10466 validate_arctags $a
10467 if {$arctags($a) ne {}} {
10468 lappend tagloc($id) [lindex $arctags($a) 0]
10469 }
10470 }
10471 if {![info exists arcend($a)]} continue
10472 set d $arcend($a)
10473 if {$td || $arctags($a) ne {}} {
10474 set tomark [list $d]
10475 for {set j 0} {$j < [llength $tomark]} {incr j} {
10476 set dd [lindex $tomark $j]
10477 if {![info exists hastaggeddescendent($dd)]} {
10478 if {[info exists done($dd)]} {
10479 foreach b $arcout($dd) {
10480 if {[info exists arcend($b)]} {
10481 lappend tomark $arcend($b)
10482 }
10483 }
10484 if {[info exists tagloc($dd)]} {
10485 unset tagloc($dd)
10486 }
10487 } elseif {[info exists queued($dd)]} {
10488 incr nc -1
10489 }
10490 set hastaggeddescendent($dd) 1
10491 }
10492 }
10493 }
10494 if {![info exists queued($d)]} {
10495 lappend todo $d
10496 set queued($d) 1
10497 if {![info exists hastaggeddescendent($d)]} {
10498 incr nc
10499 }
10500 }
10501 }
10502 }
10503 set t2 [clock clicks -milliseconds]
10504 set loopix $i
10505 set tags {}
10506 foreach id [array names tagloc] {
10507 if {![info exists hastaggeddescendent($id)]} {
10508 foreach t $tagloc($id) {
10509 if {[lsearch -exact $tags $t] < 0} {
10510 lappend tags $t
10511 }
10512 }
ceadfe90
PM
10513 }
10514 }
ceadfe90 10515
e11f1233
PM
10516 # remove tags that are ancestors of other tags
10517 for {set i 0} {$i < [llength $tags]} {incr i} {
10518 set a [lindex $tags $i]
10519 for {set j 0} {$j < $i} {incr j} {
10520 set b [lindex $tags $j]
10521 set r [anc_or_desc $a $b]
10522 if {$r == -1} {
10523 set tags [lreplace $tags $j $j]
10524 incr j -1
10525 incr i -1
10526 } elseif {$r == 1} {
10527 set tags [lreplace $tags $i $i]
10528 incr i -1
10529 break
10530 }
10531 }
10532 }
10533
10534 if {[array names growing] ne {}} {
10535 # graph isn't finished, need to check if any tag could get
10536 # eclipsed by another tag coming later. Simply ignore any
10537 # tags that could later get eclipsed.
10538 set ctags {}
10539 foreach t $tags {
10540 if {[is_certain $origid $t]} {
10541 lappend ctags $t
10542 }
10543 }
10544 if {$tags eq $ctags} {
10545 set cached_atags($origid) $tags
10546 } else {
10547 set tags $ctags
d6ac1a86 10548 }
e11f1233
PM
10549 } else {
10550 set cached_atags($origid) $tags
10551 }
10552 set t3 [clock clicks -milliseconds]
10553 if {0 && $t3 - $t1 >= 100} {
10554 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10555 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
d6ac1a86 10556 }
e11f1233 10557 return $tags
d6ac1a86
PM
10558}
10559
e11f1233
PM
10560# Return the list of IDs that have heads that are descendents of id,
10561# including id itself if it has a head.
10562proc descheads {id} {
10563 global arcnos arcstart arcids archeads idheads cached_dheads
10564 global allparents
ca6d8f58 10565
e11f1233
PM
10566 if {![info exists allparents($id)]} {
10567 return {}
10568 }
f3326b66 10569 set aret {}
e11f1233
PM
10570 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10571 # part-way along an arc; check it first
10572 set a [lindex $arcnos($id) 0]
10573 if {$archeads($a) ne {}} {
10574 validate_archeads $a
10575 set i [lsearch -exact $arcids($a) $id]
10576 foreach t $archeads($a) {
10577 set j [lsearch -exact $arcids($a) $t]
10578 if {$j > $i} break
f3326b66 10579 lappend aret $t
e11f1233 10580 }
ca6d8f58 10581 }
e11f1233 10582 set id $arcstart($a)
ca6d8f58 10583 }
e11f1233
PM
10584 set origid $id
10585 set todo [list $id]
10586 set seen($id) 1
f3326b66 10587 set ret {}
e11f1233
PM
10588 for {set i 0} {$i < [llength $todo]} {incr i} {
10589 set id [lindex $todo $i]
10590 if {[info exists cached_dheads($id)]} {
10591 set ret [concat $ret $cached_dheads($id)]
10592 } else {
10593 if {[info exists idheads($id)]} {
10594 lappend ret $id
10595 }
10596 foreach a $arcnos($id) {
10597 if {$archeads($a) ne {}} {
706d6c3e
PM
10598 validate_archeads $a
10599 if {$archeads($a) ne {}} {
10600 set ret [concat $ret $archeads($a)]
10601 }
e11f1233
PM
10602 }
10603 set d $arcstart($a)
10604 if {![info exists seen($d)]} {
10605 lappend todo $d
10606 set seen($d) 1
10607 }
10608 }
10299152 10609 }
10299152 10610 }
e11f1233
PM
10611 set ret [lsort -unique $ret]
10612 set cached_dheads($origid) $ret
f3326b66 10613 return [concat $ret $aret]
10299152
PM
10614}
10615
e11f1233
PM
10616proc addedtag {id} {
10617 global arcnos arcout cached_dtags cached_atags
ca6d8f58 10618
e11f1233
PM
10619 if {![info exists arcnos($id)]} return
10620 if {![info exists arcout($id)]} {
10621 recalcarc [lindex $arcnos($id) 0]
ca6d8f58 10622 }
e11f1233
PM
10623 catch {unset cached_dtags}
10624 catch {unset cached_atags}
ca6d8f58
PM
10625}
10626
e11f1233
PM
10627proc addedhead {hid head} {
10628 global arcnos arcout cached_dheads
10629
10630 if {![info exists arcnos($hid)]} return
10631 if {![info exists arcout($hid)]} {
10632 recalcarc [lindex $arcnos($hid) 0]
10633 }
10634 catch {unset cached_dheads}
10635}
10636
10637proc removedhead {hid head} {
10638 global cached_dheads
10639
10640 catch {unset cached_dheads}
10641}
10642
10643proc movedhead {hid head} {
10644 global arcnos arcout cached_dheads
cec7bece 10645
e11f1233
PM
10646 if {![info exists arcnos($hid)]} return
10647 if {![info exists arcout($hid)]} {
10648 recalcarc [lindex $arcnos($hid) 0]
cec7bece 10649 }
e11f1233
PM
10650 catch {unset cached_dheads}
10651}
10652
10653proc changedrefs {} {
587277fe 10654 global cached_dheads cached_dtags cached_atags cached_tagcontent
e11f1233
PM
10655 global arctags archeads arcnos arcout idheads idtags
10656
10657 foreach id [concat [array names idheads] [array names idtags]] {
10658 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10659 set a [lindex $arcnos($id) 0]
10660 if {![info exists donearc($a)]} {
10661 recalcarc $a
10662 set donearc($a) 1
10663 }
cec7bece
PM
10664 }
10665 }
587277fe 10666 catch {unset cached_tagcontent}
e11f1233
PM
10667 catch {unset cached_dtags}
10668 catch {unset cached_atags}
10669 catch {unset cached_dheads}
cec7bece
PM
10670}
10671
f1d83ba3 10672proc rereadrefs {} {
fc2a256f 10673 global idtags idheads idotherrefs mainheadid
f1d83ba3
PM
10674
10675 set refids [concat [array names idtags] \
10676 [array names idheads] [array names idotherrefs]]
10677 foreach id $refids {
10678 if {![info exists ref($id)]} {
10679 set ref($id) [listrefs $id]
10680 }
10681 }
fc2a256f 10682 set oldmainhead $mainheadid
f1d83ba3 10683 readrefs
cec7bece 10684 changedrefs
f1d83ba3
PM
10685 set refids [lsort -unique [concat $refids [array names idtags] \
10686 [array names idheads] [array names idotherrefs]]]
10687 foreach id $refids {
10688 set v [listrefs $id]
c11ff120 10689 if {![info exists ref($id)] || $ref($id) != $v} {
f1d83ba3
PM
10690 redrawtags $id
10691 }
10692 }
c11ff120
PM
10693 if {$oldmainhead ne $mainheadid} {
10694 redrawtags $oldmainhead
10695 redrawtags $mainheadid
10696 }
887c996e 10697 run refill_reflist
f1d83ba3
PM
10698}
10699
2e1ded44
JH
10700proc listrefs {id} {
10701 global idtags idheads idotherrefs
10702
10703 set x {}
10704 if {[info exists idtags($id)]} {
10705 set x $idtags($id)
10706 }
10707 set y {}
10708 if {[info exists idheads($id)]} {
10709 set y $idheads($id)
10710 }
10711 set z {}
10712 if {[info exists idotherrefs($id)]} {
10713 set z $idotherrefs($id)
10714 }
10715 return [list $x $y $z]
10716}
10717
106288cb 10718proc showtag {tag isnew} {
587277fe 10719 global ctext cached_tagcontent tagids linknum tagobjid
106288cb
PM
10720
10721 if {$isnew} {
354af6bd 10722 addtohistory [list showtag $tag 0] savectextpos
106288cb
PM
10723 }
10724 $ctext conf -state normal
3ea06f9f 10725 clear_ctext
32f1b3e4 10726 settabs 0
106288cb 10727 set linknum 0
587277fe 10728 if {![info exists cached_tagcontent($tag)]} {
62d3ea65 10729 catch {
587277fe 10730 set cached_tagcontent($tag) [exec git cat-file tag $tag]
62d3ea65
PM
10731 }
10732 }
587277fe
DA
10733 if {[info exists cached_tagcontent($tag)]} {
10734 set text $cached_tagcontent($tag)
106288cb 10735 } else {
d990cedf 10736 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
106288cb 10737 }
f1b86294 10738 appendwithlinks $text {}
a80e82f6 10739 maybe_scroll_ctext 1
106288cb 10740 $ctext conf -state disabled
7fcceed7 10741 init_flist {}
106288cb
PM
10742}
10743
1d10f36d
PM
10744proc doquit {} {
10745 global stopped
314f5de1
TA
10746 global gitktmpdir
10747
1d10f36d 10748 set stopped 100
b6047c5a 10749 savestuff .
1d10f36d 10750 destroy .
314f5de1
TA
10751
10752 if {[info exists gitktmpdir]} {
10753 catch {file delete -force $gitktmpdir}
10754 }
1d10f36d 10755}
1db95b00 10756
9a7558f3 10757proc mkfontdisp {font top which} {
d93f1713 10758 global fontattr fontpref $font NS use_ttk
9a7558f3
PM
10759
10760 set fontpref($font) [set $font]
d93f1713 10761 ${NS}::button $top.${font}but -text $which \
9a7558f3 10762 -command [list choosefont $font $which]
d93f1713 10763 ${NS}::label $top.$font -relief flat -font $font \
9a7558f3
PM
10764 -text $fontattr($font,family) -justify left
10765 grid x $top.${font}but $top.$font -sticky w
10766}
10767
10768proc choosefont {font which} {
10769 global fontparam fontlist fonttop fontattr
d93f1713 10770 global prefstop NS
9a7558f3
PM
10771
10772 set fontparam(which) $which
10773 set fontparam(font) $font
10774 set fontparam(family) [font actual $font -family]
10775 set fontparam(size) $fontattr($font,size)
10776 set fontparam(weight) $fontattr($font,weight)
10777 set fontparam(slant) $fontattr($font,slant)
10778 set top .gitkfont
10779 set fonttop $top
10780 if {![winfo exists $top]} {
10781 font create sample
10782 eval font config sample [font actual $font]
d93f1713 10783 ttk_toplevel $top
e7d64008 10784 make_transient $top $prefstop
d990cedf 10785 wm title $top [mc "Gitk font chooser"]
d93f1713 10786 ${NS}::label $top.l -textvariable fontparam(which)
9a7558f3
PM
10787 pack $top.l -side top
10788 set fontlist [lsort [font families]]
d93f1713 10789 ${NS}::frame $top.f
9a7558f3
PM
10790 listbox $top.f.fam -listvariable fontlist \
10791 -yscrollcommand [list $top.f.sb set]
10792 bind $top.f.fam <<ListboxSelect>> selfontfam
d93f1713 10793 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
9a7558f3
PM
10794 pack $top.f.sb -side right -fill y
10795 pack $top.f.fam -side left -fill both -expand 1
10796 pack $top.f -side top -fill both -expand 1
d93f1713 10797 ${NS}::frame $top.g
9a7558f3
PM
10798 spinbox $top.g.size -from 4 -to 40 -width 4 \
10799 -textvariable fontparam(size) \
10800 -validatecommand {string is integer -strict %s}
10801 checkbutton $top.g.bold -padx 5 \
d990cedf 10802 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9a7558f3
PM
10803 -variable fontparam(weight) -onvalue bold -offvalue normal
10804 checkbutton $top.g.ital -padx 5 \
d990cedf 10805 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9a7558f3
PM
10806 -variable fontparam(slant) -onvalue italic -offvalue roman
10807 pack $top.g.size $top.g.bold $top.g.ital -side left
10808 pack $top.g -side top
10809 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10810 -background white
10811 $top.c create text 100 25 -anchor center -text $which -font sample \
10812 -fill black -tags text
10813 bind $top.c <Configure> [list centertext $top.c]
10814 pack $top.c -side top -fill x
d93f1713
PT
10815 ${NS}::frame $top.buts
10816 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10817 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
76f15947
AG
10818 bind $top <Key-Return> fontok
10819 bind $top <Key-Escape> fontcan
9a7558f3
PM
10820 grid $top.buts.ok $top.buts.can
10821 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10822 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10823 pack $top.buts -side bottom -fill x
10824 trace add variable fontparam write chg_fontparam
10825 } else {
10826 raise $top
10827 $top.c itemconf text -text $which
10828 }
10829 set i [lsearch -exact $fontlist $fontparam(family)]
10830 if {$i >= 0} {
10831 $top.f.fam selection set $i
10832 $top.f.fam see $i
10833 }
10834}
10835
10836proc centertext {w} {
10837 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10838}
10839
10840proc fontok {} {
10841 global fontparam fontpref prefstop
10842
10843 set f $fontparam(font)
10844 set fontpref($f) [list $fontparam(family) $fontparam(size)]
10845 if {$fontparam(weight) eq "bold"} {
10846 lappend fontpref($f) "bold"
10847 }
10848 if {$fontparam(slant) eq "italic"} {
10849 lappend fontpref($f) "italic"
10850 }
39ddf99c 10851 set w $prefstop.notebook.fonts.$f
9a7558f3 10852 $w conf -text $fontparam(family) -font $fontpref($f)
d93f1713 10853
9a7558f3
PM
10854 fontcan
10855}
10856
10857proc fontcan {} {
10858 global fonttop fontparam
10859
10860 if {[info exists fonttop]} {
10861 catch {destroy $fonttop}
10862 catch {font delete sample}
10863 unset fonttop
10864 unset fontparam
10865 }
10866}
10867
d93f1713
PT
10868if {[package vsatisfies [package provide Tk] 8.6]} {
10869 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10870 # function to make use of it.
10871 proc choosefont {font which} {
10872 tk fontchooser configure -title $which -font $font \
10873 -command [list on_choosefont $font $which]
10874 tk fontchooser show
10875 }
10876 proc on_choosefont {font which newfont} {
10877 global fontparam
10878 puts stderr "$font $newfont"
10879 array set f [font actual $newfont]
10880 set fontparam(which) $which
10881 set fontparam(font) $font
10882 set fontparam(family) $f(-family)
10883 set fontparam(size) $f(-size)
10884 set fontparam(weight) $f(-weight)
10885 set fontparam(slant) $f(-slant)
10886 fontok
10887 }
10888}
10889
9a7558f3
PM
10890proc selfontfam {} {
10891 global fonttop fontparam
10892
10893 set i [$fonttop.f.fam curselection]
10894 if {$i ne {}} {
10895 set fontparam(family) [$fonttop.f.fam get $i]
10896 }
10897}
10898
10899proc chg_fontparam {v sub op} {
10900 global fontparam
10901
10902 font config sample -$sub $fontparam($sub)
10903}
10904
44acce0b
PT
10905# Create a property sheet tab page
10906proc create_prefs_page {w} {
10907 global NS
10908 set parent [join [lrange [split $w .] 0 end-1] .]
10909 if {[winfo class $parent] eq "TNotebook"} {
10910 ${NS}::frame $w
10911 } else {
10912 ${NS}::labelframe $w
10913 }
10914}
10915
10916proc prefspage_general {notebook} {
10917 global NS maxwidth maxgraphpct showneartags showlocalchanges
10918 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10919 global hideremotes want_ttk have_ttk
10920
10921 set page [create_prefs_page $notebook.general]
10922
10923 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10924 grid $page.ldisp - -sticky w -pady 10
10925 ${NS}::label $page.spacer -text " "
10926 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10927 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10928 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10929 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10930 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10931 grid x $page.maxpctl $page.maxpct -sticky w
10932 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10933 -variable showlocalchanges
10934 grid x $page.showlocal -sticky w
10935 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10936 -variable autoselect
10937 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10938 grid x $page.autoselect $page.autosellen -sticky w
10939 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10940 -variable hideremotes
10941 grid x $page.hideremotes -sticky w
10942
10943 ${NS}::label $page.ddisp -text [mc "Diff display options"]
10944 grid $page.ddisp - -sticky w -pady 10
10945 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10946 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10947 grid x $page.tabstopl $page.tabstop -sticky w
10948 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \
10949 -variable showneartags
10950 grid x $page.ntag -sticky w
10951 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10952 -variable limitdiffs
10953 grid x $page.ldiff -sticky w
10954 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10955 -variable perfile_attrs
10956 grid x $page.lattr -sticky w
10957
10958 ${NS}::entry $page.extdifft -textvariable extdifftool
10959 ${NS}::frame $page.extdifff
10960 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10961 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10962 pack $page.extdifff.l $page.extdifff.b -side left
10963 pack configure $page.extdifff.l -padx 10
10964 grid x $page.extdifff $page.extdifft -sticky ew
10965
10966 ${NS}::label $page.lgen -text [mc "General options"]
10967 grid $page.lgen - -sticky w -pady 10
10968 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10969 -text [mc "Use themed widgets"]
10970 if {$have_ttk} {
10971 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10972 } else {
10973 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
10974 }
10975 grid x $page.want_ttk $page.ttk_note -sticky w
10976 return $page
10977}
10978
10979proc prefspage_colors {notebook} {
10980 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10981
10982 set page [create_prefs_page $notebook.colors]
10983
10984 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
10985 grid $page.cdisp - -sticky w -pady 10
10986 label $page.ui -padx 40 -relief sunk -background $uicolor
10987 ${NS}::button $page.uibut -text [mc "Interface"] \
10988 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
10989 grid x $page.uibut $page.ui -sticky w
10990 label $page.bg -padx 40 -relief sunk -background $bgcolor
10991 ${NS}::button $page.bgbut -text [mc "Background"] \
10992 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
10993 grid x $page.bgbut $page.bg -sticky w
10994 label $page.fg -padx 40 -relief sunk -background $fgcolor
10995 ${NS}::button $page.fgbut -text [mc "Foreground"] \
10996 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
10997 grid x $page.fgbut $page.fg -sticky w
10998 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10999 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11000 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11001 [list $ctext tag conf d0 -foreground]]
11002 grid x $page.diffoldbut $page.diffold -sticky w
11003 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11004 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11005 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11006 [list $ctext tag conf dresult -foreground]]
11007 grid x $page.diffnewbut $page.diffnew -sticky w
11008 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11009 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11010 -command [list choosecolor diffcolors 2 $page.hunksep \
11011 [mc "diff hunk header"] \
11012 [list $ctext tag conf hunksep -foreground]]
11013 grid x $page.hunksepbut $page.hunksep -sticky w
11014 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11015 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11016 -command [list choosecolor markbgcolor {} $page.markbgsep \
11017 [mc "marked line background"] \
11018 [list $ctext tag conf omark -background]]
11019 grid x $page.markbgbut $page.markbgsep -sticky w
11020 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11021 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11022 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11023 grid x $page.selbgbut $page.selbgsep -sticky w
11024 return $page
11025}
11026
11027proc prefspage_fonts {notebook} {
11028 global NS
11029 set page [create_prefs_page $notebook.fonts]
11030 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11031 grid $page.cfont - -sticky w -pady 10
11032 mkfontdisp mainfont $page [mc "Main font"]
11033 mkfontdisp textfont $page [mc "Diff display font"]
11034 mkfontdisp uifont $page [mc "User interface font"]
11035 return $page
11036}
11037
712fcc08 11038proc doprefs {} {
d93f1713 11039 global maxwidth maxgraphpct use_ttk NS
219ea3a9 11040 global oldprefs prefstop showneartags showlocalchanges
5497f7a2 11041 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
21ac8a8d 11042 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
0cc08ff7 11043 global hideremotes want_ttk have_ttk
232475d3 11044
712fcc08
PM
11045 set top .gitkprefs
11046 set prefstop $top
11047 if {[winfo exists $top]} {
11048 raise $top
11049 return
757f17bc 11050 }
3de07118 11051 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
0cc08ff7 11052 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
712fcc08 11053 set oldprefs($v) [set $v]
232475d3 11054 }
d93f1713 11055 ttk_toplevel $top
d990cedf 11056 wm title $top [mc "Gitk preferences"]
e7d64008 11057 make_transient $top .
44acce0b
PT
11058
11059 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11060 set notebook [ttk::notebook $top.notebook]
0cc08ff7 11061 } else {
44acce0b
PT
11062 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11063 }
11064
11065 lappend pages [prefspage_general $notebook] [mc "General"]
11066 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11067 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
28cb7074 11068 set col 0
44acce0b
PT
11069 foreach {page title} $pages {
11070 if {$use_notebook} {
11071 $notebook add $page -text $title
11072 } else {
11073 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11074 -text $title -command [list raise $page]]
11075 $page configure -text $title
11076 grid $btn -row 0 -column [incr col] -sticky w
11077 grid $page -row 1 -column 0 -sticky news -columnspan 100
11078 }
11079 }
11080
11081 if {!$use_notebook} {
11082 grid columnconfigure $notebook 0 -weight 1
11083 grid rowconfigure $notebook 1 -weight 1
11084 raise [lindex $pages 0]
11085 }
11086
11087 grid $notebook -sticky news -padx 2 -pady 2
11088 grid rowconfigure $top 0 -weight 1
11089 grid columnconfigure $top 0 -weight 1
9a7558f3 11090
d93f1713
PT
11091 ${NS}::frame $top.buts
11092 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11093 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
76f15947
AG
11094 bind $top <Key-Return> prefsok
11095 bind $top <Key-Escape> prefscan
712fcc08
PM
11096 grid $top.buts.ok $top.buts.can
11097 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11098 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11099 grid $top.buts - - -pady 10 -sticky ew
d93f1713 11100 grid columnconfigure $top 2 -weight 1
44acce0b 11101 bind $top <Visibility> [list focus $top.buts.ok]
712fcc08
PM
11102}
11103
314f5de1
TA
11104proc choose_extdiff {} {
11105 global extdifftool
11106
b56e0a9a 11107 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
314f5de1
TA
11108 if {$prog ne {}} {
11109 set extdifftool $prog
11110 }
11111}
11112
f8a2c0d1
PM
11113proc choosecolor {v vi w x cmd} {
11114 global $v
11115
11116 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
d990cedf 11117 -title [mc "Gitk: choose color for %s" $x]]
f8a2c0d1
PM
11118 if {$c eq {}} return
11119 $w conf -background $c
11120 lset $v $vi $c
11121 eval $cmd $c
11122}
11123
60378c0c
ML
11124proc setselbg {c} {
11125 global bglist cflist
11126 foreach w $bglist {
11127 $w configure -selectbackground $c
11128 }
11129 $cflist tag configure highlight \
11130 -background [$cflist cget -selectbackground]
11131 allcanvs itemconf secsel -fill $c
11132}
11133
51a7e8b6
PM
11134# This sets the background color and the color scheme for the whole UI.
11135# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11136# if we don't specify one ourselves, which makes the checkbuttons and
11137# radiobuttons look bad. This chooses white for selectColor if the
11138# background color is light, or black if it is dark.
5497f7a2 11139proc setui {c} {
2e58c944 11140 if {[tk windowingsystem] eq "win32"} { return }
51a7e8b6
PM
11141 set bg [winfo rgb . $c]
11142 set selc black
11143 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11144 set selc white
11145 }
11146 tk_setPalette background $c selectColor $selc
5497f7a2
GR
11147}
11148
f8a2c0d1
PM
11149proc setbg {c} {
11150 global bglist
11151
11152 foreach w $bglist {
11153 $w conf -background $c
11154 }
11155}
11156
11157proc setfg {c} {
11158 global fglist canv
11159
11160 foreach w $fglist {
11161 $w conf -foreground $c
11162 }
11163 allcanvs itemconf text -fill $c
11164 $canv itemconf circle -outline $c
b9fdba7f 11165 $canv itemconf markid -outline $c
f8a2c0d1
PM
11166}
11167
712fcc08 11168proc prefscan {} {
94503918 11169 global oldprefs prefstop
712fcc08 11170
3de07118 11171 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
0cc08ff7 11172 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
94503918 11173 global $v
712fcc08
PM
11174 set $v $oldprefs($v)
11175 }
11176 catch {destroy $prefstop}
11177 unset prefstop
9a7558f3 11178 fontcan
712fcc08
PM
11179}
11180
11181proc prefsok {} {
11182 global maxwidth maxgraphpct
219ea3a9 11183 global oldprefs prefstop showneartags showlocalchanges
9a7558f3 11184 global fontpref mainfont textfont uifont
39ee47ef 11185 global limitdiffs treediffs perfile_attrs
ffe15297 11186 global hideremotes
712fcc08
PM
11187
11188 catch {destroy $prefstop}
11189 unset prefstop
9a7558f3
PM
11190 fontcan
11191 set fontchanged 0
11192 if {$mainfont ne $fontpref(mainfont)} {
11193 set mainfont $fontpref(mainfont)
11194 parsefont mainfont $mainfont
11195 eval font configure mainfont [fontflags mainfont]
11196 eval font configure mainfontbold [fontflags mainfont 1]
11197 setcoords
11198 set fontchanged 1
11199 }
11200 if {$textfont ne $fontpref(textfont)} {
11201 set textfont $fontpref(textfont)
11202 parsefont textfont $textfont
11203 eval font configure textfont [fontflags textfont]
11204 eval font configure textfontbold [fontflags textfont 1]
11205 }
11206 if {$uifont ne $fontpref(uifont)} {
11207 set uifont $fontpref(uifont)
11208 parsefont uifont $uifont
11209 eval font configure uifont [fontflags uifont]
11210 }
32f1b3e4 11211 settabs
219ea3a9
PM
11212 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11213 if {$showlocalchanges} {
11214 doshowlocalchanges
11215 } else {
11216 dohidelocalchanges
11217 }
11218 }
39ee47ef
PM
11219 if {$limitdiffs != $oldprefs(limitdiffs) ||
11220 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11221 # treediffs elements are limited by path;
11222 # won't have encodings cached if perfile_attrs was just turned on
74a40c71
PM
11223 catch {unset treediffs}
11224 }
9a7558f3 11225 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
712fcc08
PM
11226 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11227 redisplay
7a39a17a
PM
11228 } elseif {$showneartags != $oldprefs(showneartags) ||
11229 $limitdiffs != $oldprefs(limitdiffs)} {
b8ab2e17 11230 reselectline
712fcc08 11231 }
ffe15297
TR
11232 if {$hideremotes != $oldprefs(hideremotes)} {
11233 rereadrefs
11234 }
712fcc08
PM
11235}
11236
11237proc formatdate {d} {
e8b5f4be 11238 global datetimeformat
219ea3a9 11239 if {$d ne {}} {
f5974d97 11240 set d [clock format [lindex $d 0] -format $datetimeformat]
219ea3a9
PM
11241 }
11242 return $d
232475d3
PM
11243}
11244
fd8ccbec
PM
11245# This list of encoding names and aliases is distilled from
11246# http://www.iana.org/assignments/character-sets.
11247# Not all of them are supported by Tcl.
11248set encoding_aliases {
11249 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11250 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11251 { ISO-10646-UTF-1 csISO10646UTF1 }
11252 { ISO_646.basic:1983 ref csISO646basic1983 }
11253 { INVARIANT csINVARIANT }
11254 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11255 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11256 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11257 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11258 { NATS-DANO iso-ir-9-1 csNATSDANO }
11259 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11260 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11261 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11262 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11263 { ISO-2022-KR csISO2022KR }
11264 { EUC-KR csEUCKR }
11265 { ISO-2022-JP csISO2022JP }
11266 { ISO-2022-JP-2 csISO2022JP2 }
11267 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11268 csISO13JISC6220jp }
11269 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11270 { IT iso-ir-15 ISO646-IT csISO15Italian }
11271 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11272 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11273 { greek7-old iso-ir-18 csISO18Greek7Old }
11274 { latin-greek iso-ir-19 csISO19LatinGreek }
11275 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11276 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11277 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11278 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11279 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11280 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11281 { INIS iso-ir-49 csISO49INIS }
11282 { INIS-8 iso-ir-50 csISO50INIS8 }
11283 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11284 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11285 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11286 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11287 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11288 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11289 csISO60Norwegian1 }
11290 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11291 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11292 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11293 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11294 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11295 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11296 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11297 { greek7 iso-ir-88 csISO88Greek7 }
11298 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11299 { iso-ir-90 csISO90 }
11300 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11301 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11302 csISO92JISC62991984b }
11303 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11304 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11305 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11306 csISO95JIS62291984handadd }
11307 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11308 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11309 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11310 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11311 CP819 csISOLatin1 }
11312 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11313 { T.61-7bit iso-ir-102 csISO102T617bit }
11314 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11315 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11316 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11317 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11318 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11319 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11320 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11321 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11322 arabic csISOLatinArabic }
11323 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11324 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11325 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11326 greek greek8 csISOLatinGreek }
11327 { T.101-G2 iso-ir-128 csISO128T101G2 }
11328 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11329 csISOLatinHebrew }
11330 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11331 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11332 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11333 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11334 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11335 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11336 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11337 csISOLatinCyrillic }
11338 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11339 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11340 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11341 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11342 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11343 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11344 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11345 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11346 { ISO_10367-box iso-ir-155 csISO10367Box }
11347 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11348 { latin-lap lap iso-ir-158 csISO158Lap }
11349 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11350 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11351 { us-dk csUSDK }
11352 { dk-us csDKUS }
11353 { JIS_X0201 X0201 csHalfWidthKatakana }
11354 { KSC5636 ISO646-KR csKSC5636 }
11355 { ISO-10646-UCS-2 csUnicode }
11356 { ISO-10646-UCS-4 csUCS4 }
11357 { DEC-MCS dec csDECMCS }
11358 { hp-roman8 roman8 r8 csHPRoman8 }
11359 { macintosh mac csMacintosh }
11360 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11361 csIBM037 }
11362 { IBM038 EBCDIC-INT cp038 csIBM038 }
11363 { IBM273 CP273 csIBM273 }
11364 { IBM274 EBCDIC-BE CP274 csIBM274 }
11365 { IBM275 EBCDIC-BR cp275 csIBM275 }
11366 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11367 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11368 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11369 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11370 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11371 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11372 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11373 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11374 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11375 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11376 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11377 { IBM437 cp437 437 csPC8CodePage437 }
11378 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11379 { IBM775 cp775 csPC775Baltic }
11380 { IBM850 cp850 850 csPC850Multilingual }
11381 { IBM851 cp851 851 csIBM851 }
11382 { IBM852 cp852 852 csPCp852 }
11383 { IBM855 cp855 855 csIBM855 }
11384 { IBM857 cp857 857 csIBM857 }
11385 { IBM860 cp860 860 csIBM860 }
11386 { IBM861 cp861 861 cp-is csIBM861 }
11387 { IBM862 cp862 862 csPC862LatinHebrew }
11388 { IBM863 cp863 863 csIBM863 }
11389 { IBM864 cp864 csIBM864 }
11390 { IBM865 cp865 865 csIBM865 }
11391 { IBM866 cp866 866 csIBM866 }
11392 { IBM868 CP868 cp-ar csIBM868 }
11393 { IBM869 cp869 869 cp-gr csIBM869 }
11394 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11395 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11396 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11397 { IBM891 cp891 csIBM891 }
11398 { IBM903 cp903 csIBM903 }
11399 { IBM904 cp904 904 csIBBM904 }
11400 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11401 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11402 { IBM1026 CP1026 csIBM1026 }
11403 { EBCDIC-AT-DE csIBMEBCDICATDE }
11404 { EBCDIC-AT-DE-A csEBCDICATDEA }
11405 { EBCDIC-CA-FR csEBCDICCAFR }
11406 { EBCDIC-DK-NO csEBCDICDKNO }
11407 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11408 { EBCDIC-FI-SE csEBCDICFISE }
11409 { EBCDIC-FI-SE-A csEBCDICFISEA }
11410 { EBCDIC-FR csEBCDICFR }
11411 { EBCDIC-IT csEBCDICIT }
11412 { EBCDIC-PT csEBCDICPT }
11413 { EBCDIC-ES csEBCDICES }
11414 { EBCDIC-ES-A csEBCDICESA }
11415 { EBCDIC-ES-S csEBCDICESS }
11416 { EBCDIC-UK csEBCDICUK }
11417 { EBCDIC-US csEBCDICUS }
11418 { UNKNOWN-8BIT csUnknown8BiT }
11419 { MNEMONIC csMnemonic }
11420 { MNEM csMnem }
11421 { VISCII csVISCII }
11422 { VIQR csVIQR }
11423 { KOI8-R csKOI8R }
11424 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11425 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11426 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11427 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11428 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11429 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11430 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11431 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11432 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11433 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11434 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11435 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11436 { IBM1047 IBM-1047 }
11437 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11438 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11439 { UNICODE-1-1 csUnicode11 }
11440 { CESU-8 csCESU-8 }
11441 { BOCU-1 csBOCU-1 }
11442 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11443 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11444 l8 }
11445 { ISO-8859-15 ISO_8859-15 Latin-9 }
11446 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11447 { GBK CP936 MS936 windows-936 }
11448 { JIS_Encoding csJISEncoding }
09c7029d 11449 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
fd8ccbec
PM
11450 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11451 EUC-JP }
11452 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11453 { ISO-10646-UCS-Basic csUnicodeASCII }
11454 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11455 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11456 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11457 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11458 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11459 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11460 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11461 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11462 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11463 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11464 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11465 { Ventura-US csVenturaUS }
11466 { Ventura-International csVenturaInternational }
11467 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11468 { PC8-Turkish csPC8Turkish }
11469 { IBM-Symbols csIBMSymbols }
11470 { IBM-Thai csIBMThai }
11471 { HP-Legal csHPLegal }
11472 { HP-Pi-font csHPPiFont }
11473 { HP-Math8 csHPMath8 }
11474 { Adobe-Symbol-Encoding csHPPSMath }
11475 { HP-DeskTop csHPDesktop }
11476 { Ventura-Math csVenturaMath }
11477 { Microsoft-Publishing csMicrosoftPublishing }
11478 { Windows-31J csWindows31J }
11479 { GB2312 csGB2312 }
11480 { Big5 csBig5 }
11481}
11482
11483proc tcl_encoding {enc} {
39ee47ef
PM
11484 global encoding_aliases tcl_encoding_cache
11485 if {[info exists tcl_encoding_cache($enc)]} {
11486 return $tcl_encoding_cache($enc)
11487 }
fd8ccbec
PM
11488 set names [encoding names]
11489 set lcnames [string tolower $names]
11490 set enc [string tolower $enc]
11491 set i [lsearch -exact $lcnames $enc]
11492 if {$i < 0} {
11493 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
09c7029d 11494 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
fd8ccbec
PM
11495 set i [lsearch -exact $lcnames $encx]
11496 }
11497 }
11498 if {$i < 0} {
11499 foreach l $encoding_aliases {
11500 set ll [string tolower $l]
11501 if {[lsearch -exact $ll $enc] < 0} continue
11502 # look through the aliases for one that tcl knows about
11503 foreach e $ll {
11504 set i [lsearch -exact $lcnames $e]
11505 if {$i < 0} {
09c7029d 11506 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
fd8ccbec
PM
11507 set i [lsearch -exact $lcnames $ex]
11508 }
11509 }
11510 if {$i >= 0} break
11511 }
11512 break
11513 }
11514 }
39ee47ef 11515 set tclenc {}
fd8ccbec 11516 if {$i >= 0} {
39ee47ef 11517 set tclenc [lindex $names $i]
fd8ccbec 11518 }
39ee47ef
PM
11519 set tcl_encoding_cache($enc) $tclenc
11520 return $tclenc
fd8ccbec
PM
11521}
11522
09c7029d 11523proc gitattr {path attr default} {
39ee47ef
PM
11524 global path_attr_cache
11525 if {[info exists path_attr_cache($attr,$path)]} {
11526 set r $path_attr_cache($attr,$path)
11527 } else {
11528 set r "unspecified"
11529 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
097e1118 11530 regexp "(.*): $attr: (.*)" $line m f r
09c7029d 11531 }
4db09304 11532 set path_attr_cache($attr,$path) $r
39ee47ef
PM
11533 }
11534 if {$r eq "unspecified"} {
11535 return $default
11536 }
11537 return $r
09c7029d
AG
11538}
11539
4db09304 11540proc cache_gitattr {attr pathlist} {
39ee47ef
PM
11541 global path_attr_cache
11542 set newlist {}
11543 foreach path $pathlist {
11544 if {![info exists path_attr_cache($attr,$path)]} {
11545 lappend newlist $path
11546 }
11547 }
11548 set lim 1000
11549 if {[tk windowingsystem] == "win32"} {
11550 # windows has a 32k limit on the arguments to a command...
11551 set lim 30
11552 }
11553 while {$newlist ne {}} {
11554 set head [lrange $newlist 0 [expr {$lim - 1}]]
11555 set newlist [lrange $newlist $lim end]
11556 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11557 foreach row [split $rlist "\n"] {
097e1118 11558 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
39ee47ef
PM
11559 if {[string index $path 0] eq "\""} {
11560 set path [encoding convertfrom [lindex $path 0]]
11561 }
11562 set path_attr_cache($attr,$path) $value
4db09304 11563 }
39ee47ef 11564 }
4db09304 11565 }
39ee47ef 11566 }
4db09304
AG
11567}
11568
09c7029d 11569proc get_path_encoding {path} {
39ee47ef
PM
11570 global gui_encoding perfile_attrs
11571 set tcl_enc $gui_encoding
11572 if {$path ne {} && $perfile_attrs} {
11573 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11574 if {$enc2 ne {}} {
11575 set tcl_enc $enc2
09c7029d 11576 }
39ee47ef
PM
11577 }
11578 return $tcl_enc
09c7029d
AG
11579}
11580
5d7589d4
PM
11581# First check that Tcl/Tk is recent enough
11582if {[catch {package require Tk 8.4} err]} {
8d849957
BH
11583 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11584 Gitk requires at least Tcl/Tk 8.4." list
5d7589d4
PM
11585 exit 1
11586}
11587
0ae10357
AO
11588# Unset GIT_TRACE var if set
11589if { [info exists ::env(GIT_TRACE)] } {
11590 unset ::env(GIT_TRACE)
11591}
11592
1d10f36d 11593# defaults...
8974c6f9 11594set wrcomcmd "git diff-tree --stdin -p --pretty"
671bc153 11595
fd8ccbec 11596set gitencoding {}
671bc153 11597catch {
27cb61ca 11598 set gitencoding [exec git config --get i18n.commitencoding]
671bc153 11599}
590915da
AG
11600catch {
11601 set gitencoding [exec git config --get i18n.logoutputencoding]
11602}
671bc153 11603if {$gitencoding == ""} {
fd8ccbec
PM
11604 set gitencoding "utf-8"
11605}
11606set tclencoding [tcl_encoding $gitencoding]
11607if {$tclencoding == {}} {
11608 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
671bc153 11609}
1db95b00 11610
09c7029d
AG
11611set gui_encoding [encoding system]
11612catch {
39ee47ef
PM
11613 set enc [exec git config --get gui.encoding]
11614 if {$enc ne {}} {
11615 set tclenc [tcl_encoding $enc]
11616 if {$tclenc ne {}} {
11617 set gui_encoding $tclenc
11618 } else {
11619 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11620 }
11621 }
09c7029d
AG
11622}
11623
b2b76d10
MK
11624set log_showroot true
11625catch {
11626 set log_showroot [exec git config --bool --get log.showroot]
11627}
11628
5fdcbb13
DS
11629if {[tk windowingsystem] eq "aqua"} {
11630 set mainfont {{Lucida Grande} 9}
11631 set textfont {Monaco 9}
11632 set uifont {{Lucida Grande} 9 bold}
5c9096f7
JN
11633} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11634 # fontconfig!
11635 set mainfont {sans 9}
11636 set textfont {monospace 9}
11637 set uifont {sans 9 bold}
5fdcbb13
DS
11638} else {
11639 set mainfont {Helvetica 9}
11640 set textfont {Courier 9}
11641 set uifont {Helvetica 9 bold}
11642}
7e12f1a6 11643set tabstop 8
b74fd579 11644set findmergefiles 0
8d858d1a 11645set maxgraphpct 50
f6075eba 11646set maxwidth 16
232475d3 11647set revlistorder 0
757f17bc 11648set fastdate 0
6e8c8707
PM
11649set uparrowlen 5
11650set downarrowlen 5
11651set mingaplen 100
f8b28a40 11652set cmitmode "patch"
f1b86294 11653set wrapcomment "none"
b8ab2e17 11654set showneartags 1
ffe15297 11655set hideremotes 0
0a4dd8b8 11656set maxrefs 20
322a8cc9 11657set maxlinelen 200
219ea3a9 11658set showlocalchanges 1
7a39a17a 11659set limitdiffs 1
e8b5f4be 11660set datetimeformat "%Y-%m-%d %H:%M:%S"
95293b58 11661set autoselect 1
21ac8a8d 11662set autosellen 40
39ee47ef 11663set perfile_attrs 0
0cc08ff7 11664set want_ttk 1
1d10f36d 11665
5fdcbb13
DS
11666if {[tk windowingsystem] eq "aqua"} {
11667 set extdifftool "opendiff"
11668} else {
11669 set extdifftool "meld"
11670}
314f5de1 11671
1d10f36d 11672set colors {green red blue magenta darkgrey brown orange}
1924d1bc
PT
11673if {[tk windowingsystem] eq "win32"} {
11674 set uicolor SystemButtonFace
11675 set bgcolor SystemWindow
11676 set fgcolor SystemButtonText
11677 set selectbgcolor SystemHighlight
11678} else {
11679 set uicolor grey85
11680 set bgcolor white
11681 set fgcolor black
11682 set selectbgcolor gray85
11683}
f8a2c0d1 11684set diffcolors {red "#00a000" blue}
890fae70 11685set diffcontext 3
b9b86007 11686set ignorespace 0
ae4e3ff9 11687set worddiff ""
e3e901be 11688set markbgcolor "#e0e0ff"
1d10f36d 11689
c11ff120
PM
11690set circlecolors {white blue gray blue blue}
11691
d277e89f
PM
11692# button for popping up context menus
11693if {[tk windowingsystem] eq "aqua"} {
11694 set ctxbut <Button-2>
11695} else {
11696 set ctxbut <Button-3>
11697}
11698
663c3aa9
CS
11699## For msgcat loading, first locate the installation location.
11700if { [info exists ::env(GITK_MSGSDIR)] } {
11701 ## Msgsdir was manually set in the environment.
11702 set gitk_msgsdir $::env(GITK_MSGSDIR)
11703} else {
11704 ## Let's guess the prefix from argv0.
11705 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11706 set gitk_libdir [file join $gitk_prefix share gitk lib]
11707 set gitk_msgsdir [file join $gitk_libdir msgs]
11708 unset gitk_prefix
11709}
11710
11711## Internationalization (i18n) through msgcat and gettext. See
11712## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11713package require msgcat
11714namespace import ::msgcat::mc
11715## And eventually load the actual message catalog
11716::msgcat::mcload $gitk_msgsdir
11717
1d10f36d
PM
11718catch {source ~/.gitk}
11719
0ed1dd3c
PM
11720parsefont mainfont $mainfont
11721eval font create mainfont [fontflags mainfont]
11722eval font create mainfontbold [fontflags mainfont 1]
11723
11724parsefont textfont $textfont
11725eval font create textfont [fontflags textfont]
11726eval font create textfontbold [fontflags textfont 1]
11727
11728parsefont uifont $uifont
11729eval font create uifont [fontflags uifont]
17386066 11730
51a7e8b6 11731setui $uicolor
5497f7a2 11732
b039f0a6
PM
11733setoptions
11734
cdaee5db 11735# check that we can find a .git directory somewhere...
86e847bc 11736if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
d990cedf 11737 show_error {} . [mc "Cannot find a git repository here."]
6c87d60c
AR
11738 exit 1
11739}
cdaee5db 11740
39816d60
AG
11741set selecthead {}
11742set selectheadid {}
11743
1d10f36d 11744set revtreeargs {}
cdaee5db
PM
11745set cmdline_files {}
11746set i 0
2d480856 11747set revtreeargscmd {}
1d10f36d 11748foreach arg $argv {
2d480856 11749 switch -glob -- $arg {
6ebedabf 11750 "" { }
cdaee5db
PM
11751 "--" {
11752 set cmdline_files [lrange $argv [expr {$i + 1}] end]
11753 break
11754 }
39816d60
AG
11755 "--select-commit=*" {
11756 set selecthead [string range $arg 16 end]
11757 }
2d480856
YD
11758 "--argscmd=*" {
11759 set revtreeargscmd [string range $arg 10 end]
11760 }
1d10f36d
PM
11761 default {
11762 lappend revtreeargs $arg
11763 }
11764 }
cdaee5db 11765 incr i
1db95b00 11766}
1d10f36d 11767
39816d60
AG
11768if {$selecthead eq "HEAD"} {
11769 set selecthead {}
11770}
11771
cdaee5db 11772if {$i >= [llength $argv] && $revtreeargs ne {}} {
3ed31a81 11773 # no -- on command line, but some arguments (other than --argscmd)
098dd8a3 11774 if {[catch {
8974c6f9 11775 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
098dd8a3
PM
11776 set cmdline_files [split $f "\n"]
11777 set n [llength $cmdline_files]
11778 set revtreeargs [lrange $revtreeargs 0 end-$n]
cdaee5db
PM
11779 # Unfortunately git rev-parse doesn't produce an error when
11780 # something is both a revision and a filename. To be consistent
11781 # with git log and git rev-list, check revtreeargs for filenames.
11782 foreach arg $revtreeargs {
11783 if {[file exists $arg]} {
d990cedf
CS
11784 show_error {} . [mc "Ambiguous argument '%s': both revision\
11785 and filename" $arg]
cdaee5db
PM
11786 exit 1
11787 }
11788 }
098dd8a3
PM
11789 } err]} {
11790 # unfortunately we get both stdout and stderr in $err,
11791 # so look for "fatal:".
11792 set i [string first "fatal:" $err]
11793 if {$i > 0} {
b5e09633 11794 set err [string range $err [expr {$i + 6}] end]
098dd8a3 11795 }
d990cedf 11796 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
098dd8a3
PM
11797 exit 1
11798 }
11799}
11800
219ea3a9 11801set nullid "0000000000000000000000000000000000000000"
8f489363 11802set nullid2 "0000000000000000000000000000000000000001"
314f5de1 11803set nullfile "/dev/null"
8f489363 11804
32f1b3e4 11805set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
0cc08ff7
PM
11806if {![info exists have_ttk]} {
11807 set have_ttk [llength [info commands ::ttk::style]]
d93f1713 11808}
0cc08ff7 11809set use_ttk [expr {$have_ttk && $want_ttk}]
d93f1713 11810set NS [expr {$use_ttk ? "ttk" : ""}]
0cc08ff7 11811
7add5aff 11812regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
219ea3a9 11813
7defefb1
KS
11814set show_notes {}
11815if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11816 set show_notes "--show-notes"
11817}
11818
3878e636
ZJS
11819set appname "gitk"
11820
7eb3cb9c 11821set runq {}
d698206c
PM
11822set history {}
11823set historyindex 0
908c3585 11824set fh_serial 0
908c3585 11825set nhl_names {}
63b79191 11826set highlight_paths {}
687c8765 11827set findpattern {}
1902c270 11828set searchdirn -forwards
28593d3f
PM
11829set boldids {}
11830set boldnameids {}
a8d610a2 11831set diffelide {0 0}
4fb0fa19 11832set markingmatches 0
97645683 11833set linkentercount 0
0380081c
PM
11834set need_redisplay 0
11835set nrows_drawn 0
32f1b3e4 11836set firsttabstop 0
9f1afe05 11837
50b44ece
PM
11838set nextviewnum 1
11839set curview 0
a90a6d24 11840set selectedview 0
b007ee20
CS
11841set selectedhlview [mc "None"]
11842set highlight_related [mc "None"]
687c8765 11843set highlight_files {}
50b44ece 11844set viewfiles(0) {}
a90a6d24 11845set viewperm(0) 0
098dd8a3 11846set viewargs(0) {}
2d480856 11847set viewargscmd(0) {}
50b44ece 11848
94b4a69f 11849set selectedline {}
6df7403a 11850set numcommits 0
7fcc92bf 11851set loginstance 0
098dd8a3 11852set cmdlineok 0
1d10f36d 11853set stopped 0
0fba86b3 11854set stuffsaved 0
74daedb6 11855set patchnum 0
219ea3a9 11856set lserial 0
74cb884f 11857set hasworktree [hasworktree]
c332f445 11858set cdup {}
74cb884f 11859if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
c332f445
MZ
11860 set cdup [exec git rev-parse --show-cdup]
11861}
784b7e2f 11862set worktree [exec git rev-parse --show-toplevel]
1d10f36d 11863setcoords
d94f8cd6 11864makewindow
37871b73
GB
11865catch {
11866 image create photo gitlogo -width 16 -height 16
11867
11868 image create photo gitlogominus -width 4 -height 2
11869 gitlogominus put #C00000 -to 0 0 4 2
11870 gitlogo copy gitlogominus -to 1 5
11871 gitlogo copy gitlogominus -to 6 5
11872 gitlogo copy gitlogominus -to 11 5
11873 image delete gitlogominus
11874
11875 image create photo gitlogoplus -width 4 -height 4
11876 gitlogoplus put #008000 -to 1 0 3 4
11877 gitlogoplus put #008000 -to 0 1 4 3
11878 gitlogo copy gitlogoplus -to 1 9
11879 gitlogo copy gitlogoplus -to 6 9
11880 gitlogo copy gitlogoplus -to 11 9
11881 image delete gitlogoplus
11882
d38d7d49
SB
11883 image create photo gitlogo32 -width 32 -height 32
11884 gitlogo32 copy gitlogo -zoom 2 2
11885
11886 wm iconphoto . -default gitlogo gitlogo32
37871b73 11887}
0eafba14
PM
11888# wait for the window to become visible
11889tkwait visibility .
3878e636 11890wm title . "$appname: [reponame]"
478afad6 11891update
887fe3c4 11892readrefs
a8aaf19c 11893
2d480856 11894if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
50b44ece
PM
11895 # create a view for the files/dirs specified on the command line
11896 set curview 1
a90a6d24 11897 set selectedview 1
50b44ece 11898 set nextviewnum 2
d990cedf 11899 set viewname(1) [mc "Command line"]
50b44ece 11900 set viewfiles(1) $cmdline_files
098dd8a3 11901 set viewargs(1) $revtreeargs
2d480856 11902 set viewargscmd(1) $revtreeargscmd
a90a6d24 11903 set viewperm(1) 0
3ed31a81 11904 set vdatemode(1) 0
da7c24dd 11905 addviewmenu 1
f2d0bbbd
PM
11906 .bar.view entryconf [mca "Edit view..."] -state normal
11907 .bar.view entryconf [mca "Delete view"] -state normal
50b44ece 11908}
a90a6d24
PM
11909
11910if {[info exists permviews]} {
11911 foreach v $permviews {
11912 set n $nextviewnum
11913 incr nextviewnum
11914 set viewname($n) [lindex $v 0]
11915 set viewfiles($n) [lindex $v 1]
098dd8a3 11916 set viewargs($n) [lindex $v 2]
2d480856 11917 set viewargscmd($n) [lindex $v 3]
a90a6d24 11918 set viewperm($n) 1
da7c24dd 11919 addviewmenu $n
a90a6d24
PM
11920 }
11921}
e4df519f
JS
11922
11923if {[tk windowingsystem] eq "win32"} {
11924 focus -force .
11925}
11926
567c34e0 11927getcommits {}
adab0dab
PT
11928
11929# Local variables:
11930# mode: tcl
11931# indent-tabs-mode: t
11932# tab-width: 8
11933# End: