]> git.ipfire.org Git - thirdparty/git.git/blame - gitk
gitk: Split out diff part in $commitinfo
[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" -
71846c5c 230 "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
f687aaa8 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]
b449eb2c
TR
1707 set diff ""
1708 # If there is diff output shown in the git-log stream, split it
1709 # out. But get rid of the empty line that always precedes the
1710 # diff.
1711 set i [string first "\n\ndiff" $comment]
1712 if {$i >= 0} {
1713 set diff [string range $comment $i+1 end]
1714 set comment [string range $comment 0 $i-1]
1715 }
e5c2d856 1716 set commitinfo($id) [list $headline $auname $audate \
b449eb2c 1717 $comname $comdate $comment $hasnote $diff]
1db95b00
PM
1718}
1719
f7a3e8d2 1720proc getcommit {id} {
79b2c75e 1721 global commitdata commitinfo
8ed16484 1722
f7a3e8d2
PM
1723 if {[info exists commitdata($id)]} {
1724 parsecommit $id $commitdata($id) 1
8ed16484
PM
1725 } else {
1726 readcommit $id
1727 if {![info exists commitinfo($id)]} {
d990cedf 1728 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
1729 }
1730 }
1731 return 1
1732}
1733
d375ef9b
PM
1734# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1735# and are present in the current view.
1736# This is fairly slow...
1737proc longid {prefix} {
22387f23 1738 global varcid curview vshortids
d375ef9b
PM
1739
1740 set ids {}
22387f23
PM
1741 if {[string length $prefix] >= 4} {
1742 set vshortid $curview,[string range $prefix 0 3]
1743 if {[info exists vshortids($vshortid)]} {
1744 foreach id $vshortids($vshortid) {
1745 if {[string match "$prefix*" $id]} {
1746 if {[lsearch -exact $ids $id] < 0} {
1747 lappend ids $id
1748 if {[llength $ids] >= 2} break
1749 }
1750 }
1751 }
1752 }
1753 } else {
1754 foreach match [array names varcid "$curview,$prefix*"] {
1755 lappend ids [lindex [split $match ","] 1]
1756 if {[llength $ids] >= 2} break
1757 }
d375ef9b
PM
1758 }
1759 return $ids
1760}
1761
887fe3c4 1762proc readrefs {} {
62d3ea65 1763 global tagids idtags headids idheads tagobjid
219ea3a9 1764 global otherrefids idotherrefs mainhead mainheadid
39816d60 1765 global selecthead selectheadid
ffe15297 1766 global hideremotes
106288cb 1767
b5c2f306
SV
1768 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1769 catch {unset $v}
1770 }
62d3ea65
PM
1771 set refd [open [list | git show-ref -d] r]
1772 while {[gets $refd line] >= 0} {
1773 if {[string index $line 40] ne " "} continue
1774 set id [string range $line 0 39]
1775 set ref [string range $line 41 end]
1776 if {![string match "refs/*" $ref]} continue
1777 set name [string range $ref 5 end]
1778 if {[string match "remotes/*" $name]} {
ffe15297 1779 if {![string match "*/HEAD" $name] && !$hideremotes} {
62d3ea65
PM
1780 set headids($name) $id
1781 lappend idheads($id) $name
f1d83ba3 1782 }
62d3ea65
PM
1783 } elseif {[string match "heads/*" $name]} {
1784 set name [string range $name 6 end]
36a7cad6
JH
1785 set headids($name) $id
1786 lappend idheads($id) $name
62d3ea65
PM
1787 } elseif {[string match "tags/*" $name]} {
1788 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1789 # which is what we want since the former is the commit ID
1790 set name [string range $name 5 end]
1791 if {[string match "*^{}" $name]} {
1792 set name [string range $name 0 end-3]
1793 } else {
1794 set tagobjid($name) $id
1795 }
1796 set tagids($name) $id
1797 lappend idtags($id) $name
36a7cad6
JH
1798 } else {
1799 set otherrefids($name) $id
1800 lappend idotherrefs($id) $name
f1d83ba3
PM
1801 }
1802 }
062d671f 1803 catch {close $refd}
8a48571c 1804 set mainhead {}
219ea3a9 1805 set mainheadid {}
8a48571c 1806 catch {
c11ff120 1807 set mainheadid [exec git rev-parse HEAD]
8a48571c
PM
1808 set thehead [exec git symbolic-ref HEAD]
1809 if {[string match "refs/heads/*" $thehead]} {
1810 set mainhead [string range $thehead 11 end]
1811 }
1812 }
39816d60
AG
1813 set selectheadid {}
1814 if {$selecthead ne {}} {
1815 catch {
1816 set selectheadid [exec git rev-parse --verify $selecthead]
1817 }
1818 }
887fe3c4
PM
1819}
1820
8f489363
PM
1821# skip over fake commits
1822proc first_real_row {} {
7fcc92bf 1823 global nullid nullid2 numcommits
8f489363
PM
1824
1825 for {set row 0} {$row < $numcommits} {incr row} {
7fcc92bf 1826 set id [commitonrow $row]
8f489363
PM
1827 if {$id ne $nullid && $id ne $nullid2} {
1828 break
1829 }
1830 }
1831 return $row
1832}
1833
e11f1233
PM
1834# update things for a head moved to a child of its previous location
1835proc movehead {id name} {
1836 global headids idheads
1837
1838 removehead $headids($name) $name
1839 set headids($name) $id
1840 lappend idheads($id) $name
1841}
1842
1843# update things when a head has been removed
1844proc removehead {id name} {
1845 global headids idheads
1846
1847 if {$idheads($id) eq $name} {
1848 unset idheads($id)
1849 } else {
1850 set i [lsearch -exact $idheads($id) $name]
1851 if {$i >= 0} {
1852 set idheads($id) [lreplace $idheads($id) $i $i]
1853 }
1854 }
1855 unset headids($name)
1856}
1857
d93f1713
PT
1858proc ttk_toplevel {w args} {
1859 global use_ttk
1860 eval [linsert $args 0 ::toplevel $w]
1861 if {$use_ttk} {
1862 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1863 }
1864 return $w
1865}
1866
e7d64008
AG
1867proc make_transient {window origin} {
1868 global have_tk85
1869
1870 # In MacOS Tk 8.4 transient appears to work by setting
1871 # overrideredirect, which is utterly useless, since the
1872 # windows get no border, and are not even kept above
1873 # the parent.
1874 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1875
1876 wm transient $window $origin
1877
1878 # Windows fails to place transient windows normally, so
1879 # schedule a callback to center them on the parent.
1880 if {[tk windowingsystem] eq {win32}} {
1881 after idle [list tk::PlaceWindow $window widget $origin]
1882 }
1883}
1884
8d849957 1885proc show_error {w top msg {mc mc}} {
d93f1713 1886 global NS
3cb1f9c9 1887 if {![info exists NS]} {set NS ""}
d93f1713 1888 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
df3d83b1
PM
1889 message $w.m -text $msg -justify center -aspect 400
1890 pack $w.m -side top -fill x -padx 20 -pady 20
7a0ebbf8 1891 ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
df3d83b1 1892 pack $w.ok -side bottom -fill x
e54be9e3
PM
1893 bind $top <Visibility> "grab $top; focus $top"
1894 bind $top <Key-Return> "destroy $top"
76f15947
AG
1895 bind $top <Key-space> "destroy $top"
1896 bind $top <Key-Escape> "destroy $top"
e54be9e3 1897 tkwait window $top
df3d83b1
PM
1898}
1899
84a76f18 1900proc error_popup {msg {owner .}} {
d93f1713
PT
1901 if {[tk windowingsystem] eq "win32"} {
1902 tk_messageBox -icon error -type ok -title [wm title .] \
1903 -parent $owner -message $msg
1904 } else {
1905 set w .error
1906 ttk_toplevel $w
1907 make_transient $w $owner
1908 show_error $w $w $msg
1909 }
098dd8a3
PM
1910}
1911
84a76f18 1912proc confirm_popup {msg {owner .}} {
d93f1713 1913 global confirm_ok NS
10299152
PM
1914 set confirm_ok 0
1915 set w .confirm
d93f1713 1916 ttk_toplevel $w
e7d64008 1917 make_transient $w $owner
10299152
PM
1918 message $w.m -text $msg -justify center -aspect 400
1919 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1920 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1921 pack $w.ok -side left -fill x
d93f1713 1922 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1923 pack $w.cancel -side right -fill x
1924 bind $w <Visibility> "grab $w; focus $w"
76f15947
AG
1925 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1926 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1927 bind $w <Key-Escape> "destroy $w"
d93f1713 1928 tk::PlaceWindow $w widget $owner
10299152
PM
1929 tkwait window $w
1930 return $confirm_ok
1931}
1932
b039f0a6 1933proc setoptions {} {
d93f1713
PT
1934 if {[tk windowingsystem] ne "win32"} {
1935 option add *Panedwindow.showHandle 1 startupFile
1936 option add *Panedwindow.sashRelief raised startupFile
1937 if {[tk windowingsystem] ne "aqua"} {
1938 option add *Menu.font uifont startupFile
1939 }
1940 } else {
1941 option add *Menu.TearOff 0 startupFile
1942 }
b039f0a6
PM
1943 option add *Button.font uifont startupFile
1944 option add *Checkbutton.font uifont startupFile
1945 option add *Radiobutton.font uifont startupFile
b039f0a6
PM
1946 option add *Menubutton.font uifont startupFile
1947 option add *Label.font uifont startupFile
1948 option add *Message.font uifont startupFile
b9b142ff
MH
1949 option add *Entry.font textfont startupFile
1950 option add *Text.font textfont startupFile
d93f1713 1951 option add *Labelframe.font uifont startupFile
0933b04e 1952 option add *Spinbox.font textfont startupFile
207ad7b8 1953 option add *Listbox.font mainfont startupFile
b039f0a6
PM
1954}
1955
79056034
PM
1956# Make a menu and submenus.
1957# m is the window name for the menu, items is the list of menu items to add.
1958# Each item is a list {mc label type description options...}
1959# mc is ignored; it's so we can put mc there to alert xgettext
1960# label is the string that appears in the menu
1961# type is cascade, command or radiobutton (should add checkbutton)
1962# description depends on type; it's the sublist for cascade, the
1963# command to invoke for command, or {variable value} for radiobutton
f2d0bbbd
PM
1964proc makemenu {m items} {
1965 menu $m
cea07cf8
AG
1966 if {[tk windowingsystem] eq {aqua}} {
1967 set Meta1 Cmd
1968 } else {
1969 set Meta1 Ctrl
1970 }
f2d0bbbd 1971 foreach i $items {
79056034
PM
1972 set name [mc [lindex $i 1]]
1973 set type [lindex $i 2]
1974 set thing [lindex $i 3]
f2d0bbbd
PM
1975 set params [list $type]
1976 if {$name ne {}} {
1977 set u [string first "&" [string map {&& x} $name]]
1978 lappend params -label [string map {&& & & {}} $name]
1979 if {$u >= 0} {
1980 lappend params -underline $u
1981 }
1982 }
1983 switch -- $type {
1984 "cascade" {
79056034 1985 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
f2d0bbbd
PM
1986 lappend params -menu $m.$submenu
1987 }
1988 "command" {
1989 lappend params -command $thing
1990 }
1991 "radiobutton" {
1992 lappend params -variable [lindex $thing 0] \
1993 -value [lindex $thing 1]
1994 }
1995 }
cea07cf8
AG
1996 set tail [lrange $i 4 end]
1997 regsub -all {\yMeta1\y} $tail $Meta1 tail
1998 eval $m add $params $tail
f2d0bbbd
PM
1999 if {$type eq "cascade"} {
2000 makemenu $m.$submenu $thing
2001 }
2002 }
2003}
2004
2005# translate string and remove ampersands
2006proc mca {str} {
2007 return [string map {&& & & {}} [mc $str]]
2008}
2009
39c12691
PM
2010proc cleardropsel {w} {
2011 $w selection clear
2012}
d93f1713
PT
2013proc makedroplist {w varname args} {
2014 global use_ttk
2015 if {$use_ttk} {
3cb1f9c9
PT
2016 set width 0
2017 foreach label $args {
2018 set cx [string length $label]
2019 if {$cx > $width} {set width $cx}
2020 }
2021 set gm [ttk::combobox $w -width $width -state readonly\
39c12691
PM
2022 -textvariable $varname -values $args \
2023 -exportselection false]
2024 bind $gm <<ComboboxSelected>> [list $gm selection clear]
d93f1713
PT
2025 } else {
2026 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2027 }
2028 return $gm
2029}
2030
d94f8cd6 2031proc makewindow {} {
31c0eaa8 2032 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 2033 global tabstop
b74fd579 2034 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 2035 global entries sha1entry sha1string sha1but
890fae70 2036 global diffcontextstring diffcontext
b9b86007 2037 global ignorespace
94a2eede 2038 global maincursor textcursor curtextcursor
219ea3a9 2039 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 2040 global highlight_files gdttype
3ea06f9f 2041 global searchstring sstring
60378c0c 2042 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
252c52df
2043 global uifgcolor uifgdisabledcolor
2044 global filesepbgcolor filesepfgcolor
2045 global mergecolors foundbgcolor currentsearchhitbgcolor
bb3edc8b
PM
2046 global headctxmenu progresscanv progressitem progresscoords statusw
2047 global fprogitem fprogcoord lastprogupdate progupdatepending
6df7403a 2048 global rprogitem rprogcoord rownumsel numcommits
d93f1713 2049 global have_tk85 use_ttk NS
ae4e3ff9
TR
2050 global git_version
2051 global worddiff
9a40c50c 2052
79056034
PM
2053 # The "mc" arguments here are purely so that xgettext
2054 # sees the following string as needing to be translated
5fdcbb13
DS
2055 set file {
2056 mc "File" cascade {
79056034 2057 {mc "Update" command updatecommits -accelerator F5}
a135f214 2058 {mc "Reload" command reloadcommits -accelerator Shift-F5}
79056034 2059 {mc "Reread references" command rereadrefs}
cea07cf8 2060 {mc "List references" command showrefs -accelerator F2}
7fb0abb1
AG
2061 {xx "" separator}
2062 {mc "Start git gui" command {exec git gui &}}
2063 {xx "" separator}
cea07cf8 2064 {mc "Quit" command doquit -accelerator Meta1-Q}
f2d0bbbd 2065 }}
5fdcbb13
DS
2066 set edit {
2067 mc "Edit" cascade {
79056034 2068 {mc "Preferences" command doprefs}
f2d0bbbd 2069 }}
5fdcbb13
DS
2070 set view {
2071 mc "View" cascade {
cea07cf8
AG
2072 {mc "New view..." command {newview 0} -accelerator Shift-F4}
2073 {mc "Edit view..." command editview -state disabled -accelerator F4}
79056034
PM
2074 {mc "Delete view" command delview -state disabled}
2075 {xx "" separator}
2076 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
f2d0bbbd 2077 }}
5fdcbb13
DS
2078 if {[tk windowingsystem] ne "aqua"} {
2079 set help {
2080 mc "Help" cascade {
2081 {mc "About gitk" command about}
2082 {mc "Key bindings" command keys}
2083 }}
2084 set bar [list $file $edit $view $help]
2085 } else {
2086 proc ::tk::mac::ShowPreferences {} {doprefs}
2087 proc ::tk::mac::Quit {} {doquit}
2088 lset file end [lreplace [lindex $file end] end-1 end]
2089 set apple {
2090 xx "Apple" cascade {
79056034 2091 {mc "About gitk" command about}
5fdcbb13
DS
2092 {xx "" separator}
2093 }}
2094 set help {
2095 mc "Help" cascade {
79056034 2096 {mc "Key bindings" command keys}
f2d0bbbd 2097 }}
5fdcbb13 2098 set bar [list $apple $file $view $help]
f2d0bbbd 2099 }
5fdcbb13 2100 makemenu .bar $bar
9a40c50c
PM
2101 . configure -menu .bar
2102
d93f1713
PT
2103 if {$use_ttk} {
2104 # cover the non-themed toplevel with a themed frame.
2105 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2106 }
2107
e9937d2a 2108 # the gui has upper and lower half, parts of a paned window.
d93f1713 2109 ${NS}::panedwindow .ctop -orient vertical
e9937d2a
JH
2110
2111 # possibly use assumed geometry
9ca72f4f 2112 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
2113 set geometry(topheight) [expr {15 * $linespc}]
2114 set geometry(topwidth) [expr {80 * $charspc}]
2115 set geometry(botheight) [expr {15 * $linespc}]
2116 set geometry(botwidth) [expr {50 * $charspc}]
d93f1713
PT
2117 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2118 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
e9937d2a
JH
2119 }
2120
2121 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
d93f1713
PT
2122 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2123 ${NS}::frame .tf.histframe
2124 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2125 if {!$use_ttk} {
2126 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2127 }
e9937d2a
JH
2128
2129 # create three canvases
2130 set cscroll .tf.histframe.csb
2131 set canv .tf.histframe.pwclist.canv
9ca72f4f 2132 canvas $canv \
60378c0c 2133 -selectbackground $selectbgcolor \
f8a2c0d1 2134 -background $bgcolor -bd 0 \
9f1afe05 2135 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
2136 .tf.histframe.pwclist add $canv
2137 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 2138 canvas $canv2 \
60378c0c 2139 -selectbackground $selectbgcolor \
f8a2c0d1 2140 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
2141 .tf.histframe.pwclist add $canv2
2142 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 2143 canvas $canv3 \
60378c0c 2144 -selectbackground $selectbgcolor \
f8a2c0d1 2145 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 2146 .tf.histframe.pwclist add $canv3
d93f1713
PT
2147 if {$use_ttk} {
2148 bind .tf.histframe.pwclist <Map> {
2149 bind %W <Map> {}
2150 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2151 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2152 }
2153 } else {
2154 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2155 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2156 }
e9937d2a
JH
2157
2158 # a scroll bar to rule them
d93f1713
PT
2159 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2160 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
e9937d2a
JH
2161 pack $cscroll -side right -fill y
2162 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 2163 lappend bglist $canv $canv2 $canv3
e9937d2a 2164 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 2165
e9937d2a 2166 # we have two button bars at bottom of top frame. Bar 1
d93f1713
PT
2167 ${NS}::frame .tf.bar
2168 ${NS}::frame .tf.lbar -height 15
e9937d2a
JH
2169
2170 set sha1entry .tf.bar.sha1
887fe3c4 2171 set entries $sha1entry
e9937d2a 2172 set sha1but .tf.bar.sha1label
0359ba72 2173 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
b039f0a6 2174 -command gotocommit -width 8
887fe3c4 2175 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 2176 pack .tf.bar.sha1label -side left
d93f1713 2177 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 2178 trace add variable sha1string write sha1change
98f350e5 2179 pack $sha1entry -side left -pady 2
d698206c 2180
f062e50f 2181 set bm_left_data {
d698206c
PM
2182 #define left_width 16
2183 #define left_height 16
2184 static unsigned char left_bits[] = {
2185 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2186 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2187 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2188 }
f062e50f 2189 set bm_right_data {
d698206c
PM
2190 #define right_width 16
2191 #define right_height 16
2192 static unsigned char right_bits[] = {
2193 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2194 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2195 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2196 }
252c52df
2197 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2198 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2199 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2200 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
f062e50f 2201
62e9ac5e
MK
2202 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2203 if {$use_ttk} {
2204 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2205 } else {
2206 .tf.bar.leftbut configure -image bm-left
2207 }
e9937d2a 2208 pack .tf.bar.leftbut -side left -fill y
62e9ac5e
MK
2209 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2210 if {$use_ttk} {
2211 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2212 } else {
2213 .tf.bar.rightbut configure -image bm-right
2214 }
e9937d2a 2215 pack .tf.bar.rightbut -side left -fill y
d698206c 2216
d93f1713 2217 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
6df7403a 2218 set rownumsel {}
d93f1713 2219 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
6df7403a 2220 -relief sunken -anchor e
d93f1713
PT
2221 ${NS}::label .tf.bar.rowlabel2 -text "/"
2222 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
6df7403a
PM
2223 -relief sunken -anchor e
2224 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2225 -side left
d93f1713
PT
2226 if {!$use_ttk} {
2227 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2228 }
6df7403a 2229 global selectedline
94b4a69f 2230 trace add variable selectedline write selectedline_change
6df7403a 2231
bb3edc8b
PM
2232 # Status label and progress bar
2233 set statusw .tf.bar.status
d93f1713 2234 ${NS}::label $statusw -width 15 -relief sunken
bb3edc8b 2235 pack $statusw -side left -padx 5
d93f1713
PT
2236 if {$use_ttk} {
2237 set progresscanv [ttk::progressbar .tf.bar.progress]
2238 } else {
2239 set h [expr {[font metrics uifont -linespace] + 2}]
2240 set progresscanv .tf.bar.progress
2241 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2242 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2243 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2244 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2245 }
2246 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
bb3edc8b
PM
2247 set progresscoords {0 0}
2248 set fprogcoord 0
a137a90f 2249 set rprogcoord 0
bb3edc8b
PM
2250 bind $progresscanv <Configure> adjustprogress
2251 set lastprogupdate [clock clicks -milliseconds]
2252 set progupdatepending 0
2253
687c8765 2254 # build up the bottom bar of upper window
d93f1713
PT
2255 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2256 ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2257 ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2258 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
687c8765
PM
2259 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2260 -side left -fill y
b007ee20 2261 set gdttype [mc "containing:"]
3cb1f9c9 2262 set gm [makedroplist .tf.lbar.gdttype gdttype \
b007ee20
CS
2263 [mc "containing:"] \
2264 [mc "touching paths:"] \
c33cb908
ML
2265 [mc "adding/removing string:"] \
2266 [mc "changing lines matching:"]]
687c8765 2267 trace add variable gdttype write gdttype_change
687c8765
PM
2268 pack .tf.lbar.gdttype -side left -fill y
2269
98f350e5 2270 set findstring {}
687c8765 2271 set fstring .tf.lbar.findstring
887fe3c4 2272 lappend entries $fstring
b9b142ff 2273 ${NS}::entry $fstring -width 30 -textvariable findstring
60f7a7dc 2274 trace add variable findstring write find_change
b007ee20 2275 set findtype [mc "Exact"]
d93f1713
PT
2276 set findtypemenu [makedroplist .tf.lbar.findtype \
2277 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 2278 trace add variable findtype write findcom_change
b007ee20 2279 set findloc [mc "All fields"]
d93f1713 2280 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
b007ee20 2281 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 2282 trace add variable findloc write find_change
687c8765
PM
2283 pack .tf.lbar.findloc -side right
2284 pack .tf.lbar.findtype -side right
2285 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
2286
2287 # Finish putting the upper half of the viewer together
2288 pack .tf.lbar -in .tf -side bottom -fill x
2289 pack .tf.bar -in .tf -side bottom -fill x
2290 pack .tf.histframe -fill both -side top -expand 1
2291 .ctop add .tf
d93f1713
PT
2292 if {!$use_ttk} {
2293 .ctop paneconfigure .tf -height $geometry(topheight)
2294 .ctop paneconfigure .tf -width $geometry(topwidth)
2295 }
e9937d2a
JH
2296
2297 # now build up the bottom
d93f1713 2298 ${NS}::panedwindow .pwbottom -orient horizontal
e9937d2a
JH
2299
2300 # lower left, a text box over search bar, scroll bar to the right
2301 # if we know window height, then that will set the lower text height, otherwise
2302 # we set lower text height which will drive window height
2303 if {[info exists geometry(main)]} {
d93f1713 2304 ${NS}::frame .bleft -width $geometry(botwidth)
e9937d2a 2305 } else {
d93f1713 2306 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
e9937d2a 2307 }
d93f1713
PT
2308 ${NS}::frame .bleft.top
2309 ${NS}::frame .bleft.mid
2310 ${NS}::frame .bleft.bottom
e9937d2a 2311
d93f1713 2312 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
2313 pack .bleft.top.search -side left -padx 5
2314 set sstring .bleft.top.sstring
d93f1713 2315 set searchstring ""
b9b142ff 2316 ${NS}::entry $sstring -width 20 -textvariable searchstring
3ea06f9f
PM
2317 lappend entries $sstring
2318 trace add variable searchstring write incrsearch
2319 pack $sstring -side left -expand 1 -fill x
d93f1713 2320 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 2321 -command changediffdisp -variable diffelide -value {0 0}
d93f1713 2322 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 2323 -command changediffdisp -variable diffelide -value {0 1}
d93f1713 2324 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 2325 -command changediffdisp -variable diffelide -value {1 0}
d93f1713 2326 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
a8d610a2 2327 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
0933b04e 2328 spinbox .bleft.mid.diffcontext -width 5 \
a41ddbb6 2329 -from 0 -increment 1 -to 10000000 \
890fae70
SP
2330 -validate all -validatecommand "diffcontextvalidate %P" \
2331 -textvariable diffcontextstring
2332 .bleft.mid.diffcontext set $diffcontext
2333 trace add variable diffcontextstring write diffcontextchange
2334 lappend entries .bleft.mid.diffcontext
2335 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
d93f1713 2336 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
b9b86007
SP
2337 -command changeignorespace -variable ignorespace
2338 pack .bleft.mid.ignspace -side left -padx 5
ae4e3ff9
TR
2339
2340 set worddiff [mc "Line diff"]
2341 if {[package vcompare $git_version "1.7.2"] >= 0} {
2342 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2343 [mc "Markup words"] [mc "Color words"]
2344 trace add variable worddiff write changeworddiff
2345 pack .bleft.mid.worddiff -side left -padx 5
2346 }
2347
8809d691 2348 set ctext .bleft.bottom.ctext
f8a2c0d1 2349 text $ctext -background $bgcolor -foreground $fgcolor \
9c311b32 2350 -state disabled -font textfont \
8809d691
PK
2351 -yscrollcommand scrolltext -wrap none \
2352 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4
PM
2353 if {$have_tk85} {
2354 $ctext conf -tabstyle wordprocessor
2355 }
d93f1713
PT
2356 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2357 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
e9937d2a 2358 pack .bleft.top -side top -fill x
a8d610a2 2359 pack .bleft.mid -side top -fill x
8809d691
PK
2360 grid $ctext .bleft.bottom.sb -sticky nsew
2361 grid .bleft.bottom.sbhorizontal -sticky ew
2362 grid columnconfigure .bleft.bottom 0 -weight 1
2363 grid rowconfigure .bleft.bottom 0 -weight 1
2364 grid rowconfigure .bleft.bottom 1 -weight 0
2365 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
2366 lappend bglist $ctext
2367 lappend fglist $ctext
d2610d11 2368
f1b86294 2369 $ctext tag conf comment -wrap $wrapcomment
252c52df 2370 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
f8a2c0d1
PM
2371 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2372 $ctext tag conf d0 -fore [lindex $diffcolors 0]
8b07dca1 2373 $ctext tag conf dresult -fore [lindex $diffcolors 1]
252c52df
2374 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2375 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2376 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2377 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2378 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2379 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2380 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2381 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2382 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2383 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2384 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2385 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2386 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2387 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2388 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2389 $ctext tag conf m15 -fore [lindex $mergecolors 15]
712fcc08 2390 $ctext tag conf mmax -fore darkgrey
b77b0278 2391 set mergemax 16
9c311b32
PM
2392 $ctext tag conf mresult -font textfontbold
2393 $ctext tag conf msep -font textfontbold
252c52df
2394 $ctext tag conf found -back $foundbgcolor
2395 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
d34835c9 2396 $ctext tag conf wwrap -wrap word
4399fe33 2397 $ctext tag conf bold -font textfontbold
e5c2d856 2398
e9937d2a 2399 .pwbottom add .bleft
d93f1713
PT
2400 if {!$use_ttk} {
2401 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2402 }
e9937d2a
JH
2403
2404 # lower right
d93f1713
PT
2405 ${NS}::frame .bright
2406 ${NS}::frame .bright.mode
2407 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 2408 -command reselectline -variable cmitmode -value "patch"
d93f1713 2409 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 2410 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
2411 grid .bright.mode.patch .bright.mode.tree -sticky ew
2412 pack .bright.mode -side top -fill x
2413 set cflist .bright.cfiles
9c311b32 2414 set indent [font measure mainfont "nn"]
e9937d2a 2415 text $cflist \
60378c0c 2416 -selectbackground $selectbgcolor \
f8a2c0d1 2417 -background $bgcolor -foreground $fgcolor \
9c311b32 2418 -font mainfont \
7fcceed7 2419 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 2420 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
2421 -cursor [. cget -cursor] \
2422 -spacing1 1 -spacing3 1
f8a2c0d1
PM
2423 lappend bglist $cflist
2424 lappend fglist $cflist
d93f1713 2425 ${NS}::scrollbar .bright.sb -command "$cflist yview"
e9937d2a 2426 pack .bright.sb -side right -fill y
d2610d11 2427 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
2428 $cflist tag configure highlight \
2429 -background [$cflist cget -selectbackground]
9c311b32 2430 $cflist tag configure bold -font mainfontbold
d2610d11 2431
e9937d2a
JH
2432 .pwbottom add .bright
2433 .ctop add .pwbottom
1db95b00 2434
b9bee115 2435 # restore window width & height if known
e9937d2a 2436 if {[info exists geometry(main)]} {
b9bee115
PM
2437 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2438 if {$w > [winfo screenwidth .]} {
2439 set w [winfo screenwidth .]
2440 }
2441 if {$h > [winfo screenheight .]} {
2442 set h [winfo screenheight .]
2443 }
2444 wm geometry . "${w}x$h"
2445 }
e9937d2a
JH
2446 }
2447
c876dbad
PT
2448 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2449 wm state . $geometry(state)
2450 }
2451
d23d98d3
SP
2452 if {[tk windowingsystem] eq {aqua}} {
2453 set M1B M1
5fdcbb13 2454 set ::BM "3"
d23d98d3
SP
2455 } else {
2456 set M1B Control
5fdcbb13 2457 set ::BM "2"
d23d98d3
SP
2458 }
2459
d93f1713
PT
2460 if {$use_ttk} {
2461 bind .ctop <Map> {
2462 bind %W <Map> {}
2463 %W sashpos 0 $::geometry(topheight)
2464 }
2465 bind .pwbottom <Map> {
2466 bind %W <Map> {}
2467 %W sashpos 0 $::geometry(botwidth)
2468 }
2469 }
2470
e9937d2a
JH
2471 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2472 pack .ctop -fill both -expand 1
c8dfbcf9
PM
2473 bindall <1> {selcanvline %W %x %y}
2474 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
2475 if {[tk windowingsystem] == "win32"} {
2476 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2477 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2478 } else {
2479 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2480 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
5dd57d51
JS
2481 if {[tk windowingsystem] eq "aqua"} {
2482 bindall <MouseWheel> {
2483 set delta [expr {- (%D)}]
2484 allcanvs yview scroll $delta units
2485 }
5fdcbb13
DS
2486 bindall <Shift-MouseWheel> {
2487 set delta [expr {- (%D)}]
2488 $canv xview scroll $delta units
2489 }
5dd57d51 2490 }
314c3093 2491 }
5fdcbb13
DS
2492 bindall <$::BM> "canvscan mark %W %x %y"
2493 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
decd0a1e
JL
2494 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2495 bind . <$M1B-Key-w> doquit
6e5f7203
RN
2496 bindkey <Home> selfirstline
2497 bindkey <End> sellastline
17386066
PM
2498 bind . <Key-Up> "selnextline -1"
2499 bind . <Key-Down> "selnextline 1"
cca5d946
PM
2500 bind . <Shift-Key-Up> "dofind -1 0"
2501 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
2502 bindkey <Key-Right> "goforw"
2503 bindkey <Key-Left> "goback"
2504 bind . <Key-Prior> "selnextpage -1"
2505 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
2506 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2507 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2508 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2509 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2510 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2511 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
2512 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2513 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2514 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
2515 bindkey p "selnextline -1"
2516 bindkey n "selnextline 1"
6e2dda35
RS
2517 bindkey z "goback"
2518 bindkey x "goforw"
811c70fc
JN
2519 bindkey k "selnextline -1"
2520 bindkey j "selnextline 1"
2521 bindkey h "goback"
6e2dda35 2522 bindkey l "goforw"
f4c54b3c 2523 bindkey b prevfile
cfb4563c
PM
2524 bindkey d "$ctext yview scroll 18 units"
2525 bindkey u "$ctext yview scroll -18 units"
97bed034 2526 bindkey / {focus $fstring}
b6e192db 2527 bindkey <Key-KP_Divide> {focus $fstring}
cca5d946
PM
2528 bindkey <Key-Return> {dofind 1 1}
2529 bindkey ? {dofind -1 1}
39ad8570 2530 bindkey f nextfile
cea07cf8 2531 bind . <F5> updatecommits
ebb91db8 2532 bindmodfunctionkey Shift 5 reloadcommits
cea07cf8 2533 bind . <F2> showrefs
69ecfcd6 2534 bindmodfunctionkey Shift 4 {newview 0}
cea07cf8 2535 bind . <F4> edit_or_newview
d23d98d3 2536 bind . <$M1B-q> doquit
cca5d946
PM
2537 bind . <$M1B-f> {dofind 1 1}
2538 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
2539 bind . <$M1B-r> dosearchback
2540 bind . <$M1B-s> dosearch
2541 bind . <$M1B-equal> {incrfont 1}
646f3a14 2542 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
2543 bind . <$M1B-KP_Add> {incrfont 1}
2544 bind . <$M1B-minus> {incrfont -1}
2545 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 2546 wm protocol . WM_DELETE_WINDOW doquit
e2f90ee4 2547 bind . <Destroy> {stop_backends}
df3d83b1 2548 bind . <Button-1> "click %W"
cca5d946 2549 bind $fstring <Key-Return> {dofind 1 1}
968ce45c 2550 bind $sha1entry <Key-Return> {gotocommit; break}
ee3dc72e 2551 bind $sha1entry <<PasteSelection>> clearsha1
7fcceed7
PM
2552 bind $cflist <1> {sel_flist %W %x %y; break}
2553 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 2554 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
d277e89f
PM
2555 global ctxbut
2556 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
7cdc3556 2557 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
4adcbea0 2558 bind $ctext <Button-1> {focus %W}
c4614994 2559 bind $ctext <<Selection>> rehighlight_search_results
ea13cba1
PM
2560
2561 set maincursor [. cget -cursor]
2562 set textcursor [$ctext cget -cursor]
94a2eede 2563 set curtextcursor $textcursor
84ba7345 2564
c8dfbcf9 2565 set rowctxmenu .rowctxmenu
f2d0bbbd 2566 makemenu $rowctxmenu {
79056034
PM
2567 {mc "Diff this -> selected" command {diffvssel 0}}
2568 {mc "Diff selected -> this" command {diffvssel 1}}
2569 {mc "Make patch" command mkpatch}
2570 {mc "Create tag" command mktag}
2571 {mc "Write commit to file" command writecommit}
2572 {mc "Create new branch" command mkbranch}
2573 {mc "Cherry-pick this commit" command cherrypick}
2574 {mc "Reset HEAD branch to here" command resethead}
b9fdba7f
PM
2575 {mc "Mark this commit" command markhere}
2576 {mc "Return to mark" command gotomark}
2577 {mc "Find descendant of this and mark" command find_common_desc}
010509f2 2578 {mc "Compare with marked commit" command compare_commits}
6febdede
PM
2579 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2580 {mc "Diff marked commit -> this" command {diffvsmark 1}}
8f3ff933 2581 {mc "Revert this commit" command revert}
f2d0bbbd
PM
2582 }
2583 $rowctxmenu configure -tearoff 0
10299152 2584
219ea3a9 2585 set fakerowmenu .fakerowmenu
f2d0bbbd 2586 makemenu $fakerowmenu {
79056034
PM
2587 {mc "Diff this -> selected" command {diffvssel 0}}
2588 {mc "Diff selected -> this" command {diffvssel 1}}
2589 {mc "Make patch" command mkpatch}
6febdede
PM
2590 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2591 {mc "Diff marked commit -> this" command {diffvsmark 1}}
f2d0bbbd
PM
2592 }
2593 $fakerowmenu configure -tearoff 0
219ea3a9 2594
10299152 2595 set headctxmenu .headctxmenu
f2d0bbbd 2596 makemenu $headctxmenu {
79056034
PM
2597 {mc "Check out this branch" command cobranch}
2598 {mc "Remove this branch" command rmbranch}
f2d0bbbd
PM
2599 }
2600 $headctxmenu configure -tearoff 0
3244729a
PM
2601
2602 global flist_menu
2603 set flist_menu .flistctxmenu
f2d0bbbd 2604 makemenu $flist_menu {
79056034
PM
2605 {mc "Highlight this too" command {flist_hl 0}}
2606 {mc "Highlight this only" command {flist_hl 1}}
2607 {mc "External diff" command {external_diff}}
2608 {mc "Blame parent commit" command {external_blame 1}}
f2d0bbbd
PM
2609 }
2610 $flist_menu configure -tearoff 0
7cdc3556
AG
2611
2612 global diff_menu
2613 set diff_menu .diffctxmenu
2614 makemenu $diff_menu {
8a897742 2615 {mc "Show origin of this line" command show_line_source}
7cdc3556
AG
2616 {mc "Run git gui blame on this line" command {external_blame_diff}}
2617 }
2618 $diff_menu configure -tearoff 0
df3d83b1
PM
2619}
2620
314c3093
ML
2621# Windows sends all mouse wheel events to the current focused window, not
2622# the one where the mouse hovers, so bind those events here and redirect
2623# to the correct window
2624proc windows_mousewheel_redirector {W X Y D} {
2625 global canv canv2 canv3
2626 set w [winfo containing -displayof $W $X $Y]
2627 if {$w ne ""} {
2628 set u [expr {$D < 0 ? 5 : -5}]
2629 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2630 allcanvs yview scroll $u units
2631 } else {
2632 catch {
2633 $w yview scroll $u units
2634 }
2635 }
2636 }
2637}
2638
6df7403a
PM
2639# Update row number label when selectedline changes
2640proc selectedline_change {n1 n2 op} {
2641 global selectedline rownumsel
2642
94b4a69f 2643 if {$selectedline eq {}} {
6df7403a
PM
2644 set rownumsel {}
2645 } else {
2646 set rownumsel [expr {$selectedline + 1}]
2647 }
2648}
2649
be0cd098
PM
2650# mouse-2 makes all windows scan vertically, but only the one
2651# the cursor is in scans horizontally
2652proc canvscan {op w x y} {
2653 global canv canv2 canv3
2654 foreach c [list $canv $canv2 $canv3] {
2655 if {$c == $w} {
2656 $c scan $op $x $y
2657 } else {
2658 $c scan $op 0 $y
2659 }
2660 }
2661}
2662
9f1afe05
PM
2663proc scrollcanv {cscroll f0 f1} {
2664 $cscroll set $f0 $f1
31c0eaa8 2665 drawvisible
908c3585 2666 flushhighlights
9f1afe05
PM
2667}
2668
df3d83b1
PM
2669# when we make a key binding for the toplevel, make sure
2670# it doesn't get triggered when that key is pressed in the
2671# find string entry widget.
2672proc bindkey {ev script} {
887fe3c4 2673 global entries
df3d83b1
PM
2674 bind . $ev $script
2675 set escript [bind Entry $ev]
2676 if {$escript == {}} {
2677 set escript [bind Entry <Key>]
2678 }
887fe3c4
PM
2679 foreach e $entries {
2680 bind $e $ev "$escript; break"
2681 }
df3d83b1
PM
2682}
2683
69ecfcd6
AW
2684proc bindmodfunctionkey {mod n script} {
2685 bind . <$mod-F$n> $script
2686 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2687}
2688
df3d83b1 2689# set the focus back to the toplevel for any click outside
887fe3c4 2690# the entry widgets
df3d83b1 2691proc click {w} {
bd441de4
ML
2692 global ctext entries
2693 foreach e [concat $entries $ctext] {
887fe3c4 2694 if {$w == $e} return
df3d83b1 2695 }
887fe3c4 2696 focus .
0fba86b3
PM
2697}
2698
bb3edc8b
PM
2699# Adjust the progress bar for a change in requested extent or canvas size
2700proc adjustprogress {} {
2701 global progresscanv progressitem progresscoords
2702 global fprogitem fprogcoord lastprogupdate progupdatepending
d93f1713
PT
2703 global rprogitem rprogcoord use_ttk
2704
2705 if {$use_ttk} {
2706 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2707 return
2708 }
bb3edc8b
PM
2709
2710 set w [expr {[winfo width $progresscanv] - 4}]
2711 set x0 [expr {$w * [lindex $progresscoords 0]}]
2712 set x1 [expr {$w * [lindex $progresscoords 1]}]
2713 set h [winfo height $progresscanv]
2714 $progresscanv coords $progressitem $x0 0 $x1 $h
2715 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 2716 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
2717 set now [clock clicks -milliseconds]
2718 if {$now >= $lastprogupdate + 100} {
2719 set progupdatepending 0
2720 update
2721 } elseif {!$progupdatepending} {
2722 set progupdatepending 1
2723 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2724 }
2725}
2726
2727proc doprogupdate {} {
2728 global lastprogupdate progupdatepending
2729
2730 if {$progupdatepending} {
2731 set progupdatepending 0
2732 set lastprogupdate [clock clicks -milliseconds]
2733 update
2734 }
2735}
2736
0fba86b3 2737proc savestuff {w} {
32f1b3e4 2738 global canv canv2 canv3 mainfont textfont uifont tabstop
712fcc08 2739 global stuffsaved findmergefiles maxgraphpct
219ea3a9 2740 global maxwidth showneartags showlocalchanges
2d480856 2741 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
7a39a17a 2742 global cmitmode wrapcomment datetimeformat limitdiffs
5497f7a2 2743 global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
252c52df
2744 global uifgcolor uifgdisabledcolor
2745 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
2746 global tagbgcolor tagfgcolor tagoutlinecolor
2747 global reflinecolor filesepbgcolor filesepfgcolor
2748 global mergecolors foundbgcolor currentsearchhitbgcolor
2749 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
2750 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
2751 global linkfgcolor circleoutlinecolor
21ac8a8d 2752 global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
d34835c9 2753 global hideremotes want_ttk maxrefs
4ef17537 2754
0fba86b3 2755 if {$stuffsaved} return
df3d83b1 2756 if {![winfo viewable .]} return
0fba86b3 2757 catch {
9bedb0e1 2758 if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
0fba86b3 2759 set f [open "~/.gitk-new" w]
9832e4f2
PM
2760 if {$::tcl_platform(platform) eq {windows}} {
2761 file attributes "~/.gitk-new" -hidden true
2762 }
f0654861
PM
2763 puts $f [list set mainfont $mainfont]
2764 puts $f [list set textfont $textfont]
4840be66 2765 puts $f [list set uifont $uifont]
7e12f1a6 2766 puts $f [list set tabstop $tabstop]
f0654861 2767 puts $f [list set findmergefiles $findmergefiles]
8d858d1a 2768 puts $f [list set maxgraphpct $maxgraphpct]
04c13d38 2769 puts $f [list set maxwidth $maxwidth]
f8b28a40 2770 puts $f [list set cmitmode $cmitmode]
f1b86294 2771 puts $f [list set wrapcomment $wrapcomment]
95293b58 2772 puts $f [list set autoselect $autoselect]
21ac8a8d 2773 puts $f [list set autosellen $autosellen]
b8ab2e17 2774 puts $f [list set showneartags $showneartags]
d34835c9 2775 puts $f [list set maxrefs $maxrefs]
ffe15297 2776 puts $f [list set hideremotes $hideremotes]
219ea3a9 2777 puts $f [list set showlocalchanges $showlocalchanges]
e8b5f4be 2778 puts $f [list set datetimeformat $datetimeformat]
7a39a17a 2779 puts $f [list set limitdiffs $limitdiffs]
5497f7a2 2780 puts $f [list set uicolor $uicolor]
0cc08ff7 2781 puts $f [list set want_ttk $want_ttk]
f8a2c0d1
PM
2782 puts $f [list set bgcolor $bgcolor]
2783 puts $f [list set fgcolor $fgcolor]
252c52df
2784 puts $f [list set uifgcolor $uifgcolor]
2785 puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
f8a2c0d1
PM
2786 puts $f [list set colors $colors]
2787 puts $f [list set diffcolors $diffcolors]
252c52df 2788 puts $f [list set mergecolors $mergecolors]
e3e901be 2789 puts $f [list set markbgcolor $markbgcolor]
890fae70 2790 puts $f [list set diffcontext $diffcontext]
60378c0c 2791 puts $f [list set selectbgcolor $selectbgcolor]
252c52df
2792 puts $f [list set foundbgcolor $foundbgcolor]
2793 puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
314f5de1 2794 puts $f [list set extdifftool $extdifftool]
39ee47ef 2795 puts $f [list set perfile_attrs $perfile_attrs]
252c52df
2796 puts $f [list set headbgcolor $headbgcolor]
2797 puts $f [list set headfgcolor $headfgcolor]
2798 puts $f [list set headoutlinecolor $headoutlinecolor]
2799 puts $f [list set remotebgcolor $remotebgcolor]
2800 puts $f [list set tagbgcolor $tagbgcolor]
2801 puts $f [list set tagfgcolor $tagfgcolor]
2802 puts $f [list set tagoutlinecolor $tagoutlinecolor]
2803 puts $f [list set reflinecolor $reflinecolor]
2804 puts $f [list set filesepbgcolor $filesepbgcolor]
2805 puts $f [list set filesepfgcolor $filesepfgcolor]
2806 puts $f [list set linehoverbgcolor $linehoverbgcolor]
2807 puts $f [list set linehoverfgcolor $linehoverfgcolor]
2808 puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
2809 puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
2810 puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
2811 puts $f [list set indexcirclecolor $indexcirclecolor]
2812 puts $f [list set circlecolors $circlecolors]
2813 puts $f [list set linkfgcolor $linkfgcolor]
2814 puts $f [list set circleoutlinecolor $circleoutlinecolor]
e9937d2a 2815
b6047c5a 2816 puts $f "set geometry(main) [wm geometry .]"
c876dbad 2817 puts $f "set geometry(state) [wm state .]"
e9937d2a
JH
2818 puts $f "set geometry(topwidth) [winfo width .tf]"
2819 puts $f "set geometry(topheight) [winfo height .tf]"
d93f1713
PT
2820 if {$use_ttk} {
2821 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2822 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2823 } else {
2824 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2825 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2826 }
e9937d2a
JH
2827 puts $f "set geometry(botwidth) [winfo width .bleft]"
2828 puts $f "set geometry(botheight) [winfo height .bleft]"
2829
a90a6d24
PM
2830 puts -nonewline $f "set permviews {"
2831 for {set v 0} {$v < $nextviewnum} {incr v} {
2832 if {$viewperm($v)} {
2d480856 2833 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
a90a6d24
PM
2834 }
2835 }
2836 puts $f "}"
0fba86b3
PM
2837 close $f
2838 file rename -force "~/.gitk-new" "~/.gitk"
2839 }
2840 set stuffsaved 1
1db95b00
PM
2841}
2842
43bddeb4 2843proc resizeclistpanes {win w} {
d93f1713 2844 global oldwidth use_ttk
418c4c7b 2845 if {[info exists oldwidth($win)]} {
d93f1713
PT
2846 if {$use_ttk} {
2847 set s0 [$win sashpos 0]
2848 set s1 [$win sashpos 1]
2849 } else {
2850 set s0 [$win sash coord 0]
2851 set s1 [$win sash coord 1]
2852 }
43bddeb4
PM
2853 if {$w < 60} {
2854 set sash0 [expr {int($w/2 - 2)}]
2855 set sash1 [expr {int($w*5/6 - 2)}]
2856 } else {
2857 set factor [expr {1.0 * $w / $oldwidth($win)}]
2858 set sash0 [expr {int($factor * [lindex $s0 0])}]
2859 set sash1 [expr {int($factor * [lindex $s1 0])}]
2860 if {$sash0 < 30} {
2861 set sash0 30
2862 }
2863 if {$sash1 < $sash0 + 20} {
2ed49d54 2864 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
2865 }
2866 if {$sash1 > $w - 10} {
2ed49d54 2867 set sash1 [expr {$w - 10}]
43bddeb4 2868 if {$sash0 > $sash1 - 20} {
2ed49d54 2869 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
2870 }
2871 }
2872 }
d93f1713
PT
2873 if {$use_ttk} {
2874 $win sashpos 0 $sash0
2875 $win sashpos 1 $sash1
2876 } else {
2877 $win sash place 0 $sash0 [lindex $s0 1]
2878 $win sash place 1 $sash1 [lindex $s1 1]
2879 }
43bddeb4
PM
2880 }
2881 set oldwidth($win) $w
2882}
2883
2884proc resizecdetpanes {win w} {
d93f1713 2885 global oldwidth use_ttk
418c4c7b 2886 if {[info exists oldwidth($win)]} {
d93f1713
PT
2887 if {$use_ttk} {
2888 set s0 [$win sashpos 0]
2889 } else {
2890 set s0 [$win sash coord 0]
2891 }
43bddeb4
PM
2892 if {$w < 60} {
2893 set sash0 [expr {int($w*3/4 - 2)}]
2894 } else {
2895 set factor [expr {1.0 * $w / $oldwidth($win)}]
2896 set sash0 [expr {int($factor * [lindex $s0 0])}]
2897 if {$sash0 < 45} {
2898 set sash0 45
2899 }
2900 if {$sash0 > $w - 15} {
2ed49d54 2901 set sash0 [expr {$w - 15}]
43bddeb4
PM
2902 }
2903 }
d93f1713
PT
2904 if {$use_ttk} {
2905 $win sashpos 0 $sash0
2906 } else {
2907 $win sash place 0 $sash0 [lindex $s0 1]
2908 }
43bddeb4
PM
2909 }
2910 set oldwidth($win) $w
2911}
2912
b5721c72
PM
2913proc allcanvs args {
2914 global canv canv2 canv3
2915 eval $canv $args
2916 eval $canv2 $args
2917 eval $canv3 $args
2918}
2919
2920proc bindall {event action} {
2921 global canv canv2 canv3
2922 bind $canv $event $action
2923 bind $canv2 $event $action
2924 bind $canv3 $event $action
2925}
2926
9a40c50c 2927proc about {} {
d93f1713 2928 global uifont NS
9a40c50c
PM
2929 set w .about
2930 if {[winfo exists $w]} {
2931 raise $w
2932 return
2933 }
d93f1713 2934 ttk_toplevel $w
d990cedf 2935 wm title $w [mc "About gitk"]
e7d64008 2936 make_transient $w .
d990cedf 2937 message $w.m -text [mc "
9f1afe05 2938Gitk - a commit viewer for git
9a40c50c 2939
bb3e86a1 2940Copyright \u00a9 2005-2011 Paul Mackerras
9a40c50c 2941
d990cedf 2942Use and redistribute under the terms of the GNU General Public License"] \
3a950e9a
ER
2943 -justify center -aspect 400 -border 2 -bg white -relief groove
2944 pack $w.m -side top -fill x -padx 2 -pady 2
d93f1713 2945 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 2946 pack $w.ok -side bottom
3a950e9a
ER
2947 bind $w <Visibility> "focus $w.ok"
2948 bind $w <Key-Escape> "destroy $w"
2949 bind $w <Key-Return> "destroy $w"
d93f1713 2950 tk::PlaceWindow $w widget .
9a40c50c
PM
2951}
2952
4e95e1f7 2953proc keys {} {
d93f1713 2954 global NS
4e95e1f7
PM
2955 set w .keys
2956 if {[winfo exists $w]} {
2957 raise $w
2958 return
2959 }
d23d98d3
SP
2960 if {[tk windowingsystem] eq {aqua}} {
2961 set M1T Cmd
2962 } else {
2963 set M1T Ctrl
2964 }
d93f1713 2965 ttk_toplevel $w
d990cedf 2966 wm title $w [mc "Gitk key bindings"]
e7d64008 2967 make_transient $w .
3d2c998e
MB
2968 message $w.m -text "
2969[mc "Gitk key bindings:"]
2970
2971[mc "<%s-Q> Quit" $M1T]
decd0a1e 2972[mc "<%s-W> Close window" $M1T]
3d2c998e
MB
2973[mc "<Home> Move to first commit"]
2974[mc "<End> Move to last commit"]
811c70fc
JN
2975[mc "<Up>, p, k Move up one commit"]
2976[mc "<Down>, n, j Move down one commit"]
2977[mc "<Left>, z, h Go back in history list"]
3d2c998e
MB
2978[mc "<Right>, x, l Go forward in history list"]
2979[mc "<PageUp> Move up one page in commit list"]
2980[mc "<PageDown> Move down one page in commit list"]
2981[mc "<%s-Home> Scroll to top of commit list" $M1T]
2982[mc "<%s-End> Scroll to bottom of commit list" $M1T]
2983[mc "<%s-Up> Scroll commit list up one line" $M1T]
2984[mc "<%s-Down> Scroll commit list down one line" $M1T]
2985[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2986[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2987[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2988[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2989[mc "<Delete>, b Scroll diff view up one page"]
2990[mc "<Backspace> Scroll diff view up one page"]
2991[mc "<Space> Scroll diff view down one page"]
2992[mc "u Scroll diff view up 18 lines"]
2993[mc "d Scroll diff view down 18 lines"]
2994[mc "<%s-F> Find" $M1T]
2995[mc "<%s-G> Move to next find hit" $M1T]
2996[mc "<Return> Move to next find hit"]
97bed034 2997[mc "/ Focus the search box"]
3d2c998e
MB
2998[mc "? Move to previous find hit"]
2999[mc "f Scroll diff view to next file"]
3000[mc "<%s-S> Search for next hit in diff view" $M1T]
3001[mc "<%s-R> Search for previous hit in diff view" $M1T]
3002[mc "<%s-KP+> Increase font size" $M1T]
3003[mc "<%s-plus> Increase font size" $M1T]
3004[mc "<%s-KP-> Decrease font size" $M1T]
3005[mc "<%s-minus> Decrease font size" $M1T]
3006[mc "<F5> Update"]
3007" \
3a950e9a
ER
3008 -justify left -bg white -border 2 -relief groove
3009 pack $w.m -side top -fill both -padx 2 -pady 2
d93f1713 3010 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
76f15947 3011 bind $w <Key-Escape> [list destroy $w]
4e95e1f7 3012 pack $w.ok -side bottom
3a950e9a
ER
3013 bind $w <Visibility> "focus $w.ok"
3014 bind $w <Key-Escape> "destroy $w"
3015 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
3016}
3017
7fcceed7
PM
3018# Procedures for manipulating the file list window at the
3019# bottom right of the overall window.
f8b28a40
PM
3020
3021proc treeview {w l openlevs} {
3022 global treecontents treediropen treeheight treeparent treeindex
3023
3024 set ix 0
3025 set treeindex() 0
3026 set lev 0
3027 set prefix {}
3028 set prefixend -1
3029 set prefendstack {}
3030 set htstack {}
3031 set ht 0
3032 set treecontents() {}
3033 $w conf -state normal
3034 foreach f $l {
3035 while {[string range $f 0 $prefixend] ne $prefix} {
3036 if {$lev <= $openlevs} {
3037 $w mark set e:$treeindex($prefix) "end -1c"
3038 $w mark gravity e:$treeindex($prefix) left
3039 }
3040 set treeheight($prefix) $ht
3041 incr ht [lindex $htstack end]
3042 set htstack [lreplace $htstack end end]
3043 set prefixend [lindex $prefendstack end]
3044 set prefendstack [lreplace $prefendstack end end]
3045 set prefix [string range $prefix 0 $prefixend]
3046 incr lev -1
3047 }
3048 set tail [string range $f [expr {$prefixend+1}] end]
3049 while {[set slash [string first "/" $tail]] >= 0} {
3050 lappend htstack $ht
3051 set ht 0
3052 lappend prefendstack $prefixend
3053 incr prefixend [expr {$slash + 1}]
3054 set d [string range $tail 0 $slash]
3055 lappend treecontents($prefix) $d
3056 set oldprefix $prefix
3057 append prefix $d
3058 set treecontents($prefix) {}
3059 set treeindex($prefix) [incr ix]
3060 set treeparent($prefix) $oldprefix
3061 set tail [string range $tail [expr {$slash+1}] end]
3062 if {$lev <= $openlevs} {
3063 set ht 1
3064 set treediropen($prefix) [expr {$lev < $openlevs}]
3065 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3066 $w mark set d:$ix "end -1c"
3067 $w mark gravity d:$ix left
3068 set str "\n"
3069 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3070 $w insert end $str
3071 $w image create end -align center -image $bm -padx 1 \
3072 -name a:$ix
45a9d505 3073 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
3074 $w mark set s:$ix "end -1c"
3075 $w mark gravity s:$ix left
3076 }
3077 incr lev
3078 }
3079 if {$tail ne {}} {
3080 if {$lev <= $openlevs} {
3081 incr ht
3082 set str "\n"
3083 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3084 $w insert end $str
45a9d505 3085 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
3086 }
3087 lappend treecontents($prefix) $tail
3088 }
3089 }
3090 while {$htstack ne {}} {
3091 set treeheight($prefix) $ht
3092 incr ht [lindex $htstack end]
3093 set htstack [lreplace $htstack end end]
096e96b4
BD
3094 set prefixend [lindex $prefendstack end]
3095 set prefendstack [lreplace $prefendstack end end]
3096 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
3097 }
3098 $w conf -state disabled
3099}
3100
3101proc linetoelt {l} {
3102 global treeheight treecontents
3103
3104 set y 2
3105 set prefix {}
3106 while {1} {
3107 foreach e $treecontents($prefix) {
3108 if {$y == $l} {
3109 return "$prefix$e"
3110 }
3111 set n 1
3112 if {[string index $e end] eq "/"} {
3113 set n $treeheight($prefix$e)
3114 if {$y + $n > $l} {
3115 append prefix $e
3116 incr y
3117 break
3118 }
3119 }
3120 incr y $n
3121 }
3122 }
3123}
3124
45a9d505
PM
3125proc highlight_tree {y prefix} {
3126 global treeheight treecontents cflist
3127
3128 foreach e $treecontents($prefix) {
3129 set path $prefix$e
3130 if {[highlight_tag $path] ne {}} {
3131 $cflist tag add bold $y.0 "$y.0 lineend"
3132 }
3133 incr y
3134 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3135 set y [highlight_tree $y $path]
3136 }
3137 }
3138 return $y
3139}
3140
f8b28a40
PM
3141proc treeclosedir {w dir} {
3142 global treediropen treeheight treeparent treeindex
3143
3144 set ix $treeindex($dir)
3145 $w conf -state normal
3146 $w delete s:$ix e:$ix
3147 set treediropen($dir) 0
3148 $w image configure a:$ix -image tri-rt
3149 $w conf -state disabled
3150 set n [expr {1 - $treeheight($dir)}]
3151 while {$dir ne {}} {
3152 incr treeheight($dir) $n
3153 set dir $treeparent($dir)
3154 }
3155}
3156
3157proc treeopendir {w dir} {
3158 global treediropen treeheight treeparent treecontents treeindex
3159
3160 set ix $treeindex($dir)
3161 $w conf -state normal
3162 $w image configure a:$ix -image tri-dn
3163 $w mark set e:$ix s:$ix
3164 $w mark gravity e:$ix right
3165 set lev 0
3166 set str "\n"
3167 set n [llength $treecontents($dir)]
3168 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3169 incr lev
3170 append str "\t"
3171 incr treeheight($x) $n
3172 }
3173 foreach e $treecontents($dir) {
45a9d505 3174 set de $dir$e
f8b28a40 3175 if {[string index $e end] eq "/"} {
f8b28a40
PM
3176 set iy $treeindex($de)
3177 $w mark set d:$iy e:$ix
3178 $w mark gravity d:$iy left
3179 $w insert e:$ix $str
3180 set treediropen($de) 0
3181 $w image create e:$ix -align center -image tri-rt -padx 1 \
3182 -name a:$iy
45a9d505 3183 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3184 $w mark set s:$iy e:$ix
3185 $w mark gravity s:$iy left
3186 set treeheight($de) 1
3187 } else {
3188 $w insert e:$ix $str
45a9d505 3189 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3190 }
3191 }
b8a640ee 3192 $w mark gravity e:$ix right
f8b28a40
PM
3193 $w conf -state disabled
3194 set treediropen($dir) 1
3195 set top [lindex [split [$w index @0,0] .] 0]
3196 set ht [$w cget -height]
3197 set l [lindex [split [$w index s:$ix] .] 0]
3198 if {$l < $top} {
3199 $w yview $l.0
3200 } elseif {$l + $n + 1 > $top + $ht} {
3201 set top [expr {$l + $n + 2 - $ht}]
3202 if {$l < $top} {
3203 set top $l
3204 }
3205 $w yview $top.0
3206 }
3207}
3208
3209proc treeclick {w x y} {
3210 global treediropen cmitmode ctext cflist cflist_top
3211
3212 if {$cmitmode ne "tree"} return
3213 if {![info exists cflist_top]} return
3214 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3215 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3216 $cflist tag add highlight $l.0 "$l.0 lineend"
3217 set cflist_top $l
3218 if {$l == 1} {
3219 $ctext yview 1.0
3220 return
3221 }
3222 set e [linetoelt $l]
3223 if {[string index $e end] ne "/"} {
3224 showfile $e
3225 } elseif {$treediropen($e)} {
3226 treeclosedir $w $e
3227 } else {
3228 treeopendir $w $e
3229 }
3230}
3231
3232proc setfilelist {id} {
8a897742 3233 global treefilelist cflist jump_to_here
f8b28a40
PM
3234
3235 treeview $cflist $treefilelist($id) 0
8a897742
PM
3236 if {$jump_to_here ne {}} {
3237 set f [lindex $jump_to_here 0]
3238 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3239 showfile $f
3240 }
3241 }
f8b28a40
PM
3242}
3243
3244image create bitmap tri-rt -background black -foreground blue -data {
3245 #define tri-rt_width 13
3246 #define tri-rt_height 13
3247 static unsigned char tri-rt_bits[] = {
3248 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3249 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3250 0x00, 0x00};
3251} -maskdata {
3252 #define tri-rt-mask_width 13
3253 #define tri-rt-mask_height 13
3254 static unsigned char tri-rt-mask_bits[] = {
3255 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3256 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3257 0x08, 0x00};
3258}
3259image create bitmap tri-dn -background black -foreground blue -data {
3260 #define tri-dn_width 13
3261 #define tri-dn_height 13
3262 static unsigned char tri-dn_bits[] = {
3263 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3264 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3265 0x00, 0x00};
3266} -maskdata {
3267 #define tri-dn-mask_width 13
3268 #define tri-dn-mask_height 13
3269 static unsigned char tri-dn-mask_bits[] = {
3270 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3271 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3272 0x00, 0x00};
3273}
3274
887c996e
PM
3275image create bitmap reficon-T -background black -foreground yellow -data {
3276 #define tagicon_width 13
3277 #define tagicon_height 9
3278 static unsigned char tagicon_bits[] = {
3279 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3280 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3281} -maskdata {
3282 #define tagicon-mask_width 13
3283 #define tagicon-mask_height 9
3284 static unsigned char tagicon-mask_bits[] = {
3285 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3286 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3287}
3288set rectdata {
3289 #define headicon_width 13
3290 #define headicon_height 9
3291 static unsigned char headicon_bits[] = {
3292 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3293 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3294}
3295set rectmask {
3296 #define headicon-mask_width 13
3297 #define headicon-mask_height 9
3298 static unsigned char headicon-mask_bits[] = {
3299 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3300 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3301}
3302image create bitmap reficon-H -background black -foreground green \
3303 -data $rectdata -maskdata $rectmask
3304image create bitmap reficon-o -background black -foreground "#ddddff" \
3305 -data $rectdata -maskdata $rectmask
3306
7fcceed7 3307proc init_flist {first} {
7fcc92bf 3308 global cflist cflist_top difffilestart
7fcceed7
PM
3309
3310 $cflist conf -state normal
3311 $cflist delete 0.0 end
3312 if {$first ne {}} {
3313 $cflist insert end $first
3314 set cflist_top 1
7fcceed7
PM
3315 $cflist tag add highlight 1.0 "1.0 lineend"
3316 } else {
3317 catch {unset cflist_top}
3318 }
3319 $cflist conf -state disabled
3320 set difffilestart {}
3321}
3322
63b79191
PM
3323proc highlight_tag {f} {
3324 global highlight_paths
3325
3326 foreach p $highlight_paths {
3327 if {[string match $p $f]} {
3328 return "bold"
3329 }
3330 }
3331 return {}
3332}
3333
3334proc highlight_filelist {} {
45a9d505 3335 global cmitmode cflist
63b79191 3336
45a9d505
PM
3337 $cflist conf -state normal
3338 if {$cmitmode ne "tree"} {
63b79191
PM
3339 set end [lindex [split [$cflist index end] .] 0]
3340 for {set l 2} {$l < $end} {incr l} {
3341 set line [$cflist get $l.0 "$l.0 lineend"]
3342 if {[highlight_tag $line] ne {}} {
3343 $cflist tag add bold $l.0 "$l.0 lineend"
3344 }
3345 }
45a9d505
PM
3346 } else {
3347 highlight_tree 2 {}
63b79191 3348 }
45a9d505 3349 $cflist conf -state disabled
63b79191
PM
3350}
3351
3352proc unhighlight_filelist {} {
45a9d505 3353 global cflist
63b79191 3354
45a9d505
PM
3355 $cflist conf -state normal
3356 $cflist tag remove bold 1.0 end
3357 $cflist conf -state disabled
63b79191
PM
3358}
3359
f8b28a40 3360proc add_flist {fl} {
45a9d505 3361 global cflist
7fcceed7 3362
45a9d505
PM
3363 $cflist conf -state normal
3364 foreach f $fl {
3365 $cflist insert end "\n"
3366 $cflist insert end $f [highlight_tag $f]
7fcceed7 3367 }
45a9d505 3368 $cflist conf -state disabled
7fcceed7
PM
3369}
3370
3371proc sel_flist {w x y} {
45a9d505 3372 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 3373
f8b28a40 3374 if {$cmitmode eq "tree"} return
7fcceed7
PM
3375 if {![info exists cflist_top]} return
3376 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
3377 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3378 $cflist tag add highlight $l.0 "$l.0 lineend"
3379 set cflist_top $l
f8b28a40
PM
3380 if {$l == 1} {
3381 $ctext yview 1.0
3382 } else {
3383 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 3384 }
b967135d 3385 suppress_highlighting_file_for_current_scrollpos
7fcceed7
PM
3386}
3387
3244729a
PM
3388proc pop_flist_menu {w X Y x y} {
3389 global ctext cflist cmitmode flist_menu flist_menu_file
3390 global treediffs diffids
3391
bb3edc8b 3392 stopfinding
3244729a
PM
3393 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3394 if {$l <= 1} return
3395 if {$cmitmode eq "tree"} {
3396 set e [linetoelt $l]
3397 if {[string index $e end] eq "/"} return
3398 } else {
3399 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3400 }
3401 set flist_menu_file $e
314f5de1
TA
3402 set xdiffstate "normal"
3403 if {$cmitmode eq "tree"} {
3404 set xdiffstate "disabled"
3405 }
3406 # Disable "External diff" item in tree mode
3407 $flist_menu entryconf 2 -state $xdiffstate
3244729a
PM
3408 tk_popup $flist_menu $X $Y
3409}
3410
7cdc3556
AG
3411proc find_ctext_fileinfo {line} {
3412 global ctext_file_names ctext_file_lines
3413
3414 set ok [bsearch $ctext_file_lines $line]
3415 set tline [lindex $ctext_file_lines $ok]
3416
3417 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3418 return {}
3419 } else {
3420 return [list [lindex $ctext_file_names $ok] $tline]
3421 }
3422}
3423
3424proc pop_diff_menu {w X Y x y} {
3425 global ctext diff_menu flist_menu_file
3426 global diff_menu_txtpos diff_menu_line
3427 global diff_menu_filebase
3428
7cdc3556
AG
3429 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3430 set diff_menu_line [lindex $diff_menu_txtpos 0]
190ec52c
PM
3431 # don't pop up the menu on hunk-separator or file-separator lines
3432 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3433 return
3434 }
3435 stopfinding
7cdc3556
AG
3436 set f [find_ctext_fileinfo $diff_menu_line]
3437 if {$f eq {}} return
3438 set flist_menu_file [lindex $f 0]
3439 set diff_menu_filebase [lindex $f 1]
3440 tk_popup $diff_menu $X $Y
3441}
3442
3244729a 3443proc flist_hl {only} {
bb3edc8b 3444 global flist_menu_file findstring gdttype
3244729a
PM
3445
3446 set x [shellquote $flist_menu_file]
b007ee20 3447 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 3448 set findstring $x
3244729a 3449 } else {
bb3edc8b 3450 append findstring " " $x
3244729a 3451 }
b007ee20 3452 set gdttype [mc "touching paths:"]
3244729a
PM
3453}
3454
c21398be
PM
3455proc gitknewtmpdir {} {
3456 global diffnum gitktmpdir gitdir
3457
3458 if {![info exists gitktmpdir]} {
929f577e 3459 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
c21398be
PM
3460 if {[catch {file mkdir $gitktmpdir} err]} {
3461 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3462 unset gitktmpdir
3463 return {}
3464 }
3465 set diffnum 0
3466 }
3467 incr diffnum
3468 set diffdir [file join $gitktmpdir $diffnum]
3469 if {[catch {file mkdir $diffdir} err]} {
3470 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3471 return {}
3472 }
3473 return $diffdir
3474}
3475
314f5de1
TA
3476proc save_file_from_commit {filename output what} {
3477 global nullfile
3478
3479 if {[catch {exec git show $filename -- > $output} err]} {
3480 if {[string match "fatal: bad revision *" $err]} {
3481 return $nullfile
3482 }
3945d2c0 3483 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
314f5de1
TA
3484 return {}
3485 }
3486 return $output
3487}
3488
3489proc external_diff_get_one_file {diffid filename diffdir} {
3490 global nullid nullid2 nullfile
784b7e2f 3491 global worktree
314f5de1
TA
3492
3493 if {$diffid == $nullid} {
784b7e2f 3494 set difffile [file join $worktree $filename]
314f5de1
TA
3495 if {[file exists $difffile]} {
3496 return $difffile
3497 }
3498 return $nullfile
3499 }
3500 if {$diffid == $nullid2} {
3501 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3502 return [save_file_from_commit :$filename $difffile index]
3503 }
3504 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3505 return [save_file_from_commit $diffid:$filename $difffile \
3506 "revision $diffid"]
3507}
3508
3509proc external_diff {} {
c21398be 3510 global nullid nullid2
314f5de1
TA
3511 global flist_menu_file
3512 global diffids
c21398be 3513 global extdifftool
314f5de1
TA
3514
3515 if {[llength $diffids] == 1} {
3516 # no reference commit given
3517 set diffidto [lindex $diffids 0]
3518 if {$diffidto eq $nullid} {
3519 # diffing working copy with index
3520 set diffidfrom $nullid2
3521 } elseif {$diffidto eq $nullid2} {
3522 # diffing index with HEAD
3523 set diffidfrom "HEAD"
3524 } else {
3525 # use first parent commit
3526 global parentlist selectedline
3527 set diffidfrom [lindex $parentlist $selectedline 0]
3528 }
3529 } else {
3530 set diffidfrom [lindex $diffids 0]
3531 set diffidto [lindex $diffids 1]
3532 }
3533
3534 # make sure that several diffs wont collide
c21398be
PM
3535 set diffdir [gitknewtmpdir]
3536 if {$diffdir eq {}} return
314f5de1
TA
3537
3538 # gather files to diff
3539 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3540 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3541
3542 if {$difffromfile ne {} && $difftofile ne {}} {
b575b2f1
PT
3543 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3544 if {[catch {set fl [open |$cmd r]} err]} {
314f5de1 3545 file delete -force $diffdir
3945d2c0 3546 error_popup "$extdifftool: [mc "command failed:"] $err"
314f5de1
TA
3547 } else {
3548 fconfigure $fl -blocking 0
3549 filerun $fl [list delete_at_eof $fl $diffdir]
3550 }
3551 }
3552}
3553
7cdc3556
AG
3554proc find_hunk_blamespec {base line} {
3555 global ctext
3556
3557 # Find and parse the hunk header
3558 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3559 if {$s_lix eq {}} return
3560
3561 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3562 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3563 s_line old_specs osz osz1 new_line nsz]} {
3564 return
3565 }
3566
3567 # base lines for the parents
3568 set base_lines [list $new_line]
3569 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3570 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3571 old_spec old_line osz]} {
3572 return
3573 }
3574 lappend base_lines $old_line
3575 }
3576
3577 # Now scan the lines to determine offset within the hunk
7cdc3556
AG
3578 set max_parent [expr {[llength $base_lines]-2}]
3579 set dline 0
3580 set s_lno [lindex [split $s_lix "."] 0]
3581
190ec52c
PM
3582 # Determine if the line is removed
3583 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3584 if {[string match {[-+ ]*} $chunk]} {
7cdc3556
AG
3585 set removed_idx [string first "-" $chunk]
3586 # Choose a parent index
190ec52c
PM
3587 if {$removed_idx >= 0} {
3588 set parent $removed_idx
3589 } else {
3590 set unchanged_idx [string first " " $chunk]
3591 if {$unchanged_idx >= 0} {
3592 set parent $unchanged_idx
7cdc3556 3593 } else {
190ec52c
PM
3594 # blame the current commit
3595 set parent -1
7cdc3556
AG
3596 }
3597 }
3598 # then count other lines that belong to it
190ec52c
PM
3599 for {set i $line} {[incr i -1] > $s_lno} {} {
3600 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3601 # Determine if the line is removed
3602 set removed_idx [string first "-" $chunk]
3603 if {$parent >= 0} {
3604 set code [string index $chunk $parent]
3605 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3606 incr dline
3607 }
3608 } else {
3609 if {$removed_idx < 0} {
3610 incr dline
3611 }
7cdc3556
AG
3612 }
3613 }
190ec52c
PM
3614 incr parent
3615 } else {
3616 set parent 0
7cdc3556
AG
3617 }
3618
7cdc3556
AG
3619 incr dline [lindex $base_lines $parent]
3620 return [list $parent $dline]
3621}
3622
3623proc external_blame_diff {} {
8b07dca1 3624 global currentid cmitmode
7cdc3556
AG
3625 global diff_menu_txtpos diff_menu_line
3626 global diff_menu_filebase flist_menu_file
3627
3628 if {$cmitmode eq "tree"} {
3629 set parent_idx 0
190ec52c 3630 set line [expr {$diff_menu_line - $diff_menu_filebase}]
7cdc3556
AG
3631 } else {
3632 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3633 if {$hinfo ne {}} {
3634 set parent_idx [lindex $hinfo 0]
3635 set line [lindex $hinfo 1]
3636 } else {
3637 set parent_idx 0
3638 set line 0
3639 }
3640 }
3641
3642 external_blame $parent_idx $line
3643}
3644
fc4977e1
PM
3645# Find the SHA1 ID of the blob for file $fname in the index
3646# at stage 0 or 2
3647proc index_sha1 {fname} {
3648 set f [open [list | git ls-files -s $fname] r]
3649 while {[gets $f line] >= 0} {
3650 set info [lindex [split $line "\t"] 0]
3651 set stage [lindex $info 2]
3652 if {$stage eq "0" || $stage eq "2"} {
3653 close $f
3654 return [lindex $info 1]
3655 }
3656 }
3657 close $f
3658 return {}
3659}
3660
9712b81a
PM
3661# Turn an absolute path into one relative to the current directory
3662proc make_relative {f} {
a4390ace
MH
3663 if {[file pathtype $f] eq "relative"} {
3664 return $f
3665 }
9712b81a
PM
3666 set elts [file split $f]
3667 set here [file split [pwd]]
3668 set ei 0
3669 set hi 0
3670 set res {}
3671 foreach d $here {
3672 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3673 lappend res ".."
3674 } else {
3675 incr ei
3676 }
3677 incr hi
3678 }
3679 set elts [concat $res [lrange $elts $ei end]]
3680 return [eval file join $elts]
3681}
3682
7cdc3556 3683proc external_blame {parent_idx {line {}}} {
0a2a9793 3684 global flist_menu_file cdup
77aa0ae8
AG
3685 global nullid nullid2
3686 global parentlist selectedline currentid
3687
3688 if {$parent_idx > 0} {
3689 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3690 } else {
3691 set base_commit $currentid
3692 }
3693
3694 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3695 error_popup [mc "No such commit"]
3696 return
3697 }
3698
7cdc3556
AG
3699 set cmdline [list git gui blame]
3700 if {$line ne {} && $line > 1} {
3701 lappend cmdline "--line=$line"
3702 }
0a2a9793 3703 set f [file join $cdup $flist_menu_file]
9712b81a
PM
3704 # Unfortunately it seems git gui blame doesn't like
3705 # being given an absolute path...
3706 set f [make_relative $f]
3707 lappend cmdline $base_commit $f
7cdc3556 3708 if {[catch {eval exec $cmdline &} err]} {
3945d2c0 3709 error_popup "[mc "git gui blame: command failed:"] $err"
77aa0ae8
AG
3710 }
3711}
3712
8a897742
PM
3713proc show_line_source {} {
3714 global cmitmode currentid parents curview blamestuff blameinst
3715 global diff_menu_line diff_menu_filebase flist_menu_file
9b6adf34 3716 global nullid nullid2 gitdir cdup
8a897742 3717
fc4977e1 3718 set from_index {}
8a897742
PM
3719 if {$cmitmode eq "tree"} {
3720 set id $currentid
3721 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3722 } else {
3723 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3724 if {$h eq {}} return
3725 set pi [lindex $h 0]
3726 if {$pi == 0} {
3727 mark_ctext_line $diff_menu_line
3728 return
3729 }
fc4977e1
PM
3730 incr pi -1
3731 if {$currentid eq $nullid} {
3732 if {$pi > 0} {
3733 # must be a merge in progress...
3734 if {[catch {
3735 # get the last line from .git/MERGE_HEAD
3736 set f [open [file join $gitdir MERGE_HEAD] r]
3737 set id [lindex [split [read $f] "\n"] end-1]
3738 close $f
3739 } err]} {
3740 error_popup [mc "Couldn't read merge head: %s" $err]
3741 return
3742 }
3743 } elseif {$parents($curview,$currentid) eq $nullid2} {
3744 # need to do the blame from the index
3745 if {[catch {
3746 set from_index [index_sha1 $flist_menu_file]
3747 } err]} {
3748 error_popup [mc "Error reading index: %s" $err]
3749 return
3750 }
9712b81a
PM
3751 } else {
3752 set id $parents($curview,$currentid)
fc4977e1
PM
3753 }
3754 } else {
3755 set id [lindex $parents($curview,$currentid) $pi]
3756 }
8a897742
PM
3757 set line [lindex $h 1]
3758 }
fc4977e1
PM
3759 set blameargs {}
3760 if {$from_index ne {}} {
3761 lappend blameargs | git cat-file blob $from_index
3762 }
3763 lappend blameargs | git blame -p -L$line,+1
3764 if {$from_index ne {}} {
3765 lappend blameargs --contents -
3766 } else {
3767 lappend blameargs $id
3768 }
9b6adf34 3769 lappend blameargs -- [file join $cdup $flist_menu_file]
8a897742 3770 if {[catch {
fc4977e1 3771 set f [open $blameargs r]
8a897742
PM
3772 } err]} {
3773 error_popup [mc "Couldn't start git blame: %s" $err]
3774 return
3775 }
f3413079 3776 nowbusy blaming [mc "Searching"]
8a897742
PM
3777 fconfigure $f -blocking 0
3778 set i [reg_instance $f]
3779 set blamestuff($i) {}
3780 set blameinst $i
3781 filerun $f [list read_line_source $f $i]
3782}
3783
3784proc stopblaming {} {
3785 global blameinst
3786
3787 if {[info exists blameinst]} {
3788 stop_instance $blameinst
3789 unset blameinst
f3413079 3790 notbusy blaming
8a897742
PM
3791 }
3792}
3793
3794proc read_line_source {fd inst} {
fc4977e1 3795 global blamestuff curview commfd blameinst nullid nullid2
8a897742
PM
3796
3797 while {[gets $fd line] >= 0} {
3798 lappend blamestuff($inst) $line
3799 }
3800 if {![eof $fd]} {
3801 return 1
3802 }
3803 unset commfd($inst)
3804 unset blameinst
f3413079 3805 notbusy blaming
8a897742
PM
3806 fconfigure $fd -blocking 1
3807 if {[catch {close $fd} err]} {
3808 error_popup [mc "Error running git blame: %s" $err]
3809 return 0
3810 }
3811
3812 set fname {}
3813 set line [split [lindex $blamestuff($inst) 0] " "]
3814 set id [lindex $line 0]
3815 set lnum [lindex $line 1]
3816 if {[string length $id] == 40 && [string is xdigit $id] &&
3817 [string is digit -strict $lnum]} {
3818 # look for "filename" line
3819 foreach l $blamestuff($inst) {
3820 if {[string match "filename *" $l]} {
3821 set fname [string range $l 9 end]
3822 break
3823 }
3824 }
3825 }
3826 if {$fname ne {}} {
3827 # all looks good, select it
fc4977e1
PM
3828 if {$id eq $nullid} {
3829 # blame uses all-zeroes to mean not committed,
3830 # which would mean a change in the index
3831 set id $nullid2
3832 }
8a897742
PM
3833 if {[commitinview $id $curview]} {
3834 selectline [rowofcommit $id] 1 [list $fname $lnum]
3835 } else {
3836 error_popup [mc "That line comes from commit %s, \
3837 which is not in this view" [shortids $id]]
3838 }
3839 } else {
3840 puts "oops couldn't parse git blame output"
3841 }
3842 return 0
3843}
3844
314f5de1
TA
3845# delete $dir when we see eof on $f (presumably because the child has exited)
3846proc delete_at_eof {f dir} {
3847 while {[gets $f line] >= 0} {}
3848 if {[eof $f]} {
3849 if {[catch {close $f} err]} {
3945d2c0 3850 error_popup "[mc "External diff viewer failed:"] $err"
314f5de1
TA
3851 }
3852 file delete -force $dir
3853 return 0
3854 }
3855 return 1
3856}
3857
098dd8a3
PM
3858# Functions for adding and removing shell-type quoting
3859
3860proc shellquote {str} {
3861 if {![string match "*\['\"\\ \t]*" $str]} {
3862 return $str
3863 }
3864 if {![string match "*\['\"\\]*" $str]} {
3865 return "\"$str\""
3866 }
3867 if {![string match "*'*" $str]} {
3868 return "'$str'"
3869 }
3870 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3871}
3872
3873proc shellarglist {l} {
3874 set str {}
3875 foreach a $l {
3876 if {$str ne {}} {
3877 append str " "
3878 }
3879 append str [shellquote $a]
3880 }
3881 return $str
3882}
3883
3884proc shelldequote {str} {
3885 set ret {}
3886 set used -1
3887 while {1} {
3888 incr used
3889 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3890 append ret [string range $str $used end]
3891 set used [string length $str]
3892 break
3893 }
3894 set first [lindex $first 0]
3895 set ch [string index $str $first]
3896 if {$first > $used} {
3897 append ret [string range $str $used [expr {$first - 1}]]
3898 set used $first
3899 }
3900 if {$ch eq " " || $ch eq "\t"} break
3901 incr used
3902 if {$ch eq "'"} {
3903 set first [string first "'" $str $used]
3904 if {$first < 0} {
3905 error "unmatched single-quote"
3906 }
3907 append ret [string range $str $used [expr {$first - 1}]]
3908 set used $first
3909 continue
3910 }
3911 if {$ch eq "\\"} {
3912 if {$used >= [string length $str]} {
3913 error "trailing backslash"
3914 }
3915 append ret [string index $str $used]
3916 continue
3917 }
3918 # here ch == "\""
3919 while {1} {
3920 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3921 error "unmatched double-quote"
3922 }
3923 set first [lindex $first 0]
3924 set ch [string index $str $first]
3925 if {$first > $used} {
3926 append ret [string range $str $used [expr {$first - 1}]]
3927 set used $first
3928 }
3929 if {$ch eq "\""} break
3930 incr used
3931 append ret [string index $str $used]
3932 incr used
3933 }
3934 }
3935 return [list $used $ret]
3936}
3937
3938proc shellsplit {str} {
3939 set l {}
3940 while {1} {
3941 set str [string trimleft $str]
3942 if {$str eq {}} break
3943 set dq [shelldequote $str]
3944 set n [lindex $dq 0]
3945 set word [lindex $dq 1]
3946 set str [string range $str $n end]
3947 lappend l $word
3948 }
3949 return $l
3950}
3951
7fcceed7
PM
3952# Code to implement multiple views
3953
da7c24dd 3954proc newview {ishighlight} {
218a900b
AG
3955 global nextviewnum newviewname newishighlight
3956 global revtreeargs viewargscmd newviewopts curview
50b44ece 3957
da7c24dd 3958 set newishighlight $ishighlight
50b44ece
PM
3959 set top .gitkview
3960 if {[winfo exists $top]} {
3961 raise $top
3962 return
3963 }
5d11f794 3964 decode_view_opts $nextviewnum $revtreeargs
a3a1f579 3965 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
218a900b
AG
3966 set newviewopts($nextviewnum,perm) 0
3967 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
d990cedf 3968 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
3969}
3970
218a900b 3971set known_view_options {
13d40b61
EN
3972 {perm b . {} {mc "Remember this view"}}
3973 {reflabel l + {} {mc "References (space separated list):"}}
3974 {refs t15 .. {} {mc "Branches & tags:"}}
3975 {allrefs b *. "--all" {mc "All refs"}}
3976 {branches b . "--branches" {mc "All (local) branches"}}
3977 {tags b . "--tags" {mc "All tags"}}
3978 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3979 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3980 {author t15 .. "--author=*" {mc "Author:"}}
3981 {committer t15 . "--committer=*" {mc "Committer:"}}
3982 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3983 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3984 {changes_l l + {} {mc "Changes to Files:"}}
3985 {pickaxe_s r0 . {} {mc "Fixed String"}}
3986 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3987 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3988 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3989 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3990 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3991 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3992 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3993 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3994 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3995 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3996 {lright b . "--left-right" {mc "Mark branch sides"}}
3997 {first b . "--first-parent" {mc "Limit to first parent"}}
f687aaa8 3998 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
13d40b61
EN
3999 {args t50 *. {} {mc "Additional arguments to git log:"}}
4000 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4001 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
218a900b
AG
4002 }
4003
e7feb695 4004# Convert $newviewopts($n, ...) into args for git log.
218a900b
AG
4005proc encode_view_opts {n} {
4006 global known_view_options newviewopts
4007
4008 set rargs [list]
4009 foreach opt $known_view_options {
4010 set patterns [lindex $opt 3]
4011 if {$patterns eq {}} continue
4012 set pattern [lindex $patterns 0]
4013
218a900b 4014 if {[lindex $opt 1] eq "b"} {
13d40b61 4015 set val $newviewopts($n,[lindex $opt 0])
218a900b
AG
4016 if {$val} {
4017 lappend rargs $pattern
4018 }
13d40b61
EN
4019 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4020 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4021 set val $newviewopts($n,$button_id)
4022 if {$val eq $value} {
4023 lappend rargs $pattern
4024 }
218a900b 4025 } else {
13d40b61 4026 set val $newviewopts($n,[lindex $opt 0])
218a900b
AG
4027 set val [string trim $val]
4028 if {$val ne {}} {
4029 set pfix [string range $pattern 0 end-1]
4030 lappend rargs $pfix$val
4031 }
4032 }
4033 }
13d40b61 4034 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
218a900b
AG
4035 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4036}
4037
e7feb695 4038# Fill $newviewopts($n, ...) based on args for git log.
218a900b
AG
4039proc decode_view_opts {n view_args} {
4040 global known_view_options newviewopts
4041
4042 foreach opt $known_view_options {
13d40b61 4043 set id [lindex $opt 0]
218a900b 4044 if {[lindex $opt 1] eq "b"} {
13d40b61
EN
4045 # Checkboxes
4046 set val 0
4047 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4048 # Radiobuttons
4049 regexp {^(.*_)} $id uselessvar id
218a900b
AG
4050 set val 0
4051 } else {
13d40b61 4052 # Text fields
218a900b
AG
4053 set val {}
4054 }
13d40b61 4055 set newviewopts($n,$id) $val
218a900b
AG
4056 }
4057 set oargs [list]
13d40b61 4058 set refargs [list]
218a900b
AG
4059 foreach arg $view_args {
4060 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4061 && ![info exists found(limit)]} {
4062 set newviewopts($n,limit) $cnt
4063 set found(limit) 1
4064 continue
4065 }
4066 catch { unset val }
4067 foreach opt $known_view_options {
4068 set id [lindex $opt 0]
4069 if {[info exists found($id)]} continue
4070 foreach pattern [lindex $opt 3] {
4071 if {![string match $pattern $arg]} continue
13d40b61
EN
4072 if {[lindex $opt 1] eq "b"} {
4073 # Check buttons
4074 set val 1
4075 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4076 # Radio buttons
4077 regexp {^(.*_)} $id uselessvar id
4078 set val $num
4079 } else {
4080 # Text input fields
218a900b
AG
4081 set size [string length $pattern]
4082 set val [string range $arg [expr {$size-1}] end]
218a900b
AG
4083 }
4084 set newviewopts($n,$id) $val
4085 set found($id) 1
4086 break
4087 }
4088 if {[info exists val]} break
4089 }
4090 if {[info exists val]} continue
13d40b61
EN
4091 if {[regexp {^-} $arg]} {
4092 lappend oargs $arg
4093 } else {
4094 lappend refargs $arg
4095 }
218a900b 4096 }
13d40b61 4097 set newviewopts($n,refs) [shellarglist $refargs]
218a900b
AG
4098 set newviewopts($n,args) [shellarglist $oargs]
4099}
4100
cea07cf8
AG
4101proc edit_or_newview {} {
4102 global curview
4103
4104 if {$curview > 0} {
4105 editview
4106 } else {
4107 newview 0
4108 }
4109}
4110
d16c0812
PM
4111proc editview {} {
4112 global curview
218a900b
AG
4113 global viewname viewperm newviewname newviewopts
4114 global viewargs viewargscmd
d16c0812
PM
4115
4116 set top .gitkvedit-$curview
4117 if {[winfo exists $top]} {
4118 raise $top
4119 return
4120 }
5d11f794 4121 decode_view_opts $curview $viewargs($curview)
218a900b
AG
4122 set newviewname($curview) $viewname($curview)
4123 set newviewopts($curview,perm) $viewperm($curview)
4124 set newviewopts($curview,cmd) $viewargscmd($curview)
b56e0a9a 4125 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
d16c0812
PM
4126}
4127
4128proc vieweditor {top n title} {
218a900b 4129 global newviewname newviewopts viewfiles bgcolor
d93f1713 4130 global known_view_options NS
d16c0812 4131
d93f1713 4132 ttk_toplevel $top
e0a01995 4133 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
e7d64008 4134 make_transient $top .
218a900b
AG
4135
4136 # View name
d93f1713 4137 ${NS}::frame $top.nfr
eae7d64a 4138 ${NS}::label $top.nl -text [mc "View Name"]
d93f1713 4139 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
218a900b 4140 pack $top.nfr -in $top -fill x -pady 5 -padx 3
13d40b61
EN
4141 pack $top.nl -in $top.nfr -side left -padx {0 5}
4142 pack $top.name -in $top.nfr -side left -padx {0 25}
218a900b
AG
4143
4144 # View options
4145 set cframe $top.nfr
4146 set cexpand 0
4147 set cnt 0
4148 foreach opt $known_view_options {
4149 set id [lindex $opt 0]
4150 set type [lindex $opt 1]
4151 set flags [lindex $opt 2]
4152 set title [eval [lindex $opt 4]]
4153 set lxpad 0
4154
4155 if {$flags eq "+" || $flags eq "*"} {
4156 set cframe $top.fr$cnt
4157 incr cnt
d93f1713 4158 ${NS}::frame $cframe
218a900b
AG
4159 pack $cframe -in $top -fill x -pady 3 -padx 3
4160 set cexpand [expr {$flags eq "*"}]
13d40b61
EN
4161 } elseif {$flags eq ".." || $flags eq "*."} {
4162 set cframe $top.fr$cnt
4163 incr cnt
eae7d64a 4164 ${NS}::frame $cframe
13d40b61
EN
4165 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4166 set cexpand [expr {$flags eq "*."}]
218a900b
AG
4167 } else {
4168 set lxpad 5
4169 }
4170
13d40b61 4171 if {$type eq "l"} {
eae7d64a 4172 ${NS}::label $cframe.l_$id -text $title
13d40b61
EN
4173 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4174 } elseif {$type eq "b"} {
d93f1713 4175 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
218a900b
AG
4176 pack $cframe.c_$id -in $cframe -side left \
4177 -padx [list $lxpad 0] -expand $cexpand -anchor w
13d40b61
EN
4178 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4179 regexp {^(.*_)} $id uselessvar button_id
eae7d64a 4180 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
13d40b61
EN
4181 pack $cframe.c_$id -in $cframe -side left \
4182 -padx [list $lxpad 0] -expand $cexpand -anchor w
218a900b 4183 } elseif {[regexp {^t(\d+)$} $type type sz]} {
d93f1713
PT
4184 ${NS}::label $cframe.l_$id -text $title
4185 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
4186 -textvariable newviewopts($n,$id)
4187 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4188 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4189 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
d93f1713
PT
4190 ${NS}::label $cframe.l_$id -text $title
4191 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
4192 -textvariable newviewopts($n,$id)
4193 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4194 pack $cframe.e_$id -in $cframe -side top -fill x
13d40b61 4195 } elseif {$type eq "path"} {
eae7d64a 4196 ${NS}::label $top.l -text $title
13d40b61 4197 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
b9b142ff 4198 text $top.t -width 40 -height 5 -background $bgcolor
13d40b61
EN
4199 if {[info exists viewfiles($n)]} {
4200 foreach f $viewfiles($n) {
4201 $top.t insert end $f
4202 $top.t insert end "\n"
4203 }
4204 $top.t delete {end - 1c} end
4205 $top.t mark set insert 0.0
4206 }
4207 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
218a900b
AG
4208 }
4209 }
4210
d93f1713
PT
4211 ${NS}::frame $top.buts
4212 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4213 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4214 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
218a900b
AG
4215 bind $top <Control-Return> [list newviewok $top $n]
4216 bind $top <F5> [list newviewok $top $n 1]
76f15947 4217 bind $top <Escape> [list destroy $top]
218a900b 4218 grid $top.buts.ok $top.buts.apply $top.buts.can
50b44ece
PM
4219 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4220 grid columnconfigure $top.buts 1 -weight 1 -uniform a
218a900b
AG
4221 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4222 pack $top.buts -in $top -side top -fill x
50b44ece
PM
4223 focus $top.t
4224}
4225
908c3585 4226proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
4227 set nmenu [$m index end]
4228 for {set i $first} {$i <= $nmenu} {incr i} {
4229 if {[$m entrycget $i -command] eq $cmd} {
908c3585 4230 eval $m $op $i $argv
da7c24dd 4231 break
d16c0812
PM
4232 }
4233 }
da7c24dd
PM
4234}
4235
4236proc allviewmenus {n op args} {
687c8765 4237 # global viewhlmenu
908c3585 4238
3cd204e5 4239 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 4240 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
4241}
4242
218a900b 4243proc newviewok {top n {apply 0}} {
da7c24dd 4244 global nextviewnum newviewperm newviewname newishighlight
d16c0812 4245 global viewname viewfiles viewperm selectedview curview
218a900b 4246 global viewargs viewargscmd newviewopts viewhlmenu
50b44ece 4247
098dd8a3 4248 if {[catch {
218a900b 4249 set newargs [encode_view_opts $n]
098dd8a3 4250 } err]} {
84a76f18 4251 error_popup "[mc "Error in commit selection arguments:"] $err" $top
098dd8a3
PM
4252 return
4253 }
50b44ece 4254 set files {}
d16c0812 4255 foreach f [split [$top.t get 0.0 end] "\n"] {
50b44ece
PM
4256 set ft [string trim $f]
4257 if {$ft ne {}} {
4258 lappend files $ft
4259 }
4260 }
d16c0812
PM
4261 if {![info exists viewfiles($n)]} {
4262 # creating a new view
4263 incr nextviewnum
4264 set viewname($n) $newviewname($n)
218a900b 4265 set viewperm($n) $newviewopts($n,perm)
d16c0812 4266 set viewfiles($n) $files
098dd8a3 4267 set viewargs($n) $newargs
218a900b 4268 set viewargscmd($n) $newviewopts($n,cmd)
da7c24dd
PM
4269 addviewmenu $n
4270 if {!$newishighlight} {
7eb3cb9c 4271 run showview $n
da7c24dd 4272 } else {
7eb3cb9c 4273 run addvhighlight $n
da7c24dd 4274 }
d16c0812
PM
4275 } else {
4276 # editing an existing view
218a900b 4277 set viewperm($n) $newviewopts($n,perm)
d16c0812
PM
4278 if {$newviewname($n) ne $viewname($n)} {
4279 set viewname($n) $newviewname($n)
3cd204e5 4280 doviewmenu .bar.view 5 [list showview $n] \
908c3585 4281 entryconf [list -label $viewname($n)]
687c8765
PM
4282 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4283 # entryconf [list -label $viewname($n) -value $viewname($n)]
d16c0812 4284 }
2d480856 4285 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
218a900b 4286 $newviewopts($n,cmd) ne $viewargscmd($n)} {
d16c0812 4287 set viewfiles($n) $files
098dd8a3 4288 set viewargs($n) $newargs
218a900b 4289 set viewargscmd($n) $newviewopts($n,cmd)
d16c0812 4290 if {$curview == $n} {
7fcc92bf 4291 run reloadcommits
d16c0812
PM
4292 }
4293 }
4294 }
218a900b 4295 if {$apply} return
d16c0812 4296 catch {destroy $top}
50b44ece
PM
4297}
4298
4299proc delview {} {
7fcc92bf 4300 global curview viewperm hlview selectedhlview
50b44ece
PM
4301
4302 if {$curview == 0} return
908c3585 4303 if {[info exists hlview] && $hlview == $curview} {
b007ee20 4304 set selectedhlview [mc "None"]
908c3585
PM
4305 unset hlview
4306 }
da7c24dd 4307 allviewmenus $curview delete
a90a6d24 4308 set viewperm($curview) 0
50b44ece
PM
4309 showview 0
4310}
4311
da7c24dd 4312proc addviewmenu {n} {
908c3585 4313 global viewname viewhlmenu
da7c24dd
PM
4314
4315 .bar.view add radiobutton -label $viewname($n) \
4316 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
4317 #$viewhlmenu add radiobutton -label $viewname($n) \
4318 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
4319}
4320
50b44ece 4321proc showview {n} {
3ed31a81 4322 global curview cached_commitrow ordertok
f5f3c2e2 4323 global displayorder parentlist rowidlist rowisopt rowfinal
7fcc92bf
PM
4324 global colormap rowtextx nextcolor canvxmax
4325 global numcommits viewcomplete
50b44ece 4326 global selectedline currentid canv canvy0
4fb0fa19 4327 global treediffs
3e76608d 4328 global pending_select mainheadid
0380081c 4329 global commitidx
3e76608d 4330 global selectedview
97645683 4331 global hlview selectedhlview commitinterest
50b44ece
PM
4332
4333 if {$n == $curview} return
4334 set selid {}
7fcc92bf
PM
4335 set ymax [lindex [$canv cget -scrollregion] 3]
4336 set span [$canv yview]
4337 set ytop [expr {[lindex $span 0] * $ymax}]
4338 set ybot [expr {[lindex $span 1] * $ymax}]
4339 set yscreen [expr {($ybot - $ytop) / 2}]
94b4a69f 4340 if {$selectedline ne {}} {
50b44ece
PM
4341 set selid $currentid
4342 set y [yc $selectedline]
50b44ece
PM
4343 if {$ytop < $y && $y < $ybot} {
4344 set yscreen [expr {$y - $ytop}]
50b44ece 4345 }
e507fd48
PM
4346 } elseif {[info exists pending_select]} {
4347 set selid $pending_select
4348 unset pending_select
50b44ece
PM
4349 }
4350 unselectline
fdedbcfb 4351 normalline
50b44ece
PM
4352 catch {unset treediffs}
4353 clear_display
908c3585
PM
4354 if {[info exists hlview] && $hlview == $n} {
4355 unset hlview
b007ee20 4356 set selectedhlview [mc "None"]
908c3585 4357 }
97645683 4358 catch {unset commitinterest}
7fcc92bf 4359 catch {unset cached_commitrow}
9257d8f7 4360 catch {unset ordertok}
50b44ece
PM
4361
4362 set curview $n
a90a6d24 4363 set selectedview $n
f2d0bbbd
PM
4364 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4365 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 4366
df904497 4367 run refill_reflist
7fcc92bf 4368 if {![info exists viewcomplete($n)]} {
567c34e0 4369 getcommits $selid
50b44ece
PM
4370 return
4371 }
4372
7fcc92bf
PM
4373 set displayorder {}
4374 set parentlist {}
4375 set rowidlist {}
4376 set rowisopt {}
4377 set rowfinal {}
f5f3c2e2 4378 set numcommits $commitidx($n)
22626ef4 4379
50b44ece
PM
4380 catch {unset colormap}
4381 catch {unset rowtextx}
da7c24dd
PM
4382 set nextcolor 0
4383 set canvxmax [$canv cget -width]
50b44ece
PM
4384 set curview $n
4385 set row 0
50b44ece
PM
4386 setcanvscroll
4387 set yf 0
e507fd48 4388 set row {}
7fcc92bf
PM
4389 if {$selid ne {} && [commitinview $selid $n]} {
4390 set row [rowofcommit $selid]
50b44ece
PM
4391 # try to get the selected row in the same position on the screen
4392 set ymax [lindex [$canv cget -scrollregion] 3]
4393 set ytop [expr {[yc $row] - $yscreen}]
4394 if {$ytop < 0} {
4395 set ytop 0
4396 }
4397 set yf [expr {$ytop * 1.0 / $ymax}]
4398 }
4399 allcanvs yview moveto $yf
4400 drawvisible
e507fd48
PM
4401 if {$row ne {}} {
4402 selectline $row 0
3e76608d 4403 } elseif {!$viewcomplete($n)} {
567c34e0 4404 reset_pending_select $selid
e507fd48 4405 } else {
835e62ae
AG
4406 reset_pending_select {}
4407
4408 if {[commitinview $pending_select $curview]} {
4409 selectline [rowofcommit $pending_select] 1
4410 } else {
4411 set row [first_real_row]
4412 if {$row < $numcommits} {
4413 selectline $row 0
4414 }
e507fd48
PM
4415 }
4416 }
7fcc92bf
PM
4417 if {!$viewcomplete($n)} {
4418 if {$numcommits == 0} {
d990cedf 4419 show_status [mc "Reading commits..."]
d16c0812 4420 }
098dd8a3 4421 } elseif {$numcommits == 0} {
d990cedf 4422 show_status [mc "No commits selected"]
2516dae2 4423 }
50b44ece
PM
4424}
4425
908c3585
PM
4426# Stuff relating to the highlighting facility
4427
476ca63d 4428proc ishighlighted {id} {
164ff275 4429 global vhighlights fhighlights nhighlights rhighlights
908c3585 4430
476ca63d
PM
4431 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4432 return $nhighlights($id)
908c3585 4433 }
476ca63d
PM
4434 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4435 return $vhighlights($id)
908c3585 4436 }
476ca63d
PM
4437 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4438 return $fhighlights($id)
908c3585 4439 }
476ca63d
PM
4440 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4441 return $rhighlights($id)
164ff275 4442 }
908c3585
PM
4443 return 0
4444}
4445
28593d3f 4446proc bolden {id font} {
b9fdba7f 4447 global canv linehtag currentid boldids need_redisplay markedid
908c3585 4448
d98d50e2
PM
4449 # need_redisplay = 1 means the display is stale and about to be redrawn
4450 if {$need_redisplay} return
28593d3f
PM
4451 lappend boldids $id
4452 $canv itemconf $linehtag($id) -font $font
4453 if {[info exists currentid] && $id eq $currentid} {
908c3585 4454 $canv delete secsel
28593d3f 4455 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
908c3585
PM
4456 -outline {{}} -tags secsel \
4457 -fill [$canv cget -selectbackground]]
4458 $canv lower $t
4459 }
b9fdba7f
PM
4460 if {[info exists markedid] && $id eq $markedid} {
4461 make_idmark $id
4462 }
908c3585
PM
4463}
4464
28593d3f
PM
4465proc bolden_name {id font} {
4466 global canv2 linentag currentid boldnameids need_redisplay
908c3585 4467
d98d50e2 4468 if {$need_redisplay} return
28593d3f
PM
4469 lappend boldnameids $id
4470 $canv2 itemconf $linentag($id) -font $font
4471 if {[info exists currentid] && $id eq $currentid} {
908c3585 4472 $canv2 delete secsel
28593d3f 4473 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
908c3585
PM
4474 -outline {{}} -tags secsel \
4475 -fill [$canv2 cget -selectbackground]]
4476 $canv2 lower $t
4477 }
4478}
4479
4e7d6779 4480proc unbolden {} {
28593d3f 4481 global boldids
908c3585 4482
4e7d6779 4483 set stillbold {}
28593d3f
PM
4484 foreach id $boldids {
4485 if {![ishighlighted $id]} {
4486 bolden $id mainfont
4e7d6779 4487 } else {
28593d3f 4488 lappend stillbold $id
908c3585
PM
4489 }
4490 }
28593d3f 4491 set boldids $stillbold
908c3585
PM
4492}
4493
4494proc addvhighlight {n} {
476ca63d 4495 global hlview viewcomplete curview vhl_done commitidx
da7c24dd
PM
4496
4497 if {[info exists hlview]} {
908c3585 4498 delvhighlight
da7c24dd
PM
4499 }
4500 set hlview $n
7fcc92bf 4501 if {$n != $curview && ![info exists viewcomplete($n)]} {
da7c24dd 4502 start_rev_list $n
908c3585
PM
4503 }
4504 set vhl_done $commitidx($hlview)
4505 if {$vhl_done > 0} {
4506 drawvisible
da7c24dd
PM
4507 }
4508}
4509
908c3585
PM
4510proc delvhighlight {} {
4511 global hlview vhighlights
da7c24dd
PM
4512
4513 if {![info exists hlview]} return
4514 unset hlview
4e7d6779
PM
4515 catch {unset vhighlights}
4516 unbolden
da7c24dd
PM
4517}
4518
908c3585 4519proc vhighlightmore {} {
7fcc92bf 4520 global hlview vhl_done commitidx vhighlights curview
da7c24dd 4521
da7c24dd 4522 set max $commitidx($hlview)
908c3585
PM
4523 set vr [visiblerows]
4524 set r0 [lindex $vr 0]
4525 set r1 [lindex $vr 1]
4526 for {set i $vhl_done} {$i < $max} {incr i} {
7fcc92bf
PM
4527 set id [commitonrow $i $hlview]
4528 if {[commitinview $id $curview]} {
4529 set row [rowofcommit $id]
908c3585
PM
4530 if {$r0 <= $row && $row <= $r1} {
4531 if {![highlighted $row]} {
28593d3f 4532 bolden $id mainfontbold
da7c24dd 4533 }
476ca63d 4534 set vhighlights($id) 1
da7c24dd
PM
4535 }
4536 }
4537 }
908c3585 4538 set vhl_done $max
ac1276ab 4539 return 0
908c3585
PM
4540}
4541
4542proc askvhighlight {row id} {
7fcc92bf 4543 global hlview vhighlights iddrawn
908c3585 4544
7fcc92bf 4545 if {[commitinview $id $hlview]} {
476ca63d 4546 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
28593d3f 4547 bolden $id mainfontbold
908c3585 4548 }
476ca63d 4549 set vhighlights($id) 1
908c3585 4550 } else {
476ca63d 4551 set vhighlights($id) 0
908c3585
PM
4552 }
4553}
4554
687c8765 4555proc hfiles_change {} {
908c3585 4556 global highlight_files filehighlight fhighlights fh_serial
8b39e04f 4557 global highlight_paths
908c3585
PM
4558
4559 if {[info exists filehighlight]} {
4560 # delete previous highlights
4561 catch {close $filehighlight}
4562 unset filehighlight
4e7d6779
PM
4563 catch {unset fhighlights}
4564 unbolden
63b79191 4565 unhighlight_filelist
908c3585 4566 }
63b79191 4567 set highlight_paths {}
908c3585
PM
4568 after cancel do_file_hl $fh_serial
4569 incr fh_serial
4570 if {$highlight_files ne {}} {
4571 after 300 do_file_hl $fh_serial
4572 }
4573}
4574
687c8765
PM
4575proc gdttype_change {name ix op} {
4576 global gdttype highlight_files findstring findpattern
4577
bb3edc8b 4578 stopfinding
687c8765 4579 if {$findstring ne {}} {
b007ee20 4580 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4581 if {$highlight_files ne {}} {
4582 set highlight_files {}
4583 hfiles_change
4584 }
4585 findcom_change
4586 } else {
4587 if {$findpattern ne {}} {
4588 set findpattern {}
4589 findcom_change
4590 }
4591 set highlight_files $findstring
4592 hfiles_change
4593 }
4594 drawvisible
4595 }
4596 # enable/disable findtype/findloc menus too
4597}
4598
4599proc find_change {name ix op} {
4600 global gdttype findstring highlight_files
4601
bb3edc8b 4602 stopfinding
b007ee20 4603 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4604 findcom_change
4605 } else {
4606 if {$highlight_files ne $findstring} {
4607 set highlight_files $findstring
4608 hfiles_change
4609 }
4610 }
4611 drawvisible
4612}
4613
64b5f146 4614proc findcom_change args {
28593d3f 4615 global nhighlights boldnameids
687c8765
PM
4616 global findpattern findtype findstring gdttype
4617
bb3edc8b 4618 stopfinding
687c8765 4619 # delete previous highlights, if any
28593d3f
PM
4620 foreach id $boldnameids {
4621 bolden_name $id mainfont
687c8765 4622 }
28593d3f 4623 set boldnameids {}
687c8765
PM
4624 catch {unset nhighlights}
4625 unbolden
4626 unmarkmatches
b007ee20 4627 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
687c8765 4628 set findpattern {}
b007ee20 4629 } elseif {$findtype eq [mc "Regexp"]} {
687c8765
PM
4630 set findpattern $findstring
4631 } else {
4632 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4633 $findstring]
4634 set findpattern "*$e*"
4635 }
4636}
4637
63b79191
PM
4638proc makepatterns {l} {
4639 set ret {}
4640 foreach e $l {
4641 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4642 if {[string index $ee end] eq "/"} {
4643 lappend ret "$ee*"
4644 } else {
4645 lappend ret $ee
4646 lappend ret "$ee/*"
4647 }
4648 }
4649 return $ret
4650}
4651
908c3585 4652proc do_file_hl {serial} {
4e7d6779 4653 global highlight_files filehighlight highlight_paths gdttype fhl_list
de665fd3 4654 global cdup findtype
908c3585 4655
b007ee20 4656 if {$gdttype eq [mc "touching paths:"]} {
de665fd3
YK
4657 # If "exact" match then convert backslashes to forward slashes.
4658 # Most useful to support Windows-flavoured file paths.
4659 if {$findtype eq [mc "Exact"]} {
4660 set highlight_files [string map {"\\" "/"} $highlight_files]
4661 }
60f7a7dc
PM
4662 if {[catch {set paths [shellsplit $highlight_files]}]} return
4663 set highlight_paths [makepatterns $paths]
4664 highlight_filelist
c332f445
MZ
4665 set relative_paths {}
4666 foreach path $paths {
4667 lappend relative_paths [file join $cdup $path]
4668 }
4669 set gdtargs [concat -- $relative_paths]
b007ee20 4670 } elseif {$gdttype eq [mc "adding/removing string:"]} {
60f7a7dc 4671 set gdtargs [list "-S$highlight_files"]
c33cb908
ML
4672 } elseif {$gdttype eq [mc "changing lines matching:"]} {
4673 set gdtargs [list "-G$highlight_files"]
687c8765
PM
4674 } else {
4675 # must be "containing:", i.e. we're searching commit info
4676 return
60f7a7dc 4677 }
1ce09dd6 4678 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
4679 set filehighlight [open $cmd r+]
4680 fconfigure $filehighlight -blocking 0
7eb3cb9c 4681 filerun $filehighlight readfhighlight
4e7d6779 4682 set fhl_list {}
908c3585
PM
4683 drawvisible
4684 flushhighlights
4685}
4686
4687proc flushhighlights {} {
4e7d6779 4688 global filehighlight fhl_list
908c3585
PM
4689
4690 if {[info exists filehighlight]} {
4e7d6779 4691 lappend fhl_list {}
908c3585
PM
4692 puts $filehighlight ""
4693 flush $filehighlight
4694 }
4695}
4696
4697proc askfilehighlight {row id} {
4e7d6779 4698 global filehighlight fhighlights fhl_list
908c3585 4699
4e7d6779 4700 lappend fhl_list $id
476ca63d 4701 set fhighlights($id) -1
908c3585
PM
4702 puts $filehighlight $id
4703}
4704
4705proc readfhighlight {} {
7fcc92bf 4706 global filehighlight fhighlights curview iddrawn
687c8765 4707 global fhl_list find_dirn
4e7d6779 4708
7eb3cb9c
PM
4709 if {![info exists filehighlight]} {
4710 return 0
4711 }
4712 set nr 0
4713 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4e7d6779
PM
4714 set line [string trim $line]
4715 set i [lsearch -exact $fhl_list $line]
4716 if {$i < 0} continue
4717 for {set j 0} {$j < $i} {incr j} {
4718 set id [lindex $fhl_list $j]
476ca63d 4719 set fhighlights($id) 0
908c3585 4720 }
4e7d6779
PM
4721 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4722 if {$line eq {}} continue
7fcc92bf 4723 if {![commitinview $line $curview]} continue
476ca63d 4724 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
28593d3f 4725 bolden $line mainfontbold
4e7d6779 4726 }
476ca63d 4727 set fhighlights($line) 1
908c3585 4728 }
4e7d6779
PM
4729 if {[eof $filehighlight]} {
4730 # strange...
1ce09dd6 4731 puts "oops, git diff-tree died"
4e7d6779
PM
4732 catch {close $filehighlight}
4733 unset filehighlight
7eb3cb9c 4734 return 0
908c3585 4735 }
687c8765 4736 if {[info exists find_dirn]} {
cca5d946 4737 run findmore
908c3585 4738 }
687c8765 4739 return 1
908c3585
PM
4740}
4741
4fb0fa19 4742proc doesmatch {f} {
687c8765 4743 global findtype findpattern
4fb0fa19 4744
b007ee20 4745 if {$findtype eq [mc "Regexp"]} {
687c8765 4746 return [regexp $findpattern $f]
b007ee20 4747 } elseif {$findtype eq [mc "IgnCase"]} {
4fb0fa19
PM
4748 return [string match -nocase $findpattern $f]
4749 } else {
4750 return [string match $findpattern $f]
4751 }
4752}
4753
60f7a7dc 4754proc askfindhighlight {row id} {
9c311b32 4755 global nhighlights commitinfo iddrawn
4fb0fa19
PM
4756 global findloc
4757 global markingmatches
908c3585
PM
4758
4759 if {![info exists commitinfo($id)]} {
4760 getcommit $id
4761 }
60f7a7dc 4762 set info $commitinfo($id)
908c3585 4763 set isbold 0
585c27cb 4764 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
60f7a7dc 4765 foreach f $info ty $fldtypes {
585c27cb 4766 if {$ty eq ""} continue
b007ee20 4767 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4fb0fa19 4768 [doesmatch $f]} {
b007ee20 4769 if {$ty eq [mc "Author"]} {
60f7a7dc 4770 set isbold 2
4fb0fa19 4771 break
60f7a7dc 4772 }
4fb0fa19 4773 set isbold 1
908c3585
PM
4774 }
4775 }
4fb0fa19 4776 if {$isbold && [info exists iddrawn($id)]} {
476ca63d 4777 if {![ishighlighted $id]} {
28593d3f 4778 bolden $id mainfontbold
4fb0fa19 4779 if {$isbold > 1} {
28593d3f 4780 bolden_name $id mainfontbold
4fb0fa19 4781 }
908c3585 4782 }
4fb0fa19 4783 if {$markingmatches} {
005a2f4e 4784 markrowmatches $row $id
908c3585
PM
4785 }
4786 }
476ca63d 4787 set nhighlights($id) $isbold
da7c24dd
PM
4788}
4789
005a2f4e
PM
4790proc markrowmatches {row id} {
4791 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 4792
005a2f4e
PM
4793 set headline [lindex $commitinfo($id) 0]
4794 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
4795 $canv delete match$row
4796 $canv2 delete match$row
b007ee20 4797 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
005a2f4e
PM
4798 set m [findmatches $headline]
4799 if {$m ne {}} {
28593d3f
PM
4800 markmatches $canv $row $headline $linehtag($id) $m \
4801 [$canv itemcget $linehtag($id) -font] $row
005a2f4e 4802 }
4fb0fa19 4803 }
b007ee20 4804 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
005a2f4e
PM
4805 set m [findmatches $author]
4806 if {$m ne {}} {
28593d3f
PM
4807 markmatches $canv2 $row $author $linentag($id) $m \
4808 [$canv2 itemcget $linentag($id) -font] $row
005a2f4e 4809 }
4fb0fa19
PM
4810 }
4811}
4812
164ff275
PM
4813proc vrel_change {name ix op} {
4814 global highlight_related
4815
4816 rhighlight_none
b007ee20 4817 if {$highlight_related ne [mc "None"]} {
7eb3cb9c 4818 run drawvisible
164ff275
PM
4819 }
4820}
4821
4822# prepare for testing whether commits are descendents or ancestors of a
4823proc rhighlight_sel {a} {
4824 global descendent desc_todo ancestor anc_todo
476ca63d 4825 global highlight_related
164ff275
PM
4826
4827 catch {unset descendent}
4828 set desc_todo [list $a]
4829 catch {unset ancestor}
4830 set anc_todo [list $a]
b007ee20 4831 if {$highlight_related ne [mc "None"]} {
164ff275 4832 rhighlight_none
7eb3cb9c 4833 run drawvisible
164ff275
PM
4834 }
4835}
4836
4837proc rhighlight_none {} {
4838 global rhighlights
4839
4e7d6779
PM
4840 catch {unset rhighlights}
4841 unbolden
164ff275
PM
4842}
4843
4844proc is_descendent {a} {
7fcc92bf 4845 global curview children descendent desc_todo
164ff275
PM
4846
4847 set v $curview
7fcc92bf 4848 set la [rowofcommit $a]
164ff275
PM
4849 set todo $desc_todo
4850 set leftover {}
4851 set done 0
4852 for {set i 0} {$i < [llength $todo]} {incr i} {
4853 set do [lindex $todo $i]
7fcc92bf 4854 if {[rowofcommit $do] < $la} {
164ff275
PM
4855 lappend leftover $do
4856 continue
4857 }
4858 foreach nk $children($v,$do) {
4859 if {![info exists descendent($nk)]} {
4860 set descendent($nk) 1
4861 lappend todo $nk
4862 if {$nk eq $a} {
4863 set done 1
4864 }
4865 }
4866 }
4867 if {$done} {
4868 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4869 return
4870 }
4871 }
4872 set descendent($a) 0
4873 set desc_todo $leftover
4874}
4875
4876proc is_ancestor {a} {
7fcc92bf 4877 global curview parents ancestor anc_todo
164ff275
PM
4878
4879 set v $curview
7fcc92bf 4880 set la [rowofcommit $a]
164ff275
PM
4881 set todo $anc_todo
4882 set leftover {}
4883 set done 0
4884 for {set i 0} {$i < [llength $todo]} {incr i} {
4885 set do [lindex $todo $i]
7fcc92bf 4886 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
164ff275
PM
4887 lappend leftover $do
4888 continue
4889 }
7fcc92bf 4890 foreach np $parents($v,$do) {
164ff275
PM
4891 if {![info exists ancestor($np)]} {
4892 set ancestor($np) 1
4893 lappend todo $np
4894 if {$np eq $a} {
4895 set done 1
4896 }
4897 }
4898 }
4899 if {$done} {
4900 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4901 return
4902 }
4903 }
4904 set ancestor($a) 0
4905 set anc_todo $leftover
4906}
4907
4908proc askrelhighlight {row id} {
9c311b32 4909 global descendent highlight_related iddrawn rhighlights
164ff275
PM
4910 global selectedline ancestor
4911
94b4a69f 4912 if {$selectedline eq {}} return
164ff275 4913 set isbold 0
55e34436
CS
4914 if {$highlight_related eq [mc "Descendant"] ||
4915 $highlight_related eq [mc "Not descendant"]} {
164ff275
PM
4916 if {![info exists descendent($id)]} {
4917 is_descendent $id
4918 }
55e34436 4919 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
164ff275
PM
4920 set isbold 1
4921 }
b007ee20
CS
4922 } elseif {$highlight_related eq [mc "Ancestor"] ||
4923 $highlight_related eq [mc "Not ancestor"]} {
164ff275
PM
4924 if {![info exists ancestor($id)]} {
4925 is_ancestor $id
4926 }
b007ee20 4927 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
164ff275
PM
4928 set isbold 1
4929 }
4930 }
4931 if {[info exists iddrawn($id)]} {
476ca63d 4932 if {$isbold && ![ishighlighted $id]} {
28593d3f 4933 bolden $id mainfontbold
164ff275
PM
4934 }
4935 }
476ca63d 4936 set rhighlights($id) $isbold
164ff275
PM
4937}
4938
da7c24dd
PM
4939# Graph layout functions
4940
9f1afe05
PM
4941proc shortids {ids} {
4942 set res {}
4943 foreach id $ids {
4944 if {[llength $id] > 1} {
4945 lappend res [shortids $id]
4946 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4947 lappend res [string range $id 0 7]
4948 } else {
4949 lappend res $id
4950 }
4951 }
4952 return $res
4953}
4954
9f1afe05
PM
4955proc ntimes {n o} {
4956 set ret {}
0380081c
PM
4957 set o [list $o]
4958 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4959 if {($n & $mask) != 0} {
4960 set ret [concat $ret $o]
9f1afe05 4961 }
0380081c 4962 set o [concat $o $o]
9f1afe05 4963 }
0380081c 4964 return $ret
9f1afe05
PM
4965}
4966
9257d8f7
PM
4967proc ordertoken {id} {
4968 global ordertok curview varcid varcstart varctok curview parents children
4969 global nullid nullid2
4970
4971 if {[info exists ordertok($id)]} {
4972 return $ordertok($id)
4973 }
4974 set origid $id
4975 set todo {}
4976 while {1} {
4977 if {[info exists varcid($curview,$id)]} {
4978 set a $varcid($curview,$id)
4979 set p [lindex $varcstart($curview) $a]
4980 } else {
4981 set p [lindex $children($curview,$id) 0]
4982 }
4983 if {[info exists ordertok($p)]} {
4984 set tok $ordertok($p)
4985 break
4986 }
c8c9f3d9
PM
4987 set id [first_real_child $curview,$p]
4988 if {$id eq {}} {
9257d8f7 4989 # it's a root
46308ea1 4990 set tok [lindex $varctok($curview) $varcid($curview,$p)]
9257d8f7
PM
4991 break
4992 }
9257d8f7
PM
4993 if {[llength $parents($curview,$id)] == 1} {
4994 lappend todo [list $p {}]
4995 } else {
4996 set j [lsearch -exact $parents($curview,$id) $p]
4997 if {$j < 0} {
4998 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4999 }
5000 lappend todo [list $p [strrep $j]]
5001 }
5002 }
5003 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5004 set p [lindex $todo $i 0]
5005 append tok [lindex $todo $i 1]
5006 set ordertok($p) $tok
5007 }
5008 set ordertok($origid) $tok
5009 return $tok
5010}
5011
6e8c8707
PM
5012# Work out where id should go in idlist so that order-token
5013# values increase from left to right
5014proc idcol {idlist id {i 0}} {
9257d8f7 5015 set t [ordertoken $id]
e5b37ac1
PM
5016 if {$i < 0} {
5017 set i 0
5018 }
9257d8f7 5019 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
6e8c8707
PM
5020 if {$i > [llength $idlist]} {
5021 set i [llength $idlist]
9f1afe05 5022 }
9257d8f7 5023 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
6e8c8707
PM
5024 incr i
5025 } else {
9257d8f7 5026 if {$t > [ordertoken [lindex $idlist $i]]} {
6e8c8707 5027 while {[incr i] < [llength $idlist] &&
9257d8f7 5028 $t >= [ordertoken [lindex $idlist $i]]} {}
9f1afe05 5029 }
9f1afe05 5030 }
6e8c8707 5031 return $i
9f1afe05
PM
5032}
5033
5034proc initlayout {} {
7fcc92bf 5035 global rowidlist rowisopt rowfinal displayorder parentlist
da7c24dd 5036 global numcommits canvxmax canv
8f7d0cec 5037 global nextcolor
da7c24dd 5038 global colormap rowtextx
9f1afe05 5039
8f7d0cec
PM
5040 set numcommits 0
5041 set displayorder {}
79b2c75e 5042 set parentlist {}
8f7d0cec 5043 set nextcolor 0
0380081c
PM
5044 set rowidlist {}
5045 set rowisopt {}
f5f3c2e2 5046 set rowfinal {}
be0cd098 5047 set canvxmax [$canv cget -width]
50b44ece
PM
5048 catch {unset colormap}
5049 catch {unset rowtextx}
ac1276ab 5050 setcanvscroll
be0cd098
PM
5051}
5052
5053proc setcanvscroll {} {
5054 global canv canv2 canv3 numcommits linespc canvxmax canvy0
ac1276ab 5055 global lastscrollset lastscrollrows
be0cd098
PM
5056
5057 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5058 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5059 $canv2 conf -scrollregion [list 0 0 0 $ymax]
5060 $canv3 conf -scrollregion [list 0 0 0 $ymax]
ac1276ab
PM
5061 set lastscrollset [clock clicks -milliseconds]
5062 set lastscrollrows $numcommits
9f1afe05
PM
5063}
5064
5065proc visiblerows {} {
5066 global canv numcommits linespc
5067
5068 set ymax [lindex [$canv cget -scrollregion] 3]
5069 if {$ymax eq {} || $ymax == 0} return
5070 set f [$canv yview]
5071 set y0 [expr {int([lindex $f 0] * $ymax)}]
5072 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5073 if {$r0 < 0} {
5074 set r0 0
5075 }
5076 set y1 [expr {int([lindex $f 1] * $ymax)}]
5077 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5078 if {$r1 >= $numcommits} {
5079 set r1 [expr {$numcommits - 1}]
5080 }
5081 return [list $r0 $r1]
5082}
5083
f5f3c2e2 5084proc layoutmore {} {
38dfe939 5085 global commitidx viewcomplete curview
94b4a69f 5086 global numcommits pending_select curview
d375ef9b 5087 global lastscrollset lastscrollrows
ac1276ab
PM
5088
5089 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5090 [clock clicks -milliseconds] - $lastscrollset > 500} {
a2c22362
PM
5091 setcanvscroll
5092 }
d94f8cd6 5093 if {[info exists pending_select] &&
7fcc92bf 5094 [commitinview $pending_select $curview]} {
567c34e0 5095 update
7fcc92bf 5096 selectline [rowofcommit $pending_select] 1
d94f8cd6 5097 }
ac1276ab 5098 drawvisible
219ea3a9
PM
5099}
5100
cdc8429c
PM
5101# With path limiting, we mightn't get the actual HEAD commit,
5102# so ask git rev-list what is the first ancestor of HEAD that
5103# touches a file in the path limit.
5104proc get_viewmainhead {view} {
5105 global viewmainheadid vfilelimit viewinstances mainheadid
5106
5107 catch {
5108 set rfd [open [concat | git rev-list -1 $mainheadid \
5109 -- $vfilelimit($view)] r]
5110 set j [reg_instance $rfd]
5111 lappend viewinstances($view) $j
5112 fconfigure $rfd -blocking 0
5113 filerun $rfd [list getviewhead $rfd $j $view]
5114 set viewmainheadid($curview) {}
5115 }
5116}
5117
5118# git rev-list should give us just 1 line to use as viewmainheadid($view)
5119proc getviewhead {fd inst view} {
5120 global viewmainheadid commfd curview viewinstances showlocalchanges
5121
5122 set id {}
5123 if {[gets $fd line] < 0} {
5124 if {![eof $fd]} {
5125 return 1
5126 }
5127 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5128 set id $line
5129 }
5130 set viewmainheadid($view) $id
5131 close $fd
5132 unset commfd($inst)
5133 set i [lsearch -exact $viewinstances($view) $inst]
5134 if {$i >= 0} {
5135 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5136 }
5137 if {$showlocalchanges && $id ne {} && $view == $curview} {
5138 doshowlocalchanges
5139 }
5140 return 0
5141}
5142
219ea3a9 5143proc doshowlocalchanges {} {
cdc8429c 5144 global curview viewmainheadid
219ea3a9 5145
cdc8429c
PM
5146 if {$viewmainheadid($curview) eq {}} return
5147 if {[commitinview $viewmainheadid($curview) $curview]} {
219ea3a9 5148 dodiffindex
38dfe939 5149 } else {
cdc8429c 5150 interestedin $viewmainheadid($curview) dodiffindex
219ea3a9
PM
5151 }
5152}
5153
5154proc dohidelocalchanges {} {
7fcc92bf 5155 global nullid nullid2 lserial curview
219ea3a9 5156
7fcc92bf 5157 if {[commitinview $nullid $curview]} {
b8a938cf 5158 removefakerow $nullid
8f489363 5159 }
7fcc92bf 5160 if {[commitinview $nullid2 $curview]} {
b8a938cf 5161 removefakerow $nullid2
219ea3a9
PM
5162 }
5163 incr lserial
5164}
5165
8f489363 5166# spawn off a process to do git diff-index --cached HEAD
219ea3a9 5167proc dodiffindex {} {
cdc8429c 5168 global lserial showlocalchanges vfilelimit curview
74cb884f 5169 global hasworktree
219ea3a9 5170
74cb884f 5171 if {!$showlocalchanges || !$hasworktree} return
219ea3a9 5172 incr lserial
cdc8429c
PM
5173 set cmd "|git diff-index --cached HEAD"
5174 if {$vfilelimit($curview) ne {}} {
5175 set cmd [concat $cmd -- $vfilelimit($curview)]
5176 }
5177 set fd [open $cmd r]
219ea3a9 5178 fconfigure $fd -blocking 0
e439e092
AG
5179 set i [reg_instance $fd]
5180 filerun $fd [list readdiffindex $fd $lserial $i]
219ea3a9
PM
5181}
5182
e439e092 5183proc readdiffindex {fd serial inst} {
cdc8429c
PM
5184 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5185 global vfilelimit
219ea3a9 5186
8f489363 5187 set isdiff 1
219ea3a9 5188 if {[gets $fd line] < 0} {
8f489363
PM
5189 if {![eof $fd]} {
5190 return 1
219ea3a9 5191 }
8f489363 5192 set isdiff 0
219ea3a9
PM
5193 }
5194 # we only need to see one line and we don't really care what it says...
e439e092 5195 stop_instance $inst
219ea3a9 5196
24f7a667
PM
5197 if {$serial != $lserial} {
5198 return 0
8f489363
PM
5199 }
5200
24f7a667 5201 # now see if there are any local changes not checked in to the index
cdc8429c
PM
5202 set cmd "|git diff-files"
5203 if {$vfilelimit($curview) ne {}} {
5204 set cmd [concat $cmd -- $vfilelimit($curview)]
5205 }
5206 set fd [open $cmd r]
24f7a667 5207 fconfigure $fd -blocking 0
e439e092
AG
5208 set i [reg_instance $fd]
5209 filerun $fd [list readdifffiles $fd $serial $i]
24f7a667
PM
5210
5211 if {$isdiff && ![commitinview $nullid2 $curview]} {
8f489363 5212 # add the line for the changes in the index to the graph
d990cedf 5213 set hl [mc "Local changes checked in to index but not committed"]
8f489363
PM
5214 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5215 set commitdata($nullid2) "\n $hl\n"
fc2a256f 5216 if {[commitinview $nullid $curview]} {
b8a938cf 5217 removefakerow $nullid
fc2a256f 5218 }
cdc8429c 5219 insertfakerow $nullid2 $viewmainheadid($curview)
24f7a667 5220 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
cdc8429c
PM
5221 if {[commitinview $nullid $curview]} {
5222 removefakerow $nullid
5223 }
b8a938cf 5224 removefakerow $nullid2
8f489363
PM
5225 }
5226 return 0
5227}
5228
e439e092 5229proc readdifffiles {fd serial inst} {
cdc8429c 5230 global viewmainheadid nullid nullid2 curview
8f489363
PM
5231 global commitinfo commitdata lserial
5232
5233 set isdiff 1
5234 if {[gets $fd line] < 0} {
5235 if {![eof $fd]} {
5236 return 1
5237 }
5238 set isdiff 0
5239 }
5240 # we only need to see one line and we don't really care what it says...
e439e092 5241 stop_instance $inst
8f489363 5242
24f7a667
PM
5243 if {$serial != $lserial} {
5244 return 0
5245 }
5246
5247 if {$isdiff && ![commitinview $nullid $curview]} {
219ea3a9 5248 # add the line for the local diff to the graph
d990cedf 5249 set hl [mc "Local uncommitted changes, not checked in to index"]
219ea3a9
PM
5250 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5251 set commitdata($nullid) "\n $hl\n"
7fcc92bf
PM
5252 if {[commitinview $nullid2 $curview]} {
5253 set p $nullid2
5254 } else {
cdc8429c 5255 set p $viewmainheadid($curview)
7fcc92bf 5256 }
b8a938cf 5257 insertfakerow $nullid $p
24f7a667 5258 } elseif {!$isdiff && [commitinview $nullid $curview]} {
b8a938cf 5259 removefakerow $nullid
219ea3a9
PM
5260 }
5261 return 0
9f1afe05
PM
5262}
5263
8f0bc7e9 5264proc nextuse {id row} {
7fcc92bf 5265 global curview children
9f1afe05 5266
8f0bc7e9
PM
5267 if {[info exists children($curview,$id)]} {
5268 foreach kid $children($curview,$id) {
7fcc92bf 5269 if {![commitinview $kid $curview]} {
0380081c
PM
5270 return -1
5271 }
7fcc92bf
PM
5272 if {[rowofcommit $kid] > $row} {
5273 return [rowofcommit $kid]
9f1afe05 5274 }
9f1afe05 5275 }
8f0bc7e9 5276 }
7fcc92bf
PM
5277 if {[commitinview $id $curview]} {
5278 return [rowofcommit $id]
8f0bc7e9
PM
5279 }
5280 return -1
5281}
5282
f5f3c2e2 5283proc prevuse {id row} {
7fcc92bf 5284 global curview children
f5f3c2e2
PM
5285
5286 set ret -1
5287 if {[info exists children($curview,$id)]} {
5288 foreach kid $children($curview,$id) {
7fcc92bf
PM
5289 if {![commitinview $kid $curview]} break
5290 if {[rowofcommit $kid] < $row} {
5291 set ret [rowofcommit $kid]
7b459a1c 5292 }
7b459a1c 5293 }
f5f3c2e2
PM
5294 }
5295 return $ret
5296}
5297
0380081c
PM
5298proc make_idlist {row} {
5299 global displayorder parentlist uparrowlen downarrowlen mingaplen
9257d8f7 5300 global commitidx curview children
9f1afe05 5301
0380081c
PM
5302 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5303 if {$r < 0} {
5304 set r 0
8f0bc7e9 5305 }
0380081c
PM
5306 set ra [expr {$row - $downarrowlen}]
5307 if {$ra < 0} {
5308 set ra 0
5309 }
5310 set rb [expr {$row + $uparrowlen}]
5311 if {$rb > $commitidx($curview)} {
5312 set rb $commitidx($curview)
5313 }
7fcc92bf 5314 make_disporder $r [expr {$rb + 1}]
0380081c
PM
5315 set ids {}
5316 for {} {$r < $ra} {incr r} {
5317 set nextid [lindex $displayorder [expr {$r + 1}]]
5318 foreach p [lindex $parentlist $r] {
5319 if {$p eq $nextid} continue
5320 set rn [nextuse $p $r]
5321 if {$rn >= $row &&
5322 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
9257d8f7 5323 lappend ids [list [ordertoken $p] $p]
9f1afe05 5324 }
9f1afe05 5325 }
0380081c
PM
5326 }
5327 for {} {$r < $row} {incr r} {
5328 set nextid [lindex $displayorder [expr {$r + 1}]]
5329 foreach p [lindex $parentlist $r] {
5330 if {$p eq $nextid} continue
5331 set rn [nextuse $p $r]
5332 if {$rn < 0 || $rn >= $row} {
9257d8f7 5333 lappend ids [list [ordertoken $p] $p]
9f1afe05 5334 }
9f1afe05 5335 }
0380081c
PM
5336 }
5337 set id [lindex $displayorder $row]
9257d8f7 5338 lappend ids [list [ordertoken $id] $id]
0380081c
PM
5339 while {$r < $rb} {
5340 foreach p [lindex $parentlist $r] {
5341 set firstkid [lindex $children($curview,$p) 0]
7fcc92bf 5342 if {[rowofcommit $firstkid] < $row} {
9257d8f7 5343 lappend ids [list [ordertoken $p] $p]
9f1afe05 5344 }
9f1afe05 5345 }
0380081c
PM
5346 incr r
5347 set id [lindex $displayorder $r]
5348 if {$id ne {}} {
5349 set firstkid [lindex $children($curview,$id) 0]
7fcc92bf 5350 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
9257d8f7 5351 lappend ids [list [ordertoken $id] $id]
0380081c 5352 }
9f1afe05 5353 }
9f1afe05 5354 }
0380081c
PM
5355 set idlist {}
5356 foreach idx [lsort -unique $ids] {
5357 lappend idlist [lindex $idx 1]
5358 }
5359 return $idlist
9f1afe05
PM
5360}
5361
f5f3c2e2
PM
5362proc rowsequal {a b} {
5363 while {[set i [lsearch -exact $a {}]] >= 0} {
5364 set a [lreplace $a $i $i]
5365 }
5366 while {[set i [lsearch -exact $b {}]] >= 0} {
5367 set b [lreplace $b $i $i]
5368 }
5369 return [expr {$a eq $b}]
9f1afe05
PM
5370}
5371
f5f3c2e2
PM
5372proc makeupline {id row rend col} {
5373 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 5374
f5f3c2e2
PM
5375 for {set r $rend} {1} {set r $rstart} {
5376 set rstart [prevuse $id $r]
5377 if {$rstart < 0} return
5378 if {$rstart < $row} break
5379 }
5380 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5381 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 5382 }
f5f3c2e2
PM
5383 for {set r $rstart} {[incr r] <= $row} {} {
5384 set idlist [lindex $rowidlist $r]
5385 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5386 set col [idcol $idlist $id $col]
5387 lset rowidlist $r [linsert $idlist $col $id]
5388 changedrow $r
5389 }
9f1afe05
PM
5390 }
5391}
5392
0380081c 5393proc layoutrows {row endrow} {
f5f3c2e2 5394 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
5395 global uparrowlen downarrowlen maxwidth mingaplen
5396 global children parentlist
7fcc92bf 5397 global commitidx viewcomplete curview
9f1afe05 5398
7fcc92bf 5399 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
0380081c
PM
5400 set idlist {}
5401 if {$row > 0} {
f56782ae
PM
5402 set rm1 [expr {$row - 1}]
5403 foreach id [lindex $rowidlist $rm1] {
0380081c
PM
5404 if {$id ne {}} {
5405 lappend idlist $id
5406 }
5407 }
f56782ae 5408 set final [lindex $rowfinal $rm1]
79b2c75e 5409 }
0380081c
PM
5410 for {} {$row < $endrow} {incr row} {
5411 set rm1 [expr {$row - 1}]
f56782ae 5412 if {$rm1 < 0 || $idlist eq {}} {
0380081c 5413 set idlist [make_idlist $row]
f5f3c2e2 5414 set final 1
0380081c
PM
5415 } else {
5416 set id [lindex $displayorder $rm1]
5417 set col [lsearch -exact $idlist $id]
5418 set idlist [lreplace $idlist $col $col]
5419 foreach p [lindex $parentlist $rm1] {
5420 if {[lsearch -exact $idlist $p] < 0} {
5421 set col [idcol $idlist $p $col]
5422 set idlist [linsert $idlist $col $p]
f5f3c2e2
PM
5423 # if not the first child, we have to insert a line going up
5424 if {$id ne [lindex $children($curview,$p) 0]} {
5425 makeupline $p $rm1 $row $col
5426 }
0380081c
PM
5427 }
5428 }
5429 set id [lindex $displayorder $row]
5430 if {$row > $downarrowlen} {
5431 set termrow [expr {$row - $downarrowlen - 1}]
5432 foreach p [lindex $parentlist $termrow] {
5433 set i [lsearch -exact $idlist $p]
5434 if {$i < 0} continue
5435 set nr [nextuse $p $termrow]
5436 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5437 set idlist [lreplace $idlist $i $i]
5438 }
5439 }
5440 }
5441 set col [lsearch -exact $idlist $id]
5442 if {$col < 0} {
5443 set col [idcol $idlist $id]
5444 set idlist [linsert $idlist $col $id]
f5f3c2e2
PM
5445 if {$children($curview,$id) ne {}} {
5446 makeupline $id $rm1 $row $col
5447 }
0380081c
PM
5448 }
5449 set r [expr {$row + $uparrowlen - 1}]
5450 if {$r < $commitidx($curview)} {
5451 set x $col
5452 foreach p [lindex $parentlist $r] {
5453 if {[lsearch -exact $idlist $p] >= 0} continue
5454 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5455 if {[rowofcommit $fk] < $row} {
0380081c
PM
5456 set x [idcol $idlist $p $x]
5457 set idlist [linsert $idlist $x $p]
5458 }
5459 }
5460 if {[incr r] < $commitidx($curview)} {
5461 set p [lindex $displayorder $r]
5462 if {[lsearch -exact $idlist $p] < 0} {
5463 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5464 if {$fk ne {} && [rowofcommit $fk] < $row} {
0380081c
PM
5465 set x [idcol $idlist $p $x]
5466 set idlist [linsert $idlist $x $p]
5467 }
5468 }
5469 }
5470 }
5471 }
f5f3c2e2
PM
5472 if {$final && !$viewcomplete($curview) &&
5473 $row + $uparrowlen + $mingaplen + $downarrowlen
5474 >= $commitidx($curview)} {
5475 set final 0
5476 }
0380081c
PM
5477 set l [llength $rowidlist]
5478 if {$row == $l} {
5479 lappend rowidlist $idlist
5480 lappend rowisopt 0
f5f3c2e2 5481 lappend rowfinal $final
0380081c 5482 } elseif {$row < $l} {
f5f3c2e2 5483 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
0380081c
PM
5484 lset rowidlist $row $idlist
5485 changedrow $row
5486 }
f56782ae 5487 lset rowfinal $row $final
0380081c 5488 } else {
f5f3c2e2
PM
5489 set pad [ntimes [expr {$row - $l}] {}]
5490 set rowidlist [concat $rowidlist $pad]
0380081c 5491 lappend rowidlist $idlist
f5f3c2e2
PM
5492 set rowfinal [concat $rowfinal $pad]
5493 lappend rowfinal $final
0380081c
PM
5494 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5495 }
9f1afe05 5496 }
0380081c 5497 return $row
9f1afe05
PM
5498}
5499
0380081c
PM
5500proc changedrow {row} {
5501 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 5502
0380081c
PM
5503 set l [llength $rowisopt]
5504 if {$row < $l} {
5505 lset rowisopt $row 0
5506 if {$row + 1 < $l} {
5507 lset rowisopt [expr {$row + 1}] 0
5508 if {$row + 2 < $l} {
5509 lset rowisopt [expr {$row + 2}] 0
5510 }
5511 }
5512 }
5513 set id [lindex $displayorder $row]
5514 if {[info exists iddrawn($id)]} {
5515 set need_redisplay 1
9f1afe05
PM
5516 }
5517}
5518
5519proc insert_pad {row col npad} {
6e8c8707 5520 global rowidlist
9f1afe05
PM
5521
5522 set pad [ntimes $npad {}]
e341c06d
PM
5523 set idlist [lindex $rowidlist $row]
5524 set bef [lrange $idlist 0 [expr {$col - 1}]]
5525 set aft [lrange $idlist $col end]
5526 set i [lsearch -exact $aft {}]
5527 if {$i > 0} {
5528 set aft [lreplace $aft $i $i]
5529 }
5530 lset rowidlist $row [concat $bef $pad $aft]
0380081c 5531 changedrow $row
9f1afe05
PM
5532}
5533
5534proc optimize_rows {row col endrow} {
0380081c 5535 global rowidlist rowisopt displayorder curview children
9f1afe05 5536
6e8c8707
PM
5537 if {$row < 1} {
5538 set row 1
5539 }
0380081c
PM
5540 for {} {$row < $endrow} {incr row; set col 0} {
5541 if {[lindex $rowisopt $row]} continue
9f1afe05 5542 set haspad 0
6e8c8707
PM
5543 set y0 [expr {$row - 1}]
5544 set ym [expr {$row - 2}]
0380081c
PM
5545 set idlist [lindex $rowidlist $row]
5546 set previdlist [lindex $rowidlist $y0]
5547 if {$idlist eq {} || $previdlist eq {}} continue
5548 if {$ym >= 0} {
5549 set pprevidlist [lindex $rowidlist $ym]
5550 if {$pprevidlist eq {}} continue
5551 } else {
5552 set pprevidlist {}
5553 }
6e8c8707
PM
5554 set x0 -1
5555 set xm -1
5556 for {} {$col < [llength $idlist]} {incr col} {
5557 set id [lindex $idlist $col]
5558 if {[lindex $previdlist $col] eq $id} continue
5559 if {$id eq {}} {
9f1afe05
PM
5560 set haspad 1
5561 continue
5562 }
6e8c8707
PM
5563 set x0 [lsearch -exact $previdlist $id]
5564 if {$x0 < 0} continue
5565 set z [expr {$x0 - $col}]
9f1afe05 5566 set isarrow 0
6e8c8707
PM
5567 set z0 {}
5568 if {$ym >= 0} {
5569 set xm [lsearch -exact $pprevidlist $id]
5570 if {$xm >= 0} {
5571 set z0 [expr {$xm - $x0}]
5572 }
5573 }
9f1afe05 5574 if {$z0 eq {}} {
92ed666f
PM
5575 # if row y0 is the first child of $id then it's not an arrow
5576 if {[lindex $children($curview,$id) 0] ne
5577 [lindex $displayorder $y0]} {
9f1afe05
PM
5578 set isarrow 1
5579 }
5580 }
e341c06d
PM
5581 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5582 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5583 set isarrow 1
5584 }
3fc4279a
PM
5585 # Looking at lines from this row to the previous row,
5586 # make them go straight up if they end in an arrow on
5587 # the previous row; otherwise make them go straight up
5588 # or at 45 degrees.
9f1afe05 5589 if {$z < -1 || ($z < 0 && $isarrow)} {
3fc4279a
PM
5590 # Line currently goes left too much;
5591 # insert pads in the previous row, then optimize it
9f1afe05 5592 set npad [expr {-1 - $z + $isarrow}]
9f1afe05
PM
5593 insert_pad $y0 $x0 $npad
5594 if {$y0 > 0} {
5595 optimize_rows $y0 $x0 $row
5596 }
6e8c8707
PM
5597 set previdlist [lindex $rowidlist $y0]
5598 set x0 [lsearch -exact $previdlist $id]
5599 set z [expr {$x0 - $col}]
5600 if {$z0 ne {}} {
5601 set pprevidlist [lindex $rowidlist $ym]
5602 set xm [lsearch -exact $pprevidlist $id]
5603 set z0 [expr {$xm - $x0}]
5604 }
9f1afe05 5605 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3fc4279a 5606 # Line currently goes right too much;
6e8c8707 5607 # insert pads in this line
9f1afe05 5608 set npad [expr {$z - 1 + $isarrow}]
e341c06d
PM
5609 insert_pad $row $col $npad
5610 set idlist [lindex $rowidlist $row]
9f1afe05 5611 incr col $npad
6e8c8707 5612 set z [expr {$x0 - $col}]
9f1afe05
PM
5613 set haspad 1
5614 }
6e8c8707 5615 if {$z0 eq {} && !$isarrow && $ym >= 0} {
eb447a12 5616 # this line links to its first child on row $row-2
6e8c8707
PM
5617 set id [lindex $displayorder $ym]
5618 set xc [lsearch -exact $pprevidlist $id]
eb447a12
PM
5619 if {$xc >= 0} {
5620 set z0 [expr {$xc - $x0}]
5621 }
5622 }
3fc4279a 5623 # avoid lines jigging left then immediately right
9f1afe05
PM
5624 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5625 insert_pad $y0 $x0 1
6e8c8707
PM
5626 incr x0
5627 optimize_rows $y0 $x0 $row
5628 set previdlist [lindex $rowidlist $y0]
9f1afe05
PM
5629 }
5630 }
5631 if {!$haspad} {
3fc4279a 5632 # Find the first column that doesn't have a line going right
9f1afe05 5633 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
6e8c8707
PM
5634 set id [lindex $idlist $col]
5635 if {$id eq {}} break
5636 set x0 [lsearch -exact $previdlist $id]
5637 if {$x0 < 0} {
eb447a12 5638 # check if this is the link to the first child
92ed666f
PM
5639 set kid [lindex $displayorder $y0]
5640 if {[lindex $children($curview,$id) 0] eq $kid} {
eb447a12 5641 # it is, work out offset to child
92ed666f 5642 set x0 [lsearch -exact $previdlist $kid]
eb447a12
PM
5643 }
5644 }
6e8c8707 5645 if {$x0 <= $col} break
9f1afe05 5646 }
3fc4279a 5647 # Insert a pad at that column as long as it has a line and
6e8c8707
PM
5648 # isn't the last column
5649 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
9f1afe05 5650 set idlist [linsert $idlist $col {}]
0380081c
PM
5651 lset rowidlist $row $idlist
5652 changedrow $row
9f1afe05
PM
5653 }
5654 }
9f1afe05
PM
5655 }
5656}
5657
5658proc xc {row col} {
5659 global canvx0 linespc
5660 return [expr {$canvx0 + $col * $linespc}]
5661}
5662
5663proc yc {row} {
5664 global canvy0 linespc
5665 return [expr {$canvy0 + $row * $linespc}]
5666}
5667
c934a8a3
PM
5668proc linewidth {id} {
5669 global thickerline lthickness
5670
5671 set wid $lthickness
5672 if {[info exists thickerline] && $id eq $thickerline} {
5673 set wid [expr {2 * $lthickness}]
5674 }
5675 return $wid
5676}
5677
50b44ece 5678proc rowranges {id} {
7fcc92bf 5679 global curview children uparrowlen downarrowlen
92ed666f 5680 global rowidlist
50b44ece 5681
92ed666f
PM
5682 set kids $children($curview,$id)
5683 if {$kids eq {}} {
5684 return {}
66e46f37 5685 }
92ed666f
PM
5686 set ret {}
5687 lappend kids $id
5688 foreach child $kids {
7fcc92bf
PM
5689 if {![commitinview $child $curview]} break
5690 set row [rowofcommit $child]
92ed666f
PM
5691 if {![info exists prev]} {
5692 lappend ret [expr {$row + 1}]
322a8cc9 5693 } else {
92ed666f 5694 if {$row <= $prevrow} {
7fcc92bf 5695 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
92ed666f
PM
5696 }
5697 # see if the line extends the whole way from prevrow to row
5698 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5699 [lsearch -exact [lindex $rowidlist \
5700 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5701 # it doesn't, see where it ends
5702 set r [expr {$prevrow + $downarrowlen}]
5703 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5704 while {[incr r -1] > $prevrow &&
5705 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5706 } else {
5707 while {[incr r] <= $row &&
5708 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5709 incr r -1
5710 }
5711 lappend ret $r
5712 # see where it starts up again
5713 set r [expr {$row - $uparrowlen}]
5714 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5715 while {[incr r] < $row &&
5716 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5717 } else {
5718 while {[incr r -1] >= $prevrow &&
5719 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5720 incr r
5721 }
5722 lappend ret $r
5723 }
5724 }
5725 if {$child eq $id} {
5726 lappend ret $row
322a8cc9 5727 }
7fcc92bf 5728 set prev $child
92ed666f 5729 set prevrow $row
9f1afe05 5730 }
92ed666f 5731 return $ret
322a8cc9
PM
5732}
5733
5734proc drawlineseg {id row endrow arrowlow} {
5735 global rowidlist displayorder iddrawn linesegs
e341c06d 5736 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
5737
5738 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5739 set le [expr {$row + 1}]
5740 set arrowhigh 1
9f1afe05 5741 while {1} {
322a8cc9
PM
5742 set c [lsearch -exact [lindex $rowidlist $le] $id]
5743 if {$c < 0} {
5744 incr le -1
5745 break
5746 }
5747 lappend cols $c
5748 set x [lindex $displayorder $le]
5749 if {$x eq $id} {
5750 set arrowhigh 0
5751 break
9f1afe05 5752 }
322a8cc9
PM
5753 if {[info exists iddrawn($x)] || $le == $endrow} {
5754 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5755 if {$c >= 0} {
5756 lappend cols $c
5757 set arrowhigh 0
5758 }
5759 break
5760 }
5761 incr le
9f1afe05 5762 }
322a8cc9
PM
5763 if {$le <= $row} {
5764 return $row
5765 }
5766
5767 set lines {}
5768 set i 0
5769 set joinhigh 0
5770 if {[info exists linesegs($id)]} {
5771 set lines $linesegs($id)
5772 foreach li $lines {
5773 set r0 [lindex $li 0]
5774 if {$r0 > $row} {
5775 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5776 set joinhigh 1
5777 }
5778 break
5779 }
5780 incr i
5781 }
5782 }
5783 set joinlow 0
5784 if {$i > 0} {
5785 set li [lindex $lines [expr {$i-1}]]
5786 set r1 [lindex $li 1]
5787 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5788 set joinlow 1
5789 }
5790 }
5791
5792 set x [lindex $cols [expr {$le - $row}]]
5793 set xp [lindex $cols [expr {$le - 1 - $row}]]
5794 set dir [expr {$xp - $x}]
5795 if {$joinhigh} {
5796 set ith [lindex $lines $i 2]
5797 set coords [$canv coords $ith]
5798 set ah [$canv itemcget $ith -arrow]
5799 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5800 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5801 if {$x2 ne {} && $x - $x2 == $dir} {
5802 set coords [lrange $coords 0 end-2]
5803 }
5804 } else {
5805 set coords [list [xc $le $x] [yc $le]]
5806 }
5807 if {$joinlow} {
5808 set itl [lindex $lines [expr {$i-1}] 2]
5809 set al [$canv itemcget $itl -arrow]
5810 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d
PM
5811 } elseif {$arrowlow} {
5812 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5813 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5814 set arrowlow 0
5815 }
322a8cc9
PM
5816 }
5817 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5818 for {set y $le} {[incr y -1] > $row} {} {
5819 set x $xp
5820 set xp [lindex $cols [expr {$y - 1 - $row}]]
5821 set ndir [expr {$xp - $x}]
5822 if {$dir != $ndir || $xp < 0} {
5823 lappend coords [xc $y $x] [yc $y]
5824 }
5825 set dir $ndir
5826 }
5827 if {!$joinlow} {
5828 if {$xp < 0} {
5829 # join parent line to first child
5830 set ch [lindex $displayorder $row]
5831 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5832 if {$xc < 0} {
5833 puts "oops: drawlineseg: child $ch not on row $row"
e341c06d
PM
5834 } elseif {$xc != $x} {
5835 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5836 set d [expr {int(0.5 * $linespc)}]
5837 set x1 [xc $row $x]
5838 if {$xc < $x} {
5839 set x2 [expr {$x1 - $d}]
5840 } else {
5841 set x2 [expr {$x1 + $d}]
5842 }
5843 set y2 [yc $row]
5844 set y1 [expr {$y2 + $d}]
5845 lappend coords $x1 $y1 $x2 $y2
5846 } elseif {$xc < $x - 1} {
322a8cc9
PM
5847 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5848 } elseif {$xc > $x + 1} {
5849 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5850 }
5851 set x $xc
eb447a12 5852 }
322a8cc9
PM
5853 lappend coords [xc $row $x] [yc $row]
5854 } else {
5855 set xn [xc $row $xp]
5856 set yn [yc $row]
e341c06d 5857 lappend coords $xn $yn
322a8cc9
PM
5858 }
5859 if {!$joinhigh} {
322a8cc9
PM
5860 assigncolor $id
5861 set t [$canv create line $coords -width [linewidth $id] \
5862 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5863 $canv lower $t
5864 bindline $t $id
5865 set lines [linsert $lines $i [list $row $le $t]]
5866 } else {
5867 $canv coords $ith $coords
5868 if {$arrow ne $ah} {
5869 $canv itemconf $ith -arrow $arrow
5870 }
5871 lset lines $i 0 $row
5872 }
5873 } else {
5874 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5875 set ndir [expr {$xo - $xp}]
5876 set clow [$canv coords $itl]
5877 if {$dir == $ndir} {
5878 set clow [lrange $clow 2 end]
5879 }
5880 set coords [concat $coords $clow]
5881 if {!$joinhigh} {
5882 lset lines [expr {$i-1}] 1 $le
322a8cc9
PM
5883 } else {
5884 # coalesce two pieces
5885 $canv delete $ith
5886 set b [lindex $lines [expr {$i-1}] 0]
5887 set e [lindex $lines $i 1]
5888 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5889 }
5890 $canv coords $itl $coords
5891 if {$arrow ne $al} {
5892 $canv itemconf $itl -arrow $arrow
879e8b1a
PM
5893 }
5894 }
322a8cc9
PM
5895
5896 set linesegs($id) $lines
5897 return $le
9f1afe05
PM
5898}
5899
322a8cc9
PM
5900proc drawparentlinks {id row} {
5901 global rowidlist canv colormap curview parentlist
513a54dc 5902 global idpos linespc
9f1afe05 5903
322a8cc9
PM
5904 set rowids [lindex $rowidlist $row]
5905 set col [lsearch -exact $rowids $id]
5906 if {$col < 0} return
5907 set olds [lindex $parentlist $row]
9f1afe05
PM
5908 set row2 [expr {$row + 1}]
5909 set x [xc $row $col]
5910 set y [yc $row]
5911 set y2 [yc $row2]
e341c06d 5912 set d [expr {int(0.5 * $linespc)}]
513a54dc 5913 set ymid [expr {$y + $d}]
8f7d0cec 5914 set ids [lindex $rowidlist $row2]
9f1afe05
PM
5915 # rmx = right-most X coord used
5916 set rmx 0
9f1afe05 5917 foreach p $olds {
f3408449
PM
5918 set i [lsearch -exact $ids $p]
5919 if {$i < 0} {
5920 puts "oops, parent $p of $id not in list"
5921 continue
5922 }
5923 set x2 [xc $row2 $i]
5924 if {$x2 > $rmx} {
5925 set rmx $x2
5926 }
513a54dc
PM
5927 set j [lsearch -exact $rowids $p]
5928 if {$j < 0} {
eb447a12
PM
5929 # drawlineseg will do this one for us
5930 continue
5931 }
9f1afe05
PM
5932 assigncolor $p
5933 # should handle duplicated parents here...
5934 set coords [list $x $y]
513a54dc
PM
5935 if {$i != $col} {
5936 # if attaching to a vertical segment, draw a smaller
5937 # slant for visual distinctness
5938 if {$i == $j} {
5939 if {$i < $col} {
5940 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5941 } else {
5942 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5943 }
5944 } elseif {$i < $col && $i < $j} {
5945 # segment slants towards us already
5946 lappend coords [xc $row $j] $y
5947 } else {
5948 if {$i < $col - 1} {
5949 lappend coords [expr {$x2 + $linespc}] $y
5950 } elseif {$i > $col + 1} {
5951 lappend coords [expr {$x2 - $linespc}] $y
5952 }
5953 lappend coords $x2 $y2
5954 }
5955 } else {
5956 lappend coords $x2 $y2
9f1afe05 5957 }
c934a8a3 5958 set t [$canv create line $coords -width [linewidth $p] \
9f1afe05
PM
5959 -fill $colormap($p) -tags lines.$p]
5960 $canv lower $t
5961 bindline $t $p
5962 }
322a8cc9
PM
5963 if {$rmx > [lindex $idpos($id) 1]} {
5964 lset idpos($id) 1 $rmx
5965 redrawtags $id
5966 }
9f1afe05
PM
5967}
5968
c934a8a3 5969proc drawlines {id} {
322a8cc9 5970 global canv
9f1afe05 5971
322a8cc9 5972 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
5973}
5974
322a8cc9 5975proc drawcmittext {id row col} {
7fcc92bf
PM
5976 global linespc canv canv2 canv3 fgcolor curview
5977 global cmitlisted commitinfo rowidlist parentlist
9f1afe05 5978 global rowtextx idpos idtags idheads idotherrefs
0380081c 5979 global linehtag linentag linedtag selectedline
b9fdba7f 5980 global canvxmax boldids boldnameids fgcolor markedid
d277e89f 5981 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
252c52df
5982 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5983 global circleoutlinecolor
9f1afe05 5984
1407ade9 5985 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
7fcc92bf 5986 set listed $cmitlisted($curview,$id)
219ea3a9 5987 if {$id eq $nullid} {
252c52df 5988 set ofill $workingfilescirclecolor
8f489363 5989 } elseif {$id eq $nullid2} {
252c52df 5990 set ofill $indexcirclecolor
c11ff120 5991 } elseif {$id eq $mainheadid} {
252c52df 5992 set ofill $mainheadcirclecolor
219ea3a9 5993 } else {
c11ff120 5994 set ofill [lindex $circlecolors $listed]
219ea3a9 5995 }
9f1afe05
PM
5996 set x [xc $row $col]
5997 set y [yc $row]
5998 set orad [expr {$linespc / 3}]
1407ade9 5999 if {$listed <= 2} {
c961b228
PM
6000 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6001 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
252c52df 6002 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
1407ade9 6003 } elseif {$listed == 3} {
c961b228
PM
6004 # triangle pointing left for left-side commits
6005 set t [$canv create polygon \
6006 [expr {$x - $orad}] $y \
6007 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6008 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
252c52df 6009 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
c961b228
PM
6010 } else {
6011 # triangle pointing right for right-side commits
6012 set t [$canv create polygon \
6013 [expr {$x + $orad - 1}] $y \
6014 [expr {$x - $orad}] [expr {$y - $orad}] \
6015 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
252c52df 6016 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
c961b228 6017 }
c11ff120 6018 set circleitem($row) $t
9f1afe05
PM
6019 $canv raise $t
6020 $canv bind $t <1> {selcanvline {} %x %y}
322a8cc9
PM
6021 set rmx [llength [lindex $rowidlist $row]]
6022 set olds [lindex $parentlist $row]
6023 if {$olds ne {}} {
6024 set nextids [lindex $rowidlist [expr {$row + 1}]]
6025 foreach p $olds {
6026 set i [lsearch -exact $nextids $p]
6027 if {$i > $rmx} {
6028 set rmx $i
6029 }
6030 }
9f1afe05 6031 }
322a8cc9 6032 set xt [xc $row $rmx]
9f1afe05
PM
6033 set rowtextx($row) $xt
6034 set idpos($id) [list $x $xt $y]
6035 if {[info exists idtags($id)] || [info exists idheads($id)]
6036 || [info exists idotherrefs($id)]} {
6037 set xt [drawtags $id $x $xt $y]
6038 }
36242490
RZ
6039 if {[lindex $commitinfo($id) 6] > 0} {
6040 set xt [drawnotesign $xt $y]
6041 }
9f1afe05
PM
6042 set headline [lindex $commitinfo($id) 0]
6043 set name [lindex $commitinfo($id) 1]
6044 set date [lindex $commitinfo($id) 2]
6045 set date [formatdate $date]
9c311b32
PM
6046 set font mainfont
6047 set nfont mainfont
476ca63d 6048 set isbold [ishighlighted $id]
908c3585 6049 if {$isbold > 0} {
28593d3f 6050 lappend boldids $id
9c311b32 6051 set font mainfontbold
908c3585 6052 if {$isbold > 1} {
28593d3f 6053 lappend boldnameids $id
9c311b32 6054 set nfont mainfontbold
908c3585 6055 }
da7c24dd 6056 }
28593d3f
PM
6057 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6058 -text $headline -font $font -tags text]
6059 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6060 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6061 -text $name -font $nfont -tags text]
6062 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6063 -text $date -font mainfont -tags text]
94b4a69f 6064 if {$selectedline == $row} {
28593d3f 6065 make_secsel $id
0380081c 6066 }
b9fdba7f
PM
6067 if {[info exists markedid] && $markedid eq $id} {
6068 make_idmark $id
6069 }
9c311b32 6070 set xr [expr {$xt + [font measure $font $headline]}]
be0cd098
PM
6071 if {$xr > $canvxmax} {
6072 set canvxmax $xr
6073 setcanvscroll
6074 }
9f1afe05
PM
6075}
6076
6077proc drawcmitrow {row} {
0380081c 6078 global displayorder rowidlist nrows_drawn
005a2f4e 6079 global iddrawn markingmatches
7fcc92bf 6080 global commitinfo numcommits
687c8765 6081 global filehighlight fhighlights findpattern nhighlights
908c3585 6082 global hlview vhighlights
164ff275 6083 global highlight_related rhighlights
9f1afe05 6084
8f7d0cec 6085 if {$row >= $numcommits} return
9f1afe05
PM
6086
6087 set id [lindex $displayorder $row]
476ca63d 6088 if {[info exists hlview] && ![info exists vhighlights($id)]} {
908c3585
PM
6089 askvhighlight $row $id
6090 }
476ca63d 6091 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
908c3585
PM
6092 askfilehighlight $row $id
6093 }
476ca63d 6094 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
60f7a7dc 6095 askfindhighlight $row $id
908c3585 6096 }
476ca63d 6097 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
164ff275
PM
6098 askrelhighlight $row $id
6099 }
005a2f4e
PM
6100 if {![info exists iddrawn($id)]} {
6101 set col [lsearch -exact [lindex $rowidlist $row] $id]
6102 if {$col < 0} {
6103 puts "oops, row $row id $id not in list"
6104 return
6105 }
6106 if {![info exists commitinfo($id)]} {
6107 getcommit $id
6108 }
6109 assigncolor $id
6110 drawcmittext $id $row $col
6111 set iddrawn($id) 1
0380081c 6112 incr nrows_drawn
9f1afe05 6113 }
005a2f4e
PM
6114 if {$markingmatches} {
6115 markrowmatches $row $id
9f1afe05 6116 }
9f1afe05
PM
6117}
6118
322a8cc9 6119proc drawcommits {row {endrow {}}} {
0380081c 6120 global numcommits iddrawn displayorder curview need_redisplay
f5f3c2e2 6121 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
9f1afe05 6122
9f1afe05
PM
6123 if {$row < 0} {
6124 set row 0
6125 }
322a8cc9
PM
6126 if {$endrow eq {}} {
6127 set endrow $row
6128 }
9f1afe05
PM
6129 if {$endrow >= $numcommits} {
6130 set endrow [expr {$numcommits - 1}]
6131 }
322a8cc9 6132
0380081c
PM
6133 set rl1 [expr {$row - $downarrowlen - 3}]
6134 if {$rl1 < 0} {
6135 set rl1 0
6136 }
6137 set ro1 [expr {$row - 3}]
6138 if {$ro1 < 0} {
6139 set ro1 0
6140 }
6141 set r2 [expr {$endrow + $uparrowlen + 3}]
6142 if {$r2 > $numcommits} {
6143 set r2 $numcommits
6144 }
6145 for {set r $rl1} {$r < $r2} {incr r} {
f5f3c2e2 6146 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
0380081c
PM
6147 if {$rl1 < $r} {
6148 layoutrows $rl1 $r
6149 }
6150 set rl1 [expr {$r + 1}]
6151 }
6152 }
6153 if {$rl1 < $r} {
6154 layoutrows $rl1 $r
6155 }
6156 optimize_rows $ro1 0 $r2
6157 if {$need_redisplay || $nrows_drawn > 2000} {
6158 clear_display
0380081c
PM
6159 }
6160
322a8cc9
PM
6161 # make the lines join to already-drawn rows either side
6162 set r [expr {$row - 1}]
6163 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6164 set r $row
6165 }
6166 set er [expr {$endrow + 1}]
6167 if {$er >= $numcommits ||
6168 ![info exists iddrawn([lindex $displayorder $er])]} {
6169 set er $endrow
6170 }
6171 for {} {$r <= $er} {incr r} {
6172 set id [lindex $displayorder $r]
6173 set wasdrawn [info exists iddrawn($id)]
4fb0fa19 6174 drawcmitrow $r
322a8cc9
PM
6175 if {$r == $er} break
6176 set nextid [lindex $displayorder [expr {$r + 1}]]
e5ef6f95 6177 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
322a8cc9
PM
6178 drawparentlinks $id $r
6179
322a8cc9
PM
6180 set rowids [lindex $rowidlist $r]
6181 foreach lid $rowids {
6182 if {$lid eq {}} continue
e5ef6f95 6183 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
322a8cc9
PM
6184 if {$lid eq $id} {
6185 # see if this is the first child of any of its parents
6186 foreach p [lindex $parentlist $r] {
6187 if {[lsearch -exact $rowids $p] < 0} {
6188 # make this line extend up to the child
e5ef6f95 6189 set lineend($p) [drawlineseg $p $r $er 0]
322a8cc9
PM
6190 }
6191 }
e5ef6f95
PM
6192 } else {
6193 set lineend($lid) [drawlineseg $lid $r $er 1]
322a8cc9
PM
6194 }
6195 }
9f1afe05
PM
6196 }
6197}
6198
7fcc92bf
PM
6199proc undolayout {row} {
6200 global uparrowlen mingaplen downarrowlen
6201 global rowidlist rowisopt rowfinal need_redisplay
6202
6203 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6204 if {$r < 0} {
6205 set r 0
6206 }
6207 if {[llength $rowidlist] > $r} {
6208 incr r -1
6209 set rowidlist [lrange $rowidlist 0 $r]
6210 set rowfinal [lrange $rowfinal 0 $r]
6211 set rowisopt [lrange $rowisopt 0 $r]
6212 set need_redisplay 1
6213 run drawvisible
6214 }
6215}
6216
31c0eaa8
PM
6217proc drawvisible {} {
6218 global canv linespc curview vrowmod selectedline targetrow targetid
42a671fc 6219 global need_redisplay cscroll numcommits
322a8cc9 6220
31c0eaa8 6221 set fs [$canv yview]
322a8cc9 6222 set ymax [lindex [$canv cget -scrollregion] 3]
5a7f577d 6223 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
31c0eaa8
PM
6224 set f0 [lindex $fs 0]
6225 set f1 [lindex $fs 1]
322a8cc9 6226 set y0 [expr {int($f0 * $ymax)}]
322a8cc9 6227 set y1 [expr {int($f1 * $ymax)}]
31c0eaa8
PM
6228
6229 if {[info exists targetid]} {
42a671fc
PM
6230 if {[commitinview $targetid $curview]} {
6231 set r [rowofcommit $targetid]
6232 if {$r != $targetrow} {
6233 # Fix up the scrollregion and change the scrolling position
6234 # now that our target row has moved.
6235 set diff [expr {($r - $targetrow) * $linespc}]
6236 set targetrow $r
6237 setcanvscroll
6238 set ymax [lindex [$canv cget -scrollregion] 3]
6239 incr y0 $diff
6240 incr y1 $diff
6241 set f0 [expr {$y0 / $ymax}]
6242 set f1 [expr {$y1 / $ymax}]
6243 allcanvs yview moveto $f0
6244 $cscroll set $f0 $f1
6245 set need_redisplay 1
6246 }
6247 } else {
6248 unset targetid
31c0eaa8
PM
6249 }
6250 }
6251
6252 set row [expr {int(($y0 - 3) / $linespc) - 1}]
322a8cc9 6253 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
31c0eaa8
PM
6254 if {$endrow >= $vrowmod($curview)} {
6255 update_arcrows $curview
6256 }
94b4a69f 6257 if {$selectedline ne {} &&
31c0eaa8
PM
6258 $row <= $selectedline && $selectedline <= $endrow} {
6259 set targetrow $selectedline
ac1276ab 6260 } elseif {[info exists targetid]} {
31c0eaa8
PM
6261 set targetrow [expr {int(($row + $endrow) / 2)}]
6262 }
ac1276ab
PM
6263 if {[info exists targetrow]} {
6264 if {$targetrow >= $numcommits} {
6265 set targetrow [expr {$numcommits - 1}]
6266 }
6267 set targetid [commitonrow $targetrow]
42a671fc 6268 }
322a8cc9
PM
6269 drawcommits $row $endrow
6270}
6271
9f1afe05 6272proc clear_display {} {
0380081c 6273 global iddrawn linesegs need_redisplay nrows_drawn
164ff275 6274 global vhighlights fhighlights nhighlights rhighlights
28593d3f 6275 global linehtag linentag linedtag boldids boldnameids
9f1afe05
PM
6276
6277 allcanvs delete all
6278 catch {unset iddrawn}
322a8cc9 6279 catch {unset linesegs}
94503a66
PM
6280 catch {unset linehtag}
6281 catch {unset linentag}
6282 catch {unset linedtag}
28593d3f
PM
6283 set boldids {}
6284 set boldnameids {}
908c3585
PM
6285 catch {unset vhighlights}
6286 catch {unset fhighlights}
6287 catch {unset nhighlights}
164ff275 6288 catch {unset rhighlights}
0380081c
PM
6289 set need_redisplay 0
6290 set nrows_drawn 0
9f1afe05
PM
6291}
6292
50b44ece 6293proc findcrossings {id} {
6e8c8707 6294 global rowidlist parentlist numcommits displayorder
50b44ece
PM
6295
6296 set cross {}
6297 set ccross {}
6298 foreach {s e} [rowranges $id] {
6299 if {$e >= $numcommits} {
6300 set e [expr {$numcommits - 1}]
50b44ece 6301 }
d94f8cd6 6302 if {$e <= $s} continue
50b44ece 6303 for {set row $e} {[incr row -1] >= $s} {} {
6e8c8707
PM
6304 set x [lsearch -exact [lindex $rowidlist $row] $id]
6305 if {$x < 0} break
50b44ece
PM
6306 set olds [lindex $parentlist $row]
6307 set kid [lindex $displayorder $row]
6308 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6309 if {$kidx < 0} continue
6310 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6311 foreach p $olds {
6312 set px [lsearch -exact $nextrow $p]
6313 if {$px < 0} continue
6314 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6315 if {[lsearch -exact $ccross $p] >= 0} continue
6316 if {$x == $px + ($kidx < $px? -1: 1)} {
6317 lappend ccross $p
6318 } elseif {[lsearch -exact $cross $p] < 0} {
6319 lappend cross $p
6320 }
6321 }
6322 }
50b44ece
PM
6323 }
6324 }
6325 return [concat $ccross {{}} $cross]
6326}
6327
e5c2d856 6328proc assigncolor {id} {
aa81d974 6329 global colormap colors nextcolor
7fcc92bf 6330 global parents children children curview
6c20ff34 6331
418c4c7b 6332 if {[info exists colormap($id)]} return
e5c2d856 6333 set ncolors [llength $colors]
da7c24dd
PM
6334 if {[info exists children($curview,$id)]} {
6335 set kids $children($curview,$id)
79b2c75e
PM
6336 } else {
6337 set kids {}
6338 }
6339 if {[llength $kids] == 1} {
6340 set child [lindex $kids 0]
9ccbdfbf 6341 if {[info exists colormap($child)]
7fcc92bf 6342 && [llength $parents($curview,$child)] == 1} {
9ccbdfbf
PM
6343 set colormap($id) $colormap($child)
6344 return
e5c2d856 6345 }
9ccbdfbf
PM
6346 }
6347 set badcolors {}
50b44ece
PM
6348 set origbad {}
6349 foreach x [findcrossings $id] {
6350 if {$x eq {}} {
6351 # delimiter between corner crossings and other crossings
6352 if {[llength $badcolors] >= $ncolors - 1} break
6353 set origbad $badcolors
e5c2d856 6354 }
50b44ece
PM
6355 if {[info exists colormap($x)]
6356 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6357 lappend badcolors $colormap($x)
6c20ff34
PM
6358 }
6359 }
50b44ece
PM
6360 if {[llength $badcolors] >= $ncolors} {
6361 set badcolors $origbad
9ccbdfbf 6362 }
50b44ece 6363 set origbad $badcolors
6c20ff34 6364 if {[llength $badcolors] < $ncolors - 1} {
79b2c75e 6365 foreach child $kids {
6c20ff34
PM
6366 if {[info exists colormap($child)]
6367 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6368 lappend badcolors $colormap($child)
6369 }
7fcc92bf 6370 foreach p $parents($curview,$child) {
79b2c75e
PM
6371 if {[info exists colormap($p)]
6372 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6373 lappend badcolors $colormap($p)
6c20ff34
PM
6374 }
6375 }
6376 }
6377 if {[llength $badcolors] >= $ncolors} {
6378 set badcolors $origbad
6379 }
9ccbdfbf
PM
6380 }
6381 for {set i 0} {$i <= $ncolors} {incr i} {
6382 set c [lindex $colors $nextcolor]
6383 if {[incr nextcolor] >= $ncolors} {
6384 set nextcolor 0
e5c2d856 6385 }
9ccbdfbf 6386 if {[lsearch -exact $badcolors $c]} break
e5c2d856 6387 }
9ccbdfbf 6388 set colormap($id) $c
e5c2d856
PM
6389}
6390
a823a911
PM
6391proc bindline {t id} {
6392 global canv
6393
a823a911
PM
6394 $canv bind $t <Enter> "lineenter %x %y $id"
6395 $canv bind $t <Motion> "linemotion %x %y $id"
6396 $canv bind $t <Leave> "lineleave $id"
fa4da7b3 6397 $canv bind $t <Button-1> "lineclick %x %y $id 1"
a823a911
PM
6398}
6399
4399fe33
PM
6400proc graph_pane_width {} {
6401 global use_ttk
6402
6403 if {$use_ttk} {
6404 set g [.tf.histframe.pwclist sashpos 0]
6405 } else {
6406 set g [.tf.histframe.pwclist sash coord 0]
6407 }
6408 return [lindex $g 0]
6409}
6410
6411proc totalwidth {l font extra} {
6412 set tot 0
6413 foreach str $l {
6414 set tot [expr {$tot + [font measure $font $str] + $extra}]
6415 }
6416 return $tot
6417}
6418
bdbfbe3d 6419proc drawtags {id x xt y1} {
8a48571c 6420 global idtags idheads idotherrefs mainhead
bdbfbe3d 6421 global linespc lthickness
d277e89f 6422 global canv rowtextx curview fgcolor bgcolor ctxbut
252c52df
6423 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6424 global tagbgcolor tagfgcolor tagoutlinecolor
6425 global reflinecolor
bdbfbe3d
PM
6426
6427 set marks {}
6428 set ntags 0
f1d83ba3 6429 set nheads 0
4399fe33
PM
6430 set singletag 0
6431 set maxtags 3
6432 set maxtagpct 25
6433 set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6434 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6435 set extra [expr {$delta + $lthickness + $linespc}]
6436
bdbfbe3d
PM
6437 if {[info exists idtags($id)]} {
6438 set marks $idtags($id)
6439 set ntags [llength $marks]
4399fe33
PM
6440 if {$ntags > $maxtags ||
6441 [totalwidth $marks mainfont $extra] > $maxwidth} {
6442 # show just a single "n tags..." tag
6443 set singletag 1
6444 if {$ntags == 1} {
6445 set marks [list "tag..."]
6446 } else {
6447 set marks [list [format "%d tags..." $ntags]]
6448 }
6449 set ntags 1
6450 }
bdbfbe3d
PM
6451 }
6452 if {[info exists idheads($id)]} {
6453 set marks [concat $marks $idheads($id)]
f1d83ba3
PM
6454 set nheads [llength $idheads($id)]
6455 }
6456 if {[info exists idotherrefs($id)]} {
6457 set marks [concat $marks $idotherrefs($id)]
bdbfbe3d
PM
6458 }
6459 if {$marks eq {}} {
6460 return $xt
6461 }
6462
2ed49d54
JH
6463 set yt [expr {$y1 - 0.5 * $linespc}]
6464 set yb [expr {$yt + $linespc - 1}]
bdbfbe3d
PM
6465 set xvals {}
6466 set wvals {}
8a48571c 6467 set i -1
bdbfbe3d 6468 foreach tag $marks {
8a48571c
PM
6469 incr i
6470 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
9c311b32 6471 set wid [font measure mainfontbold $tag]
8a48571c 6472 } else {
9c311b32 6473 set wid [font measure mainfont $tag]
8a48571c 6474 }
bdbfbe3d
PM
6475 lappend xvals $xt
6476 lappend wvals $wid
4399fe33 6477 set xt [expr {$xt + $wid + $extra}]
bdbfbe3d
PM
6478 }
6479 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
252c52df 6480 -width $lthickness -fill $reflinecolor -tags tag.$id]
bdbfbe3d
PM
6481 $canv lower $t
6482 foreach tag $marks x $xvals wid $wvals {
8dd60f54 6483 set tag_quoted [string map {% %%} $tag]
2ed49d54
JH
6484 set xl [expr {$x + $delta}]
6485 set xr [expr {$x + $delta + $wid + $lthickness}]
9c311b32 6486 set font mainfont
bdbfbe3d
PM
6487 if {[incr ntags -1] >= 0} {
6488 # draw a tag
2ed49d54
JH
6489 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6490 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
252c52df
6491 -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6492 -tags tag.$id]
4399fe33
PM
6493 if {$singletag} {
6494 set tagclick [list showtags $id 1]
6495 } else {
6496 set tagclick [list showtag $tag_quoted 1]
6497 }
6498 $canv bind $t <1> $tagclick
7fcc92bf 6499 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
bdbfbe3d 6500 } else {
f1d83ba3
PM
6501 # draw a head or other ref
6502 if {[incr nheads -1] >= 0} {
252c52df 6503 set col $headbgcolor
8a48571c 6504 if {$tag eq $mainhead} {
9c311b32 6505 set font mainfontbold
8a48571c 6506 }
f1d83ba3
PM
6507 } else {
6508 set col "#ddddff"
6509 }
2ed49d54 6510 set xl [expr {$xl - $delta/2}]
bdbfbe3d 6511 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
f1d83ba3 6512 -width 1 -outline black -fill $col -tags tag.$id
a970fcf2 6513 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
9c311b32 6514 set rwid [font measure mainfont $remoteprefix]
a970fcf2
JW
6515 set xi [expr {$x + 1}]
6516 set yti [expr {$yt + 1}]
6517 set xri [expr {$x + $rwid}]
6518 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
252c52df 6519 -width 0 -fill $remotebgcolor -tags tag.$id
a970fcf2 6520 }
bdbfbe3d 6521 }
252c52df 6522 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
8a48571c 6523 -font $font -tags [list tag.$id text]]
106288cb 6524 if {$ntags >= 0} {
4399fe33 6525 $canv bind $t <1> $tagclick
10299152 6526 } elseif {$nheads >= 0} {
8dd60f54 6527 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
106288cb 6528 }
bdbfbe3d
PM
6529 }
6530 return $xt
6531}
6532
36242490
RZ
6533proc drawnotesign {xt y} {
6534 global linespc canv fgcolor
6535
6536 set orad [expr {$linespc / 3}]
6537 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6538 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6539 -fill yellow -outline $fgcolor -width 1 -tags circle]
6540 set xt [expr {$xt + $orad * 3}]
6541 return $xt
6542}
6543
8d858d1a
PM
6544proc xcoord {i level ln} {
6545 global canvx0 xspc1 xspc2
6546
6547 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6548 if {$i > 0 && $i == $level} {
6549 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6550 } elseif {$i > $level} {
6551 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6552 }
6553 return $x
6554}
9ccbdfbf 6555
098dd8a3 6556proc show_status {msg} {
9c311b32 6557 global canv fgcolor
098dd8a3
PM
6558
6559 clear_display
9c311b32 6560 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
f8a2c0d1 6561 -tags text -fill $fgcolor
098dd8a3
PM
6562}
6563
94a2eede
PM
6564# Don't change the text pane cursor if it is currently the hand cursor,
6565# showing that we are over a sha1 ID link.
6566proc settextcursor {c} {
6567 global ctext curtextcursor
6568
6569 if {[$ctext cget -cursor] == $curtextcursor} {
6570 $ctext config -cursor $c
6571 }
6572 set curtextcursor $c
9ccbdfbf
PM
6573}
6574
a137a90f
PM
6575proc nowbusy {what {name {}}} {
6576 global isbusy busyname statusw
da7c24dd
PM
6577
6578 if {[array names isbusy] eq {}} {
6579 . config -cursor watch
6580 settextcursor watch
6581 }
6582 set isbusy($what) 1
a137a90f
PM
6583 set busyname($what) $name
6584 if {$name ne {}} {
6585 $statusw conf -text $name
6586 }
da7c24dd
PM
6587}
6588
6589proc notbusy {what} {
a137a90f 6590 global isbusy maincursor textcursor busyname statusw
da7c24dd 6591
a137a90f
PM
6592 catch {
6593 unset isbusy($what)
6594 if {$busyname($what) ne {} &&
6595 [$statusw cget -text] eq $busyname($what)} {
6596 $statusw conf -text {}
6597 }
6598 }
da7c24dd
PM
6599 if {[array names isbusy] eq {}} {
6600 . config -cursor $maincursor
6601 settextcursor $textcursor
6602 }
6603}
6604
df3d83b1 6605proc findmatches {f} {
4fb0fa19 6606 global findtype findstring
b007ee20 6607 if {$findtype == [mc "Regexp"]} {
4fb0fa19 6608 set matches [regexp -indices -all -inline $findstring $f]
df3d83b1 6609 } else {
4fb0fa19 6610 set fs $findstring
b007ee20 6611 if {$findtype == [mc "IgnCase"]} {
4fb0fa19
PM
6612 set f [string tolower $f]
6613 set fs [string tolower $fs]
df3d83b1
PM
6614 }
6615 set matches {}
6616 set i 0
4fb0fa19
PM
6617 set l [string length $fs]
6618 while {[set j [string first $fs $f $i]] >= 0} {
6619 lappend matches [list $j [expr {$j+$l-1}]]
6620 set i [expr {$j + $l}]
df3d83b1
PM
6621 }
6622 }
6623 return $matches
6624}
6625
cca5d946 6626proc dofind {{dirn 1} {wrap 1}} {
4fb0fa19 6627 global findstring findstartline findcurline selectedline numcommits
cca5d946 6628 global gdttype filehighlight fh_serial find_dirn findallowwrap
b74fd579 6629
cca5d946
PM
6630 if {[info exists find_dirn]} {
6631 if {$find_dirn == $dirn} return
6632 stopfinding
6633 }
df3d83b1 6634 focus .
4fb0fa19 6635 if {$findstring eq {} || $numcommits == 0} return
94b4a69f 6636 if {$selectedline eq {}} {
cca5d946 6637 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
98f350e5 6638 } else {
4fb0fa19 6639 set findstartline $selectedline
98f350e5 6640 }
4fb0fa19 6641 set findcurline $findstartline
b007ee20
CS
6642 nowbusy finding [mc "Searching"]
6643 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
687c8765
PM
6644 after cancel do_file_hl $fh_serial
6645 do_file_hl $fh_serial
98f350e5 6646 }
cca5d946
PM
6647 set find_dirn $dirn
6648 set findallowwrap $wrap
6649 run findmore
4fb0fa19
PM
6650}
6651
bb3edc8b
PM
6652proc stopfinding {} {
6653 global find_dirn findcurline fprogcoord
4fb0fa19 6654
bb3edc8b
PM
6655 if {[info exists find_dirn]} {
6656 unset find_dirn
6657 unset findcurline
6658 notbusy finding
6659 set fprogcoord 0
6660 adjustprogress
4fb0fa19 6661 }
8a897742 6662 stopblaming
4fb0fa19
PM
6663}
6664
6665proc findmore {} {
687c8765 6666 global commitdata commitinfo numcommits findpattern findloc
7fcc92bf 6667 global findstartline findcurline findallowwrap
bb3edc8b 6668 global find_dirn gdttype fhighlights fprogcoord
cd2bcae7 6669 global curview varcorder vrownum varccommits vrowmod
4fb0fa19 6670
bb3edc8b 6671 if {![info exists find_dirn]} {
4fb0fa19
PM
6672 return 0
6673 }
585c27cb 6674 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
4fb0fa19 6675 set l $findcurline
cca5d946
PM
6676 set moretodo 0
6677 if {$find_dirn > 0} {
6678 incr l
6679 if {$l >= $numcommits} {
6680 set l 0
6681 }
6682 if {$l <= $findstartline} {
6683 set lim [expr {$findstartline + 1}]
6684 } else {
6685 set lim $numcommits
6686 set moretodo $findallowwrap
8ed16484 6687 }
4fb0fa19 6688 } else {
cca5d946
PM
6689 if {$l == 0} {
6690 set l $numcommits
98f350e5 6691 }
cca5d946
PM
6692 incr l -1
6693 if {$l >= $findstartline} {
6694 set lim [expr {$findstartline - 1}]
bb3edc8b 6695 } else {
cca5d946
PM
6696 set lim -1
6697 set moretodo $findallowwrap
bb3edc8b 6698 }
687c8765 6699 }
cca5d946
PM
6700 set n [expr {($lim - $l) * $find_dirn}]
6701 if {$n > 500} {
6702 set n 500
6703 set moretodo 1
4fb0fa19 6704 }
cd2bcae7
PM
6705 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6706 update_arcrows $curview
6707 }
687c8765
PM
6708 set found 0
6709 set domore 1
7fcc92bf
PM
6710 set ai [bsearch $vrownum($curview) $l]
6711 set a [lindex $varcorder($curview) $ai]
6712 set arow [lindex $vrownum($curview) $ai]
6713 set ids [lindex $varccommits($curview,$a)]
6714 set arowend [expr {$arow + [llength $ids]}]
b007ee20 6715 if {$gdttype eq [mc "containing:"]} {
cca5d946 6716 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6717 if {$l < $arow || $l >= $arowend} {
6718 incr ai $find_dirn
6719 set a [lindex $varcorder($curview) $ai]
6720 set arow [lindex $vrownum($curview) $ai]
6721 set ids [lindex $varccommits($curview,$a)]
6722 set arowend [expr {$arow + [llength $ids]}]
6723 }
6724 set id [lindex $ids [expr {$l - $arow}]]
cca5d946 6725 # shouldn't happen unless git log doesn't give all the commits...
7fcc92bf
PM
6726 if {![info exists commitdata($id)] ||
6727 ![doesmatch $commitdata($id)]} {
6728 continue
6729 }
687c8765
PM
6730 if {![info exists commitinfo($id)]} {
6731 getcommit $id
6732 }
6733 set info $commitinfo($id)
6734 foreach f $info ty $fldtypes {
585c27cb 6735 if {$ty eq ""} continue
b007ee20 6736 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
687c8765
PM
6737 [doesmatch $f]} {
6738 set found 1
6739 break
6740 }
6741 }
6742 if {$found} break
4fb0fa19 6743 }
687c8765 6744 } else {
cca5d946 6745 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6746 if {$l < $arow || $l >= $arowend} {
6747 incr ai $find_dirn
6748 set a [lindex $varcorder($curview) $ai]
6749 set arow [lindex $vrownum($curview) $ai]
6750 set ids [lindex $varccommits($curview,$a)]
6751 set arowend [expr {$arow + [llength $ids]}]
6752 }
6753 set id [lindex $ids [expr {$l - $arow}]]
476ca63d
PM
6754 if {![info exists fhighlights($id)]} {
6755 # this sets fhighlights($id) to -1
687c8765 6756 askfilehighlight $l $id
cd2bcae7 6757 }
476ca63d 6758 if {$fhighlights($id) > 0} {
cd2bcae7
PM
6759 set found $domore
6760 break
6761 }
476ca63d 6762 if {$fhighlights($id) < 0} {
687c8765
PM
6763 if {$domore} {
6764 set domore 0
cca5d946 6765 set findcurline [expr {$l - $find_dirn}]
687c8765 6766 }
98f350e5
PM
6767 }
6768 }
6769 }
cca5d946 6770 if {$found || ($domore && !$moretodo)} {
4fb0fa19 6771 unset findcurline
687c8765 6772 unset find_dirn
4fb0fa19 6773 notbusy finding
bb3edc8b
PM
6774 set fprogcoord 0
6775 adjustprogress
6776 if {$found} {
6777 findselectline $l
6778 } else {
6779 bell
6780 }
4fb0fa19 6781 return 0
df3d83b1 6782 }
687c8765
PM
6783 if {!$domore} {
6784 flushhighlights
bb3edc8b 6785 } else {
cca5d946 6786 set findcurline [expr {$l - $find_dirn}]
687c8765 6787 }
cca5d946 6788 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
bb3edc8b
PM
6789 if {$n < 0} {
6790 incr n $numcommits
df3d83b1 6791 }
bb3edc8b
PM
6792 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6793 adjustprogress
6794 return $domore
df3d83b1
PM
6795}
6796
6797proc findselectline {l} {
687c8765 6798 global findloc commentend ctext findcurline markingmatches gdttype
005a2f4e 6799
8b39e04f 6800 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
005a2f4e 6801 set findcurline $l
d698206c 6802 selectline $l 1
8b39e04f
PM
6803 if {$markingmatches &&
6804 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
df3d83b1
PM
6805 # highlight the matches in the comments
6806 set f [$ctext get 1.0 $commentend]
6807 set matches [findmatches $f]
6808 foreach match $matches {
6809 set start [lindex $match 0]
2ed49d54 6810 set end [expr {[lindex $match 1] + 1}]
df3d83b1
PM
6811 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6812 }
98f350e5 6813 }
005a2f4e 6814 drawvisible
98f350e5
PM
6815}
6816
4fb0fa19 6817# mark the bits of a headline or author that match a find string
005a2f4e
PM
6818proc markmatches {canv l str tag matches font row} {
6819 global selectedline
6820
98f350e5
PM
6821 set bbox [$canv bbox $tag]
6822 set x0 [lindex $bbox 0]
6823 set y0 [lindex $bbox 1]
6824 set y1 [lindex $bbox 3]
6825 foreach match $matches {
6826 set start [lindex $match 0]
6827 set end [lindex $match 1]
6828 if {$start > $end} continue
2ed49d54
JH
6829 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6830 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6831 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6832 [expr {$x0+$xlen+2}] $y1 \
4fb0fa19 6833 -outline {} -tags [list match$l matches] -fill yellow]
98f350e5 6834 $canv lower $t
94b4a69f 6835 if {$row == $selectedline} {
005a2f4e
PM
6836 $canv raise $t secsel
6837 }
98f350e5
PM
6838 }
6839}
6840
6841proc unmarkmatches {} {
bb3edc8b 6842 global markingmatches
4fb0fa19 6843
98f350e5 6844 allcanvs delete matches
4fb0fa19 6845 set markingmatches 0
bb3edc8b 6846 stopfinding
98f350e5
PM
6847}
6848
c8dfbcf9 6849proc selcanvline {w x y} {
fa4da7b3 6850 global canv canvy0 ctext linespc
9f1afe05 6851 global rowtextx
1db95b00 6852 set ymax [lindex [$canv cget -scrollregion] 3]
cfb4563c 6853 if {$ymax == {}} return
1db95b00
PM
6854 set yfrac [lindex [$canv yview] 0]
6855 set y [expr {$y + $yfrac * $ymax}]
6856 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6857 if {$l < 0} {
6858 set l 0
6859 }
c8dfbcf9 6860 if {$w eq $canv} {
fc2a256f
PM
6861 set xmax [lindex [$canv cget -scrollregion] 2]
6862 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6863 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
c8dfbcf9 6864 }
98f350e5 6865 unmarkmatches
d698206c 6866 selectline $l 1
5ad588de
PM
6867}
6868
b1ba39e7
LT
6869proc commit_descriptor {p} {
6870 global commitinfo
b0934489
PM
6871 if {![info exists commitinfo($p)]} {
6872 getcommit $p
6873 }
b1ba39e7 6874 set l "..."
b0934489 6875 if {[llength $commitinfo($p)] > 1} {
b1ba39e7
LT
6876 set l [lindex $commitinfo($p) 0]
6877 }
b8ab2e17 6878 return "$p ($l)\n"
b1ba39e7
LT
6879}
6880
106288cb
PM
6881# append some text to the ctext widget, and make any SHA1 ID
6882# that we know about be a clickable link.
f1b86294 6883proc appendwithlinks {text tags} {
d375ef9b 6884 global ctext linknum curview
106288cb
PM
6885
6886 set start [$ctext index "end - 1c"]
f1b86294 6887 $ctext insert end $text $tags
6c9e2d18 6888 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
106288cb
PM
6889 foreach l $links {
6890 set s [lindex $l 0]
6891 set e [lindex $l 1]
6892 set linkid [string range $text $s $e]
106288cb 6893 incr e
c73adce2 6894 $ctext tag delete link$linknum
106288cb 6895 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
97645683 6896 setlink $linkid link$linknum
106288cb
PM
6897 incr linknum
6898 }
97645683
PM
6899}
6900
6901proc setlink {id lk} {
d375ef9b 6902 global curview ctext pendinglinks
252c52df 6903 global linkfgcolor
97645683 6904
6c9e2d18
JM
6905 if {[string range $id 0 1] eq "-g"} {
6906 set id [string range $id 2 end]
6907 }
6908
d375ef9b
PM
6909 set known 0
6910 if {[string length $id] < 40} {
6911 set matches [longid $id]
6912 if {[llength $matches] > 0} {
6913 if {[llength $matches] > 1} return
6914 set known 1
6915 set id [lindex $matches 0]
6916 }
6917 } else {
6918 set known [commitinview $id $curview]
6919 }
6920 if {$known} {
252c52df 6921 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
d375ef9b 6922 $ctext tag bind $lk <1> [list selbyid $id]
97645683
PM
6923 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6924 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6925 } else {
6926 lappend pendinglinks($id) $lk
d375ef9b 6927 interestedin $id {makelink %P}
97645683
PM
6928 }
6929}
6930
6f63fc18
PM
6931proc appendshortlink {id {pre {}} {post {}}} {
6932 global ctext linknum
6933
6934 $ctext insert end $pre
6935 $ctext tag delete link$linknum
6936 $ctext insert end [string range $id 0 7] link$linknum
6937 $ctext insert end $post
6938 setlink $id link$linknum
6939 incr linknum
6940}
6941
97645683
PM
6942proc makelink {id} {
6943 global pendinglinks
6944
6945 if {![info exists pendinglinks($id)]} return
6946 foreach lk $pendinglinks($id) {
6947 setlink $id $lk
6948 }
6949 unset pendinglinks($id)
6950}
6951
6952proc linkcursor {w inc} {
6953 global linkentercount curtextcursor
6954
6955 if {[incr linkentercount $inc] > 0} {
6956 $w configure -cursor hand2
6957 } else {
6958 $w configure -cursor $curtextcursor
6959 if {$linkentercount < 0} {
6960 set linkentercount 0
6961 }
6962 }
106288cb
PM
6963}
6964
6e5f7203
RN
6965proc viewnextline {dir} {
6966 global canv linespc
6967
6968 $canv delete hover
6969 set ymax [lindex [$canv cget -scrollregion] 3]
6970 set wnow [$canv yview]
6971 set wtop [expr {[lindex $wnow 0] * $ymax}]
6972 set newtop [expr {$wtop + $dir * $linespc}]
6973 if {$newtop < 0} {
6974 set newtop 0
6975 } elseif {$newtop > $ymax} {
6976 set newtop $ymax
6977 }
6978 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6979}
6980
ef030b85
PM
6981# add a list of tag or branch names at position pos
6982# returns the number of names inserted
e11f1233 6983proc appendrefs {pos ids var} {
386befb7 6984 global ctext linknum curview $var maxrefs mainheadid
b8ab2e17 6985
ef030b85
PM
6986 if {[catch {$ctext index $pos}]} {
6987 return 0
6988 }
e11f1233
PM
6989 $ctext conf -state normal
6990 $ctext delete $pos "$pos lineend"
6991 set tags {}
6992 foreach id $ids {
6993 foreach tag [set $var\($id\)] {
6994 lappend tags [list $tag $id]
6995 }
6996 }
386befb7
PM
6997
6998 set sep {}
6999 set tags [lsort -index 0 -decreasing $tags]
7000 set nutags 0
7001
0a4dd8b8 7002 if {[llength $tags] > $maxrefs} {
386befb7
PM
7003 # If we are displaying heads, and there are too many,
7004 # see if there are some important heads to display.
7005 # Currently this means "master" and the current head.
7006 set itags {}
7007 if {$var eq "idheads"} {
7008 set utags {}
7009 foreach ti $tags {
7010 set hname [lindex $ti 0]
7011 set id [lindex $ti 1]
7012 if {($hname eq "master" || $id eq $mainheadid) &&
7013 [llength $itags] < $maxrefs} {
7014 lappend itags $ti
7015 } else {
7016 lappend utags $ti
7017 }
7018 }
7019 set tags $utags
b8ab2e17 7020 }
386befb7
PM
7021 if {$itags ne {}} {
7022 set str [mc "and many more"]
7023 set sep " "
7024 } else {
7025 set str [mc "many"]
7026 }
7027 $ctext insert $pos "$str ([llength $tags])"
7028 set nutags [llength $tags]
7029 set tags $itags
7030 }
7031
7032 foreach ti $tags {
7033 set id [lindex $ti 1]
7034 set lk link$linknum
7035 incr linknum
7036 $ctext tag delete $lk
7037 $ctext insert $pos $sep
7038 $ctext insert $pos [lindex $ti 0] $lk
7039 setlink $id $lk
7040 set sep ", "
b8ab2e17 7041 }
d34835c9 7042 $ctext tag add wwrap "$pos linestart" "$pos lineend"
e11f1233 7043 $ctext conf -state disabled
386befb7 7044 return [expr {[llength $tags] + $nutags}]
b8ab2e17
PM
7045}
7046
e11f1233
PM
7047# called when we have finished computing the nearby tags
7048proc dispneartags {delay} {
7049 global selectedline currentid showneartags tagphase
ca6d8f58 7050
94b4a69f 7051 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
7052 after cancel dispnexttag
7053 if {$delay} {
7054 after 200 dispnexttag
7055 set tagphase -1
7056 } else {
7057 after idle dispnexttag
7058 set tagphase 0
ca6d8f58 7059 }
ca6d8f58
PM
7060}
7061
e11f1233
PM
7062proc dispnexttag {} {
7063 global selectedline currentid showneartags tagphase ctext
b8ab2e17 7064
94b4a69f 7065 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
7066 switch -- $tagphase {
7067 0 {
7068 set dtags [desctags $currentid]
7069 if {$dtags ne {}} {
7070 appendrefs precedes $dtags idtags
7071 }
7072 }
7073 1 {
7074 set atags [anctags $currentid]
7075 if {$atags ne {}} {
7076 appendrefs follows $atags idtags
7077 }
7078 }
7079 2 {
7080 set dheads [descheads $currentid]
7081 if {$dheads ne {}} {
7082 if {[appendrefs branch $dheads idheads] > 1
7083 && [$ctext get "branch -3c"] eq "h"} {
7084 # turn "Branch" into "Branches"
7085 $ctext conf -state normal
7086 $ctext insert "branch -2c" "es"
7087 $ctext conf -state disabled
7088 }
7089 }
ef030b85
PM
7090 }
7091 }
e11f1233
PM
7092 if {[incr tagphase] <= 2} {
7093 after idle dispnexttag
b8ab2e17 7094 }
b8ab2e17
PM
7095}
7096
28593d3f 7097proc make_secsel {id} {
0380081c
PM
7098 global linehtag linentag linedtag canv canv2 canv3
7099
28593d3f 7100 if {![info exists linehtag($id)]} return
0380081c 7101 $canv delete secsel
28593d3f 7102 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
0380081c
PM
7103 -tags secsel -fill [$canv cget -selectbackground]]
7104 $canv lower $t
7105 $canv2 delete secsel
28593d3f 7106 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
0380081c
PM
7107 -tags secsel -fill [$canv2 cget -selectbackground]]
7108 $canv2 lower $t
7109 $canv3 delete secsel
28593d3f 7110 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
0380081c
PM
7111 -tags secsel -fill [$canv3 cget -selectbackground]]
7112 $canv3 lower $t
7113}
7114
b9fdba7f
PM
7115proc make_idmark {id} {
7116 global linehtag canv fgcolor
7117
7118 if {![info exists linehtag($id)]} return
7119 $canv delete markid
7120 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7121 -tags markid -outline $fgcolor]
7122 $canv raise $t
7123}
7124
8a897742 7125proc selectline {l isnew {desired_loc {}}} {
0380081c 7126 global canv ctext commitinfo selectedline
7fcc92bf 7127 global canvy0 linespc parents children curview
7fcceed7 7128 global currentid sha1entry
9f1afe05 7129 global commentend idtags linknum
d94f8cd6 7130 global mergemax numcommits pending_select
e11f1233 7131 global cmitmode showneartags allcommits
c30acc77 7132 global targetrow targetid lastscrollrows
21ac8a8d 7133 global autoselect autosellen jump_to_here
d698206c 7134
d94f8cd6 7135 catch {unset pending_select}
84ba7345 7136 $canv delete hover
9843c307 7137 normalline
887c996e 7138 unsel_reflist
bb3edc8b 7139 stopfinding
8f7d0cec 7140 if {$l < 0 || $l >= $numcommits} return
ac1276ab
PM
7141 set id [commitonrow $l]
7142 set targetid $id
7143 set targetrow $l
c30acc77
PM
7144 set selectedline $l
7145 set currentid $id
7146 if {$lastscrollrows < $numcommits} {
7147 setcanvscroll
7148 }
ac1276ab 7149
5ad588de 7150 set y [expr {$canvy0 + $l * $linespc}]
17386066 7151 set ymax [lindex [$canv cget -scrollregion] 3]
5842215e
PM
7152 set ytop [expr {$y - $linespc - 1}]
7153 set ybot [expr {$y + $linespc + 1}]
5ad588de 7154 set wnow [$canv yview]
2ed49d54
JH
7155 set wtop [expr {[lindex $wnow 0] * $ymax}]
7156 set wbot [expr {[lindex $wnow 1] * $ymax}]
5842215e
PM
7157 set wh [expr {$wbot - $wtop}]
7158 set newtop $wtop
17386066 7159 if {$ytop < $wtop} {
5842215e
PM
7160 if {$ybot < $wtop} {
7161 set newtop [expr {$y - $wh / 2.0}]
7162 } else {
7163 set newtop $ytop
7164 if {$newtop > $wtop - $linespc} {
7165 set newtop [expr {$wtop - $linespc}]
7166 }
17386066 7167 }
5842215e
PM
7168 } elseif {$ybot > $wbot} {
7169 if {$ytop > $wbot} {
7170 set newtop [expr {$y - $wh / 2.0}]
7171 } else {
7172 set newtop [expr {$ybot - $wh}]
7173 if {$newtop < $wtop + $linespc} {
7174 set newtop [expr {$wtop + $linespc}]
7175 }
17386066 7176 }
5842215e
PM
7177 }
7178 if {$newtop != $wtop} {
7179 if {$newtop < 0} {
7180 set newtop 0
7181 }
2ed49d54 7182 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
9f1afe05 7183 drawvisible
5ad588de 7184 }
d698206c 7185
28593d3f 7186 make_secsel $id
9f1afe05 7187
fa4da7b3 7188 if {$isnew} {
354af6bd 7189 addtohistory [list selbyid $id 0] savecmitpos
d698206c
PM
7190 }
7191
98f350e5
PM
7192 $sha1entry delete 0 end
7193 $sha1entry insert 0 $id
95293b58 7194 if {$autoselect} {
21ac8a8d 7195 $sha1entry selection range 0 $autosellen
95293b58 7196 }
164ff275 7197 rhighlight_sel $id
98f350e5 7198
5ad588de 7199 $ctext conf -state normal
3ea06f9f 7200 clear_ctext
106288cb 7201 set linknum 0
d76afb15
PM
7202 if {![info exists commitinfo($id)]} {
7203 getcommit $id
7204 }
1db95b00 7205 set info $commitinfo($id)
232475d3 7206 set date [formatdate [lindex $info 2]]
d990cedf 7207 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
232475d3 7208 set date [formatdate [lindex $info 4]]
d990cedf 7209 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
887fe3c4 7210 if {[info exists idtags($id)]} {
d990cedf 7211 $ctext insert end [mc "Tags:"]
887fe3c4
PM
7212 foreach tag $idtags($id) {
7213 $ctext insert end " $tag"
7214 }
7215 $ctext insert end "\n"
7216 }
40b87ff8 7217
f1b86294 7218 set headers {}
7fcc92bf 7219 set olds $parents($curview,$id)
79b2c75e 7220 if {[llength $olds] > 1} {
b77b0278 7221 set np 0
79b2c75e 7222 foreach p $olds {
b77b0278
PM
7223 if {$np >= $mergemax} {
7224 set tag mmax
7225 } else {
7226 set tag m$np
7227 }
d990cedf 7228 $ctext insert end "[mc "Parent"]: " $tag
f1b86294 7229 appendwithlinks [commit_descriptor $p] {}
b77b0278
PM
7230 incr np
7231 }
7232 } else {
79b2c75e 7233 foreach p $olds {
d990cedf 7234 append headers "[mc "Parent"]: [commit_descriptor $p]"
b1ba39e7
LT
7235 }
7236 }
b77b0278 7237
6a90bff1 7238 foreach c $children($curview,$id) {
d990cedf 7239 append headers "[mc "Child"]: [commit_descriptor $c]"
8b192809 7240 }
d698206c
PM
7241
7242 # make anything that looks like a SHA1 ID be a clickable link
f1b86294 7243 appendwithlinks $headers {}
b8ab2e17
PM
7244 if {$showneartags} {
7245 if {![info exists allcommits]} {
7246 getallcommits
7247 }
d990cedf 7248 $ctext insert end "[mc "Branch"]: "
ef030b85
PM
7249 $ctext mark set branch "end -1c"
7250 $ctext mark gravity branch left
d990cedf 7251 $ctext insert end "\n[mc "Follows"]: "
b8ab2e17
PM
7252 $ctext mark set follows "end -1c"
7253 $ctext mark gravity follows left
d990cedf 7254 $ctext insert end "\n[mc "Precedes"]: "
b8ab2e17
PM
7255 $ctext mark set precedes "end -1c"
7256 $ctext mark gravity precedes left
b8ab2e17 7257 $ctext insert end "\n"
e11f1233 7258 dispneartags 1
b8ab2e17
PM
7259 }
7260 $ctext insert end "\n"
43c25074
PM
7261 set comment [lindex $info 5]
7262 if {[string first "\r" $comment] >= 0} {
7263 set comment [string map {"\r" "\n "} $comment]
7264 }
7265 appendwithlinks $comment {comment}
d698206c 7266
df3d83b1 7267 $ctext tag remove found 1.0 end
5ad588de 7268 $ctext conf -state disabled
df3d83b1 7269 set commentend [$ctext index "end - 1c"]
5ad588de 7270
8a897742 7271 set jump_to_here $desired_loc
b007ee20 7272 init_flist [mc "Comments"]
f8b28a40
PM
7273 if {$cmitmode eq "tree"} {
7274 gettree $id
7275 } elseif {[llength $olds] <= 1} {
d327244a 7276 startdiff $id
7b5ff7e7 7277 } else {
7fcc92bf 7278 mergediff $id
3c461ffe
PM
7279 }
7280}
7281
6e5f7203
RN
7282proc selfirstline {} {
7283 unmarkmatches
7284 selectline 0 1
7285}
7286
7287proc sellastline {} {
7288 global numcommits
7289 unmarkmatches
7290 set l [expr {$numcommits - 1}]
7291 selectline $l 1
7292}
7293
3c461ffe
PM
7294proc selnextline {dir} {
7295 global selectedline
bd441de4 7296 focus .
94b4a69f 7297 if {$selectedline eq {}} return
2ed49d54 7298 set l [expr {$selectedline + $dir}]
3c461ffe 7299 unmarkmatches
d698206c
PM
7300 selectline $l 1
7301}
7302
6e5f7203
RN
7303proc selnextpage {dir} {
7304 global canv linespc selectedline numcommits
7305
7306 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7307 if {$lpp < 1} {
7308 set lpp 1
7309 }
7310 allcanvs yview scroll [expr {$dir * $lpp}] units
e72ee5eb 7311 drawvisible
94b4a69f 7312 if {$selectedline eq {}} return
6e5f7203
RN
7313 set l [expr {$selectedline + $dir * $lpp}]
7314 if {$l < 0} {
7315 set l 0
7316 } elseif {$l >= $numcommits} {
7317 set l [expr $numcommits - 1]
7318 }
7319 unmarkmatches
40b87ff8 7320 selectline $l 1
6e5f7203
RN
7321}
7322
fa4da7b3 7323proc unselectline {} {
50b44ece 7324 global selectedline currentid
fa4da7b3 7325
94b4a69f 7326 set selectedline {}
50b44ece 7327 catch {unset currentid}
fa4da7b3 7328 allcanvs delete secsel
164ff275 7329 rhighlight_none
fa4da7b3
PM
7330}
7331
f8b28a40
PM
7332proc reselectline {} {
7333 global selectedline
7334
94b4a69f 7335 if {$selectedline ne {}} {
f8b28a40
PM
7336 selectline $selectedline 0
7337 }
7338}
7339
354af6bd 7340proc addtohistory {cmd {saveproc {}}} {
2516dae2 7341 global history historyindex curview
fa4da7b3 7342
354af6bd
PM
7343 unset_posvars
7344 save_position
7345 set elt [list $curview $cmd $saveproc {}]
fa4da7b3 7346 if {$historyindex > 0
2516dae2 7347 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
fa4da7b3
PM
7348 return
7349 }
7350
7351 if {$historyindex < [llength $history]} {
2516dae2 7352 set history [lreplace $history $historyindex end $elt]
fa4da7b3 7353 } else {
2516dae2 7354 lappend history $elt
fa4da7b3
PM
7355 }
7356 incr historyindex
7357 if {$historyindex > 1} {
e9937d2a 7358 .tf.bar.leftbut conf -state normal
fa4da7b3 7359 } else {
e9937d2a 7360 .tf.bar.leftbut conf -state disabled
fa4da7b3 7361 }
e9937d2a 7362 .tf.bar.rightbut conf -state disabled
fa4da7b3
PM
7363}
7364
354af6bd
PM
7365# save the scrolling position of the diff display pane
7366proc save_position {} {
7367 global historyindex history
7368
7369 if {$historyindex < 1} return
7370 set hi [expr {$historyindex - 1}]
7371 set fn [lindex $history $hi 2]
7372 if {$fn ne {}} {
7373 lset history $hi 3 [eval $fn]
7374 }
7375}
7376
7377proc unset_posvars {} {
7378 global last_posvars
7379
7380 if {[info exists last_posvars]} {
7381 foreach {var val} $last_posvars {
7382 global $var
7383 catch {unset $var}
7384 }
7385 unset last_posvars
7386 }
7387}
7388
2516dae2 7389proc godo {elt} {
354af6bd 7390 global curview last_posvars
2516dae2
PM
7391
7392 set view [lindex $elt 0]
7393 set cmd [lindex $elt 1]
354af6bd 7394 set pv [lindex $elt 3]
2516dae2
PM
7395 if {$curview != $view} {
7396 showview $view
7397 }
354af6bd
PM
7398 unset_posvars
7399 foreach {var val} $pv {
7400 global $var
7401 set $var $val
7402 }
7403 set last_posvars $pv
2516dae2
PM
7404 eval $cmd
7405}
7406
d698206c
PM
7407proc goback {} {
7408 global history historyindex
bd441de4 7409 focus .
d698206c
PM
7410
7411 if {$historyindex > 1} {
354af6bd 7412 save_position
d698206c 7413 incr historyindex -1
2516dae2 7414 godo [lindex $history [expr {$historyindex - 1}]]
e9937d2a 7415 .tf.bar.rightbut conf -state normal
d698206c
PM
7416 }
7417 if {$historyindex <= 1} {
e9937d2a 7418 .tf.bar.leftbut conf -state disabled
d698206c
PM
7419 }
7420}
7421
7422proc goforw {} {
7423 global history historyindex
bd441de4 7424 focus .
d698206c
PM
7425
7426 if {$historyindex < [llength $history]} {
354af6bd 7427 save_position
fa4da7b3 7428 set cmd [lindex $history $historyindex]
d698206c 7429 incr historyindex
2516dae2 7430 godo $cmd
e9937d2a 7431 .tf.bar.leftbut conf -state normal
d698206c
PM
7432 }
7433 if {$historyindex >= [llength $history]} {
e9937d2a 7434 .tf.bar.rightbut conf -state disabled
d698206c 7435 }
e2ed4324
PM
7436}
7437
f8b28a40 7438proc gettree {id} {
8f489363
PM
7439 global treefilelist treeidlist diffids diffmergeid treepending
7440 global nullid nullid2
f8b28a40
PM
7441
7442 set diffids $id
7443 catch {unset diffmergeid}
7444 if {![info exists treefilelist($id)]} {
7445 if {![info exists treepending]} {
8f489363
PM
7446 if {$id eq $nullid} {
7447 set cmd [list | git ls-files]
7448 } elseif {$id eq $nullid2} {
7449 set cmd [list | git ls-files --stage -t]
219ea3a9 7450 } else {
8f489363 7451 set cmd [list | git ls-tree -r $id]
219ea3a9
PM
7452 }
7453 if {[catch {set gtf [open $cmd r]}]} {
f8b28a40
PM
7454 return
7455 }
7456 set treepending $id
7457 set treefilelist($id) {}
7458 set treeidlist($id) {}
09c7029d 7459 fconfigure $gtf -blocking 0 -encoding binary
7eb3cb9c 7460 filerun $gtf [list gettreeline $gtf $id]
f8b28a40
PM
7461 }
7462 } else {
7463 setfilelist $id
7464 }
7465}
7466
7467proc gettreeline {gtf id} {
8f489363 7468 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
f8b28a40 7469
7eb3cb9c
PM
7470 set nl 0
7471 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
8f489363
PM
7472 if {$diffids eq $nullid} {
7473 set fname $line
7474 } else {
9396cd38
PM
7475 set i [string first "\t" $line]
7476 if {$i < 0} continue
9396cd38 7477 set fname [string range $line [expr {$i+1}] end]
f31fa2c0
PM
7478 set line [string range $line 0 [expr {$i-1}]]
7479 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7480 set sha1 [lindex $line 2]
219ea3a9 7481 lappend treeidlist($id) $sha1
219ea3a9 7482 }
09c7029d
AG
7483 if {[string index $fname 0] eq "\""} {
7484 set fname [lindex $fname 0]
7485 }
7486 set fname [encoding convertfrom $fname]
7eb3cb9c
PM
7487 lappend treefilelist($id) $fname
7488 }
7489 if {![eof $gtf]} {
7490 return [expr {$nl >= 1000? 2: 1}]
f8b28a40 7491 }
f8b28a40
PM
7492 close $gtf
7493 unset treepending
7494 if {$cmitmode ne "tree"} {
7495 if {![info exists diffmergeid]} {
7496 gettreediffs $diffids
7497 }
7498 } elseif {$id ne $diffids} {
7499 gettree $diffids
7500 } else {
7501 setfilelist $id
7502 }
7eb3cb9c 7503 return 0
f8b28a40
PM
7504}
7505
7506proc showfile {f} {
8f489363 7507 global treefilelist treeidlist diffids nullid nullid2
7cdc3556 7508 global ctext_file_names ctext_file_lines
f8b28a40
PM
7509 global ctext commentend
7510
7511 set i [lsearch -exact $treefilelist($diffids) $f]
7512 if {$i < 0} {
7513 puts "oops, $f not in list for id $diffids"
7514 return
7515 }
8f489363
PM
7516 if {$diffids eq $nullid} {
7517 if {[catch {set bf [open $f r]} err]} {
7518 puts "oops, can't read $f: $err"
219ea3a9
PM
7519 return
7520 }
7521 } else {
8f489363
PM
7522 set blob [lindex $treeidlist($diffids) $i]
7523 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7524 puts "oops, error reading blob $blob: $err"
219ea3a9
PM
7525 return
7526 }
f8b28a40 7527 }
09c7029d 7528 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7eb3cb9c 7529 filerun $bf [list getblobline $bf $diffids]
f8b28a40 7530 $ctext config -state normal
3ea06f9f 7531 clear_ctext $commentend
7cdc3556
AG
7532 lappend ctext_file_names $f
7533 lappend ctext_file_lines [lindex [split $commentend "."] 0]
f8b28a40
PM
7534 $ctext insert end "\n"
7535 $ctext insert end "$f\n" filesep
7536 $ctext config -state disabled
7537 $ctext yview $commentend
32f1b3e4 7538 settabs 0
f8b28a40
PM
7539}
7540
7541proc getblobline {bf id} {
7542 global diffids cmitmode ctext
7543
7544 if {$id ne $diffids || $cmitmode ne "tree"} {
7545 catch {close $bf}
7eb3cb9c 7546 return 0
f8b28a40
PM
7547 }
7548 $ctext config -state normal
7eb3cb9c
PM
7549 set nl 0
7550 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
f8b28a40
PM
7551 $ctext insert end "$line\n"
7552 }
7553 if {[eof $bf]} {
8a897742
PM
7554 global jump_to_here ctext_file_names commentend
7555
f8b28a40
PM
7556 # delete last newline
7557 $ctext delete "end - 2c" "end - 1c"
7558 close $bf
8a897742
PM
7559 if {$jump_to_here ne {} &&
7560 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7561 set lnum [expr {[lindex $jump_to_here 1] +
7562 [lindex [split $commentend .] 0]}]
7563 mark_ctext_line $lnum
7564 }
120ea892 7565 $ctext config -state disabled
7eb3cb9c 7566 return 0
f8b28a40
PM
7567 }
7568 $ctext config -state disabled
7eb3cb9c 7569 return [expr {$nl >= 1000? 2: 1}]
f8b28a40
PM
7570}
7571
8a897742 7572proc mark_ctext_line {lnum} {
e3e901be 7573 global ctext markbgcolor
8a897742
PM
7574
7575 $ctext tag delete omark
7576 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
e3e901be 7577 $ctext tag conf omark -background $markbgcolor
8a897742
PM
7578 $ctext see $lnum.0
7579}
7580
7fcc92bf 7581proc mergediff {id} {
8b07dca1 7582 global diffmergeid
2df6442f 7583 global diffids treediffs
8b07dca1 7584 global parents curview
e2ed4324 7585
3c461ffe 7586 set diffmergeid $id
7a1d9d14 7587 set diffids $id
2df6442f 7588 set treediffs($id) {}
7fcc92bf 7589 set np [llength $parents($curview,$id)]
32f1b3e4 7590 settabs $np
8b07dca1 7591 getblobdiffs $id
c8a4acbf
PM
7592}
7593
3c461ffe 7594proc startdiff {ids} {
8f489363 7595 global treediffs diffids treepending diffmergeid nullid nullid2
c8dfbcf9 7596
32f1b3e4 7597 settabs 1
4f2c2642 7598 set diffids $ids
3c461ffe 7599 catch {unset diffmergeid}
8f489363
PM
7600 if {![info exists treediffs($ids)] ||
7601 [lsearch -exact $ids $nullid] >= 0 ||
7602 [lsearch -exact $ids $nullid2] >= 0} {
c8dfbcf9 7603 if {![info exists treepending]} {
14c9dbd6 7604 gettreediffs $ids
c8dfbcf9
PM
7605 }
7606 } else {
14c9dbd6 7607 addtocflist $ids
c8dfbcf9
PM
7608 }
7609}
7610
65bb0bda
PT
7611# If the filename (name) is under any of the passed filter paths
7612# then return true to include the file in the listing.
7a39a17a 7613proc path_filter {filter name} {
65bb0bda 7614 set worktree [gitworktree]
7a39a17a 7615 foreach p $filter {
65bb0bda
PT
7616 set fq_p [file normalize $p]
7617 set fq_n [file normalize [file join $worktree $name]]
7618 if {[string match [file normalize $fq_p]* $fq_n]} {
7619 return 1
7a39a17a
PM
7620 }
7621 }
7622 return 0
7623}
7624
c8dfbcf9 7625proc addtocflist {ids} {
74a40c71 7626 global treediffs
7a39a17a 7627
74a40c71 7628 add_flist $treediffs($ids)
c8dfbcf9 7629 getblobdiffs $ids
d2610d11
PM
7630}
7631
219ea3a9 7632proc diffcmd {ids flags} {
b2b76d10 7633 global log_showroot nullid nullid2
219ea3a9
PM
7634
7635 set i [lsearch -exact $ids $nullid]
8f489363 7636 set j [lsearch -exact $ids $nullid2]
219ea3a9 7637 if {$i >= 0} {
8f489363
PM
7638 if {[llength $ids] > 1 && $j < 0} {
7639 # comparing working directory with some specific revision
7640 set cmd [concat | git diff-index $flags]
7641 if {$i == 0} {
7642 lappend cmd -R [lindex $ids 1]
7643 } else {
7644 lappend cmd [lindex $ids 0]
7645 }
7646 } else {
7647 # comparing working directory with index
7648 set cmd [concat | git diff-files $flags]
7649 if {$j == 1} {
7650 lappend cmd -R
7651 }
7652 }
7653 } elseif {$j >= 0} {
7654 set cmd [concat | git diff-index --cached $flags]
219ea3a9 7655 if {[llength $ids] > 1} {
8f489363 7656 # comparing index with specific revision
90a77925 7657 if {$j == 0} {
219ea3a9
PM
7658 lappend cmd -R [lindex $ids 1]
7659 } else {
7660 lappend cmd [lindex $ids 0]
7661 }
7662 } else {
8f489363 7663 # comparing index with HEAD
219ea3a9
PM
7664 lappend cmd HEAD
7665 }
7666 } else {
b2b76d10
MK
7667 if {$log_showroot} {
7668 lappend flags --root
7669 }
8f489363 7670 set cmd [concat | git diff-tree -r $flags $ids]
219ea3a9
PM
7671 }
7672 return $cmd
7673}
7674
c8dfbcf9 7675proc gettreediffs {ids} {
2c8cd905 7676 global treediff treepending limitdiffs vfilelimit curview
219ea3a9 7677
2c8cd905
FC
7678 set cmd [diffcmd $ids {--no-commit-id}]
7679 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7680 set cmd [concat $cmd -- $vfilelimit($curview)]
7681 }
7682 if {[catch {set gdtf [open $cmd r]}]} return
7272131b 7683
c8dfbcf9 7684 set treepending $ids
3c461ffe 7685 set treediff {}
09c7029d 7686 fconfigure $gdtf -blocking 0 -encoding binary
7eb3cb9c 7687 filerun $gdtf [list gettreediffline $gdtf $ids]
d2610d11
PM
7688}
7689
c8dfbcf9 7690proc gettreediffline {gdtf ids} {
3c461ffe 7691 global treediff treediffs treepending diffids diffmergeid
39ee47ef 7692 global cmitmode vfilelimit curview limitdiffs perfile_attrs
3c461ffe 7693
7eb3cb9c 7694 set nr 0
4db09304 7695 set sublist {}
39ee47ef
PM
7696 set max 1000
7697 if {$perfile_attrs} {
7698 # cache_gitattr is slow, and even slower on win32 where we
7699 # have to invoke it for only about 30 paths at a time
7700 set max 500
7701 if {[tk windowingsystem] == "win32"} {
7702 set max 120
7703 }
7704 }
7705 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
9396cd38
PM
7706 set i [string first "\t" $line]
7707 if {$i >= 0} {
7708 set file [string range $line [expr {$i+1}] end]
7709 if {[string index $file 0] eq "\""} {
7710 set file [lindex $file 0]
7711 }
09c7029d 7712 set file [encoding convertfrom $file]
48a81b7c
PM
7713 if {$file ne [lindex $treediff end]} {
7714 lappend treediff $file
7715 lappend sublist $file
7716 }
9396cd38 7717 }
7eb3cb9c 7718 }
39ee47ef
PM
7719 if {$perfile_attrs} {
7720 cache_gitattr encoding $sublist
7721 }
7eb3cb9c 7722 if {![eof $gdtf]} {
39ee47ef 7723 return [expr {$nr >= $max? 2: 1}]
7eb3cb9c
PM
7724 }
7725 close $gdtf
2c8cd905 7726 set treediffs($ids) $treediff
7eb3cb9c 7727 unset treepending
e1160138 7728 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7eb3cb9c
PM
7729 gettree $diffids
7730 } elseif {$ids != $diffids} {
7731 if {![info exists diffmergeid]} {
7732 gettreediffs $diffids
b74fd579 7733 }
7eb3cb9c
PM
7734 } else {
7735 addtocflist $ids
d2610d11 7736 }
7eb3cb9c 7737 return 0
d2610d11
PM
7738}
7739
890fae70
SP
7740# empty string or positive integer
7741proc diffcontextvalidate {v} {
7742 return [regexp {^(|[1-9][0-9]*)$} $v]
7743}
7744
7745proc diffcontextchange {n1 n2 op} {
7746 global diffcontextstring diffcontext
7747
7748 if {[string is integer -strict $diffcontextstring]} {
a41ddbb6 7749 if {$diffcontextstring >= 0} {
890fae70
SP
7750 set diffcontext $diffcontextstring
7751 reselectline
7752 }
7753 }
7754}
7755
b9b86007
SP
7756proc changeignorespace {} {
7757 reselectline
7758}
7759
ae4e3ff9
TR
7760proc changeworddiff {name ix op} {
7761 reselectline
7762}
7763
5de460a2
TR
7764proc initblobdiffvars {} {
7765 global diffencoding targetline diffnparents
7766 global diffinhdr currdiffsubmod diffseehere
7767 set targetline {}
7768 set diffnparents 0
7769 set diffinhdr 0
7770 set diffencoding [get_path_encoding {}]
7771 set currdiffsubmod ""
7772 set diffseehere -1
7773}
7774
c8dfbcf9 7775proc getblobdiffs {ids} {
8d73b242 7776 global blobdifffd diffids env
5de460a2 7777 global treediffs
890fae70 7778 global diffcontext
b9b86007 7779 global ignorespace
ae4e3ff9 7780 global worddiff
3ed31a81 7781 global limitdiffs vfilelimit curview
5de460a2 7782 global git_version
c8dfbcf9 7783
a8138733
PM
7784 set textconv {}
7785 if {[package vcompare $git_version "1.6.1"] >= 0} {
7786 set textconv "--textconv"
7787 }
5c838d23
JL
7788 set submodule {}
7789 if {[package vcompare $git_version "1.6.6"] >= 0} {
7790 set submodule "--submodule"
7791 }
7792 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
b9b86007
SP
7793 if {$ignorespace} {
7794 append cmd " -w"
7795 }
ae4e3ff9
TR
7796 if {$worddiff ne [mc "Line diff"]} {
7797 append cmd " --word-diff=porcelain"
7798 }
3ed31a81
PM
7799 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7800 set cmd [concat $cmd -- $vfilelimit($curview)]
7a39a17a
PM
7801 }
7802 if {[catch {set bdf [open $cmd r]} err]} {
8b07dca1 7803 error_popup [mc "Error getting diffs: %s" $err]
e5c2d856
PM
7804 return
7805 }
681c3290 7806 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
c8dfbcf9 7807 set blobdifffd($ids) $bdf
5de460a2 7808 initblobdiffvars
7eb3cb9c 7809 filerun $bdf [list getblobdiffline $bdf $diffids]
e5c2d856
PM
7810}
7811
354af6bd
PM
7812proc savecmitpos {} {
7813 global ctext cmitmode
7814
7815 if {$cmitmode eq "tree"} {
7816 return {}
7817 }
7818 return [list target_scrollpos [$ctext index @0,0]]
7819}
7820
7821proc savectextpos {} {
7822 global ctext
7823
7824 return [list target_scrollpos [$ctext index @0,0]]
7825}
7826
7827proc maybe_scroll_ctext {ateof} {
7828 global ctext target_scrollpos
7829
7830 if {![info exists target_scrollpos]} return
7831 if {!$ateof} {
7832 set nlines [expr {[winfo height $ctext]
7833 / [font metrics textfont -linespace]}]
7834 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7835 }
7836 $ctext yview $target_scrollpos
7837 unset target_scrollpos
7838}
7839
89b11d3b
PM
7840proc setinlist {var i val} {
7841 global $var
7842
7843 while {[llength [set $var]] < $i} {
7844 lappend $var {}
7845 }
7846 if {[llength [set $var]] == $i} {
7847 lappend $var $val
7848 } else {
7849 lset $var $i $val
7850 }
7851}
7852
9396cd38 7853proc makediffhdr {fname ids} {
8b07dca1 7854 global ctext curdiffstart treediffs diffencoding
8a897742 7855 global ctext_file_names jump_to_here targetline diffline
9396cd38 7856
8b07dca1
PM
7857 set fname [encoding convertfrom $fname]
7858 set diffencoding [get_path_encoding $fname]
9396cd38
PM
7859 set i [lsearch -exact $treediffs($ids) $fname]
7860 if {$i >= 0} {
7861 setinlist difffilestart $i $curdiffstart
7862 }
48a81b7c 7863 lset ctext_file_names end $fname
9396cd38
PM
7864 set l [expr {(78 - [string length $fname]) / 2}]
7865 set pad [string range "----------------------------------------" 1 $l]
7866 $ctext insert $curdiffstart "$pad $fname $pad" filesep
8a897742
PM
7867 set targetline {}
7868 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7869 set targetline [lindex $jump_to_here 1]
7870 }
7871 set diffline 0
9396cd38
PM
7872}
7873
5de460a2
TR
7874proc blobdiffmaybeseehere {ateof} {
7875 global diffseehere
7876 if {$diffseehere >= 0} {
7877 mark_ctext_line [lindex [split $diffseehere .] 0]
7878 }
7879 maybe_scroll_ctext ateof
7880}
7881
c8dfbcf9 7882proc getblobdiffline {bdf ids} {
5de460a2
TR
7883 global diffids blobdifffd
7884 global ctext
c8dfbcf9 7885
7eb3cb9c 7886 set nr 0
e5c2d856 7887 $ctext conf -state normal
7eb3cb9c
PM
7888 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7889 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
c21398be 7890 catch {close $bdf}
7eb3cb9c 7891 return 0
89b11d3b 7892 }
5de460a2
TR
7893 parseblobdiffline $ids $line
7894 }
7895 $ctext conf -state disabled
7896 blobdiffmaybeseehere [eof $bdf]
7897 if {[eof $bdf]} {
7898 catch {close $bdf}
7899 return 0
7900 }
7901 return [expr {$nr >= 1000? 2: 1}]
7902}
7903
7904proc parseblobdiffline {ids line} {
7905 global ctext curdiffstart
7906 global diffnexthead diffnextnote difffilestart
7907 global ctext_file_names ctext_file_lines
7908 global diffinhdr treediffs mergemax diffnparents
7909 global diffencoding jump_to_here targetline diffline currdiffsubmod
7910 global worddiff diffseehere
7911
7912 if {![string compare -length 5 "diff " $line]} {
7913 if {![regexp {^diff (--cc|--git) } $line m type]} {
7914 set line [encoding convertfrom $line]
7915 $ctext insert end "$line\n" hunksep
7916 continue
7917 }
7918 # start of a new file
7919 set diffinhdr 1
7920 $ctext insert end "\n"
7921 set curdiffstart [$ctext index "end - 1c"]
7922 lappend ctext_file_names ""
7923 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7924 $ctext insert end "\n" filesep
7925
7926 if {$type eq "--cc"} {
7927 # start of a new file in a merge diff
7928 set fname [string range $line 10 end]
7929 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7930 lappend treediffs($ids) $fname
7931 add_flist [list $fname]
8b07dca1 7932 }
8b07dca1 7933
5de460a2
TR
7934 } else {
7935 set line [string range $line 11 end]
7936 # If the name hasn't changed the length will be odd,
7937 # the middle char will be a space, and the two bits either
7938 # side will be a/name and b/name, or "a/name" and "b/name".
7939 # If the name has changed we'll get "rename from" and
7940 # "rename to" or "copy from" and "copy to" lines following
7941 # this, and we'll use them to get the filenames.
7942 # This complexity is necessary because spaces in the
7943 # filename(s) don't get escaped.
7944 set l [string length $line]
7945 set i [expr {$l / 2}]
7946 if {!(($l & 1) && [string index $line $i] eq " " &&
7947 [string range $line 2 [expr {$i - 1}]] eq \
7948 [string range $line [expr {$i + 3}] end])} {
7949 return
7950 }
7951 # unescape if quoted and chop off the a/ from the front
7952 if {[string index $line 0] eq "\""} {
7953 set fname [string range [lindex $line 0] 2 end]
9396cd38 7954 } else {
5de460a2 7955 set fname [string range $line 2 [expr {$i - 1}]]
7eb3cb9c 7956 }
5de460a2
TR
7957 }
7958 makediffhdr $fname $ids
7959
7960 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7961 set fname [encoding convertfrom [string range $line 16 end]]
7962 $ctext insert end "\n"
7963 set curdiffstart [$ctext index "end - 1c"]
7964 lappend ctext_file_names $fname
7965 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7966 $ctext insert end "$line\n" filesep
7967 set i [lsearch -exact $treediffs($ids) $fname]
7968 if {$i >= 0} {
7969 setinlist difffilestart $i $curdiffstart
7970 }
7971
7972 } elseif {![string compare -length 2 "@@" $line]} {
7973 regexp {^@@+} $line ats
7974 set line [encoding convertfrom $diffencoding $line]
7975 $ctext insert end "$line\n" hunksep
7976 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7977 set diffline $nl
7978 }
7979 set diffnparents [expr {[string length $ats] - 1}]
7980 set diffinhdr 0
9396cd38 7981
5de460a2
TR
7982 } elseif {![string compare -length 10 "Submodule " $line]} {
7983 # start of a new submodule
7984 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7985 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7986 } else {
7987 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7988 }
7989 if {$currdiffsubmod != $fname} {
7990 $ctext insert end "\n"; # Add newline after commit message
7991 }
7992 set curdiffstart [$ctext index "end - 1c"]
7993 lappend ctext_file_names ""
7994 if {$currdiffsubmod != $fname} {
7995 lappend ctext_file_lines $fname
7996 makediffhdr $fname $ids
7997 set currdiffsubmod $fname
7998 $ctext insert end "\n$line\n" filesep
7999 } else {
48a81b7c 8000 $ctext insert end "$line\n" filesep
5de460a2
TR
8001 }
8002 } elseif {![string compare -length 3 " >" $line]} {
8003 set $currdiffsubmod ""
8004 set line [encoding convertfrom $diffencoding $line]
8005 $ctext insert end "$line\n" dresult
8006 } elseif {![string compare -length 3 " <" $line]} {
8007 set $currdiffsubmod ""
8008 set line [encoding convertfrom $diffencoding $line]
8009 $ctext insert end "$line\n" d0
8010 } elseif {$diffinhdr} {
8011 if {![string compare -length 12 "rename from " $line]} {
8012 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8013 if {[string index $fname 0] eq "\""} {
8014 set fname [lindex $fname 0]
8015 }
8016 set fname [encoding convertfrom $fname]
48a81b7c
PM
8017 set i [lsearch -exact $treediffs($ids) $fname]
8018 if {$i >= 0} {
8019 setinlist difffilestart $i $curdiffstart
8020 }
5de460a2
TR
8021 } elseif {![string compare -length 10 $line "rename to "] ||
8022 ![string compare -length 8 $line "copy to "]} {
8023 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8024 if {[string index $fname 0] eq "\""} {
8025 set fname [lindex $fname 0]
8b07dca1 8026 }
5de460a2
TR
8027 makediffhdr $fname $ids
8028 } elseif {[string compare -length 3 $line "---"] == 0} {
8029 # do nothing
8030 return
8031 } elseif {[string compare -length 3 $line "+++"] == 0} {
7eb3cb9c 8032 set diffinhdr 0
5de460a2
TR
8033 return
8034 }
8035 $ctext insert end "$line\n" filesep
9396cd38 8036
5de460a2
TR
8037 } else {
8038 set line [string map {\x1A ^Z} \
8039 [encoding convertfrom $diffencoding $line]]
8040 # parse the prefix - one ' ', '-' or '+' for each parent
8041 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8042 set tag [expr {$diffnparents > 1? "m": "d"}]
8043 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8044 set words_pre_markup ""
8045 set words_post_markup ""
8046 if {[string trim $prefix " -+"] eq {}} {
8047 # prefix only has " ", "-" and "+" in it: normal diff line
8048 set num [string first "-" $prefix]
8049 if {$dowords} {
8050 set line [string range $line 1 end]
8051 }
8052 if {$num >= 0} {
8053 # removed line, first parent with line is $num
8054 if {$num >= $mergemax} {
8055 set num "max"
9396cd38 8056 }
5de460a2
TR
8057 if {$dowords && $worddiff eq [mc "Markup words"]} {
8058 $ctext insert end "\[-$line-\]" $tag$num
8059 } else {
8060 $ctext insert end "$line" $tag$num
9396cd38 8061 }
5de460a2
TR
8062 if {!$dowords} {
8063 $ctext insert end "\n" $tag$num
ae4e3ff9 8064 }
5de460a2
TR
8065 } else {
8066 set tags {}
8067 if {[string first "+" $prefix] >= 0} {
8068 # added line
8069 lappend tags ${tag}result
8070 if {$diffnparents > 1} {
8071 set num [string first " " $prefix]
8072 if {$num >= 0} {
8073 if {$num >= $mergemax} {
8074 set num "max"
8b07dca1 8075 }
5de460a2 8076 lappend tags m$num
8b07dca1
PM
8077 }
8078 }
5de460a2
TR
8079 set words_pre_markup "{+"
8080 set words_post_markup "+}"
8081 }
8082 if {$targetline ne {}} {
8083 if {$diffline == $targetline} {
8084 set diffseehere [$ctext index "end - 1 chars"]
8085 set targetline {}
ae4e3ff9 8086 } else {
5de460a2 8087 incr diffline
ae4e3ff9 8088 }
8b07dca1 8089 }
5de460a2
TR
8090 if {$dowords && $worddiff eq [mc "Markup words"]} {
8091 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8092 } else {
8093 $ctext insert end "$line" $tags
8094 }
8095 if {!$dowords} {
8096 $ctext insert end "\n" $tags
8097 }
e5c2d856 8098 }
5de460a2
TR
8099 } elseif {$dowords && $prefix eq "~"} {
8100 $ctext insert end "\n" {}
8101 } else {
8102 # "\ No newline at end of file",
8103 # or something else we don't recognize
8104 $ctext insert end "$line\n" hunksep
e5c2d856
PM
8105 }
8106 }
e5c2d856
PM
8107}
8108
a8d610a2
PM
8109proc changediffdisp {} {
8110 global ctext diffelide
8111
8112 $ctext tag conf d0 -elide [lindex $diffelide 0]
8b07dca1 8113 $ctext tag conf dresult -elide [lindex $diffelide 1]
a8d610a2
PM
8114}
8115
b967135d
SH
8116proc highlightfile {cline} {
8117 global cflist cflist_top
f4c54b3c 8118
ce837c9d
SH
8119 if {![info exists cflist_top]} return
8120
f4c54b3c
PM
8121 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8122 $cflist tag add highlight $cline.0 "$cline.0 lineend"
8123 $cflist see $cline.0
8124 set cflist_top $cline
8125}
8126
b967135d 8127proc highlightfile_for_scrollpos {topidx} {
978904bf 8128 global cmitmode difffilestart
b967135d 8129
978904bf 8130 if {$cmitmode eq "tree"} return
b967135d
SH
8131 if {![info exists difffilestart]} return
8132
8133 set top [lindex [split $topidx .] 0]
8134 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8135 highlightfile 0
8136 } else {
8137 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8138 }
8139}
8140
67c22874 8141proc prevfile {} {
f4c54b3c
PM
8142 global difffilestart ctext cmitmode
8143
8144 if {$cmitmode eq "tree"} return
8145 set prev 0.0
67c22874
OH
8146 set here [$ctext index @0,0]
8147 foreach loc $difffilestart {
8148 if {[$ctext compare $loc >= $here]} {
b967135d 8149 $ctext yview $prev
67c22874
OH
8150 return
8151 }
8152 set prev $loc
8153 }
b967135d 8154 $ctext yview $prev
67c22874
OH
8155}
8156
39ad8570 8157proc nextfile {} {
f4c54b3c
PM
8158 global difffilestart ctext cmitmode
8159
8160 if {$cmitmode eq "tree"} return
39ad8570 8161 set here [$ctext index @0,0]
7fcceed7
PM
8162 foreach loc $difffilestart {
8163 if {[$ctext compare $loc > $here]} {
b967135d 8164 $ctext yview $loc
67c22874 8165 return
39ad8570
PM
8166 }
8167 }
1db95b00
PM
8168}
8169
3ea06f9f
PM
8170proc clear_ctext {{first 1.0}} {
8171 global ctext smarktop smarkbot
7cdc3556 8172 global ctext_file_names ctext_file_lines
97645683 8173 global pendinglinks
3ea06f9f 8174
1902c270
PM
8175 set l [lindex [split $first .] 0]
8176 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8177 set smarktop $l
3ea06f9f 8178 }
1902c270
PM
8179 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8180 set smarkbot $l
3ea06f9f
PM
8181 }
8182 $ctext delete $first end
97645683
PM
8183 if {$first eq "1.0"} {
8184 catch {unset pendinglinks}
8185 }
7cdc3556
AG
8186 set ctext_file_names {}
8187 set ctext_file_lines {}
3ea06f9f
PM
8188}
8189
32f1b3e4 8190proc settabs {{firstab {}}} {
9c311b32 8191 global firsttabstop tabstop ctext have_tk85
32f1b3e4
PM
8192
8193 if {$firstab ne {} && $have_tk85} {
8194 set firsttabstop $firstab
8195 }
9c311b32 8196 set w [font measure textfont "0"]
32f1b3e4 8197 if {$firsttabstop != 0} {
64b5f146
PM
8198 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8199 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
32f1b3e4
PM
8200 } elseif {$have_tk85 || $tabstop != 8} {
8201 $ctext conf -tabs [expr {$tabstop * $w}]
8202 } else {
8203 $ctext conf -tabs {}
8204 }
3ea06f9f
PM
8205}
8206
8207proc incrsearch {name ix op} {
1902c270 8208 global ctext searchstring searchdirn
3ea06f9f 8209
1902c270
PM
8210 if {[catch {$ctext index anchor}]} {
8211 # no anchor set, use start of selection, or of visible area
8212 set sel [$ctext tag ranges sel]
8213 if {$sel ne {}} {
8214 $ctext mark set anchor [lindex $sel 0]
8215 } elseif {$searchdirn eq "-forwards"} {
8216 $ctext mark set anchor @0,0
8217 } else {
8218 $ctext mark set anchor @0,[winfo height $ctext]
8219 }
8220 }
3ea06f9f 8221 if {$searchstring ne {}} {
30441a6f 8222 set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
1902c270
PM
8223 if {$here ne {}} {
8224 $ctext see $here
30441a6f
SH
8225 set mend "$here + $mlen c"
8226 $ctext tag remove sel 1.0 end
8227 $ctext tag add sel $here $mend
b967135d
SH
8228 suppress_highlighting_file_for_current_scrollpos
8229 highlightfile_for_scrollpos $here
1902c270 8230 }
3ea06f9f 8231 }
c4614994 8232 rehighlight_search_results
3ea06f9f
PM
8233}
8234
8235proc dosearch {} {
1902c270 8236 global sstring ctext searchstring searchdirn
3ea06f9f
PM
8237
8238 focus $sstring
8239 $sstring icursor end
1902c270
PM
8240 set searchdirn -forwards
8241 if {$searchstring ne {}} {
8242 set sel [$ctext tag ranges sel]
8243 if {$sel ne {}} {
8244 set start "[lindex $sel 0] + 1c"
8245 } elseif {[catch {set start [$ctext index anchor]}]} {
8246 set start "@0,0"
8247 }
8248 set match [$ctext search -count mlen -- $searchstring $start]
8249 $ctext tag remove sel 1.0 end
8250 if {$match eq {}} {
8251 bell
8252 return
8253 }
8254 $ctext see $match
b967135d
SH
8255 suppress_highlighting_file_for_current_scrollpos
8256 highlightfile_for_scrollpos $match
1902c270
PM
8257 set mend "$match + $mlen c"
8258 $ctext tag add sel $match $mend
8259 $ctext mark unset anchor
c4614994 8260 rehighlight_search_results
1902c270
PM
8261 }
8262}
8263
8264proc dosearchback {} {
8265 global sstring ctext searchstring searchdirn
8266
8267 focus $sstring
8268 $sstring icursor end
8269 set searchdirn -backwards
8270 if {$searchstring ne {}} {
8271 set sel [$ctext tag ranges sel]
8272 if {$sel ne {}} {
8273 set start [lindex $sel 0]
8274 } elseif {[catch {set start [$ctext index anchor]}]} {
8275 set start @0,[winfo height $ctext]
8276 }
8277 set match [$ctext search -backwards -count ml -- $searchstring $start]
8278 $ctext tag remove sel 1.0 end
8279 if {$match eq {}} {
8280 bell
8281 return
8282 }
8283 $ctext see $match
b967135d
SH
8284 suppress_highlighting_file_for_current_scrollpos
8285 highlightfile_for_scrollpos $match
1902c270
PM
8286 set mend "$match + $ml c"
8287 $ctext tag add sel $match $mend
8288 $ctext mark unset anchor
c4614994
SH
8289 rehighlight_search_results
8290 }
8291}
8292
8293proc rehighlight_search_results {} {
8294 global ctext searchstring
8295
8296 $ctext tag remove found 1.0 end
8297 $ctext tag remove currentsearchhit 1.0 end
8298
8299 if {$searchstring ne {}} {
8300 searchmarkvisible 1
3ea06f9f 8301 }
3ea06f9f
PM
8302}
8303
8304proc searchmark {first last} {
8305 global ctext searchstring
8306
c4614994
SH
8307 set sel [$ctext tag ranges sel]
8308
3ea06f9f
PM
8309 set mend $first.0
8310 while {1} {
8311 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8312 if {$match eq {}} break
8313 set mend "$match + $mlen c"
c4614994
SH
8314 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8315 $ctext tag add currentsearchhit $match $mend
8316 } else {
8317 $ctext tag add found $match $mend
8318 }
3ea06f9f
PM
8319 }
8320}
8321
8322proc searchmarkvisible {doall} {
8323 global ctext smarktop smarkbot
8324
8325 set topline [lindex [split [$ctext index @0,0] .] 0]
8326 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8327 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8328 # no overlap with previous
8329 searchmark $topline $botline
8330 set smarktop $topline
8331 set smarkbot $botline
8332 } else {
8333 if {$topline < $smarktop} {
8334 searchmark $topline [expr {$smarktop-1}]
8335 set smarktop $topline
8336 }
8337 if {$botline > $smarkbot} {
8338 searchmark [expr {$smarkbot+1}] $botline
8339 set smarkbot $botline
8340 }
8341 }
8342}
8343
b967135d
SH
8344proc suppress_highlighting_file_for_current_scrollpos {} {
8345 global ctext suppress_highlighting_file_for_this_scrollpos
8346
8347 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8348}
8349
3ea06f9f 8350proc scrolltext {f0 f1} {
b967135d
SH
8351 global searchstring cmitmode ctext
8352 global suppress_highlighting_file_for_this_scrollpos
8353
978904bf
SH
8354 set topidx [$ctext index @0,0]
8355 if {![info exists suppress_highlighting_file_for_this_scrollpos]
8356 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8357 highlightfile_for_scrollpos $topidx
b967135d
SH
8358 }
8359
8360 catch {unset suppress_highlighting_file_for_this_scrollpos}
3ea06f9f 8361
8809d691 8362 .bleft.bottom.sb set $f0 $f1
3ea06f9f
PM
8363 if {$searchstring ne {}} {
8364 searchmarkvisible 0
8365 }
8366}
8367
1d10f36d 8368proc setcoords {} {
9c311b32 8369 global linespc charspc canvx0 canvy0
f6075eba 8370 global xspc1 xspc2 lthickness
8d858d1a 8371
9c311b32
PM
8372 set linespc [font metrics mainfont -linespace]
8373 set charspc [font measure mainfont "m"]
9f1afe05
PM
8374 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8375 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
f6075eba 8376 set lthickness [expr {int($linespc / 9) + 1}]
8d858d1a
PM
8377 set xspc1(0) $linespc
8378 set xspc2 $linespc
9a40c50c 8379}
1db95b00 8380
1d10f36d 8381proc redisplay {} {
be0cd098 8382 global canv
9f1afe05
PM
8383 global selectedline
8384
8385 set ymax [lindex [$canv cget -scrollregion] 3]
8386 if {$ymax eq {} || $ymax == 0} return
8387 set span [$canv yview]
8388 clear_display
be0cd098 8389 setcanvscroll
9f1afe05
PM
8390 allcanvs yview moveto [lindex $span 0]
8391 drawvisible
94b4a69f 8392 if {$selectedline ne {}} {
9f1afe05 8393 selectline $selectedline 0
ca6d8f58 8394 allcanvs yview moveto [lindex $span 0]
1d10f36d
PM
8395 }
8396}
8397
0ed1dd3c
PM
8398proc parsefont {f n} {
8399 global fontattr
8400
8401 set fontattr($f,family) [lindex $n 0]
8402 set s [lindex $n 1]
8403 if {$s eq {} || $s == 0} {
8404 set s 10
8405 } elseif {$s < 0} {
8406 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
9c311b32 8407 }
0ed1dd3c
PM
8408 set fontattr($f,size) $s
8409 set fontattr($f,weight) normal
8410 set fontattr($f,slant) roman
8411 foreach style [lrange $n 2 end] {
8412 switch -- $style {
8413 "normal" -
8414 "bold" {set fontattr($f,weight) $style}
8415 "roman" -
8416 "italic" {set fontattr($f,slant) $style}
8417 }
9c311b32 8418 }
0ed1dd3c
PM
8419}
8420
8421proc fontflags {f {isbold 0}} {
8422 global fontattr
8423
8424 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8425 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8426 -slant $fontattr($f,slant)]
8427}
8428
8429proc fontname {f} {
8430 global fontattr
8431
8432 set n [list $fontattr($f,family) $fontattr($f,size)]
8433 if {$fontattr($f,weight) eq "bold"} {
8434 lappend n "bold"
9c311b32 8435 }
0ed1dd3c
PM
8436 if {$fontattr($f,slant) eq "italic"} {
8437 lappend n "italic"
9c311b32 8438 }
0ed1dd3c 8439 return $n
9c311b32
PM
8440}
8441
1d10f36d 8442proc incrfont {inc} {
7fcc92bf 8443 global mainfont textfont ctext canv cflist showrefstop
0ed1dd3c
PM
8444 global stopped entries fontattr
8445
1d10f36d 8446 unmarkmatches
0ed1dd3c 8447 set s $fontattr(mainfont,size)
9c311b32
PM
8448 incr s $inc
8449 if {$s < 1} {
8450 set s 1
8451 }
0ed1dd3c 8452 set fontattr(mainfont,size) $s
9c311b32
PM
8453 font config mainfont -size $s
8454 font config mainfontbold -size $s
0ed1dd3c
PM
8455 set mainfont [fontname mainfont]
8456 set s $fontattr(textfont,size)
9c311b32
PM
8457 incr s $inc
8458 if {$s < 1} {
8459 set s 1
8460 }
0ed1dd3c 8461 set fontattr(textfont,size) $s
9c311b32
PM
8462 font config textfont -size $s
8463 font config textfontbold -size $s
0ed1dd3c 8464 set textfont [fontname textfont]
1d10f36d 8465 setcoords
32f1b3e4 8466 settabs
1d10f36d
PM
8467 redisplay
8468}
1db95b00 8469
ee3dc72e
PM
8470proc clearsha1 {} {
8471 global sha1entry sha1string
8472 if {[string length $sha1string] == 40} {
8473 $sha1entry delete 0 end
8474 }
8475}
8476
887fe3c4
PM
8477proc sha1change {n1 n2 op} {
8478 global sha1string currentid sha1but
8479 if {$sha1string == {}
8480 || ([info exists currentid] && $sha1string == $currentid)} {
8481 set state disabled
8482 } else {
8483 set state normal
8484 }
8485 if {[$sha1but cget -state] == $state} return
8486 if {$state == "normal"} {
d990cedf 8487 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
887fe3c4 8488 } else {
d990cedf 8489 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
887fe3c4
PM
8490 }
8491}
8492
8493proc gotocommit {} {
7fcc92bf 8494 global sha1string tagids headids curview varcid
f3b8b3ce 8495
887fe3c4
PM
8496 if {$sha1string == {}
8497 || ([info exists currentid] && $sha1string == $currentid)} return
8498 if {[info exists tagids($sha1string)]} {
8499 set id $tagids($sha1string)
e1007129
SR
8500 } elseif {[info exists headids($sha1string)]} {
8501 set id $headids($sha1string)
887fe3c4
PM
8502 } else {
8503 set id [string tolower $sha1string]
f3b8b3ce 8504 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
d375ef9b 8505 set matches [longid $id]
f3b8b3ce
PM
8506 if {$matches ne {}} {
8507 if {[llength $matches] > 1} {
d990cedf 8508 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
f3b8b3ce
PM
8509 return
8510 }
d375ef9b 8511 set id [lindex $matches 0]
f3b8b3ce 8512 }
9bf3acfa
TR
8513 } else {
8514 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8515 error_popup [mc "Revision %s is not known" $sha1string]
8516 return
8517 }
f3b8b3ce 8518 }
887fe3c4 8519 }
7fcc92bf
PM
8520 if {[commitinview $id $curview]} {
8521 selectline [rowofcommit $id] 1
887fe3c4
PM
8522 return
8523 }
f3b8b3ce 8524 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
d990cedf 8525 set msg [mc "SHA1 id %s is not known" $sha1string]
887fe3c4 8526 } else {
9bf3acfa 8527 set msg [mc "Revision %s is not in the current view" $sha1string]
887fe3c4 8528 }
d990cedf 8529 error_popup $msg
887fe3c4
PM
8530}
8531
84ba7345
PM
8532proc lineenter {x y id} {
8533 global hoverx hovery hoverid hovertimer
8534 global commitinfo canv
8535
8ed16484 8536 if {![info exists commitinfo($id)] && ![getcommit $id]} return
84ba7345
PM
8537 set hoverx $x
8538 set hovery $y
8539 set hoverid $id
8540 if {[info exists hovertimer]} {
8541 after cancel $hovertimer
8542 }
8543 set hovertimer [after 500 linehover]
8544 $canv delete hover
8545}
8546
8547proc linemotion {x y id} {
8548 global hoverx hovery hoverid hovertimer
8549
8550 if {[info exists hoverid] && $id == $hoverid} {
8551 set hoverx $x
8552 set hovery $y
8553 if {[info exists hovertimer]} {
8554 after cancel $hovertimer
8555 }
8556 set hovertimer [after 500 linehover]
8557 }
8558}
8559
8560proc lineleave {id} {
8561 global hoverid hovertimer canv
8562
8563 if {[info exists hoverid] && $id == $hoverid} {
8564 $canv delete hover
8565 if {[info exists hovertimer]} {
8566 after cancel $hovertimer
8567 unset hovertimer
8568 }
8569 unset hoverid
8570 }
8571}
8572
8573proc linehover {} {
8574 global hoverx hovery hoverid hovertimer
8575 global canv linespc lthickness
252c52df
8576 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8577
9c311b32 8578 global commitinfo
84ba7345
PM
8579
8580 set text [lindex $commitinfo($hoverid) 0]
8581 set ymax [lindex [$canv cget -scrollregion] 3]
8582 if {$ymax == {}} return
8583 set yfrac [lindex [$canv yview] 0]
8584 set x [expr {$hoverx + 2 * $linespc}]
8585 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8586 set x0 [expr {$x - 2 * $lthickness}]
8587 set y0 [expr {$y - 2 * $lthickness}]
9c311b32 8588 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
84ba7345
PM
8589 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8590 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
252c52df
8591 -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8592 -width 1 -tags hover]
84ba7345 8593 $canv raise $t
f8a2c0d1 8594 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
252c52df 8595 -font mainfont -fill $linehoverfgcolor]
84ba7345
PM
8596 $canv raise $t
8597}
8598
9843c307 8599proc clickisonarrow {id y} {
50b44ece 8600 global lthickness
9843c307 8601
50b44ece 8602 set ranges [rowranges $id]
9843c307 8603 set thresh [expr {2 * $lthickness + 6}]
50b44ece 8604 set n [expr {[llength $ranges] - 1}]
f6342480 8605 for {set i 1} {$i < $n} {incr i} {
50b44ece 8606 set row [lindex $ranges $i]
f6342480
PM
8607 if {abs([yc $row] - $y) < $thresh} {
8608 return $i
9843c307
PM
8609 }
8610 }
8611 return {}
8612}
8613
f6342480 8614proc arrowjump {id n y} {
50b44ece 8615 global canv
9843c307 8616
f6342480
PM
8617 # 1 <-> 2, 3 <-> 4, etc...
8618 set n [expr {(($n - 1) ^ 1) + 1}]
50b44ece 8619 set row [lindex [rowranges $id] $n]
f6342480 8620 set yt [yc $row]
9843c307
PM
8621 set ymax [lindex [$canv cget -scrollregion] 3]
8622 if {$ymax eq {} || $ymax <= 0} return
8623 set view [$canv yview]
8624 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8625 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8626 if {$yfrac < 0} {
8627 set yfrac 0
8628 }
f6342480 8629 allcanvs yview moveto $yfrac
9843c307
PM
8630}
8631
fa4da7b3 8632proc lineclick {x y id isnew} {
7fcc92bf 8633 global ctext commitinfo children canv thickerline curview
c8dfbcf9 8634
8ed16484 8635 if {![info exists commitinfo($id)] && ![getcommit $id]} return
c8dfbcf9 8636 unmarkmatches
fa4da7b3 8637 unselectline
9843c307
PM
8638 normalline
8639 $canv delete hover
8640 # draw this line thicker than normal
9843c307 8641 set thickerline $id
c934a8a3 8642 drawlines $id
fa4da7b3 8643 if {$isnew} {
9843c307
PM
8644 set ymax [lindex [$canv cget -scrollregion] 3]
8645 if {$ymax eq {}} return
8646 set yfrac [lindex [$canv yview] 0]
8647 set y [expr {$y + $yfrac * $ymax}]
8648 }
8649 set dirn [clickisonarrow $id $y]
8650 if {$dirn ne {}} {
8651 arrowjump $id $dirn $y
8652 return
8653 }
8654
8655 if {$isnew} {
354af6bd 8656 addtohistory [list lineclick $x $y $id 0] savectextpos
fa4da7b3 8657 }
c8dfbcf9
PM
8658 # fill the details pane with info about this line
8659 $ctext conf -state normal
3ea06f9f 8660 clear_ctext
32f1b3e4 8661 settabs 0
d990cedf 8662 $ctext insert end "[mc "Parent"]:\t"
97645683
PM
8663 $ctext insert end $id link0
8664 setlink $id link0
c8dfbcf9 8665 set info $commitinfo($id)
fa4da7b3 8666 $ctext insert end "\n\t[lindex $info 0]\n"
d990cedf 8667 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
232475d3 8668 set date [formatdate [lindex $info 2]]
d990cedf 8669 $ctext insert end "\t[mc "Date"]:\t$date\n"
da7c24dd 8670 set kids $children($curview,$id)
79b2c75e 8671 if {$kids ne {}} {
d990cedf 8672 $ctext insert end "\n[mc "Children"]:"
fa4da7b3 8673 set i 0
79b2c75e 8674 foreach child $kids {
fa4da7b3 8675 incr i
8ed16484 8676 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
c8dfbcf9 8677 set info $commitinfo($child)
fa4da7b3 8678 $ctext insert end "\n\t"
97645683
PM
8679 $ctext insert end $child link$i
8680 setlink $child link$i
fa4da7b3 8681 $ctext insert end "\n\t[lindex $info 0]"
d990cedf 8682 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
232475d3 8683 set date [formatdate [lindex $info 2]]
d990cedf 8684 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
c8dfbcf9
PM
8685 }
8686 }
354af6bd 8687 maybe_scroll_ctext 1
c8dfbcf9 8688 $ctext conf -state disabled
7fcceed7 8689 init_flist {}
c8dfbcf9
PM
8690}
8691
9843c307
PM
8692proc normalline {} {
8693 global thickerline
8694 if {[info exists thickerline]} {
c934a8a3 8695 set id $thickerline
9843c307 8696 unset thickerline
c934a8a3 8697 drawlines $id
9843c307
PM
8698 }
8699}
8700
354af6bd 8701proc selbyid {id {isnew 1}} {
7fcc92bf
PM
8702 global curview
8703 if {[commitinview $id $curview]} {
354af6bd 8704 selectline [rowofcommit $id] $isnew
c8dfbcf9
PM
8705 }
8706}
8707
8708proc mstime {} {
8709 global startmstime
8710 if {![info exists startmstime]} {
8711 set startmstime [clock clicks -milliseconds]
8712 }
8713 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8714}
8715
8716proc rowmenu {x y id} {
7fcc92bf 8717 global rowctxmenu selectedline rowmenuid curview
b9fdba7f 8718 global nullid nullid2 fakerowmenu mainhead markedid
c8dfbcf9 8719
bb3edc8b 8720 stopfinding
219ea3a9 8721 set rowmenuid $id
94b4a69f 8722 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
c8dfbcf9
PM
8723 set state disabled
8724 } else {
8725 set state normal
8726 }
6febdede
PM
8727 if {[info exists markedid] && $markedid ne $id} {
8728 set mstate normal
8729 } else {
8730 set mstate disabled
8731 }
8f489363 8732 if {$id ne $nullid && $id ne $nullid2} {
219ea3a9 8733 set menu $rowctxmenu
5e3502da 8734 if {$mainhead ne {}} {
da12e59d 8735 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
5e3502da
MB
8736 } else {
8737 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8738 }
6febdede
PM
8739 $menu entryconfigure 9 -state $mstate
8740 $menu entryconfigure 10 -state $mstate
8741 $menu entryconfigure 11 -state $mstate
219ea3a9
PM
8742 } else {
8743 set menu $fakerowmenu
8744 }
f2d0bbbd
PM
8745 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8746 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8747 $menu entryconfigure [mca "Make patch"] -state $state
6febdede
PM
8748 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8749 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
219ea3a9 8750 tk_popup $menu $x $y
c8dfbcf9
PM
8751}
8752
b9fdba7f
PM
8753proc markhere {} {
8754 global rowmenuid markedid canv
8755
8756 set markedid $rowmenuid
8757 make_idmark $markedid
8758}
8759
8760proc gotomark {} {
8761 global markedid
8762
8763 if {[info exists markedid]} {
8764 selbyid $markedid
8765 }
8766}
8767
8768proc replace_by_kids {l r} {
8769 global curview children
8770
8771 set id [commitonrow $r]
8772 set l [lreplace $l 0 0]
8773 foreach kid $children($curview,$id) {
8774 lappend l [rowofcommit $kid]
8775 }
8776 return [lsort -integer -decreasing -unique $l]
8777}
8778
8779proc find_common_desc {} {
8780 global markedid rowmenuid curview children
8781
8782 if {![info exists markedid]} return
8783 if {![commitinview $markedid $curview] ||
8784 ![commitinview $rowmenuid $curview]} return
8785 #set t1 [clock clicks -milliseconds]
8786 set l1 [list [rowofcommit $markedid]]
8787 set l2 [list [rowofcommit $rowmenuid]]
8788 while 1 {
8789 set r1 [lindex $l1 0]
8790 set r2 [lindex $l2 0]
8791 if {$r1 eq {} || $r2 eq {}} break
8792 if {$r1 == $r2} {
8793 selectline $r1 1
8794 break
8795 }
8796 if {$r1 > $r2} {
8797 set l1 [replace_by_kids $l1 $r1]
8798 } else {
8799 set l2 [replace_by_kids $l2 $r2]
8800 }
8801 }
8802 #set t2 [clock clicks -milliseconds]
8803 #puts "took [expr {$t2-$t1}]ms"
8804}
8805
010509f2
PM
8806proc compare_commits {} {
8807 global markedid rowmenuid curview children
8808
8809 if {![info exists markedid]} return
8810 if {![commitinview $markedid $curview]} return
8811 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8812 do_cmp_commits $markedid $rowmenuid
8813}
8814
8815proc getpatchid {id} {
8816 global patchids
8817
8818 if {![info exists patchids($id)]} {
6f63fc18
PM
8819 set cmd [diffcmd [list $id] {-p --root}]
8820 # trim off the initial "|"
8821 set cmd [lrange $cmd 1 end]
8822 if {[catch {
8823 set x [eval exec $cmd | git patch-id]
8824 set patchids($id) [lindex $x 0]
8825 }]} {
8826 set patchids($id) "error"
8827 }
010509f2
PM
8828 }
8829 return $patchids($id)
8830}
8831
8832proc do_cmp_commits {a b} {
8833 global ctext curview parents children patchids commitinfo
8834
8835 $ctext conf -state normal
8836 clear_ctext
8837 init_flist {}
8838 for {set i 0} {$i < 100} {incr i} {
010509f2
PM
8839 set skipa 0
8840 set skipb 0
8841 if {[llength $parents($curview,$a)] > 1} {
6f63fc18 8842 appendshortlink $a [mc "Skipping merge commit "] "\n"
010509f2
PM
8843 set skipa 1
8844 } else {
8845 set patcha [getpatchid $a]
8846 }
8847 if {[llength $parents($curview,$b)] > 1} {
6f63fc18 8848 appendshortlink $b [mc "Skipping merge commit "] "\n"
010509f2
PM
8849 set skipb 1
8850 } else {
8851 set patchb [getpatchid $b]
8852 }
8853 if {!$skipa && !$skipb} {
8854 set heada [lindex $commitinfo($a) 0]
8855 set headb [lindex $commitinfo($b) 0]
6f63fc18
PM
8856 if {$patcha eq "error"} {
8857 appendshortlink $a [mc "Error getting patch ID for "] \
8858 [mc " - stopping\n"]
8859 break
8860 }
8861 if {$patchb eq "error"} {
8862 appendshortlink $b [mc "Error getting patch ID for "] \
8863 [mc " - stopping\n"]
8864 break
8865 }
010509f2
PM
8866 if {$patcha eq $patchb} {
8867 if {$heada eq $headb} {
6f63fc18
PM
8868 appendshortlink $a [mc "Commit "]
8869 appendshortlink $b " == " " $heada\n"
010509f2 8870 } else {
6f63fc18
PM
8871 appendshortlink $a [mc "Commit "] " $heada\n"
8872 appendshortlink $b [mc " is the same patch as\n "] \
8873 " $headb\n"
010509f2
PM
8874 }
8875 set skipa 1
8876 set skipb 1
8877 } else {
8878 $ctext insert end "\n"
6f63fc18
PM
8879 appendshortlink $a [mc "Commit "] " $heada\n"
8880 appendshortlink $b [mc " differs from\n "] \
8881 " $headb\n"
c21398be
PM
8882 $ctext insert end [mc "Diff of commits:\n\n"]
8883 $ctext conf -state disabled
8884 update
8885 diffcommits $a $b
8886 return
010509f2
PM
8887 }
8888 }
8889 if {$skipa} {
aa43561a
PM
8890 set kids [real_children $curview,$a]
8891 if {[llength $kids] != 1} {
010509f2 8892 $ctext insert end "\n"
6f63fc18 8893 appendshortlink $a [mc "Commit "] \
aa43561a 8894 [mc " has %s children - stopping\n" [llength $kids]]
010509f2
PM
8895 break
8896 }
aa43561a 8897 set a [lindex $kids 0]
010509f2
PM
8898 }
8899 if {$skipb} {
aa43561a
PM
8900 set kids [real_children $curview,$b]
8901 if {[llength $kids] != 1} {
6f63fc18 8902 appendshortlink $b [mc "Commit "] \
aa43561a 8903 [mc " has %s children - stopping\n" [llength $kids]]
010509f2
PM
8904 break
8905 }
aa43561a 8906 set b [lindex $kids 0]
010509f2
PM
8907 }
8908 }
8909 $ctext conf -state disabled
8910}
8911
c21398be 8912proc diffcommits {a b} {
a1d383c5 8913 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
c21398be
PM
8914
8915 set tmpdir [gitknewtmpdir]
8916 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8917 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8918 if {[catch {
8919 exec git diff-tree -p --pretty $a >$fna
8920 exec git diff-tree -p --pretty $b >$fnb
8921 } err]} {
8922 error_popup [mc "Error writing commit to file: %s" $err]
8923 return
8924 }
8925 if {[catch {
8926 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8927 } err]} {
8928 error_popup [mc "Error diffing commits: %s" $err]
8929 return
8930 }
8931 set diffids [list commits $a $b]
8932 set blobdifffd($diffids) $fd
8933 set diffinhdr 0
a1d383c5 8934 set currdiffsubmod ""
c21398be
PM
8935 filerun $fd [list getblobdiffline $fd $diffids]
8936}
8937
c8dfbcf9 8938proc diffvssel {dirn} {
7fcc92bf 8939 global rowmenuid selectedline
c8dfbcf9 8940
94b4a69f 8941 if {$selectedline eq {}} return
c8dfbcf9 8942 if {$dirn} {
7fcc92bf 8943 set oldid [commitonrow $selectedline]
c8dfbcf9
PM
8944 set newid $rowmenuid
8945 } else {
8946 set oldid $rowmenuid
7fcc92bf 8947 set newid [commitonrow $selectedline]
c8dfbcf9 8948 }
354af6bd 8949 addtohistory [list doseldiff $oldid $newid] savectextpos
fa4da7b3
PM
8950 doseldiff $oldid $newid
8951}
8952
6febdede
PM
8953proc diffvsmark {dirn} {
8954 global rowmenuid markedid
8955
8956 if {![info exists markedid]} return
8957 if {$dirn} {
8958 set oldid $markedid
8959 set newid $rowmenuid
8960 } else {
8961 set oldid $rowmenuid
8962 set newid $markedid
8963 }
8964 addtohistory [list doseldiff $oldid $newid] savectextpos
8965 doseldiff $oldid $newid
8966}
8967
fa4da7b3 8968proc doseldiff {oldid newid} {
7fcceed7 8969 global ctext
fa4da7b3
PM
8970 global commitinfo
8971
c8dfbcf9 8972 $ctext conf -state normal
3ea06f9f 8973 clear_ctext
d990cedf
CS
8974 init_flist [mc "Top"]
8975 $ctext insert end "[mc "From"] "
97645683
PM
8976 $ctext insert end $oldid link0
8977 setlink $oldid link0
fa4da7b3 8978 $ctext insert end "\n "
c8dfbcf9 8979 $ctext insert end [lindex $commitinfo($oldid) 0]
d990cedf 8980 $ctext insert end "\n\n[mc "To"] "
97645683
PM
8981 $ctext insert end $newid link1
8982 setlink $newid link1
fa4da7b3 8983 $ctext insert end "\n "
c8dfbcf9
PM
8984 $ctext insert end [lindex $commitinfo($newid) 0]
8985 $ctext insert end "\n"
8986 $ctext conf -state disabled
c8dfbcf9 8987 $ctext tag remove found 1.0 end
d327244a 8988 startdiff [list $oldid $newid]
c8dfbcf9
PM
8989}
8990
74daedb6 8991proc mkpatch {} {
d93f1713 8992 global rowmenuid currentid commitinfo patchtop patchnum NS
74daedb6
PM
8993
8994 if {![info exists currentid]} return
8995 set oldid $currentid
8996 set oldhead [lindex $commitinfo($oldid) 0]
8997 set newid $rowmenuid
8998 set newhead [lindex $commitinfo($newid) 0]
8999 set top .patch
9000 set patchtop $top
9001 catch {destroy $top}
d93f1713 9002 ttk_toplevel $top
e7d64008 9003 make_transient $top .
d93f1713 9004 ${NS}::label $top.title -text [mc "Generate patch"]
4a2139f5 9005 grid $top.title - -pady 10
d93f1713
PT
9006 ${NS}::label $top.from -text [mc "From:"]
9007 ${NS}::entry $top.fromsha1 -width 40
74daedb6
PM
9008 $top.fromsha1 insert 0 $oldid
9009 $top.fromsha1 conf -state readonly
9010 grid $top.from $top.fromsha1 -sticky w
d93f1713 9011 ${NS}::entry $top.fromhead -width 60
74daedb6
PM
9012 $top.fromhead insert 0 $oldhead
9013 $top.fromhead conf -state readonly
9014 grid x $top.fromhead -sticky w
d93f1713
PT
9015 ${NS}::label $top.to -text [mc "To:"]
9016 ${NS}::entry $top.tosha1 -width 40
74daedb6
PM
9017 $top.tosha1 insert 0 $newid
9018 $top.tosha1 conf -state readonly
9019 grid $top.to $top.tosha1 -sticky w
d93f1713 9020 ${NS}::entry $top.tohead -width 60
74daedb6
PM
9021 $top.tohead insert 0 $newhead
9022 $top.tohead conf -state readonly
9023 grid x $top.tohead -sticky w
d93f1713
PT
9024 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9025 grid $top.rev x -pady 10 -padx 5
9026 ${NS}::label $top.flab -text [mc "Output file:"]
9027 ${NS}::entry $top.fname -width 60
74daedb6
PM
9028 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9029 incr patchnum
bdbfbe3d 9030 grid $top.flab $top.fname -sticky w
d93f1713
PT
9031 ${NS}::frame $top.buts
9032 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9033 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
76f15947
AG
9034 bind $top <Key-Return> mkpatchgo
9035 bind $top <Key-Escape> mkpatchcan
74daedb6
PM
9036 grid $top.buts.gen $top.buts.can
9037 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9038 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9039 grid $top.buts - -pady 10 -sticky ew
bdbfbe3d 9040 focus $top.fname
74daedb6
PM
9041}
9042
9043proc mkpatchrev {} {
9044 global patchtop
9045
9046 set oldid [$patchtop.fromsha1 get]
9047 set oldhead [$patchtop.fromhead get]
9048 set newid [$patchtop.tosha1 get]
9049 set newhead [$patchtop.tohead get]
9050 foreach e [list fromsha1 fromhead tosha1 tohead] \
9051 v [list $newid $newhead $oldid $oldhead] {
9052 $patchtop.$e conf -state normal
9053 $patchtop.$e delete 0 end
9054 $patchtop.$e insert 0 $v
9055 $patchtop.$e conf -state readonly
9056 }
9057}
9058
9059proc mkpatchgo {} {
8f489363 9060 global patchtop nullid nullid2
74daedb6
PM
9061
9062 set oldid [$patchtop.fromsha1 get]
9063 set newid [$patchtop.tosha1 get]
9064 set fname [$patchtop.fname get]
8f489363 9065 set cmd [diffcmd [list $oldid $newid] -p]
d372e216
PM
9066 # trim off the initial "|"
9067 set cmd [lrange $cmd 1 end]
219ea3a9
PM
9068 lappend cmd >$fname &
9069 if {[catch {eval exec $cmd} err]} {
84a76f18 9070 error_popup "[mc "Error creating patch:"] $err" $patchtop
74daedb6
PM
9071 }
9072 catch {destroy $patchtop}
9073 unset patchtop
9074}
9075
9076proc mkpatchcan {} {
9077 global patchtop
9078
9079 catch {destroy $patchtop}
9080 unset patchtop
9081}
9082
bdbfbe3d 9083proc mktag {} {
d93f1713 9084 global rowmenuid mktagtop commitinfo NS
bdbfbe3d
PM
9085
9086 set top .maketag
9087 set mktagtop $top
9088 catch {destroy $top}
d93f1713 9089 ttk_toplevel $top
e7d64008 9090 make_transient $top .
d93f1713 9091 ${NS}::label $top.title -text [mc "Create tag"]
4a2139f5 9092 grid $top.title - -pady 10
d93f1713
PT
9093 ${NS}::label $top.id -text [mc "ID:"]
9094 ${NS}::entry $top.sha1 -width 40
bdbfbe3d
PM
9095 $top.sha1 insert 0 $rowmenuid
9096 $top.sha1 conf -state readonly
9097 grid $top.id $top.sha1 -sticky w
d93f1713 9098 ${NS}::entry $top.head -width 60
bdbfbe3d
PM
9099 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9100 $top.head conf -state readonly
9101 grid x $top.head -sticky w
d93f1713
PT
9102 ${NS}::label $top.tlab -text [mc "Tag name:"]
9103 ${NS}::entry $top.tag -width 60
bdbfbe3d 9104 grid $top.tlab $top.tag -sticky w
dfb891e3
DD
9105 ${NS}::label $top.op -text [mc "Tag message is optional"]
9106 grid $top.op -columnspan 2 -sticky we
9107 ${NS}::label $top.mlab -text [mc "Tag message:"]
9108 ${NS}::entry $top.msg -width 60
9109 grid $top.mlab $top.msg -sticky w
d93f1713
PT
9110 ${NS}::frame $top.buts
9111 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9112 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
76f15947
AG
9113 bind $top <Key-Return> mktaggo
9114 bind $top <Key-Escape> mktagcan
bdbfbe3d
PM
9115 grid $top.buts.gen $top.buts.can
9116 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9117 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9118 grid $top.buts - -pady 10 -sticky ew
9119 focus $top.tag
9120}
9121
9122proc domktag {} {
9123 global mktagtop env tagids idtags
bdbfbe3d
PM
9124
9125 set id [$mktagtop.sha1 get]
9126 set tag [$mktagtop.tag get]
dfb891e3 9127 set msg [$mktagtop.msg get]
bdbfbe3d 9128 if {$tag == {}} {
84a76f18
AG
9129 error_popup [mc "No tag name specified"] $mktagtop
9130 return 0
bdbfbe3d
PM
9131 }
9132 if {[info exists tagids($tag)]} {
84a76f18
AG
9133 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9134 return 0
bdbfbe3d
PM
9135 }
9136 if {[catch {
dfb891e3
DD
9137 if {$msg != {}} {
9138 exec git tag -a -m $msg $tag $id
9139 } else {
9140 exec git tag $tag $id
9141 }
bdbfbe3d 9142 } err]} {
84a76f18
AG
9143 error_popup "[mc "Error creating tag:"] $err" $mktagtop
9144 return 0
bdbfbe3d
PM
9145 }
9146
9147 set tagids($tag) $id
9148 lappend idtags($id) $tag
f1d83ba3 9149 redrawtags $id
ceadfe90 9150 addedtag $id
887c996e
PM
9151 dispneartags 0
9152 run refill_reflist
84a76f18 9153 return 1
f1d83ba3
PM
9154}
9155
9156proc redrawtags {id} {
b9fdba7f 9157 global canv linehtag idpos currentid curview cmitlisted markedid
c11ff120 9158 global canvxmax iddrawn circleitem mainheadid circlecolors
252c52df 9159 global mainheadcirclecolor
f1d83ba3 9160
7fcc92bf 9161 if {![commitinview $id $curview]} return
322a8cc9 9162 if {![info exists iddrawn($id)]} return
fc2a256f 9163 set row [rowofcommit $id]
c11ff120 9164 if {$id eq $mainheadid} {
252c52df 9165 set ofill $mainheadcirclecolor
c11ff120
PM
9166 } else {
9167 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9168 }
9169 $canv itemconf $circleitem($row) -fill $ofill
bdbfbe3d
PM
9170 $canv delete tag.$id
9171 set xt [eval drawtags $id $idpos($id)]
28593d3f
PM
9172 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9173 set text [$canv itemcget $linehtag($id) -text]
9174 set font [$canv itemcget $linehtag($id) -font]
fc2a256f 9175 set xr [expr {$xt + [font measure $font $text]}]
b8ab2e17
PM
9176 if {$xr > $canvxmax} {
9177 set canvxmax $xr
9178 setcanvscroll
9179 }
fc2a256f 9180 if {[info exists currentid] && $currentid == $id} {
28593d3f 9181 make_secsel $id
bdbfbe3d 9182 }
b9fdba7f
PM
9183 if {[info exists markedid] && $markedid eq $id} {
9184 make_idmark $id
9185 }
bdbfbe3d
PM
9186}
9187
9188proc mktagcan {} {
9189 global mktagtop
9190
9191 catch {destroy $mktagtop}
9192 unset mktagtop
9193}
9194
9195proc mktaggo {} {
84a76f18 9196 if {![domktag]} return
bdbfbe3d
PM
9197 mktagcan
9198}
9199
4a2139f5 9200proc writecommit {} {
d93f1713 9201 global rowmenuid wrcomtop commitinfo wrcomcmd NS
4a2139f5
PM
9202
9203 set top .writecommit
9204 set wrcomtop $top
9205 catch {destroy $top}
d93f1713 9206 ttk_toplevel $top
e7d64008 9207 make_transient $top .
d93f1713 9208 ${NS}::label $top.title -text [mc "Write commit to file"]
4a2139f5 9209 grid $top.title - -pady 10
d93f1713
PT
9210 ${NS}::label $top.id -text [mc "ID:"]
9211 ${NS}::entry $top.sha1 -width 40
4a2139f5
PM
9212 $top.sha1 insert 0 $rowmenuid
9213 $top.sha1 conf -state readonly
9214 grid $top.id $top.sha1 -sticky w
d93f1713 9215 ${NS}::entry $top.head -width 60
4a2139f5
PM
9216 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9217 $top.head conf -state readonly
9218 grid x $top.head -sticky w
d93f1713
PT
9219 ${NS}::label $top.clab -text [mc "Command:"]
9220 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
4a2139f5 9221 grid $top.clab $top.cmd -sticky w -pady 10
d93f1713
PT
9222 ${NS}::label $top.flab -text [mc "Output file:"]
9223 ${NS}::entry $top.fname -width 60
4a2139f5
PM
9224 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9225 grid $top.flab $top.fname -sticky w
d93f1713
PT
9226 ${NS}::frame $top.buts
9227 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9228 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
76f15947
AG
9229 bind $top <Key-Return> wrcomgo
9230 bind $top <Key-Escape> wrcomcan
4a2139f5
PM
9231 grid $top.buts.gen $top.buts.can
9232 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9233 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9234 grid $top.buts - -pady 10 -sticky ew
9235 focus $top.fname
9236}
9237
9238proc wrcomgo {} {
9239 global wrcomtop
9240
9241 set id [$wrcomtop.sha1 get]
9242 set cmd "echo $id | [$wrcomtop.cmd get]"
9243 set fname [$wrcomtop.fname get]
9244 if {[catch {exec sh -c $cmd >$fname &} err]} {
84a76f18 9245 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
4a2139f5
PM
9246 }
9247 catch {destroy $wrcomtop}
9248 unset wrcomtop
9249}
9250
9251proc wrcomcan {} {
9252 global wrcomtop
9253
9254 catch {destroy $wrcomtop}
9255 unset wrcomtop
9256}
9257
d6ac1a86 9258proc mkbranch {} {
d93f1713 9259 global rowmenuid mkbrtop NS
d6ac1a86
PM
9260
9261 set top .makebranch
9262 catch {destroy $top}
d93f1713 9263 ttk_toplevel $top
e7d64008 9264 make_transient $top .
d93f1713 9265 ${NS}::label $top.title -text [mc "Create new branch"]
d6ac1a86 9266 grid $top.title - -pady 10
d93f1713
PT
9267 ${NS}::label $top.id -text [mc "ID:"]
9268 ${NS}::entry $top.sha1 -width 40
d6ac1a86
PM
9269 $top.sha1 insert 0 $rowmenuid
9270 $top.sha1 conf -state readonly
9271 grid $top.id $top.sha1 -sticky w
d93f1713
PT
9272 ${NS}::label $top.nlab -text [mc "Name:"]
9273 ${NS}::entry $top.name -width 40
d6ac1a86 9274 grid $top.nlab $top.name -sticky w
d93f1713
PT
9275 ${NS}::frame $top.buts
9276 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9277 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
76f15947
AG
9278 bind $top <Key-Return> [list mkbrgo $top]
9279 bind $top <Key-Escape> "catch {destroy $top}"
d6ac1a86
PM
9280 grid $top.buts.go $top.buts.can
9281 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9282 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9283 grid $top.buts - -pady 10 -sticky ew
9284 focus $top.name
9285}
9286
9287proc mkbrgo {top} {
9288 global headids idheads
9289
9290 set name [$top.name get]
9291 set id [$top.sha1 get]
bee866fa
AG
9292 set cmdargs {}
9293 set old_id {}
d6ac1a86 9294 if {$name eq {}} {
84a76f18 9295 error_popup [mc "Please specify a name for the new branch"] $top
d6ac1a86
PM
9296 return
9297 }
bee866fa
AG
9298 if {[info exists headids($name)]} {
9299 if {![confirm_popup [mc \
84a76f18 9300 "Branch '%s' already exists. Overwrite?" $name] $top]} {
bee866fa
AG
9301 return
9302 }
9303 set old_id $headids($name)
9304 lappend cmdargs -f
9305 }
d6ac1a86 9306 catch {destroy $top}
bee866fa 9307 lappend cmdargs $name $id
d6ac1a86
PM
9308 nowbusy newbranch
9309 update
9310 if {[catch {
bee866fa 9311 eval exec git branch $cmdargs
d6ac1a86
PM
9312 } err]} {
9313 notbusy newbranch
9314 error_popup $err
9315 } else {
d6ac1a86 9316 notbusy newbranch
bee866fa
AG
9317 if {$old_id ne {}} {
9318 movehead $id $name
9319 movedhead $id $name
9320 redrawtags $old_id
9321 redrawtags $id
9322 } else {
9323 set headids($name) $id
9324 lappend idheads($id) $name
9325 addedhead $id $name
9326 redrawtags $id
9327 }
e11f1233 9328 dispneartags 0
887c996e 9329 run refill_reflist
d6ac1a86
PM
9330 }
9331}
9332
15e35055
AG
9333proc exec_citool {tool_args {baseid {}}} {
9334 global commitinfo env
9335
9336 set save_env [array get env GIT_AUTHOR_*]
9337
9338 if {$baseid ne {}} {
9339 if {![info exists commitinfo($baseid)]} {
9340 getcommit $baseid
9341 }
9342 set author [lindex $commitinfo($baseid) 1]
9343 set date [lindex $commitinfo($baseid) 2]
9344 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9345 $author author name email]
9346 && $date ne {}} {
9347 set env(GIT_AUTHOR_NAME) $name
9348 set env(GIT_AUTHOR_EMAIL) $email
9349 set env(GIT_AUTHOR_DATE) $date
9350 }
9351 }
9352
9353 eval exec git citool $tool_args &
9354
9355 array unset env GIT_AUTHOR_*
9356 array set env $save_env
9357}
9358
ca6d8f58 9359proc cherrypick {} {
468bcaed 9360 global rowmenuid curview
b8a938cf 9361 global mainhead mainheadid
da616db5 9362 global gitdir
ca6d8f58 9363
e11f1233
PM
9364 set oldhead [exec git rev-parse HEAD]
9365 set dheads [descheads $rowmenuid]
9366 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
d990cedf
CS
9367 set ok [confirm_popup [mc "Commit %s is already\
9368 included in branch %s -- really re-apply it?" \
9369 [string range $rowmenuid 0 7] $mainhead]]
ca6d8f58
PM
9370 if {!$ok} return
9371 }
d990cedf 9372 nowbusy cherrypick [mc "Cherry-picking"]
ca6d8f58 9373 update
ca6d8f58
PM
9374 # Unfortunately git-cherry-pick writes stuff to stderr even when
9375 # no error occurs, and exec takes that as an indication of error...
9376 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9377 notbusy cherrypick
15e35055 9378 if {[regexp -line \
887a791f
PM
9379 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9380 $err msg fname]} {
9381 error_popup [mc "Cherry-pick failed because of local changes\
9382 to file '%s'.\nPlease commit, reset or stash\
9383 your changes and try again." $fname]
9384 } elseif {[regexp -line \
b74307f6 9385 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
887a791f
PM
9386 $err]} {
9387 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9388 conflict.\nDo you wish to run git citool to\
9389 resolve it?"]]} {
9390 # Force citool to read MERGE_MSG
da616db5 9391 file delete [file join $gitdir "GITGUI_MSG"]
887a791f
PM
9392 exec_citool {} $rowmenuid
9393 }
15e35055
AG
9394 } else {
9395 error_popup $err
9396 }
887a791f 9397 run updatecommits
ca6d8f58
PM
9398 return
9399 }
9400 set newhead [exec git rev-parse HEAD]
9401 if {$newhead eq $oldhead} {
9402 notbusy cherrypick
d990cedf 9403 error_popup [mc "No changes committed"]
ca6d8f58
PM
9404 return
9405 }
e11f1233 9406 addnewchild $newhead $oldhead
7fcc92bf 9407 if {[commitinview $oldhead $curview]} {
cdc8429c 9408 # XXX this isn't right if we have a path limit...
7fcc92bf 9409 insertrow $newhead $oldhead $curview
ca6d8f58 9410 if {$mainhead ne {}} {
e11f1233 9411 movehead $newhead $mainhead
ca6d8f58
PM
9412 movedhead $newhead $mainhead
9413 }
c11ff120 9414 set mainheadid $newhead
ca6d8f58
PM
9415 redrawtags $oldhead
9416 redrawtags $newhead
46308ea1 9417 selbyid $newhead
ca6d8f58
PM
9418 }
9419 notbusy cherrypick
9420}
9421
8f3ff933
KF
9422proc revert {} {
9423 global rowmenuid curview
9424 global mainhead mainheadid
9425 global gitdir
9426
9427 set oldhead [exec git rev-parse HEAD]
9428 set dheads [descheads $rowmenuid]
9429 if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9430 set ok [confirm_popup [mc "Commit %s is not\
9431 included in branch %s -- really revert it?" \
9432 [string range $rowmenuid 0 7] $mainhead]]
9433 if {!$ok} return
9434 }
9435 nowbusy revert [mc "Reverting"]
9436 update
9437
9438 if [catch {exec git revert --no-edit $rowmenuid} err] {
9439 notbusy revert
9440 if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9441 $err match files] {
9442 regsub {\n( |\t)+} $files "\n" files
9443 error_popup [mc "Revert failed because of local changes to\
9444 the following files:%s Please commit, reset or stash \
9445 your changes and try again." $files]
9446 } elseif [regexp {error: could not revert} $err] {
9447 if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9448 Do you wish to run git citool to resolve it?"]] {
9449 # Force citool to read MERGE_MSG
9450 file delete [file join $gitdir "GITGUI_MSG"]
9451 exec_citool {} $rowmenuid
9452 }
9453 } else { error_popup $err }
9454 run updatecommits
9455 return
9456 }
9457
9458 set newhead [exec git rev-parse HEAD]
9459 if { $newhead eq $oldhead } {
9460 notbusy revert
9461 error_popup [mc "No changes committed"]
9462 return
9463 }
9464
9465 addnewchild $newhead $oldhead
9466
9467 if [commitinview $oldhead $curview] {
9468 # XXX this isn't right if we have a path limit...
9469 insertrow $newhead $oldhead $curview
9470 if {$mainhead ne {}} {
9471 movehead $newhead $mainhead
9472 movedhead $newhead $mainhead
9473 }
9474 set mainheadid $newhead
9475 redrawtags $oldhead
9476 redrawtags $newhead
9477 selbyid $newhead
9478 }
9479
9480 notbusy revert
9481}
9482
6fb735ae 9483proc resethead {} {
d93f1713 9484 global mainhead rowmenuid confirm_ok resettype NS
6fb735ae
PM
9485
9486 set confirm_ok 0
9487 set w ".confirmreset"
d93f1713 9488 ttk_toplevel $w
e7d64008 9489 make_transient $w .
d990cedf 9490 wm title $w [mc "Confirm reset"]
d93f1713
PT
9491 ${NS}::label $w.m -text \
9492 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
6fb735ae 9493 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 9494 ${NS}::labelframe $w.f -text [mc "Reset type:"]
6fb735ae 9495 set resettype mixed
d93f1713 9496 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
d990cedf 9497 -text [mc "Soft: Leave working tree and index untouched"]
6fb735ae 9498 grid $w.f.soft -sticky w
d93f1713 9499 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
d990cedf 9500 -text [mc "Mixed: Leave working tree untouched, reset index"]
6fb735ae 9501 grid $w.f.mixed -sticky w
d93f1713 9502 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
d990cedf 9503 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6fb735ae 9504 grid $w.f.hard -sticky w
d93f1713
PT
9505 pack $w.f -side top -fill x -padx 4
9506 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6fb735ae 9507 pack $w.ok -side left -fill x -padx 20 -pady 20
d93f1713 9508 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
76f15947 9509 bind $w <Key-Escape> [list destroy $w]
6fb735ae
PM
9510 pack $w.cancel -side right -fill x -padx 20 -pady 20
9511 bind $w <Visibility> "grab $w; focus $w"
9512 tkwait window $w
9513 if {!$confirm_ok} return
706d6c3e 9514 if {[catch {set fd [open \
08ba820f 9515 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
6fb735ae
PM
9516 error_popup $err
9517 } else {
706d6c3e 9518 dohidelocalchanges
a137a90f 9519 filerun $fd [list readresetstat $fd]
d990cedf 9520 nowbusy reset [mc "Resetting"]
46308ea1 9521 selbyid $rowmenuid
706d6c3e
PM
9522 }
9523}
9524
a137a90f
PM
9525proc readresetstat {fd} {
9526 global mainhead mainheadid showlocalchanges rprogcoord
706d6c3e
PM
9527
9528 if {[gets $fd line] >= 0} {
9529 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
a137a90f
PM
9530 set rprogcoord [expr {1.0 * $m / $n}]
9531 adjustprogress
706d6c3e
PM
9532 }
9533 return 1
9534 }
a137a90f
PM
9535 set rprogcoord 0
9536 adjustprogress
706d6c3e
PM
9537 notbusy reset
9538 if {[catch {close $fd} err]} {
9539 error_popup $err
9540 }
9541 set oldhead $mainheadid
9542 set newhead [exec git rev-parse HEAD]
9543 if {$newhead ne $oldhead} {
9544 movehead $newhead $mainhead
9545 movedhead $newhead $mainhead
9546 set mainheadid $newhead
6fb735ae 9547 redrawtags $oldhead
706d6c3e 9548 redrawtags $newhead
6fb735ae
PM
9549 }
9550 if {$showlocalchanges} {
9551 doshowlocalchanges
9552 }
706d6c3e 9553 return 0
6fb735ae
PM
9554}
9555
10299152
PM
9556# context menu for a head
9557proc headmenu {x y id head} {
00609463 9558 global headmenuid headmenuhead headctxmenu mainhead
10299152 9559
bb3edc8b 9560 stopfinding
10299152
PM
9561 set headmenuid $id
9562 set headmenuhead $head
00609463 9563 set state normal
70a5fc44
SC
9564 if {[string match "remotes/*" $head]} {
9565 set state disabled
9566 }
00609463
PM
9567 if {$head eq $mainhead} {
9568 set state disabled
9569 }
9570 $headctxmenu entryconfigure 0 -state $state
9571 $headctxmenu entryconfigure 1 -state $state
10299152
PM
9572 tk_popup $headctxmenu $x $y
9573}
9574
9575proc cobranch {} {
c11ff120 9576 global headmenuid headmenuhead headids
cdc8429c 9577 global showlocalchanges
10299152
PM
9578
9579 # check the tree is clean first??
d990cedf 9580 nowbusy checkout [mc "Checking out"]
10299152 9581 update
219ea3a9 9582 dohidelocalchanges
10299152 9583 if {[catch {
08ba820f 9584 set fd [open [list | git checkout $headmenuhead 2>@1] r]
10299152
PM
9585 } err]} {
9586 notbusy checkout
9587 error_popup $err
08ba820f
PM
9588 if {$showlocalchanges} {
9589 dodiffindex
9590 }
10299152 9591 } else {
08ba820f
PM
9592 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9593 }
9594}
9595
9596proc readcheckoutstat {fd newhead newheadid} {
9597 global mainhead mainheadid headids showlocalchanges progresscoords
cdc8429c 9598 global viewmainheadid curview
08ba820f
PM
9599
9600 if {[gets $fd line] >= 0} {
9601 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9602 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9603 adjustprogress
10299152 9604 }
08ba820f
PM
9605 return 1
9606 }
9607 set progresscoords {0 0}
9608 adjustprogress
9609 notbusy checkout
9610 if {[catch {close $fd} err]} {
9611 error_popup $err
9612 }
c11ff120 9613 set oldmainid $mainheadid
08ba820f
PM
9614 set mainhead $newhead
9615 set mainheadid $newheadid
cdc8429c 9616 set viewmainheadid($curview) $newheadid
c11ff120 9617 redrawtags $oldmainid
08ba820f
PM
9618 redrawtags $newheadid
9619 selbyid $newheadid
6fb735ae
PM
9620 if {$showlocalchanges} {
9621 dodiffindex
10299152
PM
9622 }
9623}
9624
9625proc rmbranch {} {
e11f1233 9626 global headmenuid headmenuhead mainhead
b1054ac9 9627 global idheads
10299152
PM
9628
9629 set head $headmenuhead
9630 set id $headmenuid
00609463 9631 # this check shouldn't be needed any more...
10299152 9632 if {$head eq $mainhead} {
d990cedf 9633 error_popup [mc "Cannot delete the currently checked-out branch"]
10299152
PM
9634 return
9635 }
e11f1233 9636 set dheads [descheads $id]
d7b16113 9637 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
10299152 9638 # the stuff on this branch isn't on any other branch
d990cedf
CS
9639 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9640 branch.\nReally delete branch %s?" $head $head]]} return
10299152
PM
9641 }
9642 nowbusy rmbranch
9643 update
9644 if {[catch {exec git branch -D $head} err]} {
9645 notbusy rmbranch
9646 error_popup $err
9647 return
9648 }
e11f1233 9649 removehead $id $head
ca6d8f58 9650 removedhead $id $head
10299152
PM
9651 redrawtags $id
9652 notbusy rmbranch
e11f1233 9653 dispneartags 0
887c996e
PM
9654 run refill_reflist
9655}
9656
9657# Display a list of tags and heads
9658proc showrefs {} {
d93f1713 9659 global showrefstop bgcolor fgcolor selectbgcolor NS
9c311b32 9660 global bglist fglist reflistfilter reflist maincursor
887c996e
PM
9661
9662 set top .showrefs
9663 set showrefstop $top
9664 if {[winfo exists $top]} {
9665 raise $top
9666 refill_reflist
9667 return
9668 }
d93f1713 9669 ttk_toplevel $top
d990cedf 9670 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
e7d64008 9671 make_transient $top .
887c996e 9672 text $top.list -background $bgcolor -foreground $fgcolor \
9c311b32 9673 -selectbackground $selectbgcolor -font mainfont \
887c996e
PM
9674 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9675 -width 30 -height 20 -cursor $maincursor \
9676 -spacing1 1 -spacing3 1 -state disabled
9677 $top.list tag configure highlight -background $selectbgcolor
9678 lappend bglist $top.list
9679 lappend fglist $top.list
d93f1713
PT
9680 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9681 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
887c996e
PM
9682 grid $top.list $top.ysb -sticky nsew
9683 grid $top.xsb x -sticky ew
d93f1713
PT
9684 ${NS}::frame $top.f
9685 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9686 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
887c996e
PM
9687 set reflistfilter "*"
9688 trace add variable reflistfilter write reflistfilter_change
9689 pack $top.f.e -side right -fill x -expand 1
9690 pack $top.f.l -side left
9691 grid $top.f - -sticky ew -pady 2
d93f1713 9692 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
76f15947 9693 bind $top <Key-Escape> [list destroy $top]
887c996e
PM
9694 grid $top.close -
9695 grid columnconfigure $top 0 -weight 1
9696 grid rowconfigure $top 0 -weight 1
9697 bind $top.list <1> {break}
9698 bind $top.list <B1-Motion> {break}
9699 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9700 set reflist {}
9701 refill_reflist
9702}
9703
9704proc sel_reflist {w x y} {
9705 global showrefstop reflist headids tagids otherrefids
9706
9707 if {![winfo exists $showrefstop]} return
9708 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9709 set ref [lindex $reflist [expr {$l-1}]]
9710 set n [lindex $ref 0]
9711 switch -- [lindex $ref 1] {
9712 "H" {selbyid $headids($n)}
9713 "T" {selbyid $tagids($n)}
9714 "o" {selbyid $otherrefids($n)}
9715 }
9716 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9717}
9718
9719proc unsel_reflist {} {
9720 global showrefstop
9721
9722 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9723 $showrefstop.list tag remove highlight 0.0 end
9724}
9725
9726proc reflistfilter_change {n1 n2 op} {
9727 global reflistfilter
9728
9729 after cancel refill_reflist
9730 after 200 refill_reflist
9731}
9732
9733proc refill_reflist {} {
9734 global reflist reflistfilter showrefstop headids tagids otherrefids
d375ef9b 9735 global curview
887c996e
PM
9736
9737 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9738 set refs {}
9739 foreach n [array names headids] {
9740 if {[string match $reflistfilter $n]} {
7fcc92bf 9741 if {[commitinview $headids($n) $curview]} {
887c996e
PM
9742 lappend refs [list $n H]
9743 } else {
d375ef9b 9744 interestedin $headids($n) {run refill_reflist}
887c996e
PM
9745 }
9746 }
9747 }
9748 foreach n [array names tagids] {
9749 if {[string match $reflistfilter $n]} {
7fcc92bf 9750 if {[commitinview $tagids($n) $curview]} {
887c996e
PM
9751 lappend refs [list $n T]
9752 } else {
d375ef9b 9753 interestedin $tagids($n) {run refill_reflist}
887c996e
PM
9754 }
9755 }
9756 }
9757 foreach n [array names otherrefids] {
9758 if {[string match $reflistfilter $n]} {
7fcc92bf 9759 if {[commitinview $otherrefids($n) $curview]} {
887c996e
PM
9760 lappend refs [list $n o]
9761 } else {
d375ef9b 9762 interestedin $otherrefids($n) {run refill_reflist}
887c996e
PM
9763 }
9764 }
9765 }
9766 set refs [lsort -index 0 $refs]
9767 if {$refs eq $reflist} return
9768
9769 # Update the contents of $showrefstop.list according to the
9770 # differences between $reflist (old) and $refs (new)
9771 $showrefstop.list conf -state normal
9772 $showrefstop.list insert end "\n"
9773 set i 0
9774 set j 0
9775 while {$i < [llength $reflist] || $j < [llength $refs]} {
9776 if {$i < [llength $reflist]} {
9777 if {$j < [llength $refs]} {
9778 set cmp [string compare [lindex $reflist $i 0] \
9779 [lindex $refs $j 0]]
9780 if {$cmp == 0} {
9781 set cmp [string compare [lindex $reflist $i 1] \
9782 [lindex $refs $j 1]]
9783 }
9784 } else {
9785 set cmp -1
9786 }
9787 } else {
9788 set cmp 1
9789 }
9790 switch -- $cmp {
9791 -1 {
9792 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9793 incr i
9794 }
9795 0 {
9796 incr i
9797 incr j
9798 }
9799 1 {
9800 set l [expr {$j + 1}]
9801 $showrefstop.list image create $l.0 -align baseline \
9802 -image reficon-[lindex $refs $j 1] -padx 2
9803 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9804 incr j
9805 }
9806 }
9807 }
9808 set reflist $refs
9809 # delete last newline
9810 $showrefstop.list delete end-2c end-1c
9811 $showrefstop.list conf -state disabled
10299152
PM
9812}
9813
b8ab2e17
PM
9814# Stuff for finding nearby tags
9815proc getallcommits {} {
5cd15b6b
PM
9816 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9817 global idheads idtags idotherrefs allparents tagobjid
da616db5 9818 global gitdir
f1d83ba3 9819
a69b2d1a 9820 if {![info exists allcommits]} {
a69b2d1a
PM
9821 set nextarc 0
9822 set allcommits 0
9823 set seeds {}
5cd15b6b
PM
9824 set allcwait 0
9825 set cachedarcs 0
da616db5 9826 set allccache [file join $gitdir "gitk.cache"]
5cd15b6b
PM
9827 if {![catch {
9828 set f [open $allccache r]
9829 set allcwait 1
9830 getcache $f
9831 }]} return
a69b2d1a 9832 }
2d71bccc 9833
5cd15b6b
PM
9834 if {$allcwait} {
9835 return
9836 }
9837 set cmd [list | git rev-list --parents]
9838 set allcupdate [expr {$seeds ne {}}]
9839 if {!$allcupdate} {
9840 set ids "--all"
9841 } else {
9842 set refs [concat [array names idheads] [array names idtags] \
9843 [array names idotherrefs]]
9844 set ids {}
9845 set tagobjs {}
9846 foreach name [array names tagobjid] {
9847 lappend tagobjs $tagobjid($name)
9848 }
9849 foreach id [lsort -unique $refs] {
9850 if {![info exists allparents($id)] &&
9851 [lsearch -exact $tagobjs $id] < 0} {
9852 lappend ids $id
9853 }
9854 }
9855 if {$ids ne {}} {
9856 foreach id $seeds {
9857 lappend ids "^$id"
9858 }
9859 }
9860 }
9861 if {$ids ne {}} {
9862 set fd [open [concat $cmd $ids] r]
9863 fconfigure $fd -blocking 0
9864 incr allcommits
9865 nowbusy allcommits
9866 filerun $fd [list getallclines $fd]
9867 } else {
9868 dispneartags 0
2d71bccc 9869 }
e11f1233
PM
9870}
9871
9872# Since most commits have 1 parent and 1 child, we group strings of
9873# such commits into "arcs" joining branch/merge points (BMPs), which
9874# are commits that either don't have 1 parent or don't have 1 child.
9875#
9876# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9877# arcout(id) - outgoing arcs for BMP
9878# arcids(a) - list of IDs on arc including end but not start
9879# arcstart(a) - BMP ID at start of arc
9880# arcend(a) - BMP ID at end of arc
9881# growing(a) - arc a is still growing
9882# arctags(a) - IDs out of arcids (excluding end) that have tags
9883# archeads(a) - IDs out of arcids (excluding end) that have heads
9884# The start of an arc is at the descendent end, so "incoming" means
9885# coming from descendents, and "outgoing" means going towards ancestors.
9886
9887proc getallclines {fd} {
5cd15b6b 9888 global allparents allchildren idtags idheads nextarc
e11f1233 9889 global arcnos arcids arctags arcout arcend arcstart archeads growing
5cd15b6b 9890 global seeds allcommits cachedarcs allcupdate
d93f1713 9891
e11f1233 9892 set nid 0
7eb3cb9c 9893 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
e11f1233
PM
9894 set id [lindex $line 0]
9895 if {[info exists allparents($id)]} {
9896 # seen it already
9897 continue
9898 }
5cd15b6b 9899 set cachedarcs 0
e11f1233
PM
9900 set olds [lrange $line 1 end]
9901 set allparents($id) $olds
9902 if {![info exists allchildren($id)]} {
9903 set allchildren($id) {}
9904 set arcnos($id) {}
9905 lappend seeds $id
9906 } else {
9907 set a $arcnos($id)
9908 if {[llength $olds] == 1 && [llength $a] == 1} {
9909 lappend arcids($a) $id
9910 if {[info exists idtags($id)]} {
9911 lappend arctags($a) $id
b8ab2e17 9912 }
e11f1233
PM
9913 if {[info exists idheads($id)]} {
9914 lappend archeads($a) $id
9915 }
9916 if {[info exists allparents($olds)]} {
9917 # seen parent already
9918 if {![info exists arcout($olds)]} {
9919 splitarc $olds
9920 }
9921 lappend arcids($a) $olds
9922 set arcend($a) $olds
9923 unset growing($a)
9924 }
9925 lappend allchildren($olds) $id
9926 lappend arcnos($olds) $a
9927 continue
9928 }
9929 }
e11f1233
PM
9930 foreach a $arcnos($id) {
9931 lappend arcids($a) $id
9932 set arcend($a) $id
9933 unset growing($a)
9934 }
9935
9936 set ao {}
9937 foreach p $olds {
9938 lappend allchildren($p) $id
9939 set a [incr nextarc]
9940 set arcstart($a) $id
9941 set archeads($a) {}
9942 set arctags($a) {}
9943 set archeads($a) {}
9944 set arcids($a) {}
9945 lappend ao $a
9946 set growing($a) 1
9947 if {[info exists allparents($p)]} {
9948 # seen it already, may need to make a new branch
9949 if {![info exists arcout($p)]} {
9950 splitarc $p
9951 }
9952 lappend arcids($a) $p
9953 set arcend($a) $p
9954 unset growing($a)
9955 }
9956 lappend arcnos($p) $a
9957 }
9958 set arcout($id) $ao
f1d83ba3 9959 }
f3326b66
PM
9960 if {$nid > 0} {
9961 global cached_dheads cached_dtags cached_atags
9962 catch {unset cached_dheads}
9963 catch {unset cached_dtags}
9964 catch {unset cached_atags}
9965 }
7eb3cb9c
PM
9966 if {![eof $fd]} {
9967 return [expr {$nid >= 1000? 2: 1}]
9968 }
5cd15b6b
PM
9969 set cacheok 1
9970 if {[catch {
9971 fconfigure $fd -blocking 1
9972 close $fd
9973 } err]} {
9974 # got an error reading the list of commits
9975 # if we were updating, try rereading the whole thing again
9976 if {$allcupdate} {
9977 incr allcommits -1
9978 dropcache $err
9979 return
9980 }
d990cedf 9981 error_popup "[mc "Error reading commit topology information;\
5cd15b6b 9982 branch and preceding/following tag information\
d990cedf 9983 will be incomplete."]\n($err)"
5cd15b6b
PM
9984 set cacheok 0
9985 }
e11f1233
PM
9986 if {[incr allcommits -1] == 0} {
9987 notbusy allcommits
5cd15b6b
PM
9988 if {$cacheok} {
9989 run savecache
9990 }
e11f1233
PM
9991 }
9992 dispneartags 0
7eb3cb9c 9993 return 0
b8ab2e17
PM
9994}
9995
e11f1233
PM
9996proc recalcarc {a} {
9997 global arctags archeads arcids idtags idheads
b8ab2e17 9998
e11f1233
PM
9999 set at {}
10000 set ah {}
10001 foreach id [lrange $arcids($a) 0 end-1] {
10002 if {[info exists idtags($id)]} {
10003 lappend at $id
10004 }
10005 if {[info exists idheads($id)]} {
10006 lappend ah $id
b8ab2e17 10007 }
f1d83ba3 10008 }
e11f1233
PM
10009 set arctags($a) $at
10010 set archeads($a) $ah
b8ab2e17
PM
10011}
10012
e11f1233 10013proc splitarc {p} {
5cd15b6b 10014 global arcnos arcids nextarc arctags archeads idtags idheads
e11f1233 10015 global arcstart arcend arcout allparents growing
cec7bece 10016
e11f1233
PM
10017 set a $arcnos($p)
10018 if {[llength $a] != 1} {
10019 puts "oops splitarc called but [llength $a] arcs already"
10020 return
10021 }
10022 set a [lindex $a 0]
10023 set i [lsearch -exact $arcids($a) $p]
10024 if {$i < 0} {
10025 puts "oops splitarc $p not in arc $a"
10026 return
10027 }
10028 set na [incr nextarc]
10029 if {[info exists arcend($a)]} {
10030 set arcend($na) $arcend($a)
10031 } else {
10032 set l [lindex $allparents([lindex $arcids($a) end]) 0]
10033 set j [lsearch -exact $arcnos($l) $a]
10034 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10035 }
10036 set tail [lrange $arcids($a) [expr {$i+1}] end]
10037 set arcids($a) [lrange $arcids($a) 0 $i]
10038 set arcend($a) $p
10039 set arcstart($na) $p
10040 set arcout($p) $na
10041 set arcids($na) $tail
10042 if {[info exists growing($a)]} {
10043 set growing($na) 1
10044 unset growing($a)
10045 }
e11f1233
PM
10046
10047 foreach id $tail {
10048 if {[llength $arcnos($id)] == 1} {
10049 set arcnos($id) $na
cec7bece 10050 } else {
e11f1233
PM
10051 set j [lsearch -exact $arcnos($id) $a]
10052 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
cec7bece 10053 }
e11f1233
PM
10054 }
10055
10056 # reconstruct tags and heads lists
10057 if {$arctags($a) ne {} || $archeads($a) ne {}} {
10058 recalcarc $a
10059 recalcarc $na
10060 } else {
10061 set arctags($na) {}
10062 set archeads($na) {}
10063 }
10064}
10065
10066# Update things for a new commit added that is a child of one
10067# existing commit. Used when cherry-picking.
10068proc addnewchild {id p} {
5cd15b6b 10069 global allparents allchildren idtags nextarc
e11f1233 10070 global arcnos arcids arctags arcout arcend arcstart archeads growing
719c2b9d 10071 global seeds allcommits
e11f1233 10072
3ebba3c7 10073 if {![info exists allcommits] || ![info exists arcnos($p)]} return
e11f1233
PM
10074 set allparents($id) [list $p]
10075 set allchildren($id) {}
10076 set arcnos($id) {}
10077 lappend seeds $id
e11f1233
PM
10078 lappend allchildren($p) $id
10079 set a [incr nextarc]
10080 set arcstart($a) $id
10081 set archeads($a) {}
10082 set arctags($a) {}
10083 set arcids($a) [list $p]
10084 set arcend($a) $p
10085 if {![info exists arcout($p)]} {
10086 splitarc $p
10087 }
10088 lappend arcnos($p) $a
10089 set arcout($id) [list $a]
10090}
10091
5cd15b6b
PM
10092# This implements a cache for the topology information.
10093# The cache saves, for each arc, the start and end of the arc,
10094# the ids on the arc, and the outgoing arcs from the end.
10095proc readcache {f} {
10096 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10097 global idtags idheads allparents cachedarcs possible_seeds seeds growing
10098 global allcwait
10099
10100 set a $nextarc
10101 set lim $cachedarcs
10102 if {$lim - $a > 500} {
10103 set lim [expr {$a + 500}]
10104 }
10105 if {[catch {
10106 if {$a == $lim} {
10107 # finish reading the cache and setting up arctags, etc.
10108 set line [gets $f]
10109 if {$line ne "1"} {error "bad final version"}
10110 close $f
10111 foreach id [array names idtags] {
10112 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10113 [llength $allparents($id)] == 1} {
10114 set a [lindex $arcnos($id) 0]
10115 if {$arctags($a) eq {}} {
10116 recalcarc $a
10117 }
10118 }
10119 }
10120 foreach id [array names idheads] {
10121 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10122 [llength $allparents($id)] == 1} {
10123 set a [lindex $arcnos($id) 0]
10124 if {$archeads($a) eq {}} {
10125 recalcarc $a
10126 }
10127 }
10128 }
10129 foreach id [lsort -unique $possible_seeds] {
10130 if {$arcnos($id) eq {}} {
10131 lappend seeds $id
10132 }
10133 }
10134 set allcwait 0
10135 } else {
10136 while {[incr a] <= $lim} {
10137 set line [gets $f]
10138 if {[llength $line] != 3} {error "bad line"}
10139 set s [lindex $line 0]
10140 set arcstart($a) $s
10141 lappend arcout($s) $a
10142 if {![info exists arcnos($s)]} {
10143 lappend possible_seeds $s
10144 set arcnos($s) {}
10145 }
10146 set e [lindex $line 1]
10147 if {$e eq {}} {
10148 set growing($a) 1
10149 } else {
10150 set arcend($a) $e
10151 if {![info exists arcout($e)]} {
10152 set arcout($e) {}
10153 }
10154 }
10155 set arcids($a) [lindex $line 2]
10156 foreach id $arcids($a) {
10157 lappend allparents($s) $id
10158 set s $id
10159 lappend arcnos($id) $a
10160 }
10161 if {![info exists allparents($s)]} {
10162 set allparents($s) {}
10163 }
10164 set arctags($a) {}
10165 set archeads($a) {}
10166 }
10167 set nextarc [expr {$a - 1}]
10168 }
10169 } err]} {
10170 dropcache $err
10171 return 0
10172 }
10173 if {!$allcwait} {
10174 getallcommits
10175 }
10176 return $allcwait
10177}
10178
10179proc getcache {f} {
10180 global nextarc cachedarcs possible_seeds
10181
10182 if {[catch {
10183 set line [gets $f]
10184 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10185 # make sure it's an integer
10186 set cachedarcs [expr {int([lindex $line 1])}]
10187 if {$cachedarcs < 0} {error "bad number of arcs"}
10188 set nextarc 0
10189 set possible_seeds {}
10190 run readcache $f
10191 } err]} {
10192 dropcache $err
10193 }
10194 return 0
10195}
10196
10197proc dropcache {err} {
10198 global allcwait nextarc cachedarcs seeds
10199
10200 #puts "dropping cache ($err)"
10201 foreach v {arcnos arcout arcids arcstart arcend growing \
10202 arctags archeads allparents allchildren} {
10203 global $v
10204 catch {unset $v}
10205 }
10206 set allcwait 0
10207 set nextarc 0
10208 set cachedarcs 0
10209 set seeds {}
10210 getallcommits
10211}
10212
10213proc writecache {f} {
10214 global cachearc cachedarcs allccache
10215 global arcstart arcend arcnos arcids arcout
10216
10217 set a $cachearc
10218 set lim $cachedarcs
10219 if {$lim - $a > 1000} {
10220 set lim [expr {$a + 1000}]
10221 }
10222 if {[catch {
10223 while {[incr a] <= $lim} {
10224 if {[info exists arcend($a)]} {
10225 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10226 } else {
10227 puts $f [list $arcstart($a) {} $arcids($a)]
10228 }
10229 }
10230 } err]} {
10231 catch {close $f}
10232 catch {file delete $allccache}
10233 #puts "writing cache failed ($err)"
10234 return 0
10235 }
10236 set cachearc [expr {$a - 1}]
10237 if {$a > $cachedarcs} {
10238 puts $f "1"
10239 close $f
10240 return 0
10241 }
10242 return 1
10243}
10244
10245proc savecache {} {
10246 global nextarc cachedarcs cachearc allccache
10247
10248 if {$nextarc == $cachedarcs} return
10249 set cachearc 0
10250 set cachedarcs $nextarc
10251 catch {
10252 set f [open $allccache w]
10253 puts $f [list 1 $cachedarcs]
10254 run writecache $f
10255 }
10256}
10257
e11f1233
PM
10258# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10259# or 0 if neither is true.
10260proc anc_or_desc {a b} {
10261 global arcout arcstart arcend arcnos cached_isanc
10262
10263 if {$arcnos($a) eq $arcnos($b)} {
10264 # Both are on the same arc(s); either both are the same BMP,
10265 # or if one is not a BMP, the other is also not a BMP or is
10266 # the BMP at end of the arc (and it only has 1 incoming arc).
69c0b5d2
PM
10267 # Or both can be BMPs with no incoming arcs.
10268 if {$a eq $b || $arcnos($a) eq {}} {
e11f1233 10269 return 0
cec7bece 10270 }
e11f1233
PM
10271 # assert {[llength $arcnos($a)] == 1}
10272 set arc [lindex $arcnos($a) 0]
10273 set i [lsearch -exact $arcids($arc) $a]
10274 set j [lsearch -exact $arcids($arc) $b]
10275 if {$i < 0 || $i > $j} {
10276 return 1
10277 } else {
10278 return -1
cec7bece
PM
10279 }
10280 }
e11f1233
PM
10281
10282 if {![info exists arcout($a)]} {
10283 set arc [lindex $arcnos($a) 0]
10284 if {[info exists arcend($arc)]} {
10285 set aend $arcend($arc)
10286 } else {
10287 set aend {}
cec7bece 10288 }
e11f1233
PM
10289 set a $arcstart($arc)
10290 } else {
10291 set aend $a
10292 }
10293 if {![info exists arcout($b)]} {
10294 set arc [lindex $arcnos($b) 0]
10295 if {[info exists arcend($arc)]} {
10296 set bend $arcend($arc)
10297 } else {
10298 set bend {}
cec7bece 10299 }
e11f1233
PM
10300 set b $arcstart($arc)
10301 } else {
10302 set bend $b
cec7bece 10303 }
e11f1233
PM
10304 if {$a eq $bend} {
10305 return 1
10306 }
10307 if {$b eq $aend} {
10308 return -1
10309 }
10310 if {[info exists cached_isanc($a,$bend)]} {
10311 if {$cached_isanc($a,$bend)} {
10312 return 1
10313 }
10314 }
10315 if {[info exists cached_isanc($b,$aend)]} {
10316 if {$cached_isanc($b,$aend)} {
10317 return -1
10318 }
10319 if {[info exists cached_isanc($a,$bend)]} {
10320 return 0
10321 }
cec7bece 10322 }
cec7bece 10323
e11f1233
PM
10324 set todo [list $a $b]
10325 set anc($a) a
10326 set anc($b) b
10327 for {set i 0} {$i < [llength $todo]} {incr i} {
10328 set x [lindex $todo $i]
10329 if {$anc($x) eq {}} {
10330 continue
10331 }
10332 foreach arc $arcnos($x) {
10333 set xd $arcstart($arc)
10334 if {$xd eq $bend} {
10335 set cached_isanc($a,$bend) 1
10336 set cached_isanc($b,$aend) 0
10337 return 1
10338 } elseif {$xd eq $aend} {
10339 set cached_isanc($b,$aend) 1
10340 set cached_isanc($a,$bend) 0
10341 return -1
10342 }
10343 if {![info exists anc($xd)]} {
10344 set anc($xd) $anc($x)
10345 lappend todo $xd
10346 } elseif {$anc($xd) ne $anc($x)} {
10347 set anc($xd) {}
10348 }
10349 }
10350 }
10351 set cached_isanc($a,$bend) 0
10352 set cached_isanc($b,$aend) 0
10353 return 0
10354}
b8ab2e17 10355
e11f1233
PM
10356# This identifies whether $desc has an ancestor that is
10357# a growing tip of the graph and which is not an ancestor of $anc
10358# and returns 0 if so and 1 if not.
10359# If we subsequently discover a tag on such a growing tip, and that
10360# turns out to be a descendent of $anc (which it could, since we
10361# don't necessarily see children before parents), then $desc
10362# isn't a good choice to display as a descendent tag of
10363# $anc (since it is the descendent of another tag which is
10364# a descendent of $anc). Similarly, $anc isn't a good choice to
10365# display as a ancestor tag of $desc.
10366#
10367proc is_certain {desc anc} {
10368 global arcnos arcout arcstart arcend growing problems
10369
10370 set certain {}
10371 if {[llength $arcnos($anc)] == 1} {
10372 # tags on the same arc are certain
10373 if {$arcnos($desc) eq $arcnos($anc)} {
10374 return 1
b8ab2e17 10375 }
e11f1233
PM
10376 if {![info exists arcout($anc)]} {
10377 # if $anc is partway along an arc, use the start of the arc instead
10378 set a [lindex $arcnos($anc) 0]
10379 set anc $arcstart($a)
b8ab2e17 10380 }
e11f1233
PM
10381 }
10382 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10383 set x $desc
10384 } else {
10385 set a [lindex $arcnos($desc) 0]
10386 set x $arcend($a)
10387 }
10388 if {$x == $anc} {
10389 return 1
10390 }
10391 set anclist [list $x]
10392 set dl($x) 1
10393 set nnh 1
10394 set ngrowanc 0
10395 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10396 set x [lindex $anclist $i]
10397 if {$dl($x)} {
10398 incr nnh -1
10399 }
10400 set done($x) 1
10401 foreach a $arcout($x) {
10402 if {[info exists growing($a)]} {
10403 if {![info exists growanc($x)] && $dl($x)} {
10404 set growanc($x) 1
10405 incr ngrowanc
10406 }
10407 } else {
10408 set y $arcend($a)
10409 if {[info exists dl($y)]} {
10410 if {$dl($y)} {
10411 if {!$dl($x)} {
10412 set dl($y) 0
10413 if {![info exists done($y)]} {
10414 incr nnh -1
10415 }
10416 if {[info exists growanc($x)]} {
10417 incr ngrowanc -1
10418 }
10419 set xl [list $y]
10420 for {set k 0} {$k < [llength $xl]} {incr k} {
10421 set z [lindex $xl $k]
10422 foreach c $arcout($z) {
10423 if {[info exists arcend($c)]} {
10424 set v $arcend($c)
10425 if {[info exists dl($v)] && $dl($v)} {
10426 set dl($v) 0
10427 if {![info exists done($v)]} {
10428 incr nnh -1
10429 }
10430 if {[info exists growanc($v)]} {
10431 incr ngrowanc -1
10432 }
10433 lappend xl $v
10434 }
10435 }
10436 }
10437 }
10438 }
10439 }
10440 } elseif {$y eq $anc || !$dl($x)} {
10441 set dl($y) 0
10442 lappend anclist $y
10443 } else {
10444 set dl($y) 1
10445 lappend anclist $y
10446 incr nnh
10447 }
10448 }
b8ab2e17
PM
10449 }
10450 }
e11f1233
PM
10451 foreach x [array names growanc] {
10452 if {$dl($x)} {
10453 return 0
b8ab2e17 10454 }
7eb3cb9c 10455 return 0
b8ab2e17 10456 }
e11f1233 10457 return 1
b8ab2e17
PM
10458}
10459
e11f1233
PM
10460proc validate_arctags {a} {
10461 global arctags idtags
b8ab2e17 10462
e11f1233
PM
10463 set i -1
10464 set na $arctags($a)
10465 foreach id $arctags($a) {
10466 incr i
10467 if {![info exists idtags($id)]} {
10468 set na [lreplace $na $i $i]
10469 incr i -1
10470 }
10471 }
10472 set arctags($a) $na
10473}
10474
10475proc validate_archeads {a} {
10476 global archeads idheads
10477
10478 set i -1
10479 set na $archeads($a)
10480 foreach id $archeads($a) {
10481 incr i
10482 if {![info exists idheads($id)]} {
10483 set na [lreplace $na $i $i]
10484 incr i -1
10485 }
10486 }
10487 set archeads($a) $na
10488}
10489
10490# Return the list of IDs that have tags that are descendents of id,
10491# ignoring IDs that are descendents of IDs already reported.
10492proc desctags {id} {
10493 global arcnos arcstart arcids arctags idtags allparents
10494 global growing cached_dtags
10495
10496 if {![info exists allparents($id)]} {
10497 return {}
10498 }
10499 set t1 [clock clicks -milliseconds]
10500 set argid $id
10501 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10502 # part-way along an arc; check that arc first
10503 set a [lindex $arcnos($id) 0]
10504 if {$arctags($a) ne {}} {
10505 validate_arctags $a
10506 set i [lsearch -exact $arcids($a) $id]
10507 set tid {}
10508 foreach t $arctags($a) {
10509 set j [lsearch -exact $arcids($a) $t]
10510 if {$j >= $i} break
10511 set tid $t
b8ab2e17 10512 }
e11f1233
PM
10513 if {$tid ne {}} {
10514 return $tid
b8ab2e17
PM
10515 }
10516 }
e11f1233
PM
10517 set id $arcstart($a)
10518 if {[info exists idtags($id)]} {
10519 return $id
10520 }
10521 }
10522 if {[info exists cached_dtags($id)]} {
10523 return $cached_dtags($id)
10524 }
10525
10526 set origid $id
10527 set todo [list $id]
10528 set queued($id) 1
10529 set nc 1
10530 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10531 set id [lindex $todo $i]
10532 set done($id) 1
10533 set ta [info exists hastaggedancestor($id)]
10534 if {!$ta} {
10535 incr nc -1
10536 }
10537 # ignore tags on starting node
10538 if {!$ta && $i > 0} {
10539 if {[info exists idtags($id)]} {
10540 set tagloc($id) $id
10541 set ta 1
10542 } elseif {[info exists cached_dtags($id)]} {
10543 set tagloc($id) $cached_dtags($id)
10544 set ta 1
10545 }
10546 }
10547 foreach a $arcnos($id) {
10548 set d $arcstart($a)
10549 if {!$ta && $arctags($a) ne {}} {
10550 validate_arctags $a
10551 if {$arctags($a) ne {}} {
10552 lappend tagloc($id) [lindex $arctags($a) end]
10553 }
10554 }
10555 if {$ta || $arctags($a) ne {}} {
10556 set tomark [list $d]
10557 for {set j 0} {$j < [llength $tomark]} {incr j} {
10558 set dd [lindex $tomark $j]
10559 if {![info exists hastaggedancestor($dd)]} {
10560 if {[info exists done($dd)]} {
10561 foreach b $arcnos($dd) {
10562 lappend tomark $arcstart($b)
10563 }
10564 if {[info exists tagloc($dd)]} {
10565 unset tagloc($dd)
10566 }
10567 } elseif {[info exists queued($dd)]} {
10568 incr nc -1
10569 }
10570 set hastaggedancestor($dd) 1
10571 }
10572 }
10573 }
10574 if {![info exists queued($d)]} {
10575 lappend todo $d
10576 set queued($d) 1
10577 if {![info exists hastaggedancestor($d)]} {
10578 incr nc
10579 }
10580 }
b8ab2e17 10581 }
f1d83ba3 10582 }
e11f1233
PM
10583 set tags {}
10584 foreach id [array names tagloc] {
10585 if {![info exists hastaggedancestor($id)]} {
10586 foreach t $tagloc($id) {
10587 if {[lsearch -exact $tags $t] < 0} {
10588 lappend tags $t
10589 }
10590 }
10591 }
10592 }
10593 set t2 [clock clicks -milliseconds]
10594 set loopix $i
f1d83ba3 10595
e11f1233
PM
10596 # remove tags that are descendents of other tags
10597 for {set i 0} {$i < [llength $tags]} {incr i} {
10598 set a [lindex $tags $i]
10599 for {set j 0} {$j < $i} {incr j} {
10600 set b [lindex $tags $j]
10601 set r [anc_or_desc $a $b]
10602 if {$r == 1} {
10603 set tags [lreplace $tags $j $j]
10604 incr j -1
10605 incr i -1
10606 } elseif {$r == -1} {
10607 set tags [lreplace $tags $i $i]
10608 incr i -1
10609 break
ceadfe90
PM
10610 }
10611 }
10612 }
10613
e11f1233
PM
10614 if {[array names growing] ne {}} {
10615 # graph isn't finished, need to check if any tag could get
10616 # eclipsed by another tag coming later. Simply ignore any
10617 # tags that could later get eclipsed.
10618 set ctags {}
10619 foreach t $tags {
10620 if {[is_certain $t $origid]} {
10621 lappend ctags $t
10622 }
ceadfe90 10623 }
e11f1233
PM
10624 if {$tags eq $ctags} {
10625 set cached_dtags($origid) $tags
10626 } else {
10627 set tags $ctags
ceadfe90 10628 }
e11f1233
PM
10629 } else {
10630 set cached_dtags($origid) $tags
10631 }
10632 set t3 [clock clicks -milliseconds]
10633 if {0 && $t3 - $t1 >= 100} {
10634 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10635 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
ceadfe90 10636 }
e11f1233
PM
10637 return $tags
10638}
ceadfe90 10639
e11f1233
PM
10640proc anctags {id} {
10641 global arcnos arcids arcout arcend arctags idtags allparents
10642 global growing cached_atags
10643
10644 if {![info exists allparents($id)]} {
10645 return {}
10646 }
10647 set t1 [clock clicks -milliseconds]
10648 set argid $id
10649 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10650 # part-way along an arc; check that arc first
10651 set a [lindex $arcnos($id) 0]
10652 if {$arctags($a) ne {}} {
10653 validate_arctags $a
10654 set i [lsearch -exact $arcids($a) $id]
10655 foreach t $arctags($a) {
10656 set j [lsearch -exact $arcids($a) $t]
10657 if {$j > $i} {
10658 return $t
10659 }
10660 }
ceadfe90 10661 }
e11f1233
PM
10662 if {![info exists arcend($a)]} {
10663 return {}
10664 }
10665 set id $arcend($a)
10666 if {[info exists idtags($id)]} {
10667 return $id
10668 }
10669 }
10670 if {[info exists cached_atags($id)]} {
10671 return $cached_atags($id)
10672 }
10673
10674 set origid $id
10675 set todo [list $id]
10676 set queued($id) 1
10677 set taglist {}
10678 set nc 1
10679 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10680 set id [lindex $todo $i]
10681 set done($id) 1
10682 set td [info exists hastaggeddescendent($id)]
10683 if {!$td} {
10684 incr nc -1
10685 }
10686 # ignore tags on starting node
10687 if {!$td && $i > 0} {
10688 if {[info exists idtags($id)]} {
10689 set tagloc($id) $id
10690 set td 1
10691 } elseif {[info exists cached_atags($id)]} {
10692 set tagloc($id) $cached_atags($id)
10693 set td 1
10694 }
10695 }
10696 foreach a $arcout($id) {
10697 if {!$td && $arctags($a) ne {}} {
10698 validate_arctags $a
10699 if {$arctags($a) ne {}} {
10700 lappend tagloc($id) [lindex $arctags($a) 0]
10701 }
10702 }
10703 if {![info exists arcend($a)]} continue
10704 set d $arcend($a)
10705 if {$td || $arctags($a) ne {}} {
10706 set tomark [list $d]
10707 for {set j 0} {$j < [llength $tomark]} {incr j} {
10708 set dd [lindex $tomark $j]
10709 if {![info exists hastaggeddescendent($dd)]} {
10710 if {[info exists done($dd)]} {
10711 foreach b $arcout($dd) {
10712 if {[info exists arcend($b)]} {
10713 lappend tomark $arcend($b)
10714 }
10715 }
10716 if {[info exists tagloc($dd)]} {
10717 unset tagloc($dd)
10718 }
10719 } elseif {[info exists queued($dd)]} {
10720 incr nc -1
10721 }
10722 set hastaggeddescendent($dd) 1
10723 }
10724 }
10725 }
10726 if {![info exists queued($d)]} {
10727 lappend todo $d
10728 set queued($d) 1
10729 if {![info exists hastaggeddescendent($d)]} {
10730 incr nc
10731 }
10732 }
10733 }
10734 }
10735 set t2 [clock clicks -milliseconds]
10736 set loopix $i
10737 set tags {}
10738 foreach id [array names tagloc] {
10739 if {![info exists hastaggeddescendent($id)]} {
10740 foreach t $tagloc($id) {
10741 if {[lsearch -exact $tags $t] < 0} {
10742 lappend tags $t
10743 }
10744 }
ceadfe90
PM
10745 }
10746 }
ceadfe90 10747
e11f1233
PM
10748 # remove tags that are ancestors of other tags
10749 for {set i 0} {$i < [llength $tags]} {incr i} {
10750 set a [lindex $tags $i]
10751 for {set j 0} {$j < $i} {incr j} {
10752 set b [lindex $tags $j]
10753 set r [anc_or_desc $a $b]
10754 if {$r == -1} {
10755 set tags [lreplace $tags $j $j]
10756 incr j -1
10757 incr i -1
10758 } elseif {$r == 1} {
10759 set tags [lreplace $tags $i $i]
10760 incr i -1
10761 break
10762 }
10763 }
10764 }
10765
10766 if {[array names growing] ne {}} {
10767 # graph isn't finished, need to check if any tag could get
10768 # eclipsed by another tag coming later. Simply ignore any
10769 # tags that could later get eclipsed.
10770 set ctags {}
10771 foreach t $tags {
10772 if {[is_certain $origid $t]} {
10773 lappend ctags $t
10774 }
10775 }
10776 if {$tags eq $ctags} {
10777 set cached_atags($origid) $tags
10778 } else {
10779 set tags $ctags
d6ac1a86 10780 }
e11f1233
PM
10781 } else {
10782 set cached_atags($origid) $tags
10783 }
10784 set t3 [clock clicks -milliseconds]
10785 if {0 && $t3 - $t1 >= 100} {
10786 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10787 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
d6ac1a86 10788 }
e11f1233 10789 return $tags
d6ac1a86
PM
10790}
10791
e11f1233
PM
10792# Return the list of IDs that have heads that are descendents of id,
10793# including id itself if it has a head.
10794proc descheads {id} {
10795 global arcnos arcstart arcids archeads idheads cached_dheads
d809fb17 10796 global allparents arcout
ca6d8f58 10797
e11f1233
PM
10798 if {![info exists allparents($id)]} {
10799 return {}
10800 }
f3326b66 10801 set aret {}
d809fb17 10802 if {![info exists arcout($id)]} {
e11f1233
PM
10803 # part-way along an arc; check it first
10804 set a [lindex $arcnos($id) 0]
10805 if {$archeads($a) ne {}} {
10806 validate_archeads $a
10807 set i [lsearch -exact $arcids($a) $id]
10808 foreach t $archeads($a) {
10809 set j [lsearch -exact $arcids($a) $t]
10810 if {$j > $i} break
f3326b66 10811 lappend aret $t
e11f1233 10812 }
ca6d8f58 10813 }
e11f1233 10814 set id $arcstart($a)
ca6d8f58 10815 }
e11f1233
PM
10816 set origid $id
10817 set todo [list $id]
10818 set seen($id) 1
f3326b66 10819 set ret {}
e11f1233
PM
10820 for {set i 0} {$i < [llength $todo]} {incr i} {
10821 set id [lindex $todo $i]
10822 if {[info exists cached_dheads($id)]} {
10823 set ret [concat $ret $cached_dheads($id)]
10824 } else {
10825 if {[info exists idheads($id)]} {
10826 lappend ret $id
10827 }
10828 foreach a $arcnos($id) {
10829 if {$archeads($a) ne {}} {
706d6c3e
PM
10830 validate_archeads $a
10831 if {$archeads($a) ne {}} {
10832 set ret [concat $ret $archeads($a)]
10833 }
e11f1233
PM
10834 }
10835 set d $arcstart($a)
10836 if {![info exists seen($d)]} {
10837 lappend todo $d
10838 set seen($d) 1
10839 }
10840 }
10299152 10841 }
10299152 10842 }
e11f1233
PM
10843 set ret [lsort -unique $ret]
10844 set cached_dheads($origid) $ret
f3326b66 10845 return [concat $ret $aret]
10299152
PM
10846}
10847
e11f1233
PM
10848proc addedtag {id} {
10849 global arcnos arcout cached_dtags cached_atags
ca6d8f58 10850
e11f1233
PM
10851 if {![info exists arcnos($id)]} return
10852 if {![info exists arcout($id)]} {
10853 recalcarc [lindex $arcnos($id) 0]
ca6d8f58 10854 }
e11f1233
PM
10855 catch {unset cached_dtags}
10856 catch {unset cached_atags}
ca6d8f58
PM
10857}
10858
e11f1233
PM
10859proc addedhead {hid head} {
10860 global arcnos arcout cached_dheads
10861
10862 if {![info exists arcnos($hid)]} return
10863 if {![info exists arcout($hid)]} {
10864 recalcarc [lindex $arcnos($hid) 0]
10865 }
10866 catch {unset cached_dheads}
10867}
10868
10869proc removedhead {hid head} {
10870 global cached_dheads
10871
10872 catch {unset cached_dheads}
10873}
10874
10875proc movedhead {hid head} {
10876 global arcnos arcout cached_dheads
cec7bece 10877
e11f1233
PM
10878 if {![info exists arcnos($hid)]} return
10879 if {![info exists arcout($hid)]} {
10880 recalcarc [lindex $arcnos($hid) 0]
cec7bece 10881 }
e11f1233
PM
10882 catch {unset cached_dheads}
10883}
10884
10885proc changedrefs {} {
587277fe 10886 global cached_dheads cached_dtags cached_atags cached_tagcontent
e11f1233
PM
10887 global arctags archeads arcnos arcout idheads idtags
10888
10889 foreach id [concat [array names idheads] [array names idtags]] {
10890 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10891 set a [lindex $arcnos($id) 0]
10892 if {![info exists donearc($a)]} {
10893 recalcarc $a
10894 set donearc($a) 1
10895 }
cec7bece
PM
10896 }
10897 }
587277fe 10898 catch {unset cached_tagcontent}
e11f1233
PM
10899 catch {unset cached_dtags}
10900 catch {unset cached_atags}
10901 catch {unset cached_dheads}
cec7bece
PM
10902}
10903
f1d83ba3 10904proc rereadrefs {} {
fc2a256f 10905 global idtags idheads idotherrefs mainheadid
f1d83ba3
PM
10906
10907 set refids [concat [array names idtags] \
10908 [array names idheads] [array names idotherrefs]]
10909 foreach id $refids {
10910 if {![info exists ref($id)]} {
10911 set ref($id) [listrefs $id]
10912 }
10913 }
fc2a256f 10914 set oldmainhead $mainheadid
f1d83ba3 10915 readrefs
cec7bece 10916 changedrefs
f1d83ba3
PM
10917 set refids [lsort -unique [concat $refids [array names idtags] \
10918 [array names idheads] [array names idotherrefs]]]
10919 foreach id $refids {
10920 set v [listrefs $id]
c11ff120 10921 if {![info exists ref($id)] || $ref($id) != $v} {
f1d83ba3
PM
10922 redrawtags $id
10923 }
10924 }
c11ff120
PM
10925 if {$oldmainhead ne $mainheadid} {
10926 redrawtags $oldmainhead
10927 redrawtags $mainheadid
10928 }
887c996e 10929 run refill_reflist
f1d83ba3
PM
10930}
10931
2e1ded44
JH
10932proc listrefs {id} {
10933 global idtags idheads idotherrefs
10934
10935 set x {}
10936 if {[info exists idtags($id)]} {
10937 set x $idtags($id)
10938 }
10939 set y {}
10940 if {[info exists idheads($id)]} {
10941 set y $idheads($id)
10942 }
10943 set z {}
10944 if {[info exists idotherrefs($id)]} {
10945 set z $idotherrefs($id)
10946 }
10947 return [list $x $y $z]
10948}
10949
4399fe33
PM
10950proc add_tag_ctext {tag} {
10951 global ctext cached_tagcontent tagids
10952
10953 if {![info exists cached_tagcontent($tag)]} {
10954 catch {
10955 set cached_tagcontent($tag) [exec git cat-file -p $tag]
10956 }
10957 }
10958 $ctext insert end "[mc "Tag"]: $tag\n" bold
10959 if {[info exists cached_tagcontent($tag)]} {
10960 set text $cached_tagcontent($tag)
10961 } else {
10962 set text "[mc "Id"]: $tagids($tag)"
10963 }
10964 appendwithlinks $text {}
10965}
10966
106288cb 10967proc showtag {tag isnew} {
587277fe 10968 global ctext cached_tagcontent tagids linknum tagobjid
106288cb
PM
10969
10970 if {$isnew} {
354af6bd 10971 addtohistory [list showtag $tag 0] savectextpos
106288cb
PM
10972 }
10973 $ctext conf -state normal
3ea06f9f 10974 clear_ctext
32f1b3e4 10975 settabs 0
106288cb 10976 set linknum 0
4399fe33
PM
10977 add_tag_ctext $tag
10978 maybe_scroll_ctext 1
10979 $ctext conf -state disabled
10980 init_flist {}
10981}
10982
10983proc showtags {id isnew} {
10984 global idtags ctext linknum
10985
10986 if {$isnew} {
10987 addtohistory [list showtags $id 0] savectextpos
62d3ea65 10988 }
4399fe33
PM
10989 $ctext conf -state normal
10990 clear_ctext
10991 settabs 0
10992 set linknum 0
10993 set sep {}
10994 foreach tag $idtags($id) {
10995 $ctext insert end $sep
10996 add_tag_ctext $tag
10997 set sep "\n\n"
106288cb 10998 }
a80e82f6 10999 maybe_scroll_ctext 1
106288cb 11000 $ctext conf -state disabled
7fcceed7 11001 init_flist {}
106288cb
PM
11002}
11003
1d10f36d
PM
11004proc doquit {} {
11005 global stopped
314f5de1
TA
11006 global gitktmpdir
11007
1d10f36d 11008 set stopped 100
b6047c5a 11009 savestuff .
1d10f36d 11010 destroy .
314f5de1
TA
11011
11012 if {[info exists gitktmpdir]} {
11013 catch {file delete -force $gitktmpdir}
11014 }
1d10f36d 11015}
1db95b00 11016
9a7558f3 11017proc mkfontdisp {font top which} {
d93f1713 11018 global fontattr fontpref $font NS use_ttk
9a7558f3
PM
11019
11020 set fontpref($font) [set $font]
d93f1713 11021 ${NS}::button $top.${font}but -text $which \
9a7558f3 11022 -command [list choosefont $font $which]
d93f1713 11023 ${NS}::label $top.$font -relief flat -font $font \
9a7558f3
PM
11024 -text $fontattr($font,family) -justify left
11025 grid x $top.${font}but $top.$font -sticky w
11026}
11027
11028proc choosefont {font which} {
11029 global fontparam fontlist fonttop fontattr
d93f1713 11030 global prefstop NS
9a7558f3
PM
11031
11032 set fontparam(which) $which
11033 set fontparam(font) $font
11034 set fontparam(family) [font actual $font -family]
11035 set fontparam(size) $fontattr($font,size)
11036 set fontparam(weight) $fontattr($font,weight)
11037 set fontparam(slant) $fontattr($font,slant)
11038 set top .gitkfont
11039 set fonttop $top
11040 if {![winfo exists $top]} {
11041 font create sample
11042 eval font config sample [font actual $font]
d93f1713 11043 ttk_toplevel $top
e7d64008 11044 make_transient $top $prefstop
d990cedf 11045 wm title $top [mc "Gitk font chooser"]
d93f1713 11046 ${NS}::label $top.l -textvariable fontparam(which)
9a7558f3
PM
11047 pack $top.l -side top
11048 set fontlist [lsort [font families]]
d93f1713 11049 ${NS}::frame $top.f
9a7558f3
PM
11050 listbox $top.f.fam -listvariable fontlist \
11051 -yscrollcommand [list $top.f.sb set]
11052 bind $top.f.fam <<ListboxSelect>> selfontfam
d93f1713 11053 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
9a7558f3
PM
11054 pack $top.f.sb -side right -fill y
11055 pack $top.f.fam -side left -fill both -expand 1
11056 pack $top.f -side top -fill both -expand 1
d93f1713 11057 ${NS}::frame $top.g
9a7558f3
PM
11058 spinbox $top.g.size -from 4 -to 40 -width 4 \
11059 -textvariable fontparam(size) \
11060 -validatecommand {string is integer -strict %s}
11061 checkbutton $top.g.bold -padx 5 \
d990cedf 11062 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9a7558f3
PM
11063 -variable fontparam(weight) -onvalue bold -offvalue normal
11064 checkbutton $top.g.ital -padx 5 \
d990cedf 11065 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9a7558f3
PM
11066 -variable fontparam(slant) -onvalue italic -offvalue roman
11067 pack $top.g.size $top.g.bold $top.g.ital -side left
11068 pack $top.g -side top
11069 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11070 -background white
11071 $top.c create text 100 25 -anchor center -text $which -font sample \
11072 -fill black -tags text
11073 bind $top.c <Configure> [list centertext $top.c]
11074 pack $top.c -side top -fill x
d93f1713
PT
11075 ${NS}::frame $top.buts
11076 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11077 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
76f15947
AG
11078 bind $top <Key-Return> fontok
11079 bind $top <Key-Escape> fontcan
9a7558f3
PM
11080 grid $top.buts.ok $top.buts.can
11081 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11082 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11083 pack $top.buts -side bottom -fill x
11084 trace add variable fontparam write chg_fontparam
11085 } else {
11086 raise $top
11087 $top.c itemconf text -text $which
11088 }
11089 set i [lsearch -exact $fontlist $fontparam(family)]
11090 if {$i >= 0} {
11091 $top.f.fam selection set $i
11092 $top.f.fam see $i
11093 }
11094}
11095
11096proc centertext {w} {
11097 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11098}
11099
11100proc fontok {} {
11101 global fontparam fontpref prefstop
11102
11103 set f $fontparam(font)
11104 set fontpref($f) [list $fontparam(family) $fontparam(size)]
11105 if {$fontparam(weight) eq "bold"} {
11106 lappend fontpref($f) "bold"
11107 }
11108 if {$fontparam(slant) eq "italic"} {
11109 lappend fontpref($f) "italic"
11110 }
39ddf99c 11111 set w $prefstop.notebook.fonts.$f
9a7558f3 11112 $w conf -text $fontparam(family) -font $fontpref($f)
d93f1713 11113
9a7558f3
PM
11114 fontcan
11115}
11116
11117proc fontcan {} {
11118 global fonttop fontparam
11119
11120 if {[info exists fonttop]} {
11121 catch {destroy $fonttop}
11122 catch {font delete sample}
11123 unset fonttop
11124 unset fontparam
11125 }
11126}
11127
d93f1713
PT
11128if {[package vsatisfies [package provide Tk] 8.6]} {
11129 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11130 # function to make use of it.
11131 proc choosefont {font which} {
11132 tk fontchooser configure -title $which -font $font \
11133 -command [list on_choosefont $font $which]
11134 tk fontchooser show
11135 }
11136 proc on_choosefont {font which newfont} {
11137 global fontparam
11138 puts stderr "$font $newfont"
11139 array set f [font actual $newfont]
11140 set fontparam(which) $which
11141 set fontparam(font) $font
11142 set fontparam(family) $f(-family)
11143 set fontparam(size) $f(-size)
11144 set fontparam(weight) $f(-weight)
11145 set fontparam(slant) $f(-slant)
11146 fontok
11147 }
11148}
11149
9a7558f3
PM
11150proc selfontfam {} {
11151 global fonttop fontparam
11152
11153 set i [$fonttop.f.fam curselection]
11154 if {$i ne {}} {
11155 set fontparam(family) [$fonttop.f.fam get $i]
11156 }
11157}
11158
11159proc chg_fontparam {v sub op} {
11160 global fontparam
11161
11162 font config sample -$sub $fontparam($sub)
11163}
11164
44acce0b
PT
11165# Create a property sheet tab page
11166proc create_prefs_page {w} {
11167 global NS
11168 set parent [join [lrange [split $w .] 0 end-1] .]
11169 if {[winfo class $parent] eq "TNotebook"} {
11170 ${NS}::frame $w
11171 } else {
11172 ${NS}::labelframe $w
11173 }
11174}
11175
11176proc prefspage_general {notebook} {
11177 global NS maxwidth maxgraphpct showneartags showlocalchanges
11178 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
d34835c9 11179 global hideremotes want_ttk have_ttk maxrefs
44acce0b
PT
11180
11181 set page [create_prefs_page $notebook.general]
11182
11183 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11184 grid $page.ldisp - -sticky w -pady 10
11185 ${NS}::label $page.spacer -text " "
11186 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11187 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11188 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11189 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11190 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11191 grid x $page.maxpctl $page.maxpct -sticky w
11192 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11193 -variable showlocalchanges
11194 grid x $page.showlocal -sticky w
11195 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11196 -variable autoselect
11197 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11198 grid x $page.autoselect $page.autosellen -sticky w
11199 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11200 -variable hideremotes
11201 grid x $page.hideremotes -sticky w
11202
11203 ${NS}::label $page.ddisp -text [mc "Diff display options"]
11204 grid $page.ddisp - -sticky w -pady 10
11205 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11206 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11207 grid x $page.tabstopl $page.tabstop -sticky w
d34835c9 11208 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
44acce0b
PT
11209 -variable showneartags
11210 grid x $page.ntag -sticky w
d34835c9
PM
11211 ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11212 spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11213 grid x $page.maxrefsl $page.maxrefs -sticky w
44acce0b
PT
11214 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11215 -variable limitdiffs
11216 grid x $page.ldiff -sticky w
11217 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11218 -variable perfile_attrs
11219 grid x $page.lattr -sticky w
11220
11221 ${NS}::entry $page.extdifft -textvariable extdifftool
11222 ${NS}::frame $page.extdifff
11223 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11224 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11225 pack $page.extdifff.l $page.extdifff.b -side left
11226 pack configure $page.extdifff.l -padx 10
11227 grid x $page.extdifff $page.extdifft -sticky ew
11228
11229 ${NS}::label $page.lgen -text [mc "General options"]
11230 grid $page.lgen - -sticky w -pady 10
11231 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11232 -text [mc "Use themed widgets"]
11233 if {$have_ttk} {
11234 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11235 } else {
11236 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11237 }
11238 grid x $page.want_ttk $page.ttk_note -sticky w
11239 return $page
11240}
11241
11242proc prefspage_colors {notebook} {
11243 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11244
11245 set page [create_prefs_page $notebook.colors]
11246
11247 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11248 grid $page.cdisp - -sticky w -pady 10
11249 label $page.ui -padx 40 -relief sunk -background $uicolor
11250 ${NS}::button $page.uibut -text [mc "Interface"] \
11251 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11252 grid x $page.uibut $page.ui -sticky w
11253 label $page.bg -padx 40 -relief sunk -background $bgcolor
11254 ${NS}::button $page.bgbut -text [mc "Background"] \
11255 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11256 grid x $page.bgbut $page.bg -sticky w
11257 label $page.fg -padx 40 -relief sunk -background $fgcolor
11258 ${NS}::button $page.fgbut -text [mc "Foreground"] \
11259 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11260 grid x $page.fgbut $page.fg -sticky w
11261 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11262 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11263 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11264 [list $ctext tag conf d0 -foreground]]
11265 grid x $page.diffoldbut $page.diffold -sticky w
11266 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11267 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11268 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11269 [list $ctext tag conf dresult -foreground]]
11270 grid x $page.diffnewbut $page.diffnew -sticky w
11271 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11272 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11273 -command [list choosecolor diffcolors 2 $page.hunksep \
11274 [mc "diff hunk header"] \
11275 [list $ctext tag conf hunksep -foreground]]
11276 grid x $page.hunksepbut $page.hunksep -sticky w
11277 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11278 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11279 -command [list choosecolor markbgcolor {} $page.markbgsep \
11280 [mc "marked line background"] \
11281 [list $ctext tag conf omark -background]]
11282 grid x $page.markbgbut $page.markbgsep -sticky w
11283 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11284 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11285 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11286 grid x $page.selbgbut $page.selbgsep -sticky w
11287 return $page
11288}
11289
11290proc prefspage_fonts {notebook} {
11291 global NS
11292 set page [create_prefs_page $notebook.fonts]
11293 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11294 grid $page.cfont - -sticky w -pady 10
11295 mkfontdisp mainfont $page [mc "Main font"]
11296 mkfontdisp textfont $page [mc "Diff display font"]
11297 mkfontdisp uifont $page [mc "User interface font"]
11298 return $page
11299}
11300
712fcc08 11301proc doprefs {} {
d93f1713 11302 global maxwidth maxgraphpct use_ttk NS
219ea3a9 11303 global oldprefs prefstop showneartags showlocalchanges
5497f7a2 11304 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
21ac8a8d 11305 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
0cc08ff7 11306 global hideremotes want_ttk have_ttk
232475d3 11307
712fcc08
PM
11308 set top .gitkprefs
11309 set prefstop $top
11310 if {[winfo exists $top]} {
11311 raise $top
11312 return
757f17bc 11313 }
3de07118 11314 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
0cc08ff7 11315 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
712fcc08 11316 set oldprefs($v) [set $v]
232475d3 11317 }
d93f1713 11318 ttk_toplevel $top
d990cedf 11319 wm title $top [mc "Gitk preferences"]
e7d64008 11320 make_transient $top .
44acce0b
PT
11321
11322 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11323 set notebook [ttk::notebook $top.notebook]
0cc08ff7 11324 } else {
44acce0b
PT
11325 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11326 }
11327
11328 lappend pages [prefspage_general $notebook] [mc "General"]
11329 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11330 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
28cb7074 11331 set col 0
44acce0b
PT
11332 foreach {page title} $pages {
11333 if {$use_notebook} {
11334 $notebook add $page -text $title
11335 } else {
11336 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11337 -text $title -command [list raise $page]]
11338 $page configure -text $title
11339 grid $btn -row 0 -column [incr col] -sticky w
11340 grid $page -row 1 -column 0 -sticky news -columnspan 100
11341 }
11342 }
11343
11344 if {!$use_notebook} {
11345 grid columnconfigure $notebook 0 -weight 1
11346 grid rowconfigure $notebook 1 -weight 1
11347 raise [lindex $pages 0]
11348 }
11349
11350 grid $notebook -sticky news -padx 2 -pady 2
11351 grid rowconfigure $top 0 -weight 1
11352 grid columnconfigure $top 0 -weight 1
9a7558f3 11353
d93f1713
PT
11354 ${NS}::frame $top.buts
11355 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11356 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
76f15947
AG
11357 bind $top <Key-Return> prefsok
11358 bind $top <Key-Escape> prefscan
712fcc08
PM
11359 grid $top.buts.ok $top.buts.can
11360 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11361 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11362 grid $top.buts - - -pady 10 -sticky ew
d93f1713 11363 grid columnconfigure $top 2 -weight 1
44acce0b 11364 bind $top <Visibility> [list focus $top.buts.ok]
712fcc08
PM
11365}
11366
314f5de1
TA
11367proc choose_extdiff {} {
11368 global extdifftool
11369
b56e0a9a 11370 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
314f5de1
TA
11371 if {$prog ne {}} {
11372 set extdifftool $prog
11373 }
11374}
11375
f8a2c0d1
PM
11376proc choosecolor {v vi w x cmd} {
11377 global $v
11378
11379 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
d990cedf 11380 -title [mc "Gitk: choose color for %s" $x]]
f8a2c0d1
PM
11381 if {$c eq {}} return
11382 $w conf -background $c
11383 lset $v $vi $c
11384 eval $cmd $c
11385}
11386
60378c0c
ML
11387proc setselbg {c} {
11388 global bglist cflist
11389 foreach w $bglist {
11390 $w configure -selectbackground $c
11391 }
11392 $cflist tag configure highlight \
11393 -background [$cflist cget -selectbackground]
11394 allcanvs itemconf secsel -fill $c
11395}
11396
51a7e8b6
PM
11397# This sets the background color and the color scheme for the whole UI.
11398# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11399# if we don't specify one ourselves, which makes the checkbuttons and
11400# radiobuttons look bad. This chooses white for selectColor if the
11401# background color is light, or black if it is dark.
5497f7a2 11402proc setui {c} {
2e58c944 11403 if {[tk windowingsystem] eq "win32"} { return }
51a7e8b6
PM
11404 set bg [winfo rgb . $c]
11405 set selc black
11406 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11407 set selc white
11408 }
11409 tk_setPalette background $c selectColor $selc
5497f7a2
GR
11410}
11411
f8a2c0d1
PM
11412proc setbg {c} {
11413 global bglist
11414
11415 foreach w $bglist {
11416 $w conf -background $c
11417 }
11418}
11419
11420proc setfg {c} {
11421 global fglist canv
11422
11423 foreach w $fglist {
11424 $w conf -foreground $c
11425 }
11426 allcanvs itemconf text -fill $c
11427 $canv itemconf circle -outline $c
b9fdba7f 11428 $canv itemconf markid -outline $c
f8a2c0d1
PM
11429}
11430
712fcc08 11431proc prefscan {} {
94503918 11432 global oldprefs prefstop
712fcc08 11433
3de07118 11434 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
0cc08ff7 11435 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
94503918 11436 global $v
712fcc08
PM
11437 set $v $oldprefs($v)
11438 }
11439 catch {destroy $prefstop}
11440 unset prefstop
9a7558f3 11441 fontcan
712fcc08
PM
11442}
11443
11444proc prefsok {} {
11445 global maxwidth maxgraphpct
219ea3a9 11446 global oldprefs prefstop showneartags showlocalchanges
9a7558f3 11447 global fontpref mainfont textfont uifont
39ee47ef 11448 global limitdiffs treediffs perfile_attrs
ffe15297 11449 global hideremotes
712fcc08
PM
11450
11451 catch {destroy $prefstop}
11452 unset prefstop
9a7558f3
PM
11453 fontcan
11454 set fontchanged 0
11455 if {$mainfont ne $fontpref(mainfont)} {
11456 set mainfont $fontpref(mainfont)
11457 parsefont mainfont $mainfont
11458 eval font configure mainfont [fontflags mainfont]
11459 eval font configure mainfontbold [fontflags mainfont 1]
11460 setcoords
11461 set fontchanged 1
11462 }
11463 if {$textfont ne $fontpref(textfont)} {
11464 set textfont $fontpref(textfont)
11465 parsefont textfont $textfont
11466 eval font configure textfont [fontflags textfont]
11467 eval font configure textfontbold [fontflags textfont 1]
11468 }
11469 if {$uifont ne $fontpref(uifont)} {
11470 set uifont $fontpref(uifont)
11471 parsefont uifont $uifont
11472 eval font configure uifont [fontflags uifont]
11473 }
32f1b3e4 11474 settabs
219ea3a9
PM
11475 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11476 if {$showlocalchanges} {
11477 doshowlocalchanges
11478 } else {
11479 dohidelocalchanges
11480 }
11481 }
39ee47ef
PM
11482 if {$limitdiffs != $oldprefs(limitdiffs) ||
11483 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11484 # treediffs elements are limited by path;
11485 # won't have encodings cached if perfile_attrs was just turned on
74a40c71
PM
11486 catch {unset treediffs}
11487 }
9a7558f3 11488 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
712fcc08
PM
11489 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11490 redisplay
7a39a17a
PM
11491 } elseif {$showneartags != $oldprefs(showneartags) ||
11492 $limitdiffs != $oldprefs(limitdiffs)} {
b8ab2e17 11493 reselectline
712fcc08 11494 }
ffe15297
TR
11495 if {$hideremotes != $oldprefs(hideremotes)} {
11496 rereadrefs
11497 }
712fcc08
PM
11498}
11499
11500proc formatdate {d} {
e8b5f4be 11501 global datetimeformat
219ea3a9 11502 if {$d ne {}} {
f5974d97 11503 set d [clock format [lindex $d 0] -format $datetimeformat]
219ea3a9
PM
11504 }
11505 return $d
232475d3
PM
11506}
11507
fd8ccbec
PM
11508# This list of encoding names and aliases is distilled from
11509# http://www.iana.org/assignments/character-sets.
11510# Not all of them are supported by Tcl.
11511set encoding_aliases {
11512 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11513 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11514 { ISO-10646-UTF-1 csISO10646UTF1 }
11515 { ISO_646.basic:1983 ref csISO646basic1983 }
11516 { INVARIANT csINVARIANT }
11517 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11518 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11519 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11520 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11521 { NATS-DANO iso-ir-9-1 csNATSDANO }
11522 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11523 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11524 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11525 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11526 { ISO-2022-KR csISO2022KR }
11527 { EUC-KR csEUCKR }
11528 { ISO-2022-JP csISO2022JP }
11529 { ISO-2022-JP-2 csISO2022JP2 }
11530 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11531 csISO13JISC6220jp }
11532 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11533 { IT iso-ir-15 ISO646-IT csISO15Italian }
11534 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11535 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11536 { greek7-old iso-ir-18 csISO18Greek7Old }
11537 { latin-greek iso-ir-19 csISO19LatinGreek }
11538 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11539 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11540 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11541 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11542 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11543 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11544 { INIS iso-ir-49 csISO49INIS }
11545 { INIS-8 iso-ir-50 csISO50INIS8 }
11546 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11547 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11548 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11549 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11550 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11551 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11552 csISO60Norwegian1 }
11553 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11554 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11555 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11556 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11557 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11558 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11559 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11560 { greek7 iso-ir-88 csISO88Greek7 }
11561 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11562 { iso-ir-90 csISO90 }
11563 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11564 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11565 csISO92JISC62991984b }
11566 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11567 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11568 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11569 csISO95JIS62291984handadd }
11570 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11571 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11572 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11573 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11574 CP819 csISOLatin1 }
11575 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11576 { T.61-7bit iso-ir-102 csISO102T617bit }
11577 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11578 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11579 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11580 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11581 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11582 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11583 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11584 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11585 arabic csISOLatinArabic }
11586 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11587 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11588 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11589 greek greek8 csISOLatinGreek }
11590 { T.101-G2 iso-ir-128 csISO128T101G2 }
11591 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11592 csISOLatinHebrew }
11593 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11594 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11595 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11596 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11597 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11598 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11599 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11600 csISOLatinCyrillic }
11601 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11602 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11603 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11604 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11605 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11606 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11607 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11608 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11609 { ISO_10367-box iso-ir-155 csISO10367Box }
11610 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11611 { latin-lap lap iso-ir-158 csISO158Lap }
11612 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11613 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11614 { us-dk csUSDK }
11615 { dk-us csDKUS }
11616 { JIS_X0201 X0201 csHalfWidthKatakana }
11617 { KSC5636 ISO646-KR csKSC5636 }
11618 { ISO-10646-UCS-2 csUnicode }
11619 { ISO-10646-UCS-4 csUCS4 }
11620 { DEC-MCS dec csDECMCS }
11621 { hp-roman8 roman8 r8 csHPRoman8 }
11622 { macintosh mac csMacintosh }
11623 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11624 csIBM037 }
11625 { IBM038 EBCDIC-INT cp038 csIBM038 }
11626 { IBM273 CP273 csIBM273 }
11627 { IBM274 EBCDIC-BE CP274 csIBM274 }
11628 { IBM275 EBCDIC-BR cp275 csIBM275 }
11629 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11630 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11631 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11632 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11633 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11634 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11635 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11636 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11637 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11638 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11639 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11640 { IBM437 cp437 437 csPC8CodePage437 }
11641 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11642 { IBM775 cp775 csPC775Baltic }
11643 { IBM850 cp850 850 csPC850Multilingual }
11644 { IBM851 cp851 851 csIBM851 }
11645 { IBM852 cp852 852 csPCp852 }
11646 { IBM855 cp855 855 csIBM855 }
11647 { IBM857 cp857 857 csIBM857 }
11648 { IBM860 cp860 860 csIBM860 }
11649 { IBM861 cp861 861 cp-is csIBM861 }
11650 { IBM862 cp862 862 csPC862LatinHebrew }
11651 { IBM863 cp863 863 csIBM863 }
11652 { IBM864 cp864 csIBM864 }
11653 { IBM865 cp865 865 csIBM865 }
11654 { IBM866 cp866 866 csIBM866 }
11655 { IBM868 CP868 cp-ar csIBM868 }
11656 { IBM869 cp869 869 cp-gr csIBM869 }
11657 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11658 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11659 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11660 { IBM891 cp891 csIBM891 }
11661 { IBM903 cp903 csIBM903 }
11662 { IBM904 cp904 904 csIBBM904 }
11663 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11664 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11665 { IBM1026 CP1026 csIBM1026 }
11666 { EBCDIC-AT-DE csIBMEBCDICATDE }
11667 { EBCDIC-AT-DE-A csEBCDICATDEA }
11668 { EBCDIC-CA-FR csEBCDICCAFR }
11669 { EBCDIC-DK-NO csEBCDICDKNO }
11670 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11671 { EBCDIC-FI-SE csEBCDICFISE }
11672 { EBCDIC-FI-SE-A csEBCDICFISEA }
11673 { EBCDIC-FR csEBCDICFR }
11674 { EBCDIC-IT csEBCDICIT }
11675 { EBCDIC-PT csEBCDICPT }
11676 { EBCDIC-ES csEBCDICES }
11677 { EBCDIC-ES-A csEBCDICESA }
11678 { EBCDIC-ES-S csEBCDICESS }
11679 { EBCDIC-UK csEBCDICUK }
11680 { EBCDIC-US csEBCDICUS }
11681 { UNKNOWN-8BIT csUnknown8BiT }
11682 { MNEMONIC csMnemonic }
11683 { MNEM csMnem }
11684 { VISCII csVISCII }
11685 { VIQR csVIQR }
11686 { KOI8-R csKOI8R }
11687 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11688 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11689 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11690 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11691 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11692 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11693 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11694 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11695 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11696 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11697 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11698 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11699 { IBM1047 IBM-1047 }
11700 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11701 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11702 { UNICODE-1-1 csUnicode11 }
11703 { CESU-8 csCESU-8 }
11704 { BOCU-1 csBOCU-1 }
11705 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11706 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11707 l8 }
11708 { ISO-8859-15 ISO_8859-15 Latin-9 }
11709 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11710 { GBK CP936 MS936 windows-936 }
11711 { JIS_Encoding csJISEncoding }
09c7029d 11712 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
fd8ccbec
PM
11713 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11714 EUC-JP }
11715 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11716 { ISO-10646-UCS-Basic csUnicodeASCII }
11717 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11718 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11719 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11720 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11721 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11722 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11723 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11724 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11725 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11726 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11727 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11728 { Ventura-US csVenturaUS }
11729 { Ventura-International csVenturaInternational }
11730 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11731 { PC8-Turkish csPC8Turkish }
11732 { IBM-Symbols csIBMSymbols }
11733 { IBM-Thai csIBMThai }
11734 { HP-Legal csHPLegal }
11735 { HP-Pi-font csHPPiFont }
11736 { HP-Math8 csHPMath8 }
11737 { Adobe-Symbol-Encoding csHPPSMath }
11738 { HP-DeskTop csHPDesktop }
11739 { Ventura-Math csVenturaMath }
11740 { Microsoft-Publishing csMicrosoftPublishing }
11741 { Windows-31J csWindows31J }
11742 { GB2312 csGB2312 }
11743 { Big5 csBig5 }
11744}
11745
11746proc tcl_encoding {enc} {
39ee47ef
PM
11747 global encoding_aliases tcl_encoding_cache
11748 if {[info exists tcl_encoding_cache($enc)]} {
11749 return $tcl_encoding_cache($enc)
11750 }
fd8ccbec
PM
11751 set names [encoding names]
11752 set lcnames [string tolower $names]
11753 set enc [string tolower $enc]
11754 set i [lsearch -exact $lcnames $enc]
11755 if {$i < 0} {
11756 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
09c7029d 11757 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
fd8ccbec
PM
11758 set i [lsearch -exact $lcnames $encx]
11759 }
11760 }
11761 if {$i < 0} {
11762 foreach l $encoding_aliases {
11763 set ll [string tolower $l]
11764 if {[lsearch -exact $ll $enc] < 0} continue
11765 # look through the aliases for one that tcl knows about
11766 foreach e $ll {
11767 set i [lsearch -exact $lcnames $e]
11768 if {$i < 0} {
09c7029d 11769 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
fd8ccbec
PM
11770 set i [lsearch -exact $lcnames $ex]
11771 }
11772 }
11773 if {$i >= 0} break
11774 }
11775 break
11776 }
11777 }
39ee47ef 11778 set tclenc {}
fd8ccbec 11779 if {$i >= 0} {
39ee47ef 11780 set tclenc [lindex $names $i]
fd8ccbec 11781 }
39ee47ef
PM
11782 set tcl_encoding_cache($enc) $tclenc
11783 return $tclenc
fd8ccbec
PM
11784}
11785
09c7029d 11786proc gitattr {path attr default} {
39ee47ef
PM
11787 global path_attr_cache
11788 if {[info exists path_attr_cache($attr,$path)]} {
11789 set r $path_attr_cache($attr,$path)
11790 } else {
11791 set r "unspecified"
11792 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
097e1118 11793 regexp "(.*): $attr: (.*)" $line m f r
09c7029d 11794 }
4db09304 11795 set path_attr_cache($attr,$path) $r
39ee47ef
PM
11796 }
11797 if {$r eq "unspecified"} {
11798 return $default
11799 }
11800 return $r
09c7029d
AG
11801}
11802
4db09304 11803proc cache_gitattr {attr pathlist} {
39ee47ef
PM
11804 global path_attr_cache
11805 set newlist {}
11806 foreach path $pathlist {
11807 if {![info exists path_attr_cache($attr,$path)]} {
11808 lappend newlist $path
11809 }
11810 }
11811 set lim 1000
11812 if {[tk windowingsystem] == "win32"} {
11813 # windows has a 32k limit on the arguments to a command...
11814 set lim 30
11815 }
11816 while {$newlist ne {}} {
11817 set head [lrange $newlist 0 [expr {$lim - 1}]]
11818 set newlist [lrange $newlist $lim end]
11819 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11820 foreach row [split $rlist "\n"] {
097e1118 11821 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
39ee47ef
PM
11822 if {[string index $path 0] eq "\""} {
11823 set path [encoding convertfrom [lindex $path 0]]
11824 }
11825 set path_attr_cache($attr,$path) $value
4db09304 11826 }
39ee47ef 11827 }
4db09304 11828 }
39ee47ef 11829 }
4db09304
AG
11830}
11831
09c7029d 11832proc get_path_encoding {path} {
39ee47ef
PM
11833 global gui_encoding perfile_attrs
11834 set tcl_enc $gui_encoding
11835 if {$path ne {} && $perfile_attrs} {
11836 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11837 if {$enc2 ne {}} {
11838 set tcl_enc $enc2
09c7029d 11839 }
39ee47ef
PM
11840 }
11841 return $tcl_enc
09c7029d
AG
11842}
11843
5d7589d4
PM
11844# First check that Tcl/Tk is recent enough
11845if {[catch {package require Tk 8.4} err]} {
8d849957
BH
11846 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11847 Gitk requires at least Tcl/Tk 8.4." list
5d7589d4
PM
11848 exit 1
11849}
11850
76bf6ff9
TS
11851# on OSX bring the current Wish process window to front
11852if {[tk windowingsystem] eq "aqua"} {
11853 exec osascript -e [format {
11854 tell application "System Events"
11855 set frontmost of processes whose unix id is %d to true
11856 end tell
11857 } [pid] ]
11858}
11859
0ae10357
AO
11860# Unset GIT_TRACE var if set
11861if { [info exists ::env(GIT_TRACE)] } {
11862 unset ::env(GIT_TRACE)
11863}
11864
1d10f36d 11865# defaults...
8974c6f9 11866set wrcomcmd "git diff-tree --stdin -p --pretty"
671bc153 11867
fd8ccbec 11868set gitencoding {}
671bc153 11869catch {
27cb61ca 11870 set gitencoding [exec git config --get i18n.commitencoding]
671bc153 11871}
590915da
AG
11872catch {
11873 set gitencoding [exec git config --get i18n.logoutputencoding]
11874}
671bc153 11875if {$gitencoding == ""} {
fd8ccbec
PM
11876 set gitencoding "utf-8"
11877}
11878set tclencoding [tcl_encoding $gitencoding]
11879if {$tclencoding == {}} {
11880 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
671bc153 11881}
1db95b00 11882
09c7029d
AG
11883set gui_encoding [encoding system]
11884catch {
39ee47ef
PM
11885 set enc [exec git config --get gui.encoding]
11886 if {$enc ne {}} {
11887 set tclenc [tcl_encoding $enc]
11888 if {$tclenc ne {}} {
11889 set gui_encoding $tclenc
11890 } else {
11891 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11892 }
11893 }
09c7029d
AG
11894}
11895
b2b76d10
MK
11896set log_showroot true
11897catch {
11898 set log_showroot [exec git config --bool --get log.showroot]
11899}
11900
5fdcbb13
DS
11901if {[tk windowingsystem] eq "aqua"} {
11902 set mainfont {{Lucida Grande} 9}
11903 set textfont {Monaco 9}
11904 set uifont {{Lucida Grande} 9 bold}
5c9096f7
JN
11905} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11906 # fontconfig!
11907 set mainfont {sans 9}
11908 set textfont {monospace 9}
11909 set uifont {sans 9 bold}
5fdcbb13
DS
11910} else {
11911 set mainfont {Helvetica 9}
11912 set textfont {Courier 9}
11913 set uifont {Helvetica 9 bold}
11914}
7e12f1a6 11915set tabstop 8
b74fd579 11916set findmergefiles 0
8d858d1a 11917set maxgraphpct 50
f6075eba 11918set maxwidth 16
232475d3 11919set revlistorder 0
757f17bc 11920set fastdate 0
6e8c8707
PM
11921set uparrowlen 5
11922set downarrowlen 5
11923set mingaplen 100
f8b28a40 11924set cmitmode "patch"
f1b86294 11925set wrapcomment "none"
b8ab2e17 11926set showneartags 1
ffe15297 11927set hideremotes 0
0a4dd8b8 11928set maxrefs 20
322a8cc9 11929set maxlinelen 200
219ea3a9 11930set showlocalchanges 1
7a39a17a 11931set limitdiffs 1
e8b5f4be 11932set datetimeformat "%Y-%m-%d %H:%M:%S"
95293b58 11933set autoselect 1
21ac8a8d 11934set autosellen 40
39ee47ef 11935set perfile_attrs 0
0cc08ff7 11936set want_ttk 1
1d10f36d 11937
5fdcbb13
DS
11938if {[tk windowingsystem] eq "aqua"} {
11939 set extdifftool "opendiff"
11940} else {
11941 set extdifftool "meld"
11942}
314f5de1 11943
1d10f36d 11944set colors {green red blue magenta darkgrey brown orange}
1924d1bc
PT
11945if {[tk windowingsystem] eq "win32"} {
11946 set uicolor SystemButtonFace
252c52df
11947 set uifgcolor SystemButtonText
11948 set uifgdisabledcolor SystemDisabledText
1924d1bc 11949 set bgcolor SystemWindow
252c52df 11950 set fgcolor SystemWindowText
1924d1bc
PT
11951 set selectbgcolor SystemHighlight
11952} else {
11953 set uicolor grey85
252c52df
11954 set uifgcolor black
11955 set uifgdisabledcolor "#999"
1924d1bc
PT
11956 set bgcolor white
11957 set fgcolor black
11958 set selectbgcolor gray85
11959}
f8a2c0d1 11960set diffcolors {red "#00a000" blue}
890fae70 11961set diffcontext 3
252c52df 11962set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
b9b86007 11963set ignorespace 0
ae4e3ff9 11964set worddiff ""
e3e901be 11965set markbgcolor "#e0e0ff"
1d10f36d 11966
252c52df
11967set headbgcolor green
11968set headfgcolor black
11969set headoutlinecolor black
11970set remotebgcolor #ffddaa
11971set tagbgcolor yellow
11972set tagfgcolor black
11973set tagoutlinecolor black
11974set reflinecolor black
11975set filesepbgcolor #aaaaaa
11976set filesepfgcolor black
11977set linehoverbgcolor #ffff80
11978set linehoverfgcolor black
11979set linehoveroutlinecolor black
11980set mainheadcirclecolor yellow
11981set workingfilescirclecolor red
11982set indexcirclecolor green
c11ff120 11983set circlecolors {white blue gray blue blue}
252c52df
11984set linkfgcolor blue
11985set circleoutlinecolor $fgcolor
11986set foundbgcolor yellow
11987set currentsearchhitbgcolor orange
c11ff120 11988
d277e89f
PM
11989# button for popping up context menus
11990if {[tk windowingsystem] eq "aqua"} {
11991 set ctxbut <Button-2>
11992} else {
11993 set ctxbut <Button-3>
11994}
11995
663c3aa9
CS
11996## For msgcat loading, first locate the installation location.
11997if { [info exists ::env(GITK_MSGSDIR)] } {
11998 ## Msgsdir was manually set in the environment.
11999 set gitk_msgsdir $::env(GITK_MSGSDIR)
12000} else {
12001 ## Let's guess the prefix from argv0.
12002 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12003 set gitk_libdir [file join $gitk_prefix share gitk lib]
12004 set gitk_msgsdir [file join $gitk_libdir msgs]
12005 unset gitk_prefix
12006}
12007
12008## Internationalization (i18n) through msgcat and gettext. See
12009## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12010package require msgcat
12011namespace import ::msgcat::mc
12012## And eventually load the actual message catalog
12013::msgcat::mcload $gitk_msgsdir
12014
1d10f36d
PM
12015catch {source ~/.gitk}
12016
0ed1dd3c
PM
12017parsefont mainfont $mainfont
12018eval font create mainfont [fontflags mainfont]
12019eval font create mainfontbold [fontflags mainfont 1]
12020
12021parsefont textfont $textfont
12022eval font create textfont [fontflags textfont]
12023eval font create textfontbold [fontflags textfont 1]
12024
12025parsefont uifont $uifont
12026eval font create uifont [fontflags uifont]
17386066 12027
51a7e8b6 12028setui $uicolor
5497f7a2 12029
b039f0a6
PM
12030setoptions
12031
cdaee5db 12032# check that we can find a .git directory somewhere...
86e847bc 12033if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
d990cedf 12034 show_error {} . [mc "Cannot find a git repository here."]
6c87d60c
AR
12035 exit 1
12036}
cdaee5db 12037
39816d60
AG
12038set selecthead {}
12039set selectheadid {}
12040
1d10f36d 12041set revtreeargs {}
cdaee5db
PM
12042set cmdline_files {}
12043set i 0
2d480856 12044set revtreeargscmd {}
1d10f36d 12045foreach arg $argv {
2d480856 12046 switch -glob -- $arg {
6ebedabf 12047 "" { }
cdaee5db
PM
12048 "--" {
12049 set cmdline_files [lrange $argv [expr {$i + 1}] end]
12050 break
12051 }
39816d60
AG
12052 "--select-commit=*" {
12053 set selecthead [string range $arg 16 end]
12054 }
2d480856
YD
12055 "--argscmd=*" {
12056 set revtreeargscmd [string range $arg 10 end]
12057 }
1d10f36d
PM
12058 default {
12059 lappend revtreeargs $arg
12060 }
12061 }
cdaee5db 12062 incr i
1db95b00 12063}
1d10f36d 12064
39816d60
AG
12065if {$selecthead eq "HEAD"} {
12066 set selecthead {}
12067}
12068
cdaee5db 12069if {$i >= [llength $argv] && $revtreeargs ne {}} {
3ed31a81 12070 # no -- on command line, but some arguments (other than --argscmd)
098dd8a3 12071 if {[catch {
8974c6f9 12072 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
098dd8a3
PM
12073 set cmdline_files [split $f "\n"]
12074 set n [llength $cmdline_files]
12075 set revtreeargs [lrange $revtreeargs 0 end-$n]
cdaee5db
PM
12076 # Unfortunately git rev-parse doesn't produce an error when
12077 # something is both a revision and a filename. To be consistent
12078 # with git log and git rev-list, check revtreeargs for filenames.
12079 foreach arg $revtreeargs {
12080 if {[file exists $arg]} {
d990cedf
CS
12081 show_error {} . [mc "Ambiguous argument '%s': both revision\
12082 and filename" $arg]
cdaee5db
PM
12083 exit 1
12084 }
12085 }
098dd8a3
PM
12086 } err]} {
12087 # unfortunately we get both stdout and stderr in $err,
12088 # so look for "fatal:".
12089 set i [string first "fatal:" $err]
12090 if {$i > 0} {
b5e09633 12091 set err [string range $err [expr {$i + 6}] end]
098dd8a3 12092 }
d990cedf 12093 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
098dd8a3
PM
12094 exit 1
12095 }
12096}
12097
219ea3a9 12098set nullid "0000000000000000000000000000000000000000"
8f489363 12099set nullid2 "0000000000000000000000000000000000000001"
314f5de1 12100set nullfile "/dev/null"
8f489363 12101
32f1b3e4 12102set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
0cc08ff7
PM
12103if {![info exists have_ttk]} {
12104 set have_ttk [llength [info commands ::ttk::style]]
d93f1713 12105}
0cc08ff7 12106set use_ttk [expr {$have_ttk && $want_ttk}]
d93f1713 12107set NS [expr {$use_ttk ? "ttk" : ""}]
0cc08ff7 12108
7add5aff 12109regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
219ea3a9 12110
7defefb1
KS
12111set show_notes {}
12112if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12113 set show_notes "--show-notes"
12114}
12115
3878e636
ZJS
12116set appname "gitk"
12117
7eb3cb9c 12118set runq {}
d698206c
PM
12119set history {}
12120set historyindex 0
908c3585 12121set fh_serial 0
908c3585 12122set nhl_names {}
63b79191 12123set highlight_paths {}
687c8765 12124set findpattern {}
1902c270 12125set searchdirn -forwards
28593d3f
PM
12126set boldids {}
12127set boldnameids {}
a8d610a2 12128set diffelide {0 0}
4fb0fa19 12129set markingmatches 0
97645683 12130set linkentercount 0
0380081c
PM
12131set need_redisplay 0
12132set nrows_drawn 0
32f1b3e4 12133set firsttabstop 0
9f1afe05 12134
50b44ece
PM
12135set nextviewnum 1
12136set curview 0
a90a6d24 12137set selectedview 0
b007ee20
CS
12138set selectedhlview [mc "None"]
12139set highlight_related [mc "None"]
687c8765 12140set highlight_files {}
50b44ece 12141set viewfiles(0) {}
a90a6d24 12142set viewperm(0) 0
098dd8a3 12143set viewargs(0) {}
2d480856 12144set viewargscmd(0) {}
50b44ece 12145
94b4a69f 12146set selectedline {}
6df7403a 12147set numcommits 0
7fcc92bf 12148set loginstance 0
098dd8a3 12149set cmdlineok 0
1d10f36d 12150set stopped 0
0fba86b3 12151set stuffsaved 0
74daedb6 12152set patchnum 0
219ea3a9 12153set lserial 0
74cb884f 12154set hasworktree [hasworktree]
c332f445 12155set cdup {}
74cb884f 12156if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
c332f445
MZ
12157 set cdup [exec git rev-parse --show-cdup]
12158}
784b7e2f 12159set worktree [exec git rev-parse --show-toplevel]
1d10f36d 12160setcoords
d94f8cd6 12161makewindow
37871b73
GB
12162catch {
12163 image create photo gitlogo -width 16 -height 16
12164
12165 image create photo gitlogominus -width 4 -height 2
12166 gitlogominus put #C00000 -to 0 0 4 2
12167 gitlogo copy gitlogominus -to 1 5
12168 gitlogo copy gitlogominus -to 6 5
12169 gitlogo copy gitlogominus -to 11 5
12170 image delete gitlogominus
12171
12172 image create photo gitlogoplus -width 4 -height 4
12173 gitlogoplus put #008000 -to 1 0 3 4
12174 gitlogoplus put #008000 -to 0 1 4 3
12175 gitlogo copy gitlogoplus -to 1 9
12176 gitlogo copy gitlogoplus -to 6 9
12177 gitlogo copy gitlogoplus -to 11 9
12178 image delete gitlogoplus
12179
d38d7d49
SB
12180 image create photo gitlogo32 -width 32 -height 32
12181 gitlogo32 copy gitlogo -zoom 2 2
12182
12183 wm iconphoto . -default gitlogo gitlogo32
37871b73 12184}
0eafba14
PM
12185# wait for the window to become visible
12186tkwait visibility .
3878e636 12187wm title . "$appname: [reponame]"
478afad6 12188update
887fe3c4 12189readrefs
a8aaf19c 12190
2d480856 12191if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
50b44ece
PM
12192 # create a view for the files/dirs specified on the command line
12193 set curview 1
a90a6d24 12194 set selectedview 1
50b44ece 12195 set nextviewnum 2
d990cedf 12196 set viewname(1) [mc "Command line"]
50b44ece 12197 set viewfiles(1) $cmdline_files
098dd8a3 12198 set viewargs(1) $revtreeargs
2d480856 12199 set viewargscmd(1) $revtreeargscmd
a90a6d24 12200 set viewperm(1) 0
3ed31a81 12201 set vdatemode(1) 0
da7c24dd 12202 addviewmenu 1
f2d0bbbd
PM
12203 .bar.view entryconf [mca "Edit view..."] -state normal
12204 .bar.view entryconf [mca "Delete view"] -state normal
50b44ece 12205}
a90a6d24
PM
12206
12207if {[info exists permviews]} {
12208 foreach v $permviews {
12209 set n $nextviewnum
12210 incr nextviewnum
12211 set viewname($n) [lindex $v 0]
12212 set viewfiles($n) [lindex $v 1]
098dd8a3 12213 set viewargs($n) [lindex $v 2]
2d480856 12214 set viewargscmd($n) [lindex $v 3]
a90a6d24 12215 set viewperm($n) 1
da7c24dd 12216 addviewmenu $n
a90a6d24
PM
12217 }
12218}
e4df519f
JS
12219
12220if {[tk windowingsystem] eq "win32"} {
12221 focus -force .
12222}
12223
567c34e0 12224getcommits {}
adab0dab
PT
12225
12226# Local variables:
12227# mode: tcl
12228# indent-tabs-mode: t
12229# tab-width: 8
12230# End: