]> git.ipfire.org Git - thirdparty/git.git/blame - gitk-git/gitk
Merge branch 'js/update-index-ignore-removal-for-skip-worktree'
[thirdparty/git.git] / gitk-git / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
9e026d39 3exec wish "$0" -- "$@"
1db95b00 4
fbf42647 5# Copyright © 2005-2016 Paul Mackerras. All rights reserved.
1db95b00
PM
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
d93f1713
PT
10package require Tk
11
74cb884f
MZ
12proc hasworktree {} {
13 return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
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
9403bd02 159 global vinlinediff
ae4e3ff9 160 global worddiff git_version
3ed31a81
PM
161
162 set vdatemode($n) 0
163 set vmergeonly($n) 0
9403bd02 164 set vinlinediff($n) 0
ee66e089
PM
165 set glflags {}
166 set diffargs {}
167 set nextisval 0
168 set revargs {}
169 set origargs $arglist
170 set allknown 1
171 set filtered 0
172 set i -1
173 foreach arg $arglist {
174 incr i
175 if {$nextisval} {
176 lappend glflags $arg
177 set nextisval 0
178 continue
179 }
3ed31a81
PM
180 switch -glob -- $arg {
181 "-d" -
182 "--date-order" {
183 set vdatemode($n) 1
ee66e089
PM
184 # remove from origargs in case we hit an unknown option
185 set origargs [lreplace $origargs $i $i]
186 incr i -1
187 }
ee66e089
PM
188 "-[puabwcrRBMC]" -
189 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
190 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
191 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
192 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
193 "--ignore-space-change" - "-U*" - "--unified=*" {
29582284
PM
194 # These request or affect diff output, which we don't want.
195 # Some could be used to set our defaults for diff display.
ee66e089
PM
196 lappend diffargs $arg
197 }
ee66e089 198 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
ae4e3ff9 199 "--name-only" - "--name-status" - "--color" -
ee66e089
PM
200 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
201 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
202 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
203 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
204 "--objects" - "--objects-edge" - "--reverse" {
29582284
PM
205 # These cause our parsing of git log's output to fail, or else
206 # they're options we want to set ourselves, so ignore them.
ee66e089 207 }
ae4e3ff9
TR
208 "--color-words*" - "--word-diff=color" {
209 # These trigger a word diff in the console interface,
210 # so help the user by enabling our own support
211 if {[package vcompare $git_version "1.7.2"] >= 0} {
212 set worddiff [mc "Color words"]
213 }
214 }
215 "--word-diff*" {
216 if {[package vcompare $git_version "1.7.2"] >= 0} {
217 set worddiff [mc "Markup words"]
218 }
219 }
ee66e089
PM
220 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
221 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
222 "--full-history" - "--dense" - "--sparse" -
223 "--follow" - "--left-right" - "--encoding=*" {
29582284 224 # These are harmless, and some are even useful
ee66e089
PM
225 lappend glflags $arg
226 }
ee66e089
PM
227 "--diff-filter=*" - "--no-merges" - "--unpacked" -
228 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
229 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
230 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
231 "--remove-empty" - "--first-parent" - "--cherry-pick" -
71846c5c 232 "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
f687aaa8 233 "--simplify-by-decoration" {
29582284 234 # These mean that we get a subset of the commits
ee66e089
PM
235 set filtered 1
236 lappend glflags $arg
237 }
ce2c58cd
TR
238 "-L*" {
239 # Line-log with 'stuck' argument (unstuck form is
240 # not supported)
241 set filtered 1
242 set vinlinediff($n) 1
243 set allknown 0
244 lappend glflags $arg
245 }
ee66e089 246 "-n" {
29582284
PM
247 # This appears to be the only one that has a value as a
248 # separate word following it
ee66e089
PM
249 set filtered 1
250 set nextisval 1
251 lappend glflags $arg
252 }
6e7e87c7 253 "--not" - "--all" {
ee66e089 254 lappend revargs $arg
3ed31a81
PM
255 }
256 "--merge" {
257 set vmergeonly($n) 1
ee66e089
PM
258 # git rev-parse doesn't understand --merge
259 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
260 }
c2f2dab9
CC
261 "--no-replace-objects" {
262 set env(GIT_NO_REPLACE_OBJECTS) "1"
263 }
ee66e089 264 "-*" {
29582284 265 # Other flag arguments including -<n>
ee66e089
PM
266 if {[string is digit -strict [string range $arg 1 end]]} {
267 set filtered 1
268 } else {
269 # a flag argument that we don't recognize;
270 # that means we can't optimize
271 set allknown 0
272 }
273 lappend glflags $arg
3ed31a81
PM
274 }
275 default {
29582284 276 # Non-flag arguments specify commits or ranges of commits
ee66e089
PM
277 if {[string match "*...*" $arg]} {
278 lappend revargs --gitk-symmetric-diff-marker
279 }
280 lappend revargs $arg
281 }
282 }
283 }
284 set vdflags($n) $diffargs
285 set vflags($n) $glflags
286 set vrevs($n) $revargs
287 set vfiltered($n) $filtered
288 set vorigargs($n) $origargs
289 return $allknown
290}
291
292proc parseviewrevs {view revs} {
293 global vposids vnegids
294
295 if {$revs eq {}} {
296 set revs HEAD
4d5e1b13
MK
297 } elseif {[lsearch -exact $revs --all] >= 0} {
298 lappend revs HEAD
ee66e089
PM
299 }
300 if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
301 # we get stdout followed by stderr in $err
302 # for an unknown rev, git rev-parse echoes it and then errors out
303 set errlines [split $err "\n"]
304 set badrev {}
305 for {set l 0} {$l < [llength $errlines]} {incr l} {
306 set line [lindex $errlines $l]
307 if {!([string length $line] == 40 && [string is xdigit $line])} {
308 if {[string match "fatal:*" $line]} {
309 if {[string match "fatal: ambiguous argument*" $line]
310 && $badrev ne {}} {
311 if {[llength $badrev] == 1} {
312 set err "unknown revision $badrev"
313 } else {
314 set err "unknown revisions: [join $badrev ", "]"
315 }
316 } else {
317 set err [join [lrange $errlines $l end] "\n"]
318 }
319 break
320 }
321 lappend badrev $line
322 }
d93f1713 323 }
3945d2c0 324 error_popup "[mc "Error parsing revisions:"] $err"
ee66e089
PM
325 return {}
326 }
327 set ret {}
328 set pos {}
329 set neg {}
330 set sdm 0
331 foreach id [split $ids "\n"] {
332 if {$id eq "--gitk-symmetric-diff-marker"} {
333 set sdm 4
334 } elseif {[string match "^*" $id]} {
335 if {$sdm != 1} {
336 lappend ret $id
337 if {$sdm == 3} {
338 set sdm 0
339 }
340 }
341 lappend neg [string range $id 1 end]
342 } else {
343 if {$sdm != 2} {
344 lappend ret $id
345 } else {
2b1fbf90 346 lset ret end $id...[lindex $ret end]
3ed31a81 347 }
ee66e089 348 lappend pos $id
3ed31a81 349 }
ee66e089 350 incr sdm -1
3ed31a81 351 }
ee66e089
PM
352 set vposids($view) $pos
353 set vnegids($view) $neg
354 return $ret
3ed31a81
PM
355}
356
f9e0b6fb 357# Start off a git log process and arrange to read its output
da7c24dd 358proc start_rev_list {view} {
6df7403a 359 global startmsecs commitidx viewcomplete curview
e439e092 360 global tclencoding
ee66e089 361 global viewargs viewargscmd viewfiles vfilelimit
d375ef9b 362 global showlocalchanges
e439e092 363 global viewactive viewinstances vmergeonly
cdc8429c 364 global mainheadid viewmainheadid viewmainheadid_orig
ee66e089 365 global vcanopt vflags vrevs vorigargs
7defefb1 366 global show_notes
9ccbdfbf 367
9ccbdfbf 368 set startmsecs [clock clicks -milliseconds]
da7c24dd 369 set commitidx($view) 0
3ed31a81
PM
370 # these are set this way for the error exits
371 set viewcomplete($view) 1
372 set viewactive($view) 0
7fcc92bf
PM
373 varcinit $view
374
2d480856
YD
375 set args $viewargs($view)
376 if {$viewargscmd($view) ne {}} {
377 if {[catch {
378 set str [exec sh -c $viewargscmd($view)]
379 } err]} {
3945d2c0 380 error_popup "[mc "Error executing --argscmd command:"] $err"
3ed31a81 381 return 0
2d480856
YD
382 }
383 set args [concat $args [split $str "\n"]]
384 }
ee66e089 385 set vcanopt($view) [parseviewargs $view $args]
3ed31a81
PM
386
387 set files $viewfiles($view)
388 if {$vmergeonly($view)} {
389 set files [unmerged_files $files]
390 if {$files eq {}} {
391 global nr_unmerged
392 if {$nr_unmerged == 0} {
393 error_popup [mc "No files selected: --merge specified but\
394 no files are unmerged."]
395 } else {
396 error_popup [mc "No files selected: --merge specified but\
397 no unmerged files are within file limit."]
398 }
399 return 0
400 }
401 }
402 set vfilelimit($view) $files
403
ee66e089
PM
404 if {$vcanopt($view)} {
405 set revs [parseviewrevs $view $vrevs($view)]
406 if {$revs eq {}} {
407 return 0
408 }
409 set args [concat $vflags($view) $revs]
410 } else {
411 set args $vorigargs($view)
412 }
413
418c4c7b 414 if {[catch {
7defefb1
KS
415 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
416 --parents --boundary $args "--" $files] r]
418c4c7b 417 } err]} {
00abadb9 418 error_popup "[mc "Error executing git log:"] $err"
3ed31a81 419 return 0
1d10f36d 420 }
e439e092 421 set i [reg_instance $fd]
7fcc92bf 422 set viewinstances($view) [list $i]
cdc8429c
PM
423 set viewmainheadid($view) $mainheadid
424 set viewmainheadid_orig($view) $mainheadid
425 if {$files ne {} && $mainheadid ne {}} {
426 get_viewmainhead $view
427 }
428 if {$showlocalchanges && $viewmainheadid($view) ne {}} {
429 interestedin $viewmainheadid($view) dodiffindex
3e6b893f 430 }
86da5b6c 431 fconfigure $fd -blocking 0 -translation lf -eofchar {}
fd8ccbec 432 if {$tclencoding != {}} {
da7c24dd 433 fconfigure $fd -encoding $tclencoding
fd8ccbec 434 }
f806f0fb 435 filerun $fd [list getcommitlines $fd $i $view 0]
d990cedf 436 nowbusy $view [mc "Reading"]
3ed31a81
PM
437 set viewcomplete($view) 0
438 set viewactive($view) 1
439 return 1
38ad0910
PM
440}
441
e2f90ee4
AG
442proc stop_instance {inst} {
443 global commfd leftover
444
445 set fd $commfd($inst)
446 catch {
447 set pid [pid $fd]
b6326e92
AG
448
449 if {$::tcl_platform(platform) eq {windows}} {
7b68b0ee 450 exec taskkill /pid $pid
b6326e92
AG
451 } else {
452 exec kill $pid
453 }
e2f90ee4
AG
454 }
455 catch {close $fd}
456 nukefile $fd
457 unset commfd($inst)
458 unset leftover($inst)
459}
460
461proc stop_backends {} {
462 global commfd
463
464 foreach inst [array names commfd] {
465 stop_instance $inst
466 }
467}
468
7fcc92bf 469proc stop_rev_list {view} {
e2f90ee4 470 global viewinstances
22626ef4 471
7fcc92bf 472 foreach inst $viewinstances($view) {
e2f90ee4 473 stop_instance $inst
22626ef4 474 }
7fcc92bf 475 set viewinstances($view) {}
22626ef4
PM
476}
477
567c34e0 478proc reset_pending_select {selid} {
39816d60 479 global pending_select mainheadid selectheadid
567c34e0
AG
480
481 if {$selid ne {}} {
482 set pending_select $selid
39816d60
AG
483 } elseif {$selectheadid ne {}} {
484 set pending_select $selectheadid
567c34e0
AG
485 } else {
486 set pending_select $mainheadid
487 }
488}
489
490proc getcommits {selid} {
3ed31a81 491 global canv curview need_redisplay viewactive
38ad0910 492
da7c24dd 493 initlayout
3ed31a81 494 if {[start_rev_list $curview]} {
567c34e0 495 reset_pending_select $selid
3ed31a81
PM
496 show_status [mc "Reading commits..."]
497 set need_redisplay 1
498 } else {
499 show_status [mc "No commits selected"]
500 }
1d10f36d
PM
501}
502
7fcc92bf 503proc updatecommits {} {
ee66e089 504 global curview vcanopt vorigargs vfilelimit viewinstances
e439e092
AG
505 global viewactive viewcomplete tclencoding
506 global startmsecs showneartags showlocalchanges
cdc8429c 507 global mainheadid viewmainheadid viewmainheadid_orig pending_select
74cb884f 508 global hasworktree
ee66e089 509 global varcid vposids vnegids vflags vrevs
7defefb1 510 global show_notes
7fcc92bf 511
74cb884f 512 set hasworktree [hasworktree]
fc2a256f 513 rereadrefs
cdc8429c
PM
514 set view $curview
515 if {$mainheadid ne $viewmainheadid_orig($view)} {
516 if {$showlocalchanges} {
eb5f8c9c
PM
517 dohidelocalchanges
518 }
cdc8429c
PM
519 set viewmainheadid($view) $mainheadid
520 set viewmainheadid_orig($view) $mainheadid
521 if {$vfilelimit($view) ne {}} {
522 get_viewmainhead $view
eb5f8c9c
PM
523 }
524 }
cdc8429c
PM
525 if {$showlocalchanges} {
526 doshowlocalchanges
527 }
ee66e089
PM
528 if {$vcanopt($view)} {
529 set oldpos $vposids($view)
530 set oldneg $vnegids($view)
531 set revs [parseviewrevs $view $vrevs($view)]
532 if {$revs eq {}} {
533 return
534 }
535 # note: getting the delta when negative refs change is hard,
536 # and could require multiple git log invocations, so in that
537 # case we ask git log for all the commits (not just the delta)
538 if {$oldneg eq $vnegids($view)} {
539 set newrevs {}
540 set npos 0
541 # take out positive refs that we asked for before or
542 # that we have already seen
543 foreach rev $revs {
544 if {[string length $rev] == 40} {
545 if {[lsearch -exact $oldpos $rev] < 0
546 && ![info exists varcid($view,$rev)]} {
547 lappend newrevs $rev
548 incr npos
549 }
550 } else {
551 lappend $newrevs $rev
552 }
553 }
554 if {$npos == 0} return
555 set revs $newrevs
556 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
557 }
558 set args [concat $vflags($view) $revs --not $oldpos]
559 } else {
560 set args $vorigargs($view)
561 }
7fcc92bf 562 if {[catch {
7defefb1
KS
563 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
564 --parents --boundary $args "--" $vfilelimit($view)] r]
7fcc92bf 565 } err]} {
3945d2c0 566 error_popup "[mc "Error executing git log:"] $err"
ee66e089 567 return
7fcc92bf
PM
568 }
569 if {$viewactive($view) == 0} {
570 set startmsecs [clock clicks -milliseconds]
571 }
e439e092 572 set i [reg_instance $fd]
7fcc92bf 573 lappend viewinstances($view) $i
7fcc92bf
PM
574 fconfigure $fd -blocking 0 -translation lf -eofchar {}
575 if {$tclencoding != {}} {
576 fconfigure $fd -encoding $tclencoding
577 }
f806f0fb 578 filerun $fd [list getcommitlines $fd $i $view 1]
7fcc92bf
PM
579 incr viewactive($view)
580 set viewcomplete($view) 0
567c34e0 581 reset_pending_select {}
b56e0a9a 582 nowbusy $view [mc "Reading"]
7fcc92bf
PM
583 if {$showneartags} {
584 getallcommits
585 }
586}
587
588proc reloadcommits {} {
589 global curview viewcomplete selectedline currentid thickerline
590 global showneartags treediffs commitinterest cached_commitrow
18ae9120 591 global targetid commitinfo
7fcc92bf 592
567c34e0
AG
593 set selid {}
594 if {$selectedline ne {}} {
595 set selid $currentid
596 }
597
7fcc92bf
PM
598 if {!$viewcomplete($curview)} {
599 stop_rev_list $curview
7fcc92bf
PM
600 }
601 resetvarcs $curview
94b4a69f 602 set selectedline {}
009409fe
PM
603 unset -nocomplain currentid
604 unset -nocomplain thickerline
605 unset -nocomplain treediffs
7fcc92bf
PM
606 readrefs
607 changedrefs
608 if {$showneartags} {
609 getallcommits
610 }
611 clear_display
18ae9120 612 unset -nocomplain commitinfo
009409fe
PM
613 unset -nocomplain commitinterest
614 unset -nocomplain cached_commitrow
615 unset -nocomplain targetid
7fcc92bf 616 setcanvscroll
567c34e0 617 getcommits $selid
e7297a1c 618 return 0
7fcc92bf
PM
619}
620
6e8c8707
PM
621# This makes a string representation of a positive integer which
622# sorts as a string in numerical order
623proc strrep {n} {
624 if {$n < 16} {
625 return [format "%x" $n]
626 } elseif {$n < 256} {
627 return [format "x%.2x" $n]
628 } elseif {$n < 65536} {
629 return [format "y%.4x" $n]
630 }
631 return [format "z%.8x" $n]
632}
633
7fcc92bf
PM
634# Procedures used in reordering commits from git log (without
635# --topo-order) into the order for display.
636
637proc varcinit {view} {
f3ea5ede
PM
638 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
639 global vtokmod varcmod vrowmod varcix vlastins
7fcc92bf 640
7fcc92bf
PM
641 set varcstart($view) {{}}
642 set vupptr($view) {0}
643 set vdownptr($view) {0}
644 set vleftptr($view) {0}
f3ea5ede 645 set vbackptr($view) {0}
7fcc92bf
PM
646 set varctok($view) {{}}
647 set varcrow($view) {{}}
648 set vtokmod($view) {}
649 set varcmod($view) 0
e5b37ac1 650 set vrowmod($view) 0
7fcc92bf 651 set varcix($view) {{}}
f3ea5ede 652 set vlastins($view) {0}
7fcc92bf
PM
653}
654
655proc resetvarcs {view} {
656 global varcid varccommits parents children vseedcount ordertok
22387f23 657 global vshortids
7fcc92bf
PM
658
659 foreach vid [array names varcid $view,*] {
660 unset varcid($vid)
661 unset children($vid)
662 unset parents($vid)
663 }
22387f23
PM
664 foreach vid [array names vshortids $view,*] {
665 unset vshortids($vid)
666 }
7fcc92bf
PM
667 # some commits might have children but haven't been seen yet
668 foreach vid [array names children $view,*] {
669 unset children($vid)
670 }
671 foreach va [array names varccommits $view,*] {
672 unset varccommits($va)
673 }
674 foreach vd [array names vseedcount $view,*] {
675 unset vseedcount($vd)
676 }
009409fe 677 unset -nocomplain ordertok
7fcc92bf
PM
678}
679
468bcaed
PM
680# returns a list of the commits with no children
681proc seeds {v} {
682 global vdownptr vleftptr varcstart
683
684 set ret {}
685 set a [lindex $vdownptr($v) 0]
686 while {$a != 0} {
687 lappend ret [lindex $varcstart($v) $a]
688 set a [lindex $vleftptr($v) $a]
689 }
690 return $ret
691}
692
7fcc92bf 693proc newvarc {view id} {
3ed31a81 694 global varcid varctok parents children vdatemode
f3ea5ede
PM
695 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
696 global commitdata commitinfo vseedcount varccommits vlastins
7fcc92bf
PM
697
698 set a [llength $varctok($view)]
699 set vid $view,$id
3ed31a81 700 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
7fcc92bf
PM
701 if {![info exists commitinfo($id)]} {
702 parsecommit $id $commitdata($id) 1
703 }
f5974d97 704 set cdate [lindex [lindex $commitinfo($id) 4] 0]
7fcc92bf
PM
705 if {![string is integer -strict $cdate]} {
706 set cdate 0
707 }
708 if {![info exists vseedcount($view,$cdate)]} {
709 set vseedcount($view,$cdate) -1
710 }
711 set c [incr vseedcount($view,$cdate)]
712 set cdate [expr {$cdate ^ 0xffffffff}]
713 set tok "s[strrep $cdate][strrep $c]"
7fcc92bf
PM
714 } else {
715 set tok {}
f3ea5ede
PM
716 }
717 set ka 0
718 if {[llength $children($vid)] > 0} {
719 set kid [lindex $children($vid) end]
720 set k $varcid($view,$kid)
721 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
722 set ki $kid
723 set ka $k
724 set tok [lindex $varctok($view) $k]
7fcc92bf 725 }
f3ea5ede
PM
726 }
727 if {$ka != 0} {
7fcc92bf
PM
728 set i [lsearch -exact $parents($view,$ki) $id]
729 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
7fcc92bf
PM
730 append tok [strrep $j]
731 }
f3ea5ede
PM
732 set c [lindex $vlastins($view) $ka]
733 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
734 set c $ka
735 set b [lindex $vdownptr($view) $ka]
736 } else {
737 set b [lindex $vleftptr($view) $c]
738 }
739 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
740 set c $b
741 set b [lindex $vleftptr($view) $c]
742 }
743 if {$c == $ka} {
744 lset vdownptr($view) $ka $a
745 lappend vbackptr($view) 0
746 } else {
747 lset vleftptr($view) $c $a
748 lappend vbackptr($view) $c
749 }
750 lset vlastins($view) $ka $a
751 lappend vupptr($view) $ka
752 lappend vleftptr($view) $b
753 if {$b != 0} {
754 lset vbackptr($view) $b $a
755 }
7fcc92bf
PM
756 lappend varctok($view) $tok
757 lappend varcstart($view) $id
758 lappend vdownptr($view) 0
759 lappend varcrow($view) {}
760 lappend varcix($view) {}
e5b37ac1 761 set varccommits($view,$a) {}
f3ea5ede 762 lappend vlastins($view) 0
7fcc92bf
PM
763 return $a
764}
765
766proc splitvarc {p v} {
52b8ea93 767 global varcid varcstart varccommits varctok vtokmod
f3ea5ede 768 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
7fcc92bf
PM
769
770 set oa $varcid($v,$p)
52b8ea93 771 set otok [lindex $varctok($v) $oa]
7fcc92bf
PM
772 set ac $varccommits($v,$oa)
773 set i [lsearch -exact $varccommits($v,$oa) $p]
774 if {$i <= 0} return
775 set na [llength $varctok($v)]
776 # "%" sorts before "0"...
52b8ea93 777 set tok "$otok%[strrep $i]"
7fcc92bf
PM
778 lappend varctok($v) $tok
779 lappend varcrow($v) {}
780 lappend varcix($v) {}
781 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
782 set varccommits($v,$na) [lrange $ac $i end]
783 lappend varcstart($v) $p
784 foreach id $varccommits($v,$na) {
785 set varcid($v,$id) $na
786 }
787 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
841ea824 788 lappend vlastins($v) [lindex $vlastins($v) $oa]
7fcc92bf 789 lset vdownptr($v) $oa $na
841ea824 790 lset vlastins($v) $oa 0
7fcc92bf
PM
791 lappend vupptr($v) $oa
792 lappend vleftptr($v) 0
f3ea5ede 793 lappend vbackptr($v) 0
7fcc92bf
PM
794 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
795 lset vupptr($v) $b $na
796 }
52b8ea93
PM
797 if {[string compare $otok $vtokmod($v)] <= 0} {
798 modify_arc $v $oa
799 }
7fcc92bf
PM
800}
801
802proc renumbervarc {a v} {
803 global parents children varctok varcstart varccommits
3ed31a81 804 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
7fcc92bf
PM
805
806 set t1 [clock clicks -milliseconds]
807 set todo {}
808 set isrelated($a) 1
f3ea5ede 809 set kidchanged($a) 1
7fcc92bf
PM
810 set ntot 0
811 while {$a != 0} {
812 if {[info exists isrelated($a)]} {
813 lappend todo $a
814 set id [lindex $varccommits($v,$a) end]
815 foreach p $parents($v,$id) {
816 if {[info exists varcid($v,$p)]} {
817 set isrelated($varcid($v,$p)) 1
818 }
819 }
820 }
821 incr ntot
822 set b [lindex $vdownptr($v) $a]
823 if {$b == 0} {
824 while {$a != 0} {
825 set b [lindex $vleftptr($v) $a]
826 if {$b != 0} break
827 set a [lindex $vupptr($v) $a]
828 }
829 }
830 set a $b
831 }
832 foreach a $todo {
f3ea5ede 833 if {![info exists kidchanged($a)]} continue
7fcc92bf 834 set id [lindex $varcstart($v) $a]
f3ea5ede
PM
835 if {[llength $children($v,$id)] > 1} {
836 set children($v,$id) [lsort -command [list vtokcmp $v] \
837 $children($v,$id)]
838 }
839 set oldtok [lindex $varctok($v) $a]
3ed31a81 840 if {!$vdatemode($v)} {
f3ea5ede
PM
841 set tok {}
842 } else {
843 set tok $oldtok
844 }
845 set ka 0
c8c9f3d9
PM
846 set kid [last_real_child $v,$id]
847 if {$kid ne {}} {
f3ea5ede
PM
848 set k $varcid($v,$kid)
849 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
850 set ki $kid
851 set ka $k
852 set tok [lindex $varctok($v) $k]
7fcc92bf
PM
853 }
854 }
f3ea5ede 855 if {$ka != 0} {
7fcc92bf
PM
856 set i [lsearch -exact $parents($v,$ki) $id]
857 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
858 append tok [strrep $j]
7fcc92bf 859 }
f3ea5ede
PM
860 if {$tok eq $oldtok} {
861 continue
862 }
863 set id [lindex $varccommits($v,$a) end]
864 foreach p $parents($v,$id) {
865 if {[info exists varcid($v,$p)]} {
866 set kidchanged($varcid($v,$p)) 1
867 } else {
868 set sortkids($p) 1
869 }
870 }
871 lset varctok($v) $a $tok
7fcc92bf
PM
872 set b [lindex $vupptr($v) $a]
873 if {$b != $ka} {
9257d8f7
PM
874 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
875 modify_arc $v $ka
38dfe939 876 }
9257d8f7
PM
877 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
878 modify_arc $v $b
38dfe939 879 }
f3ea5ede
PM
880 set c [lindex $vbackptr($v) $a]
881 set d [lindex $vleftptr($v) $a]
882 if {$c == 0} {
883 lset vdownptr($v) $b $d
7fcc92bf 884 } else {
f3ea5ede
PM
885 lset vleftptr($v) $c $d
886 }
887 if {$d != 0} {
888 lset vbackptr($v) $d $c
7fcc92bf 889 }
841ea824
PM
890 if {[lindex $vlastins($v) $b] == $a} {
891 lset vlastins($v) $b $c
892 }
7fcc92bf 893 lset vupptr($v) $a $ka
f3ea5ede
PM
894 set c [lindex $vlastins($v) $ka]
895 if {$c == 0 || \
896 [string compare $tok [lindex $varctok($v) $c]] < 0} {
897 set c $ka
898 set b [lindex $vdownptr($v) $ka]
899 } else {
900 set b [lindex $vleftptr($v) $c]
901 }
902 while {$b != 0 && \
903 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
904 set c $b
905 set b [lindex $vleftptr($v) $c]
7fcc92bf 906 }
f3ea5ede
PM
907 if {$c == $ka} {
908 lset vdownptr($v) $ka $a
909 lset vbackptr($v) $a 0
910 } else {
911 lset vleftptr($v) $c $a
912 lset vbackptr($v) $a $c
7fcc92bf 913 }
f3ea5ede
PM
914 lset vleftptr($v) $a $b
915 if {$b != 0} {
916 lset vbackptr($v) $b $a
917 }
918 lset vlastins($v) $ka $a
919 }
920 }
921 foreach id [array names sortkids] {
922 if {[llength $children($v,$id)] > 1} {
923 set children($v,$id) [lsort -command [list vtokcmp $v] \
924 $children($v,$id)]
7fcc92bf
PM
925 }
926 }
927 set t2 [clock clicks -milliseconds]
928 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
929}
930
f806f0fb
PM
931# Fix up the graph after we have found out that in view $v,
932# $p (a commit that we have already seen) is actually the parent
933# of the last commit in arc $a.
7fcc92bf 934proc fix_reversal {p a v} {
24f7a667 935 global varcid varcstart varctok vupptr
7fcc92bf
PM
936
937 set pa $varcid($v,$p)
938 if {$p ne [lindex $varcstart($v) $pa]} {
939 splitvarc $p $v
940 set pa $varcid($v,$p)
941 }
24f7a667
PM
942 # seeds always need to be renumbered
943 if {[lindex $vupptr($v) $pa] == 0 ||
944 [string compare [lindex $varctok($v) $a] \
945 [lindex $varctok($v) $pa]] > 0} {
7fcc92bf
PM
946 renumbervarc $pa $v
947 }
948}
949
950proc insertrow {id p v} {
b8a938cf
PM
951 global cmitlisted children parents varcid varctok vtokmod
952 global varccommits ordertok commitidx numcommits curview
22387f23 953 global targetid targetrow vshortids
b8a938cf
PM
954
955 readcommit $id
956 set vid $v,$id
957 set cmitlisted($vid) 1
958 set children($vid) {}
959 set parents($vid) [list $p]
960 set a [newvarc $v $id]
961 set varcid($vid) $a
22387f23 962 lappend vshortids($v,[string range $id 0 3]) $id
b8a938cf
PM
963 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
964 modify_arc $v $a
965 }
966 lappend varccommits($v,$a) $id
967 set vp $v,$p
968 if {[llength [lappend children($vp) $id]] > 1} {
969 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
009409fe 970 unset -nocomplain ordertok
b8a938cf
PM
971 }
972 fix_reversal $p $a $v
973 incr commitidx($v)
974 if {$v == $curview} {
975 set numcommits $commitidx($v)
976 setcanvscroll
977 if {[info exists targetid]} {
978 if {![comes_before $targetid $p]} {
979 incr targetrow
980 }
981 }
982 }
983}
984
985proc insertfakerow {id p} {
9257d8f7 986 global varcid varccommits parents children cmitlisted
b8a938cf 987 global commitidx varctok vtokmod targetid targetrow curview numcommits
7fcc92bf 988
b8a938cf 989 set v $curview
7fcc92bf
PM
990 set a $varcid($v,$p)
991 set i [lsearch -exact $varccommits($v,$a) $p]
992 if {$i < 0} {
b8a938cf 993 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
7fcc92bf
PM
994 return
995 }
996 set children($v,$id) {}
997 set parents($v,$id) [list $p]
998 set varcid($v,$id) $a
9257d8f7 999 lappend children($v,$p) $id
7fcc92bf 1000 set cmitlisted($v,$id) 1
b8a938cf 1001 set numcommits [incr commitidx($v)]
7fcc92bf
PM
1002 # note we deliberately don't update varcstart($v) even if $i == 0
1003 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
c9cfdc96 1004 modify_arc $v $a $i
42a671fc
PM
1005 if {[info exists targetid]} {
1006 if {![comes_before $targetid $p]} {
1007 incr targetrow
1008 }
1009 }
b8a938cf 1010 setcanvscroll
9257d8f7 1011 drawvisible
7fcc92bf
PM
1012}
1013
b8a938cf 1014proc removefakerow {id} {
9257d8f7 1015 global varcid varccommits parents children commitidx
fc2a256f 1016 global varctok vtokmod cmitlisted currentid selectedline
b8a938cf 1017 global targetid curview numcommits
7fcc92bf 1018
b8a938cf 1019 set v $curview
7fcc92bf 1020 if {[llength $parents($v,$id)] != 1} {
b8a938cf 1021 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
7fcc92bf
PM
1022 return
1023 }
1024 set p [lindex $parents($v,$id) 0]
1025 set a $varcid($v,$id)
1026 set i [lsearch -exact $varccommits($v,$a) $id]
1027 if {$i < 0} {
b8a938cf 1028 puts "oops: removefakerow can't find [shortids $id] on arc $a"
7fcc92bf
PM
1029 return
1030 }
1031 unset varcid($v,$id)
1032 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1033 unset parents($v,$id)
1034 unset children($v,$id)
1035 unset cmitlisted($v,$id)
b8a938cf 1036 set numcommits [incr commitidx($v) -1]
7fcc92bf
PM
1037 set j [lsearch -exact $children($v,$p) $id]
1038 if {$j >= 0} {
1039 set children($v,$p) [lreplace $children($v,$p) $j $j]
1040 }
c9cfdc96 1041 modify_arc $v $a $i
fc2a256f
PM
1042 if {[info exist currentid] && $id eq $currentid} {
1043 unset currentid
94b4a69f 1044 set selectedline {}
fc2a256f 1045 }
42a671fc
PM
1046 if {[info exists targetid] && $targetid eq $id} {
1047 set targetid $p
1048 }
b8a938cf 1049 setcanvscroll
9257d8f7 1050 drawvisible
7fcc92bf
PM
1051}
1052
aa43561a
PM
1053proc real_children {vp} {
1054 global children nullid nullid2
1055
1056 set kids {}
1057 foreach id $children($vp) {
1058 if {$id ne $nullid && $id ne $nullid2} {
1059 lappend kids $id
1060 }
1061 }
1062 return $kids
1063}
1064
c8c9f3d9
PM
1065proc first_real_child {vp} {
1066 global children nullid nullid2
1067
1068 foreach id $children($vp) {
1069 if {$id ne $nullid && $id ne $nullid2} {
1070 return $id
1071 }
1072 }
1073 return {}
1074}
1075
1076proc last_real_child {vp} {
1077 global children nullid nullid2
1078
1079 set kids $children($vp)
1080 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1081 set id [lindex $kids $i]
1082 if {$id ne $nullid && $id ne $nullid2} {
1083 return $id
1084 }
1085 }
1086 return {}
1087}
1088
7fcc92bf
PM
1089proc vtokcmp {v a b} {
1090 global varctok varcid
1091
1092 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1093 [lindex $varctok($v) $varcid($v,$b)]]
1094}
1095
c9cfdc96
PM
1096# This assumes that if lim is not given, the caller has checked that
1097# arc a's token is less than $vtokmod($v)
e5b37ac1
PM
1098proc modify_arc {v a {lim {}}} {
1099 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
9257d8f7 1100
c9cfdc96
PM
1101 if {$lim ne {}} {
1102 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1103 if {$c > 0} return
1104 if {$c == 0} {
1105 set r [lindex $varcrow($v) $a]
1106 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1107 }
1108 }
9257d8f7
PM
1109 set vtokmod($v) [lindex $varctok($v) $a]
1110 set varcmod($v) $a
1111 if {$v == $curview} {
1112 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1113 set a [lindex $vupptr($v) $a]
e5b37ac1 1114 set lim {}
9257d8f7 1115 }
e5b37ac1
PM
1116 set r 0
1117 if {$a != 0} {
1118 if {$lim eq {}} {
1119 set lim [llength $varccommits($v,$a)]
1120 }
1121 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1122 }
1123 set vrowmod($v) $r
0c27886e 1124 undolayout $r
9257d8f7
PM
1125 }
1126}
1127
7fcc92bf 1128proc update_arcrows {v} {
e5b37ac1 1129 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
24f7a667 1130 global varcid vrownum varcorder varcix varccommits
7fcc92bf 1131 global vupptr vdownptr vleftptr varctok
24f7a667 1132 global displayorder parentlist curview cached_commitrow
7fcc92bf 1133
c9cfdc96
PM
1134 if {$vrowmod($v) == $commitidx($v)} return
1135 if {$v == $curview} {
1136 if {[llength $displayorder] > $vrowmod($v)} {
1137 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1138 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1139 }
009409fe 1140 unset -nocomplain cached_commitrow
c9cfdc96 1141 }
7fcc92bf
PM
1142 set narctot [expr {[llength $varctok($v)] - 1}]
1143 set a $varcmod($v)
1144 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1145 # go up the tree until we find something that has a row number,
1146 # or we get to a seed
1147 set a [lindex $vupptr($v) $a]
1148 }
1149 if {$a == 0} {
1150 set a [lindex $vdownptr($v) 0]
1151 if {$a == 0} return
1152 set vrownum($v) {0}
1153 set varcorder($v) [list $a]
1154 lset varcix($v) $a 0
1155 lset varcrow($v) $a 0
1156 set arcn 0
1157 set row 0
1158 } else {
1159 set arcn [lindex $varcix($v) $a]
7fcc92bf
PM
1160 if {[llength $vrownum($v)] > $arcn + 1} {
1161 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1162 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1163 }
1164 set row [lindex $varcrow($v) $a]
1165 }
7fcc92bf
PM
1166 while {1} {
1167 set p $a
1168 incr row [llength $varccommits($v,$a)]
1169 # go down if possible
1170 set b [lindex $vdownptr($v) $a]
1171 if {$b == 0} {
1172 # if not, go left, or go up until we can go left
1173 while {$a != 0} {
1174 set b [lindex $vleftptr($v) $a]
1175 if {$b != 0} break
1176 set a [lindex $vupptr($v) $a]
1177 }
1178 if {$a == 0} break
1179 }
1180 set a $b
1181 incr arcn
1182 lappend vrownum($v) $row
1183 lappend varcorder($v) $a
1184 lset varcix($v) $a $arcn
1185 lset varcrow($v) $a $row
1186 }
e5b37ac1
PM
1187 set vtokmod($v) [lindex $varctok($v) $p]
1188 set varcmod($v) $p
1189 set vrowmod($v) $row
7fcc92bf
PM
1190 if {[info exists currentid]} {
1191 set selectedline [rowofcommit $currentid]
1192 }
7fcc92bf
PM
1193}
1194
1195# Test whether view $v contains commit $id
1196proc commitinview {id v} {
1197 global varcid
1198
1199 return [info exists varcid($v,$id)]
1200}
1201
1202# Return the row number for commit $id in the current view
1203proc rowofcommit {id} {
1204 global varcid varccommits varcrow curview cached_commitrow
9257d8f7 1205 global varctok vtokmod
7fcc92bf 1206
7fcc92bf
PM
1207 set v $curview
1208 if {![info exists varcid($v,$id)]} {
1209 puts "oops rowofcommit no arc for [shortids $id]"
1210 return {}
1211 }
1212 set a $varcid($v,$id)
fc2a256f 1213 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
9257d8f7
PM
1214 update_arcrows $v
1215 }
31c0eaa8
PM
1216 if {[info exists cached_commitrow($id)]} {
1217 return $cached_commitrow($id)
1218 }
7fcc92bf
PM
1219 set i [lsearch -exact $varccommits($v,$a) $id]
1220 if {$i < 0} {
1221 puts "oops didn't find commit [shortids $id] in arc $a"
1222 return {}
1223 }
1224 incr i [lindex $varcrow($v) $a]
1225 set cached_commitrow($id) $i
1226 return $i
1227}
1228
42a671fc
PM
1229# Returns 1 if a is on an earlier row than b, otherwise 0
1230proc comes_before {a b} {
1231 global varcid varctok curview
1232
1233 set v $curview
1234 if {$a eq $b || ![info exists varcid($v,$a)] || \
1235 ![info exists varcid($v,$b)]} {
1236 return 0
1237 }
1238 if {$varcid($v,$a) != $varcid($v,$b)} {
1239 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1240 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1241 }
1242 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1243}
1244
7fcc92bf
PM
1245proc bsearch {l elt} {
1246 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1247 return 0
1248 }
1249 set lo 0
1250 set hi [llength $l]
1251 while {$hi - $lo > 1} {
1252 set mid [expr {int(($lo + $hi) / 2)}]
1253 set t [lindex $l $mid]
1254 if {$elt < $t} {
1255 set hi $mid
1256 } elseif {$elt > $t} {
1257 set lo $mid
1258 } else {
1259 return $mid
1260 }
1261 }
1262 return $lo
1263}
1264
1265# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1266proc make_disporder {start end} {
1267 global vrownum curview commitidx displayorder parentlist
e5b37ac1 1268 global varccommits varcorder parents vrowmod varcrow
7fcc92bf
PM
1269 global d_valid_start d_valid_end
1270
e5b37ac1 1271 if {$end > $vrowmod($curview)} {
9257d8f7
PM
1272 update_arcrows $curview
1273 }
7fcc92bf
PM
1274 set ai [bsearch $vrownum($curview) $start]
1275 set start [lindex $vrownum($curview) $ai]
1276 set narc [llength $vrownum($curview)]
1277 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1278 set a [lindex $varcorder($curview) $ai]
1279 set l [llength $displayorder]
1280 set al [llength $varccommits($curview,$a)]
1281 if {$l < $r + $al} {
1282 if {$l < $r} {
1283 set pad [ntimes [expr {$r - $l}] {}]
1284 set displayorder [concat $displayorder $pad]
1285 set parentlist [concat $parentlist $pad]
1286 } elseif {$l > $r} {
1287 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1288 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1289 }
1290 foreach id $varccommits($curview,$a) {
1291 lappend displayorder $id
1292 lappend parentlist $parents($curview,$id)
1293 }
17529cf9 1294 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
7fcc92bf
PM
1295 set i $r
1296 foreach id $varccommits($curview,$a) {
1297 lset displayorder $i $id
1298 lset parentlist $i $parents($curview,$id)
1299 incr i
1300 }
1301 }
1302 incr r $al
1303 }
1304}
1305
1306proc commitonrow {row} {
1307 global displayorder
1308
1309 set id [lindex $displayorder $row]
1310 if {$id eq {}} {
1311 make_disporder $row [expr {$row + 1}]
1312 set id [lindex $displayorder $row]
1313 }
1314 return $id
1315}
1316
1317proc closevarcs {v} {
1318 global varctok varccommits varcid parents children
d92aa570 1319 global cmitlisted commitidx vtokmod curview numcommits
7fcc92bf
PM
1320
1321 set missing_parents 0
1322 set scripts {}
1323 set narcs [llength $varctok($v)]
1324 for {set a 1} {$a < $narcs} {incr a} {
1325 set id [lindex $varccommits($v,$a) end]
1326 foreach p $parents($v,$id) {
1327 if {[info exists varcid($v,$p)]} continue
1328 # add p as a new commit
1329 incr missing_parents
1330 set cmitlisted($v,$p) 0
1331 set parents($v,$p) {}
1332 if {[llength $children($v,$p)] == 1 &&
1333 [llength $parents($v,$id)] == 1} {
1334 set b $a
1335 } else {
1336 set b [newvarc $v $p]
1337 }
1338 set varcid($v,$p) $b
9257d8f7
PM
1339 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1340 modify_arc $v $b
7fcc92bf 1341 }
e5b37ac1 1342 lappend varccommits($v,$b) $p
7fcc92bf 1343 incr commitidx($v)
d92aa570
SD
1344 if {$v == $curview} {
1345 set numcommits $commitidx($v)
1346 }
d375ef9b 1347 set scripts [check_interest $p $scripts]
7fcc92bf
PM
1348 }
1349 }
1350 if {$missing_parents > 0} {
7fcc92bf
PM
1351 foreach s $scripts {
1352 eval $s
1353 }
1354 }
1355}
1356
f806f0fb
PM
1357# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1358# Assumes we already have an arc for $rwid.
1359proc rewrite_commit {v id rwid} {
1360 global children parents varcid varctok vtokmod varccommits
1361
1362 foreach ch $children($v,$id) {
1363 # make $rwid be $ch's parent in place of $id
1364 set i [lsearch -exact $parents($v,$ch) $id]
1365 if {$i < 0} {
1366 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1367 }
1368 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1369 # add $ch to $rwid's children and sort the list if necessary
1370 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1371 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1372 $children($v,$rwid)]
1373 }
1374 # fix the graph after joining $id to $rwid
1375 set a $varcid($v,$ch)
1376 fix_reversal $rwid $a $v
c9cfdc96
PM
1377 # parentlist is wrong for the last element of arc $a
1378 # even if displayorder is right, hence the 3rd arg here
1379 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
f806f0fb
PM
1380 }
1381}
1382
d375ef9b
PM
1383# Mechanism for registering a command to be executed when we come
1384# across a particular commit. To handle the case when only the
1385# prefix of the commit is known, the commitinterest array is now
1386# indexed by the first 4 characters of the ID. Each element is a
1387# list of id, cmd pairs.
1388proc interestedin {id cmd} {
1389 global commitinterest
1390
1391 lappend commitinterest([string range $id 0 3]) $id $cmd
1392}
1393
1394proc check_interest {id scripts} {
1395 global commitinterest
1396
1397 set prefix [string range $id 0 3]
1398 if {[info exists commitinterest($prefix)]} {
1399 set newlist {}
1400 foreach {i script} $commitinterest($prefix) {
1401 if {[string match "$i*" $id]} {
1402 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1403 } else {
1404 lappend newlist $i $script
1405 }
1406 }
1407 if {$newlist ne {}} {
1408 set commitinterest($prefix) $newlist
1409 } else {
1410 unset commitinterest($prefix)
1411 }
1412 }
1413 return $scripts
1414}
1415
f806f0fb 1416proc getcommitlines {fd inst view updating} {
d375ef9b 1417 global cmitlisted leftover
3ed31a81 1418 global commitidx commitdata vdatemode
7fcc92bf 1419 global parents children curview hlview
468bcaed 1420 global idpending ordertok
22387f23 1421 global varccommits varcid varctok vtokmod vfilelimit vshortids
9ccbdfbf 1422
d1e46756 1423 set stuff [read $fd 500000]
005a2f4e 1424 # git log doesn't terminate the last commit with a null...
7fcc92bf 1425 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
005a2f4e
PM
1426 set stuff "\0"
1427 }
b490a991 1428 if {$stuff == {}} {
7eb3cb9c
PM
1429 if {![eof $fd]} {
1430 return 1
1431 }
6df7403a 1432 global commfd viewcomplete viewactive viewname
7fcc92bf
PM
1433 global viewinstances
1434 unset commfd($inst)
1435 set i [lsearch -exact $viewinstances($view) $inst]
1436 if {$i >= 0} {
1437 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
b0cdca99 1438 }
f0654861 1439 # set it blocking so we wait for the process to terminate
da7c24dd 1440 fconfigure $fd -blocking 1
098dd8a3
PM
1441 if {[catch {close $fd} err]} {
1442 set fv {}
1443 if {$view != $curview} {
1444 set fv " for the \"$viewname($view)\" view"
da7c24dd 1445 }
098dd8a3
PM
1446 if {[string range $err 0 4] == "usage"} {
1447 set err "Gitk: error reading commits$fv:\
f9e0b6fb 1448 bad arguments to git log."
5ee1c99a 1449 if {$viewname($view) eq [mc "Command line"]} {
098dd8a3 1450 append err \
f9e0b6fb 1451 " (Note: arguments to gitk are passed to git log\
098dd8a3
PM
1452 to allow selection of commits to be displayed.)"
1453 }
1454 } else {
1455 set err "Error reading commits$fv: $err"
1456 }
1457 error_popup $err
1d10f36d 1458 }
7fcc92bf
PM
1459 if {[incr viewactive($view) -1] <= 0} {
1460 set viewcomplete($view) 1
1461 # Check if we have seen any ids listed as parents that haven't
1462 # appeared in the list
1463 closevarcs $view
1464 notbusy $view
7fcc92bf 1465 }
098dd8a3 1466 if {$view == $curview} {
ac1276ab 1467 run chewcommits
9a40c50c 1468 }
7eb3cb9c 1469 return 0
9a40c50c 1470 }
b490a991 1471 set start 0
8f7d0cec 1472 set gotsome 0
7fcc92bf 1473 set scripts {}
b490a991
PM
1474 while 1 {
1475 set i [string first "\0" $stuff $start]
1476 if {$i < 0} {
7fcc92bf 1477 append leftover($inst) [string range $stuff $start end]
9f1afe05 1478 break
9ccbdfbf 1479 }
b490a991 1480 if {$start == 0} {
7fcc92bf 1481 set cmit $leftover($inst)
8f7d0cec 1482 append cmit [string range $stuff 0 [expr {$i - 1}]]
7fcc92bf 1483 set leftover($inst) {}
8f7d0cec
PM
1484 } else {
1485 set cmit [string range $stuff $start [expr {$i - 1}]]
b490a991
PM
1486 }
1487 set start [expr {$i + 1}]
e5ea701b
PM
1488 set j [string first "\n" $cmit]
1489 set ok 0
16c1ff96 1490 set listed 1
c961b228
PM
1491 if {$j >= 0 && [string match "commit *" $cmit]} {
1492 set ids [string range $cmit 7 [expr {$j - 1}]]
1407ade9 1493 if {[string match {[-^<>]*} $ids]} {
c961b228
PM
1494 switch -- [string index $ids 0] {
1495 "-" {set listed 0}
1407ade9
LT
1496 "^" {set listed 2}
1497 "<" {set listed 3}
1498 ">" {set listed 4}
c961b228 1499 }
16c1ff96
PM
1500 set ids [string range $ids 1 end]
1501 }
e5ea701b
PM
1502 set ok 1
1503 foreach id $ids {
8f7d0cec 1504 if {[string length $id] != 40} {
e5ea701b
PM
1505 set ok 0
1506 break
1507 }
1508 }
1509 }
1510 if {!$ok} {
7e952e79
PM
1511 set shortcmit $cmit
1512 if {[string length $shortcmit] > 80} {
1513 set shortcmit "[string range $shortcmit 0 80]..."
1514 }
d990cedf 1515 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
b490a991
PM
1516 exit 1
1517 }
e5ea701b 1518 set id [lindex $ids 0]
7fcc92bf 1519 set vid $view,$id
f806f0fb 1520
22387f23
PM
1521 lappend vshortids($view,[string range $id 0 3]) $id
1522
f806f0fb 1523 if {!$listed && $updating && ![info exists varcid($vid)] &&
3ed31a81 1524 $vfilelimit($view) ne {}} {
f806f0fb
PM
1525 # git log doesn't rewrite parents for unlisted commits
1526 # when doing path limiting, so work around that here
1527 # by working out the rewritten parent with git rev-list
1528 # and if we already know about it, using the rewritten
1529 # parent as a substitute parent for $id's children.
1530 if {![catch {
1531 set rwid [exec git rev-list --first-parent --max-count=1 \
3ed31a81 1532 $id -- $vfilelimit($view)]
f806f0fb
PM
1533 }]} {
1534 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1535 # use $rwid in place of $id
1536 rewrite_commit $view $id $rwid
1537 continue
1538 }
1539 }
1540 }
1541
f1bf4ee6
PM
1542 set a 0
1543 if {[info exists varcid($vid)]} {
1544 if {$cmitlisted($vid) || !$listed} continue
1545 set a $varcid($vid)
1546 }
16c1ff96
PM
1547 if {$listed} {
1548 set olds [lrange $ids 1 end]
16c1ff96
PM
1549 } else {
1550 set olds {}
1551 }
f7a3e8d2 1552 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
7fcc92bf
PM
1553 set cmitlisted($vid) $listed
1554 set parents($vid) $olds
7fcc92bf
PM
1555 if {![info exists children($vid)]} {
1556 set children($vid) {}
f1bf4ee6 1557 } elseif {$a == 0 && [llength $children($vid)] == 1} {
f3ea5ede
PM
1558 set k [lindex $children($vid) 0]
1559 if {[llength $parents($view,$k)] == 1 &&
3ed31a81 1560 (!$vdatemode($view) ||
f3ea5ede
PM
1561 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1562 set a $varcid($view,$k)
7fcc92bf 1563 }
da7c24dd 1564 }
7fcc92bf
PM
1565 if {$a == 0} {
1566 # new arc
1567 set a [newvarc $view $id]
1568 }
e5b37ac1
PM
1569 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1570 modify_arc $view $a
1571 }
f1bf4ee6
PM
1572 if {![info exists varcid($vid)]} {
1573 set varcid($vid) $a
1574 lappend varccommits($view,$a) $id
1575 incr commitidx($view)
1576 }
e5b37ac1 1577
7fcc92bf
PM
1578 set i 0
1579 foreach p $olds {
1580 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1581 set vp $view,$p
1582 if {[llength [lappend children($vp) $id]] > 1 &&
1583 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1584 set children($vp) [lsort -command [list vtokcmp $view] \
1585 $children($vp)]
009409fe 1586 unset -nocomplain ordertok
7fcc92bf 1587 }
f3ea5ede
PM
1588 if {[info exists varcid($view,$p)]} {
1589 fix_reversal $p $a $view
1590 }
7fcc92bf
PM
1591 }
1592 incr i
1593 }
7fcc92bf 1594
d375ef9b 1595 set scripts [check_interest $id $scripts]
8f7d0cec
PM
1596 set gotsome 1
1597 }
1598 if {$gotsome} {
ac1276ab
PM
1599 global numcommits hlview
1600
1601 if {$view == $curview} {
1602 set numcommits $commitidx($view)
1603 run chewcommits
1604 }
1605 if {[info exists hlview] && $view == $hlview} {
1606 # we never actually get here...
1607 run vhighlightmore
1608 }
7fcc92bf
PM
1609 foreach s $scripts {
1610 eval $s
1611 }
9ccbdfbf 1612 }
7eb3cb9c 1613 return 2
9ccbdfbf
PM
1614}
1615
ac1276ab 1616proc chewcommits {} {
f5f3c2e2 1617 global curview hlview viewcomplete
7fcc92bf 1618 global pending_select
7eb3cb9c 1619
ac1276ab
PM
1620 layoutmore
1621 if {$viewcomplete($curview)} {
1622 global commitidx varctok
1623 global numcommits startmsecs
ac1276ab
PM
1624
1625 if {[info exists pending_select]} {
835e62ae
AG
1626 update
1627 reset_pending_select {}
1628
1629 if {[commitinview $pending_select $curview]} {
1630 selectline [rowofcommit $pending_select] 1
1631 } else {
1632 set row [first_real_row]
1633 selectline $row 1
1634 }
7eb3cb9c 1635 }
ac1276ab
PM
1636 if {$commitidx($curview) > 0} {
1637 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1638 #puts "overall $ms ms for $numcommits commits"
1639 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1640 } else {
1641 show_status [mc "No commits selected"]
1642 }
1643 notbusy layout
b664550c 1644 }
f5f3c2e2 1645 return 0
1db95b00
PM
1646}
1647
590915da
AG
1648proc do_readcommit {id} {
1649 global tclencoding
1650
1651 # Invoke git-log to handle automatic encoding conversion
1652 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1653 # Read the results using i18n.logoutputencoding
1654 fconfigure $fd -translation lf -eofchar {}
1655 if {$tclencoding != {}} {
1656 fconfigure $fd -encoding $tclencoding
1657 }
1658 set contents [read $fd]
1659 close $fd
1660 # Remove the heading line
1661 regsub {^commit [0-9a-f]+\n} $contents {} contents
1662
1663 return $contents
1664}
1665
1db95b00 1666proc readcommit {id} {
590915da
AG
1667 if {[catch {set contents [do_readcommit $id]}]} return
1668 parsecommit $id $contents 1
b490a991
PM
1669}
1670
8f7d0cec 1671proc parsecommit {id contents listed} {
ef73896b 1672 global commitinfo
b5c2f306
SV
1673
1674 set inhdr 1
1675 set comment {}
1676 set headline {}
1677 set auname {}
1678 set audate {}
1679 set comname {}
1680 set comdate {}
232475d3
PM
1681 set hdrend [string first "\n\n" $contents]
1682 if {$hdrend < 0} {
1683 # should never happen...
1684 set hdrend [string length $contents]
1685 }
1686 set header [string range $contents 0 [expr {$hdrend - 1}]]
1687 set comment [string range $contents [expr {$hdrend + 2}] end]
1688 foreach line [split $header "\n"] {
61f57cb0 1689 set line [split $line " "]
232475d3
PM
1690 set tag [lindex $line 0]
1691 if {$tag == "author"} {
f5974d97 1692 set audate [lrange $line end-1 end]
61f57cb0 1693 set auname [join [lrange $line 1 end-2] " "]
232475d3 1694 } elseif {$tag == "committer"} {
f5974d97 1695 set comdate [lrange $line end-1 end]
61f57cb0 1696 set comname [join [lrange $line 1 end-2] " "]
1db95b00
PM
1697 }
1698 }
232475d3 1699 set headline {}
43c25074
PM
1700 # take the first non-blank line of the comment as the headline
1701 set headline [string trimleft $comment]
1702 set i [string first "\n" $headline]
232475d3 1703 if {$i >= 0} {
43c25074
PM
1704 set headline [string range $headline 0 $i]
1705 }
1706 set headline [string trimright $headline]
1707 set i [string first "\r" $headline]
1708 if {$i >= 0} {
1709 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
1710 }
1711 if {!$listed} {
f9e0b6fb 1712 # git log indents the comment by 4 spaces;
8974c6f9 1713 # if we got this via git cat-file, add the indentation
232475d3
PM
1714 set newcomment {}
1715 foreach line [split $comment "\n"] {
1716 append newcomment " "
1717 append newcomment $line
f6e2869f 1718 append newcomment "\n"
232475d3
PM
1719 }
1720 set comment $newcomment
1db95b00 1721 }
36242490 1722 set hasnote [string first "\nNotes:\n" $contents]
b449eb2c
TR
1723 set diff ""
1724 # If there is diff output shown in the git-log stream, split it
1725 # out. But get rid of the empty line that always precedes the
1726 # diff.
1727 set i [string first "\n\ndiff" $comment]
1728 if {$i >= 0} {
1729 set diff [string range $comment $i+1 end]
1730 set comment [string range $comment 0 $i-1]
1731 }
e5c2d856 1732 set commitinfo($id) [list $headline $auname $audate \
b449eb2c 1733 $comname $comdate $comment $hasnote $diff]
1db95b00
PM
1734}
1735
f7a3e8d2 1736proc getcommit {id} {
79b2c75e 1737 global commitdata commitinfo
8ed16484 1738
f7a3e8d2
PM
1739 if {[info exists commitdata($id)]} {
1740 parsecommit $id $commitdata($id) 1
8ed16484
PM
1741 } else {
1742 readcommit $id
1743 if {![info exists commitinfo($id)]} {
d990cedf 1744 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
1745 }
1746 }
1747 return 1
1748}
1749
d375ef9b
PM
1750# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1751# and are present in the current view.
1752# This is fairly slow...
1753proc longid {prefix} {
22387f23 1754 global varcid curview vshortids
d375ef9b
PM
1755
1756 set ids {}
22387f23
PM
1757 if {[string length $prefix] >= 4} {
1758 set vshortid $curview,[string range $prefix 0 3]
1759 if {[info exists vshortids($vshortid)]} {
1760 foreach id $vshortids($vshortid) {
1761 if {[string match "$prefix*" $id]} {
1762 if {[lsearch -exact $ids $id] < 0} {
1763 lappend ids $id
1764 if {[llength $ids] >= 2} break
1765 }
1766 }
1767 }
1768 }
1769 } else {
1770 foreach match [array names varcid "$curview,$prefix*"] {
1771 lappend ids [lindex [split $match ","] 1]
1772 if {[llength $ids] >= 2} break
1773 }
d375ef9b
PM
1774 }
1775 return $ids
1776}
1777
887fe3c4 1778proc readrefs {} {
62d3ea65 1779 global tagids idtags headids idheads tagobjid
219ea3a9 1780 global otherrefids idotherrefs mainhead mainheadid
39816d60 1781 global selecthead selectheadid
ffe15297 1782 global hideremotes
106288cb 1783
b5c2f306 1784 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
009409fe 1785 unset -nocomplain $v
b5c2f306 1786 }
62d3ea65
PM
1787 set refd [open [list | git show-ref -d] r]
1788 while {[gets $refd line] >= 0} {
1789 if {[string index $line 40] ne " "} continue
1790 set id [string range $line 0 39]
1791 set ref [string range $line 41 end]
1792 if {![string match "refs/*" $ref]} continue
1793 set name [string range $ref 5 end]
1794 if {[string match "remotes/*" $name]} {
ffe15297 1795 if {![string match "*/HEAD" $name] && !$hideremotes} {
62d3ea65
PM
1796 set headids($name) $id
1797 lappend idheads($id) $name
f1d83ba3 1798 }
62d3ea65
PM
1799 } elseif {[string match "heads/*" $name]} {
1800 set name [string range $name 6 end]
36a7cad6
JH
1801 set headids($name) $id
1802 lappend idheads($id) $name
62d3ea65
PM
1803 } elseif {[string match "tags/*" $name]} {
1804 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1805 # which is what we want since the former is the commit ID
1806 set name [string range $name 5 end]
1807 if {[string match "*^{}" $name]} {
1808 set name [string range $name 0 end-3]
1809 } else {
1810 set tagobjid($name) $id
1811 }
1812 set tagids($name) $id
1813 lappend idtags($id) $name
36a7cad6
JH
1814 } else {
1815 set otherrefids($name) $id
1816 lappend idotherrefs($id) $name
f1d83ba3
PM
1817 }
1818 }
062d671f 1819 catch {close $refd}
8a48571c 1820 set mainhead {}
219ea3a9 1821 set mainheadid {}
8a48571c 1822 catch {
c11ff120 1823 set mainheadid [exec git rev-parse HEAD]
8a48571c
PM
1824 set thehead [exec git symbolic-ref HEAD]
1825 if {[string match "refs/heads/*" $thehead]} {
1826 set mainhead [string range $thehead 11 end]
1827 }
1828 }
39816d60
AG
1829 set selectheadid {}
1830 if {$selecthead ne {}} {
1831 catch {
1832 set selectheadid [exec git rev-parse --verify $selecthead]
1833 }
1834 }
887fe3c4
PM
1835}
1836
8f489363
PM
1837# skip over fake commits
1838proc first_real_row {} {
7fcc92bf 1839 global nullid nullid2 numcommits
8f489363
PM
1840
1841 for {set row 0} {$row < $numcommits} {incr row} {
7fcc92bf 1842 set id [commitonrow $row]
8f489363
PM
1843 if {$id ne $nullid && $id ne $nullid2} {
1844 break
1845 }
1846 }
1847 return $row
1848}
1849
e11f1233
PM
1850# update things for a head moved to a child of its previous location
1851proc movehead {id name} {
1852 global headids idheads
1853
1854 removehead $headids($name) $name
1855 set headids($name) $id
1856 lappend idheads($id) $name
1857}
1858
1859# update things when a head has been removed
1860proc removehead {id name} {
1861 global headids idheads
1862
1863 if {$idheads($id) eq $name} {
1864 unset idheads($id)
1865 } else {
1866 set i [lsearch -exact $idheads($id) $name]
1867 if {$i >= 0} {
1868 set idheads($id) [lreplace $idheads($id) $i $i]
1869 }
1870 }
1871 unset headids($name)
1872}
1873
d93f1713
PT
1874proc ttk_toplevel {w args} {
1875 global use_ttk
1876 eval [linsert $args 0 ::toplevel $w]
1877 if {$use_ttk} {
1878 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1879 }
1880 return $w
1881}
1882
e7d64008
AG
1883proc make_transient {window origin} {
1884 global have_tk85
1885
1886 # In MacOS Tk 8.4 transient appears to work by setting
1887 # overrideredirect, which is utterly useless, since the
1888 # windows get no border, and are not even kept above
1889 # the parent.
1890 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1891
1892 wm transient $window $origin
1893
1894 # Windows fails to place transient windows normally, so
1895 # schedule a callback to center them on the parent.
1896 if {[tk windowingsystem] eq {win32}} {
1897 after idle [list tk::PlaceWindow $window widget $origin]
1898 }
1899}
1900
ef87a480 1901proc show_error {w top msg} {
d93f1713 1902 global NS
3cb1f9c9 1903 if {![info exists NS]} {set NS ""}
d93f1713 1904 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
df3d83b1
PM
1905 message $w.m -text $msg -justify center -aspect 400
1906 pack $w.m -side top -fill x -padx 20 -pady 20
ef87a480 1907 ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
df3d83b1 1908 pack $w.ok -side bottom -fill x
e54be9e3
PM
1909 bind $top <Visibility> "grab $top; focus $top"
1910 bind $top <Key-Return> "destroy $top"
76f15947
AG
1911 bind $top <Key-space> "destroy $top"
1912 bind $top <Key-Escape> "destroy $top"
e54be9e3 1913 tkwait window $top
df3d83b1
PM
1914}
1915
84a76f18 1916proc error_popup {msg {owner .}} {
d93f1713
PT
1917 if {[tk windowingsystem] eq "win32"} {
1918 tk_messageBox -icon error -type ok -title [wm title .] \
1919 -parent $owner -message $msg
1920 } else {
1921 set w .error
1922 ttk_toplevel $w
1923 make_transient $w $owner
1924 show_error $w $w $msg
1925 }
098dd8a3
PM
1926}
1927
84a76f18 1928proc confirm_popup {msg {owner .}} {
d93f1713 1929 global confirm_ok NS
10299152
PM
1930 set confirm_ok 0
1931 set w .confirm
d93f1713 1932 ttk_toplevel $w
e7d64008 1933 make_transient $w $owner
10299152
PM
1934 message $w.m -text $msg -justify center -aspect 400
1935 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1936 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1937 pack $w.ok -side left -fill x
d93f1713 1938 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1939 pack $w.cancel -side right -fill x
1940 bind $w <Visibility> "grab $w; focus $w"
76f15947
AG
1941 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1942 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1943 bind $w <Key-Escape> "destroy $w"
d93f1713 1944 tk::PlaceWindow $w widget $owner
10299152
PM
1945 tkwait window $w
1946 return $confirm_ok
1947}
1948
b039f0a6 1949proc setoptions {} {
6cb73c84
GB
1950 global use_ttk
1951
d93f1713
PT
1952 if {[tk windowingsystem] ne "win32"} {
1953 option add *Panedwindow.showHandle 1 startupFile
1954 option add *Panedwindow.sashRelief raised startupFile
1955 if {[tk windowingsystem] ne "aqua"} {
1956 option add *Menu.font uifont startupFile
1957 }
1958 } else {
1959 option add *Menu.TearOff 0 startupFile
1960 }
b039f0a6
PM
1961 option add *Button.font uifont startupFile
1962 option add *Checkbutton.font uifont startupFile
1963 option add *Radiobutton.font uifont startupFile
b039f0a6
PM
1964 option add *Menubutton.font uifont startupFile
1965 option add *Label.font uifont startupFile
1966 option add *Message.font uifont startupFile
b9b142ff
MH
1967 option add *Entry.font textfont startupFile
1968 option add *Text.font textfont startupFile
d93f1713 1969 option add *Labelframe.font uifont startupFile
0933b04e 1970 option add *Spinbox.font textfont startupFile
207ad7b8 1971 option add *Listbox.font mainfont startupFile
b039f0a6
PM
1972}
1973
6cb73c84
GB
1974proc setttkstyle {} {
1975 eval font configure TkDefaultFont [fontflags mainfont]
1976 eval font configure TkTextFont [fontflags textfont]
1977 eval font configure TkHeadingFont [fontflags mainfont]
1978 eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1979 eval font configure TkTooltipFont [fontflags uifont]
1980 eval font configure TkFixedFont [fontflags textfont]
1981 eval font configure TkIconFont [fontflags uifont]
1982 eval font configure TkMenuFont [fontflags uifont]
1983 eval font configure TkSmallCaptionFont [fontflags uifont]
1984}
1985
79056034
PM
1986# Make a menu and submenus.
1987# m is the window name for the menu, items is the list of menu items to add.
1988# Each item is a list {mc label type description options...}
1989# mc is ignored; it's so we can put mc there to alert xgettext
1990# label is the string that appears in the menu
1991# type is cascade, command or radiobutton (should add checkbutton)
1992# description depends on type; it's the sublist for cascade, the
1993# command to invoke for command, or {variable value} for radiobutton
f2d0bbbd
PM
1994proc makemenu {m items} {
1995 menu $m
cea07cf8
AG
1996 if {[tk windowingsystem] eq {aqua}} {
1997 set Meta1 Cmd
1998 } else {
1999 set Meta1 Ctrl
2000 }
f2d0bbbd 2001 foreach i $items {
79056034
PM
2002 set name [mc [lindex $i 1]]
2003 set type [lindex $i 2]
2004 set thing [lindex $i 3]
f2d0bbbd
PM
2005 set params [list $type]
2006 if {$name ne {}} {
2007 set u [string first "&" [string map {&& x} $name]]
2008 lappend params -label [string map {&& & & {}} $name]
2009 if {$u >= 0} {
2010 lappend params -underline $u
2011 }
2012 }
2013 switch -- $type {
2014 "cascade" {
79056034 2015 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
f2d0bbbd
PM
2016 lappend params -menu $m.$submenu
2017 }
2018 "command" {
2019 lappend params -command $thing
2020 }
2021 "radiobutton" {
2022 lappend params -variable [lindex $thing 0] \
2023 -value [lindex $thing 1]
2024 }
2025 }
cea07cf8
AG
2026 set tail [lrange $i 4 end]
2027 regsub -all {\yMeta1\y} $tail $Meta1 tail
2028 eval $m add $params $tail
f2d0bbbd
PM
2029 if {$type eq "cascade"} {
2030 makemenu $m.$submenu $thing
2031 }
2032 }
2033}
2034
2035# translate string and remove ampersands
2036proc mca {str} {
2037 return [string map {&& & & {}} [mc $str]]
2038}
2039
39c12691
PM
2040proc cleardropsel {w} {
2041 $w selection clear
2042}
d93f1713
PT
2043proc makedroplist {w varname args} {
2044 global use_ttk
2045 if {$use_ttk} {
3cb1f9c9
PT
2046 set width 0
2047 foreach label $args {
2048 set cx [string length $label]
2049 if {$cx > $width} {set width $cx}
2050 }
2051 set gm [ttk::combobox $w -width $width -state readonly\
39c12691
PM
2052 -textvariable $varname -values $args \
2053 -exportselection false]
2054 bind $gm <<ComboboxSelected>> [list $gm selection clear]
d93f1713
PT
2055 } else {
2056 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2057 }
2058 return $gm
2059}
2060
d94f8cd6 2061proc makewindow {} {
31c0eaa8 2062 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 2063 global tabstop
b74fd579 2064 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 2065 global entries sha1entry sha1string sha1but
890fae70 2066 global diffcontextstring diffcontext
b9b86007 2067 global ignorespace
94a2eede 2068 global maincursor textcursor curtextcursor
219ea3a9 2069 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 2070 global highlight_files gdttype
3ea06f9f 2071 global searchstring sstring
60378c0c 2072 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
252c52df
2073 global uifgcolor uifgdisabledcolor
2074 global filesepbgcolor filesepfgcolor
2075 global mergecolors foundbgcolor currentsearchhitbgcolor
bb3edc8b
PM
2076 global headctxmenu progresscanv progressitem progresscoords statusw
2077 global fprogitem fprogcoord lastprogupdate progupdatepending
6df7403a 2078 global rprogitem rprogcoord rownumsel numcommits
d93f1713 2079 global have_tk85 use_ttk NS
ae4e3ff9
TR
2080 global git_version
2081 global worddiff
9a40c50c 2082
79056034
PM
2083 # The "mc" arguments here are purely so that xgettext
2084 # sees the following string as needing to be translated
5fdcbb13 2085 set file {
d99b4b0d
GB
2086 mc "&File" cascade {
2087 {mc "&Update" command updatecommits -accelerator F5}
2088 {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2089 {mc "Reread re&ferences" command rereadrefs}
2090 {mc "&List references" command showrefs -accelerator F2}
7fb0abb1 2091 {xx "" separator}
d99b4b0d 2092 {mc "Start git &gui" command {exec git gui &}}
7fb0abb1 2093 {xx "" separator}
d99b4b0d 2094 {mc "&Quit" command doquit -accelerator Meta1-Q}
f2d0bbbd 2095 }}
5fdcbb13 2096 set edit {
d99b4b0d
GB
2097 mc "&Edit" cascade {
2098 {mc "&Preferences" command doprefs}
f2d0bbbd 2099 }}
5fdcbb13 2100 set view {
d99b4b0d
GB
2101 mc "&View" cascade {
2102 {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2103 {mc "&Edit view..." command editview -state disabled -accelerator F4}
2104 {mc "&Delete view" command delview -state disabled}
79056034 2105 {xx "" separator}
d99b4b0d 2106 {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
f2d0bbbd 2107 }}
5fdcbb13
DS
2108 if {[tk windowingsystem] ne "aqua"} {
2109 set help {
d99b4b0d
GB
2110 mc "&Help" cascade {
2111 {mc "&About gitk" command about}
2112 {mc "&Key bindings" command keys}
5fdcbb13
DS
2113 }}
2114 set bar [list $file $edit $view $help]
2115 } else {
2116 proc ::tk::mac::ShowPreferences {} {doprefs}
2117 proc ::tk::mac::Quit {} {doquit}
2118 lset file end [lreplace [lindex $file end] end-1 end]
2119 set apple {
d99b4b0d
GB
2120 xx "&Apple" cascade {
2121 {mc "&About gitk" command about}
5fdcbb13
DS
2122 {xx "" separator}
2123 }}
2124 set help {
d99b4b0d
GB
2125 mc "&Help" cascade {
2126 {mc "&Key bindings" command keys}
f2d0bbbd 2127 }}
5fdcbb13 2128 set bar [list $apple $file $view $help]
f2d0bbbd 2129 }
5fdcbb13 2130 makemenu .bar $bar
9a40c50c
PM
2131 . configure -menu .bar
2132
d93f1713
PT
2133 if {$use_ttk} {
2134 # cover the non-themed toplevel with a themed frame.
2135 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2136 }
2137
e9937d2a 2138 # the gui has upper and lower half, parts of a paned window.
d93f1713 2139 ${NS}::panedwindow .ctop -orient vertical
e9937d2a
JH
2140
2141 # possibly use assumed geometry
9ca72f4f 2142 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
2143 set geometry(topheight) [expr {15 * $linespc}]
2144 set geometry(topwidth) [expr {80 * $charspc}]
2145 set geometry(botheight) [expr {15 * $linespc}]
2146 set geometry(botwidth) [expr {50 * $charspc}]
d93f1713
PT
2147 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2148 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
e9937d2a
JH
2149 }
2150
2151 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
d93f1713
PT
2152 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2153 ${NS}::frame .tf.histframe
2154 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2155 if {!$use_ttk} {
2156 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2157 }
e9937d2a
JH
2158
2159 # create three canvases
2160 set cscroll .tf.histframe.csb
2161 set canv .tf.histframe.pwclist.canv
9ca72f4f 2162 canvas $canv \
60378c0c 2163 -selectbackground $selectbgcolor \
f8a2c0d1 2164 -background $bgcolor -bd 0 \
9f1afe05 2165 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
2166 .tf.histframe.pwclist add $canv
2167 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 2168 canvas $canv2 \
60378c0c 2169 -selectbackground $selectbgcolor \
f8a2c0d1 2170 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
2171 .tf.histframe.pwclist add $canv2
2172 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 2173 canvas $canv3 \
60378c0c 2174 -selectbackground $selectbgcolor \
f8a2c0d1 2175 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 2176 .tf.histframe.pwclist add $canv3
d93f1713
PT
2177 if {$use_ttk} {
2178 bind .tf.histframe.pwclist <Map> {
2179 bind %W <Map> {}
2180 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2181 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2182 }
2183 } else {
2184 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2185 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2186 }
e9937d2a
JH
2187
2188 # a scroll bar to rule them
d93f1713
PT
2189 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2190 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
e9937d2a
JH
2191 pack $cscroll -side right -fill y
2192 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 2193 lappend bglist $canv $canv2 $canv3
e9937d2a 2194 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 2195
e9937d2a 2196 # we have two button bars at bottom of top frame. Bar 1
d93f1713
PT
2197 ${NS}::frame .tf.bar
2198 ${NS}::frame .tf.lbar -height 15
e9937d2a
JH
2199
2200 set sha1entry .tf.bar.sha1
887fe3c4 2201 set entries $sha1entry
e9937d2a 2202 set sha1but .tf.bar.sha1label
0359ba72 2203 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
b039f0a6 2204 -command gotocommit -width 8
887fe3c4 2205 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 2206 pack .tf.bar.sha1label -side left
d93f1713 2207 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 2208 trace add variable sha1string write sha1change
98f350e5 2209 pack $sha1entry -side left -pady 2
d698206c 2210
f062e50f 2211 set bm_left_data {
d698206c
PM
2212 #define left_width 16
2213 #define left_height 16
2214 static unsigned char left_bits[] = {
2215 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2216 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2217 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2218 }
f062e50f 2219 set bm_right_data {
d698206c
PM
2220 #define right_width 16
2221 #define right_height 16
2222 static unsigned char right_bits[] = {
2223 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2224 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2225 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2226 }
252c52df
2227 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2228 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2229 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2230 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
f062e50f 2231
62e9ac5e
MK
2232 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2233 if {$use_ttk} {
2234 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2235 } else {
2236 .tf.bar.leftbut configure -image bm-left
2237 }
e9937d2a 2238 pack .tf.bar.leftbut -side left -fill y
62e9ac5e
MK
2239 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2240 if {$use_ttk} {
2241 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2242 } else {
2243 .tf.bar.rightbut configure -image bm-right
2244 }
e9937d2a 2245 pack .tf.bar.rightbut -side left -fill y
d698206c 2246
d93f1713 2247 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
6df7403a 2248 set rownumsel {}
d93f1713 2249 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
6df7403a 2250 -relief sunken -anchor e
d93f1713
PT
2251 ${NS}::label .tf.bar.rowlabel2 -text "/"
2252 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
6df7403a
PM
2253 -relief sunken -anchor e
2254 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2255 -side left
d93f1713
PT
2256 if {!$use_ttk} {
2257 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2258 }
6df7403a 2259 global selectedline
94b4a69f 2260 trace add variable selectedline write selectedline_change
6df7403a 2261
bb3edc8b
PM
2262 # Status label and progress bar
2263 set statusw .tf.bar.status
d93f1713 2264 ${NS}::label $statusw -width 15 -relief sunken
bb3edc8b 2265 pack $statusw -side left -padx 5
d93f1713
PT
2266 if {$use_ttk} {
2267 set progresscanv [ttk::progressbar .tf.bar.progress]
2268 } else {
2269 set h [expr {[font metrics uifont -linespace] + 2}]
2270 set progresscanv .tf.bar.progress
2271 canvas $progresscanv -relief sunken -height $h -borderwidth 2
6e8fda5f 2272 set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
d93f1713
PT
2273 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2274 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2275 }
2276 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
bb3edc8b
PM
2277 set progresscoords {0 0}
2278 set fprogcoord 0
a137a90f 2279 set rprogcoord 0
bb3edc8b
PM
2280 bind $progresscanv <Configure> adjustprogress
2281 set lastprogupdate [clock clicks -milliseconds]
2282 set progupdatepending 0
2283
687c8765 2284 # build up the bottom bar of upper window
d93f1713 2285 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
786f15c8
MB
2286
2287 set bm_down_data {
2288 #define down_width 16
2289 #define down_height 16
2290 static unsigned char down_bits[] = {
2291 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2292 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2293 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2294 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2295 }
2296 image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2297 ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2298 .tf.lbar.fnext configure -image bm-down
2299
2300 set bm_up_data {
2301 #define up_width 16
2302 #define up_height 16
2303 static unsigned char up_bits[] = {
2304 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2305 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2306 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2307 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2308 }
2309 image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2310 ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2311 .tf.lbar.fprev configure -image bm-up
2312
d93f1713 2313 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
786f15c8 2314
687c8765
PM
2315 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2316 -side left -fill y
b007ee20 2317 set gdttype [mc "containing:"]
3cb1f9c9 2318 set gm [makedroplist .tf.lbar.gdttype gdttype \
b007ee20
CS
2319 [mc "containing:"] \
2320 [mc "touching paths:"] \
c33cb908
ML
2321 [mc "adding/removing string:"] \
2322 [mc "changing lines matching:"]]
687c8765 2323 trace add variable gdttype write gdttype_change
687c8765
PM
2324 pack .tf.lbar.gdttype -side left -fill y
2325
98f350e5 2326 set findstring {}
687c8765 2327 set fstring .tf.lbar.findstring
887fe3c4 2328 lappend entries $fstring
b9b142ff 2329 ${NS}::entry $fstring -width 30 -textvariable findstring
60f7a7dc 2330 trace add variable findstring write find_change
b007ee20 2331 set findtype [mc "Exact"]
d93f1713
PT
2332 set findtypemenu [makedroplist .tf.lbar.findtype \
2333 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 2334 trace add variable findtype write findcom_change
b007ee20 2335 set findloc [mc "All fields"]
d93f1713 2336 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
b007ee20 2337 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 2338 trace add variable findloc write find_change
687c8765
PM
2339 pack .tf.lbar.findloc -side right
2340 pack .tf.lbar.findtype -side right
2341 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
2342
2343 # Finish putting the upper half of the viewer together
2344 pack .tf.lbar -in .tf -side bottom -fill x
2345 pack .tf.bar -in .tf -side bottom -fill x
2346 pack .tf.histframe -fill both -side top -expand 1
2347 .ctop add .tf
d93f1713
PT
2348 if {!$use_ttk} {
2349 .ctop paneconfigure .tf -height $geometry(topheight)
2350 .ctop paneconfigure .tf -width $geometry(topwidth)
2351 }
e9937d2a
JH
2352
2353 # now build up the bottom
d93f1713 2354 ${NS}::panedwindow .pwbottom -orient horizontal
e9937d2a
JH
2355
2356 # lower left, a text box over search bar, scroll bar to the right
2357 # if we know window height, then that will set the lower text height, otherwise
2358 # we set lower text height which will drive window height
2359 if {[info exists geometry(main)]} {
d93f1713 2360 ${NS}::frame .bleft -width $geometry(botwidth)
e9937d2a 2361 } else {
d93f1713 2362 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
e9937d2a 2363 }
d93f1713
PT
2364 ${NS}::frame .bleft.top
2365 ${NS}::frame .bleft.mid
2366 ${NS}::frame .bleft.bottom
e9937d2a 2367
cae4b60a
GB
2368 # gap between sub-widgets
2369 set wgap [font measure uifont "i"]
2370
d93f1713 2371 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
2372 pack .bleft.top.search -side left -padx 5
2373 set sstring .bleft.top.sstring
d93f1713 2374 set searchstring ""
b9b142ff 2375 ${NS}::entry $sstring -width 20 -textvariable searchstring
3ea06f9f
PM
2376 lappend entries $sstring
2377 trace add variable searchstring write incrsearch
2378 pack $sstring -side left -expand 1 -fill x
d93f1713 2379 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 2380 -command changediffdisp -variable diffelide -value {0 0}
d93f1713 2381 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 2382 -command changediffdisp -variable diffelide -value {0 1}
d93f1713 2383 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 2384 -command changediffdisp -variable diffelide -value {1 0}
cae4b60a 2385
d93f1713 2386 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
cae4b60a 2387 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
0933b04e 2388 spinbox .bleft.mid.diffcontext -width 5 \
a41ddbb6 2389 -from 0 -increment 1 -to 10000000 \
890fae70
SP
2390 -validate all -validatecommand "diffcontextvalidate %P" \
2391 -textvariable diffcontextstring
2392 .bleft.mid.diffcontext set $diffcontext
2393 trace add variable diffcontextstring write diffcontextchange
2394 lappend entries .bleft.mid.diffcontext
cae4b60a 2395 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
d93f1713 2396 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
b9b86007
SP
2397 -command changeignorespace -variable ignorespace
2398 pack .bleft.mid.ignspace -side left -padx 5
ae4e3ff9
TR
2399
2400 set worddiff [mc "Line diff"]
2401 if {[package vcompare $git_version "1.7.2"] >= 0} {
2402 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2403 [mc "Markup words"] [mc "Color words"]
2404 trace add variable worddiff write changeworddiff
2405 pack .bleft.mid.worddiff -side left -padx 5
2406 }
2407
8809d691 2408 set ctext .bleft.bottom.ctext
f8a2c0d1 2409 text $ctext -background $bgcolor -foreground $fgcolor \
106a6d9d 2410 -state disabled -undo 0 -font textfont \
8809d691
PK
2411 -yscrollcommand scrolltext -wrap none \
2412 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4
PM
2413 if {$have_tk85} {
2414 $ctext conf -tabstyle wordprocessor
2415 }
d93f1713
PT
2416 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2417 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
e9937d2a 2418 pack .bleft.top -side top -fill x
a8d610a2 2419 pack .bleft.mid -side top -fill x
8809d691
PK
2420 grid $ctext .bleft.bottom.sb -sticky nsew
2421 grid .bleft.bottom.sbhorizontal -sticky ew
2422 grid columnconfigure .bleft.bottom 0 -weight 1
2423 grid rowconfigure .bleft.bottom 0 -weight 1
2424 grid rowconfigure .bleft.bottom 1 -weight 0
2425 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
2426 lappend bglist $ctext
2427 lappend fglist $ctext
d2610d11 2428
f1b86294 2429 $ctext tag conf comment -wrap $wrapcomment
252c52df 2430 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
f8a2c0d1
PM
2431 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2432 $ctext tag conf d0 -fore [lindex $diffcolors 0]
8b07dca1 2433 $ctext tag conf dresult -fore [lindex $diffcolors 1]
252c52df
2434 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2435 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2436 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2437 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2438 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2439 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2440 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2441 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2442 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2443 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2444 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2445 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2446 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2447 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2448 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2449 $ctext tag conf m15 -fore [lindex $mergecolors 15]
712fcc08 2450 $ctext tag conf mmax -fore darkgrey
b77b0278 2451 set mergemax 16
9c311b32
PM
2452 $ctext tag conf mresult -font textfontbold
2453 $ctext tag conf msep -font textfontbold
252c52df
2454 $ctext tag conf found -back $foundbgcolor
2455 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
76d64ca6 2456 $ctext tag conf wwrap -wrap word -lmargin2 1c
4399fe33 2457 $ctext tag conf bold -font textfontbold
e5c2d856 2458
e9937d2a 2459 .pwbottom add .bleft
d93f1713
PT
2460 if {!$use_ttk} {
2461 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2462 }
e9937d2a
JH
2463
2464 # lower right
d93f1713
PT
2465 ${NS}::frame .bright
2466 ${NS}::frame .bright.mode
2467 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 2468 -command reselectline -variable cmitmode -value "patch"
d93f1713 2469 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 2470 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
2471 grid .bright.mode.patch .bright.mode.tree -sticky ew
2472 pack .bright.mode -side top -fill x
2473 set cflist .bright.cfiles
9c311b32 2474 set indent [font measure mainfont "nn"]
e9937d2a 2475 text $cflist \
60378c0c 2476 -selectbackground $selectbgcolor \
f8a2c0d1 2477 -background $bgcolor -foreground $fgcolor \
9c311b32 2478 -font mainfont \
7fcceed7 2479 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 2480 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
2481 -cursor [. cget -cursor] \
2482 -spacing1 1 -spacing3 1
f8a2c0d1
PM
2483 lappend bglist $cflist
2484 lappend fglist $cflist
d93f1713 2485 ${NS}::scrollbar .bright.sb -command "$cflist yview"
e9937d2a 2486 pack .bright.sb -side right -fill y
d2610d11 2487 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
2488 $cflist tag configure highlight \
2489 -background [$cflist cget -selectbackground]
9c311b32 2490 $cflist tag configure bold -font mainfontbold
d2610d11 2491
e9937d2a
JH
2492 .pwbottom add .bright
2493 .ctop add .pwbottom
1db95b00 2494
b9bee115 2495 # restore window width & height if known
e9937d2a 2496 if {[info exists geometry(main)]} {
b9bee115
PM
2497 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2498 if {$w > [winfo screenwidth .]} {
2499 set w [winfo screenwidth .]
2500 }
2501 if {$h > [winfo screenheight .]} {
2502 set h [winfo screenheight .]
2503 }
2504 wm geometry . "${w}x$h"
2505 }
e9937d2a
JH
2506 }
2507
c876dbad
PT
2508 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2509 wm state . $geometry(state)
2510 }
2511
d23d98d3
SP
2512 if {[tk windowingsystem] eq {aqua}} {
2513 set M1B M1
5fdcbb13 2514 set ::BM "3"
d23d98d3
SP
2515 } else {
2516 set M1B Control
5fdcbb13 2517 set ::BM "2"
d23d98d3
SP
2518 }
2519
d93f1713
PT
2520 if {$use_ttk} {
2521 bind .ctop <Map> {
2522 bind %W <Map> {}
2523 %W sashpos 0 $::geometry(topheight)
2524 }
2525 bind .pwbottom <Map> {
2526 bind %W <Map> {}
2527 %W sashpos 0 $::geometry(botwidth)
2528 }
2529 }
2530
e9937d2a
JH
2531 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2532 pack .ctop -fill both -expand 1
c8dfbcf9
PM
2533 bindall <1> {selcanvline %W %x %y}
2534 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
2535 if {[tk windowingsystem] == "win32"} {
2536 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2537 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2538 } else {
2539 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2540 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
122b8079
GM
2541 bind $ctext <Button> {
2542 if {"%b" eq 6} {
2543 $ctext xview scroll -5 units
2544 } elseif {"%b" eq 7} {
2545 $ctext xview scroll 5 units
2546 }
2547 }
5dd57d51
JS
2548 if {[tk windowingsystem] eq "aqua"} {
2549 bindall <MouseWheel> {
2550 set delta [expr {- (%D)}]
2551 allcanvs yview scroll $delta units
2552 }
5fdcbb13
DS
2553 bindall <Shift-MouseWheel> {
2554 set delta [expr {- (%D)}]
2555 $canv xview scroll $delta units
2556 }
5dd57d51 2557 }
314c3093 2558 }
5fdcbb13
DS
2559 bindall <$::BM> "canvscan mark %W %x %y"
2560 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
decd0a1e
JL
2561 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2562 bind . <$M1B-Key-w> doquit
6e5f7203
RN
2563 bindkey <Home> selfirstline
2564 bindkey <End> sellastline
17386066
PM
2565 bind . <Key-Up> "selnextline -1"
2566 bind . <Key-Down> "selnextline 1"
cca5d946
PM
2567 bind . <Shift-Key-Up> "dofind -1 0"
2568 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
2569 bindkey <Key-Right> "goforw"
2570 bindkey <Key-Left> "goback"
2571 bind . <Key-Prior> "selnextpage -1"
2572 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
2573 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2574 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2575 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2576 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2577 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2578 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
2579 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2580 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2581 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
2582 bindkey p "selnextline -1"
2583 bindkey n "selnextline 1"
6e2dda35
RS
2584 bindkey z "goback"
2585 bindkey x "goforw"
811c70fc
JN
2586 bindkey k "selnextline -1"
2587 bindkey j "selnextline 1"
2588 bindkey h "goback"
6e2dda35 2589 bindkey l "goforw"
f4c54b3c 2590 bindkey b prevfile
cfb4563c
PM
2591 bindkey d "$ctext yview scroll 18 units"
2592 bindkey u "$ctext yview scroll -18 units"
0deb5c97 2593 bindkey g {$sha1entry delete 0 end; focus $sha1entry}
97bed034 2594 bindkey / {focus $fstring}
b6e192db 2595 bindkey <Key-KP_Divide> {focus $fstring}
cca5d946
PM
2596 bindkey <Key-Return> {dofind 1 1}
2597 bindkey ? {dofind -1 1}
39ad8570 2598 bindkey f nextfile
cea07cf8 2599 bind . <F5> updatecommits
ebb91db8 2600 bindmodfunctionkey Shift 5 reloadcommits
cea07cf8 2601 bind . <F2> showrefs
69ecfcd6 2602 bindmodfunctionkey Shift 4 {newview 0}
cea07cf8 2603 bind . <F4> edit_or_newview
d23d98d3 2604 bind . <$M1B-q> doquit
cca5d946
PM
2605 bind . <$M1B-f> {dofind 1 1}
2606 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
2607 bind . <$M1B-r> dosearchback
2608 bind . <$M1B-s> dosearch
2609 bind . <$M1B-equal> {incrfont 1}
646f3a14 2610 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
2611 bind . <$M1B-KP_Add> {incrfont 1}
2612 bind . <$M1B-minus> {incrfont -1}
2613 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 2614 wm protocol . WM_DELETE_WINDOW doquit
e2f90ee4 2615 bind . <Destroy> {stop_backends}
df3d83b1 2616 bind . <Button-1> "click %W"
cca5d946 2617 bind $fstring <Key-Return> {dofind 1 1}
968ce45c 2618 bind $sha1entry <Key-Return> {gotocommit; break}
ee3dc72e 2619 bind $sha1entry <<PasteSelection>> clearsha1
ada2ea16 2620 bind $sha1entry <<Paste>> clearsha1
7fcceed7
PM
2621 bind $cflist <1> {sel_flist %W %x %y; break}
2622 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 2623 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
d277e89f
PM
2624 global ctxbut
2625 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
7cdc3556 2626 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
4adcbea0 2627 bind $ctext <Button-1> {focus %W}
c4614994 2628 bind $ctext <<Selection>> rehighlight_search_results
d4ec30b2
MK
2629 for {set i 1} {$i < 10} {incr i} {
2630 bind . <$M1B-Key-$i> [list go_to_parent $i]
2631 }
ea13cba1
PM
2632
2633 set maincursor [. cget -cursor]
2634 set textcursor [$ctext cget -cursor]
94a2eede 2635 set curtextcursor $textcursor
84ba7345 2636
c8dfbcf9 2637 set rowctxmenu .rowctxmenu
f2d0bbbd 2638 makemenu $rowctxmenu {
79056034
PM
2639 {mc "Diff this -> selected" command {diffvssel 0}}
2640 {mc "Diff selected -> this" command {diffvssel 1}}
2641 {mc "Make patch" command mkpatch}
2642 {mc "Create tag" command mktag}
d835dbb9 2643 {mc "Copy commit summary" command copysummary}
79056034
PM
2644 {mc "Write commit to file" command writecommit}
2645 {mc "Create new branch" command mkbranch}
2646 {mc "Cherry-pick this commit" command cherrypick}
2647 {mc "Reset HEAD branch to here" command resethead}
b9fdba7f
PM
2648 {mc "Mark this commit" command markhere}
2649 {mc "Return to mark" command gotomark}
2650 {mc "Find descendant of this and mark" command find_common_desc}
010509f2 2651 {mc "Compare with marked commit" command compare_commits}
6febdede
PM
2652 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2653 {mc "Diff marked commit -> this" command {diffvsmark 1}}
8f3ff933 2654 {mc "Revert this commit" command revert}
f2d0bbbd
PM
2655 }
2656 $rowctxmenu configure -tearoff 0
10299152 2657
219ea3a9 2658 set fakerowmenu .fakerowmenu
f2d0bbbd 2659 makemenu $fakerowmenu {
79056034
PM
2660 {mc "Diff this -> selected" command {diffvssel 0}}
2661 {mc "Diff selected -> this" command {diffvssel 1}}
2662 {mc "Make patch" command mkpatch}
6febdede
PM
2663 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2664 {mc "Diff marked commit -> this" command {diffvsmark 1}}
f2d0bbbd
PM
2665 }
2666 $fakerowmenu configure -tearoff 0
219ea3a9 2667
10299152 2668 set headctxmenu .headctxmenu
f2d0bbbd 2669 makemenu $headctxmenu {
79056034 2670 {mc "Check out this branch" command cobranch}
5a046c52 2671 {mc "Rename this branch" command mvbranch}
79056034 2672 {mc "Remove this branch" command rmbranch}
427cf169 2673 {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
f2d0bbbd
PM
2674 }
2675 $headctxmenu configure -tearoff 0
3244729a
PM
2676
2677 global flist_menu
2678 set flist_menu .flistctxmenu
f2d0bbbd 2679 makemenu $flist_menu {
79056034
PM
2680 {mc "Highlight this too" command {flist_hl 0}}
2681 {mc "Highlight this only" command {flist_hl 1}}
2682 {mc "External diff" command {external_diff}}
2683 {mc "Blame parent commit" command {external_blame 1}}
427cf169 2684 {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
f2d0bbbd
PM
2685 }
2686 $flist_menu configure -tearoff 0
7cdc3556
AG
2687
2688 global diff_menu
2689 set diff_menu .diffctxmenu
2690 makemenu $diff_menu {
8a897742 2691 {mc "Show origin of this line" command show_line_source}
7cdc3556
AG
2692 {mc "Run git gui blame on this line" command {external_blame_diff}}
2693 }
2694 $diff_menu configure -tearoff 0
df3d83b1
PM
2695}
2696
314c3093
ML
2697# Windows sends all mouse wheel events to the current focused window, not
2698# the one where the mouse hovers, so bind those events here and redirect
2699# to the correct window
2700proc windows_mousewheel_redirector {W X Y D} {
2701 global canv canv2 canv3
2702 set w [winfo containing -displayof $W $X $Y]
2703 if {$w ne ""} {
2704 set u [expr {$D < 0 ? 5 : -5}]
2705 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2706 allcanvs yview scroll $u units
2707 } else {
2708 catch {
2709 $w yview scroll $u units
2710 }
2711 }
2712 }
2713}
2714
6df7403a
PM
2715# Update row number label when selectedline changes
2716proc selectedline_change {n1 n2 op} {
2717 global selectedline rownumsel
2718
94b4a69f 2719 if {$selectedline eq {}} {
6df7403a
PM
2720 set rownumsel {}
2721 } else {
2722 set rownumsel [expr {$selectedline + 1}]
2723 }
2724}
2725
be0cd098
PM
2726# mouse-2 makes all windows scan vertically, but only the one
2727# the cursor is in scans horizontally
2728proc canvscan {op w x y} {
2729 global canv canv2 canv3
2730 foreach c [list $canv $canv2 $canv3] {
2731 if {$c == $w} {
2732 $c scan $op $x $y
2733 } else {
2734 $c scan $op 0 $y
2735 }
2736 }
2737}
2738
9f1afe05
PM
2739proc scrollcanv {cscroll f0 f1} {
2740 $cscroll set $f0 $f1
31c0eaa8 2741 drawvisible
908c3585 2742 flushhighlights
9f1afe05
PM
2743}
2744
df3d83b1
PM
2745# when we make a key binding for the toplevel, make sure
2746# it doesn't get triggered when that key is pressed in the
2747# find string entry widget.
2748proc bindkey {ev script} {
887fe3c4 2749 global entries
df3d83b1
PM
2750 bind . $ev $script
2751 set escript [bind Entry $ev]
2752 if {$escript == {}} {
2753 set escript [bind Entry <Key>]
2754 }
887fe3c4
PM
2755 foreach e $entries {
2756 bind $e $ev "$escript; break"
2757 }
df3d83b1
PM
2758}
2759
69ecfcd6
AW
2760proc bindmodfunctionkey {mod n script} {
2761 bind . <$mod-F$n> $script
2762 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2763}
2764
df3d83b1 2765# set the focus back to the toplevel for any click outside
887fe3c4 2766# the entry widgets
df3d83b1 2767proc click {w} {
bd441de4
ML
2768 global ctext entries
2769 foreach e [concat $entries $ctext] {
887fe3c4 2770 if {$w == $e} return
df3d83b1 2771 }
887fe3c4 2772 focus .
0fba86b3
PM
2773}
2774
bb3edc8b
PM
2775# Adjust the progress bar for a change in requested extent or canvas size
2776proc adjustprogress {} {
2777 global progresscanv progressitem progresscoords
2778 global fprogitem fprogcoord lastprogupdate progupdatepending
d93f1713
PT
2779 global rprogitem rprogcoord use_ttk
2780
2781 if {$use_ttk} {
2782 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2783 return
2784 }
bb3edc8b
PM
2785
2786 set w [expr {[winfo width $progresscanv] - 4}]
2787 set x0 [expr {$w * [lindex $progresscoords 0]}]
2788 set x1 [expr {$w * [lindex $progresscoords 1]}]
2789 set h [winfo height $progresscanv]
2790 $progresscanv coords $progressitem $x0 0 $x1 $h
2791 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 2792 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
2793 set now [clock clicks -milliseconds]
2794 if {$now >= $lastprogupdate + 100} {
2795 set progupdatepending 0
2796 update
2797 } elseif {!$progupdatepending} {
2798 set progupdatepending 1
2799 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2800 }
2801}
2802
2803proc doprogupdate {} {
2804 global lastprogupdate progupdatepending
2805
2806 if {$progupdatepending} {
2807 set progupdatepending 0
2808 set lastprogupdate [clock clicks -milliseconds]
2809 update
2810 }
2811}
2812
eaf7e835
MK
2813proc config_check_tmp_exists {tries_left} {
2814 global config_file_tmp
2815
2816 if {[file exists $config_file_tmp]} {
2817 incr tries_left -1
2818 if {$tries_left > 0} {
2819 after 100 [list config_check_tmp_exists $tries_left]
2820 } else {
2821 error_popup "There appears to be a stale $config_file_tmp\
2822 file, which will prevent gitk from saving its configuration on exit.\
2823 Please remove it if it is not being used by any existing gitk process."
2824 }
2825 }
2826}
2827
995f792b
MK
2828proc config_init_trace {name} {
2829 global config_variable_changed config_variable_original
2830
2831 upvar #0 $name var
2832 set config_variable_changed($name) 0
2833 set config_variable_original($name) $var
2834}
2835
2836proc config_variable_change_cb {name name2 op} {
2837 global config_variable_changed config_variable_original
2838
2839 upvar #0 $name var
2840 if {$op eq "write" &&
2841 (![info exists config_variable_original($name)] ||
2842 $config_variable_original($name) ne $var)} {
2843 set config_variable_changed($name) 1
2844 }
2845}
2846
0fba86b3 2847proc savestuff {w} {
9fabefb1 2848 global stuffsaved
8f863398 2849 global config_file config_file_tmp
995f792b
MK
2850 global config_variables config_variable_changed
2851 global viewchanged
2852
2853 upvar #0 viewname current_viewname
2854 upvar #0 viewfiles current_viewfiles
2855 upvar #0 viewargs current_viewargs
2856 upvar #0 viewargscmd current_viewargscmd
2857 upvar #0 viewperm current_viewperm
2858 upvar #0 nextviewnum current_nextviewnum
2859 upvar #0 use_ttk current_use_ttk
4ef17537 2860
0fba86b3 2861 if {$stuffsaved} return
df3d83b1 2862 if {![winfo viewable .]} return
eaf7e835 2863 set remove_tmp 0
1dd29606 2864 if {[catch {
eaf7e835
MK
2865 set try_count 0
2866 while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2867 if {[incr try_count] > 50} {
2868 error "Unable to write config file: $config_file_tmp exists"
2869 }
2870 after 100
8f863398 2871 }
eaf7e835 2872 set remove_tmp 1
9832e4f2 2873 if {$::tcl_platform(platform) eq {windows}} {
8f863398 2874 file attributes $config_file_tmp -hidden true
9832e4f2 2875 }
995f792b
MK
2876 if {[file exists $config_file]} {
2877 source $config_file
2878 }
9fabefb1
MK
2879 foreach var_name $config_variables {
2880 upvar #0 $var_name var
995f792b
MK
2881 upvar 0 $var_name old_var
2882 if {!$config_variable_changed($var_name) && [info exists old_var]} {
2883 puts $f [list set $var_name $old_var]
2884 } else {
2885 puts $f [list set $var_name $var]
2886 }
9fabefb1 2887 }
e9937d2a 2888
b6047c5a 2889 puts $f "set geometry(main) [wm geometry .]"
c876dbad 2890 puts $f "set geometry(state) [wm state .]"
e9937d2a
JH
2891 puts $f "set geometry(topwidth) [winfo width .tf]"
2892 puts $f "set geometry(topheight) [winfo height .tf]"
995f792b 2893 if {$current_use_ttk} {
d93f1713
PT
2894 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2895 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2896 } else {
2897 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2898 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2899 }
e9937d2a
JH
2900 puts $f "set geometry(botwidth) [winfo width .bleft]"
2901 puts $f "set geometry(botheight) [winfo height .bleft]"
2902
995f792b
MK
2903 array set view_save {}
2904 array set views {}
2905 if {![info exists permviews]} { set permviews {} }
2906 foreach view $permviews {
2907 set view_save([lindex $view 0]) 1
2908 set views([lindex $view 0]) $view
2909 }
a90a6d24 2910 puts -nonewline $f "set permviews {"
995f792b
MK
2911 for {set v 1} {$v < $current_nextviewnum} {incr v} {
2912 if {$viewchanged($v)} {
2913 if {$current_viewperm($v)} {
2914 set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2915 } else {
2916 set view_save($current_viewname($v)) 0
2917 }
2918 }
2919 }
2920 # write old and updated view to their places and append remaining to the end
2921 foreach view $permviews {
2922 set view_name [lindex $view 0]
2923 if {$view_save($view_name)} {
2924 puts $f "{$views($view_name)}"
a90a6d24 2925 }
995f792b
MK
2926 unset views($view_name)
2927 }
2928 foreach view_name [array names views] {
2929 puts $f "{$views($view_name)}"
a90a6d24
PM
2930 }
2931 puts $f "}"
0fba86b3 2932 close $f
8f863398 2933 file rename -force $config_file_tmp $config_file
eaf7e835 2934 set remove_tmp 0
1dd29606
MK
2935 } err]} {
2936 puts "Error saving config: $err"
0fba86b3 2937 }
eaf7e835
MK
2938 if {$remove_tmp} {
2939 file delete -force $config_file_tmp
2940 }
0fba86b3 2941 set stuffsaved 1
1db95b00
PM
2942}
2943
43bddeb4 2944proc resizeclistpanes {win w} {
d93f1713 2945 global oldwidth use_ttk
418c4c7b 2946 if {[info exists oldwidth($win)]} {
d93f1713
PT
2947 if {$use_ttk} {
2948 set s0 [$win sashpos 0]
2949 set s1 [$win sashpos 1]
2950 } else {
2951 set s0 [$win sash coord 0]
2952 set s1 [$win sash coord 1]
2953 }
43bddeb4
PM
2954 if {$w < 60} {
2955 set sash0 [expr {int($w/2 - 2)}]
2956 set sash1 [expr {int($w*5/6 - 2)}]
2957 } else {
2958 set factor [expr {1.0 * $w / $oldwidth($win)}]
2959 set sash0 [expr {int($factor * [lindex $s0 0])}]
2960 set sash1 [expr {int($factor * [lindex $s1 0])}]
2961 if {$sash0 < 30} {
2962 set sash0 30
2963 }
2964 if {$sash1 < $sash0 + 20} {
2ed49d54 2965 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
2966 }
2967 if {$sash1 > $w - 10} {
2ed49d54 2968 set sash1 [expr {$w - 10}]
43bddeb4 2969 if {$sash0 > $sash1 - 20} {
2ed49d54 2970 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
2971 }
2972 }
2973 }
d93f1713
PT
2974 if {$use_ttk} {
2975 $win sashpos 0 $sash0
2976 $win sashpos 1 $sash1
2977 } else {
2978 $win sash place 0 $sash0 [lindex $s0 1]
2979 $win sash place 1 $sash1 [lindex $s1 1]
2980 }
43bddeb4
PM
2981 }
2982 set oldwidth($win) $w
2983}
2984
2985proc resizecdetpanes {win w} {
d93f1713 2986 global oldwidth use_ttk
418c4c7b 2987 if {[info exists oldwidth($win)]} {
d93f1713
PT
2988 if {$use_ttk} {
2989 set s0 [$win sashpos 0]
2990 } else {
2991 set s0 [$win sash coord 0]
2992 }
43bddeb4
PM
2993 if {$w < 60} {
2994 set sash0 [expr {int($w*3/4 - 2)}]
2995 } else {
2996 set factor [expr {1.0 * $w / $oldwidth($win)}]
2997 set sash0 [expr {int($factor * [lindex $s0 0])}]
2998 if {$sash0 < 45} {
2999 set sash0 45
3000 }
3001 if {$sash0 > $w - 15} {
2ed49d54 3002 set sash0 [expr {$w - 15}]
43bddeb4
PM
3003 }
3004 }
d93f1713
PT
3005 if {$use_ttk} {
3006 $win sashpos 0 $sash0
3007 } else {
3008 $win sash place 0 $sash0 [lindex $s0 1]
3009 }
43bddeb4
PM
3010 }
3011 set oldwidth($win) $w
3012}
3013
b5721c72
PM
3014proc allcanvs args {
3015 global canv canv2 canv3
3016 eval $canv $args
3017 eval $canv2 $args
3018 eval $canv3 $args
3019}
3020
3021proc bindall {event action} {
3022 global canv canv2 canv3
3023 bind $canv $event $action
3024 bind $canv2 $event $action
3025 bind $canv3 $event $action
3026}
3027
9a40c50c 3028proc about {} {
22a713c7 3029 global bgcolor NS
9a40c50c
PM
3030 set w .about
3031 if {[winfo exists $w]} {
3032 raise $w
3033 return
3034 }
d93f1713 3035 ttk_toplevel $w
d990cedf 3036 wm title $w [mc "About gitk"]
e7d64008 3037 make_transient $w .
d990cedf 3038 message $w.m -text [mc "
9f1afe05 3039Gitk - a commit viewer for git
9a40c50c 3040
fbf42647 3041Copyright \u00a9 2005-2016 Paul Mackerras
9a40c50c 3042
d990cedf 3043Use and redistribute under the terms of the GNU General Public License"] \
22a713c7 3044 -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3a950e9a 3045 pack $w.m -side top -fill x -padx 2 -pady 2
d93f1713 3046 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 3047 pack $w.ok -side bottom
3a950e9a
ER
3048 bind $w <Visibility> "focus $w.ok"
3049 bind $w <Key-Escape> "destroy $w"
3050 bind $w <Key-Return> "destroy $w"
d93f1713 3051 tk::PlaceWindow $w widget .
9a40c50c
PM
3052}
3053
4e95e1f7 3054proc keys {} {
22a713c7 3055 global bgcolor NS
4e95e1f7
PM
3056 set w .keys
3057 if {[winfo exists $w]} {
3058 raise $w
3059 return
3060 }
d23d98d3
SP
3061 if {[tk windowingsystem] eq {aqua}} {
3062 set M1T Cmd
3063 } else {
3064 set M1T Ctrl
3065 }
d93f1713 3066 ttk_toplevel $w
d990cedf 3067 wm title $w [mc "Gitk key bindings"]
e7d64008 3068 make_transient $w .
3d2c998e
MB
3069 message $w.m -text "
3070[mc "Gitk key bindings:"]
3071
3072[mc "<%s-Q> Quit" $M1T]
decd0a1e 3073[mc "<%s-W> Close window" $M1T]
3d2c998e
MB
3074[mc "<Home> Move to first commit"]
3075[mc "<End> Move to last commit"]
811c70fc
JN
3076[mc "<Up>, p, k Move up one commit"]
3077[mc "<Down>, n, j Move down one commit"]
3078[mc "<Left>, z, h Go back in history list"]
3d2c998e 3079[mc "<Right>, x, l Go forward in history list"]
d4ec30b2 3080[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
3d2c998e
MB
3081[mc "<PageUp> Move up one page in commit list"]
3082[mc "<PageDown> Move down one page in commit list"]
3083[mc "<%s-Home> Scroll to top of commit list" $M1T]
3084[mc "<%s-End> Scroll to bottom of commit list" $M1T]
3085[mc "<%s-Up> Scroll commit list up one line" $M1T]
3086[mc "<%s-Down> Scroll commit list down one line" $M1T]
3087[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
3088[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
3089[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3090[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
3091[mc "<Delete>, b Scroll diff view up one page"]
3092[mc "<Backspace> Scroll diff view up one page"]
3093[mc "<Space> Scroll diff view down one page"]
3094[mc "u Scroll diff view up 18 lines"]
3095[mc "d Scroll diff view down 18 lines"]
3096[mc "<%s-F> Find" $M1T]
3097[mc "<%s-G> Move to next find hit" $M1T]
3098[mc "<Return> Move to next find hit"]
0deb5c97 3099[mc "g Go to commit"]
97bed034 3100[mc "/ Focus the search box"]
3d2c998e
MB
3101[mc "? Move to previous find hit"]
3102[mc "f Scroll diff view to next file"]
3103[mc "<%s-S> Search for next hit in diff view" $M1T]
3104[mc "<%s-R> Search for previous hit in diff view" $M1T]
3105[mc "<%s-KP+> Increase font size" $M1T]
3106[mc "<%s-plus> Increase font size" $M1T]
3107[mc "<%s-KP-> Decrease font size" $M1T]
3108[mc "<%s-minus> Decrease font size" $M1T]
3109[mc "<F5> Update"]
3110" \
22a713c7 3111 -justify left -bg $bgcolor -border 2 -relief groove
3a950e9a 3112 pack $w.m -side top -fill both -padx 2 -pady 2
d93f1713 3113 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
76f15947 3114 bind $w <Key-Escape> [list destroy $w]
4e95e1f7 3115 pack $w.ok -side bottom
3a950e9a
ER
3116 bind $w <Visibility> "focus $w.ok"
3117 bind $w <Key-Escape> "destroy $w"
3118 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
3119}
3120
7fcceed7
PM
3121# Procedures for manipulating the file list window at the
3122# bottom right of the overall window.
f8b28a40
PM
3123
3124proc treeview {w l openlevs} {
3125 global treecontents treediropen treeheight treeparent treeindex
3126
3127 set ix 0
3128 set treeindex() 0
3129 set lev 0
3130 set prefix {}
3131 set prefixend -1
3132 set prefendstack {}
3133 set htstack {}
3134 set ht 0
3135 set treecontents() {}
3136 $w conf -state normal
3137 foreach f $l {
3138 while {[string range $f 0 $prefixend] ne $prefix} {
3139 if {$lev <= $openlevs} {
3140 $w mark set e:$treeindex($prefix) "end -1c"
3141 $w mark gravity e:$treeindex($prefix) left
3142 }
3143 set treeheight($prefix) $ht
3144 incr ht [lindex $htstack end]
3145 set htstack [lreplace $htstack end end]
3146 set prefixend [lindex $prefendstack end]
3147 set prefendstack [lreplace $prefendstack end end]
3148 set prefix [string range $prefix 0 $prefixend]
3149 incr lev -1
3150 }
3151 set tail [string range $f [expr {$prefixend+1}] end]
3152 while {[set slash [string first "/" $tail]] >= 0} {
3153 lappend htstack $ht
3154 set ht 0
3155 lappend prefendstack $prefixend
3156 incr prefixend [expr {$slash + 1}]
3157 set d [string range $tail 0 $slash]
3158 lappend treecontents($prefix) $d
3159 set oldprefix $prefix
3160 append prefix $d
3161 set treecontents($prefix) {}
3162 set treeindex($prefix) [incr ix]
3163 set treeparent($prefix) $oldprefix
3164 set tail [string range $tail [expr {$slash+1}] end]
3165 if {$lev <= $openlevs} {
3166 set ht 1
3167 set treediropen($prefix) [expr {$lev < $openlevs}]
3168 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3169 $w mark set d:$ix "end -1c"
3170 $w mark gravity d:$ix left
3171 set str "\n"
3172 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3173 $w insert end $str
3174 $w image create end -align center -image $bm -padx 1 \
3175 -name a:$ix
45a9d505 3176 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
3177 $w mark set s:$ix "end -1c"
3178 $w mark gravity s:$ix left
3179 }
3180 incr lev
3181 }
3182 if {$tail ne {}} {
3183 if {$lev <= $openlevs} {
3184 incr ht
3185 set str "\n"
3186 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3187 $w insert end $str
45a9d505 3188 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
3189 }
3190 lappend treecontents($prefix) $tail
3191 }
3192 }
3193 while {$htstack ne {}} {
3194 set treeheight($prefix) $ht
3195 incr ht [lindex $htstack end]
3196 set htstack [lreplace $htstack end end]
096e96b4
BD
3197 set prefixend [lindex $prefendstack end]
3198 set prefendstack [lreplace $prefendstack end end]
3199 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
3200 }
3201 $w conf -state disabled
3202}
3203
3204proc linetoelt {l} {
3205 global treeheight treecontents
3206
3207 set y 2
3208 set prefix {}
3209 while {1} {
3210 foreach e $treecontents($prefix) {
3211 if {$y == $l} {
3212 return "$prefix$e"
3213 }
3214 set n 1
3215 if {[string index $e end] eq "/"} {
3216 set n $treeheight($prefix$e)
3217 if {$y + $n > $l} {
3218 append prefix $e
3219 incr y
3220 break
3221 }
3222 }
3223 incr y $n
3224 }
3225 }
3226}
3227
45a9d505
PM
3228proc highlight_tree {y prefix} {
3229 global treeheight treecontents cflist
3230
3231 foreach e $treecontents($prefix) {
3232 set path $prefix$e
3233 if {[highlight_tag $path] ne {}} {
3234 $cflist tag add bold $y.0 "$y.0 lineend"
3235 }
3236 incr y
3237 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3238 set y [highlight_tree $y $path]
3239 }
3240 }
3241 return $y
3242}
3243
f8b28a40
PM
3244proc treeclosedir {w dir} {
3245 global treediropen treeheight treeparent treeindex
3246
3247 set ix $treeindex($dir)
3248 $w conf -state normal
3249 $w delete s:$ix e:$ix
3250 set treediropen($dir) 0
3251 $w image configure a:$ix -image tri-rt
3252 $w conf -state disabled
3253 set n [expr {1 - $treeheight($dir)}]
3254 while {$dir ne {}} {
3255 incr treeheight($dir) $n
3256 set dir $treeparent($dir)
3257 }
3258}
3259
3260proc treeopendir {w dir} {
3261 global treediropen treeheight treeparent treecontents treeindex
3262
3263 set ix $treeindex($dir)
3264 $w conf -state normal
3265 $w image configure a:$ix -image tri-dn
3266 $w mark set e:$ix s:$ix
3267 $w mark gravity e:$ix right
3268 set lev 0
3269 set str "\n"
3270 set n [llength $treecontents($dir)]
3271 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3272 incr lev
3273 append str "\t"
3274 incr treeheight($x) $n
3275 }
3276 foreach e $treecontents($dir) {
45a9d505 3277 set de $dir$e
f8b28a40 3278 if {[string index $e end] eq "/"} {
f8b28a40
PM
3279 set iy $treeindex($de)
3280 $w mark set d:$iy e:$ix
3281 $w mark gravity d:$iy left
3282 $w insert e:$ix $str
3283 set treediropen($de) 0
3284 $w image create e:$ix -align center -image tri-rt -padx 1 \
3285 -name a:$iy
45a9d505 3286 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3287 $w mark set s:$iy e:$ix
3288 $w mark gravity s:$iy left
3289 set treeheight($de) 1
3290 } else {
3291 $w insert e:$ix $str
45a9d505 3292 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3293 }
3294 }
b8a640ee 3295 $w mark gravity e:$ix right
f8b28a40
PM
3296 $w conf -state disabled
3297 set treediropen($dir) 1
3298 set top [lindex [split [$w index @0,0] .] 0]
3299 set ht [$w cget -height]
3300 set l [lindex [split [$w index s:$ix] .] 0]
3301 if {$l < $top} {
3302 $w yview $l.0
3303 } elseif {$l + $n + 1 > $top + $ht} {
3304 set top [expr {$l + $n + 2 - $ht}]
3305 if {$l < $top} {
3306 set top $l
3307 }
3308 $w yview $top.0
3309 }
3310}
3311
3312proc treeclick {w x y} {
3313 global treediropen cmitmode ctext cflist cflist_top
3314
3315 if {$cmitmode ne "tree"} return
3316 if {![info exists cflist_top]} return
3317 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3318 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3319 $cflist tag add highlight $l.0 "$l.0 lineend"
3320 set cflist_top $l
3321 if {$l == 1} {
3322 $ctext yview 1.0
3323 return
3324 }
3325 set e [linetoelt $l]
3326 if {[string index $e end] ne "/"} {
3327 showfile $e
3328 } elseif {$treediropen($e)} {
3329 treeclosedir $w $e
3330 } else {
3331 treeopendir $w $e
3332 }
3333}
3334
3335proc setfilelist {id} {
8a897742 3336 global treefilelist cflist jump_to_here
f8b28a40
PM
3337
3338 treeview $cflist $treefilelist($id) 0
8a897742
PM
3339 if {$jump_to_here ne {}} {
3340 set f [lindex $jump_to_here 0]
3341 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3342 showfile $f
3343 }
3344 }
f8b28a40
PM
3345}
3346
3347image create bitmap tri-rt -background black -foreground blue -data {
3348 #define tri-rt_width 13
3349 #define tri-rt_height 13
3350 static unsigned char tri-rt_bits[] = {
3351 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3352 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3353 0x00, 0x00};
3354} -maskdata {
3355 #define tri-rt-mask_width 13
3356 #define tri-rt-mask_height 13
3357 static unsigned char tri-rt-mask_bits[] = {
3358 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3359 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3360 0x08, 0x00};
3361}
3362image create bitmap tri-dn -background black -foreground blue -data {
3363 #define tri-dn_width 13
3364 #define tri-dn_height 13
3365 static unsigned char tri-dn_bits[] = {
3366 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3367 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3368 0x00, 0x00};
3369} -maskdata {
3370 #define tri-dn-mask_width 13
3371 #define tri-dn-mask_height 13
3372 static unsigned char tri-dn-mask_bits[] = {
3373 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3374 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3375 0x00, 0x00};
3376}
3377
887c996e
PM
3378image create bitmap reficon-T -background black -foreground yellow -data {
3379 #define tagicon_width 13
3380 #define tagicon_height 9
3381 static unsigned char tagicon_bits[] = {
3382 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3383 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3384} -maskdata {
3385 #define tagicon-mask_width 13
3386 #define tagicon-mask_height 9
3387 static unsigned char tagicon-mask_bits[] = {
3388 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3389 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3390}
3391set rectdata {
3392 #define headicon_width 13
3393 #define headicon_height 9
3394 static unsigned char headicon_bits[] = {
3395 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3396 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3397}
3398set rectmask {
3399 #define headicon-mask_width 13
3400 #define headicon-mask_height 9
3401 static unsigned char headicon-mask_bits[] = {
3402 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3403 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3404}
6e8fda5f 3405image create bitmap reficon-H -background black -foreground "#00ff00" \
887c996e 3406 -data $rectdata -maskdata $rectmask
d7cc4fb0
PW
3407image create bitmap reficon-R -background black -foreground "#ffddaa" \
3408 -data $rectdata -maskdata $rectmask
887c996e
PM
3409image create bitmap reficon-o -background black -foreground "#ddddff" \
3410 -data $rectdata -maskdata $rectmask
3411
7fcceed7 3412proc init_flist {first} {
7fcc92bf 3413 global cflist cflist_top difffilestart
7fcceed7
PM
3414
3415 $cflist conf -state normal
3416 $cflist delete 0.0 end
3417 if {$first ne {}} {
3418 $cflist insert end $first
3419 set cflist_top 1
7fcceed7
PM
3420 $cflist tag add highlight 1.0 "1.0 lineend"
3421 } else {
009409fe 3422 unset -nocomplain cflist_top
7fcceed7
PM
3423 }
3424 $cflist conf -state disabled
3425 set difffilestart {}
3426}
3427
63b79191
PM
3428proc highlight_tag {f} {
3429 global highlight_paths
3430
3431 foreach p $highlight_paths {
3432 if {[string match $p $f]} {
3433 return "bold"
3434 }
3435 }
3436 return {}
3437}
3438
3439proc highlight_filelist {} {
45a9d505 3440 global cmitmode cflist
63b79191 3441
45a9d505
PM
3442 $cflist conf -state normal
3443 if {$cmitmode ne "tree"} {
63b79191
PM
3444 set end [lindex [split [$cflist index end] .] 0]
3445 for {set l 2} {$l < $end} {incr l} {
3446 set line [$cflist get $l.0 "$l.0 lineend"]
3447 if {[highlight_tag $line] ne {}} {
3448 $cflist tag add bold $l.0 "$l.0 lineend"
3449 }
3450 }
45a9d505
PM
3451 } else {
3452 highlight_tree 2 {}
63b79191 3453 }
45a9d505 3454 $cflist conf -state disabled
63b79191
PM
3455}
3456
3457proc unhighlight_filelist {} {
45a9d505 3458 global cflist
63b79191 3459
45a9d505
PM
3460 $cflist conf -state normal
3461 $cflist tag remove bold 1.0 end
3462 $cflist conf -state disabled
63b79191
PM
3463}
3464
f8b28a40 3465proc add_flist {fl} {
45a9d505 3466 global cflist
7fcceed7 3467
45a9d505
PM
3468 $cflist conf -state normal
3469 foreach f $fl {
3470 $cflist insert end "\n"
3471 $cflist insert end $f [highlight_tag $f]
7fcceed7 3472 }
45a9d505 3473 $cflist conf -state disabled
7fcceed7
PM
3474}
3475
3476proc sel_flist {w x y} {
45a9d505 3477 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 3478
f8b28a40 3479 if {$cmitmode eq "tree"} return
7fcceed7
PM
3480 if {![info exists cflist_top]} return
3481 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
3482 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3483 $cflist tag add highlight $l.0 "$l.0 lineend"
3484 set cflist_top $l
f8b28a40
PM
3485 if {$l == 1} {
3486 $ctext yview 1.0
3487 } else {
3488 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 3489 }
b967135d 3490 suppress_highlighting_file_for_current_scrollpos
7fcceed7
PM
3491}
3492
3244729a
PM
3493proc pop_flist_menu {w X Y x y} {
3494 global ctext cflist cmitmode flist_menu flist_menu_file
3495 global treediffs diffids
3496
bb3edc8b 3497 stopfinding
3244729a
PM
3498 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3499 if {$l <= 1} return
3500 if {$cmitmode eq "tree"} {
3501 set e [linetoelt $l]
3502 if {[string index $e end] eq "/"} return
3503 } else {
3504 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3505 }
3506 set flist_menu_file $e
314f5de1
TA
3507 set xdiffstate "normal"
3508 if {$cmitmode eq "tree"} {
3509 set xdiffstate "disabled"
3510 }
3511 # Disable "External diff" item in tree mode
3512 $flist_menu entryconf 2 -state $xdiffstate
3244729a
PM
3513 tk_popup $flist_menu $X $Y
3514}
3515
7cdc3556
AG
3516proc find_ctext_fileinfo {line} {
3517 global ctext_file_names ctext_file_lines
3518
3519 set ok [bsearch $ctext_file_lines $line]
3520 set tline [lindex $ctext_file_lines $ok]
3521
3522 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3523 return {}
3524 } else {
3525 return [list [lindex $ctext_file_names $ok] $tline]
3526 }
3527}
3528
3529proc pop_diff_menu {w X Y x y} {
3530 global ctext diff_menu flist_menu_file
3531 global diff_menu_txtpos diff_menu_line
3532 global diff_menu_filebase
3533
7cdc3556
AG
3534 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3535 set diff_menu_line [lindex $diff_menu_txtpos 0]
190ec52c
PM
3536 # don't pop up the menu on hunk-separator or file-separator lines
3537 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3538 return
3539 }
3540 stopfinding
7cdc3556
AG
3541 set f [find_ctext_fileinfo $diff_menu_line]
3542 if {$f eq {}} return
3543 set flist_menu_file [lindex $f 0]
3544 set diff_menu_filebase [lindex $f 1]
3545 tk_popup $diff_menu $X $Y
3546}
3547
3244729a 3548proc flist_hl {only} {
bb3edc8b 3549 global flist_menu_file findstring gdttype
3244729a
PM
3550
3551 set x [shellquote $flist_menu_file]
b007ee20 3552 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 3553 set findstring $x
3244729a 3554 } else {
bb3edc8b 3555 append findstring " " $x
3244729a 3556 }
b007ee20 3557 set gdttype [mc "touching paths:"]
3244729a
PM
3558}
3559
c21398be 3560proc gitknewtmpdir {} {
c7664f1a 3561 global diffnum gitktmpdir gitdir env
c21398be
PM
3562
3563 if {![info exists gitktmpdir]} {
c7664f1a
DA
3564 if {[info exists env(GITK_TMPDIR)]} {
3565 set tmpdir $env(GITK_TMPDIR)
3566 } elseif {[info exists env(TMPDIR)]} {
3567 set tmpdir $env(TMPDIR)
3568 } else {
3569 set tmpdir $gitdir
3570 }
105b5d3f 3571 set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
ac54a4b7
DA
3572 if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3573 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3574 }
c21398be
PM
3575 if {[catch {file mkdir $gitktmpdir} err]} {
3576 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3577 unset gitktmpdir
3578 return {}
3579 }
3580 set diffnum 0
3581 }
3582 incr diffnum
3583 set diffdir [file join $gitktmpdir $diffnum]
3584 if {[catch {file mkdir $diffdir} err]} {
3585 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3586 return {}
3587 }
3588 return $diffdir
3589}
3590
314f5de1
TA
3591proc save_file_from_commit {filename output what} {
3592 global nullfile
3593
3594 if {[catch {exec git show $filename -- > $output} err]} {
3595 if {[string match "fatal: bad revision *" $err]} {
3596 return $nullfile
3597 }
3945d2c0 3598 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
314f5de1
TA
3599 return {}
3600 }
3601 return $output
3602}
3603
3604proc external_diff_get_one_file {diffid filename diffdir} {
3605 global nullid nullid2 nullfile
784b7e2f 3606 global worktree
314f5de1
TA
3607
3608 if {$diffid == $nullid} {
784b7e2f 3609 set difffile [file join $worktree $filename]
314f5de1
TA
3610 if {[file exists $difffile]} {
3611 return $difffile
3612 }
3613 return $nullfile
3614 }
3615 if {$diffid == $nullid2} {
3616 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3617 return [save_file_from_commit :$filename $difffile index]
3618 }
3619 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3620 return [save_file_from_commit $diffid:$filename $difffile \
3621 "revision $diffid"]
3622}
3623
3624proc external_diff {} {
c21398be 3625 global nullid nullid2
314f5de1
TA
3626 global flist_menu_file
3627 global diffids
c21398be 3628 global extdifftool
314f5de1
TA
3629
3630 if {[llength $diffids] == 1} {
3631 # no reference commit given
3632 set diffidto [lindex $diffids 0]
3633 if {$diffidto eq $nullid} {
3634 # diffing working copy with index
3635 set diffidfrom $nullid2
3636 } elseif {$diffidto eq $nullid2} {
3637 # diffing index with HEAD
3638 set diffidfrom "HEAD"
3639 } else {
3640 # use first parent commit
3641 global parentlist selectedline
3642 set diffidfrom [lindex $parentlist $selectedline 0]
3643 }
3644 } else {
3645 set diffidfrom [lindex $diffids 0]
3646 set diffidto [lindex $diffids 1]
3647 }
3648
3649 # make sure that several diffs wont collide
c21398be
PM
3650 set diffdir [gitknewtmpdir]
3651 if {$diffdir eq {}} return
314f5de1
TA
3652
3653 # gather files to diff
3654 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3655 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3656
3657 if {$difffromfile ne {} && $difftofile ne {}} {
b575b2f1
PT
3658 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3659 if {[catch {set fl [open |$cmd r]} err]} {
314f5de1 3660 file delete -force $diffdir
3945d2c0 3661 error_popup "$extdifftool: [mc "command failed:"] $err"
314f5de1
TA
3662 } else {
3663 fconfigure $fl -blocking 0
3664 filerun $fl [list delete_at_eof $fl $diffdir]
3665 }
3666 }
3667}
3668
7cdc3556
AG
3669proc find_hunk_blamespec {base line} {
3670 global ctext
3671
3672 # Find and parse the hunk header
3673 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3674 if {$s_lix eq {}} return
3675
3676 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3677 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3678 s_line old_specs osz osz1 new_line nsz]} {
3679 return
3680 }
3681
3682 # base lines for the parents
3683 set base_lines [list $new_line]
3684 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3685 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3686 old_spec old_line osz]} {
3687 return
3688 }
3689 lappend base_lines $old_line
3690 }
3691
3692 # Now scan the lines to determine offset within the hunk
7cdc3556
AG
3693 set max_parent [expr {[llength $base_lines]-2}]
3694 set dline 0
3695 set s_lno [lindex [split $s_lix "."] 0]
3696
190ec52c
PM
3697 # Determine if the line is removed
3698 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3699 if {[string match {[-+ ]*} $chunk]} {
7cdc3556
AG
3700 set removed_idx [string first "-" $chunk]
3701 # Choose a parent index
190ec52c
PM
3702 if {$removed_idx >= 0} {
3703 set parent $removed_idx
3704 } else {
3705 set unchanged_idx [string first " " $chunk]
3706 if {$unchanged_idx >= 0} {
3707 set parent $unchanged_idx
7cdc3556 3708 } else {
190ec52c
PM
3709 # blame the current commit
3710 set parent -1
7cdc3556
AG
3711 }
3712 }
3713 # then count other lines that belong to it
190ec52c
PM
3714 for {set i $line} {[incr i -1] > $s_lno} {} {
3715 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3716 # Determine if the line is removed
3717 set removed_idx [string first "-" $chunk]
3718 if {$parent >= 0} {
3719 set code [string index $chunk $parent]
3720 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3721 incr dline
3722 }
3723 } else {
3724 if {$removed_idx < 0} {
3725 incr dline
3726 }
7cdc3556
AG
3727 }
3728 }
190ec52c
PM
3729 incr parent
3730 } else {
3731 set parent 0
7cdc3556
AG
3732 }
3733
7cdc3556
AG
3734 incr dline [lindex $base_lines $parent]
3735 return [list $parent $dline]
3736}
3737
3738proc external_blame_diff {} {
8b07dca1 3739 global currentid cmitmode
7cdc3556
AG
3740 global diff_menu_txtpos diff_menu_line
3741 global diff_menu_filebase flist_menu_file
3742
3743 if {$cmitmode eq "tree"} {
3744 set parent_idx 0
190ec52c 3745 set line [expr {$diff_menu_line - $diff_menu_filebase}]
7cdc3556
AG
3746 } else {
3747 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3748 if {$hinfo ne {}} {
3749 set parent_idx [lindex $hinfo 0]
3750 set line [lindex $hinfo 1]
3751 } else {
3752 set parent_idx 0
3753 set line 0
3754 }
3755 }
3756
3757 external_blame $parent_idx $line
3758}
3759
fc4977e1
PM
3760# Find the SHA1 ID of the blob for file $fname in the index
3761# at stage 0 or 2
3762proc index_sha1 {fname} {
3763 set f [open [list | git ls-files -s $fname] r]
3764 while {[gets $f line] >= 0} {
3765 set info [lindex [split $line "\t"] 0]
3766 set stage [lindex $info 2]
3767 if {$stage eq "0" || $stage eq "2"} {
3768 close $f
3769 return [lindex $info 1]
3770 }
3771 }
3772 close $f
3773 return {}
3774}
3775
9712b81a
PM
3776# Turn an absolute path into one relative to the current directory
3777proc make_relative {f} {
a4390ace
MH
3778 if {[file pathtype $f] eq "relative"} {
3779 return $f
3780 }
9712b81a
PM
3781 set elts [file split $f]
3782 set here [file split [pwd]]
3783 set ei 0
3784 set hi 0
3785 set res {}
3786 foreach d $here {
3787 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3788 lappend res ".."
3789 } else {
3790 incr ei
3791 }
3792 incr hi
3793 }
3794 set elts [concat $res [lrange $elts $ei end]]
3795 return [eval file join $elts]
3796}
3797
7cdc3556 3798proc external_blame {parent_idx {line {}}} {
0a2a9793 3799 global flist_menu_file cdup
77aa0ae8
AG
3800 global nullid nullid2
3801 global parentlist selectedline currentid
3802
3803 if {$parent_idx > 0} {
3804 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3805 } else {
3806 set base_commit $currentid
3807 }
3808
3809 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3810 error_popup [mc "No such commit"]
3811 return
3812 }
3813
7cdc3556
AG
3814 set cmdline [list git gui blame]
3815 if {$line ne {} && $line > 1} {
3816 lappend cmdline "--line=$line"
3817 }
0a2a9793 3818 set f [file join $cdup $flist_menu_file]
9712b81a
PM
3819 # Unfortunately it seems git gui blame doesn't like
3820 # being given an absolute path...
3821 set f [make_relative $f]
3822 lappend cmdline $base_commit $f
7cdc3556 3823 if {[catch {eval exec $cmdline &} err]} {
3945d2c0 3824 error_popup "[mc "git gui blame: command failed:"] $err"
77aa0ae8
AG
3825 }
3826}
3827
8a897742
PM
3828proc show_line_source {} {
3829 global cmitmode currentid parents curview blamestuff blameinst
3830 global diff_menu_line diff_menu_filebase flist_menu_file
9b6adf34 3831 global nullid nullid2 gitdir cdup
8a897742 3832
fc4977e1 3833 set from_index {}
8a897742
PM
3834 if {$cmitmode eq "tree"} {
3835 set id $currentid
3836 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3837 } else {
3838 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3839 if {$h eq {}} return
3840 set pi [lindex $h 0]
3841 if {$pi == 0} {
3842 mark_ctext_line $diff_menu_line
3843 return
3844 }
fc4977e1
PM
3845 incr pi -1
3846 if {$currentid eq $nullid} {
3847 if {$pi > 0} {
3848 # must be a merge in progress...
3849 if {[catch {
3850 # get the last line from .git/MERGE_HEAD
3851 set f [open [file join $gitdir MERGE_HEAD] r]
3852 set id [lindex [split [read $f] "\n"] end-1]
3853 close $f
3854 } err]} {
3855 error_popup [mc "Couldn't read merge head: %s" $err]
3856 return
3857 }
3858 } elseif {$parents($curview,$currentid) eq $nullid2} {
3859 # need to do the blame from the index
3860 if {[catch {
3861 set from_index [index_sha1 $flist_menu_file]
3862 } err]} {
3863 error_popup [mc "Error reading index: %s" $err]
3864 return
3865 }
9712b81a
PM
3866 } else {
3867 set id $parents($curview,$currentid)
fc4977e1
PM
3868 }
3869 } else {
3870 set id [lindex $parents($curview,$currentid) $pi]
3871 }
8a897742
PM
3872 set line [lindex $h 1]
3873 }
fc4977e1
PM
3874 set blameargs {}
3875 if {$from_index ne {}} {
3876 lappend blameargs | git cat-file blob $from_index
3877 }
3878 lappend blameargs | git blame -p -L$line,+1
3879 if {$from_index ne {}} {
3880 lappend blameargs --contents -
3881 } else {
3882 lappend blameargs $id
3883 }
9b6adf34 3884 lappend blameargs -- [file join $cdup $flist_menu_file]
8a897742 3885 if {[catch {
fc4977e1 3886 set f [open $blameargs r]
8a897742
PM
3887 } err]} {
3888 error_popup [mc "Couldn't start git blame: %s" $err]
3889 return
3890 }
f3413079 3891 nowbusy blaming [mc "Searching"]
8a897742
PM
3892 fconfigure $f -blocking 0
3893 set i [reg_instance $f]
3894 set blamestuff($i) {}
3895 set blameinst $i
3896 filerun $f [list read_line_source $f $i]
3897}
3898
3899proc stopblaming {} {
3900 global blameinst
3901
3902 if {[info exists blameinst]} {
3903 stop_instance $blameinst
3904 unset blameinst
f3413079 3905 notbusy blaming
8a897742
PM
3906 }
3907}
3908
3909proc read_line_source {fd inst} {
fc4977e1 3910 global blamestuff curview commfd blameinst nullid nullid2
8a897742
PM
3911
3912 while {[gets $fd line] >= 0} {
3913 lappend blamestuff($inst) $line
3914 }
3915 if {![eof $fd]} {
3916 return 1
3917 }
3918 unset commfd($inst)
3919 unset blameinst
f3413079 3920 notbusy blaming
8a897742
PM
3921 fconfigure $fd -blocking 1
3922 if {[catch {close $fd} err]} {
3923 error_popup [mc "Error running git blame: %s" $err]
3924 return 0
3925 }
3926
3927 set fname {}
3928 set line [split [lindex $blamestuff($inst) 0] " "]
3929 set id [lindex $line 0]
3930 set lnum [lindex $line 1]
3931 if {[string length $id] == 40 && [string is xdigit $id] &&
3932 [string is digit -strict $lnum]} {
3933 # look for "filename" line
3934 foreach l $blamestuff($inst) {
3935 if {[string match "filename *" $l]} {
3936 set fname [string range $l 9 end]
3937 break
3938 }
3939 }
3940 }
3941 if {$fname ne {}} {
3942 # all looks good, select it
fc4977e1
PM
3943 if {$id eq $nullid} {
3944 # blame uses all-zeroes to mean not committed,
3945 # which would mean a change in the index
3946 set id $nullid2
3947 }
8a897742 3948 if {[commitinview $id $curview]} {
4135d36b 3949 selectline [rowofcommit $id] 1 [list $fname $lnum] 1
8a897742
PM
3950 } else {
3951 error_popup [mc "That line comes from commit %s, \
3952 which is not in this view" [shortids $id]]
3953 }
3954 } else {
3955 puts "oops couldn't parse git blame output"
3956 }
3957 return 0
3958}
3959
314f5de1
TA
3960# delete $dir when we see eof on $f (presumably because the child has exited)
3961proc delete_at_eof {f dir} {
3962 while {[gets $f line] >= 0} {}
3963 if {[eof $f]} {
3964 if {[catch {close $f} err]} {
3945d2c0 3965 error_popup "[mc "External diff viewer failed:"] $err"
314f5de1
TA
3966 }
3967 file delete -force $dir
3968 return 0
3969 }
3970 return 1
3971}
3972
098dd8a3
PM
3973# Functions for adding and removing shell-type quoting
3974
3975proc shellquote {str} {
3976 if {![string match "*\['\"\\ \t]*" $str]} {
3977 return $str
3978 }
3979 if {![string match "*\['\"\\]*" $str]} {
3980 return "\"$str\""
3981 }
3982 if {![string match "*'*" $str]} {
3983 return "'$str'"
3984 }
3985 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3986}
3987
3988proc shellarglist {l} {
3989 set str {}
3990 foreach a $l {
3991 if {$str ne {}} {
3992 append str " "
3993 }
3994 append str [shellquote $a]
3995 }
3996 return $str
3997}
3998
3999proc shelldequote {str} {
4000 set ret {}
4001 set used -1
4002 while {1} {
4003 incr used
4004 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4005 append ret [string range $str $used end]
4006 set used [string length $str]
4007 break
4008 }
4009 set first [lindex $first 0]
4010 set ch [string index $str $first]
4011 if {$first > $used} {
4012 append ret [string range $str $used [expr {$first - 1}]]
4013 set used $first
4014 }
4015 if {$ch eq " " || $ch eq "\t"} break
4016 incr used
4017 if {$ch eq "'"} {
4018 set first [string first "'" $str $used]
4019 if {$first < 0} {
4020 error "unmatched single-quote"
4021 }
4022 append ret [string range $str $used [expr {$first - 1}]]
4023 set used $first
4024 continue
4025 }
4026 if {$ch eq "\\"} {
4027 if {$used >= [string length $str]} {
4028 error "trailing backslash"
4029 }
4030 append ret [string index $str $used]
4031 continue
4032 }
4033 # here ch == "\""
4034 while {1} {
4035 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4036 error "unmatched double-quote"
4037 }
4038 set first [lindex $first 0]
4039 set ch [string index $str $first]
4040 if {$first > $used} {
4041 append ret [string range $str $used [expr {$first - 1}]]
4042 set used $first
4043 }
4044 if {$ch eq "\""} break
4045 incr used
4046 append ret [string index $str $used]
4047 incr used
4048 }
4049 }
4050 return [list $used $ret]
4051}
4052
4053proc shellsplit {str} {
4054 set l {}
4055 while {1} {
4056 set str [string trimleft $str]
4057 if {$str eq {}} break
4058 set dq [shelldequote $str]
4059 set n [lindex $dq 0]
4060 set word [lindex $dq 1]
4061 set str [string range $str $n end]
4062 lappend l $word
4063 }
4064 return $l
4065}
4066
9922c5a3
MB
4067proc set_window_title {} {
4068 global appname curview viewname vrevs
4069 set rev [mc "All files"]
4070 if {$curview ne 0} {
4071 if {$viewname($curview) eq [mc "Command line"]} {
4072 set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4073 } else {
4074 set rev $viewname($curview)
4075 }
4076 }
4077 wm title . "[reponame]: $rev - $appname"
4078}
4079
7fcceed7
PM
4080# Code to implement multiple views
4081
da7c24dd 4082proc newview {ishighlight} {
218a900b
AG
4083 global nextviewnum newviewname newishighlight
4084 global revtreeargs viewargscmd newviewopts curview
50b44ece 4085
da7c24dd 4086 set newishighlight $ishighlight
50b44ece
PM
4087 set top .gitkview
4088 if {[winfo exists $top]} {
4089 raise $top
4090 return
4091 }
5d11f794 4092 decode_view_opts $nextviewnum $revtreeargs
a3a1f579 4093 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
218a900b
AG
4094 set newviewopts($nextviewnum,perm) 0
4095 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
d990cedf 4096 vieweditor $top $nextviewnum [mc "Gitk view definition"]
d16c0812
PM
4097}
4098
218a900b 4099set known_view_options {
13d40b61
EN
4100 {perm b . {} {mc "Remember this view"}}
4101 {reflabel l + {} {mc "References (space separated list):"}}
4102 {refs t15 .. {} {mc "Branches & tags:"}}
4103 {allrefs b *. "--all" {mc "All refs"}}
4104 {branches b . "--branches" {mc "All (local) branches"}}
4105 {tags b . "--tags" {mc "All tags"}}
4106 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
4107 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
4108 {author t15 .. "--author=*" {mc "Author:"}}
4109 {committer t15 . "--committer=*" {mc "Committer:"}}
4110 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
4111 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
0013251f 4112 {igrep b .. "--invert-grep" {mc "Matches no Commit Info criteria"}}
13d40b61
EN
4113 {changes_l l + {} {mc "Changes to Files:"}}
4114 {pickaxe_s r0 . {} {mc "Fixed String"}}
4115 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
4116 {pickaxe t15 .. "-S*" {mc "Search string:"}}
4117 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4118 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
4119 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
4120 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
4121 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
4122 {skip t10 . "--skip=*" {mc "Number to skip:"}}
4123 {misc_lbl l + {} {mc "Miscellaneous options:"}}
4124 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
4125 {lright b . "--left-right" {mc "Mark branch sides"}}
4126 {first b . "--first-parent" {mc "Limit to first parent"}}
f687aaa8 4127 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
13d40b61
EN
4128 {args t50 *. {} {mc "Additional arguments to git log:"}}
4129 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4130 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
218a900b
AG
4131 }
4132
e7feb695 4133# Convert $newviewopts($n, ...) into args for git log.
218a900b
AG
4134proc encode_view_opts {n} {
4135 global known_view_options newviewopts
4136
4137 set rargs [list]
4138 foreach opt $known_view_options {
4139 set patterns [lindex $opt 3]
4140 if {$patterns eq {}} continue
4141 set pattern [lindex $patterns 0]
4142
218a900b 4143 if {[lindex $opt 1] eq "b"} {
13d40b61 4144 set val $newviewopts($n,[lindex $opt 0])
218a900b
AG
4145 if {$val} {
4146 lappend rargs $pattern
4147 }
13d40b61
EN
4148 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4149 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4150 set val $newviewopts($n,$button_id)
4151 if {$val eq $value} {
4152 lappend rargs $pattern
4153 }
218a900b 4154 } else {
13d40b61 4155 set val $newviewopts($n,[lindex $opt 0])
218a900b
AG
4156 set val [string trim $val]
4157 if {$val ne {}} {
4158 set pfix [string range $pattern 0 end-1]
4159 lappend rargs $pfix$val
4160 }
4161 }
4162 }
13d40b61 4163 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
218a900b
AG
4164 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4165}
4166
e7feb695 4167# Fill $newviewopts($n, ...) based on args for git log.
218a900b
AG
4168proc decode_view_opts {n view_args} {
4169 global known_view_options newviewopts
4170
4171 foreach opt $known_view_options {
13d40b61 4172 set id [lindex $opt 0]
218a900b 4173 if {[lindex $opt 1] eq "b"} {
13d40b61
EN
4174 # Checkboxes
4175 set val 0
4176 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4177 # Radiobuttons
4178 regexp {^(.*_)} $id uselessvar id
218a900b
AG
4179 set val 0
4180 } else {
13d40b61 4181 # Text fields
218a900b
AG
4182 set val {}
4183 }
13d40b61 4184 set newviewopts($n,$id) $val
218a900b
AG
4185 }
4186 set oargs [list]
13d40b61 4187 set refargs [list]
218a900b
AG
4188 foreach arg $view_args {
4189 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4190 && ![info exists found(limit)]} {
4191 set newviewopts($n,limit) $cnt
4192 set found(limit) 1
4193 continue
4194 }
4195 catch { unset val }
4196 foreach opt $known_view_options {
4197 set id [lindex $opt 0]
4198 if {[info exists found($id)]} continue
4199 foreach pattern [lindex $opt 3] {
4200 if {![string match $pattern $arg]} continue
13d40b61
EN
4201 if {[lindex $opt 1] eq "b"} {
4202 # Check buttons
4203 set val 1
4204 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4205 # Radio buttons
4206 regexp {^(.*_)} $id uselessvar id
4207 set val $num
4208 } else {
4209 # Text input fields
218a900b
AG
4210 set size [string length $pattern]
4211 set val [string range $arg [expr {$size-1}] end]
218a900b
AG
4212 }
4213 set newviewopts($n,$id) $val
4214 set found($id) 1
4215 break
4216 }
4217 if {[info exists val]} break
4218 }
4219 if {[info exists val]} continue
13d40b61
EN
4220 if {[regexp {^-} $arg]} {
4221 lappend oargs $arg
4222 } else {
4223 lappend refargs $arg
4224 }
218a900b 4225 }
13d40b61 4226 set newviewopts($n,refs) [shellarglist $refargs]
218a900b
AG
4227 set newviewopts($n,args) [shellarglist $oargs]
4228}
4229
cea07cf8
AG
4230proc edit_or_newview {} {
4231 global curview
4232
4233 if {$curview > 0} {
4234 editview
4235 } else {
4236 newview 0
4237 }
4238}
4239
d16c0812
PM
4240proc editview {} {
4241 global curview
218a900b
AG
4242 global viewname viewperm newviewname newviewopts
4243 global viewargs viewargscmd
d16c0812
PM
4244
4245 set top .gitkvedit-$curview
4246 if {[winfo exists $top]} {
4247 raise $top
4248 return
4249 }
5d11f794 4250 decode_view_opts $curview $viewargs($curview)
218a900b
AG
4251 set newviewname($curview) $viewname($curview)
4252 set newviewopts($curview,perm) $viewperm($curview)
4253 set newviewopts($curview,cmd) $viewargscmd($curview)
b56e0a9a 4254 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
d16c0812
PM
4255}
4256
4257proc vieweditor {top n title} {
218a900b 4258 global newviewname newviewopts viewfiles bgcolor
d93f1713 4259 global known_view_options NS
d16c0812 4260
d93f1713 4261 ttk_toplevel $top
e0a01995 4262 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
e7d64008 4263 make_transient $top .
218a900b
AG
4264
4265 # View name
d93f1713 4266 ${NS}::frame $top.nfr
eae7d64a 4267 ${NS}::label $top.nl -text [mc "View Name"]
d93f1713 4268 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
218a900b 4269 pack $top.nfr -in $top -fill x -pady 5 -padx 3
13d40b61
EN
4270 pack $top.nl -in $top.nfr -side left -padx {0 5}
4271 pack $top.name -in $top.nfr -side left -padx {0 25}
218a900b
AG
4272
4273 # View options
4274 set cframe $top.nfr
4275 set cexpand 0
4276 set cnt 0
4277 foreach opt $known_view_options {
4278 set id [lindex $opt 0]
4279 set type [lindex $opt 1]
4280 set flags [lindex $opt 2]
4281 set title [eval [lindex $opt 4]]
4282 set lxpad 0
4283
4284 if {$flags eq "+" || $flags eq "*"} {
4285 set cframe $top.fr$cnt
4286 incr cnt
d93f1713 4287 ${NS}::frame $cframe
218a900b
AG
4288 pack $cframe -in $top -fill x -pady 3 -padx 3
4289 set cexpand [expr {$flags eq "*"}]
13d40b61
EN
4290 } elseif {$flags eq ".." || $flags eq "*."} {
4291 set cframe $top.fr$cnt
4292 incr cnt
eae7d64a 4293 ${NS}::frame $cframe
13d40b61
EN
4294 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4295 set cexpand [expr {$flags eq "*."}]
218a900b
AG
4296 } else {
4297 set lxpad 5
4298 }
4299
13d40b61 4300 if {$type eq "l"} {
eae7d64a 4301 ${NS}::label $cframe.l_$id -text $title
13d40b61
EN
4302 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4303 } elseif {$type eq "b"} {
d93f1713 4304 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
218a900b
AG
4305 pack $cframe.c_$id -in $cframe -side left \
4306 -padx [list $lxpad 0] -expand $cexpand -anchor w
13d40b61
EN
4307 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4308 regexp {^(.*_)} $id uselessvar button_id
eae7d64a 4309 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
13d40b61
EN
4310 pack $cframe.c_$id -in $cframe -side left \
4311 -padx [list $lxpad 0] -expand $cexpand -anchor w
218a900b 4312 } elseif {[regexp {^t(\d+)$} $type type sz]} {
d93f1713
PT
4313 ${NS}::label $cframe.l_$id -text $title
4314 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
4315 -textvariable newviewopts($n,$id)
4316 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4317 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4318 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
d93f1713
PT
4319 ${NS}::label $cframe.l_$id -text $title
4320 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
218a900b
AG
4321 -textvariable newviewopts($n,$id)
4322 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4323 pack $cframe.e_$id -in $cframe -side top -fill x
13d40b61 4324 } elseif {$type eq "path"} {
eae7d64a 4325 ${NS}::label $top.l -text $title
13d40b61 4326 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
b9b142ff 4327 text $top.t -width 40 -height 5 -background $bgcolor
13d40b61
EN
4328 if {[info exists viewfiles($n)]} {
4329 foreach f $viewfiles($n) {
4330 $top.t insert end $f
4331 $top.t insert end "\n"
4332 }
4333 $top.t delete {end - 1c} end
4334 $top.t mark set insert 0.0
4335 }
4336 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
218a900b
AG
4337 }
4338 }
4339
d93f1713
PT
4340 ${NS}::frame $top.buts
4341 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4342 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4343 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
218a900b
AG
4344 bind $top <Control-Return> [list newviewok $top $n]
4345 bind $top <F5> [list newviewok $top $n 1]
76f15947 4346 bind $top <Escape> [list destroy $top]
218a900b 4347 grid $top.buts.ok $top.buts.apply $top.buts.can
50b44ece
PM
4348 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4349 grid columnconfigure $top.buts 1 -weight 1 -uniform a
218a900b
AG
4350 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4351 pack $top.buts -in $top -side top -fill x
50b44ece
PM
4352 focus $top.t
4353}
4354
908c3585 4355proc doviewmenu {m first cmd op argv} {
da7c24dd
PM
4356 set nmenu [$m index end]
4357 for {set i $first} {$i <= $nmenu} {incr i} {
4358 if {[$m entrycget $i -command] eq $cmd} {
908c3585 4359 eval $m $op $i $argv
da7c24dd 4360 break
d16c0812
PM
4361 }
4362 }
da7c24dd
PM
4363}
4364
4365proc allviewmenus {n op args} {
687c8765 4366 # global viewhlmenu
908c3585 4367
3cd204e5 4368 doviewmenu .bar.view 5 [list showview $n] $op $args
687c8765 4369 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
d16c0812
PM
4370}
4371
218a900b 4372proc newviewok {top n {apply 0}} {
da7c24dd 4373 global nextviewnum newviewperm newviewname newishighlight
995f792b 4374 global viewname viewfiles viewperm viewchanged selectedview curview
218a900b 4375 global viewargs viewargscmd newviewopts viewhlmenu
50b44ece 4376
098dd8a3 4377 if {[catch {
218a900b 4378 set newargs [encode_view_opts $n]
098dd8a3 4379 } err]} {
84a76f18 4380 error_popup "[mc "Error in commit selection arguments:"] $err" $top
098dd8a3
PM
4381 return
4382 }
50b44ece 4383 set files {}
d16c0812 4384 foreach f [split [$top.t get 0.0 end] "\n"] {
50b44ece
PM
4385 set ft [string trim $f]
4386 if {$ft ne {}} {
4387 lappend files $ft
4388 }
4389 }
d16c0812
PM
4390 if {![info exists viewfiles($n)]} {
4391 # creating a new view
4392 incr nextviewnum
4393 set viewname($n) $newviewname($n)
218a900b 4394 set viewperm($n) $newviewopts($n,perm)
995f792b 4395 set viewchanged($n) 1
d16c0812 4396 set viewfiles($n) $files
098dd8a3 4397 set viewargs($n) $newargs
218a900b 4398 set viewargscmd($n) $newviewopts($n,cmd)
da7c24dd
PM
4399 addviewmenu $n
4400 if {!$newishighlight} {
7eb3cb9c 4401 run showview $n
da7c24dd 4402 } else {
7eb3cb9c 4403 run addvhighlight $n
da7c24dd 4404 }
d16c0812
PM
4405 } else {
4406 # editing an existing view
218a900b 4407 set viewperm($n) $newviewopts($n,perm)
995f792b 4408 set viewchanged($n) 1
d16c0812
PM
4409 if {$newviewname($n) ne $viewname($n)} {
4410 set viewname($n) $newviewname($n)
3cd204e5 4411 doviewmenu .bar.view 5 [list showview $n] \
908c3585 4412 entryconf [list -label $viewname($n)]
687c8765
PM
4413 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4414 # entryconf [list -label $viewname($n) -value $viewname($n)]
d16c0812 4415 }
2d480856 4416 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
218a900b 4417 $newviewopts($n,cmd) ne $viewargscmd($n)} {
d16c0812 4418 set viewfiles($n) $files
098dd8a3 4419 set viewargs($n) $newargs
218a900b 4420 set viewargscmd($n) $newviewopts($n,cmd)
d16c0812 4421 if {$curview == $n} {
7fcc92bf 4422 run reloadcommits
d16c0812
PM
4423 }
4424 }
4425 }
218a900b 4426 if {$apply} return
d16c0812 4427 catch {destroy $top}
50b44ece
PM
4428}
4429
4430proc delview {} {
995f792b 4431 global curview viewperm hlview selectedhlview viewchanged
50b44ece
PM
4432
4433 if {$curview == 0} return
908c3585 4434 if {[info exists hlview] && $hlview == $curview} {
b007ee20 4435 set selectedhlview [mc "None"]
908c3585
PM
4436 unset hlview
4437 }
da7c24dd 4438 allviewmenus $curview delete
a90a6d24 4439 set viewperm($curview) 0
995f792b 4440 set viewchanged($curview) 1
50b44ece
PM
4441 showview 0
4442}
4443
da7c24dd 4444proc addviewmenu {n} {
908c3585 4445 global viewname viewhlmenu
da7c24dd
PM
4446
4447 .bar.view add radiobutton -label $viewname($n) \
4448 -command [list showview $n] -variable selectedview -value $n
687c8765
PM
4449 #$viewhlmenu add radiobutton -label $viewname($n) \
4450 # -command [list addvhighlight $n] -variable selectedhlview
da7c24dd
PM
4451}
4452
50b44ece 4453proc showview {n} {
3ed31a81 4454 global curview cached_commitrow ordertok
f5f3c2e2 4455 global displayorder parentlist rowidlist rowisopt rowfinal
7fcc92bf
PM
4456 global colormap rowtextx nextcolor canvxmax
4457 global numcommits viewcomplete
50b44ece 4458 global selectedline currentid canv canvy0
4fb0fa19 4459 global treediffs
3e76608d 4460 global pending_select mainheadid
0380081c 4461 global commitidx
3e76608d 4462 global selectedview
97645683 4463 global hlview selectedhlview commitinterest
50b44ece
PM
4464
4465 if {$n == $curview} return
4466 set selid {}
7fcc92bf
PM
4467 set ymax [lindex [$canv cget -scrollregion] 3]
4468 set span [$canv yview]
4469 set ytop [expr {[lindex $span 0] * $ymax}]
4470 set ybot [expr {[lindex $span 1] * $ymax}]
4471 set yscreen [expr {($ybot - $ytop) / 2}]
94b4a69f 4472 if {$selectedline ne {}} {
50b44ece
PM
4473 set selid $currentid
4474 set y [yc $selectedline]
50b44ece
PM
4475 if {$ytop < $y && $y < $ybot} {
4476 set yscreen [expr {$y - $ytop}]
50b44ece 4477 }
e507fd48
PM
4478 } elseif {[info exists pending_select]} {
4479 set selid $pending_select
4480 unset pending_select
50b44ece
PM
4481 }
4482 unselectline
fdedbcfb 4483 normalline
009409fe 4484 unset -nocomplain treediffs
50b44ece 4485 clear_display
908c3585
PM
4486 if {[info exists hlview] && $hlview == $n} {
4487 unset hlview
b007ee20 4488 set selectedhlview [mc "None"]
908c3585 4489 }
009409fe
PM
4490 unset -nocomplain commitinterest
4491 unset -nocomplain cached_commitrow
4492 unset -nocomplain ordertok
50b44ece
PM
4493
4494 set curview $n
a90a6d24 4495 set selectedview $n
d99b4b0d
GB
4496 .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4497 .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
50b44ece 4498
df904497 4499 run refill_reflist
7fcc92bf 4500 if {![info exists viewcomplete($n)]} {
567c34e0 4501 getcommits $selid
50b44ece
PM
4502 return
4503 }
4504
7fcc92bf
PM
4505 set displayorder {}
4506 set parentlist {}
4507 set rowidlist {}
4508 set rowisopt {}
4509 set rowfinal {}
f5f3c2e2 4510 set numcommits $commitidx($n)
22626ef4 4511
009409fe
PM
4512 unset -nocomplain colormap
4513 unset -nocomplain rowtextx
da7c24dd
PM
4514 set nextcolor 0
4515 set canvxmax [$canv cget -width]
50b44ece
PM
4516 set curview $n
4517 set row 0
50b44ece
PM
4518 setcanvscroll
4519 set yf 0
e507fd48 4520 set row {}
7fcc92bf
PM
4521 if {$selid ne {} && [commitinview $selid $n]} {
4522 set row [rowofcommit $selid]
50b44ece
PM
4523 # try to get the selected row in the same position on the screen
4524 set ymax [lindex [$canv cget -scrollregion] 3]
4525 set ytop [expr {[yc $row] - $yscreen}]
4526 if {$ytop < 0} {
4527 set ytop 0
4528 }
4529 set yf [expr {$ytop * 1.0 / $ymax}]
4530 }
4531 allcanvs yview moveto $yf
4532 drawvisible
e507fd48
PM
4533 if {$row ne {}} {
4534 selectline $row 0
3e76608d 4535 } elseif {!$viewcomplete($n)} {
567c34e0 4536 reset_pending_select $selid
e507fd48 4537 } else {
835e62ae
AG
4538 reset_pending_select {}
4539
4540 if {[commitinview $pending_select $curview]} {
4541 selectline [rowofcommit $pending_select] 1
4542 } else {
4543 set row [first_real_row]
4544 if {$row < $numcommits} {
4545 selectline $row 0
4546 }
e507fd48
PM
4547 }
4548 }
7fcc92bf
PM
4549 if {!$viewcomplete($n)} {
4550 if {$numcommits == 0} {
d990cedf 4551 show_status [mc "Reading commits..."]
d16c0812 4552 }
098dd8a3 4553 } elseif {$numcommits == 0} {
d990cedf 4554 show_status [mc "No commits selected"]
2516dae2 4555 }
9922c5a3 4556 set_window_title
50b44ece
PM
4557}
4558
908c3585
PM
4559# Stuff relating to the highlighting facility
4560
476ca63d 4561proc ishighlighted {id} {
164ff275 4562 global vhighlights fhighlights nhighlights rhighlights
908c3585 4563
476ca63d
PM
4564 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4565 return $nhighlights($id)
908c3585 4566 }
476ca63d
PM
4567 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4568 return $vhighlights($id)
908c3585 4569 }
476ca63d
PM
4570 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4571 return $fhighlights($id)
908c3585 4572 }
476ca63d
PM
4573 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4574 return $rhighlights($id)
164ff275 4575 }
908c3585
PM
4576 return 0
4577}
4578
28593d3f 4579proc bolden {id font} {
b9fdba7f 4580 global canv linehtag currentid boldids need_redisplay markedid
908c3585 4581
d98d50e2
PM
4582 # need_redisplay = 1 means the display is stale and about to be redrawn
4583 if {$need_redisplay} return
28593d3f
PM
4584 lappend boldids $id
4585 $canv itemconf $linehtag($id) -font $font
4586 if {[info exists currentid] && $id eq $currentid} {
908c3585 4587 $canv delete secsel
28593d3f 4588 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
908c3585
PM
4589 -outline {{}} -tags secsel \
4590 -fill [$canv cget -selectbackground]]
4591 $canv lower $t
4592 }
b9fdba7f
PM
4593 if {[info exists markedid] && $id eq $markedid} {
4594 make_idmark $id
4595 }
908c3585
PM
4596}
4597
28593d3f
PM
4598proc bolden_name {id font} {
4599 global canv2 linentag currentid boldnameids need_redisplay
908c3585 4600
d98d50e2 4601 if {$need_redisplay} return
28593d3f
PM
4602 lappend boldnameids $id
4603 $canv2 itemconf $linentag($id) -font $font
4604 if {[info exists currentid] && $id eq $currentid} {
908c3585 4605 $canv2 delete secsel
28593d3f 4606 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
908c3585
PM
4607 -outline {{}} -tags secsel \
4608 -fill [$canv2 cget -selectbackground]]
4609 $canv2 lower $t
4610 }
4611}
4612
4e7d6779 4613proc unbolden {} {
28593d3f 4614 global boldids
908c3585 4615
4e7d6779 4616 set stillbold {}
28593d3f
PM
4617 foreach id $boldids {
4618 if {![ishighlighted $id]} {
4619 bolden $id mainfont
4e7d6779 4620 } else {
28593d3f 4621 lappend stillbold $id
908c3585
PM
4622 }
4623 }
28593d3f 4624 set boldids $stillbold
908c3585
PM
4625}
4626
4627proc addvhighlight {n} {
476ca63d 4628 global hlview viewcomplete curview vhl_done commitidx
da7c24dd
PM
4629
4630 if {[info exists hlview]} {
908c3585 4631 delvhighlight
da7c24dd
PM
4632 }
4633 set hlview $n
7fcc92bf 4634 if {$n != $curview && ![info exists viewcomplete($n)]} {
da7c24dd 4635 start_rev_list $n
908c3585
PM
4636 }
4637 set vhl_done $commitidx($hlview)
4638 if {$vhl_done > 0} {
4639 drawvisible
da7c24dd
PM
4640 }
4641}
4642
908c3585
PM
4643proc delvhighlight {} {
4644 global hlview vhighlights
da7c24dd
PM
4645
4646 if {![info exists hlview]} return
4647 unset hlview
009409fe 4648 unset -nocomplain vhighlights
4e7d6779 4649 unbolden
da7c24dd
PM
4650}
4651
908c3585 4652proc vhighlightmore {} {
7fcc92bf 4653 global hlview vhl_done commitidx vhighlights curview
da7c24dd 4654
da7c24dd 4655 set max $commitidx($hlview)
908c3585
PM
4656 set vr [visiblerows]
4657 set r0 [lindex $vr 0]
4658 set r1 [lindex $vr 1]
4659 for {set i $vhl_done} {$i < $max} {incr i} {
7fcc92bf
PM
4660 set id [commitonrow $i $hlview]
4661 if {[commitinview $id $curview]} {
4662 set row [rowofcommit $id]
908c3585
PM
4663 if {$r0 <= $row && $row <= $r1} {
4664 if {![highlighted $row]} {
28593d3f 4665 bolden $id mainfontbold
da7c24dd 4666 }
476ca63d 4667 set vhighlights($id) 1
da7c24dd
PM
4668 }
4669 }
4670 }
908c3585 4671 set vhl_done $max
ac1276ab 4672 return 0
908c3585
PM
4673}
4674
4675proc askvhighlight {row id} {
7fcc92bf 4676 global hlview vhighlights iddrawn
908c3585 4677
7fcc92bf 4678 if {[commitinview $id $hlview]} {
476ca63d 4679 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
28593d3f 4680 bolden $id mainfontbold
908c3585 4681 }
476ca63d 4682 set vhighlights($id) 1
908c3585 4683 } else {
476ca63d 4684 set vhighlights($id) 0
908c3585
PM
4685 }
4686}
4687
687c8765 4688proc hfiles_change {} {
908c3585 4689 global highlight_files filehighlight fhighlights fh_serial
8b39e04f 4690 global highlight_paths
908c3585
PM
4691
4692 if {[info exists filehighlight]} {
4693 # delete previous highlights
4694 catch {close $filehighlight}
4695 unset filehighlight
009409fe 4696 unset -nocomplain fhighlights
4e7d6779 4697 unbolden
63b79191 4698 unhighlight_filelist
908c3585 4699 }
63b79191 4700 set highlight_paths {}
908c3585
PM
4701 after cancel do_file_hl $fh_serial
4702 incr fh_serial
4703 if {$highlight_files ne {}} {
4704 after 300 do_file_hl $fh_serial
4705 }
4706}
4707
687c8765
PM
4708proc gdttype_change {name ix op} {
4709 global gdttype highlight_files findstring findpattern
4710
bb3edc8b 4711 stopfinding
687c8765 4712 if {$findstring ne {}} {
b007ee20 4713 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4714 if {$highlight_files ne {}} {
4715 set highlight_files {}
4716 hfiles_change
4717 }
4718 findcom_change
4719 } else {
4720 if {$findpattern ne {}} {
4721 set findpattern {}
4722 findcom_change
4723 }
4724 set highlight_files $findstring
4725 hfiles_change
4726 }
4727 drawvisible
4728 }
4729 # enable/disable findtype/findloc menus too
4730}
4731
4732proc find_change {name ix op} {
4733 global gdttype findstring highlight_files
4734
bb3edc8b 4735 stopfinding
b007ee20 4736 if {$gdttype eq [mc "containing:"]} {
687c8765
PM
4737 findcom_change
4738 } else {
4739 if {$highlight_files ne $findstring} {
4740 set highlight_files $findstring
4741 hfiles_change
4742 }
4743 }
4744 drawvisible
4745}
4746
64b5f146 4747proc findcom_change args {
28593d3f 4748 global nhighlights boldnameids
687c8765
PM
4749 global findpattern findtype findstring gdttype
4750
bb3edc8b 4751 stopfinding
687c8765 4752 # delete previous highlights, if any
28593d3f
PM
4753 foreach id $boldnameids {
4754 bolden_name $id mainfont
687c8765 4755 }
28593d3f 4756 set boldnameids {}
009409fe 4757 unset -nocomplain nhighlights
687c8765
PM
4758 unbolden
4759 unmarkmatches
b007ee20 4760 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
687c8765 4761 set findpattern {}
b007ee20 4762 } elseif {$findtype eq [mc "Regexp"]} {
687c8765
PM
4763 set findpattern $findstring
4764 } else {
4765 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4766 $findstring]
4767 set findpattern "*$e*"
4768 }
4769}
4770
63b79191
PM
4771proc makepatterns {l} {
4772 set ret {}
4773 foreach e $l {
4774 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4775 if {[string index $ee end] eq "/"} {
4776 lappend ret "$ee*"
4777 } else {
4778 lappend ret $ee
4779 lappend ret "$ee/*"
4780 }
4781 }
4782 return $ret
4783}
4784
908c3585 4785proc do_file_hl {serial} {
4e7d6779 4786 global highlight_files filehighlight highlight_paths gdttype fhl_list
de665fd3 4787 global cdup findtype
908c3585 4788
b007ee20 4789 if {$gdttype eq [mc "touching paths:"]} {
de665fd3
YK
4790 # If "exact" match then convert backslashes to forward slashes.
4791 # Most useful to support Windows-flavoured file paths.
4792 if {$findtype eq [mc "Exact"]} {
4793 set highlight_files [string map {"\\" "/"} $highlight_files]
4794 }
60f7a7dc
PM
4795 if {[catch {set paths [shellsplit $highlight_files]}]} return
4796 set highlight_paths [makepatterns $paths]
4797 highlight_filelist
c332f445
MZ
4798 set relative_paths {}
4799 foreach path $paths {
4800 lappend relative_paths [file join $cdup $path]
4801 }
4802 set gdtargs [concat -- $relative_paths]
b007ee20 4803 } elseif {$gdttype eq [mc "adding/removing string:"]} {
60f7a7dc 4804 set gdtargs [list "-S$highlight_files"]
c33cb908
ML
4805 } elseif {$gdttype eq [mc "changing lines matching:"]} {
4806 set gdtargs [list "-G$highlight_files"]
687c8765
PM
4807 } else {
4808 # must be "containing:", i.e. we're searching commit info
4809 return
60f7a7dc 4810 }
1ce09dd6 4811 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
908c3585
PM
4812 set filehighlight [open $cmd r+]
4813 fconfigure $filehighlight -blocking 0
7eb3cb9c 4814 filerun $filehighlight readfhighlight
4e7d6779 4815 set fhl_list {}
908c3585
PM
4816 drawvisible
4817 flushhighlights
4818}
4819
4820proc flushhighlights {} {
4e7d6779 4821 global filehighlight fhl_list
908c3585
PM
4822
4823 if {[info exists filehighlight]} {
4e7d6779 4824 lappend fhl_list {}
908c3585
PM
4825 puts $filehighlight ""
4826 flush $filehighlight
4827 }
4828}
4829
4830proc askfilehighlight {row id} {
4e7d6779 4831 global filehighlight fhighlights fhl_list
908c3585 4832
4e7d6779 4833 lappend fhl_list $id
476ca63d 4834 set fhighlights($id) -1
908c3585
PM
4835 puts $filehighlight $id
4836}
4837
4838proc readfhighlight {} {
7fcc92bf 4839 global filehighlight fhighlights curview iddrawn
687c8765 4840 global fhl_list find_dirn
4e7d6779 4841
7eb3cb9c
PM
4842 if {![info exists filehighlight]} {
4843 return 0
4844 }
4845 set nr 0
4846 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4e7d6779
PM
4847 set line [string trim $line]
4848 set i [lsearch -exact $fhl_list $line]
4849 if {$i < 0} continue
4850 for {set j 0} {$j < $i} {incr j} {
4851 set id [lindex $fhl_list $j]
476ca63d 4852 set fhighlights($id) 0
908c3585 4853 }
4e7d6779
PM
4854 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4855 if {$line eq {}} continue
7fcc92bf 4856 if {![commitinview $line $curview]} continue
476ca63d 4857 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
28593d3f 4858 bolden $line mainfontbold
4e7d6779 4859 }
476ca63d 4860 set fhighlights($line) 1
908c3585 4861 }
4e7d6779
PM
4862 if {[eof $filehighlight]} {
4863 # strange...
1ce09dd6 4864 puts "oops, git diff-tree died"
4e7d6779
PM
4865 catch {close $filehighlight}
4866 unset filehighlight
7eb3cb9c 4867 return 0
908c3585 4868 }
687c8765 4869 if {[info exists find_dirn]} {
cca5d946 4870 run findmore
908c3585 4871 }
687c8765 4872 return 1
908c3585
PM
4873}
4874
4fb0fa19 4875proc doesmatch {f} {
687c8765 4876 global findtype findpattern
4fb0fa19 4877
b007ee20 4878 if {$findtype eq [mc "Regexp"]} {
687c8765 4879 return [regexp $findpattern $f]
b007ee20 4880 } elseif {$findtype eq [mc "IgnCase"]} {
4fb0fa19
PM
4881 return [string match -nocase $findpattern $f]
4882 } else {
4883 return [string match $findpattern $f]
4884 }
4885}
4886
60f7a7dc 4887proc askfindhighlight {row id} {
9c311b32 4888 global nhighlights commitinfo iddrawn
4fb0fa19
PM
4889 global findloc
4890 global markingmatches
908c3585
PM
4891
4892 if {![info exists commitinfo($id)]} {
4893 getcommit $id
4894 }
60f7a7dc 4895 set info $commitinfo($id)
908c3585 4896 set isbold 0
585c27cb 4897 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
60f7a7dc 4898 foreach f $info ty $fldtypes {
585c27cb 4899 if {$ty eq ""} continue
b007ee20 4900 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4fb0fa19 4901 [doesmatch $f]} {
b007ee20 4902 if {$ty eq [mc "Author"]} {
60f7a7dc 4903 set isbold 2
4fb0fa19 4904 break
60f7a7dc 4905 }
4fb0fa19 4906 set isbold 1
908c3585
PM
4907 }
4908 }
4fb0fa19 4909 if {$isbold && [info exists iddrawn($id)]} {
476ca63d 4910 if {![ishighlighted $id]} {
28593d3f 4911 bolden $id mainfontbold
4fb0fa19 4912 if {$isbold > 1} {
28593d3f 4913 bolden_name $id mainfontbold
4fb0fa19 4914 }
908c3585 4915 }
4fb0fa19 4916 if {$markingmatches} {
005a2f4e 4917 markrowmatches $row $id
908c3585
PM
4918 }
4919 }
476ca63d 4920 set nhighlights($id) $isbold
da7c24dd
PM
4921}
4922
005a2f4e
PM
4923proc markrowmatches {row id} {
4924 global canv canv2 linehtag linentag commitinfo findloc
4fb0fa19 4925
005a2f4e
PM
4926 set headline [lindex $commitinfo($id) 0]
4927 set author [lindex $commitinfo($id) 1]
4fb0fa19
PM
4928 $canv delete match$row
4929 $canv2 delete match$row
b007ee20 4930 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
005a2f4e
PM
4931 set m [findmatches $headline]
4932 if {$m ne {}} {
28593d3f
PM
4933 markmatches $canv $row $headline $linehtag($id) $m \
4934 [$canv itemcget $linehtag($id) -font] $row
005a2f4e 4935 }
4fb0fa19 4936 }
b007ee20 4937 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
005a2f4e
PM
4938 set m [findmatches $author]
4939 if {$m ne {}} {
28593d3f
PM
4940 markmatches $canv2 $row $author $linentag($id) $m \
4941 [$canv2 itemcget $linentag($id) -font] $row
005a2f4e 4942 }
4fb0fa19
PM
4943 }
4944}
4945
164ff275
PM
4946proc vrel_change {name ix op} {
4947 global highlight_related
4948
4949 rhighlight_none
b007ee20 4950 if {$highlight_related ne [mc "None"]} {
7eb3cb9c 4951 run drawvisible
164ff275
PM
4952 }
4953}
4954
4955# prepare for testing whether commits are descendents or ancestors of a
4956proc rhighlight_sel {a} {
4957 global descendent desc_todo ancestor anc_todo
476ca63d 4958 global highlight_related
164ff275 4959
009409fe 4960 unset -nocomplain descendent
164ff275 4961 set desc_todo [list $a]
009409fe 4962 unset -nocomplain ancestor
164ff275 4963 set anc_todo [list $a]
b007ee20 4964 if {$highlight_related ne [mc "None"]} {
164ff275 4965 rhighlight_none
7eb3cb9c 4966 run drawvisible
164ff275
PM
4967 }
4968}
4969
4970proc rhighlight_none {} {
4971 global rhighlights
4972
009409fe 4973 unset -nocomplain rhighlights
4e7d6779 4974 unbolden
164ff275
PM
4975}
4976
4977proc is_descendent {a} {
7fcc92bf 4978 global curview children descendent desc_todo
164ff275
PM
4979
4980 set v $curview
7fcc92bf 4981 set la [rowofcommit $a]
164ff275
PM
4982 set todo $desc_todo
4983 set leftover {}
4984 set done 0
4985 for {set i 0} {$i < [llength $todo]} {incr i} {
4986 set do [lindex $todo $i]
7fcc92bf 4987 if {[rowofcommit $do] < $la} {
164ff275
PM
4988 lappend leftover $do
4989 continue
4990 }
4991 foreach nk $children($v,$do) {
4992 if {![info exists descendent($nk)]} {
4993 set descendent($nk) 1
4994 lappend todo $nk
4995 if {$nk eq $a} {
4996 set done 1
4997 }
4998 }
4999 }
5000 if {$done} {
5001 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5002 return
5003 }
5004 }
5005 set descendent($a) 0
5006 set desc_todo $leftover
5007}
5008
5009proc is_ancestor {a} {
7fcc92bf 5010 global curview parents ancestor anc_todo
164ff275
PM
5011
5012 set v $curview
7fcc92bf 5013 set la [rowofcommit $a]
164ff275
PM
5014 set todo $anc_todo
5015 set leftover {}
5016 set done 0
5017 for {set i 0} {$i < [llength $todo]} {incr i} {
5018 set do [lindex $todo $i]
7fcc92bf 5019 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
164ff275
PM
5020 lappend leftover $do
5021 continue
5022 }
7fcc92bf 5023 foreach np $parents($v,$do) {
164ff275
PM
5024 if {![info exists ancestor($np)]} {
5025 set ancestor($np) 1
5026 lappend todo $np
5027 if {$np eq $a} {
5028 set done 1
5029 }
5030 }
5031 }
5032 if {$done} {
5033 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5034 return
5035 }
5036 }
5037 set ancestor($a) 0
5038 set anc_todo $leftover
5039}
5040
5041proc askrelhighlight {row id} {
9c311b32 5042 global descendent highlight_related iddrawn rhighlights
164ff275
PM
5043 global selectedline ancestor
5044
94b4a69f 5045 if {$selectedline eq {}} return
164ff275 5046 set isbold 0
55e34436
CS
5047 if {$highlight_related eq [mc "Descendant"] ||
5048 $highlight_related eq [mc "Not descendant"]} {
164ff275
PM
5049 if {![info exists descendent($id)]} {
5050 is_descendent $id
5051 }
55e34436 5052 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
164ff275
PM
5053 set isbold 1
5054 }
b007ee20
CS
5055 } elseif {$highlight_related eq [mc "Ancestor"] ||
5056 $highlight_related eq [mc "Not ancestor"]} {
164ff275
PM
5057 if {![info exists ancestor($id)]} {
5058 is_ancestor $id
5059 }
b007ee20 5060 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
164ff275
PM
5061 set isbold 1
5062 }
5063 }
5064 if {[info exists iddrawn($id)]} {
476ca63d 5065 if {$isbold && ![ishighlighted $id]} {
28593d3f 5066 bolden $id mainfontbold
164ff275
PM
5067 }
5068 }
476ca63d 5069 set rhighlights($id) $isbold
164ff275
PM
5070}
5071
da7c24dd
PM
5072# Graph layout functions
5073
9f1afe05
PM
5074proc shortids {ids} {
5075 set res {}
5076 foreach id $ids {
5077 if {[llength $id] > 1} {
5078 lappend res [shortids $id]
5079 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5080 lappend res [string range $id 0 7]
5081 } else {
5082 lappend res $id
5083 }
5084 }
5085 return $res
5086}
5087
9f1afe05
PM
5088proc ntimes {n o} {
5089 set ret {}
0380081c
PM
5090 set o [list $o]
5091 for {set mask 1} {$mask <= $n} {incr mask $mask} {
5092 if {($n & $mask) != 0} {
5093 set ret [concat $ret $o]
9f1afe05 5094 }
0380081c 5095 set o [concat $o $o]
9f1afe05 5096 }
0380081c 5097 return $ret
9f1afe05
PM
5098}
5099
9257d8f7
PM
5100proc ordertoken {id} {
5101 global ordertok curview varcid varcstart varctok curview parents children
5102 global nullid nullid2
5103
5104 if {[info exists ordertok($id)]} {
5105 return $ordertok($id)
5106 }
5107 set origid $id
5108 set todo {}
5109 while {1} {
5110 if {[info exists varcid($curview,$id)]} {
5111 set a $varcid($curview,$id)
5112 set p [lindex $varcstart($curview) $a]
5113 } else {
5114 set p [lindex $children($curview,$id) 0]
5115 }
5116 if {[info exists ordertok($p)]} {
5117 set tok $ordertok($p)
5118 break
5119 }
c8c9f3d9
PM
5120 set id [first_real_child $curview,$p]
5121 if {$id eq {}} {
9257d8f7 5122 # it's a root
46308ea1 5123 set tok [lindex $varctok($curview) $varcid($curview,$p)]
9257d8f7
PM
5124 break
5125 }
9257d8f7
PM
5126 if {[llength $parents($curview,$id)] == 1} {
5127 lappend todo [list $p {}]
5128 } else {
5129 set j [lsearch -exact $parents($curview,$id) $p]
5130 if {$j < 0} {
5131 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5132 }
5133 lappend todo [list $p [strrep $j]]
5134 }
5135 }
5136 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5137 set p [lindex $todo $i 0]
5138 append tok [lindex $todo $i 1]
5139 set ordertok($p) $tok
5140 }
5141 set ordertok($origid) $tok
5142 return $tok
5143}
5144
6e8c8707
PM
5145# Work out where id should go in idlist so that order-token
5146# values increase from left to right
5147proc idcol {idlist id {i 0}} {
9257d8f7 5148 set t [ordertoken $id]
e5b37ac1
PM
5149 if {$i < 0} {
5150 set i 0
5151 }
9257d8f7 5152 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
6e8c8707
PM
5153 if {$i > [llength $idlist]} {
5154 set i [llength $idlist]
9f1afe05 5155 }
9257d8f7 5156 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
6e8c8707
PM
5157 incr i
5158 } else {
9257d8f7 5159 if {$t > [ordertoken [lindex $idlist $i]]} {
6e8c8707 5160 while {[incr i] < [llength $idlist] &&
9257d8f7 5161 $t >= [ordertoken [lindex $idlist $i]]} {}
9f1afe05 5162 }
9f1afe05 5163 }
6e8c8707 5164 return $i
9f1afe05
PM
5165}
5166
5167proc initlayout {} {
7fcc92bf 5168 global rowidlist rowisopt rowfinal displayorder parentlist
da7c24dd 5169 global numcommits canvxmax canv
8f7d0cec 5170 global nextcolor
da7c24dd 5171 global colormap rowtextx
9f1afe05 5172
8f7d0cec
PM
5173 set numcommits 0
5174 set displayorder {}
79b2c75e 5175 set parentlist {}
8f7d0cec 5176 set nextcolor 0
0380081c
PM
5177 set rowidlist {}
5178 set rowisopt {}
f5f3c2e2 5179 set rowfinal {}
be0cd098 5180 set canvxmax [$canv cget -width]
009409fe
PM
5181 unset -nocomplain colormap
5182 unset -nocomplain rowtextx
ac1276ab 5183 setcanvscroll
be0cd098
PM
5184}
5185
5186proc setcanvscroll {} {
5187 global canv canv2 canv3 numcommits linespc canvxmax canvy0
ac1276ab 5188 global lastscrollset lastscrollrows
be0cd098
PM
5189
5190 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5191 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5192 $canv2 conf -scrollregion [list 0 0 0 $ymax]
5193 $canv3 conf -scrollregion [list 0 0 0 $ymax]
ac1276ab
PM
5194 set lastscrollset [clock clicks -milliseconds]
5195 set lastscrollrows $numcommits
9f1afe05
PM
5196}
5197
5198proc visiblerows {} {
5199 global canv numcommits linespc
5200
5201 set ymax [lindex [$canv cget -scrollregion] 3]
5202 if {$ymax eq {} || $ymax == 0} return
5203 set f [$canv yview]
5204 set y0 [expr {int([lindex $f 0] * $ymax)}]
5205 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5206 if {$r0 < 0} {
5207 set r0 0
5208 }
5209 set y1 [expr {int([lindex $f 1] * $ymax)}]
5210 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5211 if {$r1 >= $numcommits} {
5212 set r1 [expr {$numcommits - 1}]
5213 }
5214 return [list $r0 $r1]
5215}
5216
f5f3c2e2 5217proc layoutmore {} {
38dfe939 5218 global commitidx viewcomplete curview
94b4a69f 5219 global numcommits pending_select curview
d375ef9b 5220 global lastscrollset lastscrollrows
ac1276ab
PM
5221
5222 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5223 [clock clicks -milliseconds] - $lastscrollset > 500} {
a2c22362
PM
5224 setcanvscroll
5225 }
d94f8cd6 5226 if {[info exists pending_select] &&
7fcc92bf 5227 [commitinview $pending_select $curview]} {
567c34e0 5228 update
7fcc92bf 5229 selectline [rowofcommit $pending_select] 1
d94f8cd6 5230 }
ac1276ab 5231 drawvisible
219ea3a9
PM
5232}
5233
cdc8429c
PM
5234# With path limiting, we mightn't get the actual HEAD commit,
5235# so ask git rev-list what is the first ancestor of HEAD that
5236# touches a file in the path limit.
5237proc get_viewmainhead {view} {
5238 global viewmainheadid vfilelimit viewinstances mainheadid
5239
5240 catch {
5241 set rfd [open [concat | git rev-list -1 $mainheadid \
5242 -- $vfilelimit($view)] r]
5243 set j [reg_instance $rfd]
5244 lappend viewinstances($view) $j
5245 fconfigure $rfd -blocking 0
5246 filerun $rfd [list getviewhead $rfd $j $view]
5247 set viewmainheadid($curview) {}
5248 }
5249}
5250
5251# git rev-list should give us just 1 line to use as viewmainheadid($view)
5252proc getviewhead {fd inst view} {
5253 global viewmainheadid commfd curview viewinstances showlocalchanges
5254
5255 set id {}
5256 if {[gets $fd line] < 0} {
5257 if {![eof $fd]} {
5258 return 1
5259 }
5260 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5261 set id $line
5262 }
5263 set viewmainheadid($view) $id
5264 close $fd
5265 unset commfd($inst)
5266 set i [lsearch -exact $viewinstances($view) $inst]
5267 if {$i >= 0} {
5268 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5269 }
5270 if {$showlocalchanges && $id ne {} && $view == $curview} {
5271 doshowlocalchanges
5272 }
5273 return 0
5274}
5275
219ea3a9 5276proc doshowlocalchanges {} {
cdc8429c 5277 global curview viewmainheadid
219ea3a9 5278
cdc8429c
PM
5279 if {$viewmainheadid($curview) eq {}} return
5280 if {[commitinview $viewmainheadid($curview) $curview]} {
219ea3a9 5281 dodiffindex
38dfe939 5282 } else {
cdc8429c 5283 interestedin $viewmainheadid($curview) dodiffindex
219ea3a9
PM
5284 }
5285}
5286
5287proc dohidelocalchanges {} {
7fcc92bf 5288 global nullid nullid2 lserial curview
219ea3a9 5289
7fcc92bf 5290 if {[commitinview $nullid $curview]} {
b8a938cf 5291 removefakerow $nullid
8f489363 5292 }
7fcc92bf 5293 if {[commitinview $nullid2 $curview]} {
b8a938cf 5294 removefakerow $nullid2
219ea3a9
PM
5295 }
5296 incr lserial
5297}
5298
8f489363 5299# spawn off a process to do git diff-index --cached HEAD
219ea3a9 5300proc dodiffindex {} {
cdc8429c 5301 global lserial showlocalchanges vfilelimit curview
17f9836c 5302 global hasworktree git_version
219ea3a9 5303
74cb884f 5304 if {!$showlocalchanges || !$hasworktree} return
219ea3a9 5305 incr lserial
17f9836c
JL
5306 if {[package vcompare $git_version "1.7.2"] >= 0} {
5307 set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5308 } else {
5309 set cmd "|git diff-index --cached HEAD"
5310 }
cdc8429c
PM
5311 if {$vfilelimit($curview) ne {}} {
5312 set cmd [concat $cmd -- $vfilelimit($curview)]
5313 }
5314 set fd [open $cmd r]
219ea3a9 5315 fconfigure $fd -blocking 0
e439e092
AG
5316 set i [reg_instance $fd]
5317 filerun $fd [list readdiffindex $fd $lserial $i]
219ea3a9
PM
5318}
5319
e439e092 5320proc readdiffindex {fd serial inst} {
cdc8429c
PM
5321 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5322 global vfilelimit
219ea3a9 5323
8f489363 5324 set isdiff 1
219ea3a9 5325 if {[gets $fd line] < 0} {
8f489363
PM
5326 if {![eof $fd]} {
5327 return 1
219ea3a9 5328 }
8f489363 5329 set isdiff 0
219ea3a9
PM
5330 }
5331 # we only need to see one line and we don't really care what it says...
e439e092 5332 stop_instance $inst
219ea3a9 5333
24f7a667
PM
5334 if {$serial != $lserial} {
5335 return 0
8f489363
PM
5336 }
5337
24f7a667 5338 # now see if there are any local changes not checked in to the index
cdc8429c
PM
5339 set cmd "|git diff-files"
5340 if {$vfilelimit($curview) ne {}} {
5341 set cmd [concat $cmd -- $vfilelimit($curview)]
5342 }
5343 set fd [open $cmd r]
24f7a667 5344 fconfigure $fd -blocking 0
e439e092
AG
5345 set i [reg_instance $fd]
5346 filerun $fd [list readdifffiles $fd $serial $i]
24f7a667
PM
5347
5348 if {$isdiff && ![commitinview $nullid2 $curview]} {
8f489363 5349 # add the line for the changes in the index to the graph
d990cedf 5350 set hl [mc "Local changes checked in to index but not committed"]
8f489363
PM
5351 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5352 set commitdata($nullid2) "\n $hl\n"
fc2a256f 5353 if {[commitinview $nullid $curview]} {
b8a938cf 5354 removefakerow $nullid
fc2a256f 5355 }
cdc8429c 5356 insertfakerow $nullid2 $viewmainheadid($curview)
24f7a667 5357 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
cdc8429c
PM
5358 if {[commitinview $nullid $curview]} {
5359 removefakerow $nullid
5360 }
b8a938cf 5361 removefakerow $nullid2
8f489363
PM
5362 }
5363 return 0
5364}
5365
e439e092 5366proc readdifffiles {fd serial inst} {
cdc8429c 5367 global viewmainheadid nullid nullid2 curview
8f489363
PM
5368 global commitinfo commitdata lserial
5369
5370 set isdiff 1
5371 if {[gets $fd line] < 0} {
5372 if {![eof $fd]} {
5373 return 1
5374 }
5375 set isdiff 0
5376 }
5377 # we only need to see one line and we don't really care what it says...
e439e092 5378 stop_instance $inst
8f489363 5379
24f7a667
PM
5380 if {$serial != $lserial} {
5381 return 0
5382 }
5383
5384 if {$isdiff && ![commitinview $nullid $curview]} {
219ea3a9 5385 # add the line for the local diff to the graph
d990cedf 5386 set hl [mc "Local uncommitted changes, not checked in to index"]
219ea3a9
PM
5387 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5388 set commitdata($nullid) "\n $hl\n"
7fcc92bf
PM
5389 if {[commitinview $nullid2 $curview]} {
5390 set p $nullid2
5391 } else {
cdc8429c 5392 set p $viewmainheadid($curview)
7fcc92bf 5393 }
b8a938cf 5394 insertfakerow $nullid $p
24f7a667 5395 } elseif {!$isdiff && [commitinview $nullid $curview]} {
b8a938cf 5396 removefakerow $nullid
219ea3a9
PM
5397 }
5398 return 0
9f1afe05
PM
5399}
5400
8f0bc7e9 5401proc nextuse {id row} {
7fcc92bf 5402 global curview children
9f1afe05 5403
8f0bc7e9
PM
5404 if {[info exists children($curview,$id)]} {
5405 foreach kid $children($curview,$id) {
7fcc92bf 5406 if {![commitinview $kid $curview]} {
0380081c
PM
5407 return -1
5408 }
7fcc92bf
PM
5409 if {[rowofcommit $kid] > $row} {
5410 return [rowofcommit $kid]
9f1afe05 5411 }
9f1afe05 5412 }
8f0bc7e9 5413 }
7fcc92bf
PM
5414 if {[commitinview $id $curview]} {
5415 return [rowofcommit $id]
8f0bc7e9
PM
5416 }
5417 return -1
5418}
5419
f5f3c2e2 5420proc prevuse {id row} {
7fcc92bf 5421 global curview children
f5f3c2e2
PM
5422
5423 set ret -1
5424 if {[info exists children($curview,$id)]} {
5425 foreach kid $children($curview,$id) {
7fcc92bf
PM
5426 if {![commitinview $kid $curview]} break
5427 if {[rowofcommit $kid] < $row} {
5428 set ret [rowofcommit $kid]
7b459a1c 5429 }
7b459a1c 5430 }
f5f3c2e2
PM
5431 }
5432 return $ret
5433}
5434
0380081c
PM
5435proc make_idlist {row} {
5436 global displayorder parentlist uparrowlen downarrowlen mingaplen
9257d8f7 5437 global commitidx curview children
9f1afe05 5438
0380081c
PM
5439 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5440 if {$r < 0} {
5441 set r 0
8f0bc7e9 5442 }
0380081c
PM
5443 set ra [expr {$row - $downarrowlen}]
5444 if {$ra < 0} {
5445 set ra 0
5446 }
5447 set rb [expr {$row + $uparrowlen}]
5448 if {$rb > $commitidx($curview)} {
5449 set rb $commitidx($curview)
5450 }
7fcc92bf 5451 make_disporder $r [expr {$rb + 1}]
0380081c
PM
5452 set ids {}
5453 for {} {$r < $ra} {incr r} {
5454 set nextid [lindex $displayorder [expr {$r + 1}]]
5455 foreach p [lindex $parentlist $r] {
5456 if {$p eq $nextid} continue
5457 set rn [nextuse $p $r]
5458 if {$rn >= $row &&
5459 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
9257d8f7 5460 lappend ids [list [ordertoken $p] $p]
9f1afe05 5461 }
9f1afe05 5462 }
0380081c
PM
5463 }
5464 for {} {$r < $row} {incr r} {
5465 set nextid [lindex $displayorder [expr {$r + 1}]]
5466 foreach p [lindex $parentlist $r] {
5467 if {$p eq $nextid} continue
5468 set rn [nextuse $p $r]
5469 if {$rn < 0 || $rn >= $row} {
9257d8f7 5470 lappend ids [list [ordertoken $p] $p]
9f1afe05 5471 }
9f1afe05 5472 }
0380081c
PM
5473 }
5474 set id [lindex $displayorder $row]
9257d8f7 5475 lappend ids [list [ordertoken $id] $id]
0380081c
PM
5476 while {$r < $rb} {
5477 foreach p [lindex $parentlist $r] {
5478 set firstkid [lindex $children($curview,$p) 0]
7fcc92bf 5479 if {[rowofcommit $firstkid] < $row} {
9257d8f7 5480 lappend ids [list [ordertoken $p] $p]
9f1afe05 5481 }
9f1afe05 5482 }
0380081c
PM
5483 incr r
5484 set id [lindex $displayorder $r]
5485 if {$id ne {}} {
5486 set firstkid [lindex $children($curview,$id) 0]
7fcc92bf 5487 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
9257d8f7 5488 lappend ids [list [ordertoken $id] $id]
0380081c 5489 }
9f1afe05 5490 }
9f1afe05 5491 }
0380081c
PM
5492 set idlist {}
5493 foreach idx [lsort -unique $ids] {
5494 lappend idlist [lindex $idx 1]
5495 }
5496 return $idlist
9f1afe05
PM
5497}
5498
f5f3c2e2
PM
5499proc rowsequal {a b} {
5500 while {[set i [lsearch -exact $a {}]] >= 0} {
5501 set a [lreplace $a $i $i]
5502 }
5503 while {[set i [lsearch -exact $b {}]] >= 0} {
5504 set b [lreplace $b $i $i]
5505 }
5506 return [expr {$a eq $b}]
9f1afe05
PM
5507}
5508
f5f3c2e2
PM
5509proc makeupline {id row rend col} {
5510 global rowidlist uparrowlen downarrowlen mingaplen
9f1afe05 5511
f5f3c2e2
PM
5512 for {set r $rend} {1} {set r $rstart} {
5513 set rstart [prevuse $id $r]
5514 if {$rstart < 0} return
5515 if {$rstart < $row} break
5516 }
5517 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5518 set rstart [expr {$rend - $uparrowlen - 1}]
79b2c75e 5519 }
f5f3c2e2
PM
5520 for {set r $rstart} {[incr r] <= $row} {} {
5521 set idlist [lindex $rowidlist $r]
5522 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5523 set col [idcol $idlist $id $col]
5524 lset rowidlist $r [linsert $idlist $col $id]
5525 changedrow $r
5526 }
9f1afe05
PM
5527 }
5528}
5529
0380081c 5530proc layoutrows {row endrow} {
f5f3c2e2 5531 global rowidlist rowisopt rowfinal displayorder
0380081c
PM
5532 global uparrowlen downarrowlen maxwidth mingaplen
5533 global children parentlist
7fcc92bf 5534 global commitidx viewcomplete curview
9f1afe05 5535
7fcc92bf 5536 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
0380081c
PM
5537 set idlist {}
5538 if {$row > 0} {
f56782ae
PM
5539 set rm1 [expr {$row - 1}]
5540 foreach id [lindex $rowidlist $rm1] {
0380081c
PM
5541 if {$id ne {}} {
5542 lappend idlist $id
5543 }
5544 }
f56782ae 5545 set final [lindex $rowfinal $rm1]
79b2c75e 5546 }
0380081c
PM
5547 for {} {$row < $endrow} {incr row} {
5548 set rm1 [expr {$row - 1}]
f56782ae 5549 if {$rm1 < 0 || $idlist eq {}} {
0380081c 5550 set idlist [make_idlist $row]
f5f3c2e2 5551 set final 1
0380081c
PM
5552 } else {
5553 set id [lindex $displayorder $rm1]
5554 set col [lsearch -exact $idlist $id]
5555 set idlist [lreplace $idlist $col $col]
5556 foreach p [lindex $parentlist $rm1] {
5557 if {[lsearch -exact $idlist $p] < 0} {
5558 set col [idcol $idlist $p $col]
5559 set idlist [linsert $idlist $col $p]
f5f3c2e2
PM
5560 # if not the first child, we have to insert a line going up
5561 if {$id ne [lindex $children($curview,$p) 0]} {
5562 makeupline $p $rm1 $row $col
5563 }
0380081c
PM
5564 }
5565 }
5566 set id [lindex $displayorder $row]
5567 if {$row > $downarrowlen} {
5568 set termrow [expr {$row - $downarrowlen - 1}]
5569 foreach p [lindex $parentlist $termrow] {
5570 set i [lsearch -exact $idlist $p]
5571 if {$i < 0} continue
5572 set nr [nextuse $p $termrow]
5573 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5574 set idlist [lreplace $idlist $i $i]
5575 }
5576 }
5577 }
5578 set col [lsearch -exact $idlist $id]
5579 if {$col < 0} {
5580 set col [idcol $idlist $id]
5581 set idlist [linsert $idlist $col $id]
f5f3c2e2
PM
5582 if {$children($curview,$id) ne {}} {
5583 makeupline $id $rm1 $row $col
5584 }
0380081c
PM
5585 }
5586 set r [expr {$row + $uparrowlen - 1}]
5587 if {$r < $commitidx($curview)} {
5588 set x $col
5589 foreach p [lindex $parentlist $r] {
5590 if {[lsearch -exact $idlist $p] >= 0} continue
5591 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5592 if {[rowofcommit $fk] < $row} {
0380081c
PM
5593 set x [idcol $idlist $p $x]
5594 set idlist [linsert $idlist $x $p]
5595 }
5596 }
5597 if {[incr r] < $commitidx($curview)} {
5598 set p [lindex $displayorder $r]
5599 if {[lsearch -exact $idlist $p] < 0} {
5600 set fk [lindex $children($curview,$p) 0]
7fcc92bf 5601 if {$fk ne {} && [rowofcommit $fk] < $row} {
0380081c
PM
5602 set x [idcol $idlist $p $x]
5603 set idlist [linsert $idlist $x $p]
5604 }
5605 }
5606 }
5607 }
5608 }
f5f3c2e2
PM
5609 if {$final && !$viewcomplete($curview) &&
5610 $row + $uparrowlen + $mingaplen + $downarrowlen
5611 >= $commitidx($curview)} {
5612 set final 0
5613 }
0380081c
PM
5614 set l [llength $rowidlist]
5615 if {$row == $l} {
5616 lappend rowidlist $idlist
5617 lappend rowisopt 0
f5f3c2e2 5618 lappend rowfinal $final
0380081c 5619 } elseif {$row < $l} {
f5f3c2e2 5620 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
0380081c
PM
5621 lset rowidlist $row $idlist
5622 changedrow $row
5623 }
f56782ae 5624 lset rowfinal $row $final
0380081c 5625 } else {
f5f3c2e2
PM
5626 set pad [ntimes [expr {$row - $l}] {}]
5627 set rowidlist [concat $rowidlist $pad]
0380081c 5628 lappend rowidlist $idlist
f5f3c2e2
PM
5629 set rowfinal [concat $rowfinal $pad]
5630 lappend rowfinal $final
0380081c
PM
5631 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5632 }
9f1afe05 5633 }
0380081c 5634 return $row
9f1afe05
PM
5635}
5636
0380081c
PM
5637proc changedrow {row} {
5638 global displayorder iddrawn rowisopt need_redisplay
9f1afe05 5639
0380081c
PM
5640 set l [llength $rowisopt]
5641 if {$row < $l} {
5642 lset rowisopt $row 0
5643 if {$row + 1 < $l} {
5644 lset rowisopt [expr {$row + 1}] 0
5645 if {$row + 2 < $l} {
5646 lset rowisopt [expr {$row + 2}] 0
5647 }
5648 }
5649 }
5650 set id [lindex $displayorder $row]
5651 if {[info exists iddrawn($id)]} {
5652 set need_redisplay 1
9f1afe05
PM
5653 }
5654}
5655
5656proc insert_pad {row col npad} {
6e8c8707 5657 global rowidlist
9f1afe05
PM
5658
5659 set pad [ntimes $npad {}]
e341c06d
PM
5660 set idlist [lindex $rowidlist $row]
5661 set bef [lrange $idlist 0 [expr {$col - 1}]]
5662 set aft [lrange $idlist $col end]
5663 set i [lsearch -exact $aft {}]
5664 if {$i > 0} {
5665 set aft [lreplace $aft $i $i]
5666 }
5667 lset rowidlist $row [concat $bef $pad $aft]
0380081c 5668 changedrow $row
9f1afe05
PM
5669}
5670
5671proc optimize_rows {row col endrow} {
0380081c 5672 global rowidlist rowisopt displayorder curview children
9f1afe05 5673
6e8c8707
PM
5674 if {$row < 1} {
5675 set row 1
5676 }
0380081c
PM
5677 for {} {$row < $endrow} {incr row; set col 0} {
5678 if {[lindex $rowisopt $row]} continue
9f1afe05 5679 set haspad 0
6e8c8707
PM
5680 set y0 [expr {$row - 1}]
5681 set ym [expr {$row - 2}]
0380081c
PM
5682 set idlist [lindex $rowidlist $row]
5683 set previdlist [lindex $rowidlist $y0]
5684 if {$idlist eq {} || $previdlist eq {}} continue
5685 if {$ym >= 0} {
5686 set pprevidlist [lindex $rowidlist $ym]
5687 if {$pprevidlist eq {}} continue
5688 } else {
5689 set pprevidlist {}
5690 }
6e8c8707
PM
5691 set x0 -1
5692 set xm -1
5693 for {} {$col < [llength $idlist]} {incr col} {
5694 set id [lindex $idlist $col]
5695 if {[lindex $previdlist $col] eq $id} continue
5696 if {$id eq {}} {
9f1afe05
PM
5697 set haspad 1
5698 continue
5699 }
6e8c8707
PM
5700 set x0 [lsearch -exact $previdlist $id]
5701 if {$x0 < 0} continue
5702 set z [expr {$x0 - $col}]
9f1afe05 5703 set isarrow 0
6e8c8707
PM
5704 set z0 {}
5705 if {$ym >= 0} {
5706 set xm [lsearch -exact $pprevidlist $id]
5707 if {$xm >= 0} {
5708 set z0 [expr {$xm - $x0}]
5709 }
5710 }
9f1afe05 5711 if {$z0 eq {}} {
92ed666f
PM
5712 # if row y0 is the first child of $id then it's not an arrow
5713 if {[lindex $children($curview,$id) 0] ne
5714 [lindex $displayorder $y0]} {
9f1afe05
PM
5715 set isarrow 1
5716 }
5717 }
e341c06d
PM
5718 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5719 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5720 set isarrow 1
5721 }
3fc4279a
PM
5722 # Looking at lines from this row to the previous row,
5723 # make them go straight up if they end in an arrow on
5724 # the previous row; otherwise make them go straight up
5725 # or at 45 degrees.
9f1afe05 5726 if {$z < -1 || ($z < 0 && $isarrow)} {
3fc4279a
PM
5727 # Line currently goes left too much;
5728 # insert pads in the previous row, then optimize it
9f1afe05 5729 set npad [expr {-1 - $z + $isarrow}]
9f1afe05
PM
5730 insert_pad $y0 $x0 $npad
5731 if {$y0 > 0} {
5732 optimize_rows $y0 $x0 $row
5733 }
6e8c8707
PM
5734 set previdlist [lindex $rowidlist $y0]
5735 set x0 [lsearch -exact $previdlist $id]
5736 set z [expr {$x0 - $col}]
5737 if {$z0 ne {}} {
5738 set pprevidlist [lindex $rowidlist $ym]
5739 set xm [lsearch -exact $pprevidlist $id]
5740 set z0 [expr {$xm - $x0}]
5741 }
9f1afe05 5742 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3fc4279a 5743 # Line currently goes right too much;
6e8c8707 5744 # insert pads in this line
9f1afe05 5745 set npad [expr {$z - 1 + $isarrow}]
e341c06d
PM
5746 insert_pad $row $col $npad
5747 set idlist [lindex $rowidlist $row]
9f1afe05 5748 incr col $npad
6e8c8707 5749 set z [expr {$x0 - $col}]
9f1afe05
PM
5750 set haspad 1
5751 }
6e8c8707 5752 if {$z0 eq {} && !$isarrow && $ym >= 0} {
eb447a12 5753 # this line links to its first child on row $row-2
6e8c8707
PM
5754 set id [lindex $displayorder $ym]
5755 set xc [lsearch -exact $pprevidlist $id]
eb447a12
PM
5756 if {$xc >= 0} {
5757 set z0 [expr {$xc - $x0}]
5758 }
5759 }
3fc4279a 5760 # avoid lines jigging left then immediately right
9f1afe05
PM
5761 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5762 insert_pad $y0 $x0 1
6e8c8707
PM
5763 incr x0
5764 optimize_rows $y0 $x0 $row
5765 set previdlist [lindex $rowidlist $y0]
9f1afe05
PM
5766 }
5767 }
5768 if {!$haspad} {
3fc4279a 5769 # Find the first column that doesn't have a line going right
9f1afe05 5770 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
6e8c8707
PM
5771 set id [lindex $idlist $col]
5772 if {$id eq {}} break
5773 set x0 [lsearch -exact $previdlist $id]
5774 if {$x0 < 0} {
eb447a12 5775 # check if this is the link to the first child
92ed666f
PM
5776 set kid [lindex $displayorder $y0]
5777 if {[lindex $children($curview,$id) 0] eq $kid} {
eb447a12 5778 # it is, work out offset to child
92ed666f 5779 set x0 [lsearch -exact $previdlist $kid]
eb447a12
PM
5780 }
5781 }
6e8c8707 5782 if {$x0 <= $col} break
9f1afe05 5783 }
3fc4279a 5784 # Insert a pad at that column as long as it has a line and
6e8c8707
PM
5785 # isn't the last column
5786 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
9f1afe05 5787 set idlist [linsert $idlist $col {}]
0380081c
PM
5788 lset rowidlist $row $idlist
5789 changedrow $row
9f1afe05
PM
5790 }
5791 }
9f1afe05
PM
5792 }
5793}
5794
5795proc xc {row col} {
5796 global canvx0 linespc
5797 return [expr {$canvx0 + $col * $linespc}]
5798}
5799
5800proc yc {row} {
5801 global canvy0 linespc
5802 return [expr {$canvy0 + $row * $linespc}]
5803}
5804
c934a8a3
PM
5805proc linewidth {id} {
5806 global thickerline lthickness
5807
5808 set wid $lthickness
5809 if {[info exists thickerline] && $id eq $thickerline} {
5810 set wid [expr {2 * $lthickness}]
5811 }
5812 return $wid
5813}
5814
50b44ece 5815proc rowranges {id} {
7fcc92bf 5816 global curview children uparrowlen downarrowlen
92ed666f 5817 global rowidlist
50b44ece 5818
92ed666f
PM
5819 set kids $children($curview,$id)
5820 if {$kids eq {}} {
5821 return {}
66e46f37 5822 }
92ed666f
PM
5823 set ret {}
5824 lappend kids $id
5825 foreach child $kids {
7fcc92bf
PM
5826 if {![commitinview $child $curview]} break
5827 set row [rowofcommit $child]
92ed666f
PM
5828 if {![info exists prev]} {
5829 lappend ret [expr {$row + 1}]
322a8cc9 5830 } else {
92ed666f 5831 if {$row <= $prevrow} {
7fcc92bf 5832 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
92ed666f
PM
5833 }
5834 # see if the line extends the whole way from prevrow to row
5835 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5836 [lsearch -exact [lindex $rowidlist \
5837 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5838 # it doesn't, see where it ends
5839 set r [expr {$prevrow + $downarrowlen}]
5840 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5841 while {[incr r -1] > $prevrow &&
5842 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5843 } else {
5844 while {[incr r] <= $row &&
5845 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5846 incr r -1
5847 }
5848 lappend ret $r
5849 # see where it starts up again
5850 set r [expr {$row - $uparrowlen}]
5851 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5852 while {[incr r] < $row &&
5853 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5854 } else {
5855 while {[incr r -1] >= $prevrow &&
5856 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5857 incr r
5858 }
5859 lappend ret $r
5860 }
5861 }
5862 if {$child eq $id} {
5863 lappend ret $row
322a8cc9 5864 }
7fcc92bf 5865 set prev $child
92ed666f 5866 set prevrow $row
9f1afe05 5867 }
92ed666f 5868 return $ret
322a8cc9
PM
5869}
5870
5871proc drawlineseg {id row endrow arrowlow} {
5872 global rowidlist displayorder iddrawn linesegs
e341c06d 5873 global canv colormap linespc curview maxlinelen parentlist
322a8cc9
PM
5874
5875 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5876 set le [expr {$row + 1}]
5877 set arrowhigh 1
9f1afe05 5878 while {1} {
322a8cc9
PM
5879 set c [lsearch -exact [lindex $rowidlist $le] $id]
5880 if {$c < 0} {
5881 incr le -1
5882 break
5883 }
5884 lappend cols $c
5885 set x [lindex $displayorder $le]
5886 if {$x eq $id} {
5887 set arrowhigh 0
5888 break
9f1afe05 5889 }
322a8cc9
PM
5890 if {[info exists iddrawn($x)] || $le == $endrow} {
5891 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5892 if {$c >= 0} {
5893 lappend cols $c
5894 set arrowhigh 0
5895 }
5896 break
5897 }
5898 incr le
9f1afe05 5899 }
322a8cc9
PM
5900 if {$le <= $row} {
5901 return $row
5902 }
5903
5904 set lines {}
5905 set i 0
5906 set joinhigh 0
5907 if {[info exists linesegs($id)]} {
5908 set lines $linesegs($id)
5909 foreach li $lines {
5910 set r0 [lindex $li 0]
5911 if {$r0 > $row} {
5912 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5913 set joinhigh 1
5914 }
5915 break
5916 }
5917 incr i
5918 }
5919 }
5920 set joinlow 0
5921 if {$i > 0} {
5922 set li [lindex $lines [expr {$i-1}]]
5923 set r1 [lindex $li 1]
5924 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5925 set joinlow 1
5926 }
5927 }
5928
5929 set x [lindex $cols [expr {$le - $row}]]
5930 set xp [lindex $cols [expr {$le - 1 - $row}]]
5931 set dir [expr {$xp - $x}]
5932 if {$joinhigh} {
5933 set ith [lindex $lines $i 2]
5934 set coords [$canv coords $ith]
5935 set ah [$canv itemcget $ith -arrow]
5936 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5937 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5938 if {$x2 ne {} && $x - $x2 == $dir} {
5939 set coords [lrange $coords 0 end-2]
5940 }
5941 } else {
5942 set coords [list [xc $le $x] [yc $le]]
5943 }
5944 if {$joinlow} {
5945 set itl [lindex $lines [expr {$i-1}] 2]
5946 set al [$canv itemcget $itl -arrow]
5947 set arrowlow [expr {$al eq "last" || $al eq "both"}]
e341c06d
PM
5948 } elseif {$arrowlow} {
5949 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5950 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5951 set arrowlow 0
5952 }
322a8cc9
PM
5953 }
5954 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5955 for {set y $le} {[incr y -1] > $row} {} {
5956 set x $xp
5957 set xp [lindex $cols [expr {$y - 1 - $row}]]
5958 set ndir [expr {$xp - $x}]
5959 if {$dir != $ndir || $xp < 0} {
5960 lappend coords [xc $y $x] [yc $y]
5961 }
5962 set dir $ndir
5963 }
5964 if {!$joinlow} {
5965 if {$xp < 0} {
5966 # join parent line to first child
5967 set ch [lindex $displayorder $row]
5968 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5969 if {$xc < 0} {
5970 puts "oops: drawlineseg: child $ch not on row $row"
e341c06d
PM
5971 } elseif {$xc != $x} {
5972 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5973 set d [expr {int(0.5 * $linespc)}]
5974 set x1 [xc $row $x]
5975 if {$xc < $x} {
5976 set x2 [expr {$x1 - $d}]
5977 } else {
5978 set x2 [expr {$x1 + $d}]
5979 }
5980 set y2 [yc $row]
5981 set y1 [expr {$y2 + $d}]
5982 lappend coords $x1 $y1 $x2 $y2
5983 } elseif {$xc < $x - 1} {
322a8cc9
PM
5984 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5985 } elseif {$xc > $x + 1} {
5986 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5987 }
5988 set x $xc
eb447a12 5989 }
322a8cc9
PM
5990 lappend coords [xc $row $x] [yc $row]
5991 } else {
5992 set xn [xc $row $xp]
5993 set yn [yc $row]
e341c06d 5994 lappend coords $xn $yn
322a8cc9
PM
5995 }
5996 if {!$joinhigh} {
322a8cc9
PM
5997 assigncolor $id
5998 set t [$canv create line $coords -width [linewidth $id] \
5999 -fill $colormap($id) -tags lines.$id -arrow $arrow]
6000 $canv lower $t
6001 bindline $t $id
6002 set lines [linsert $lines $i [list $row $le $t]]
6003 } else {
6004 $canv coords $ith $coords
6005 if {$arrow ne $ah} {
6006 $canv itemconf $ith -arrow $arrow
6007 }
6008 lset lines $i 0 $row
6009 }
6010 } else {
6011 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6012 set ndir [expr {$xo - $xp}]
6013 set clow [$canv coords $itl]
6014 if {$dir == $ndir} {
6015 set clow [lrange $clow 2 end]
6016 }
6017 set coords [concat $coords $clow]
6018 if {!$joinhigh} {
6019 lset lines [expr {$i-1}] 1 $le
322a8cc9
PM
6020 } else {
6021 # coalesce two pieces
6022 $canv delete $ith
6023 set b [lindex $lines [expr {$i-1}] 0]
6024 set e [lindex $lines $i 1]
6025 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6026 }
6027 $canv coords $itl $coords
6028 if {$arrow ne $al} {
6029 $canv itemconf $itl -arrow $arrow
879e8b1a
PM
6030 }
6031 }
322a8cc9
PM
6032
6033 set linesegs($id) $lines
6034 return $le
9f1afe05
PM
6035}
6036
322a8cc9
PM
6037proc drawparentlinks {id row} {
6038 global rowidlist canv colormap curview parentlist
513a54dc 6039 global idpos linespc
9f1afe05 6040
322a8cc9
PM
6041 set rowids [lindex $rowidlist $row]
6042 set col [lsearch -exact $rowids $id]
6043 if {$col < 0} return
6044 set olds [lindex $parentlist $row]
9f1afe05
PM
6045 set row2 [expr {$row + 1}]
6046 set x [xc $row $col]
6047 set y [yc $row]
6048 set y2 [yc $row2]
e341c06d 6049 set d [expr {int(0.5 * $linespc)}]
513a54dc 6050 set ymid [expr {$y + $d}]
8f7d0cec 6051 set ids [lindex $rowidlist $row2]
9f1afe05
PM
6052 # rmx = right-most X coord used
6053 set rmx 0
9f1afe05 6054 foreach p $olds {
f3408449
PM
6055 set i [lsearch -exact $ids $p]
6056 if {$i < 0} {
6057 puts "oops, parent $p of $id not in list"
6058 continue
6059 }
6060 set x2 [xc $row2 $i]
6061 if {$x2 > $rmx} {
6062 set rmx $x2
6063 }
513a54dc
PM
6064 set j [lsearch -exact $rowids $p]
6065 if {$j < 0} {
eb447a12
PM
6066 # drawlineseg will do this one for us
6067 continue
6068 }
9f1afe05
PM
6069 assigncolor $p
6070 # should handle duplicated parents here...
6071 set coords [list $x $y]
513a54dc
PM
6072 if {$i != $col} {
6073 # if attaching to a vertical segment, draw a smaller
6074 # slant for visual distinctness
6075 if {$i == $j} {
6076 if {$i < $col} {
6077 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6078 } else {
6079 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6080 }
6081 } elseif {$i < $col && $i < $j} {
6082 # segment slants towards us already
6083 lappend coords [xc $row $j] $y
6084 } else {
6085 if {$i < $col - 1} {
6086 lappend coords [expr {$x2 + $linespc}] $y
6087 } elseif {$i > $col + 1} {
6088 lappend coords [expr {$x2 - $linespc}] $y
6089 }
6090 lappend coords $x2 $y2
6091 }
6092 } else {
6093 lappend coords $x2 $y2
9f1afe05 6094 }
c934a8a3 6095 set t [$canv create line $coords -width [linewidth $p] \
9f1afe05
PM
6096 -fill $colormap($p) -tags lines.$p]
6097 $canv lower $t
6098 bindline $t $p
6099 }
322a8cc9
PM
6100 if {$rmx > [lindex $idpos($id) 1]} {
6101 lset idpos($id) 1 $rmx
6102 redrawtags $id
6103 }
9f1afe05
PM
6104}
6105
c934a8a3 6106proc drawlines {id} {
322a8cc9 6107 global canv
9f1afe05 6108
322a8cc9 6109 $canv itemconf lines.$id -width [linewidth $id]
9f1afe05
PM
6110}
6111
322a8cc9 6112proc drawcmittext {id row col} {
7fcc92bf
PM
6113 global linespc canv canv2 canv3 fgcolor curview
6114 global cmitlisted commitinfo rowidlist parentlist
9f1afe05 6115 global rowtextx idpos idtags idheads idotherrefs
0380081c 6116 global linehtag linentag linedtag selectedline
b9fdba7f 6117 global canvxmax boldids boldnameids fgcolor markedid
d277e89f 6118 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
252c52df
6119 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6120 global circleoutlinecolor
9f1afe05 6121
1407ade9 6122 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
7fcc92bf 6123 set listed $cmitlisted($curview,$id)
219ea3a9 6124 if {$id eq $nullid} {
252c52df 6125 set ofill $workingfilescirclecolor
8f489363 6126 } elseif {$id eq $nullid2} {
252c52df 6127 set ofill $indexcirclecolor
c11ff120 6128 } elseif {$id eq $mainheadid} {
252c52df 6129 set ofill $mainheadcirclecolor
219ea3a9 6130 } else {
c11ff120 6131 set ofill [lindex $circlecolors $listed]
219ea3a9 6132 }
9f1afe05
PM
6133 set x [xc $row $col]
6134 set y [yc $row]
6135 set orad [expr {$linespc / 3}]
1407ade9 6136 if {$listed <= 2} {
c961b228
PM
6137 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6138 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
252c52df 6139 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
1407ade9 6140 } elseif {$listed == 3} {
c961b228
PM
6141 # triangle pointing left for left-side commits
6142 set t [$canv create polygon \
6143 [expr {$x - $orad}] $y \
6144 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6145 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
252c52df 6146 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
c961b228
PM
6147 } else {
6148 # triangle pointing right for right-side commits
6149 set t [$canv create polygon \
6150 [expr {$x + $orad - 1}] $y \
6151 [expr {$x - $orad}] [expr {$y - $orad}] \
6152 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
252c52df 6153 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
c961b228 6154 }
c11ff120 6155 set circleitem($row) $t
9f1afe05
PM
6156 $canv raise $t
6157 $canv bind $t <1> {selcanvline {} %x %y}
322a8cc9
PM
6158 set rmx [llength [lindex $rowidlist $row]]
6159 set olds [lindex $parentlist $row]
6160 if {$olds ne {}} {
6161 set nextids [lindex $rowidlist [expr {$row + 1}]]
6162 foreach p $olds {
6163 set i [lsearch -exact $nextids $p]
6164 if {$i > $rmx} {
6165 set rmx $i
6166 }
6167 }
9f1afe05 6168 }
322a8cc9 6169 set xt [xc $row $rmx]
9f1afe05
PM
6170 set rowtextx($row) $xt
6171 set idpos($id) [list $x $xt $y]
6172 if {[info exists idtags($id)] || [info exists idheads($id)]
6173 || [info exists idotherrefs($id)]} {
6174 set xt [drawtags $id $x $xt $y]
6175 }
36242490
RZ
6176 if {[lindex $commitinfo($id) 6] > 0} {
6177 set xt [drawnotesign $xt $y]
6178 }
9f1afe05
PM
6179 set headline [lindex $commitinfo($id) 0]
6180 set name [lindex $commitinfo($id) 1]
6181 set date [lindex $commitinfo($id) 2]
6182 set date [formatdate $date]
9c311b32
PM
6183 set font mainfont
6184 set nfont mainfont
476ca63d 6185 set isbold [ishighlighted $id]
908c3585 6186 if {$isbold > 0} {
28593d3f 6187 lappend boldids $id
9c311b32 6188 set font mainfontbold
908c3585 6189 if {$isbold > 1} {
28593d3f 6190 lappend boldnameids $id
9c311b32 6191 set nfont mainfontbold
908c3585 6192 }
da7c24dd 6193 }
28593d3f
PM
6194 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6195 -text $headline -font $font -tags text]
6196 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6197 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6198 -text $name -font $nfont -tags text]
6199 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6200 -text $date -font mainfont -tags text]
94b4a69f 6201 if {$selectedline == $row} {
28593d3f 6202 make_secsel $id
0380081c 6203 }
b9fdba7f
PM
6204 if {[info exists markedid] && $markedid eq $id} {
6205 make_idmark $id
6206 }
9c311b32 6207 set xr [expr {$xt + [font measure $font $headline]}]
be0cd098
PM
6208 if {$xr > $canvxmax} {
6209 set canvxmax $xr
6210 setcanvscroll
6211 }
9f1afe05
PM
6212}
6213
6214proc drawcmitrow {row} {
0380081c 6215 global displayorder rowidlist nrows_drawn
005a2f4e 6216 global iddrawn markingmatches
7fcc92bf 6217 global commitinfo numcommits
687c8765 6218 global filehighlight fhighlights findpattern nhighlights
908c3585 6219 global hlview vhighlights
164ff275 6220 global highlight_related rhighlights
9f1afe05 6221
8f7d0cec 6222 if {$row >= $numcommits} return
9f1afe05
PM
6223
6224 set id [lindex $displayorder $row]
476ca63d 6225 if {[info exists hlview] && ![info exists vhighlights($id)]} {
908c3585
PM
6226 askvhighlight $row $id
6227 }
476ca63d 6228 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
908c3585
PM
6229 askfilehighlight $row $id
6230 }
476ca63d 6231 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
60f7a7dc 6232 askfindhighlight $row $id
908c3585 6233 }
476ca63d 6234 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
164ff275
PM
6235 askrelhighlight $row $id
6236 }
005a2f4e
PM
6237 if {![info exists iddrawn($id)]} {
6238 set col [lsearch -exact [lindex $rowidlist $row] $id]
6239 if {$col < 0} {
6240 puts "oops, row $row id $id not in list"
6241 return
6242 }
6243 if {![info exists commitinfo($id)]} {
6244 getcommit $id
6245 }
6246 assigncolor $id
6247 drawcmittext $id $row $col
6248 set iddrawn($id) 1
0380081c 6249 incr nrows_drawn
9f1afe05 6250 }
005a2f4e
PM
6251 if {$markingmatches} {
6252 markrowmatches $row $id
9f1afe05 6253 }
9f1afe05
PM
6254}
6255
322a8cc9 6256proc drawcommits {row {endrow {}}} {
0380081c 6257 global numcommits iddrawn displayorder curview need_redisplay
f5f3c2e2 6258 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
9f1afe05 6259
9f1afe05
PM
6260 if {$row < 0} {
6261 set row 0
6262 }
322a8cc9
PM
6263 if {$endrow eq {}} {
6264 set endrow $row
6265 }
9f1afe05
PM
6266 if {$endrow >= $numcommits} {
6267 set endrow [expr {$numcommits - 1}]
6268 }
322a8cc9 6269
0380081c
PM
6270 set rl1 [expr {$row - $downarrowlen - 3}]
6271 if {$rl1 < 0} {
6272 set rl1 0
6273 }
6274 set ro1 [expr {$row - 3}]
6275 if {$ro1 < 0} {
6276 set ro1 0
6277 }
6278 set r2 [expr {$endrow + $uparrowlen + 3}]
6279 if {$r2 > $numcommits} {
6280 set r2 $numcommits
6281 }
6282 for {set r $rl1} {$r < $r2} {incr r} {
f5f3c2e2 6283 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
0380081c
PM
6284 if {$rl1 < $r} {
6285 layoutrows $rl1 $r
6286 }
6287 set rl1 [expr {$r + 1}]
6288 }
6289 }
6290 if {$rl1 < $r} {
6291 layoutrows $rl1 $r
6292 }
6293 optimize_rows $ro1 0 $r2
6294 if {$need_redisplay || $nrows_drawn > 2000} {
6295 clear_display
0380081c
PM
6296 }
6297
322a8cc9
PM
6298 # make the lines join to already-drawn rows either side
6299 set r [expr {$row - 1}]
6300 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6301 set r $row
6302 }
6303 set er [expr {$endrow + 1}]
6304 if {$er >= $numcommits ||
6305 ![info exists iddrawn([lindex $displayorder $er])]} {
6306 set er $endrow
6307 }
6308 for {} {$r <= $er} {incr r} {
6309 set id [lindex $displayorder $r]
6310 set wasdrawn [info exists iddrawn($id)]
4fb0fa19 6311 drawcmitrow $r
322a8cc9
PM
6312 if {$r == $er} break
6313 set nextid [lindex $displayorder [expr {$r + 1}]]
e5ef6f95 6314 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
322a8cc9
PM
6315 drawparentlinks $id $r
6316
322a8cc9
PM
6317 set rowids [lindex $rowidlist $r]
6318 foreach lid $rowids {
6319 if {$lid eq {}} continue
e5ef6f95 6320 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
322a8cc9
PM
6321 if {$lid eq $id} {
6322 # see if this is the first child of any of its parents
6323 foreach p [lindex $parentlist $r] {
6324 if {[lsearch -exact $rowids $p] < 0} {
6325 # make this line extend up to the child
e5ef6f95 6326 set lineend($p) [drawlineseg $p $r $er 0]
322a8cc9
PM
6327 }
6328 }
e5ef6f95
PM
6329 } else {
6330 set lineend($lid) [drawlineseg $lid $r $er 1]
322a8cc9
PM
6331 }
6332 }
9f1afe05
PM
6333 }
6334}
6335
7fcc92bf
PM
6336proc undolayout {row} {
6337 global uparrowlen mingaplen downarrowlen
6338 global rowidlist rowisopt rowfinal need_redisplay
6339
6340 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6341 if {$r < 0} {
6342 set r 0
6343 }
6344 if {[llength $rowidlist] > $r} {
6345 incr r -1
6346 set rowidlist [lrange $rowidlist 0 $r]
6347 set rowfinal [lrange $rowfinal 0 $r]
6348 set rowisopt [lrange $rowisopt 0 $r]
6349 set need_redisplay 1
6350 run drawvisible
6351 }
6352}
6353
31c0eaa8
PM
6354proc drawvisible {} {
6355 global canv linespc curview vrowmod selectedline targetrow targetid
42a671fc 6356 global need_redisplay cscroll numcommits
322a8cc9 6357
31c0eaa8 6358 set fs [$canv yview]
322a8cc9 6359 set ymax [lindex [$canv cget -scrollregion] 3]
5a7f577d 6360 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
31c0eaa8
PM
6361 set f0 [lindex $fs 0]
6362 set f1 [lindex $fs 1]
322a8cc9 6363 set y0 [expr {int($f0 * $ymax)}]
322a8cc9 6364 set y1 [expr {int($f1 * $ymax)}]
31c0eaa8
PM
6365
6366 if {[info exists targetid]} {
42a671fc
PM
6367 if {[commitinview $targetid $curview]} {
6368 set r [rowofcommit $targetid]
6369 if {$r != $targetrow} {
6370 # Fix up the scrollregion and change the scrolling position
6371 # now that our target row has moved.
6372 set diff [expr {($r - $targetrow) * $linespc}]
6373 set targetrow $r
6374 setcanvscroll
6375 set ymax [lindex [$canv cget -scrollregion] 3]
6376 incr y0 $diff
6377 incr y1 $diff
6378 set f0 [expr {$y0 / $ymax}]
6379 set f1 [expr {$y1 / $ymax}]
6380 allcanvs yview moveto $f0
6381 $cscroll set $f0 $f1
6382 set need_redisplay 1
6383 }
6384 } else {
6385 unset targetid
31c0eaa8
PM
6386 }
6387 }
6388
6389 set row [expr {int(($y0 - 3) / $linespc) - 1}]
322a8cc9 6390 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
31c0eaa8
PM
6391 if {$endrow >= $vrowmod($curview)} {
6392 update_arcrows $curview
6393 }
94b4a69f 6394 if {$selectedline ne {} &&
31c0eaa8
PM
6395 $row <= $selectedline && $selectedline <= $endrow} {
6396 set targetrow $selectedline
ac1276ab 6397 } elseif {[info exists targetid]} {
31c0eaa8
PM
6398 set targetrow [expr {int(($row + $endrow) / 2)}]
6399 }
ac1276ab
PM
6400 if {[info exists targetrow]} {
6401 if {$targetrow >= $numcommits} {
6402 set targetrow [expr {$numcommits - 1}]
6403 }
6404 set targetid [commitonrow $targetrow]
42a671fc 6405 }
322a8cc9
PM
6406 drawcommits $row $endrow
6407}
6408
9f1afe05 6409proc clear_display {} {
0380081c 6410 global iddrawn linesegs need_redisplay nrows_drawn
164ff275 6411 global vhighlights fhighlights nhighlights rhighlights
28593d3f 6412 global linehtag linentag linedtag boldids boldnameids
9f1afe05
PM
6413
6414 allcanvs delete all
009409fe
PM
6415 unset -nocomplain iddrawn
6416 unset -nocomplain linesegs
6417 unset -nocomplain linehtag
6418 unset -nocomplain linentag
6419 unset -nocomplain linedtag
28593d3f
PM
6420 set boldids {}
6421 set boldnameids {}
009409fe
PM
6422 unset -nocomplain vhighlights
6423 unset -nocomplain fhighlights
6424 unset -nocomplain nhighlights
6425 unset -nocomplain rhighlights
0380081c
PM
6426 set need_redisplay 0
6427 set nrows_drawn 0
9f1afe05
PM
6428}
6429
50b44ece 6430proc findcrossings {id} {
6e8c8707 6431 global rowidlist parentlist numcommits displayorder
50b44ece
PM
6432
6433 set cross {}
6434 set ccross {}
6435 foreach {s e} [rowranges $id] {
6436 if {$e >= $numcommits} {
6437 set e [expr {$numcommits - 1}]
50b44ece 6438 }
d94f8cd6 6439 if {$e <= $s} continue
50b44ece 6440 for {set row $e} {[incr row -1] >= $s} {} {
6e8c8707
PM
6441 set x [lsearch -exact [lindex $rowidlist $row] $id]
6442 if {$x < 0} break
50b44ece
PM
6443 set olds [lindex $parentlist $row]
6444 set kid [lindex $displayorder $row]
6445 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6446 if {$kidx < 0} continue
6447 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6448 foreach p $olds {
6449 set px [lsearch -exact $nextrow $p]
6450 if {$px < 0} continue
6451 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6452 if {[lsearch -exact $ccross $p] >= 0} continue
6453 if {$x == $px + ($kidx < $px? -1: 1)} {
6454 lappend ccross $p
6455 } elseif {[lsearch -exact $cross $p] < 0} {
6456 lappend cross $p
6457 }
6458 }
6459 }
50b44ece
PM
6460 }
6461 }
6462 return [concat $ccross {{}} $cross]
6463}
6464
e5c2d856 6465proc assigncolor {id} {
aa81d974 6466 global colormap colors nextcolor
7fcc92bf 6467 global parents children children curview
6c20ff34 6468
418c4c7b 6469 if {[info exists colormap($id)]} return
e5c2d856 6470 set ncolors [llength $colors]
da7c24dd
PM
6471 if {[info exists children($curview,$id)]} {
6472 set kids $children($curview,$id)
79b2c75e
PM
6473 } else {
6474 set kids {}
6475 }
6476 if {[llength $kids] == 1} {
6477 set child [lindex $kids 0]
9ccbdfbf 6478 if {[info exists colormap($child)]
7fcc92bf 6479 && [llength $parents($curview,$child)] == 1} {
9ccbdfbf
PM
6480 set colormap($id) $colormap($child)
6481 return
e5c2d856 6482 }
9ccbdfbf
PM
6483 }
6484 set badcolors {}
50b44ece
PM
6485 set origbad {}
6486 foreach x [findcrossings $id] {
6487 if {$x eq {}} {
6488 # delimiter between corner crossings and other crossings
6489 if {[llength $badcolors] >= $ncolors - 1} break
6490 set origbad $badcolors
e5c2d856 6491 }
50b44ece
PM
6492 if {[info exists colormap($x)]
6493 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6494 lappend badcolors $colormap($x)
6c20ff34
PM
6495 }
6496 }
50b44ece
PM
6497 if {[llength $badcolors] >= $ncolors} {
6498 set badcolors $origbad
9ccbdfbf 6499 }
50b44ece 6500 set origbad $badcolors
6c20ff34 6501 if {[llength $badcolors] < $ncolors - 1} {
79b2c75e 6502 foreach child $kids {
6c20ff34
PM
6503 if {[info exists colormap($child)]
6504 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6505 lappend badcolors $colormap($child)
6506 }
7fcc92bf 6507 foreach p $parents($curview,$child) {
79b2c75e
PM
6508 if {[info exists colormap($p)]
6509 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6510 lappend badcolors $colormap($p)
6c20ff34
PM
6511 }
6512 }
6513 }
6514 if {[llength $badcolors] >= $ncolors} {
6515 set badcolors $origbad
6516 }
9ccbdfbf
PM
6517 }
6518 for {set i 0} {$i <= $ncolors} {incr i} {
6519 set c [lindex $colors $nextcolor]
6520 if {[incr nextcolor] >= $ncolors} {
6521 set nextcolor 0
e5c2d856 6522 }
9ccbdfbf 6523 if {[lsearch -exact $badcolors $c]} break
e5c2d856 6524 }
9ccbdfbf 6525 set colormap($id) $c
e5c2d856
PM
6526}
6527
a823a911
PM
6528proc bindline {t id} {
6529 global canv
6530
a823a911
PM
6531 $canv bind $t <Enter> "lineenter %x %y $id"
6532 $canv bind $t <Motion> "linemotion %x %y $id"
6533 $canv bind $t <Leave> "lineleave $id"
fa4da7b3 6534 $canv bind $t <Button-1> "lineclick %x %y $id 1"
a823a911
PM
6535}
6536
4399fe33
PM
6537proc graph_pane_width {} {
6538 global use_ttk
6539
6540 if {$use_ttk} {
6541 set g [.tf.histframe.pwclist sashpos 0]
6542 } else {
6543 set g [.tf.histframe.pwclist sash coord 0]
6544 }
6545 return [lindex $g 0]
6546}
6547
6548proc totalwidth {l font extra} {
6549 set tot 0
6550 foreach str $l {
6551 set tot [expr {$tot + [font measure $font $str] + $extra}]
6552 }
6553 return $tot
6554}
6555
bdbfbe3d 6556proc drawtags {id x xt y1} {
8a48571c 6557 global idtags idheads idotherrefs mainhead
bdbfbe3d 6558 global linespc lthickness
d277e89f 6559 global canv rowtextx curview fgcolor bgcolor ctxbut
252c52df
6560 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6561 global tagbgcolor tagfgcolor tagoutlinecolor
6562 global reflinecolor
bdbfbe3d
PM
6563
6564 set marks {}
6565 set ntags 0
f1d83ba3 6566 set nheads 0
4399fe33
PM
6567 set singletag 0
6568 set maxtags 3
6569 set maxtagpct 25
6570 set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6571 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6572 set extra [expr {$delta + $lthickness + $linespc}]
6573
bdbfbe3d
PM
6574 if {[info exists idtags($id)]} {
6575 set marks $idtags($id)
6576 set ntags [llength $marks]
4399fe33
PM
6577 if {$ntags > $maxtags ||
6578 [totalwidth $marks mainfont $extra] > $maxwidth} {
6579 # show just a single "n tags..." tag
6580 set singletag 1
6581 if {$ntags == 1} {
6582 set marks [list "tag..."]
6583 } else {
6584 set marks [list [format "%d tags..." $ntags]]
6585 }
6586 set ntags 1
6587 }
bdbfbe3d
PM
6588 }
6589 if {[info exists idheads($id)]} {
6590 set marks [concat $marks $idheads($id)]
f1d83ba3
PM
6591 set nheads [llength $idheads($id)]
6592 }
6593 if {[info exists idotherrefs($id)]} {
6594 set marks [concat $marks $idotherrefs($id)]
bdbfbe3d
PM
6595 }
6596 if {$marks eq {}} {
6597 return $xt
6598 }
6599
2ed49d54
JH
6600 set yt [expr {$y1 - 0.5 * $linespc}]
6601 set yb [expr {$yt + $linespc - 1}]
bdbfbe3d
PM
6602 set xvals {}
6603 set wvals {}
8a48571c 6604 set i -1
bdbfbe3d 6605 foreach tag $marks {
8a48571c
PM
6606 incr i
6607 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
9c311b32 6608 set wid [font measure mainfontbold $tag]
8a48571c 6609 } else {
9c311b32 6610 set wid [font measure mainfont $tag]
8a48571c 6611 }
bdbfbe3d
PM
6612 lappend xvals $xt
6613 lappend wvals $wid
4399fe33 6614 set xt [expr {$xt + $wid + $extra}]
bdbfbe3d
PM
6615 }
6616 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
252c52df 6617 -width $lthickness -fill $reflinecolor -tags tag.$id]
bdbfbe3d
PM
6618 $canv lower $t
6619 foreach tag $marks x $xvals wid $wvals {
8dd60f54 6620 set tag_quoted [string map {% %%} $tag]
2ed49d54
JH
6621 set xl [expr {$x + $delta}]
6622 set xr [expr {$x + $delta + $wid + $lthickness}]
9c311b32 6623 set font mainfont
bdbfbe3d
PM
6624 if {[incr ntags -1] >= 0} {
6625 # draw a tag
2ed49d54
JH
6626 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6627 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
252c52df
6628 -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6629 -tags tag.$id]
4399fe33
PM
6630 if {$singletag} {
6631 set tagclick [list showtags $id 1]
6632 } else {
6633 set tagclick [list showtag $tag_quoted 1]
6634 }
6635 $canv bind $t <1> $tagclick
7fcc92bf 6636 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
bdbfbe3d 6637 } else {
f1d83ba3
PM
6638 # draw a head or other ref
6639 if {[incr nheads -1] >= 0} {
252c52df 6640 set col $headbgcolor
8a48571c 6641 if {$tag eq $mainhead} {
9c311b32 6642 set font mainfontbold
8a48571c 6643 }
f1d83ba3
PM
6644 } else {
6645 set col "#ddddff"
6646 }
2ed49d54 6647 set xl [expr {$xl - $delta/2}]
bdbfbe3d 6648 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
f1d83ba3 6649 -width 1 -outline black -fill $col -tags tag.$id
a970fcf2 6650 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
9c311b32 6651 set rwid [font measure mainfont $remoteprefix]
a970fcf2
JW
6652 set xi [expr {$x + 1}]
6653 set yti [expr {$yt + 1}]
6654 set xri [expr {$x + $rwid}]
6655 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
252c52df 6656 -width 0 -fill $remotebgcolor -tags tag.$id
a970fcf2 6657 }
bdbfbe3d 6658 }
252c52df 6659 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
8a48571c 6660 -font $font -tags [list tag.$id text]]
106288cb 6661 if {$ntags >= 0} {
4399fe33 6662 $canv bind $t <1> $tagclick
10299152 6663 } elseif {$nheads >= 0} {
8dd60f54 6664 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
106288cb 6665 }
bdbfbe3d
PM
6666 }
6667 return $xt
6668}
6669
36242490
RZ
6670proc drawnotesign {xt y} {
6671 global linespc canv fgcolor
6672
6673 set orad [expr {$linespc / 3}]
6674 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6675 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6676 -fill yellow -outline $fgcolor -width 1 -tags circle]
6677 set xt [expr {$xt + $orad * 3}]
6678 return $xt
6679}
6680
8d858d1a
PM
6681proc xcoord {i level ln} {
6682 global canvx0 xspc1 xspc2
6683
6684 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6685 if {$i > 0 && $i == $level} {
6686 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6687 } elseif {$i > $level} {
6688 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6689 }
6690 return $x
6691}
9ccbdfbf 6692
098dd8a3 6693proc show_status {msg} {
9c311b32 6694 global canv fgcolor
098dd8a3
PM
6695
6696 clear_display
9922c5a3 6697 set_window_title
9c311b32 6698 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
f8a2c0d1 6699 -tags text -fill $fgcolor
098dd8a3
PM
6700}
6701
94a2eede
PM
6702# Don't change the text pane cursor if it is currently the hand cursor,
6703# showing that we are over a sha1 ID link.
6704proc settextcursor {c} {
6705 global ctext curtextcursor
6706
6707 if {[$ctext cget -cursor] == $curtextcursor} {
6708 $ctext config -cursor $c
6709 }
6710 set curtextcursor $c
9ccbdfbf
PM
6711}
6712
a137a90f
PM
6713proc nowbusy {what {name {}}} {
6714 global isbusy busyname statusw
da7c24dd
PM
6715
6716 if {[array names isbusy] eq {}} {
6717 . config -cursor watch
6718 settextcursor watch
6719 }
6720 set isbusy($what) 1
a137a90f
PM
6721 set busyname($what) $name
6722 if {$name ne {}} {
6723 $statusw conf -text $name
6724 }
da7c24dd
PM
6725}
6726
6727proc notbusy {what} {
a137a90f 6728 global isbusy maincursor textcursor busyname statusw
da7c24dd 6729
a137a90f
PM
6730 catch {
6731 unset isbusy($what)
6732 if {$busyname($what) ne {} &&
6733 [$statusw cget -text] eq $busyname($what)} {
6734 $statusw conf -text {}
6735 }
6736 }
da7c24dd
PM
6737 if {[array names isbusy] eq {}} {
6738 . config -cursor $maincursor
6739 settextcursor $textcursor
6740 }
6741}
6742
df3d83b1 6743proc findmatches {f} {
4fb0fa19 6744 global findtype findstring
b007ee20 6745 if {$findtype == [mc "Regexp"]} {
4fb0fa19 6746 set matches [regexp -indices -all -inline $findstring $f]
df3d83b1 6747 } else {
4fb0fa19 6748 set fs $findstring
b007ee20 6749 if {$findtype == [mc "IgnCase"]} {
4fb0fa19
PM
6750 set f [string tolower $f]
6751 set fs [string tolower $fs]
df3d83b1
PM
6752 }
6753 set matches {}
6754 set i 0
4fb0fa19
PM
6755 set l [string length $fs]
6756 while {[set j [string first $fs $f $i]] >= 0} {
6757 lappend matches [list $j [expr {$j+$l-1}]]
6758 set i [expr {$j + $l}]
df3d83b1
PM
6759 }
6760 }
6761 return $matches
6762}
6763
cca5d946 6764proc dofind {{dirn 1} {wrap 1}} {
4fb0fa19 6765 global findstring findstartline findcurline selectedline numcommits
cca5d946 6766 global gdttype filehighlight fh_serial find_dirn findallowwrap
b74fd579 6767
cca5d946
PM
6768 if {[info exists find_dirn]} {
6769 if {$find_dirn == $dirn} return
6770 stopfinding
6771 }
df3d83b1 6772 focus .
4fb0fa19 6773 if {$findstring eq {} || $numcommits == 0} return
94b4a69f 6774 if {$selectedline eq {}} {
cca5d946 6775 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
98f350e5 6776 } else {
4fb0fa19 6777 set findstartline $selectedline
98f350e5 6778 }
4fb0fa19 6779 set findcurline $findstartline
b007ee20
CS
6780 nowbusy finding [mc "Searching"]
6781 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
687c8765
PM
6782 after cancel do_file_hl $fh_serial
6783 do_file_hl $fh_serial
98f350e5 6784 }
cca5d946
PM
6785 set find_dirn $dirn
6786 set findallowwrap $wrap
6787 run findmore
4fb0fa19
PM
6788}
6789
bb3edc8b
PM
6790proc stopfinding {} {
6791 global find_dirn findcurline fprogcoord
4fb0fa19 6792
bb3edc8b
PM
6793 if {[info exists find_dirn]} {
6794 unset find_dirn
6795 unset findcurline
6796 notbusy finding
6797 set fprogcoord 0
6798 adjustprogress
4fb0fa19 6799 }
8a897742 6800 stopblaming
4fb0fa19
PM
6801}
6802
6803proc findmore {} {
687c8765 6804 global commitdata commitinfo numcommits findpattern findloc
7fcc92bf 6805 global findstartline findcurline findallowwrap
bb3edc8b 6806 global find_dirn gdttype fhighlights fprogcoord
cd2bcae7 6807 global curview varcorder vrownum varccommits vrowmod
4fb0fa19 6808
bb3edc8b 6809 if {![info exists find_dirn]} {
4fb0fa19
PM
6810 return 0
6811 }
585c27cb 6812 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
4fb0fa19 6813 set l $findcurline
cca5d946
PM
6814 set moretodo 0
6815 if {$find_dirn > 0} {
6816 incr l
6817 if {$l >= $numcommits} {
6818 set l 0
6819 }
6820 if {$l <= $findstartline} {
6821 set lim [expr {$findstartline + 1}]
6822 } else {
6823 set lim $numcommits
6824 set moretodo $findallowwrap
8ed16484 6825 }
4fb0fa19 6826 } else {
cca5d946
PM
6827 if {$l == 0} {
6828 set l $numcommits
98f350e5 6829 }
cca5d946
PM
6830 incr l -1
6831 if {$l >= $findstartline} {
6832 set lim [expr {$findstartline - 1}]
bb3edc8b 6833 } else {
cca5d946
PM
6834 set lim -1
6835 set moretodo $findallowwrap
bb3edc8b 6836 }
687c8765 6837 }
cca5d946
PM
6838 set n [expr {($lim - $l) * $find_dirn}]
6839 if {$n > 500} {
6840 set n 500
6841 set moretodo 1
4fb0fa19 6842 }
cd2bcae7
PM
6843 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6844 update_arcrows $curview
6845 }
687c8765
PM
6846 set found 0
6847 set domore 1
7fcc92bf
PM
6848 set ai [bsearch $vrownum($curview) $l]
6849 set a [lindex $varcorder($curview) $ai]
6850 set arow [lindex $vrownum($curview) $ai]
6851 set ids [lindex $varccommits($curview,$a)]
6852 set arowend [expr {$arow + [llength $ids]}]
b007ee20 6853 if {$gdttype eq [mc "containing:"]} {
cca5d946 6854 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6855 if {$l < $arow || $l >= $arowend} {
6856 incr ai $find_dirn
6857 set a [lindex $varcorder($curview) $ai]
6858 set arow [lindex $vrownum($curview) $ai]
6859 set ids [lindex $varccommits($curview,$a)]
6860 set arowend [expr {$arow + [llength $ids]}]
6861 }
6862 set id [lindex $ids [expr {$l - $arow}]]
cca5d946 6863 # shouldn't happen unless git log doesn't give all the commits...
7fcc92bf
PM
6864 if {![info exists commitdata($id)] ||
6865 ![doesmatch $commitdata($id)]} {
6866 continue
6867 }
687c8765
PM
6868 if {![info exists commitinfo($id)]} {
6869 getcommit $id
6870 }
6871 set info $commitinfo($id)
6872 foreach f $info ty $fldtypes {
585c27cb 6873 if {$ty eq ""} continue
b007ee20 6874 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
687c8765
PM
6875 [doesmatch $f]} {
6876 set found 1
6877 break
6878 }
6879 }
6880 if {$found} break
4fb0fa19 6881 }
687c8765 6882 } else {
cca5d946 6883 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
7fcc92bf
PM
6884 if {$l < $arow || $l >= $arowend} {
6885 incr ai $find_dirn
6886 set a [lindex $varcorder($curview) $ai]
6887 set arow [lindex $vrownum($curview) $ai]
6888 set ids [lindex $varccommits($curview,$a)]
6889 set arowend [expr {$arow + [llength $ids]}]
6890 }
6891 set id [lindex $ids [expr {$l - $arow}]]
476ca63d
PM
6892 if {![info exists fhighlights($id)]} {
6893 # this sets fhighlights($id) to -1
687c8765 6894 askfilehighlight $l $id
cd2bcae7 6895 }
476ca63d 6896 if {$fhighlights($id) > 0} {
cd2bcae7
PM
6897 set found $domore
6898 break
6899 }
476ca63d 6900 if {$fhighlights($id) < 0} {
687c8765
PM
6901 if {$domore} {
6902 set domore 0
cca5d946 6903 set findcurline [expr {$l - $find_dirn}]
687c8765 6904 }
98f350e5
PM
6905 }
6906 }
6907 }
cca5d946 6908 if {$found || ($domore && !$moretodo)} {
4fb0fa19 6909 unset findcurline
687c8765 6910 unset find_dirn
4fb0fa19 6911 notbusy finding
bb3edc8b
PM
6912 set fprogcoord 0
6913 adjustprogress
6914 if {$found} {
6915 findselectline $l
6916 } else {
6917 bell
6918 }
4fb0fa19 6919 return 0
df3d83b1 6920 }
687c8765
PM
6921 if {!$domore} {
6922 flushhighlights
bb3edc8b 6923 } else {
cca5d946 6924 set findcurline [expr {$l - $find_dirn}]
687c8765 6925 }
cca5d946 6926 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
bb3edc8b
PM
6927 if {$n < 0} {
6928 incr n $numcommits
df3d83b1 6929 }
bb3edc8b
PM
6930 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6931 adjustprogress
6932 return $domore
df3d83b1
PM
6933}
6934
6935proc findselectline {l} {
687c8765 6936 global findloc commentend ctext findcurline markingmatches gdttype
005a2f4e 6937
8b39e04f 6938 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
005a2f4e 6939 set findcurline $l
d698206c 6940 selectline $l 1
8b39e04f
PM
6941 if {$markingmatches &&
6942 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
df3d83b1
PM
6943 # highlight the matches in the comments
6944 set f [$ctext get 1.0 $commentend]
6945 set matches [findmatches $f]
6946 foreach match $matches {
6947 set start [lindex $match 0]
2ed49d54 6948 set end [expr {[lindex $match 1] + 1}]
df3d83b1
PM
6949 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6950 }
98f350e5 6951 }
005a2f4e 6952 drawvisible
98f350e5
PM
6953}
6954
4fb0fa19 6955# mark the bits of a headline or author that match a find string
005a2f4e
PM
6956proc markmatches {canv l str tag matches font row} {
6957 global selectedline
6958
98f350e5
PM
6959 set bbox [$canv bbox $tag]
6960 set x0 [lindex $bbox 0]
6961 set y0 [lindex $bbox 1]
6962 set y1 [lindex $bbox 3]
6963 foreach match $matches {
6964 set start [lindex $match 0]
6965 set end [lindex $match 1]
6966 if {$start > $end} continue
2ed49d54
JH
6967 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6968 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6969 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6970 [expr {$x0+$xlen+2}] $y1 \
4fb0fa19 6971 -outline {} -tags [list match$l matches] -fill yellow]
98f350e5 6972 $canv lower $t
94b4a69f 6973 if {$row == $selectedline} {
005a2f4e
PM
6974 $canv raise $t secsel
6975 }
98f350e5
PM
6976 }
6977}
6978
6979proc unmarkmatches {} {
bb3edc8b 6980 global markingmatches
4fb0fa19 6981
98f350e5 6982 allcanvs delete matches
4fb0fa19 6983 set markingmatches 0
bb3edc8b 6984 stopfinding
98f350e5
PM
6985}
6986
c8dfbcf9 6987proc selcanvline {w x y} {
fa4da7b3 6988 global canv canvy0 ctext linespc
9f1afe05 6989 global rowtextx
1db95b00 6990 set ymax [lindex [$canv cget -scrollregion] 3]
cfb4563c 6991 if {$ymax == {}} return
1db95b00
PM
6992 set yfrac [lindex [$canv yview] 0]
6993 set y [expr {$y + $yfrac * $ymax}]
6994 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6995 if {$l < 0} {
6996 set l 0
6997 }
c8dfbcf9 6998 if {$w eq $canv} {
fc2a256f
PM
6999 set xmax [lindex [$canv cget -scrollregion] 2]
7000 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
7001 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
c8dfbcf9 7002 }
98f350e5 7003 unmarkmatches
d698206c 7004 selectline $l 1
5ad588de
PM
7005}
7006
b1ba39e7
LT
7007proc commit_descriptor {p} {
7008 global commitinfo
b0934489
PM
7009 if {![info exists commitinfo($p)]} {
7010 getcommit $p
7011 }
b1ba39e7 7012 set l "..."
b0934489 7013 if {[llength $commitinfo($p)] > 1} {
b1ba39e7
LT
7014 set l [lindex $commitinfo($p) 0]
7015 }
b8ab2e17 7016 return "$p ($l)\n"
b1ba39e7
LT
7017}
7018
106288cb
PM
7019# append some text to the ctext widget, and make any SHA1 ID
7020# that we know about be a clickable link.
3441de5b 7021# Also look for URLs of the form "http[s]://..." and make them web links.
f1b86294 7022proc appendwithlinks {text tags} {
d375ef9b 7023 global ctext linknum curview
106288cb
PM
7024
7025 set start [$ctext index "end - 1c"]
f1b86294 7026 $ctext insert end $text $tags
6c9e2d18 7027 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
106288cb
PM
7028 foreach l $links {
7029 set s [lindex $l 0]
7030 set e [lindex $l 1]
7031 set linkid [string range $text $s $e]
106288cb 7032 incr e
c73adce2 7033 $ctext tag delete link$linknum
106288cb 7034 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
97645683 7035 setlink $linkid link$linknum
106288cb
PM
7036 incr linknum
7037 }
3441de5b
PM
7038 set wlinks [regexp -indices -all -inline -line \
7039 {https?://[^[:space:]]+} $text]
7040 foreach l $wlinks {
7041 set s2 [lindex $l 0]
7042 set e2 [lindex $l 1]
7043 set url [string range $text $s2 $e2]
7044 incr e2
7045 $ctext tag delete link$linknum
7046 $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7047 setwlink $url link$linknum
7048 incr linknum
7049 }
97645683
PM
7050}
7051
7052proc setlink {id lk} {
d375ef9b 7053 global curview ctext pendinglinks
252c52df 7054 global linkfgcolor
97645683 7055
6c9e2d18
JM
7056 if {[string range $id 0 1] eq "-g"} {
7057 set id [string range $id 2 end]
7058 }
7059
d375ef9b
PM
7060 set known 0
7061 if {[string length $id] < 40} {
7062 set matches [longid $id]
7063 if {[llength $matches] > 0} {
7064 if {[llength $matches] > 1} return
7065 set known 1
7066 set id [lindex $matches 0]
7067 }
7068 } else {
7069 set known [commitinview $id $curview]
7070 }
7071 if {$known} {
252c52df 7072 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
d375ef9b 7073 $ctext tag bind $lk <1> [list selbyid $id]
97645683
PM
7074 $ctext tag bind $lk <Enter> {linkcursor %W 1}
7075 $ctext tag bind $lk <Leave> {linkcursor %W -1}
7076 } else {
7077 lappend pendinglinks($id) $lk
d375ef9b 7078 interestedin $id {makelink %P}
97645683
PM
7079 }
7080}
7081
3441de5b
PM
7082proc setwlink {url lk} {
7083 global ctext
7084 global linkfgcolor
7085 global web_browser
7086
7087 if {$web_browser eq {}} return
7088 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7089 $ctext tag bind $lk <1> [list browseweb $url]
7090 $ctext tag bind $lk <Enter> {linkcursor %W 1}
7091 $ctext tag bind $lk <Leave> {linkcursor %W -1}
7092}
7093
6f63fc18
PM
7094proc appendshortlink {id {pre {}} {post {}}} {
7095 global ctext linknum
7096
7097 $ctext insert end $pre
7098 $ctext tag delete link$linknum
7099 $ctext insert end [string range $id 0 7] link$linknum
7100 $ctext insert end $post
7101 setlink $id link$linknum
7102 incr linknum
7103}
7104
97645683
PM
7105proc makelink {id} {
7106 global pendinglinks
7107
7108 if {![info exists pendinglinks($id)]} return
7109 foreach lk $pendinglinks($id) {
7110 setlink $id $lk
7111 }
7112 unset pendinglinks($id)
7113}
7114
7115proc linkcursor {w inc} {
7116 global linkentercount curtextcursor
7117
7118 if {[incr linkentercount $inc] > 0} {
7119 $w configure -cursor hand2
7120 } else {
7121 $w configure -cursor $curtextcursor
7122 if {$linkentercount < 0} {
7123 set linkentercount 0
7124 }
7125 }
106288cb
PM
7126}
7127
3441de5b
PM
7128proc browseweb {url} {
7129 global web_browser
7130
7131 if {$web_browser eq {}} return
7132 # Use eval here in case $web_browser is a command plus some arguments
7133 if {[catch {eval exec $web_browser [list $url] &} err]} {
7134 error_popup "[mc "Error starting web browser:"] $err"
7135 }
7136}
7137
6e5f7203
RN
7138proc viewnextline {dir} {
7139 global canv linespc
7140
7141 $canv delete hover
7142 set ymax [lindex [$canv cget -scrollregion] 3]
7143 set wnow [$canv yview]
7144 set wtop [expr {[lindex $wnow 0] * $ymax}]
7145 set newtop [expr {$wtop + $dir * $linespc}]
7146 if {$newtop < 0} {
7147 set newtop 0
7148 } elseif {$newtop > $ymax} {
7149 set newtop $ymax
7150 }
7151 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7152}
7153
ef030b85
PM
7154# add a list of tag or branch names at position pos
7155# returns the number of names inserted
e11f1233 7156proc appendrefs {pos ids var} {
bde4a0f9 7157 global ctext linknum curview $var maxrefs visiblerefs mainheadid
b8ab2e17 7158
ef030b85
PM
7159 if {[catch {$ctext index $pos}]} {
7160 return 0
7161 }
e11f1233
PM
7162 $ctext conf -state normal
7163 $ctext delete $pos "$pos lineend"
7164 set tags {}
7165 foreach id $ids {
7166 foreach tag [set $var\($id\)] {
7167 lappend tags [list $tag $id]
7168 }
7169 }
386befb7
PM
7170
7171 set sep {}
7172 set tags [lsort -index 0 -decreasing $tags]
7173 set nutags 0
7174
0a4dd8b8 7175 if {[llength $tags] > $maxrefs} {
386befb7
PM
7176 # If we are displaying heads, and there are too many,
7177 # see if there are some important heads to display.
bde4a0f9 7178 # Currently that are the current head and heads listed in $visiblerefs option
386befb7
PM
7179 set itags {}
7180 if {$var eq "idheads"} {
7181 set utags {}
7182 foreach ti $tags {
7183 set hname [lindex $ti 0]
7184 set id [lindex $ti 1]
bde4a0f9 7185 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
386befb7
PM
7186 [llength $itags] < $maxrefs} {
7187 lappend itags $ti
7188 } else {
7189 lappend utags $ti
7190 }
7191 }
7192 set tags $utags
b8ab2e17 7193 }
386befb7
PM
7194 if {$itags ne {}} {
7195 set str [mc "and many more"]
7196 set sep " "
7197 } else {
7198 set str [mc "many"]
7199 }
7200 $ctext insert $pos "$str ([llength $tags])"
7201 set nutags [llength $tags]
7202 set tags $itags
7203 }
7204
7205 foreach ti $tags {
7206 set id [lindex $ti 1]
7207 set lk link$linknum
7208 incr linknum
7209 $ctext tag delete $lk
7210 $ctext insert $pos $sep
7211 $ctext insert $pos [lindex $ti 0] $lk
7212 setlink $id $lk
7213 set sep ", "
b8ab2e17 7214 }
d34835c9 7215 $ctext tag add wwrap "$pos linestart" "$pos lineend"
e11f1233 7216 $ctext conf -state disabled
386befb7 7217 return [expr {[llength $tags] + $nutags}]
b8ab2e17
PM
7218}
7219
e11f1233
PM
7220# called when we have finished computing the nearby tags
7221proc dispneartags {delay} {
7222 global selectedline currentid showneartags tagphase
ca6d8f58 7223
94b4a69f 7224 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
7225 after cancel dispnexttag
7226 if {$delay} {
7227 after 200 dispnexttag
7228 set tagphase -1
7229 } else {
7230 after idle dispnexttag
7231 set tagphase 0
ca6d8f58 7232 }
ca6d8f58
PM
7233}
7234
e11f1233
PM
7235proc dispnexttag {} {
7236 global selectedline currentid showneartags tagphase ctext
b8ab2e17 7237
94b4a69f 7238 if {$selectedline eq {} || !$showneartags} return
e11f1233
PM
7239 switch -- $tagphase {
7240 0 {
7241 set dtags [desctags $currentid]
7242 if {$dtags ne {}} {
7243 appendrefs precedes $dtags idtags
7244 }
7245 }
7246 1 {
7247 set atags [anctags $currentid]
7248 if {$atags ne {}} {
7249 appendrefs follows $atags idtags
7250 }
7251 }
7252 2 {
7253 set dheads [descheads $currentid]
7254 if {$dheads ne {}} {
7255 if {[appendrefs branch $dheads idheads] > 1
7256 && [$ctext get "branch -3c"] eq "h"} {
7257 # turn "Branch" into "Branches"
7258 $ctext conf -state normal
7259 $ctext insert "branch -2c" "es"
7260 $ctext conf -state disabled
7261 }
7262 }
ef030b85
PM
7263 }
7264 }
e11f1233
PM
7265 if {[incr tagphase] <= 2} {
7266 after idle dispnexttag
b8ab2e17 7267 }
b8ab2e17
PM
7268}
7269
28593d3f 7270proc make_secsel {id} {
0380081c
PM
7271 global linehtag linentag linedtag canv canv2 canv3
7272
28593d3f 7273 if {![info exists linehtag($id)]} return
0380081c 7274 $canv delete secsel
28593d3f 7275 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
0380081c
PM
7276 -tags secsel -fill [$canv cget -selectbackground]]
7277 $canv lower $t
7278 $canv2 delete secsel
28593d3f 7279 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
0380081c
PM
7280 -tags secsel -fill [$canv2 cget -selectbackground]]
7281 $canv2 lower $t
7282 $canv3 delete secsel
28593d3f 7283 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
0380081c
PM
7284 -tags secsel -fill [$canv3 cget -selectbackground]]
7285 $canv3 lower $t
7286}
7287
b9fdba7f
PM
7288proc make_idmark {id} {
7289 global linehtag canv fgcolor
7290
7291 if {![info exists linehtag($id)]} return
7292 $canv delete markid
7293 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7294 -tags markid -outline $fgcolor]
7295 $canv raise $t
7296}
7297
4135d36b 7298proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
0380081c 7299 global canv ctext commitinfo selectedline
7fcc92bf 7300 global canvy0 linespc parents children curview
7fcceed7 7301 global currentid sha1entry
9f1afe05 7302 global commentend idtags linknum
d94f8cd6 7303 global mergemax numcommits pending_select
e11f1233 7304 global cmitmode showneartags allcommits
c30acc77 7305 global targetrow targetid lastscrollrows
21ac8a8d 7306 global autoselect autosellen jump_to_here
9403bd02 7307 global vinlinediff
d698206c 7308
009409fe 7309 unset -nocomplain pending_select
84ba7345 7310 $canv delete hover
9843c307 7311 normalline
887c996e 7312 unsel_reflist
bb3edc8b 7313 stopfinding
8f7d0cec 7314 if {$l < 0 || $l >= $numcommits} return
ac1276ab
PM
7315 set id [commitonrow $l]
7316 set targetid $id
7317 set targetrow $l
c30acc77
PM
7318 set selectedline $l
7319 set currentid $id
7320 if {$lastscrollrows < $numcommits} {
7321 setcanvscroll
7322 }
ac1276ab 7323
4135d36b
MK
7324 if {$cmitmode ne "patch" && $switch_to_patch} {
7325 set cmitmode "patch"
7326 }
7327
5ad588de 7328 set y [expr {$canvy0 + $l * $linespc}]
17386066 7329 set ymax [lindex [$canv cget -scrollregion] 3]
5842215e
PM
7330 set ytop [expr {$y - $linespc - 1}]
7331 set ybot [expr {$y + $linespc + 1}]
5ad588de 7332 set wnow [$canv yview]
2ed49d54
JH
7333 set wtop [expr {[lindex $wnow 0] * $ymax}]
7334 set wbot [expr {[lindex $wnow 1] * $ymax}]
5842215e
PM
7335 set wh [expr {$wbot - $wtop}]
7336 set newtop $wtop
17386066 7337 if {$ytop < $wtop} {
5842215e
PM
7338 if {$ybot < $wtop} {
7339 set newtop [expr {$y - $wh / 2.0}]
7340 } else {
7341 set newtop $ytop
7342 if {$newtop > $wtop - $linespc} {
7343 set newtop [expr {$wtop - $linespc}]
7344 }
17386066 7345 }
5842215e
PM
7346 } elseif {$ybot > $wbot} {
7347 if {$ytop > $wbot} {
7348 set newtop [expr {$y - $wh / 2.0}]
7349 } else {
7350 set newtop [expr {$ybot - $wh}]
7351 if {$newtop < $wtop + $linespc} {
7352 set newtop [expr {$wtop + $linespc}]
7353 }
17386066 7354 }
5842215e
PM
7355 }
7356 if {$newtop != $wtop} {
7357 if {$newtop < 0} {
7358 set newtop 0
7359 }
2ed49d54 7360 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
9f1afe05 7361 drawvisible
5ad588de 7362 }
d698206c 7363
28593d3f 7364 make_secsel $id
9f1afe05 7365
fa4da7b3 7366 if {$isnew} {
354af6bd 7367 addtohistory [list selbyid $id 0] savecmitpos
d698206c
PM
7368 }
7369
98f350e5
PM
7370 $sha1entry delete 0 end
7371 $sha1entry insert 0 $id
95293b58 7372 if {$autoselect} {
21ac8a8d 7373 $sha1entry selection range 0 $autosellen
95293b58 7374 }
164ff275 7375 rhighlight_sel $id
98f350e5 7376
5ad588de 7377 $ctext conf -state normal
3ea06f9f 7378 clear_ctext
106288cb 7379 set linknum 0
d76afb15
PM
7380 if {![info exists commitinfo($id)]} {
7381 getcommit $id
7382 }
1db95b00 7383 set info $commitinfo($id)
232475d3 7384 set date [formatdate [lindex $info 2]]
d990cedf 7385 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
232475d3 7386 set date [formatdate [lindex $info 4]]
d990cedf 7387 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
887fe3c4 7388 if {[info exists idtags($id)]} {
d990cedf 7389 $ctext insert end [mc "Tags:"]
887fe3c4
PM
7390 foreach tag $idtags($id) {
7391 $ctext insert end " $tag"
7392 }
7393 $ctext insert end "\n"
7394 }
40b87ff8 7395
f1b86294 7396 set headers {}
7fcc92bf 7397 set olds $parents($curview,$id)
79b2c75e 7398 if {[llength $olds] > 1} {
b77b0278 7399 set np 0
79b2c75e 7400 foreach p $olds {
b77b0278
PM
7401 if {$np >= $mergemax} {
7402 set tag mmax
7403 } else {
7404 set tag m$np
7405 }
d990cedf 7406 $ctext insert end "[mc "Parent"]: " $tag
f1b86294 7407 appendwithlinks [commit_descriptor $p] {}
b77b0278
PM
7408 incr np
7409 }
7410 } else {
79b2c75e 7411 foreach p $olds {
d990cedf 7412 append headers "[mc "Parent"]: [commit_descriptor $p]"
b1ba39e7
LT
7413 }
7414 }
b77b0278 7415
6a90bff1 7416 foreach c $children($curview,$id) {
d990cedf 7417 append headers "[mc "Child"]: [commit_descriptor $c]"
8b192809 7418 }
d698206c
PM
7419
7420 # make anything that looks like a SHA1 ID be a clickable link
f1b86294 7421 appendwithlinks $headers {}
b8ab2e17
PM
7422 if {$showneartags} {
7423 if {![info exists allcommits]} {
7424 getallcommits
7425 }
d990cedf 7426 $ctext insert end "[mc "Branch"]: "
ef030b85
PM
7427 $ctext mark set branch "end -1c"
7428 $ctext mark gravity branch left
d990cedf 7429 $ctext insert end "\n[mc "Follows"]: "
b8ab2e17
PM
7430 $ctext mark set follows "end -1c"
7431 $ctext mark gravity follows left
d990cedf 7432 $ctext insert end "\n[mc "Precedes"]: "
b8ab2e17
PM
7433 $ctext mark set precedes "end -1c"
7434 $ctext mark gravity precedes left
b8ab2e17 7435 $ctext insert end "\n"
e11f1233 7436 dispneartags 1
b8ab2e17
PM
7437 }
7438 $ctext insert end "\n"
43c25074
PM
7439 set comment [lindex $info 5]
7440 if {[string first "\r" $comment] >= 0} {
7441 set comment [string map {"\r" "\n "} $comment]
7442 }
7443 appendwithlinks $comment {comment}
d698206c 7444
df3d83b1 7445 $ctext tag remove found 1.0 end
5ad588de 7446 $ctext conf -state disabled
df3d83b1 7447 set commentend [$ctext index "end - 1c"]
5ad588de 7448
8a897742 7449 set jump_to_here $desired_loc
b007ee20 7450 init_flist [mc "Comments"]
f8b28a40
PM
7451 if {$cmitmode eq "tree"} {
7452 gettree $id
9403bd02
TR
7453 } elseif {$vinlinediff($curview) == 1} {
7454 showinlinediff $id
f8b28a40 7455 } elseif {[llength $olds] <= 1} {
d327244a 7456 startdiff $id
7b5ff7e7 7457 } else {
7fcc92bf 7458 mergediff $id
3c461ffe
PM
7459 }
7460}
7461
6e5f7203
RN
7462proc selfirstline {} {
7463 unmarkmatches
7464 selectline 0 1
7465}
7466
7467proc sellastline {} {
7468 global numcommits
7469 unmarkmatches
7470 set l [expr {$numcommits - 1}]
7471 selectline $l 1
7472}
7473
3c461ffe
PM
7474proc selnextline {dir} {
7475 global selectedline
bd441de4 7476 focus .
94b4a69f 7477 if {$selectedline eq {}} return
2ed49d54 7478 set l [expr {$selectedline + $dir}]
3c461ffe 7479 unmarkmatches
d698206c
PM
7480 selectline $l 1
7481}
7482
6e5f7203
RN
7483proc selnextpage {dir} {
7484 global canv linespc selectedline numcommits
7485
7486 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7487 if {$lpp < 1} {
7488 set lpp 1
7489 }
7490 allcanvs yview scroll [expr {$dir * $lpp}] units
e72ee5eb 7491 drawvisible
94b4a69f 7492 if {$selectedline eq {}} return
6e5f7203
RN
7493 set l [expr {$selectedline + $dir * $lpp}]
7494 if {$l < 0} {
7495 set l 0
7496 } elseif {$l >= $numcommits} {
7497 set l [expr $numcommits - 1]
7498 }
7499 unmarkmatches
40b87ff8 7500 selectline $l 1
6e5f7203
RN
7501}
7502
fa4da7b3 7503proc unselectline {} {
50b44ece 7504 global selectedline currentid
fa4da7b3 7505
94b4a69f 7506 set selectedline {}
009409fe 7507 unset -nocomplain currentid
fa4da7b3 7508 allcanvs delete secsel
164ff275 7509 rhighlight_none
fa4da7b3
PM
7510}
7511
f8b28a40
PM
7512proc reselectline {} {
7513 global selectedline
7514
94b4a69f 7515 if {$selectedline ne {}} {
f8b28a40
PM
7516 selectline $selectedline 0
7517 }
7518}
7519
354af6bd 7520proc addtohistory {cmd {saveproc {}}} {
2516dae2 7521 global history historyindex curview
fa4da7b3 7522
354af6bd
PM
7523 unset_posvars
7524 save_position
7525 set elt [list $curview $cmd $saveproc {}]
fa4da7b3 7526 if {$historyindex > 0
2516dae2 7527 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
fa4da7b3
PM
7528 return
7529 }
7530
7531 if {$historyindex < [llength $history]} {
2516dae2 7532 set history [lreplace $history $historyindex end $elt]
fa4da7b3 7533 } else {
2516dae2 7534 lappend history $elt
fa4da7b3
PM
7535 }
7536 incr historyindex
7537 if {$historyindex > 1} {
e9937d2a 7538 .tf.bar.leftbut conf -state normal
fa4da7b3 7539 } else {
e9937d2a 7540 .tf.bar.leftbut conf -state disabled
fa4da7b3 7541 }
e9937d2a 7542 .tf.bar.rightbut conf -state disabled
fa4da7b3
PM
7543}
7544
354af6bd
PM
7545# save the scrolling position of the diff display pane
7546proc save_position {} {
7547 global historyindex history
7548
7549 if {$historyindex < 1} return
7550 set hi [expr {$historyindex - 1}]
7551 set fn [lindex $history $hi 2]
7552 if {$fn ne {}} {
7553 lset history $hi 3 [eval $fn]
7554 }
7555}
7556
7557proc unset_posvars {} {
7558 global last_posvars
7559
7560 if {[info exists last_posvars]} {
7561 foreach {var val} $last_posvars {
7562 global $var
009409fe 7563 unset -nocomplain $var
354af6bd
PM
7564 }
7565 unset last_posvars
7566 }
7567}
7568
2516dae2 7569proc godo {elt} {
354af6bd 7570 global curview last_posvars
2516dae2
PM
7571
7572 set view [lindex $elt 0]
7573 set cmd [lindex $elt 1]
354af6bd 7574 set pv [lindex $elt 3]
2516dae2
PM
7575 if {$curview != $view} {
7576 showview $view
7577 }
354af6bd
PM
7578 unset_posvars
7579 foreach {var val} $pv {
7580 global $var
7581 set $var $val
7582 }
7583 set last_posvars $pv
2516dae2
PM
7584 eval $cmd
7585}
7586
d698206c
PM
7587proc goback {} {
7588 global history historyindex
bd441de4 7589 focus .
d698206c
PM
7590
7591 if {$historyindex > 1} {
354af6bd 7592 save_position
d698206c 7593 incr historyindex -1
2516dae2 7594 godo [lindex $history [expr {$historyindex - 1}]]
e9937d2a 7595 .tf.bar.rightbut conf -state normal
d698206c
PM
7596 }
7597 if {$historyindex <= 1} {
e9937d2a 7598 .tf.bar.leftbut conf -state disabled
d698206c
PM
7599 }
7600}
7601
7602proc goforw {} {
7603 global history historyindex
bd441de4 7604 focus .
d698206c
PM
7605
7606 if {$historyindex < [llength $history]} {
354af6bd 7607 save_position
fa4da7b3 7608 set cmd [lindex $history $historyindex]
d698206c 7609 incr historyindex
2516dae2 7610 godo $cmd
e9937d2a 7611 .tf.bar.leftbut conf -state normal
d698206c
PM
7612 }
7613 if {$historyindex >= [llength $history]} {
e9937d2a 7614 .tf.bar.rightbut conf -state disabled
d698206c 7615 }
e2ed4324
PM
7616}
7617
d4ec30b2
MK
7618proc go_to_parent {i} {
7619 global parents curview targetid
7620 set ps $parents($curview,$targetid)
7621 if {[llength $ps] >= $i} {
7622 selbyid [lindex $ps [expr $i - 1]]
7623 }
7624}
7625
f8b28a40 7626proc gettree {id} {
8f489363
PM
7627 global treefilelist treeidlist diffids diffmergeid treepending
7628 global nullid nullid2
f8b28a40
PM
7629
7630 set diffids $id
009409fe 7631 unset -nocomplain diffmergeid
f8b28a40
PM
7632 if {![info exists treefilelist($id)]} {
7633 if {![info exists treepending]} {
8f489363
PM
7634 if {$id eq $nullid} {
7635 set cmd [list | git ls-files]
7636 } elseif {$id eq $nullid2} {
7637 set cmd [list | git ls-files --stage -t]
219ea3a9 7638 } else {
8f489363 7639 set cmd [list | git ls-tree -r $id]
219ea3a9
PM
7640 }
7641 if {[catch {set gtf [open $cmd r]}]} {
f8b28a40
PM
7642 return
7643 }
7644 set treepending $id
7645 set treefilelist($id) {}
7646 set treeidlist($id) {}
09c7029d 7647 fconfigure $gtf -blocking 0 -encoding binary
7eb3cb9c 7648 filerun $gtf [list gettreeline $gtf $id]
f8b28a40
PM
7649 }
7650 } else {
7651 setfilelist $id
7652 }
7653}
7654
7655proc gettreeline {gtf id} {
8f489363 7656 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
f8b28a40 7657
7eb3cb9c
PM
7658 set nl 0
7659 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
8f489363
PM
7660 if {$diffids eq $nullid} {
7661 set fname $line
7662 } else {
9396cd38
PM
7663 set i [string first "\t" $line]
7664 if {$i < 0} continue
9396cd38 7665 set fname [string range $line [expr {$i+1}] end]
f31fa2c0
PM
7666 set line [string range $line 0 [expr {$i-1}]]
7667 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7668 set sha1 [lindex $line 2]
219ea3a9 7669 lappend treeidlist($id) $sha1
219ea3a9 7670 }
09c7029d
AG
7671 if {[string index $fname 0] eq "\""} {
7672 set fname [lindex $fname 0]
7673 }
7674 set fname [encoding convertfrom $fname]
7eb3cb9c
PM
7675 lappend treefilelist($id) $fname
7676 }
7677 if {![eof $gtf]} {
7678 return [expr {$nl >= 1000? 2: 1}]
f8b28a40 7679 }
f8b28a40
PM
7680 close $gtf
7681 unset treepending
7682 if {$cmitmode ne "tree"} {
7683 if {![info exists diffmergeid]} {
7684 gettreediffs $diffids
7685 }
7686 } elseif {$id ne $diffids} {
7687 gettree $diffids
7688 } else {
7689 setfilelist $id
7690 }
7eb3cb9c 7691 return 0
f8b28a40
PM
7692}
7693
7694proc showfile {f} {
8f489363 7695 global treefilelist treeidlist diffids nullid nullid2
7cdc3556 7696 global ctext_file_names ctext_file_lines
f8b28a40
PM
7697 global ctext commentend
7698
7699 set i [lsearch -exact $treefilelist($diffids) $f]
7700 if {$i < 0} {
7701 puts "oops, $f not in list for id $diffids"
7702 return
7703 }
8f489363
PM
7704 if {$diffids eq $nullid} {
7705 if {[catch {set bf [open $f r]} err]} {
7706 puts "oops, can't read $f: $err"
219ea3a9
PM
7707 return
7708 }
7709 } else {
8f489363
PM
7710 set blob [lindex $treeidlist($diffids) $i]
7711 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7712 puts "oops, error reading blob $blob: $err"
219ea3a9
PM
7713 return
7714 }
f8b28a40 7715 }
09c7029d 7716 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7eb3cb9c 7717 filerun $bf [list getblobline $bf $diffids]
f8b28a40 7718 $ctext config -state normal
3ea06f9f 7719 clear_ctext $commentend
7cdc3556
AG
7720 lappend ctext_file_names $f
7721 lappend ctext_file_lines [lindex [split $commentend "."] 0]
f8b28a40
PM
7722 $ctext insert end "\n"
7723 $ctext insert end "$f\n" filesep
7724 $ctext config -state disabled
7725 $ctext yview $commentend
32f1b3e4 7726 settabs 0
f8b28a40
PM
7727}
7728
7729proc getblobline {bf id} {
7730 global diffids cmitmode ctext
7731
7732 if {$id ne $diffids || $cmitmode ne "tree"} {
7733 catch {close $bf}
7eb3cb9c 7734 return 0
f8b28a40
PM
7735 }
7736 $ctext config -state normal
7eb3cb9c
PM
7737 set nl 0
7738 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
f8b28a40
PM
7739 $ctext insert end "$line\n"
7740 }
7741 if {[eof $bf]} {
8a897742
PM
7742 global jump_to_here ctext_file_names commentend
7743
f8b28a40
PM
7744 # delete last newline
7745 $ctext delete "end - 2c" "end - 1c"
7746 close $bf
8a897742
PM
7747 if {$jump_to_here ne {} &&
7748 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7749 set lnum [expr {[lindex $jump_to_here 1] +
7750 [lindex [split $commentend .] 0]}]
7751 mark_ctext_line $lnum
7752 }
120ea892 7753 $ctext config -state disabled
7eb3cb9c 7754 return 0
f8b28a40
PM
7755 }
7756 $ctext config -state disabled
7eb3cb9c 7757 return [expr {$nl >= 1000? 2: 1}]
f8b28a40
PM
7758}
7759
8a897742 7760proc mark_ctext_line {lnum} {
e3e901be 7761 global ctext markbgcolor
8a897742
PM
7762
7763 $ctext tag delete omark
7764 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
e3e901be 7765 $ctext tag conf omark -background $markbgcolor
8a897742
PM
7766 $ctext see $lnum.0
7767}
7768
7fcc92bf 7769proc mergediff {id} {
8b07dca1 7770 global diffmergeid
2df6442f 7771 global diffids treediffs
8b07dca1 7772 global parents curview
e2ed4324 7773
3c461ffe 7774 set diffmergeid $id
7a1d9d14 7775 set diffids $id
2df6442f 7776 set treediffs($id) {}
7fcc92bf 7777 set np [llength $parents($curview,$id)]
32f1b3e4 7778 settabs $np
8b07dca1 7779 getblobdiffs $id
c8a4acbf
PM
7780}
7781
3c461ffe 7782proc startdiff {ids} {
8f489363 7783 global treediffs diffids treepending diffmergeid nullid nullid2
c8dfbcf9 7784
32f1b3e4 7785 settabs 1
4f2c2642 7786 set diffids $ids
009409fe 7787 unset -nocomplain diffmergeid
8f489363
PM
7788 if {![info exists treediffs($ids)] ||
7789 [lsearch -exact $ids $nullid] >= 0 ||
7790 [lsearch -exact $ids $nullid2] >= 0} {
c8dfbcf9 7791 if {![info exists treepending]} {
14c9dbd6 7792 gettreediffs $ids
c8dfbcf9
PM
7793 }
7794 } else {
14c9dbd6 7795 addtocflist $ids
c8dfbcf9
PM
7796 }
7797}
7798
9403bd02
TR
7799proc showinlinediff {ids} {
7800 global commitinfo commitdata ctext
7801 global treediffs
7802
7803 set info $commitinfo($ids)
7804 set diff [lindex $info 7]
7805 set difflines [split $diff "\n"]
7806
7807 initblobdiffvars
7808 set treediff {}
7809
7810 set inhdr 0
7811 foreach line $difflines {
7812 if {![string compare -length 5 "diff " $line]} {
7813 set inhdr 1
7814 } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7815 # offset also accounts for the b/ prefix
7816 lappend treediff [string range $line 6 end]
7817 set inhdr 0
7818 }
7819 }
7820
7821 set treediffs($ids) $treediff
7822 add_flist $treediff
7823
7824 $ctext conf -state normal
7825 foreach line $difflines {
7826 parseblobdiffline $ids $line
7827 }
7828 maybe_scroll_ctext 1
7829 $ctext conf -state disabled
7830}
7831
65bb0bda
PT
7832# If the filename (name) is under any of the passed filter paths
7833# then return true to include the file in the listing.
7a39a17a 7834proc path_filter {filter name} {
65bb0bda 7835 set worktree [gitworktree]
7a39a17a 7836 foreach p $filter {
65bb0bda
PT
7837 set fq_p [file normalize $p]
7838 set fq_n [file normalize [file join $worktree $name]]
7839 if {[string match [file normalize $fq_p]* $fq_n]} {
7840 return 1
7a39a17a
PM
7841 }
7842 }
7843 return 0
7844}
7845
c8dfbcf9 7846proc addtocflist {ids} {
74a40c71 7847 global treediffs
7a39a17a 7848
74a40c71 7849 add_flist $treediffs($ids)
c8dfbcf9 7850 getblobdiffs $ids
d2610d11
PM
7851}
7852
219ea3a9 7853proc diffcmd {ids flags} {
17f9836c 7854 global log_showroot nullid nullid2 git_version
219ea3a9
PM
7855
7856 set i [lsearch -exact $ids $nullid]
8f489363 7857 set j [lsearch -exact $ids $nullid2]
219ea3a9 7858 if {$i >= 0} {
8f489363
PM
7859 if {[llength $ids] > 1 && $j < 0} {
7860 # comparing working directory with some specific revision
7861 set cmd [concat | git diff-index $flags]
7862 if {$i == 0} {
7863 lappend cmd -R [lindex $ids 1]
7864 } else {
7865 lappend cmd [lindex $ids 0]
7866 }
7867 } else {
7868 # comparing working directory with index
7869 set cmd [concat | git diff-files $flags]
7870 if {$j == 1} {
7871 lappend cmd -R
7872 }
7873 }
7874 } elseif {$j >= 0} {
17f9836c
JL
7875 if {[package vcompare $git_version "1.7.2"] >= 0} {
7876 set flags "$flags --ignore-submodules=dirty"
7877 }
8f489363 7878 set cmd [concat | git diff-index --cached $flags]
219ea3a9 7879 if {[llength $ids] > 1} {
8f489363 7880 # comparing index with specific revision
90a77925 7881 if {$j == 0} {
219ea3a9
PM
7882 lappend cmd -R [lindex $ids 1]
7883 } else {
7884 lappend cmd [lindex $ids 0]
7885 }
7886 } else {
8f489363 7887 # comparing index with HEAD
219ea3a9
PM
7888 lappend cmd HEAD
7889 }
7890 } else {
b2b76d10
MK
7891 if {$log_showroot} {
7892 lappend flags --root
7893 }
8f489363 7894 set cmd [concat | git diff-tree -r $flags $ids]
219ea3a9
PM
7895 }
7896 return $cmd
7897}
7898
c8dfbcf9 7899proc gettreediffs {ids} {
2c8cd905 7900 global treediff treepending limitdiffs vfilelimit curview
219ea3a9 7901
2c8cd905
FC
7902 set cmd [diffcmd $ids {--no-commit-id}]
7903 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7904 set cmd [concat $cmd -- $vfilelimit($curview)]
7905 }
7906 if {[catch {set gdtf [open $cmd r]}]} return
7272131b 7907
c8dfbcf9 7908 set treepending $ids
3c461ffe 7909 set treediff {}
09c7029d 7910 fconfigure $gdtf -blocking 0 -encoding binary
7eb3cb9c 7911 filerun $gdtf [list gettreediffline $gdtf $ids]
d2610d11
PM
7912}
7913
c8dfbcf9 7914proc gettreediffline {gdtf ids} {
3c461ffe 7915 global treediff treediffs treepending diffids diffmergeid
39ee47ef 7916 global cmitmode vfilelimit curview limitdiffs perfile_attrs
3c461ffe 7917
7eb3cb9c 7918 set nr 0
4db09304 7919 set sublist {}
39ee47ef
PM
7920 set max 1000
7921 if {$perfile_attrs} {
7922 # cache_gitattr is slow, and even slower on win32 where we
7923 # have to invoke it for only about 30 paths at a time
7924 set max 500
7925 if {[tk windowingsystem] == "win32"} {
7926 set max 120
7927 }
7928 }
7929 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
9396cd38
PM
7930 set i [string first "\t" $line]
7931 if {$i >= 0} {
7932 set file [string range $line [expr {$i+1}] end]
7933 if {[string index $file 0] eq "\""} {
7934 set file [lindex $file 0]
7935 }
09c7029d 7936 set file [encoding convertfrom $file]
48a81b7c
PM
7937 if {$file ne [lindex $treediff end]} {
7938 lappend treediff $file
7939 lappend sublist $file
7940 }
9396cd38 7941 }
7eb3cb9c 7942 }
39ee47ef
PM
7943 if {$perfile_attrs} {
7944 cache_gitattr encoding $sublist
7945 }
7eb3cb9c 7946 if {![eof $gdtf]} {
39ee47ef 7947 return [expr {$nr >= $max? 2: 1}]
7eb3cb9c
PM
7948 }
7949 close $gdtf
2c8cd905 7950 set treediffs($ids) $treediff
7eb3cb9c 7951 unset treepending
e1160138 7952 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7eb3cb9c
PM
7953 gettree $diffids
7954 } elseif {$ids != $diffids} {
7955 if {![info exists diffmergeid]} {
7956 gettreediffs $diffids
b74fd579 7957 }
7eb3cb9c
PM
7958 } else {
7959 addtocflist $ids
d2610d11 7960 }
7eb3cb9c 7961 return 0
d2610d11
PM
7962}
7963
890fae70
SP
7964# empty string or positive integer
7965proc diffcontextvalidate {v} {
7966 return [regexp {^(|[1-9][0-9]*)$} $v]
7967}
7968
7969proc diffcontextchange {n1 n2 op} {
7970 global diffcontextstring diffcontext
7971
7972 if {[string is integer -strict $diffcontextstring]} {
a41ddbb6 7973 if {$diffcontextstring >= 0} {
890fae70
SP
7974 set diffcontext $diffcontextstring
7975 reselectline
7976 }
7977 }
7978}
7979
b9b86007
SP
7980proc changeignorespace {} {
7981 reselectline
7982}
7983
ae4e3ff9
TR
7984proc changeworddiff {name ix op} {
7985 reselectline
7986}
7987
5de460a2
TR
7988proc initblobdiffvars {} {
7989 global diffencoding targetline diffnparents
7990 global diffinhdr currdiffsubmod diffseehere
7991 set targetline {}
7992 set diffnparents 0
7993 set diffinhdr 0
7994 set diffencoding [get_path_encoding {}]
7995 set currdiffsubmod ""
7996 set diffseehere -1
7997}
7998
c8dfbcf9 7999proc getblobdiffs {ids} {
8d73b242 8000 global blobdifffd diffids env
5de460a2 8001 global treediffs
890fae70 8002 global diffcontext
b9b86007 8003 global ignorespace
ae4e3ff9 8004 global worddiff
3ed31a81 8005 global limitdiffs vfilelimit curview
5de460a2 8006 global git_version
c8dfbcf9 8007
a8138733
PM
8008 set textconv {}
8009 if {[package vcompare $git_version "1.6.1"] >= 0} {
8010 set textconv "--textconv"
8011 }
5c838d23
JL
8012 set submodule {}
8013 if {[package vcompare $git_version "1.6.6"] >= 0} {
8014 set submodule "--submodule"
8015 }
8016 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
b9b86007
SP
8017 if {$ignorespace} {
8018 append cmd " -w"
8019 }
ae4e3ff9
TR
8020 if {$worddiff ne [mc "Line diff"]} {
8021 append cmd " --word-diff=porcelain"
8022 }
3ed31a81
PM
8023 if {$limitdiffs && $vfilelimit($curview) ne {}} {
8024 set cmd [concat $cmd -- $vfilelimit($curview)]
7a39a17a
PM
8025 }
8026 if {[catch {set bdf [open $cmd r]} err]} {
8b07dca1 8027 error_popup [mc "Error getting diffs: %s" $err]
e5c2d856
PM
8028 return
8029 }
681c3290 8030 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
c8dfbcf9 8031 set blobdifffd($ids) $bdf
5de460a2 8032 initblobdiffvars
7eb3cb9c 8033 filerun $bdf [list getblobdiffline $bdf $diffids]
e5c2d856
PM
8034}
8035
354af6bd
PM
8036proc savecmitpos {} {
8037 global ctext cmitmode
8038
8039 if {$cmitmode eq "tree"} {
8040 return {}
8041 }
8042 return [list target_scrollpos [$ctext index @0,0]]
8043}
8044
8045proc savectextpos {} {
8046 global ctext
8047
8048 return [list target_scrollpos [$ctext index @0,0]]
8049}
8050
8051proc maybe_scroll_ctext {ateof} {
8052 global ctext target_scrollpos
8053
8054 if {![info exists target_scrollpos]} return
8055 if {!$ateof} {
8056 set nlines [expr {[winfo height $ctext]
8057 / [font metrics textfont -linespace]}]
8058 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8059 }
8060 $ctext yview $target_scrollpos
8061 unset target_scrollpos
8062}
8063
89b11d3b
PM
8064proc setinlist {var i val} {
8065 global $var
8066
8067 while {[llength [set $var]] < $i} {
8068 lappend $var {}
8069 }
8070 if {[llength [set $var]] == $i} {
8071 lappend $var $val
8072 } else {
8073 lset $var $i $val
8074 }
8075}
8076
9396cd38 8077proc makediffhdr {fname ids} {
8b07dca1 8078 global ctext curdiffstart treediffs diffencoding
8a897742 8079 global ctext_file_names jump_to_here targetline diffline
9396cd38 8080
8b07dca1
PM
8081 set fname [encoding convertfrom $fname]
8082 set diffencoding [get_path_encoding $fname]
9396cd38
PM
8083 set i [lsearch -exact $treediffs($ids) $fname]
8084 if {$i >= 0} {
8085 setinlist difffilestart $i $curdiffstart
8086 }
48a81b7c 8087 lset ctext_file_names end $fname
9396cd38
PM
8088 set l [expr {(78 - [string length $fname]) / 2}]
8089 set pad [string range "----------------------------------------" 1 $l]
8090 $ctext insert $curdiffstart "$pad $fname $pad" filesep
8a897742
PM
8091 set targetline {}
8092 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8093 set targetline [lindex $jump_to_here 1]
8094 }
8095 set diffline 0
9396cd38
PM
8096}
8097
5de460a2
TR
8098proc blobdiffmaybeseehere {ateof} {
8099 global diffseehere
8100 if {$diffseehere >= 0} {
8101 mark_ctext_line [lindex [split $diffseehere .] 0]
8102 }
1f3c8726 8103 maybe_scroll_ctext $ateof
5de460a2
TR
8104}
8105
c8dfbcf9 8106proc getblobdiffline {bdf ids} {
5de460a2
TR
8107 global diffids blobdifffd
8108 global ctext
c8dfbcf9 8109
7eb3cb9c 8110 set nr 0
e5c2d856 8111 $ctext conf -state normal
7eb3cb9c
PM
8112 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8113 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
0748f41e 8114 # Older diff read. Abort it.
c21398be 8115 catch {close $bdf}
0748f41e
MH
8116 if {$ids != $diffids} {
8117 array unset blobdifffd $ids
8118 }
7eb3cb9c 8119 return 0
89b11d3b 8120 }
5de460a2
TR
8121 parseblobdiffline $ids $line
8122 }
8123 $ctext conf -state disabled
8124 blobdiffmaybeseehere [eof $bdf]
8125 if {[eof $bdf]} {
8126 catch {close $bdf}
0748f41e 8127 array unset blobdifffd $ids
5de460a2
TR
8128 return 0
8129 }
8130 return [expr {$nr >= 1000? 2: 1}]
8131}
8132
8133proc parseblobdiffline {ids line} {
8134 global ctext curdiffstart
8135 global diffnexthead diffnextnote difffilestart
8136 global ctext_file_names ctext_file_lines
8137 global diffinhdr treediffs mergemax diffnparents
8138 global diffencoding jump_to_here targetline diffline currdiffsubmod
8139 global worddiff diffseehere
8140
8141 if {![string compare -length 5 "diff " $line]} {
8142 if {![regexp {^diff (--cc|--git) } $line m type]} {
8143 set line [encoding convertfrom $line]
8144 $ctext insert end "$line\n" hunksep
8145 continue
8146 }
8147 # start of a new file
8148 set diffinhdr 1
8149 $ctext insert end "\n"
8150 set curdiffstart [$ctext index "end - 1c"]
8151 lappend ctext_file_names ""
8152 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8153 $ctext insert end "\n" filesep
8154
8155 if {$type eq "--cc"} {
8156 # start of a new file in a merge diff
8157 set fname [string range $line 10 end]
8158 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8159 lappend treediffs($ids) $fname
8160 add_flist [list $fname]
8b07dca1 8161 }
8b07dca1 8162
5de460a2
TR
8163 } else {
8164 set line [string range $line 11 end]
8165 # If the name hasn't changed the length will be odd,
8166 # the middle char will be a space, and the two bits either
8167 # side will be a/name and b/name, or "a/name" and "b/name".
8168 # If the name has changed we'll get "rename from" and
8169 # "rename to" or "copy from" and "copy to" lines following
8170 # this, and we'll use them to get the filenames.
8171 # This complexity is necessary because spaces in the
8172 # filename(s) don't get escaped.
8173 set l [string length $line]
8174 set i [expr {$l / 2}]
8175 if {!(($l & 1) && [string index $line $i] eq " " &&
8176 [string range $line 2 [expr {$i - 1}]] eq \
8177 [string range $line [expr {$i + 3}] end])} {
8178 return
8179 }
8180 # unescape if quoted and chop off the a/ from the front
8181 if {[string index $line 0] eq "\""} {
8182 set fname [string range [lindex $line 0] 2 end]
9396cd38 8183 } else {
5de460a2 8184 set fname [string range $line 2 [expr {$i - 1}]]
7eb3cb9c 8185 }
5de460a2
TR
8186 }
8187 makediffhdr $fname $ids
8188
8189 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8190 set fname [encoding convertfrom [string range $line 16 end]]
8191 $ctext insert end "\n"
8192 set curdiffstart [$ctext index "end - 1c"]
8193 lappend ctext_file_names $fname
8194 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8195 $ctext insert end "$line\n" filesep
8196 set i [lsearch -exact $treediffs($ids) $fname]
8197 if {$i >= 0} {
8198 setinlist difffilestart $i $curdiffstart
8199 }
8200
8201 } elseif {![string compare -length 2 "@@" $line]} {
8202 regexp {^@@+} $line ats
8203 set line [encoding convertfrom $diffencoding $line]
8204 $ctext insert end "$line\n" hunksep
8205 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8206 set diffline $nl
8207 }
8208 set diffnparents [expr {[string length $ats] - 1}]
8209 set diffinhdr 0
9396cd38 8210
5de460a2
TR
8211 } elseif {![string compare -length 10 "Submodule " $line]} {
8212 # start of a new submodule
8213 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8214 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8215 } else {
8216 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8217 }
8218 if {$currdiffsubmod != $fname} {
8219 $ctext insert end "\n"; # Add newline after commit message
8220 }
8221 set curdiffstart [$ctext index "end - 1c"]
8222 lappend ctext_file_names ""
8223 if {$currdiffsubmod != $fname} {
8224 lappend ctext_file_lines $fname
8225 makediffhdr $fname $ids
8226 set currdiffsubmod $fname
8227 $ctext insert end "\n$line\n" filesep
8228 } else {
48a81b7c 8229 $ctext insert end "$line\n" filesep
5de460a2 8230 }
9ea831a2 8231 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} {
5de460a2
TR
8232 set $currdiffsubmod ""
8233 set line [encoding convertfrom $diffencoding $line]
8234 $ctext insert end "$line\n" dresult
9ea831a2 8235 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} {
5de460a2
TR
8236 set $currdiffsubmod ""
8237 set line [encoding convertfrom $diffencoding $line]
8238 $ctext insert end "$line\n" d0
8239 } elseif {$diffinhdr} {
8240 if {![string compare -length 12 "rename from " $line]} {
8241 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8242 if {[string index $fname 0] eq "\""} {
8243 set fname [lindex $fname 0]
8244 }
8245 set fname [encoding convertfrom $fname]
48a81b7c
PM
8246 set i [lsearch -exact $treediffs($ids) $fname]
8247 if {$i >= 0} {
8248 setinlist difffilestart $i $curdiffstart
8249 }
5de460a2
TR
8250 } elseif {![string compare -length 10 $line "rename to "] ||
8251 ![string compare -length 8 $line "copy to "]} {
8252 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8253 if {[string index $fname 0] eq "\""} {
8254 set fname [lindex $fname 0]
8b07dca1 8255 }
5de460a2
TR
8256 makediffhdr $fname $ids
8257 } elseif {[string compare -length 3 $line "---"] == 0} {
8258 # do nothing
8259 return
8260 } elseif {[string compare -length 3 $line "+++"] == 0} {
7eb3cb9c 8261 set diffinhdr 0
5de460a2
TR
8262 return
8263 }
8264 $ctext insert end "$line\n" filesep
9396cd38 8265
5de460a2
TR
8266 } else {
8267 set line [string map {\x1A ^Z} \
8268 [encoding convertfrom $diffencoding $line]]
8269 # parse the prefix - one ' ', '-' or '+' for each parent
8270 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8271 set tag [expr {$diffnparents > 1? "m": "d"}]
8272 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8273 set words_pre_markup ""
8274 set words_post_markup ""
8275 if {[string trim $prefix " -+"] eq {}} {
8276 # prefix only has " ", "-" and "+" in it: normal diff line
8277 set num [string first "-" $prefix]
8278 if {$dowords} {
8279 set line [string range $line 1 end]
8280 }
8281 if {$num >= 0} {
8282 # removed line, first parent with line is $num
8283 if {$num >= $mergemax} {
8284 set num "max"
9396cd38 8285 }
5de460a2
TR
8286 if {$dowords && $worddiff eq [mc "Markup words"]} {
8287 $ctext insert end "\[-$line-\]" $tag$num
8288 } else {
8289 $ctext insert end "$line" $tag$num
9396cd38 8290 }
5de460a2
TR
8291 if {!$dowords} {
8292 $ctext insert end "\n" $tag$num
ae4e3ff9 8293 }
5de460a2
TR
8294 } else {
8295 set tags {}
8296 if {[string first "+" $prefix] >= 0} {
8297 # added line
8298 lappend tags ${tag}result
8299 if {$diffnparents > 1} {
8300 set num [string first " " $prefix]
8301 if {$num >= 0} {
8302 if {$num >= $mergemax} {
8303 set num "max"
8b07dca1 8304 }
5de460a2 8305 lappend tags m$num
8b07dca1
PM
8306 }
8307 }
5de460a2
TR
8308 set words_pre_markup "{+"
8309 set words_post_markup "+}"
8310 }
8311 if {$targetline ne {}} {
8312 if {$diffline == $targetline} {
8313 set diffseehere [$ctext index "end - 1 chars"]
8314 set targetline {}
ae4e3ff9 8315 } else {
5de460a2 8316 incr diffline
ae4e3ff9 8317 }
8b07dca1 8318 }
5de460a2
TR
8319 if {$dowords && $worddiff eq [mc "Markup words"]} {
8320 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8321 } else {
8322 $ctext insert end "$line" $tags
8323 }
8324 if {!$dowords} {
8325 $ctext insert end "\n" $tags
8326 }
e5c2d856 8327 }
5de460a2
TR
8328 } elseif {$dowords && $prefix eq "~"} {
8329 $ctext insert end "\n" {}
8330 } else {
8331 # "\ No newline at end of file",
8332 # or something else we don't recognize
8333 $ctext insert end "$line\n" hunksep
e5c2d856
PM
8334 }
8335 }
e5c2d856
PM
8336}
8337
a8d610a2
PM
8338proc changediffdisp {} {
8339 global ctext diffelide
8340
8341 $ctext tag conf d0 -elide [lindex $diffelide 0]
8b07dca1 8342 $ctext tag conf dresult -elide [lindex $diffelide 1]
a8d610a2
PM
8343}
8344
b967135d
SH
8345proc highlightfile {cline} {
8346 global cflist cflist_top
f4c54b3c 8347
ce837c9d
SH
8348 if {![info exists cflist_top]} return
8349
f4c54b3c
PM
8350 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8351 $cflist tag add highlight $cline.0 "$cline.0 lineend"
8352 $cflist see $cline.0
8353 set cflist_top $cline
8354}
8355
b967135d 8356proc highlightfile_for_scrollpos {topidx} {
978904bf 8357 global cmitmode difffilestart
b967135d 8358
978904bf 8359 if {$cmitmode eq "tree"} return
b967135d
SH
8360 if {![info exists difffilestart]} return
8361
8362 set top [lindex [split $topidx .] 0]
8363 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8364 highlightfile 0
8365 } else {
8366 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8367 }
8368}
8369
67c22874 8370proc prevfile {} {
f4c54b3c
PM
8371 global difffilestart ctext cmitmode
8372
8373 if {$cmitmode eq "tree"} return
8374 set prev 0.0
67c22874
OH
8375 set here [$ctext index @0,0]
8376 foreach loc $difffilestart {
8377 if {[$ctext compare $loc >= $here]} {
b967135d 8378 $ctext yview $prev
67c22874
OH
8379 return
8380 }
8381 set prev $loc
8382 }
b967135d 8383 $ctext yview $prev
67c22874
OH
8384}
8385
39ad8570 8386proc nextfile {} {
f4c54b3c
PM
8387 global difffilestart ctext cmitmode
8388
8389 if {$cmitmode eq "tree"} return
39ad8570 8390 set here [$ctext index @0,0]
7fcceed7
PM
8391 foreach loc $difffilestart {
8392 if {[$ctext compare $loc > $here]} {
b967135d 8393 $ctext yview $loc
67c22874 8394 return
39ad8570
PM
8395 }
8396 }
1db95b00
PM
8397}
8398
3ea06f9f
PM
8399proc clear_ctext {{first 1.0}} {
8400 global ctext smarktop smarkbot
7cdc3556 8401 global ctext_file_names ctext_file_lines
97645683 8402 global pendinglinks
3ea06f9f 8403
1902c270
PM
8404 set l [lindex [split $first .] 0]
8405 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8406 set smarktop $l
3ea06f9f 8407 }
1902c270
PM
8408 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8409 set smarkbot $l
3ea06f9f
PM
8410 }
8411 $ctext delete $first end
97645683 8412 if {$first eq "1.0"} {
009409fe 8413 unset -nocomplain pendinglinks
97645683 8414 }
7cdc3556
AG
8415 set ctext_file_names {}
8416 set ctext_file_lines {}
3ea06f9f
PM
8417}
8418
32f1b3e4 8419proc settabs {{firstab {}}} {
9c311b32 8420 global firsttabstop tabstop ctext have_tk85
32f1b3e4
PM
8421
8422 if {$firstab ne {} && $have_tk85} {
8423 set firsttabstop $firstab
8424 }
9c311b32 8425 set w [font measure textfont "0"]
32f1b3e4 8426 if {$firsttabstop != 0} {
64b5f146
PM
8427 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8428 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
32f1b3e4
PM
8429 } elseif {$have_tk85 || $tabstop != 8} {
8430 $ctext conf -tabs [expr {$tabstop * $w}]
8431 } else {
8432 $ctext conf -tabs {}
8433 }
3ea06f9f
PM
8434}
8435
8436proc incrsearch {name ix op} {
1902c270 8437 global ctext searchstring searchdirn
3ea06f9f 8438
1902c270
PM
8439 if {[catch {$ctext index anchor}]} {
8440 # no anchor set, use start of selection, or of visible area
8441 set sel [$ctext tag ranges sel]
8442 if {$sel ne {}} {
8443 $ctext mark set anchor [lindex $sel 0]
8444 } elseif {$searchdirn eq "-forwards"} {
8445 $ctext mark set anchor @0,0
8446 } else {
8447 $ctext mark set anchor @0,[winfo height $ctext]
8448 }
8449 }
3ea06f9f 8450 if {$searchstring ne {}} {
30441a6f 8451 set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
1902c270
PM
8452 if {$here ne {}} {
8453 $ctext see $here
30441a6f
SH
8454 set mend "$here + $mlen c"
8455 $ctext tag remove sel 1.0 end
8456 $ctext tag add sel $here $mend
b967135d
SH
8457 suppress_highlighting_file_for_current_scrollpos
8458 highlightfile_for_scrollpos $here
1902c270 8459 }
3ea06f9f 8460 }
c4614994 8461 rehighlight_search_results
3ea06f9f
PM
8462}
8463
8464proc dosearch {} {
1902c270 8465 global sstring ctext searchstring searchdirn
3ea06f9f
PM
8466
8467 focus $sstring
8468 $sstring icursor end
1902c270
PM
8469 set searchdirn -forwards
8470 if {$searchstring ne {}} {
8471 set sel [$ctext tag ranges sel]
8472 if {$sel ne {}} {
8473 set start "[lindex $sel 0] + 1c"
8474 } elseif {[catch {set start [$ctext index anchor]}]} {
8475 set start "@0,0"
8476 }
8477 set match [$ctext search -count mlen -- $searchstring $start]
8478 $ctext tag remove sel 1.0 end
8479 if {$match eq {}} {
8480 bell
8481 return
8482 }
8483 $ctext see $match
b967135d
SH
8484 suppress_highlighting_file_for_current_scrollpos
8485 highlightfile_for_scrollpos $match
1902c270
PM
8486 set mend "$match + $mlen c"
8487 $ctext tag add sel $match $mend
8488 $ctext mark unset anchor
c4614994 8489 rehighlight_search_results
1902c270
PM
8490 }
8491}
8492
8493proc dosearchback {} {
8494 global sstring ctext searchstring searchdirn
8495
8496 focus $sstring
8497 $sstring icursor end
8498 set searchdirn -backwards
8499 if {$searchstring ne {}} {
8500 set sel [$ctext tag ranges sel]
8501 if {$sel ne {}} {
8502 set start [lindex $sel 0]
8503 } elseif {[catch {set start [$ctext index anchor]}]} {
8504 set start @0,[winfo height $ctext]
8505 }
8506 set match [$ctext search -backwards -count ml -- $searchstring $start]
8507 $ctext tag remove sel 1.0 end
8508 if {$match eq {}} {
8509 bell
8510 return
8511 }
8512 $ctext see $match
b967135d
SH
8513 suppress_highlighting_file_for_current_scrollpos
8514 highlightfile_for_scrollpos $match
1902c270
PM
8515 set mend "$match + $ml c"
8516 $ctext tag add sel $match $mend
8517 $ctext mark unset anchor
c4614994
SH
8518 rehighlight_search_results
8519 }
8520}
8521
8522proc rehighlight_search_results {} {
8523 global ctext searchstring
8524
8525 $ctext tag remove found 1.0 end
8526 $ctext tag remove currentsearchhit 1.0 end
8527
8528 if {$searchstring ne {}} {
8529 searchmarkvisible 1
3ea06f9f 8530 }
3ea06f9f
PM
8531}
8532
8533proc searchmark {first last} {
8534 global ctext searchstring
8535
c4614994
SH
8536 set sel [$ctext tag ranges sel]
8537
3ea06f9f
PM
8538 set mend $first.0
8539 while {1} {
8540 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8541 if {$match eq {}} break
8542 set mend "$match + $mlen c"
c4614994
SH
8543 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8544 $ctext tag add currentsearchhit $match $mend
8545 } else {
8546 $ctext tag add found $match $mend
8547 }
3ea06f9f
PM
8548 }
8549}
8550
8551proc searchmarkvisible {doall} {
8552 global ctext smarktop smarkbot
8553
8554 set topline [lindex [split [$ctext index @0,0] .] 0]
8555 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8556 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8557 # no overlap with previous
8558 searchmark $topline $botline
8559 set smarktop $topline
8560 set smarkbot $botline
8561 } else {
8562 if {$topline < $smarktop} {
8563 searchmark $topline [expr {$smarktop-1}]
8564 set smarktop $topline
8565 }
8566 if {$botline > $smarkbot} {
8567 searchmark [expr {$smarkbot+1}] $botline
8568 set smarkbot $botline
8569 }
8570 }
8571}
8572
b967135d
SH
8573proc suppress_highlighting_file_for_current_scrollpos {} {
8574 global ctext suppress_highlighting_file_for_this_scrollpos
8575
8576 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8577}
8578
3ea06f9f 8579proc scrolltext {f0 f1} {
b967135d
SH
8580 global searchstring cmitmode ctext
8581 global suppress_highlighting_file_for_this_scrollpos
8582
978904bf
SH
8583 set topidx [$ctext index @0,0]
8584 if {![info exists suppress_highlighting_file_for_this_scrollpos]
8585 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8586 highlightfile_for_scrollpos $topidx
b967135d
SH
8587 }
8588
009409fe 8589 unset -nocomplain suppress_highlighting_file_for_this_scrollpos
3ea06f9f 8590
8809d691 8591 .bleft.bottom.sb set $f0 $f1
3ea06f9f
PM
8592 if {$searchstring ne {}} {
8593 searchmarkvisible 0
8594 }
8595}
8596
1d10f36d 8597proc setcoords {} {
9c311b32 8598 global linespc charspc canvx0 canvy0
f6075eba 8599 global xspc1 xspc2 lthickness
8d858d1a 8600
9c311b32
PM
8601 set linespc [font metrics mainfont -linespace]
8602 set charspc [font measure mainfont "m"]
9f1afe05
PM
8603 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8604 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
f6075eba 8605 set lthickness [expr {int($linespc / 9) + 1}]
8d858d1a
PM
8606 set xspc1(0) $linespc
8607 set xspc2 $linespc
9a40c50c 8608}
1db95b00 8609
1d10f36d 8610proc redisplay {} {
be0cd098 8611 global canv
9f1afe05
PM
8612 global selectedline
8613
8614 set ymax [lindex [$canv cget -scrollregion] 3]
8615 if {$ymax eq {} || $ymax == 0} return
8616 set span [$canv yview]
8617 clear_display
be0cd098 8618 setcanvscroll
9f1afe05
PM
8619 allcanvs yview moveto [lindex $span 0]
8620 drawvisible
94b4a69f 8621 if {$selectedline ne {}} {
9f1afe05 8622 selectline $selectedline 0
ca6d8f58 8623 allcanvs yview moveto [lindex $span 0]
1d10f36d
PM
8624 }
8625}
8626
0ed1dd3c
PM
8627proc parsefont {f n} {
8628 global fontattr
8629
8630 set fontattr($f,family) [lindex $n 0]
8631 set s [lindex $n 1]
8632 if {$s eq {} || $s == 0} {
8633 set s 10
8634 } elseif {$s < 0} {
8635 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
9c311b32 8636 }
0ed1dd3c
PM
8637 set fontattr($f,size) $s
8638 set fontattr($f,weight) normal
8639 set fontattr($f,slant) roman
8640 foreach style [lrange $n 2 end] {
8641 switch -- $style {
8642 "normal" -
8643 "bold" {set fontattr($f,weight) $style}
8644 "roman" -
8645 "italic" {set fontattr($f,slant) $style}
8646 }
9c311b32 8647 }
0ed1dd3c
PM
8648}
8649
8650proc fontflags {f {isbold 0}} {
8651 global fontattr
8652
8653 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8654 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8655 -slant $fontattr($f,slant)]
8656}
8657
8658proc fontname {f} {
8659 global fontattr
8660
8661 set n [list $fontattr($f,family) $fontattr($f,size)]
8662 if {$fontattr($f,weight) eq "bold"} {
8663 lappend n "bold"
9c311b32 8664 }
0ed1dd3c
PM
8665 if {$fontattr($f,slant) eq "italic"} {
8666 lappend n "italic"
9c311b32 8667 }
0ed1dd3c 8668 return $n
9c311b32
PM
8669}
8670
1d10f36d 8671proc incrfont {inc} {
7fcc92bf 8672 global mainfont textfont ctext canv cflist showrefstop
0ed1dd3c
PM
8673 global stopped entries fontattr
8674
1d10f36d 8675 unmarkmatches
0ed1dd3c 8676 set s $fontattr(mainfont,size)
9c311b32
PM
8677 incr s $inc
8678 if {$s < 1} {
8679 set s 1
8680 }
0ed1dd3c 8681 set fontattr(mainfont,size) $s
9c311b32
PM
8682 font config mainfont -size $s
8683 font config mainfontbold -size $s
0ed1dd3c
PM
8684 set mainfont [fontname mainfont]
8685 set s $fontattr(textfont,size)
9c311b32
PM
8686 incr s $inc
8687 if {$s < 1} {
8688 set s 1
8689 }
0ed1dd3c 8690 set fontattr(textfont,size) $s
9c311b32
PM
8691 font config textfont -size $s
8692 font config textfontbold -size $s
0ed1dd3c 8693 set textfont [fontname textfont]
1d10f36d 8694 setcoords
32f1b3e4 8695 settabs
1d10f36d
PM
8696 redisplay
8697}
1db95b00 8698
ee3dc72e
PM
8699proc clearsha1 {} {
8700 global sha1entry sha1string
8701 if {[string length $sha1string] == 40} {
8702 $sha1entry delete 0 end
8703 }
8704}
8705
887fe3c4
PM
8706proc sha1change {n1 n2 op} {
8707 global sha1string currentid sha1but
8708 if {$sha1string == {}
8709 || ([info exists currentid] && $sha1string == $currentid)} {
8710 set state disabled
8711 } else {
8712 set state normal
8713 }
8714 if {[$sha1but cget -state] == $state} return
8715 if {$state == "normal"} {
d990cedf 8716 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
887fe3c4 8717 } else {
d990cedf 8718 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
887fe3c4
PM
8719 }
8720}
8721
8722proc gotocommit {} {
7fcc92bf 8723 global sha1string tagids headids curview varcid
f3b8b3ce 8724
887fe3c4
PM
8725 if {$sha1string == {}
8726 || ([info exists currentid] && $sha1string == $currentid)} return
8727 if {[info exists tagids($sha1string)]} {
8728 set id $tagids($sha1string)
e1007129
SR
8729 } elseif {[info exists headids($sha1string)]} {
8730 set id $headids($sha1string)
887fe3c4
PM
8731 } else {
8732 set id [string tolower $sha1string]
f3b8b3ce 8733 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
d375ef9b 8734 set matches [longid $id]
f3b8b3ce
PM
8735 if {$matches ne {}} {
8736 if {[llength $matches] > 1} {
d990cedf 8737 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
f3b8b3ce
PM
8738 return
8739 }
d375ef9b 8740 set id [lindex $matches 0]
f3b8b3ce 8741 }
9bf3acfa
TR
8742 } else {
8743 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8744 error_popup [mc "Revision %s is not known" $sha1string]
8745 return
8746 }
f3b8b3ce 8747 }
887fe3c4 8748 }
7fcc92bf
PM
8749 if {[commitinview $id $curview]} {
8750 selectline [rowofcommit $id] 1
887fe3c4
PM
8751 return
8752 }
f3b8b3ce 8753 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
d990cedf 8754 set msg [mc "SHA1 id %s is not known" $sha1string]
887fe3c4 8755 } else {
9bf3acfa 8756 set msg [mc "Revision %s is not in the current view" $sha1string]
887fe3c4 8757 }
d990cedf 8758 error_popup $msg
887fe3c4
PM
8759}
8760
84ba7345
PM
8761proc lineenter {x y id} {
8762 global hoverx hovery hoverid hovertimer
8763 global commitinfo canv
8764
8ed16484 8765 if {![info exists commitinfo($id)] && ![getcommit $id]} return
84ba7345
PM
8766 set hoverx $x
8767 set hovery $y
8768 set hoverid $id
8769 if {[info exists hovertimer]} {
8770 after cancel $hovertimer
8771 }
8772 set hovertimer [after 500 linehover]
8773 $canv delete hover
8774}
8775
8776proc linemotion {x y id} {
8777 global hoverx hovery hoverid hovertimer
8778
8779 if {[info exists hoverid] && $id == $hoverid} {
8780 set hoverx $x
8781 set hovery $y
8782 if {[info exists hovertimer]} {
8783 after cancel $hovertimer
8784 }
8785 set hovertimer [after 500 linehover]
8786 }
8787}
8788
8789proc lineleave {id} {
8790 global hoverid hovertimer canv
8791
8792 if {[info exists hoverid] && $id == $hoverid} {
8793 $canv delete hover
8794 if {[info exists hovertimer]} {
8795 after cancel $hovertimer
8796 unset hovertimer
8797 }
8798 unset hoverid
8799 }
8800}
8801
8802proc linehover {} {
8803 global hoverx hovery hoverid hovertimer
8804 global canv linespc lthickness
252c52df
8805 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8806
9c311b32 8807 global commitinfo
84ba7345
PM
8808
8809 set text [lindex $commitinfo($hoverid) 0]
8810 set ymax [lindex [$canv cget -scrollregion] 3]
8811 if {$ymax == {}} return
8812 set yfrac [lindex [$canv yview] 0]
8813 set x [expr {$hoverx + 2 * $linespc}]
8814 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8815 set x0 [expr {$x - 2 * $lthickness}]
8816 set y0 [expr {$y - 2 * $lthickness}]
9c311b32 8817 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
84ba7345
PM
8818 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8819 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
252c52df
8820 -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8821 -width 1 -tags hover]
84ba7345 8822 $canv raise $t
f8a2c0d1 8823 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
252c52df 8824 -font mainfont -fill $linehoverfgcolor]
84ba7345
PM
8825 $canv raise $t
8826}
8827
9843c307 8828proc clickisonarrow {id y} {
50b44ece 8829 global lthickness
9843c307 8830
50b44ece 8831 set ranges [rowranges $id]
9843c307 8832 set thresh [expr {2 * $lthickness + 6}]
50b44ece 8833 set n [expr {[llength $ranges] - 1}]
f6342480 8834 for {set i 1} {$i < $n} {incr i} {
50b44ece 8835 set row [lindex $ranges $i]
f6342480
PM
8836 if {abs([yc $row] - $y) < $thresh} {
8837 return $i
9843c307
PM
8838 }
8839 }
8840 return {}
8841}
8842
f6342480 8843proc arrowjump {id n y} {
50b44ece 8844 global canv
9843c307 8845
f6342480
PM
8846 # 1 <-> 2, 3 <-> 4, etc...
8847 set n [expr {(($n - 1) ^ 1) + 1}]
50b44ece 8848 set row [lindex [rowranges $id] $n]
f6342480 8849 set yt [yc $row]
9843c307
PM
8850 set ymax [lindex [$canv cget -scrollregion] 3]
8851 if {$ymax eq {} || $ymax <= 0} return
8852 set view [$canv yview]
8853 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8854 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8855 if {$yfrac < 0} {
8856 set yfrac 0
8857 }
f6342480 8858 allcanvs yview moveto $yfrac
9843c307
PM
8859}
8860
fa4da7b3 8861proc lineclick {x y id isnew} {
7fcc92bf 8862 global ctext commitinfo children canv thickerline curview
c8dfbcf9 8863
8ed16484 8864 if {![info exists commitinfo($id)] && ![getcommit $id]} return
c8dfbcf9 8865 unmarkmatches
fa4da7b3 8866 unselectline
9843c307
PM
8867 normalline
8868 $canv delete hover
8869 # draw this line thicker than normal
9843c307 8870 set thickerline $id
c934a8a3 8871 drawlines $id
fa4da7b3 8872 if {$isnew} {
9843c307
PM
8873 set ymax [lindex [$canv cget -scrollregion] 3]
8874 if {$ymax eq {}} return
8875 set yfrac [lindex [$canv yview] 0]
8876 set y [expr {$y + $yfrac * $ymax}]
8877 }
8878 set dirn [clickisonarrow $id $y]
8879 if {$dirn ne {}} {
8880 arrowjump $id $dirn $y
8881 return
8882 }
8883
8884 if {$isnew} {
354af6bd 8885 addtohistory [list lineclick $x $y $id 0] savectextpos
fa4da7b3 8886 }
c8dfbcf9
PM
8887 # fill the details pane with info about this line
8888 $ctext conf -state normal
3ea06f9f 8889 clear_ctext
32f1b3e4 8890 settabs 0
d990cedf 8891 $ctext insert end "[mc "Parent"]:\t"
97645683
PM
8892 $ctext insert end $id link0
8893 setlink $id link0
c8dfbcf9 8894 set info $commitinfo($id)
fa4da7b3 8895 $ctext insert end "\n\t[lindex $info 0]\n"
d990cedf 8896 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
232475d3 8897 set date [formatdate [lindex $info 2]]
d990cedf 8898 $ctext insert end "\t[mc "Date"]:\t$date\n"
da7c24dd 8899 set kids $children($curview,$id)
79b2c75e 8900 if {$kids ne {}} {
d990cedf 8901 $ctext insert end "\n[mc "Children"]:"
fa4da7b3 8902 set i 0
79b2c75e 8903 foreach child $kids {
fa4da7b3 8904 incr i
8ed16484 8905 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
c8dfbcf9 8906 set info $commitinfo($child)
fa4da7b3 8907 $ctext insert end "\n\t"
97645683
PM
8908 $ctext insert end $child link$i
8909 setlink $child link$i
fa4da7b3 8910 $ctext insert end "\n\t[lindex $info 0]"
d990cedf 8911 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
232475d3 8912 set date [formatdate [lindex $info 2]]
d990cedf 8913 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
c8dfbcf9
PM
8914 }
8915 }
354af6bd 8916 maybe_scroll_ctext 1
c8dfbcf9 8917 $ctext conf -state disabled
7fcceed7 8918 init_flist {}
c8dfbcf9
PM
8919}
8920
9843c307
PM
8921proc normalline {} {
8922 global thickerline
8923 if {[info exists thickerline]} {
c934a8a3 8924 set id $thickerline
9843c307 8925 unset thickerline
c934a8a3 8926 drawlines $id
9843c307
PM
8927 }
8928}
8929
354af6bd 8930proc selbyid {id {isnew 1}} {
7fcc92bf
PM
8931 global curview
8932 if {[commitinview $id $curview]} {
354af6bd 8933 selectline [rowofcommit $id] $isnew
c8dfbcf9
PM
8934 }
8935}
8936
8937proc mstime {} {
8938 global startmstime
8939 if {![info exists startmstime]} {
8940 set startmstime [clock clicks -milliseconds]
8941 }
8942 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8943}
8944
8945proc rowmenu {x y id} {
7fcc92bf 8946 global rowctxmenu selectedline rowmenuid curview
b9fdba7f 8947 global nullid nullid2 fakerowmenu mainhead markedid
c8dfbcf9 8948
bb3edc8b 8949 stopfinding
219ea3a9 8950 set rowmenuid $id
94b4a69f 8951 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
c8dfbcf9
PM
8952 set state disabled
8953 } else {
8954 set state normal
8955 }
6febdede
PM
8956 if {[info exists markedid] && $markedid ne $id} {
8957 set mstate normal
8958 } else {
8959 set mstate disabled
8960 }
8f489363 8961 if {$id ne $nullid && $id ne $nullid2} {
219ea3a9 8962 set menu $rowctxmenu
5e3502da 8963 if {$mainhead ne {}} {
b6f92a85 8964 $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
5e3502da 8965 } else {
b6f92a85 8966 $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
5e3502da 8967 }
6febdede
PM
8968 $menu entryconfigure 10 -state $mstate
8969 $menu entryconfigure 11 -state $mstate
b6f92a85 8970 $menu entryconfigure 12 -state $mstate
219ea3a9
PM
8971 } else {
8972 set menu $fakerowmenu
8973 }
f2d0bbbd
PM
8974 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8975 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8976 $menu entryconfigure [mca "Make patch"] -state $state
6febdede
PM
8977 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8978 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
219ea3a9 8979 tk_popup $menu $x $y
c8dfbcf9
PM
8980}
8981
b9fdba7f
PM
8982proc markhere {} {
8983 global rowmenuid markedid canv
8984
8985 set markedid $rowmenuid
8986 make_idmark $markedid
8987}
8988
8989proc gotomark {} {
8990 global markedid
8991
8992 if {[info exists markedid]} {
8993 selbyid $markedid
8994 }
8995}
8996
8997proc replace_by_kids {l r} {
8998 global curview children
8999
9000 set id [commitonrow $r]
9001 set l [lreplace $l 0 0]
9002 foreach kid $children($curview,$id) {
9003 lappend l [rowofcommit $kid]
9004 }
9005 return [lsort -integer -decreasing -unique $l]
9006}
9007
9008proc find_common_desc {} {
9009 global markedid rowmenuid curview children
9010
9011 if {![info exists markedid]} return
9012 if {![commitinview $markedid $curview] ||
9013 ![commitinview $rowmenuid $curview]} return
9014 #set t1 [clock clicks -milliseconds]
9015 set l1 [list [rowofcommit $markedid]]
9016 set l2 [list [rowofcommit $rowmenuid]]
9017 while 1 {
9018 set r1 [lindex $l1 0]
9019 set r2 [lindex $l2 0]
9020 if {$r1 eq {} || $r2 eq {}} break
9021 if {$r1 == $r2} {
9022 selectline $r1 1
9023 break
9024 }
9025 if {$r1 > $r2} {
9026 set l1 [replace_by_kids $l1 $r1]
9027 } else {
9028 set l2 [replace_by_kids $l2 $r2]
9029 }
9030 }
9031 #set t2 [clock clicks -milliseconds]
9032 #puts "took [expr {$t2-$t1}]ms"
9033}
9034
010509f2
PM
9035proc compare_commits {} {
9036 global markedid rowmenuid curview children
9037
9038 if {![info exists markedid]} return
9039 if {![commitinview $markedid $curview]} return
9040 addtohistory [list do_cmp_commits $markedid $rowmenuid]
9041 do_cmp_commits $markedid $rowmenuid
9042}
9043
9044proc getpatchid {id} {
9045 global patchids
9046
9047 if {![info exists patchids($id)]} {
6f63fc18
PM
9048 set cmd [diffcmd [list $id] {-p --root}]
9049 # trim off the initial "|"
9050 set cmd [lrange $cmd 1 end]
9051 if {[catch {
9052 set x [eval exec $cmd | git patch-id]
9053 set patchids($id) [lindex $x 0]
9054 }]} {
9055 set patchids($id) "error"
9056 }
010509f2
PM
9057 }
9058 return $patchids($id)
9059}
9060
9061proc do_cmp_commits {a b} {
9062 global ctext curview parents children patchids commitinfo
9063
9064 $ctext conf -state normal
9065 clear_ctext
9066 init_flist {}
9067 for {set i 0} {$i < 100} {incr i} {
010509f2
PM
9068 set skipa 0
9069 set skipb 0
9070 if {[llength $parents($curview,$a)] > 1} {
6f63fc18 9071 appendshortlink $a [mc "Skipping merge commit "] "\n"
010509f2
PM
9072 set skipa 1
9073 } else {
9074 set patcha [getpatchid $a]
9075 }
9076 if {[llength $parents($curview,$b)] > 1} {
6f63fc18 9077 appendshortlink $b [mc "Skipping merge commit "] "\n"
010509f2
PM
9078 set skipb 1
9079 } else {
9080 set patchb [getpatchid $b]
9081 }
9082 if {!$skipa && !$skipb} {
9083 set heada [lindex $commitinfo($a) 0]
9084 set headb [lindex $commitinfo($b) 0]
6f63fc18
PM
9085 if {$patcha eq "error"} {
9086 appendshortlink $a [mc "Error getting patch ID for "] \
9087 [mc " - stopping\n"]
9088 break
9089 }
9090 if {$patchb eq "error"} {
9091 appendshortlink $b [mc "Error getting patch ID for "] \
9092 [mc " - stopping\n"]
9093 break
9094 }
010509f2
PM
9095 if {$patcha eq $patchb} {
9096 if {$heada eq $headb} {
6f63fc18
PM
9097 appendshortlink $a [mc "Commit "]
9098 appendshortlink $b " == " " $heada\n"
010509f2 9099 } else {
6f63fc18
PM
9100 appendshortlink $a [mc "Commit "] " $heada\n"
9101 appendshortlink $b [mc " is the same patch as\n "] \
9102 " $headb\n"
010509f2
PM
9103 }
9104 set skipa 1
9105 set skipb 1
9106 } else {
9107 $ctext insert end "\n"
6f63fc18
PM
9108 appendshortlink $a [mc "Commit "] " $heada\n"
9109 appendshortlink $b [mc " differs from\n "] \
9110 " $headb\n"
c21398be
PM
9111 $ctext insert end [mc "Diff of commits:\n\n"]
9112 $ctext conf -state disabled
9113 update
9114 diffcommits $a $b
9115 return
010509f2
PM
9116 }
9117 }
9118 if {$skipa} {
aa43561a
PM
9119 set kids [real_children $curview,$a]
9120 if {[llength $kids] != 1} {
010509f2 9121 $ctext insert end "\n"
6f63fc18 9122 appendshortlink $a [mc "Commit "] \
aa43561a 9123 [mc " has %s children - stopping\n" [llength $kids]]
010509f2
PM
9124 break
9125 }
aa43561a 9126 set a [lindex $kids 0]
010509f2
PM
9127 }
9128 if {$skipb} {
aa43561a
PM
9129 set kids [real_children $curview,$b]
9130 if {[llength $kids] != 1} {
6f63fc18 9131 appendshortlink $b [mc "Commit "] \
aa43561a 9132 [mc " has %s children - stopping\n" [llength $kids]]
010509f2
PM
9133 break
9134 }
aa43561a 9135 set b [lindex $kids 0]
010509f2
PM
9136 }
9137 }
9138 $ctext conf -state disabled
9139}
9140
c21398be 9141proc diffcommits {a b} {
a1d383c5 9142 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
c21398be
PM
9143
9144 set tmpdir [gitknewtmpdir]
9145 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9146 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9147 if {[catch {
9148 exec git diff-tree -p --pretty $a >$fna
9149 exec git diff-tree -p --pretty $b >$fnb
9150 } err]} {
9151 error_popup [mc "Error writing commit to file: %s" $err]
9152 return
9153 }
9154 if {[catch {
9155 set fd [open "| diff -U$diffcontext $fna $fnb" r]
9156 } err]} {
9157 error_popup [mc "Error diffing commits: %s" $err]
9158 return
9159 }
9160 set diffids [list commits $a $b]
9161 set blobdifffd($diffids) $fd
9162 set diffinhdr 0
a1d383c5 9163 set currdiffsubmod ""
c21398be
PM
9164 filerun $fd [list getblobdiffline $fd $diffids]
9165}
9166
c8dfbcf9 9167proc diffvssel {dirn} {
7fcc92bf 9168 global rowmenuid selectedline
c8dfbcf9 9169
94b4a69f 9170 if {$selectedline eq {}} return
c8dfbcf9 9171 if {$dirn} {
7fcc92bf 9172 set oldid [commitonrow $selectedline]
c8dfbcf9
PM
9173 set newid $rowmenuid
9174 } else {
9175 set oldid $rowmenuid
7fcc92bf 9176 set newid [commitonrow $selectedline]
c8dfbcf9 9177 }
354af6bd 9178 addtohistory [list doseldiff $oldid $newid] savectextpos
fa4da7b3
PM
9179 doseldiff $oldid $newid
9180}
9181
6febdede
PM
9182proc diffvsmark {dirn} {
9183 global rowmenuid markedid
9184
9185 if {![info exists markedid]} return
9186 if {$dirn} {
9187 set oldid $markedid
9188 set newid $rowmenuid
9189 } else {
9190 set oldid $rowmenuid
9191 set newid $markedid
9192 }
9193 addtohistory [list doseldiff $oldid $newid] savectextpos
9194 doseldiff $oldid $newid
9195}
9196
fa4da7b3 9197proc doseldiff {oldid newid} {
7fcceed7 9198 global ctext
fa4da7b3
PM
9199 global commitinfo
9200
c8dfbcf9 9201 $ctext conf -state normal
3ea06f9f 9202 clear_ctext
d990cedf
CS
9203 init_flist [mc "Top"]
9204 $ctext insert end "[mc "From"] "
97645683
PM
9205 $ctext insert end $oldid link0
9206 setlink $oldid link0
fa4da7b3 9207 $ctext insert end "\n "
c8dfbcf9 9208 $ctext insert end [lindex $commitinfo($oldid) 0]
d990cedf 9209 $ctext insert end "\n\n[mc "To"] "
97645683
PM
9210 $ctext insert end $newid link1
9211 setlink $newid link1
fa4da7b3 9212 $ctext insert end "\n "
c8dfbcf9
PM
9213 $ctext insert end [lindex $commitinfo($newid) 0]
9214 $ctext insert end "\n"
9215 $ctext conf -state disabled
c8dfbcf9 9216 $ctext tag remove found 1.0 end
d327244a 9217 startdiff [list $oldid $newid]
c8dfbcf9
PM
9218}
9219
74daedb6 9220proc mkpatch {} {
d93f1713 9221 global rowmenuid currentid commitinfo patchtop patchnum NS
74daedb6
PM
9222
9223 if {![info exists currentid]} return
9224 set oldid $currentid
9225 set oldhead [lindex $commitinfo($oldid) 0]
9226 set newid $rowmenuid
9227 set newhead [lindex $commitinfo($newid) 0]
9228 set top .patch
9229 set patchtop $top
9230 catch {destroy $top}
d93f1713 9231 ttk_toplevel $top
e7d64008 9232 make_transient $top .
d93f1713 9233 ${NS}::label $top.title -text [mc "Generate patch"]
4a2139f5 9234 grid $top.title - -pady 10
d93f1713
PT
9235 ${NS}::label $top.from -text [mc "From:"]
9236 ${NS}::entry $top.fromsha1 -width 40
74daedb6
PM
9237 $top.fromsha1 insert 0 $oldid
9238 $top.fromsha1 conf -state readonly
9239 grid $top.from $top.fromsha1 -sticky w
d93f1713 9240 ${NS}::entry $top.fromhead -width 60
74daedb6
PM
9241 $top.fromhead insert 0 $oldhead
9242 $top.fromhead conf -state readonly
9243 grid x $top.fromhead -sticky w
d93f1713
PT
9244 ${NS}::label $top.to -text [mc "To:"]
9245 ${NS}::entry $top.tosha1 -width 40
74daedb6
PM
9246 $top.tosha1 insert 0 $newid
9247 $top.tosha1 conf -state readonly
9248 grid $top.to $top.tosha1 -sticky w
d93f1713 9249 ${NS}::entry $top.tohead -width 60
74daedb6
PM
9250 $top.tohead insert 0 $newhead
9251 $top.tohead conf -state readonly
9252 grid x $top.tohead -sticky w
d93f1713
PT
9253 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9254 grid $top.rev x -pady 10 -padx 5
9255 ${NS}::label $top.flab -text [mc "Output file:"]
9256 ${NS}::entry $top.fname -width 60
74daedb6
PM
9257 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9258 incr patchnum
bdbfbe3d 9259 grid $top.flab $top.fname -sticky w
d93f1713
PT
9260 ${NS}::frame $top.buts
9261 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9262 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
76f15947
AG
9263 bind $top <Key-Return> mkpatchgo
9264 bind $top <Key-Escape> mkpatchcan
74daedb6
PM
9265 grid $top.buts.gen $top.buts.can
9266 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9267 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9268 grid $top.buts - -pady 10 -sticky ew
bdbfbe3d 9269 focus $top.fname
74daedb6
PM
9270}
9271
9272proc mkpatchrev {} {
9273 global patchtop
9274
9275 set oldid [$patchtop.fromsha1 get]
9276 set oldhead [$patchtop.fromhead get]
9277 set newid [$patchtop.tosha1 get]
9278 set newhead [$patchtop.tohead get]
9279 foreach e [list fromsha1 fromhead tosha1 tohead] \
9280 v [list $newid $newhead $oldid $oldhead] {
9281 $patchtop.$e conf -state normal
9282 $patchtop.$e delete 0 end
9283 $patchtop.$e insert 0 $v
9284 $patchtop.$e conf -state readonly
9285 }
9286}
9287
9288proc mkpatchgo {} {
8f489363 9289 global patchtop nullid nullid2
74daedb6
PM
9290
9291 set oldid [$patchtop.fromsha1 get]
9292 set newid [$patchtop.tosha1 get]
9293 set fname [$patchtop.fname get]
8f489363 9294 set cmd [diffcmd [list $oldid $newid] -p]
d372e216
PM
9295 # trim off the initial "|"
9296 set cmd [lrange $cmd 1 end]
219ea3a9
PM
9297 lappend cmd >$fname &
9298 if {[catch {eval exec $cmd} err]} {
84a76f18 9299 error_popup "[mc "Error creating patch:"] $err" $patchtop
74daedb6
PM
9300 }
9301 catch {destroy $patchtop}
9302 unset patchtop
9303}
9304
9305proc mkpatchcan {} {
9306 global patchtop
9307
9308 catch {destroy $patchtop}
9309 unset patchtop
9310}
9311
bdbfbe3d 9312proc mktag {} {
d93f1713 9313 global rowmenuid mktagtop commitinfo NS
bdbfbe3d
PM
9314
9315 set top .maketag
9316 set mktagtop $top
9317 catch {destroy $top}
d93f1713 9318 ttk_toplevel $top
e7d64008 9319 make_transient $top .
d93f1713 9320 ${NS}::label $top.title -text [mc "Create tag"]
4a2139f5 9321 grid $top.title - -pady 10
d93f1713
PT
9322 ${NS}::label $top.id -text [mc "ID:"]
9323 ${NS}::entry $top.sha1 -width 40
bdbfbe3d
PM
9324 $top.sha1 insert 0 $rowmenuid
9325 $top.sha1 conf -state readonly
9326 grid $top.id $top.sha1 -sticky w
d93f1713 9327 ${NS}::entry $top.head -width 60
bdbfbe3d
PM
9328 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9329 $top.head conf -state readonly
9330 grid x $top.head -sticky w
d93f1713
PT
9331 ${NS}::label $top.tlab -text [mc "Tag name:"]
9332 ${NS}::entry $top.tag -width 60
bdbfbe3d 9333 grid $top.tlab $top.tag -sticky w
dfb891e3
DD
9334 ${NS}::label $top.op -text [mc "Tag message is optional"]
9335 grid $top.op -columnspan 2 -sticky we
9336 ${NS}::label $top.mlab -text [mc "Tag message:"]
9337 ${NS}::entry $top.msg -width 60
9338 grid $top.mlab $top.msg -sticky w
d93f1713
PT
9339 ${NS}::frame $top.buts
9340 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9341 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
76f15947
AG
9342 bind $top <Key-Return> mktaggo
9343 bind $top <Key-Escape> mktagcan
bdbfbe3d
PM
9344 grid $top.buts.gen $top.buts.can
9345 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9346 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9347 grid $top.buts - -pady 10 -sticky ew
9348 focus $top.tag
9349}
9350
9351proc domktag {} {
9352 global mktagtop env tagids idtags
bdbfbe3d
PM
9353
9354 set id [$mktagtop.sha1 get]
9355 set tag [$mktagtop.tag get]
dfb891e3 9356 set msg [$mktagtop.msg get]
bdbfbe3d 9357 if {$tag == {}} {
84a76f18
AG
9358 error_popup [mc "No tag name specified"] $mktagtop
9359 return 0
bdbfbe3d
PM
9360 }
9361 if {[info exists tagids($tag)]} {
84a76f18
AG
9362 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9363 return 0
bdbfbe3d
PM
9364 }
9365 if {[catch {
dfb891e3
DD
9366 if {$msg != {}} {
9367 exec git tag -a -m $msg $tag $id
9368 } else {
9369 exec git tag $tag $id
9370 }
bdbfbe3d 9371 } err]} {
84a76f18
AG
9372 error_popup "[mc "Error creating tag:"] $err" $mktagtop
9373 return 0
bdbfbe3d
PM
9374 }
9375
9376 set tagids($tag) $id
9377 lappend idtags($id) $tag
f1d83ba3 9378 redrawtags $id
ceadfe90 9379 addedtag $id
887c996e
PM
9380 dispneartags 0
9381 run refill_reflist
84a76f18 9382 return 1
f1d83ba3
PM
9383}
9384
9385proc redrawtags {id} {
b9fdba7f 9386 global canv linehtag idpos currentid curview cmitlisted markedid
c11ff120 9387 global canvxmax iddrawn circleitem mainheadid circlecolors
252c52df 9388 global mainheadcirclecolor
f1d83ba3 9389
7fcc92bf 9390 if {![commitinview $id $curview]} return
322a8cc9 9391 if {![info exists iddrawn($id)]} return
fc2a256f 9392 set row [rowofcommit $id]
c11ff120 9393 if {$id eq $mainheadid} {
252c52df 9394 set ofill $mainheadcirclecolor
c11ff120
PM
9395 } else {
9396 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9397 }
9398 $canv itemconf $circleitem($row) -fill $ofill
bdbfbe3d
PM
9399 $canv delete tag.$id
9400 set xt [eval drawtags $id $idpos($id)]
28593d3f
PM
9401 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9402 set text [$canv itemcget $linehtag($id) -text]
9403 set font [$canv itemcget $linehtag($id) -font]
fc2a256f 9404 set xr [expr {$xt + [font measure $font $text]}]
b8ab2e17
PM
9405 if {$xr > $canvxmax} {
9406 set canvxmax $xr
9407 setcanvscroll
9408 }
fc2a256f 9409 if {[info exists currentid] && $currentid == $id} {
28593d3f 9410 make_secsel $id
bdbfbe3d 9411 }
b9fdba7f
PM
9412 if {[info exists markedid] && $markedid eq $id} {
9413 make_idmark $id
9414 }
bdbfbe3d
PM
9415}
9416
9417proc mktagcan {} {
9418 global mktagtop
9419
9420 catch {destroy $mktagtop}
9421 unset mktagtop
9422}
9423
9424proc mktaggo {} {
84a76f18 9425 if {![domktag]} return
bdbfbe3d
PM
9426 mktagcan
9427}
9428
d835dbb9
BB
9429proc copysummary {} {
9430 global rowmenuid autosellen
9431
9432 set format "%h (\"%s\", %ad)"
9433 set cmd [list git show -s --pretty=format:$format --date=short]
9434 if {$autosellen < 40} {
9435 lappend cmd --abbrev=$autosellen
9436 }
9437 set summary [eval exec $cmd $rowmenuid]
9438
9439 clipboard clear
9440 clipboard append $summary
9441}
9442
4a2139f5 9443proc writecommit {} {
d93f1713 9444 global rowmenuid wrcomtop commitinfo wrcomcmd NS
4a2139f5
PM
9445
9446 set top .writecommit
9447 set wrcomtop $top
9448 catch {destroy $top}
d93f1713 9449 ttk_toplevel $top
e7d64008 9450 make_transient $top .
d93f1713 9451 ${NS}::label $top.title -text [mc "Write commit to file"]
4a2139f5 9452 grid $top.title - -pady 10
d93f1713
PT
9453 ${NS}::label $top.id -text [mc "ID:"]
9454 ${NS}::entry $top.sha1 -width 40
4a2139f5
PM
9455 $top.sha1 insert 0 $rowmenuid
9456 $top.sha1 conf -state readonly
9457 grid $top.id $top.sha1 -sticky w
d93f1713 9458 ${NS}::entry $top.head -width 60
4a2139f5
PM
9459 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9460 $top.head conf -state readonly
9461 grid x $top.head -sticky w
d93f1713
PT
9462 ${NS}::label $top.clab -text [mc "Command:"]
9463 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
4a2139f5 9464 grid $top.clab $top.cmd -sticky w -pady 10
d93f1713
PT
9465 ${NS}::label $top.flab -text [mc "Output file:"]
9466 ${NS}::entry $top.fname -width 60
4a2139f5
PM
9467 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9468 grid $top.flab $top.fname -sticky w
d93f1713
PT
9469 ${NS}::frame $top.buts
9470 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9471 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
76f15947
AG
9472 bind $top <Key-Return> wrcomgo
9473 bind $top <Key-Escape> wrcomcan
4a2139f5
PM
9474 grid $top.buts.gen $top.buts.can
9475 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9476 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9477 grid $top.buts - -pady 10 -sticky ew
9478 focus $top.fname
9479}
9480
9481proc wrcomgo {} {
9482 global wrcomtop
9483
9484 set id [$wrcomtop.sha1 get]
9485 set cmd "echo $id | [$wrcomtop.cmd get]"
9486 set fname [$wrcomtop.fname get]
9487 if {[catch {exec sh -c $cmd >$fname &} err]} {
84a76f18 9488 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
4a2139f5
PM
9489 }
9490 catch {destroy $wrcomtop}
9491 unset wrcomtop
9492}
9493
9494proc wrcomcan {} {
9495 global wrcomtop
9496
9497 catch {destroy $wrcomtop}
9498 unset wrcomtop
9499}
9500
d6ac1a86 9501proc mkbranch {} {
5a046c52
RG
9502 global NS rowmenuid
9503
9504 set top .branchdialog
9505
9506 set val(name) ""
9507 set val(id) $rowmenuid
9508 set val(command) [list mkbrgo $top]
9509
9510 set ui(title) [mc "Create branch"]
9511 set ui(accept) [mc "Create"]
9512
9513 branchdia $top val ui
9514}
9515
9516proc mvbranch {} {
9517 global NS
9518 global headmenuid headmenuhead
9519
9520 set top .branchdialog
9521
9522 set val(name) $headmenuhead
9523 set val(id) $headmenuid
9524 set val(command) [list mvbrgo $top $headmenuhead]
9525
9526 set ui(title) [mc "Rename branch %s" $headmenuhead]
9527 set ui(accept) [mc "Rename"]
9528
9529 branchdia $top val ui
9530}
9531
9532proc branchdia {top valvar uivar} {
7f00f4c0 9533 global NS commitinfo
5a046c52 9534 upvar $valvar val $uivar ui
d6ac1a86 9535
d6ac1a86 9536 catch {destroy $top}
d93f1713 9537 ttk_toplevel $top
e7d64008 9538 make_transient $top .
5a046c52 9539 ${NS}::label $top.title -text $ui(title)
d6ac1a86 9540 grid $top.title - -pady 10
d93f1713
PT
9541 ${NS}::label $top.id -text [mc "ID:"]
9542 ${NS}::entry $top.sha1 -width 40
5a046c52 9543 $top.sha1 insert 0 $val(id)
d6ac1a86
PM
9544 $top.sha1 conf -state readonly
9545 grid $top.id $top.sha1 -sticky w
7f00f4c0
RG
9546 ${NS}::entry $top.head -width 60
9547 $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9548 $top.head conf -state readonly
9549 grid x $top.head -sticky ew
9550 grid columnconfigure $top 1 -weight 1
d93f1713
PT
9551 ${NS}::label $top.nlab -text [mc "Name:"]
9552 ${NS}::entry $top.name -width 40
5a046c52 9553 $top.name insert 0 $val(name)
d6ac1a86 9554 grid $top.nlab $top.name -sticky w
d93f1713 9555 ${NS}::frame $top.buts
5a046c52 9556 ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
d93f1713 9557 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
5a046c52 9558 bind $top <Key-Return> $val(command)
76f15947 9559 bind $top <Key-Escape> "catch {destroy $top}"
d6ac1a86
PM
9560 grid $top.buts.go $top.buts.can
9561 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9562 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9563 grid $top.buts - -pady 10 -sticky ew
9564 focus $top.name
9565}
9566
9567proc mkbrgo {top} {
9568 global headids idheads
9569
9570 set name [$top.name get]
9571 set id [$top.sha1 get]
bee866fa
AG
9572 set cmdargs {}
9573 set old_id {}
d6ac1a86 9574 if {$name eq {}} {
84a76f18 9575 error_popup [mc "Please specify a name for the new branch"] $top
d6ac1a86
PM
9576 return
9577 }
bee866fa
AG
9578 if {[info exists headids($name)]} {
9579 if {![confirm_popup [mc \
84a76f18 9580 "Branch '%s' already exists. Overwrite?" $name] $top]} {
bee866fa
AG
9581 return
9582 }
9583 set old_id $headids($name)
9584 lappend cmdargs -f
9585 }
d6ac1a86 9586 catch {destroy $top}
bee866fa 9587 lappend cmdargs $name $id
d6ac1a86
PM
9588 nowbusy newbranch
9589 update
9590 if {[catch {
bee866fa 9591 eval exec git branch $cmdargs
d6ac1a86
PM
9592 } err]} {
9593 notbusy newbranch
9594 error_popup $err
9595 } else {
d6ac1a86 9596 notbusy newbranch
bee866fa
AG
9597 if {$old_id ne {}} {
9598 movehead $id $name
9599 movedhead $id $name
9600 redrawtags $old_id
9601 redrawtags $id
9602 } else {
9603 set headids($name) $id
9604 lappend idheads($id) $name
9605 addedhead $id $name
9606 redrawtags $id
9607 }
e11f1233 9608 dispneartags 0
887c996e 9609 run refill_reflist
d6ac1a86
PM
9610 }
9611}
9612
5a046c52
RG
9613proc mvbrgo {top prevname} {
9614 global headids idheads mainhead mainheadid
9615
9616 set name [$top.name get]
9617 set id [$top.sha1 get]
9618 set cmdargs {}
9619 if {$name eq $prevname} {
9620 catch {destroy $top}
9621 return
9622 }
9623 if {$name eq {}} {
9624 error_popup [mc "Please specify a new name for the branch"] $top
9625 return
9626 }
9627 catch {destroy $top}
9628 lappend cmdargs -m $prevname $name
9629 nowbusy renamebranch
9630 update
9631 if {[catch {
9632 eval exec git branch $cmdargs
9633 } err]} {
9634 notbusy renamebranch
9635 error_popup $err
9636 } else {
9637 notbusy renamebranch
9638 removehead $id $prevname
9639 removedhead $id $prevname
9640 set headids($name) $id
9641 lappend idheads($id) $name
9642 addedhead $id $name
9643 if {$prevname eq $mainhead} {
9644 set mainhead $name
9645 set mainheadid $id
9646 }
9647 redrawtags $id
9648 dispneartags 0
9649 run refill_reflist
9650 }
9651}
9652
15e35055
AG
9653proc exec_citool {tool_args {baseid {}}} {
9654 global commitinfo env
9655
9656 set save_env [array get env GIT_AUTHOR_*]
9657
9658 if {$baseid ne {}} {
9659 if {![info exists commitinfo($baseid)]} {
9660 getcommit $baseid
9661 }
9662 set author [lindex $commitinfo($baseid) 1]
9663 set date [lindex $commitinfo($baseid) 2]
9664 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9665 $author author name email]
9666 && $date ne {}} {
9667 set env(GIT_AUTHOR_NAME) $name
9668 set env(GIT_AUTHOR_EMAIL) $email
9669 set env(GIT_AUTHOR_DATE) $date
9670 }
9671 }
9672
9673 eval exec git citool $tool_args &
9674
9675 array unset env GIT_AUTHOR_*
9676 array set env $save_env
9677}
9678
ca6d8f58 9679proc cherrypick {} {
468bcaed 9680 global rowmenuid curview
b8a938cf 9681 global mainhead mainheadid
da616db5 9682 global gitdir
ca6d8f58 9683
e11f1233
PM
9684 set oldhead [exec git rev-parse HEAD]
9685 set dheads [descheads $rowmenuid]
9686 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
d990cedf
CS
9687 set ok [confirm_popup [mc "Commit %s is already\
9688 included in branch %s -- really re-apply it?" \
9689 [string range $rowmenuid 0 7] $mainhead]]
ca6d8f58
PM
9690 if {!$ok} return
9691 }
d990cedf 9692 nowbusy cherrypick [mc "Cherry-picking"]
ca6d8f58 9693 update
ca6d8f58
PM
9694 # Unfortunately git-cherry-pick writes stuff to stderr even when
9695 # no error occurs, and exec takes that as an indication of error...
9696 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9697 notbusy cherrypick
15e35055 9698 if {[regexp -line \
887a791f
PM
9699 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9700 $err msg fname]} {
9701 error_popup [mc "Cherry-pick failed because of local changes\
9702 to file '%s'.\nPlease commit, reset or stash\
9703 your changes and try again." $fname]
9704 } elseif {[regexp -line \
b74307f6 9705 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
887a791f
PM
9706 $err]} {
9707 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9708 conflict.\nDo you wish to run git citool to\
9709 resolve it?"]]} {
9710 # Force citool to read MERGE_MSG
da616db5 9711 file delete [file join $gitdir "GITGUI_MSG"]
887a791f
PM
9712 exec_citool {} $rowmenuid
9713 }
15e35055
AG
9714 } else {
9715 error_popup $err
9716 }
887a791f 9717 run updatecommits
ca6d8f58
PM
9718 return
9719 }
9720 set newhead [exec git rev-parse HEAD]
9721 if {$newhead eq $oldhead} {
9722 notbusy cherrypick
d990cedf 9723 error_popup [mc "No changes committed"]
ca6d8f58
PM
9724 return
9725 }
e11f1233 9726 addnewchild $newhead $oldhead
7fcc92bf 9727 if {[commitinview $oldhead $curview]} {
cdc8429c 9728 # XXX this isn't right if we have a path limit...
7fcc92bf 9729 insertrow $newhead $oldhead $curview
ca6d8f58 9730 if {$mainhead ne {}} {
e11f1233 9731 movehead $newhead $mainhead
ca6d8f58
PM
9732 movedhead $newhead $mainhead
9733 }
c11ff120 9734 set mainheadid $newhead
ca6d8f58
PM
9735 redrawtags $oldhead
9736 redrawtags $newhead
46308ea1 9737 selbyid $newhead
ca6d8f58
PM
9738 }
9739 notbusy cherrypick
9740}
9741
8f3ff933
KF
9742proc revert {} {
9743 global rowmenuid curview
9744 global mainhead mainheadid
9745 global gitdir
9746
9747 set oldhead [exec git rev-parse HEAD]
9748 set dheads [descheads $rowmenuid]
9749 if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9750 set ok [confirm_popup [mc "Commit %s is not\
9751 included in branch %s -- really revert it?" \
9752 [string range $rowmenuid 0 7] $mainhead]]
9753 if {!$ok} return
9754 }
9755 nowbusy revert [mc "Reverting"]
9756 update
9757
9758 if [catch {exec git revert --no-edit $rowmenuid} err] {
9759 notbusy revert
9760 if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9761 $err match files] {
9762 regsub {\n( |\t)+} $files "\n" files
9763 error_popup [mc "Revert failed because of local changes to\
9764 the following files:%s Please commit, reset or stash \
9765 your changes and try again." $files]
9766 } elseif [regexp {error: could not revert} $err] {
9767 if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9768 Do you wish to run git citool to resolve it?"]] {
9769 # Force citool to read MERGE_MSG
9770 file delete [file join $gitdir "GITGUI_MSG"]
9771 exec_citool {} $rowmenuid
9772 }
9773 } else { error_popup $err }
9774 run updatecommits
9775 return
9776 }
9777
9778 set newhead [exec git rev-parse HEAD]
9779 if { $newhead eq $oldhead } {
9780 notbusy revert
9781 error_popup [mc "No changes committed"]
9782 return
9783 }
9784
9785 addnewchild $newhead $oldhead
9786
9787 if [commitinview $oldhead $curview] {
9788 # XXX this isn't right if we have a path limit...
9789 insertrow $newhead $oldhead $curview
9790 if {$mainhead ne {}} {
9791 movehead $newhead $mainhead
9792 movedhead $newhead $mainhead
9793 }
9794 set mainheadid $newhead
9795 redrawtags $oldhead
9796 redrawtags $newhead
9797 selbyid $newhead
9798 }
9799
9800 notbusy revert
9801}
9802
6fb735ae 9803proc resethead {} {
d93f1713 9804 global mainhead rowmenuid confirm_ok resettype NS
6fb735ae
PM
9805
9806 set confirm_ok 0
9807 set w ".confirmreset"
d93f1713 9808 ttk_toplevel $w
e7d64008 9809 make_transient $w .
d990cedf 9810 wm title $w [mc "Confirm reset"]
d93f1713
PT
9811 ${NS}::label $w.m -text \
9812 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
6fb735ae 9813 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 9814 ${NS}::labelframe $w.f -text [mc "Reset type:"]
6fb735ae 9815 set resettype mixed
d93f1713 9816 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
d990cedf 9817 -text [mc "Soft: Leave working tree and index untouched"]
6fb735ae 9818 grid $w.f.soft -sticky w
d93f1713 9819 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
d990cedf 9820 -text [mc "Mixed: Leave working tree untouched, reset index"]
6fb735ae 9821 grid $w.f.mixed -sticky w
d93f1713 9822 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
d990cedf 9823 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6fb735ae 9824 grid $w.f.hard -sticky w
d93f1713
PT
9825 pack $w.f -side top -fill x -padx 4
9826 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6fb735ae 9827 pack $w.ok -side left -fill x -padx 20 -pady 20
d93f1713 9828 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
76f15947 9829 bind $w <Key-Escape> [list destroy $w]
6fb735ae
PM
9830 pack $w.cancel -side right -fill x -padx 20 -pady 20
9831 bind $w <Visibility> "grab $w; focus $w"
9832 tkwait window $w
9833 if {!$confirm_ok} return
706d6c3e 9834 if {[catch {set fd [open \
08ba820f 9835 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
6fb735ae
PM
9836 error_popup $err
9837 } else {
706d6c3e 9838 dohidelocalchanges
a137a90f 9839 filerun $fd [list readresetstat $fd]
d990cedf 9840 nowbusy reset [mc "Resetting"]
46308ea1 9841 selbyid $rowmenuid
706d6c3e
PM
9842 }
9843}
9844
a137a90f
PM
9845proc readresetstat {fd} {
9846 global mainhead mainheadid showlocalchanges rprogcoord
706d6c3e
PM
9847
9848 if {[gets $fd line] >= 0} {
9849 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
a137a90f
PM
9850 set rprogcoord [expr {1.0 * $m / $n}]
9851 adjustprogress
706d6c3e
PM
9852 }
9853 return 1
9854 }
a137a90f
PM
9855 set rprogcoord 0
9856 adjustprogress
706d6c3e
PM
9857 notbusy reset
9858 if {[catch {close $fd} err]} {
9859 error_popup $err
9860 }
9861 set oldhead $mainheadid
9862 set newhead [exec git rev-parse HEAD]
9863 if {$newhead ne $oldhead} {
9864 movehead $newhead $mainhead
9865 movedhead $newhead $mainhead
9866 set mainheadid $newhead
6fb735ae 9867 redrawtags $oldhead
706d6c3e 9868 redrawtags $newhead
6fb735ae
PM
9869 }
9870 if {$showlocalchanges} {
9871 doshowlocalchanges
9872 }
706d6c3e 9873 return 0
6fb735ae
PM
9874}
9875
10299152
PM
9876# context menu for a head
9877proc headmenu {x y id head} {
02e6a060 9878 global headmenuid headmenuhead headctxmenu mainhead headids
10299152 9879
bb3edc8b 9880 stopfinding
10299152
PM
9881 set headmenuid $id
9882 set headmenuhead $head
5a046c52 9883 array set state {0 normal 1 normal 2 normal}
70a5fc44 9884 if {[string match "remotes/*" $head]} {
02e6a060
RG
9885 set localhead [string range $head [expr [string last / $head] + 1] end]
9886 if {[info exists headids($localhead)]} {
9887 set state(0) disabled
9888 }
9889 array set state {1 disabled 2 disabled}
70a5fc44 9890 }
00609463 9891 if {$head eq $mainhead} {
5a046c52
RG
9892 array set state {0 disabled 2 disabled}
9893 }
9894 foreach i {0 1 2} {
9895 $headctxmenu entryconfigure $i -state $state($i)
00609463 9896 }
10299152
PM
9897 tk_popup $headctxmenu $x $y
9898}
9899
9900proc cobranch {} {
c11ff120 9901 global headmenuid headmenuhead headids
cdc8429c 9902 global showlocalchanges
10299152
PM
9903
9904 # check the tree is clean first??
02e6a060
RG
9905 set newhead $headmenuhead
9906 set command [list | git checkout]
9907 if {[string match "remotes/*" $newhead]} {
9908 set remote $newhead
9909 set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9910 # The following check is redundant - the menu option should
9911 # be disabled to begin with...
9912 if {[info exists headids($newhead)]} {
9913 error_popup [mc "A local branch named %s exists already" $newhead]
9914 return
9915 }
9916 lappend command -b $newhead --track $remote
9917 } else {
9918 lappend command $newhead
9919 }
9920 lappend command 2>@1
d990cedf 9921 nowbusy checkout [mc "Checking out"]
10299152 9922 update
219ea3a9 9923 dohidelocalchanges
10299152 9924 if {[catch {
02e6a060 9925 set fd [open $command r]
10299152
PM
9926 } err]} {
9927 notbusy checkout
9928 error_popup $err
08ba820f
PM
9929 if {$showlocalchanges} {
9930 dodiffindex
9931 }
10299152 9932 } else {
02e6a060 9933 filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
08ba820f
PM
9934 }
9935}
9936
9937proc readcheckoutstat {fd newhead newheadid} {
02e6a060 9938 global mainhead mainheadid headids idheads showlocalchanges progresscoords
cdc8429c 9939 global viewmainheadid curview
08ba820f
PM
9940
9941 if {[gets $fd line] >= 0} {
9942 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9943 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9944 adjustprogress
10299152 9945 }
08ba820f
PM
9946 return 1
9947 }
9948 set progresscoords {0 0}
9949 adjustprogress
9950 notbusy checkout
9951 if {[catch {close $fd} err]} {
9952 error_popup $err
02e6a060 9953 return
08ba820f 9954 }
c11ff120 9955 set oldmainid $mainheadid
02e6a060
RG
9956 if {! [info exists headids($newhead)]} {
9957 set headids($newhead) $newheadid
9958 lappend idheads($newheadid) $newhead
9959 addedhead $newheadid $newhead
9960 }
08ba820f
PM
9961 set mainhead $newhead
9962 set mainheadid $newheadid
cdc8429c 9963 set viewmainheadid($curview) $newheadid
c11ff120 9964 redrawtags $oldmainid
08ba820f
PM
9965 redrawtags $newheadid
9966 selbyid $newheadid
6fb735ae
PM
9967 if {$showlocalchanges} {
9968 dodiffindex
10299152
PM
9969 }
9970}
9971
9972proc rmbranch {} {
e11f1233 9973 global headmenuid headmenuhead mainhead
b1054ac9 9974 global idheads
10299152
PM
9975
9976 set head $headmenuhead
9977 set id $headmenuid
00609463 9978 # this check shouldn't be needed any more...
10299152 9979 if {$head eq $mainhead} {
d990cedf 9980 error_popup [mc "Cannot delete the currently checked-out branch"]
10299152
PM
9981 return
9982 }
e11f1233 9983 set dheads [descheads $id]
d7b16113 9984 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
10299152 9985 # the stuff on this branch isn't on any other branch
d990cedf
CS
9986 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9987 branch.\nReally delete branch %s?" $head $head]]} return
10299152
PM
9988 }
9989 nowbusy rmbranch
9990 update
9991 if {[catch {exec git branch -D $head} err]} {
9992 notbusy rmbranch
9993 error_popup $err
9994 return
9995 }
e11f1233 9996 removehead $id $head
ca6d8f58 9997 removedhead $id $head
10299152
PM
9998 redrawtags $id
9999 notbusy rmbranch
e11f1233 10000 dispneartags 0
887c996e
PM
10001 run refill_reflist
10002}
10003
10004# Display a list of tags and heads
10005proc showrefs {} {
d93f1713 10006 global showrefstop bgcolor fgcolor selectbgcolor NS
9c311b32 10007 global bglist fglist reflistfilter reflist maincursor
887c996e
PM
10008
10009 set top .showrefs
10010 set showrefstop $top
10011 if {[winfo exists $top]} {
10012 raise $top
10013 refill_reflist
10014 return
10015 }
d93f1713 10016 ttk_toplevel $top
d990cedf 10017 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
e7d64008 10018 make_transient $top .
887c996e 10019 text $top.list -background $bgcolor -foreground $fgcolor \
9c311b32 10020 -selectbackground $selectbgcolor -font mainfont \
887c996e
PM
10021 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10022 -width 30 -height 20 -cursor $maincursor \
10023 -spacing1 1 -spacing3 1 -state disabled
10024 $top.list tag configure highlight -background $selectbgcolor
eb859df8
PM
10025 if {![lsearch -exact $bglist $top.list]} {
10026 lappend bglist $top.list
10027 lappend fglist $top.list
10028 }
d93f1713
PT
10029 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10030 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
887c996e
PM
10031 grid $top.list $top.ysb -sticky nsew
10032 grid $top.xsb x -sticky ew
d93f1713
PT
10033 ${NS}::frame $top.f
10034 ${NS}::label $top.f.l -text "[mc "Filter"]: "
10035 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
887c996e
PM
10036 set reflistfilter "*"
10037 trace add variable reflistfilter write reflistfilter_change
10038 pack $top.f.e -side right -fill x -expand 1
10039 pack $top.f.l -side left
10040 grid $top.f - -sticky ew -pady 2
d93f1713 10041 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
76f15947 10042 bind $top <Key-Escape> [list destroy $top]
887c996e
PM
10043 grid $top.close -
10044 grid columnconfigure $top 0 -weight 1
10045 grid rowconfigure $top 0 -weight 1
10046 bind $top.list <1> {break}
10047 bind $top.list <B1-Motion> {break}
10048 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10049 set reflist {}
10050 refill_reflist
10051}
10052
10053proc sel_reflist {w x y} {
10054 global showrefstop reflist headids tagids otherrefids
10055
10056 if {![winfo exists $showrefstop]} return
10057 set l [lindex [split [$w index "@$x,$y"] "."] 0]
10058 set ref [lindex $reflist [expr {$l-1}]]
10059 set n [lindex $ref 0]
10060 switch -- [lindex $ref 1] {
10061 "H" {selbyid $headids($n)}
d7cc4fb0 10062 "R" {selbyid $headids($n)}
887c996e
PM
10063 "T" {selbyid $tagids($n)}
10064 "o" {selbyid $otherrefids($n)}
10065 }
10066 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10067}
10068
10069proc unsel_reflist {} {
10070 global showrefstop
10071
10072 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10073 $showrefstop.list tag remove highlight 0.0 end
10074}
10075
10076proc reflistfilter_change {n1 n2 op} {
10077 global reflistfilter
10078
10079 after cancel refill_reflist
10080 after 200 refill_reflist
10081}
10082
10083proc refill_reflist {} {
10084 global reflist reflistfilter showrefstop headids tagids otherrefids
d375ef9b 10085 global curview
887c996e
PM
10086
10087 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10088 set refs {}
10089 foreach n [array names headids] {
10090 if {[string match $reflistfilter $n]} {
7fcc92bf 10091 if {[commitinview $headids($n) $curview]} {
d7cc4fb0
PW
10092 if {[string match "remotes/*" $n]} {
10093 lappend refs [list $n R]
10094 } else {
10095 lappend refs [list $n H]
10096 }
887c996e 10097 } else {
d375ef9b 10098 interestedin $headids($n) {run refill_reflist}
887c996e
PM
10099 }
10100 }
10101 }
10102 foreach n [array names tagids] {
10103 if {[string match $reflistfilter $n]} {
7fcc92bf 10104 if {[commitinview $tagids($n) $curview]} {
887c996e
PM
10105 lappend refs [list $n T]
10106 } else {
d375ef9b 10107 interestedin $tagids($n) {run refill_reflist}
887c996e
PM
10108 }
10109 }
10110 }
10111 foreach n [array names otherrefids] {
10112 if {[string match $reflistfilter $n]} {
7fcc92bf 10113 if {[commitinview $otherrefids($n) $curview]} {
887c996e
PM
10114 lappend refs [list $n o]
10115 } else {
d375ef9b 10116 interestedin $otherrefids($n) {run refill_reflist}
887c996e
PM
10117 }
10118 }
10119 }
10120 set refs [lsort -index 0 $refs]
10121 if {$refs eq $reflist} return
10122
10123 # Update the contents of $showrefstop.list according to the
10124 # differences between $reflist (old) and $refs (new)
10125 $showrefstop.list conf -state normal
10126 $showrefstop.list insert end "\n"
10127 set i 0
10128 set j 0
10129 while {$i < [llength $reflist] || $j < [llength $refs]} {
10130 if {$i < [llength $reflist]} {
10131 if {$j < [llength $refs]} {
10132 set cmp [string compare [lindex $reflist $i 0] \
10133 [lindex $refs $j 0]]
10134 if {$cmp == 0} {
10135 set cmp [string compare [lindex $reflist $i 1] \
10136 [lindex $refs $j 1]]
10137 }
10138 } else {
10139 set cmp -1
10140 }
10141 } else {
10142 set cmp 1
10143 }
10144 switch -- $cmp {
10145 -1 {
10146 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10147 incr i
10148 }
10149 0 {
10150 incr i
10151 incr j
10152 }
10153 1 {
10154 set l [expr {$j + 1}]
10155 $showrefstop.list image create $l.0 -align baseline \
10156 -image reficon-[lindex $refs $j 1] -padx 2
10157 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10158 incr j
10159 }
10160 }
10161 }
10162 set reflist $refs
10163 # delete last newline
10164 $showrefstop.list delete end-2c end-1c
10165 $showrefstop.list conf -state disabled
10299152
PM
10166}
10167
b8ab2e17
PM
10168# Stuff for finding nearby tags
10169proc getallcommits {} {
5cd15b6b
PM
10170 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10171 global idheads idtags idotherrefs allparents tagobjid
da616db5 10172 global gitdir
f1d83ba3 10173
a69b2d1a 10174 if {![info exists allcommits]} {
a69b2d1a
PM
10175 set nextarc 0
10176 set allcommits 0
10177 set seeds {}
5cd15b6b
PM
10178 set allcwait 0
10179 set cachedarcs 0
da616db5 10180 set allccache [file join $gitdir "gitk.cache"]
5cd15b6b
PM
10181 if {![catch {
10182 set f [open $allccache r]
10183 set allcwait 1
10184 getcache $f
10185 }]} return
a69b2d1a 10186 }
2d71bccc 10187
5cd15b6b
PM
10188 if {$allcwait} {
10189 return
10190 }
10191 set cmd [list | git rev-list --parents]
10192 set allcupdate [expr {$seeds ne {}}]
10193 if {!$allcupdate} {
10194 set ids "--all"
10195 } else {
10196 set refs [concat [array names idheads] [array names idtags] \
10197 [array names idotherrefs]]
10198 set ids {}
10199 set tagobjs {}
10200 foreach name [array names tagobjid] {
10201 lappend tagobjs $tagobjid($name)
10202 }
10203 foreach id [lsort -unique $refs] {
10204 if {![info exists allparents($id)] &&
10205 [lsearch -exact $tagobjs $id] < 0} {
10206 lappend ids $id
10207 }
10208 }
10209 if {$ids ne {}} {
10210 foreach id $seeds {
10211 lappend ids "^$id"
10212 }
10213 }
10214 }
10215 if {$ids ne {}} {
10216 set fd [open [concat $cmd $ids] r]
10217 fconfigure $fd -blocking 0
10218 incr allcommits
10219 nowbusy allcommits
10220 filerun $fd [list getallclines $fd]
10221 } else {
10222 dispneartags 0
2d71bccc 10223 }
e11f1233
PM
10224}
10225
10226# Since most commits have 1 parent and 1 child, we group strings of
10227# such commits into "arcs" joining branch/merge points (BMPs), which
10228# are commits that either don't have 1 parent or don't have 1 child.
10229#
10230# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10231# arcout(id) - outgoing arcs for BMP
10232# arcids(a) - list of IDs on arc including end but not start
10233# arcstart(a) - BMP ID at start of arc
10234# arcend(a) - BMP ID at end of arc
10235# growing(a) - arc a is still growing
10236# arctags(a) - IDs out of arcids (excluding end) that have tags
10237# archeads(a) - IDs out of arcids (excluding end) that have heads
10238# The start of an arc is at the descendent end, so "incoming" means
10239# coming from descendents, and "outgoing" means going towards ancestors.
10240
10241proc getallclines {fd} {
5cd15b6b 10242 global allparents allchildren idtags idheads nextarc
e11f1233 10243 global arcnos arcids arctags arcout arcend arcstart archeads growing
5cd15b6b 10244 global seeds allcommits cachedarcs allcupdate
d93f1713 10245
e11f1233 10246 set nid 0
7eb3cb9c 10247 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
e11f1233
PM
10248 set id [lindex $line 0]
10249 if {[info exists allparents($id)]} {
10250 # seen it already
10251 continue
10252 }
5cd15b6b 10253 set cachedarcs 0
e11f1233
PM
10254 set olds [lrange $line 1 end]
10255 set allparents($id) $olds
10256 if {![info exists allchildren($id)]} {
10257 set allchildren($id) {}
10258 set arcnos($id) {}
10259 lappend seeds $id
10260 } else {
10261 set a $arcnos($id)
10262 if {[llength $olds] == 1 && [llength $a] == 1} {
10263 lappend arcids($a) $id
10264 if {[info exists idtags($id)]} {
10265 lappend arctags($a) $id
b8ab2e17 10266 }
e11f1233
PM
10267 if {[info exists idheads($id)]} {
10268 lappend archeads($a) $id
10269 }
10270 if {[info exists allparents($olds)]} {
10271 # seen parent already
10272 if {![info exists arcout($olds)]} {
10273 splitarc $olds
10274 }
10275 lappend arcids($a) $olds
10276 set arcend($a) $olds
10277 unset growing($a)
10278 }
10279 lappend allchildren($olds) $id
10280 lappend arcnos($olds) $a
10281 continue
10282 }
10283 }
e11f1233
PM
10284 foreach a $arcnos($id) {
10285 lappend arcids($a) $id
10286 set arcend($a) $id
10287 unset growing($a)
10288 }
10289
10290 set ao {}
10291 foreach p $olds {
10292 lappend allchildren($p) $id
10293 set a [incr nextarc]
10294 set arcstart($a) $id
10295 set archeads($a) {}
10296 set arctags($a) {}
10297 set archeads($a) {}
10298 set arcids($a) {}
10299 lappend ao $a
10300 set growing($a) 1
10301 if {[info exists allparents($p)]} {
10302 # seen it already, may need to make a new branch
10303 if {![info exists arcout($p)]} {
10304 splitarc $p
10305 }
10306 lappend arcids($a) $p
10307 set arcend($a) $p
10308 unset growing($a)
10309 }
10310 lappend arcnos($p) $a
10311 }
10312 set arcout($id) $ao
f1d83ba3 10313 }
f3326b66
PM
10314 if {$nid > 0} {
10315 global cached_dheads cached_dtags cached_atags
009409fe
PM
10316 unset -nocomplain cached_dheads
10317 unset -nocomplain cached_dtags
10318 unset -nocomplain cached_atags
f3326b66 10319 }
7eb3cb9c
PM
10320 if {![eof $fd]} {
10321 return [expr {$nid >= 1000? 2: 1}]
10322 }
5cd15b6b
PM
10323 set cacheok 1
10324 if {[catch {
10325 fconfigure $fd -blocking 1
10326 close $fd
10327 } err]} {
10328 # got an error reading the list of commits
10329 # if we were updating, try rereading the whole thing again
10330 if {$allcupdate} {
10331 incr allcommits -1
10332 dropcache $err
10333 return
10334 }
d990cedf 10335 error_popup "[mc "Error reading commit topology information;\
5cd15b6b 10336 branch and preceding/following tag information\
d990cedf 10337 will be incomplete."]\n($err)"
5cd15b6b
PM
10338 set cacheok 0
10339 }
e11f1233
PM
10340 if {[incr allcommits -1] == 0} {
10341 notbusy allcommits
5cd15b6b
PM
10342 if {$cacheok} {
10343 run savecache
10344 }
e11f1233
PM
10345 }
10346 dispneartags 0
7eb3cb9c 10347 return 0
b8ab2e17
PM
10348}
10349
e11f1233
PM
10350proc recalcarc {a} {
10351 global arctags archeads arcids idtags idheads
b8ab2e17 10352
e11f1233
PM
10353 set at {}
10354 set ah {}
10355 foreach id [lrange $arcids($a) 0 end-1] {
10356 if {[info exists idtags($id)]} {
10357 lappend at $id
10358 }
10359 if {[info exists idheads($id)]} {
10360 lappend ah $id
b8ab2e17 10361 }
f1d83ba3 10362 }
e11f1233
PM
10363 set arctags($a) $at
10364 set archeads($a) $ah
b8ab2e17
PM
10365}
10366
e11f1233 10367proc splitarc {p} {
5cd15b6b 10368 global arcnos arcids nextarc arctags archeads idtags idheads
e11f1233 10369 global arcstart arcend arcout allparents growing
cec7bece 10370
e11f1233
PM
10371 set a $arcnos($p)
10372 if {[llength $a] != 1} {
10373 puts "oops splitarc called but [llength $a] arcs already"
10374 return
10375 }
10376 set a [lindex $a 0]
10377 set i [lsearch -exact $arcids($a) $p]
10378 if {$i < 0} {
10379 puts "oops splitarc $p not in arc $a"
10380 return
10381 }
10382 set na [incr nextarc]
10383 if {[info exists arcend($a)]} {
10384 set arcend($na) $arcend($a)
10385 } else {
10386 set l [lindex $allparents([lindex $arcids($a) end]) 0]
10387 set j [lsearch -exact $arcnos($l) $a]
10388 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10389 }
10390 set tail [lrange $arcids($a) [expr {$i+1}] end]
10391 set arcids($a) [lrange $arcids($a) 0 $i]
10392 set arcend($a) $p
10393 set arcstart($na) $p
10394 set arcout($p) $na
10395 set arcids($na) $tail
10396 if {[info exists growing($a)]} {
10397 set growing($na) 1
10398 unset growing($a)
10399 }
e11f1233
PM
10400
10401 foreach id $tail {
10402 if {[llength $arcnos($id)] == 1} {
10403 set arcnos($id) $na
cec7bece 10404 } else {
e11f1233
PM
10405 set j [lsearch -exact $arcnos($id) $a]
10406 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
cec7bece 10407 }
e11f1233
PM
10408 }
10409
10410 # reconstruct tags and heads lists
10411 if {$arctags($a) ne {} || $archeads($a) ne {}} {
10412 recalcarc $a
10413 recalcarc $na
10414 } else {
10415 set arctags($na) {}
10416 set archeads($na) {}
10417 }
10418}
10419
10420# Update things for a new commit added that is a child of one
10421# existing commit. Used when cherry-picking.
10422proc addnewchild {id p} {
5cd15b6b 10423 global allparents allchildren idtags nextarc
e11f1233 10424 global arcnos arcids arctags arcout arcend arcstart archeads growing
719c2b9d 10425 global seeds allcommits
e11f1233 10426
3ebba3c7 10427 if {![info exists allcommits] || ![info exists arcnos($p)]} return
e11f1233
PM
10428 set allparents($id) [list $p]
10429 set allchildren($id) {}
10430 set arcnos($id) {}
10431 lappend seeds $id
e11f1233
PM
10432 lappend allchildren($p) $id
10433 set a [incr nextarc]
10434 set arcstart($a) $id
10435 set archeads($a) {}
10436 set arctags($a) {}
10437 set arcids($a) [list $p]
10438 set arcend($a) $p
10439 if {![info exists arcout($p)]} {
10440 splitarc $p
10441 }
10442 lappend arcnos($p) $a
10443 set arcout($id) [list $a]
10444}
10445
5cd15b6b
PM
10446# This implements a cache for the topology information.
10447# The cache saves, for each arc, the start and end of the arc,
10448# the ids on the arc, and the outgoing arcs from the end.
10449proc readcache {f} {
10450 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10451 global idtags idheads allparents cachedarcs possible_seeds seeds growing
10452 global allcwait
10453
10454 set a $nextarc
10455 set lim $cachedarcs
10456 if {$lim - $a > 500} {
10457 set lim [expr {$a + 500}]
10458 }
10459 if {[catch {
10460 if {$a == $lim} {
10461 # finish reading the cache and setting up arctags, etc.
10462 set line [gets $f]
10463 if {$line ne "1"} {error "bad final version"}
10464 close $f
10465 foreach id [array names idtags] {
10466 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10467 [llength $allparents($id)] == 1} {
10468 set a [lindex $arcnos($id) 0]
10469 if {$arctags($a) eq {}} {
10470 recalcarc $a
10471 }
10472 }
10473 }
10474 foreach id [array names idheads] {
10475 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10476 [llength $allparents($id)] == 1} {
10477 set a [lindex $arcnos($id) 0]
10478 if {$archeads($a) eq {}} {
10479 recalcarc $a
10480 }
10481 }
10482 }
10483 foreach id [lsort -unique $possible_seeds] {
10484 if {$arcnos($id) eq {}} {
10485 lappend seeds $id
10486 }
10487 }
10488 set allcwait 0
10489 } else {
10490 while {[incr a] <= $lim} {
10491 set line [gets $f]
10492 if {[llength $line] != 3} {error "bad line"}
10493 set s [lindex $line 0]
10494 set arcstart($a) $s
10495 lappend arcout($s) $a
10496 if {![info exists arcnos($s)]} {
10497 lappend possible_seeds $s
10498 set arcnos($s) {}
10499 }
10500 set e [lindex $line 1]
10501 if {$e eq {}} {
10502 set growing($a) 1
10503 } else {
10504 set arcend($a) $e
10505 if {![info exists arcout($e)]} {
10506 set arcout($e) {}
10507 }
10508 }
10509 set arcids($a) [lindex $line 2]
10510 foreach id $arcids($a) {
10511 lappend allparents($s) $id
10512 set s $id
10513 lappend arcnos($id) $a
10514 }
10515 if {![info exists allparents($s)]} {
10516 set allparents($s) {}
10517 }
10518 set arctags($a) {}
10519 set archeads($a) {}
10520 }
10521 set nextarc [expr {$a - 1}]
10522 }
10523 } err]} {
10524 dropcache $err
10525 return 0
10526 }
10527 if {!$allcwait} {
10528 getallcommits
10529 }
10530 return $allcwait
10531}
10532
10533proc getcache {f} {
10534 global nextarc cachedarcs possible_seeds
10535
10536 if {[catch {
10537 set line [gets $f]
10538 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10539 # make sure it's an integer
10540 set cachedarcs [expr {int([lindex $line 1])}]
10541 if {$cachedarcs < 0} {error "bad number of arcs"}
10542 set nextarc 0
10543 set possible_seeds {}
10544 run readcache $f
10545 } err]} {
10546 dropcache $err
10547 }
10548 return 0
10549}
10550
10551proc dropcache {err} {
10552 global allcwait nextarc cachedarcs seeds
10553
10554 #puts "dropping cache ($err)"
10555 foreach v {arcnos arcout arcids arcstart arcend growing \
10556 arctags archeads allparents allchildren} {
10557 global $v
009409fe 10558 unset -nocomplain $v
5cd15b6b
PM
10559 }
10560 set allcwait 0
10561 set nextarc 0
10562 set cachedarcs 0
10563 set seeds {}
10564 getallcommits
10565}
10566
10567proc writecache {f} {
10568 global cachearc cachedarcs allccache
10569 global arcstart arcend arcnos arcids arcout
10570
10571 set a $cachearc
10572 set lim $cachedarcs
10573 if {$lim - $a > 1000} {
10574 set lim [expr {$a + 1000}]
10575 }
10576 if {[catch {
10577 while {[incr a] <= $lim} {
10578 if {[info exists arcend($a)]} {
10579 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10580 } else {
10581 puts $f [list $arcstart($a) {} $arcids($a)]
10582 }
10583 }
10584 } err]} {
10585 catch {close $f}
10586 catch {file delete $allccache}
10587 #puts "writing cache failed ($err)"
10588 return 0
10589 }
10590 set cachearc [expr {$a - 1}]
10591 if {$a > $cachedarcs} {
10592 puts $f "1"
10593 close $f
10594 return 0
10595 }
10596 return 1
10597}
10598
10599proc savecache {} {
10600 global nextarc cachedarcs cachearc allccache
10601
10602 if {$nextarc == $cachedarcs} return
10603 set cachearc 0
10604 set cachedarcs $nextarc
10605 catch {
10606 set f [open $allccache w]
10607 puts $f [list 1 $cachedarcs]
10608 run writecache $f
10609 }
10610}
10611
e11f1233
PM
10612# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10613# or 0 if neither is true.
10614proc anc_or_desc {a b} {
10615 global arcout arcstart arcend arcnos cached_isanc
10616
10617 if {$arcnos($a) eq $arcnos($b)} {
10618 # Both are on the same arc(s); either both are the same BMP,
10619 # or if one is not a BMP, the other is also not a BMP or is
10620 # the BMP at end of the arc (and it only has 1 incoming arc).
69c0b5d2
PM
10621 # Or both can be BMPs with no incoming arcs.
10622 if {$a eq $b || $arcnos($a) eq {}} {
e11f1233 10623 return 0
cec7bece 10624 }
e11f1233
PM
10625 # assert {[llength $arcnos($a)] == 1}
10626 set arc [lindex $arcnos($a) 0]
10627 set i [lsearch -exact $arcids($arc) $a]
10628 set j [lsearch -exact $arcids($arc) $b]
10629 if {$i < 0 || $i > $j} {
10630 return 1
10631 } else {
10632 return -1
cec7bece
PM
10633 }
10634 }
e11f1233
PM
10635
10636 if {![info exists arcout($a)]} {
10637 set arc [lindex $arcnos($a) 0]
10638 if {[info exists arcend($arc)]} {
10639 set aend $arcend($arc)
10640 } else {
10641 set aend {}
cec7bece 10642 }
e11f1233
PM
10643 set a $arcstart($arc)
10644 } else {
10645 set aend $a
10646 }
10647 if {![info exists arcout($b)]} {
10648 set arc [lindex $arcnos($b) 0]
10649 if {[info exists arcend($arc)]} {
10650 set bend $arcend($arc)
10651 } else {
10652 set bend {}
cec7bece 10653 }
e11f1233
PM
10654 set b $arcstart($arc)
10655 } else {
10656 set bend $b
cec7bece 10657 }
e11f1233
PM
10658 if {$a eq $bend} {
10659 return 1
10660 }
10661 if {$b eq $aend} {
10662 return -1
10663 }
10664 if {[info exists cached_isanc($a,$bend)]} {
10665 if {$cached_isanc($a,$bend)} {
10666 return 1
10667 }
10668 }
10669 if {[info exists cached_isanc($b,$aend)]} {
10670 if {$cached_isanc($b,$aend)} {
10671 return -1
10672 }
10673 if {[info exists cached_isanc($a,$bend)]} {
10674 return 0
10675 }
cec7bece 10676 }
cec7bece 10677
e11f1233
PM
10678 set todo [list $a $b]
10679 set anc($a) a
10680 set anc($b) b
10681 for {set i 0} {$i < [llength $todo]} {incr i} {
10682 set x [lindex $todo $i]
10683 if {$anc($x) eq {}} {
10684 continue
10685 }
10686 foreach arc $arcnos($x) {
10687 set xd $arcstart($arc)
10688 if {$xd eq $bend} {
10689 set cached_isanc($a,$bend) 1
10690 set cached_isanc($b,$aend) 0
10691 return 1
10692 } elseif {$xd eq $aend} {
10693 set cached_isanc($b,$aend) 1
10694 set cached_isanc($a,$bend) 0
10695 return -1
10696 }
10697 if {![info exists anc($xd)]} {
10698 set anc($xd) $anc($x)
10699 lappend todo $xd
10700 } elseif {$anc($xd) ne $anc($x)} {
10701 set anc($xd) {}
10702 }
10703 }
10704 }
10705 set cached_isanc($a,$bend) 0
10706 set cached_isanc($b,$aend) 0
10707 return 0
10708}
b8ab2e17 10709
e11f1233
PM
10710# This identifies whether $desc has an ancestor that is
10711# a growing tip of the graph and which is not an ancestor of $anc
10712# and returns 0 if so and 1 if not.
10713# If we subsequently discover a tag on such a growing tip, and that
10714# turns out to be a descendent of $anc (which it could, since we
10715# don't necessarily see children before parents), then $desc
10716# isn't a good choice to display as a descendent tag of
10717# $anc (since it is the descendent of another tag which is
10718# a descendent of $anc). Similarly, $anc isn't a good choice to
10719# display as a ancestor tag of $desc.
10720#
10721proc is_certain {desc anc} {
10722 global arcnos arcout arcstart arcend growing problems
10723
10724 set certain {}
10725 if {[llength $arcnos($anc)] == 1} {
10726 # tags on the same arc are certain
10727 if {$arcnos($desc) eq $arcnos($anc)} {
10728 return 1
b8ab2e17 10729 }
e11f1233
PM
10730 if {![info exists arcout($anc)]} {
10731 # if $anc is partway along an arc, use the start of the arc instead
10732 set a [lindex $arcnos($anc) 0]
10733 set anc $arcstart($a)
b8ab2e17 10734 }
e11f1233
PM
10735 }
10736 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10737 set x $desc
10738 } else {
10739 set a [lindex $arcnos($desc) 0]
10740 set x $arcend($a)
10741 }
10742 if {$x == $anc} {
10743 return 1
10744 }
10745 set anclist [list $x]
10746 set dl($x) 1
10747 set nnh 1
10748 set ngrowanc 0
10749 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10750 set x [lindex $anclist $i]
10751 if {$dl($x)} {
10752 incr nnh -1
10753 }
10754 set done($x) 1
10755 foreach a $arcout($x) {
10756 if {[info exists growing($a)]} {
10757 if {![info exists growanc($x)] && $dl($x)} {
10758 set growanc($x) 1
10759 incr ngrowanc
10760 }
10761 } else {
10762 set y $arcend($a)
10763 if {[info exists dl($y)]} {
10764 if {$dl($y)} {
10765 if {!$dl($x)} {
10766 set dl($y) 0
10767 if {![info exists done($y)]} {
10768 incr nnh -1
10769 }
10770 if {[info exists growanc($x)]} {
10771 incr ngrowanc -1
10772 }
10773 set xl [list $y]
10774 for {set k 0} {$k < [llength $xl]} {incr k} {
10775 set z [lindex $xl $k]
10776 foreach c $arcout($z) {
10777 if {[info exists arcend($c)]} {
10778 set v $arcend($c)
10779 if {[info exists dl($v)] && $dl($v)} {
10780 set dl($v) 0
10781 if {![info exists done($v)]} {
10782 incr nnh -1
10783 }
10784 if {[info exists growanc($v)]} {
10785 incr ngrowanc -1
10786 }
10787 lappend xl $v
10788 }
10789 }
10790 }
10791 }
10792 }
10793 }
10794 } elseif {$y eq $anc || !$dl($x)} {
10795 set dl($y) 0
10796 lappend anclist $y
10797 } else {
10798 set dl($y) 1
10799 lappend anclist $y
10800 incr nnh
10801 }
10802 }
b8ab2e17
PM
10803 }
10804 }
e11f1233
PM
10805 foreach x [array names growanc] {
10806 if {$dl($x)} {
10807 return 0
b8ab2e17 10808 }
7eb3cb9c 10809 return 0
b8ab2e17 10810 }
e11f1233 10811 return 1
b8ab2e17
PM
10812}
10813
e11f1233
PM
10814proc validate_arctags {a} {
10815 global arctags idtags
b8ab2e17 10816
e11f1233
PM
10817 set i -1
10818 set na $arctags($a)
10819 foreach id $arctags($a) {
10820 incr i
10821 if {![info exists idtags($id)]} {
10822 set na [lreplace $na $i $i]
10823 incr i -1
10824 }
10825 }
10826 set arctags($a) $na
10827}
10828
10829proc validate_archeads {a} {
10830 global archeads idheads
10831
10832 set i -1
10833 set na $archeads($a)
10834 foreach id $archeads($a) {
10835 incr i
10836 if {![info exists idheads($id)]} {
10837 set na [lreplace $na $i $i]
10838 incr i -1
10839 }
10840 }
10841 set archeads($a) $na
10842}
10843
10844# Return the list of IDs that have tags that are descendents of id,
10845# ignoring IDs that are descendents of IDs already reported.
10846proc desctags {id} {
10847 global arcnos arcstart arcids arctags idtags allparents
10848 global growing cached_dtags
10849
10850 if {![info exists allparents($id)]} {
10851 return {}
10852 }
10853 set t1 [clock clicks -milliseconds]
10854 set argid $id
10855 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10856 # part-way along an arc; check that arc first
10857 set a [lindex $arcnos($id) 0]
10858 if {$arctags($a) ne {}} {
10859 validate_arctags $a
10860 set i [lsearch -exact $arcids($a) $id]
10861 set tid {}
10862 foreach t $arctags($a) {
10863 set j [lsearch -exact $arcids($a) $t]
10864 if {$j >= $i} break
10865 set tid $t
b8ab2e17 10866 }
e11f1233
PM
10867 if {$tid ne {}} {
10868 return $tid
b8ab2e17
PM
10869 }
10870 }
e11f1233
PM
10871 set id $arcstart($a)
10872 if {[info exists idtags($id)]} {
10873 return $id
10874 }
10875 }
10876 if {[info exists cached_dtags($id)]} {
10877 return $cached_dtags($id)
10878 }
10879
10880 set origid $id
10881 set todo [list $id]
10882 set queued($id) 1
10883 set nc 1
10884 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10885 set id [lindex $todo $i]
10886 set done($id) 1
10887 set ta [info exists hastaggedancestor($id)]
10888 if {!$ta} {
10889 incr nc -1
10890 }
10891 # ignore tags on starting node
10892 if {!$ta && $i > 0} {
10893 if {[info exists idtags($id)]} {
10894 set tagloc($id) $id
10895 set ta 1
10896 } elseif {[info exists cached_dtags($id)]} {
10897 set tagloc($id) $cached_dtags($id)
10898 set ta 1
10899 }
10900 }
10901 foreach a $arcnos($id) {
10902 set d $arcstart($a)
10903 if {!$ta && $arctags($a) ne {}} {
10904 validate_arctags $a
10905 if {$arctags($a) ne {}} {
10906 lappend tagloc($id) [lindex $arctags($a) end]
10907 }
10908 }
10909 if {$ta || $arctags($a) ne {}} {
10910 set tomark [list $d]
10911 for {set j 0} {$j < [llength $tomark]} {incr j} {
10912 set dd [lindex $tomark $j]
10913 if {![info exists hastaggedancestor($dd)]} {
10914 if {[info exists done($dd)]} {
10915 foreach b $arcnos($dd) {
10916 lappend tomark $arcstart($b)
10917 }
10918 if {[info exists tagloc($dd)]} {
10919 unset tagloc($dd)
10920 }
10921 } elseif {[info exists queued($dd)]} {
10922 incr nc -1
10923 }
10924 set hastaggedancestor($dd) 1
10925 }
10926 }
10927 }
10928 if {![info exists queued($d)]} {
10929 lappend todo $d
10930 set queued($d) 1
10931 if {![info exists hastaggedancestor($d)]} {
10932 incr nc
10933 }
10934 }
b8ab2e17 10935 }
f1d83ba3 10936 }
e11f1233
PM
10937 set tags {}
10938 foreach id [array names tagloc] {
10939 if {![info exists hastaggedancestor($id)]} {
10940 foreach t $tagloc($id) {
10941 if {[lsearch -exact $tags $t] < 0} {
10942 lappend tags $t
10943 }
10944 }
10945 }
10946 }
10947 set t2 [clock clicks -milliseconds]
10948 set loopix $i
f1d83ba3 10949
e11f1233
PM
10950 # remove tags that are descendents of other tags
10951 for {set i 0} {$i < [llength $tags]} {incr i} {
10952 set a [lindex $tags $i]
10953 for {set j 0} {$j < $i} {incr j} {
10954 set b [lindex $tags $j]
10955 set r [anc_or_desc $a $b]
10956 if {$r == 1} {
10957 set tags [lreplace $tags $j $j]
10958 incr j -1
10959 incr i -1
10960 } elseif {$r == -1} {
10961 set tags [lreplace $tags $i $i]
10962 incr i -1
10963 break
ceadfe90
PM
10964 }
10965 }
10966 }
10967
e11f1233
PM
10968 if {[array names growing] ne {}} {
10969 # graph isn't finished, need to check if any tag could get
10970 # eclipsed by another tag coming later. Simply ignore any
10971 # tags that could later get eclipsed.
10972 set ctags {}
10973 foreach t $tags {
10974 if {[is_certain $t $origid]} {
10975 lappend ctags $t
10976 }
ceadfe90 10977 }
e11f1233
PM
10978 if {$tags eq $ctags} {
10979 set cached_dtags($origid) $tags
10980 } else {
10981 set tags $ctags
ceadfe90 10982 }
e11f1233
PM
10983 } else {
10984 set cached_dtags($origid) $tags
10985 }
10986 set t3 [clock clicks -milliseconds]
10987 if {0 && $t3 - $t1 >= 100} {
10988 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10989 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
ceadfe90 10990 }
e11f1233
PM
10991 return $tags
10992}
ceadfe90 10993
e11f1233
PM
10994proc anctags {id} {
10995 global arcnos arcids arcout arcend arctags idtags allparents
10996 global growing cached_atags
10997
10998 if {![info exists allparents($id)]} {
10999 return {}
11000 }
11001 set t1 [clock clicks -milliseconds]
11002 set argid $id
11003 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
11004 # part-way along an arc; check that arc first
11005 set a [lindex $arcnos($id) 0]
11006 if {$arctags($a) ne {}} {
11007 validate_arctags $a
11008 set i [lsearch -exact $arcids($a) $id]
11009 foreach t $arctags($a) {
11010 set j [lsearch -exact $arcids($a) $t]
11011 if {$j > $i} {
11012 return $t
11013 }
11014 }
ceadfe90 11015 }
e11f1233
PM
11016 if {![info exists arcend($a)]} {
11017 return {}
11018 }
11019 set id $arcend($a)
11020 if {[info exists idtags($id)]} {
11021 return $id
11022 }
11023 }
11024 if {[info exists cached_atags($id)]} {
11025 return $cached_atags($id)
11026 }
11027
11028 set origid $id
11029 set todo [list $id]
11030 set queued($id) 1
11031 set taglist {}
11032 set nc 1
11033 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
11034 set id [lindex $todo $i]
11035 set done($id) 1
11036 set td [info exists hastaggeddescendent($id)]
11037 if {!$td} {
11038 incr nc -1
11039 }
11040 # ignore tags on starting node
11041 if {!$td && $i > 0} {
11042 if {[info exists idtags($id)]} {
11043 set tagloc($id) $id
11044 set td 1
11045 } elseif {[info exists cached_atags($id)]} {
11046 set tagloc($id) $cached_atags($id)
11047 set td 1
11048 }
11049 }
11050 foreach a $arcout($id) {
11051 if {!$td && $arctags($a) ne {}} {
11052 validate_arctags $a
11053 if {$arctags($a) ne {}} {
11054 lappend tagloc($id) [lindex $arctags($a) 0]
11055 }
11056 }
11057 if {![info exists arcend($a)]} continue
11058 set d $arcend($a)
11059 if {$td || $arctags($a) ne {}} {
11060 set tomark [list $d]
11061 for {set j 0} {$j < [llength $tomark]} {incr j} {
11062 set dd [lindex $tomark $j]
11063 if {![info exists hastaggeddescendent($dd)]} {
11064 if {[info exists done($dd)]} {
11065 foreach b $arcout($dd) {
11066 if {[info exists arcend($b)]} {
11067 lappend tomark $arcend($b)
11068 }
11069 }
11070 if {[info exists tagloc($dd)]} {
11071 unset tagloc($dd)
11072 }
11073 } elseif {[info exists queued($dd)]} {
11074 incr nc -1
11075 }
11076 set hastaggeddescendent($dd) 1
11077 }
11078 }
11079 }
11080 if {![info exists queued($d)]} {
11081 lappend todo $d
11082 set queued($d) 1
11083 if {![info exists hastaggeddescendent($d)]} {
11084 incr nc
11085 }
11086 }
11087 }
11088 }
11089 set t2 [clock clicks -milliseconds]
11090 set loopix $i
11091 set tags {}
11092 foreach id [array names tagloc] {
11093 if {![info exists hastaggeddescendent($id)]} {
11094 foreach t $tagloc($id) {
11095 if {[lsearch -exact $tags $t] < 0} {
11096 lappend tags $t
11097 }
11098 }
ceadfe90
PM
11099 }
11100 }
ceadfe90 11101
e11f1233
PM
11102 # remove tags that are ancestors of other tags
11103 for {set i 0} {$i < [llength $tags]} {incr i} {
11104 set a [lindex $tags $i]
11105 for {set j 0} {$j < $i} {incr j} {
11106 set b [lindex $tags $j]
11107 set r [anc_or_desc $a $b]
11108 if {$r == -1} {
11109 set tags [lreplace $tags $j $j]
11110 incr j -1
11111 incr i -1
11112 } elseif {$r == 1} {
11113 set tags [lreplace $tags $i $i]
11114 incr i -1
11115 break
11116 }
11117 }
11118 }
11119
11120 if {[array names growing] ne {}} {
11121 # graph isn't finished, need to check if any tag could get
11122 # eclipsed by another tag coming later. Simply ignore any
11123 # tags that could later get eclipsed.
11124 set ctags {}
11125 foreach t $tags {
11126 if {[is_certain $origid $t]} {
11127 lappend ctags $t
11128 }
11129 }
11130 if {$tags eq $ctags} {
11131 set cached_atags($origid) $tags
11132 } else {
11133 set tags $ctags
d6ac1a86 11134 }
e11f1233
PM
11135 } else {
11136 set cached_atags($origid) $tags
11137 }
11138 set t3 [clock clicks -milliseconds]
11139 if {0 && $t3 - $t1 >= 100} {
11140 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11141 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
d6ac1a86 11142 }
e11f1233 11143 return $tags
d6ac1a86
PM
11144}
11145
e11f1233
PM
11146# Return the list of IDs that have heads that are descendents of id,
11147# including id itself if it has a head.
11148proc descheads {id} {
11149 global arcnos arcstart arcids archeads idheads cached_dheads
d809fb17 11150 global allparents arcout
ca6d8f58 11151
e11f1233
PM
11152 if {![info exists allparents($id)]} {
11153 return {}
11154 }
f3326b66 11155 set aret {}
d809fb17 11156 if {![info exists arcout($id)]} {
e11f1233
PM
11157 # part-way along an arc; check it first
11158 set a [lindex $arcnos($id) 0]
11159 if {$archeads($a) ne {}} {
11160 validate_archeads $a
11161 set i [lsearch -exact $arcids($a) $id]
11162 foreach t $archeads($a) {
11163 set j [lsearch -exact $arcids($a) $t]
11164 if {$j > $i} break
f3326b66 11165 lappend aret $t
e11f1233 11166 }
ca6d8f58 11167 }
e11f1233 11168 set id $arcstart($a)
ca6d8f58 11169 }
e11f1233
PM
11170 set origid $id
11171 set todo [list $id]
11172 set seen($id) 1
f3326b66 11173 set ret {}
e11f1233
PM
11174 for {set i 0} {$i < [llength $todo]} {incr i} {
11175 set id [lindex $todo $i]
11176 if {[info exists cached_dheads($id)]} {
11177 set ret [concat $ret $cached_dheads($id)]
11178 } else {
11179 if {[info exists idheads($id)]} {
11180 lappend ret $id
11181 }
11182 foreach a $arcnos($id) {
11183 if {$archeads($a) ne {}} {
706d6c3e
PM
11184 validate_archeads $a
11185 if {$archeads($a) ne {}} {
11186 set ret [concat $ret $archeads($a)]
11187 }
e11f1233
PM
11188 }
11189 set d $arcstart($a)
11190 if {![info exists seen($d)]} {
11191 lappend todo $d
11192 set seen($d) 1
11193 }
11194 }
10299152 11195 }
10299152 11196 }
e11f1233
PM
11197 set ret [lsort -unique $ret]
11198 set cached_dheads($origid) $ret
f3326b66 11199 return [concat $ret $aret]
10299152
PM
11200}
11201
e11f1233
PM
11202proc addedtag {id} {
11203 global arcnos arcout cached_dtags cached_atags
ca6d8f58 11204
e11f1233
PM
11205 if {![info exists arcnos($id)]} return
11206 if {![info exists arcout($id)]} {
11207 recalcarc [lindex $arcnos($id) 0]
ca6d8f58 11208 }
009409fe
PM
11209 unset -nocomplain cached_dtags
11210 unset -nocomplain cached_atags
ca6d8f58
PM
11211}
11212
e11f1233
PM
11213proc addedhead {hid head} {
11214 global arcnos arcout cached_dheads
11215
11216 if {![info exists arcnos($hid)]} return
11217 if {![info exists arcout($hid)]} {
11218 recalcarc [lindex $arcnos($hid) 0]
11219 }
009409fe 11220 unset -nocomplain cached_dheads
e11f1233
PM
11221}
11222
11223proc removedhead {hid head} {
11224 global cached_dheads
11225
009409fe 11226 unset -nocomplain cached_dheads
e11f1233
PM
11227}
11228
11229proc movedhead {hid head} {
11230 global arcnos arcout cached_dheads
cec7bece 11231
e11f1233
PM
11232 if {![info exists arcnos($hid)]} return
11233 if {![info exists arcout($hid)]} {
11234 recalcarc [lindex $arcnos($hid) 0]
cec7bece 11235 }
009409fe 11236 unset -nocomplain cached_dheads
e11f1233
PM
11237}
11238
11239proc changedrefs {} {
587277fe 11240 global cached_dheads cached_dtags cached_atags cached_tagcontent
e11f1233
PM
11241 global arctags archeads arcnos arcout idheads idtags
11242
11243 foreach id [concat [array names idheads] [array names idtags]] {
11244 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11245 set a [lindex $arcnos($id) 0]
11246 if {![info exists donearc($a)]} {
11247 recalcarc $a
11248 set donearc($a) 1
11249 }
cec7bece
PM
11250 }
11251 }
009409fe
PM
11252 unset -nocomplain cached_tagcontent
11253 unset -nocomplain cached_dtags
11254 unset -nocomplain cached_atags
11255 unset -nocomplain cached_dheads
cec7bece
PM
11256}
11257
f1d83ba3 11258proc rereadrefs {} {
fc2a256f 11259 global idtags idheads idotherrefs mainheadid
f1d83ba3
PM
11260
11261 set refids [concat [array names idtags] \
11262 [array names idheads] [array names idotherrefs]]
11263 foreach id $refids {
11264 if {![info exists ref($id)]} {
11265 set ref($id) [listrefs $id]
11266 }
11267 }
fc2a256f 11268 set oldmainhead $mainheadid
f1d83ba3 11269 readrefs
cec7bece 11270 changedrefs
f1d83ba3
PM
11271 set refids [lsort -unique [concat $refids [array names idtags] \
11272 [array names idheads] [array names idotherrefs]]]
11273 foreach id $refids {
11274 set v [listrefs $id]
c11ff120 11275 if {![info exists ref($id)] || $ref($id) != $v} {
f1d83ba3
PM
11276 redrawtags $id
11277 }
11278 }
c11ff120
PM
11279 if {$oldmainhead ne $mainheadid} {
11280 redrawtags $oldmainhead
11281 redrawtags $mainheadid
11282 }
887c996e 11283 run refill_reflist
f1d83ba3
PM
11284}
11285
2e1ded44
JH
11286proc listrefs {id} {
11287 global idtags idheads idotherrefs
11288
11289 set x {}
11290 if {[info exists idtags($id)]} {
11291 set x $idtags($id)
11292 }
11293 set y {}
11294 if {[info exists idheads($id)]} {
11295 set y $idheads($id)
11296 }
11297 set z {}
11298 if {[info exists idotherrefs($id)]} {
11299 set z $idotherrefs($id)
11300 }
11301 return [list $x $y $z]
11302}
11303
4399fe33
PM
11304proc add_tag_ctext {tag} {
11305 global ctext cached_tagcontent tagids
11306
11307 if {![info exists cached_tagcontent($tag)]} {
11308 catch {
11309 set cached_tagcontent($tag) [exec git cat-file -p $tag]
11310 }
11311 }
11312 $ctext insert end "[mc "Tag"]: $tag\n" bold
11313 if {[info exists cached_tagcontent($tag)]} {
11314 set text $cached_tagcontent($tag)
11315 } else {
11316 set text "[mc "Id"]: $tagids($tag)"
11317 }
11318 appendwithlinks $text {}
11319}
11320
106288cb 11321proc showtag {tag isnew} {
587277fe 11322 global ctext cached_tagcontent tagids linknum tagobjid
106288cb
PM
11323
11324 if {$isnew} {
354af6bd 11325 addtohistory [list showtag $tag 0] savectextpos
106288cb
PM
11326 }
11327 $ctext conf -state normal
3ea06f9f 11328 clear_ctext
32f1b3e4 11329 settabs 0
106288cb 11330 set linknum 0
4399fe33
PM
11331 add_tag_ctext $tag
11332 maybe_scroll_ctext 1
11333 $ctext conf -state disabled
11334 init_flist {}
11335}
11336
11337proc showtags {id isnew} {
11338 global idtags ctext linknum
11339
11340 if {$isnew} {
11341 addtohistory [list showtags $id 0] savectextpos
62d3ea65 11342 }
4399fe33
PM
11343 $ctext conf -state normal
11344 clear_ctext
11345 settabs 0
11346 set linknum 0
11347 set sep {}
11348 foreach tag $idtags($id) {
11349 $ctext insert end $sep
11350 add_tag_ctext $tag
11351 set sep "\n\n"
106288cb 11352 }
a80e82f6 11353 maybe_scroll_ctext 1
106288cb 11354 $ctext conf -state disabled
7fcceed7 11355 init_flist {}
106288cb
PM
11356}
11357
1d10f36d
PM
11358proc doquit {} {
11359 global stopped
314f5de1
TA
11360 global gitktmpdir
11361
1d10f36d 11362 set stopped 100
b6047c5a 11363 savestuff .
1d10f36d 11364 destroy .
314f5de1
TA
11365
11366 if {[info exists gitktmpdir]} {
11367 catch {file delete -force $gitktmpdir}
11368 }
1d10f36d 11369}
1db95b00 11370
9a7558f3 11371proc mkfontdisp {font top which} {
d93f1713 11372 global fontattr fontpref $font NS use_ttk
9a7558f3
PM
11373
11374 set fontpref($font) [set $font]
d93f1713 11375 ${NS}::button $top.${font}but -text $which \
9a7558f3 11376 -command [list choosefont $font $which]
d93f1713 11377 ${NS}::label $top.$font -relief flat -font $font \
9a7558f3
PM
11378 -text $fontattr($font,family) -justify left
11379 grid x $top.${font}but $top.$font -sticky w
11380}
11381
11382proc choosefont {font which} {
11383 global fontparam fontlist fonttop fontattr
d93f1713 11384 global prefstop NS
9a7558f3
PM
11385
11386 set fontparam(which) $which
11387 set fontparam(font) $font
11388 set fontparam(family) [font actual $font -family]
11389 set fontparam(size) $fontattr($font,size)
11390 set fontparam(weight) $fontattr($font,weight)
11391 set fontparam(slant) $fontattr($font,slant)
11392 set top .gitkfont
11393 set fonttop $top
11394 if {![winfo exists $top]} {
11395 font create sample
11396 eval font config sample [font actual $font]
d93f1713 11397 ttk_toplevel $top
e7d64008 11398 make_transient $top $prefstop
d990cedf 11399 wm title $top [mc "Gitk font chooser"]
d93f1713 11400 ${NS}::label $top.l -textvariable fontparam(which)
9a7558f3
PM
11401 pack $top.l -side top
11402 set fontlist [lsort [font families]]
d93f1713 11403 ${NS}::frame $top.f
9a7558f3
PM
11404 listbox $top.f.fam -listvariable fontlist \
11405 -yscrollcommand [list $top.f.sb set]
11406 bind $top.f.fam <<ListboxSelect>> selfontfam
d93f1713 11407 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
9a7558f3
PM
11408 pack $top.f.sb -side right -fill y
11409 pack $top.f.fam -side left -fill both -expand 1
11410 pack $top.f -side top -fill both -expand 1
d93f1713 11411 ${NS}::frame $top.g
9a7558f3
PM
11412 spinbox $top.g.size -from 4 -to 40 -width 4 \
11413 -textvariable fontparam(size) \
11414 -validatecommand {string is integer -strict %s}
11415 checkbutton $top.g.bold -padx 5 \
d990cedf 11416 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9a7558f3
PM
11417 -variable fontparam(weight) -onvalue bold -offvalue normal
11418 checkbutton $top.g.ital -padx 5 \
d990cedf 11419 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9a7558f3
PM
11420 -variable fontparam(slant) -onvalue italic -offvalue roman
11421 pack $top.g.size $top.g.bold $top.g.ital -side left
11422 pack $top.g -side top
11423 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11424 -background white
11425 $top.c create text 100 25 -anchor center -text $which -font sample \
11426 -fill black -tags text
11427 bind $top.c <Configure> [list centertext $top.c]
11428 pack $top.c -side top -fill x
d93f1713
PT
11429 ${NS}::frame $top.buts
11430 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11431 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
76f15947
AG
11432 bind $top <Key-Return> fontok
11433 bind $top <Key-Escape> fontcan
9a7558f3
PM
11434 grid $top.buts.ok $top.buts.can
11435 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11436 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11437 pack $top.buts -side bottom -fill x
11438 trace add variable fontparam write chg_fontparam
11439 } else {
11440 raise $top
11441 $top.c itemconf text -text $which
11442 }
11443 set i [lsearch -exact $fontlist $fontparam(family)]
11444 if {$i >= 0} {
11445 $top.f.fam selection set $i
11446 $top.f.fam see $i
11447 }
11448}
11449
11450proc centertext {w} {
11451 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11452}
11453
11454proc fontok {} {
11455 global fontparam fontpref prefstop
11456
11457 set f $fontparam(font)
11458 set fontpref($f) [list $fontparam(family) $fontparam(size)]
11459 if {$fontparam(weight) eq "bold"} {
11460 lappend fontpref($f) "bold"
11461 }
11462 if {$fontparam(slant) eq "italic"} {
11463 lappend fontpref($f) "italic"
11464 }
39ddf99c 11465 set w $prefstop.notebook.fonts.$f
9a7558f3 11466 $w conf -text $fontparam(family) -font $fontpref($f)
d93f1713 11467
9a7558f3
PM
11468 fontcan
11469}
11470
11471proc fontcan {} {
11472 global fonttop fontparam
11473
11474 if {[info exists fonttop]} {
11475 catch {destroy $fonttop}
11476 catch {font delete sample}
11477 unset fonttop
11478 unset fontparam
11479 }
11480}
11481
d93f1713
PT
11482if {[package vsatisfies [package provide Tk] 8.6]} {
11483 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11484 # function to make use of it.
11485 proc choosefont {font which} {
11486 tk fontchooser configure -title $which -font $font \
11487 -command [list on_choosefont $font $which]
11488 tk fontchooser show
11489 }
11490 proc on_choosefont {font which newfont} {
11491 global fontparam
11492 puts stderr "$font $newfont"
11493 array set f [font actual $newfont]
11494 set fontparam(which) $which
11495 set fontparam(font) $font
11496 set fontparam(family) $f(-family)
11497 set fontparam(size) $f(-size)
11498 set fontparam(weight) $f(-weight)
11499 set fontparam(slant) $f(-slant)
11500 fontok
11501 }
11502}
11503
9a7558f3
PM
11504proc selfontfam {} {
11505 global fonttop fontparam
11506
11507 set i [$fonttop.f.fam curselection]
11508 if {$i ne {}} {
11509 set fontparam(family) [$fonttop.f.fam get $i]
11510 }
11511}
11512
11513proc chg_fontparam {v sub op} {
11514 global fontparam
11515
11516 font config sample -$sub $fontparam($sub)
11517}
11518
44acce0b
PT
11519# Create a property sheet tab page
11520proc create_prefs_page {w} {
11521 global NS
11522 set parent [join [lrange [split $w .] 0 end-1] .]
11523 if {[winfo class $parent] eq "TNotebook"} {
11524 ${NS}::frame $w
11525 } else {
11526 ${NS}::labelframe $w
11527 }
11528}
11529
11530proc prefspage_general {notebook} {
11531 global NS maxwidth maxgraphpct showneartags showlocalchanges
11532 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
3441de5b 11533 global hideremotes want_ttk have_ttk maxrefs web_browser
44acce0b
PT
11534
11535 set page [create_prefs_page $notebook.general]
11536
11537 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11538 grid $page.ldisp - -sticky w -pady 10
11539 ${NS}::label $page.spacer -text " "
11540 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11541 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11542 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
8a1692f6 11543 #xgettext:no-tcl-format
44acce0b
PT
11544 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11545 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11546 grid x $page.maxpctl $page.maxpct -sticky w
11547 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11548 -variable showlocalchanges
11549 grid x $page.showlocal -sticky w
11550 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11551 -variable autoselect
11552 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11553 grid x $page.autoselect $page.autosellen -sticky w
11554 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11555 -variable hideremotes
11556 grid x $page.hideremotes -sticky w
11557
11558 ${NS}::label $page.ddisp -text [mc "Diff display options"]
11559 grid $page.ddisp - -sticky w -pady 10
11560 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11561 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11562 grid x $page.tabstopl $page.tabstop -sticky w
d34835c9 11563 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
44acce0b
PT
11564 -variable showneartags
11565 grid x $page.ntag -sticky w
d34835c9
PM
11566 ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11567 spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11568 grid x $page.maxrefsl $page.maxrefs -sticky w
44acce0b
PT
11569 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11570 -variable limitdiffs
11571 grid x $page.ldiff -sticky w
11572 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11573 -variable perfile_attrs
11574 grid x $page.lattr -sticky w
11575
11576 ${NS}::entry $page.extdifft -textvariable extdifftool
11577 ${NS}::frame $page.extdifff
11578 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11579 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11580 pack $page.extdifff.l $page.extdifff.b -side left
11581 pack configure $page.extdifff.l -padx 10
11582 grid x $page.extdifff $page.extdifft -sticky ew
11583
3441de5b
PM
11584 ${NS}::entry $page.webbrowser -textvariable web_browser
11585 ${NS}::frame $page.webbrowserf
11586 ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11587 pack $page.webbrowserf.l -side left
11588 pack configure $page.webbrowserf.l -padx 10
11589 grid x $page.webbrowserf $page.webbrowser -sticky ew
11590
44acce0b
PT
11591 ${NS}::label $page.lgen -text [mc "General options"]
11592 grid $page.lgen - -sticky w -pady 10
11593 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11594 -text [mc "Use themed widgets"]
11595 if {$have_ttk} {
11596 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11597 } else {
11598 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11599 }
11600 grid x $page.want_ttk $page.ttk_note -sticky w
11601 return $page
11602}
11603
11604proc prefspage_colors {notebook} {
11605 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11606
11607 set page [create_prefs_page $notebook.colors]
11608
11609 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11610 grid $page.cdisp - -sticky w -pady 10
11611 label $page.ui -padx 40 -relief sunk -background $uicolor
11612 ${NS}::button $page.uibut -text [mc "Interface"] \
11613 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11614 grid x $page.uibut $page.ui -sticky w
11615 label $page.bg -padx 40 -relief sunk -background $bgcolor
11616 ${NS}::button $page.bgbut -text [mc "Background"] \
11617 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11618 grid x $page.bgbut $page.bg -sticky w
11619 label $page.fg -padx 40 -relief sunk -background $fgcolor
11620 ${NS}::button $page.fgbut -text [mc "Foreground"] \
11621 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11622 grid x $page.fgbut $page.fg -sticky w
11623 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11624 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11625 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11626 [list $ctext tag conf d0 -foreground]]
11627 grid x $page.diffoldbut $page.diffold -sticky w
11628 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11629 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11630 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11631 [list $ctext tag conf dresult -foreground]]
11632 grid x $page.diffnewbut $page.diffnew -sticky w
11633 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11634 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11635 -command [list choosecolor diffcolors 2 $page.hunksep \
11636 [mc "diff hunk header"] \
11637 [list $ctext tag conf hunksep -foreground]]
11638 grid x $page.hunksepbut $page.hunksep -sticky w
11639 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11640 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11641 -command [list choosecolor markbgcolor {} $page.markbgsep \
11642 [mc "marked line background"] \
11643 [list $ctext tag conf omark -background]]
11644 grid x $page.markbgbut $page.markbgsep -sticky w
11645 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11646 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11647 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11648 grid x $page.selbgbut $page.selbgsep -sticky w
11649 return $page
11650}
11651
11652proc prefspage_fonts {notebook} {
11653 global NS
11654 set page [create_prefs_page $notebook.fonts]
11655 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11656 grid $page.cfont - -sticky w -pady 10
11657 mkfontdisp mainfont $page [mc "Main font"]
11658 mkfontdisp textfont $page [mc "Diff display font"]
11659 mkfontdisp uifont $page [mc "User interface font"]
11660 return $page
11661}
11662
712fcc08 11663proc doprefs {} {
d93f1713 11664 global maxwidth maxgraphpct use_ttk NS
219ea3a9 11665 global oldprefs prefstop showneartags showlocalchanges
5497f7a2 11666 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
21ac8a8d 11667 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
0cc08ff7 11668 global hideremotes want_ttk have_ttk
232475d3 11669
712fcc08
PM
11670 set top .gitkprefs
11671 set prefstop $top
11672 if {[winfo exists $top]} {
11673 raise $top
11674 return
757f17bc 11675 }
3de07118 11676 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
0cc08ff7 11677 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
712fcc08 11678 set oldprefs($v) [set $v]
232475d3 11679 }
d93f1713 11680 ttk_toplevel $top
d990cedf 11681 wm title $top [mc "Gitk preferences"]
e7d64008 11682 make_transient $top .
44acce0b
PT
11683
11684 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11685 set notebook [ttk::notebook $top.notebook]
0cc08ff7 11686 } else {
44acce0b
PT
11687 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11688 }
11689
11690 lappend pages [prefspage_general $notebook] [mc "General"]
11691 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11692 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
28cb7074 11693 set col 0
44acce0b
PT
11694 foreach {page title} $pages {
11695 if {$use_notebook} {
11696 $notebook add $page -text $title
11697 } else {
11698 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11699 -text $title -command [list raise $page]]
11700 $page configure -text $title
11701 grid $btn -row 0 -column [incr col] -sticky w
11702 grid $page -row 1 -column 0 -sticky news -columnspan 100
11703 }
11704 }
11705
11706 if {!$use_notebook} {
11707 grid columnconfigure $notebook 0 -weight 1
11708 grid rowconfigure $notebook 1 -weight 1
11709 raise [lindex $pages 0]
11710 }
11711
11712 grid $notebook -sticky news -padx 2 -pady 2
11713 grid rowconfigure $top 0 -weight 1
11714 grid columnconfigure $top 0 -weight 1
9a7558f3 11715
d93f1713
PT
11716 ${NS}::frame $top.buts
11717 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11718 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
76f15947
AG
11719 bind $top <Key-Return> prefsok
11720 bind $top <Key-Escape> prefscan
712fcc08
PM
11721 grid $top.buts.ok $top.buts.can
11722 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11723 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11724 grid $top.buts - - -pady 10 -sticky ew
d93f1713 11725 grid columnconfigure $top 2 -weight 1
44acce0b 11726 bind $top <Visibility> [list focus $top.buts.ok]
712fcc08
PM
11727}
11728
314f5de1
TA
11729proc choose_extdiff {} {
11730 global extdifftool
11731
b56e0a9a 11732 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
314f5de1
TA
11733 if {$prog ne {}} {
11734 set extdifftool $prog
11735 }
11736}
11737
f8a2c0d1
PM
11738proc choosecolor {v vi w x cmd} {
11739 global $v
11740
11741 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
d990cedf 11742 -title [mc "Gitk: choose color for %s" $x]]
f8a2c0d1
PM
11743 if {$c eq {}} return
11744 $w conf -background $c
11745 lset $v $vi $c
11746 eval $cmd $c
11747}
11748
60378c0c
ML
11749proc setselbg {c} {
11750 global bglist cflist
11751 foreach w $bglist {
eb859df8
PM
11752 if {[winfo exists $w]} {
11753 $w configure -selectbackground $c
11754 }
60378c0c
ML
11755 }
11756 $cflist tag configure highlight \
11757 -background [$cflist cget -selectbackground]
11758 allcanvs itemconf secsel -fill $c
11759}
11760
51a7e8b6
PM
11761# This sets the background color and the color scheme for the whole UI.
11762# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11763# if we don't specify one ourselves, which makes the checkbuttons and
11764# radiobuttons look bad. This chooses white for selectColor if the
11765# background color is light, or black if it is dark.
5497f7a2 11766proc setui {c} {
2e58c944 11767 if {[tk windowingsystem] eq "win32"} { return }
51a7e8b6
PM
11768 set bg [winfo rgb . $c]
11769 set selc black
11770 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11771 set selc white
11772 }
11773 tk_setPalette background $c selectColor $selc
5497f7a2
GR
11774}
11775
f8a2c0d1
PM
11776proc setbg {c} {
11777 global bglist
11778
11779 foreach w $bglist {
eb859df8
PM
11780 if {[winfo exists $w]} {
11781 $w conf -background $c
11782 }
f8a2c0d1
PM
11783 }
11784}
11785
11786proc setfg {c} {
11787 global fglist canv
11788
11789 foreach w $fglist {
eb859df8
PM
11790 if {[winfo exists $w]} {
11791 $w conf -foreground $c
11792 }
f8a2c0d1
PM
11793 }
11794 allcanvs itemconf text -fill $c
11795 $canv itemconf circle -outline $c
b9fdba7f 11796 $canv itemconf markid -outline $c
f8a2c0d1
PM
11797}
11798
712fcc08 11799proc prefscan {} {
94503918 11800 global oldprefs prefstop
712fcc08 11801
3de07118 11802 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
0cc08ff7 11803 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
94503918 11804 global $v
712fcc08
PM
11805 set $v $oldprefs($v)
11806 }
11807 catch {destroy $prefstop}
11808 unset prefstop
9a7558f3 11809 fontcan
712fcc08
PM
11810}
11811
11812proc prefsok {} {
11813 global maxwidth maxgraphpct
219ea3a9 11814 global oldprefs prefstop showneartags showlocalchanges
9a7558f3 11815 global fontpref mainfont textfont uifont
39ee47ef 11816 global limitdiffs treediffs perfile_attrs
ffe15297 11817 global hideremotes
712fcc08
PM
11818
11819 catch {destroy $prefstop}
11820 unset prefstop
9a7558f3
PM
11821 fontcan
11822 set fontchanged 0
11823 if {$mainfont ne $fontpref(mainfont)} {
11824 set mainfont $fontpref(mainfont)
11825 parsefont mainfont $mainfont
11826 eval font configure mainfont [fontflags mainfont]
11827 eval font configure mainfontbold [fontflags mainfont 1]
11828 setcoords
11829 set fontchanged 1
11830 }
11831 if {$textfont ne $fontpref(textfont)} {
11832 set textfont $fontpref(textfont)
11833 parsefont textfont $textfont
11834 eval font configure textfont [fontflags textfont]
11835 eval font configure textfontbold [fontflags textfont 1]
11836 }
11837 if {$uifont ne $fontpref(uifont)} {
11838 set uifont $fontpref(uifont)
11839 parsefont uifont $uifont
11840 eval font configure uifont [fontflags uifont]
11841 }
32f1b3e4 11842 settabs
219ea3a9
PM
11843 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11844 if {$showlocalchanges} {
11845 doshowlocalchanges
11846 } else {
11847 dohidelocalchanges
11848 }
11849 }
39ee47ef
PM
11850 if {$limitdiffs != $oldprefs(limitdiffs) ||
11851 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11852 # treediffs elements are limited by path;
11853 # won't have encodings cached if perfile_attrs was just turned on
009409fe 11854 unset -nocomplain treediffs
74a40c71 11855 }
9a7558f3 11856 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
712fcc08
PM
11857 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11858 redisplay
7a39a17a
PM
11859 } elseif {$showneartags != $oldprefs(showneartags) ||
11860 $limitdiffs != $oldprefs(limitdiffs)} {
b8ab2e17 11861 reselectline
712fcc08 11862 }
ffe15297
TR
11863 if {$hideremotes != $oldprefs(hideremotes)} {
11864 rereadrefs
11865 }
712fcc08
PM
11866}
11867
11868proc formatdate {d} {
e8b5f4be 11869 global datetimeformat
219ea3a9 11870 if {$d ne {}} {
019e1630
AK
11871 # If $datetimeformat includes a timezone, display in the
11872 # timezone of the argument. Otherwise, display in local time.
11873 if {[string match {*%[zZ]*} $datetimeformat]} {
11874 if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11875 # Tcl < 8.5 does not support -timezone. Emulate it by
11876 # setting TZ (e.g. TZ=<-0430>+04:30).
11877 global env
11878 if {[info exists env(TZ)]} {
11879 set savedTZ $env(TZ)
11880 }
11881 set zone [lindex $d 1]
11882 set sign [string map {+ - - +} [string index $zone 0]]
11883 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11884 set d [clock format [lindex $d 0] -format $datetimeformat]
11885 if {[info exists savedTZ]} {
11886 set env(TZ) $savedTZ
11887 } else {
11888 unset env(TZ)
11889 }
11890 }
11891 } else {
11892 set d [clock format [lindex $d 0] -format $datetimeformat]
11893 }
219ea3a9
PM
11894 }
11895 return $d
232475d3
PM
11896}
11897
fd8ccbec
PM
11898# This list of encoding names and aliases is distilled from
11899# http://www.iana.org/assignments/character-sets.
11900# Not all of them are supported by Tcl.
11901set encoding_aliases {
11902 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11903 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11904 { ISO-10646-UTF-1 csISO10646UTF1 }
11905 { ISO_646.basic:1983 ref csISO646basic1983 }
11906 { INVARIANT csINVARIANT }
11907 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11908 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11909 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11910 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11911 { NATS-DANO iso-ir-9-1 csNATSDANO }
11912 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11913 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11914 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11915 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11916 { ISO-2022-KR csISO2022KR }
11917 { EUC-KR csEUCKR }
11918 { ISO-2022-JP csISO2022JP }
11919 { ISO-2022-JP-2 csISO2022JP2 }
11920 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11921 csISO13JISC6220jp }
11922 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11923 { IT iso-ir-15 ISO646-IT csISO15Italian }
11924 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11925 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11926 { greek7-old iso-ir-18 csISO18Greek7Old }
11927 { latin-greek iso-ir-19 csISO19LatinGreek }
11928 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11929 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11930 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11931 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11932 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11933 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11934 { INIS iso-ir-49 csISO49INIS }
11935 { INIS-8 iso-ir-50 csISO50INIS8 }
11936 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11937 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11938 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11939 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11940 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11941 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11942 csISO60Norwegian1 }
11943 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11944 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11945 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11946 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11947 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11948 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11949 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11950 { greek7 iso-ir-88 csISO88Greek7 }
11951 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11952 { iso-ir-90 csISO90 }
11953 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11954 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11955 csISO92JISC62991984b }
11956 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11957 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11958 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11959 csISO95JIS62291984handadd }
11960 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11961 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11962 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11963 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11964 CP819 csISOLatin1 }
11965 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11966 { T.61-7bit iso-ir-102 csISO102T617bit }
11967 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11968 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11969 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11970 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11971 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11972 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11973 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11974 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11975 arabic csISOLatinArabic }
11976 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11977 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11978 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11979 greek greek8 csISOLatinGreek }
11980 { T.101-G2 iso-ir-128 csISO128T101G2 }
11981 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11982 csISOLatinHebrew }
11983 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11984 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11985 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11986 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11987 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11988 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11989 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11990 csISOLatinCyrillic }
11991 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11992 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11993 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11994 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11995 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11996 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11997 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11998 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11999 { ISO_10367-box iso-ir-155 csISO10367Box }
12000 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
12001 { latin-lap lap iso-ir-158 csISO158Lap }
12002 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
12003 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
12004 { us-dk csUSDK }
12005 { dk-us csDKUS }
12006 { JIS_X0201 X0201 csHalfWidthKatakana }
12007 { KSC5636 ISO646-KR csKSC5636 }
12008 { ISO-10646-UCS-2 csUnicode }
12009 { ISO-10646-UCS-4 csUCS4 }
12010 { DEC-MCS dec csDECMCS }
12011 { hp-roman8 roman8 r8 csHPRoman8 }
12012 { macintosh mac csMacintosh }
12013 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12014 csIBM037 }
12015 { IBM038 EBCDIC-INT cp038 csIBM038 }
12016 { IBM273 CP273 csIBM273 }
12017 { IBM274 EBCDIC-BE CP274 csIBM274 }
12018 { IBM275 EBCDIC-BR cp275 csIBM275 }
12019 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12020 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12021 { IBM280 CP280 ebcdic-cp-it csIBM280 }
12022 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12023 { IBM284 CP284 ebcdic-cp-es csIBM284 }
12024 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12025 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12026 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12027 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12028 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12029 { IBM424 cp424 ebcdic-cp-he csIBM424 }
12030 { IBM437 cp437 437 csPC8CodePage437 }
12031 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12032 { IBM775 cp775 csPC775Baltic }
12033 { IBM850 cp850 850 csPC850Multilingual }
12034 { IBM851 cp851 851 csIBM851 }
12035 { IBM852 cp852 852 csPCp852 }
12036 { IBM855 cp855 855 csIBM855 }
12037 { IBM857 cp857 857 csIBM857 }
12038 { IBM860 cp860 860 csIBM860 }
12039 { IBM861 cp861 861 cp-is csIBM861 }
12040 { IBM862 cp862 862 csPC862LatinHebrew }
12041 { IBM863 cp863 863 csIBM863 }
12042 { IBM864 cp864 csIBM864 }
12043 { IBM865 cp865 865 csIBM865 }
12044 { IBM866 cp866 866 csIBM866 }
12045 { IBM868 CP868 cp-ar csIBM868 }
12046 { IBM869 cp869 869 cp-gr csIBM869 }
12047 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12048 { IBM871 CP871 ebcdic-cp-is csIBM871 }
12049 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12050 { IBM891 cp891 csIBM891 }
12051 { IBM903 cp903 csIBM903 }
12052 { IBM904 cp904 904 csIBBM904 }
12053 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12054 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12055 { IBM1026 CP1026 csIBM1026 }
12056 { EBCDIC-AT-DE csIBMEBCDICATDE }
12057 { EBCDIC-AT-DE-A csEBCDICATDEA }
12058 { EBCDIC-CA-FR csEBCDICCAFR }
12059 { EBCDIC-DK-NO csEBCDICDKNO }
12060 { EBCDIC-DK-NO-A csEBCDICDKNOA }
12061 { EBCDIC-FI-SE csEBCDICFISE }
12062 { EBCDIC-FI-SE-A csEBCDICFISEA }
12063 { EBCDIC-FR csEBCDICFR }
12064 { EBCDIC-IT csEBCDICIT }
12065 { EBCDIC-PT csEBCDICPT }
12066 { EBCDIC-ES csEBCDICES }
12067 { EBCDIC-ES-A csEBCDICESA }
12068 { EBCDIC-ES-S csEBCDICESS }
12069 { EBCDIC-UK csEBCDICUK }
12070 { EBCDIC-US csEBCDICUS }
12071 { UNKNOWN-8BIT csUnknown8BiT }
12072 { MNEMONIC csMnemonic }
12073 { MNEM csMnem }
12074 { VISCII csVISCII }
12075 { VIQR csVIQR }
12076 { KOI8-R csKOI8R }
12077 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12078 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12079 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12080 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12081 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12082 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12083 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12084 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12085 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12086 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12087 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12088 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12089 { IBM1047 IBM-1047 }
12090 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12091 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12092 { UNICODE-1-1 csUnicode11 }
12093 { CESU-8 csCESU-8 }
12094 { BOCU-1 csBOCU-1 }
12095 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12096 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12097 l8 }
12098 { ISO-8859-15 ISO_8859-15 Latin-9 }
12099 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12100 { GBK CP936 MS936 windows-936 }
12101 { JIS_Encoding csJISEncoding }
09c7029d 12102 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
fd8ccbec
PM
12103 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12104 EUC-JP }
12105 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12106 { ISO-10646-UCS-Basic csUnicodeASCII }
12107 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12108 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12109 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12110 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12111 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12112 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12113 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12114 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12115 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12116 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12117 { Adobe-Standard-Encoding csAdobeStandardEncoding }
12118 { Ventura-US csVenturaUS }
12119 { Ventura-International csVenturaInternational }
12120 { PC8-Danish-Norwegian csPC8DanishNorwegian }
12121 { PC8-Turkish csPC8Turkish }
12122 { IBM-Symbols csIBMSymbols }
12123 { IBM-Thai csIBMThai }
12124 { HP-Legal csHPLegal }
12125 { HP-Pi-font csHPPiFont }
12126 { HP-Math8 csHPMath8 }
12127 { Adobe-Symbol-Encoding csHPPSMath }
12128 { HP-DeskTop csHPDesktop }
12129 { Ventura-Math csVenturaMath }
12130 { Microsoft-Publishing csMicrosoftPublishing }
12131 { Windows-31J csWindows31J }
12132 { GB2312 csGB2312 }
12133 { Big5 csBig5 }
12134}
12135
12136proc tcl_encoding {enc} {
39ee47ef
PM
12137 global encoding_aliases tcl_encoding_cache
12138 if {[info exists tcl_encoding_cache($enc)]} {
12139 return $tcl_encoding_cache($enc)
12140 }
fd8ccbec
PM
12141 set names [encoding names]
12142 set lcnames [string tolower $names]
12143 set enc [string tolower $enc]
12144 set i [lsearch -exact $lcnames $enc]
12145 if {$i < 0} {
12146 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
09c7029d 12147 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
fd8ccbec
PM
12148 set i [lsearch -exact $lcnames $encx]
12149 }
12150 }
12151 if {$i < 0} {
12152 foreach l $encoding_aliases {
12153 set ll [string tolower $l]
12154 if {[lsearch -exact $ll $enc] < 0} continue
12155 # look through the aliases for one that tcl knows about
12156 foreach e $ll {
12157 set i [lsearch -exact $lcnames $e]
12158 if {$i < 0} {
09c7029d 12159 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
fd8ccbec
PM
12160 set i [lsearch -exact $lcnames $ex]
12161 }
12162 }
12163 if {$i >= 0} break
12164 }
12165 break
12166 }
12167 }
39ee47ef 12168 set tclenc {}
fd8ccbec 12169 if {$i >= 0} {
39ee47ef 12170 set tclenc [lindex $names $i]
fd8ccbec 12171 }
39ee47ef
PM
12172 set tcl_encoding_cache($enc) $tclenc
12173 return $tclenc
fd8ccbec
PM
12174}
12175
09c7029d 12176proc gitattr {path attr default} {
39ee47ef
PM
12177 global path_attr_cache
12178 if {[info exists path_attr_cache($attr,$path)]} {
12179 set r $path_attr_cache($attr,$path)
12180 } else {
12181 set r "unspecified"
12182 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
097e1118 12183 regexp "(.*): $attr: (.*)" $line m f r
09c7029d 12184 }
4db09304 12185 set path_attr_cache($attr,$path) $r
39ee47ef
PM
12186 }
12187 if {$r eq "unspecified"} {
12188 return $default
12189 }
12190 return $r
09c7029d
AG
12191}
12192
4db09304 12193proc cache_gitattr {attr pathlist} {
39ee47ef
PM
12194 global path_attr_cache
12195 set newlist {}
12196 foreach path $pathlist {
12197 if {![info exists path_attr_cache($attr,$path)]} {
12198 lappend newlist $path
12199 }
12200 }
12201 set lim 1000
12202 if {[tk windowingsystem] == "win32"} {
12203 # windows has a 32k limit on the arguments to a command...
12204 set lim 30
12205 }
12206 while {$newlist ne {}} {
12207 set head [lrange $newlist 0 [expr {$lim - 1}]]
12208 set newlist [lrange $newlist $lim end]
12209 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12210 foreach row [split $rlist "\n"] {
097e1118 12211 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
39ee47ef
PM
12212 if {[string index $path 0] eq "\""} {
12213 set path [encoding convertfrom [lindex $path 0]]
12214 }
12215 set path_attr_cache($attr,$path) $value
4db09304 12216 }
39ee47ef 12217 }
4db09304 12218 }
39ee47ef 12219 }
4db09304
AG
12220}
12221
09c7029d 12222proc get_path_encoding {path} {
39ee47ef
PM
12223 global gui_encoding perfile_attrs
12224 set tcl_enc $gui_encoding
12225 if {$path ne {} && $perfile_attrs} {
12226 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12227 if {$enc2 ne {}} {
12228 set tcl_enc $enc2
09c7029d 12229 }
39ee47ef
PM
12230 }
12231 return $tcl_enc
09c7029d
AG
12232}
12233
ef87a480
AH
12234## For msgcat loading, first locate the installation location.
12235if { [info exists ::env(GITK_MSGSDIR)] } {
12236 ## Msgsdir was manually set in the environment.
12237 set gitk_msgsdir $::env(GITK_MSGSDIR)
12238} else {
12239 ## Let's guess the prefix from argv0.
12240 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12241 set gitk_libdir [file join $gitk_prefix share gitk lib]
12242 set gitk_msgsdir [file join $gitk_libdir msgs]
12243 unset gitk_prefix
12244}
12245
12246## Internationalization (i18n) through msgcat and gettext. See
12247## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12248package require msgcat
12249namespace import ::msgcat::mc
12250## And eventually load the actual message catalog
12251::msgcat::mcload $gitk_msgsdir
12252
5d7589d4
PM
12253# First check that Tcl/Tk is recent enough
12254if {[catch {package require Tk 8.4} err]} {
ef87a480
AH
12255 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12256 Gitk requires at least Tcl/Tk 8.4."]
5d7589d4
PM
12257 exit 1
12258}
12259
76bf6ff9
TS
12260# on OSX bring the current Wish process window to front
12261if {[tk windowingsystem] eq "aqua"} {
12262 exec osascript -e [format {
12263 tell application "System Events"
12264 set frontmost of processes whose unix id is %d to true
12265 end tell
12266 } [pid] ]
12267}
12268
0ae10357
AO
12269# Unset GIT_TRACE var if set
12270if { [info exists ::env(GIT_TRACE)] } {
12271 unset ::env(GIT_TRACE)
12272}
12273
1d10f36d 12274# defaults...
e203d1dc 12275set wrcomcmd "git diff-tree --stdin -p --pretty=email"
671bc153 12276
fd8ccbec 12277set gitencoding {}
671bc153 12278catch {
27cb61ca 12279 set gitencoding [exec git config --get i18n.commitencoding]
671bc153 12280}
590915da
AG
12281catch {
12282 set gitencoding [exec git config --get i18n.logoutputencoding]
12283}
671bc153 12284if {$gitencoding == ""} {
fd8ccbec
PM
12285 set gitencoding "utf-8"
12286}
12287set tclencoding [tcl_encoding $gitencoding]
12288if {$tclencoding == {}} {
12289 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
671bc153 12290}
1db95b00 12291
09c7029d
AG
12292set gui_encoding [encoding system]
12293catch {
39ee47ef
PM
12294 set enc [exec git config --get gui.encoding]
12295 if {$enc ne {}} {
12296 set tclenc [tcl_encoding $enc]
12297 if {$tclenc ne {}} {
12298 set gui_encoding $tclenc
12299 } else {
12300 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12301 }
12302 }
09c7029d
AG
12303}
12304
b2b76d10
MK
12305set log_showroot true
12306catch {
12307 set log_showroot [exec git config --bool --get log.showroot]
12308}
12309
5fdcbb13
DS
12310if {[tk windowingsystem] eq "aqua"} {
12311 set mainfont {{Lucida Grande} 9}
12312 set textfont {Monaco 9}
12313 set uifont {{Lucida Grande} 9 bold}
5c9096f7
JN
12314} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12315 # fontconfig!
12316 set mainfont {sans 9}
12317 set textfont {monospace 9}
12318 set uifont {sans 9 bold}
5fdcbb13
DS
12319} else {
12320 set mainfont {Helvetica 9}
12321 set textfont {Courier 9}
12322 set uifont {Helvetica 9 bold}
12323}
7e12f1a6 12324set tabstop 8
b74fd579 12325set findmergefiles 0
8d858d1a 12326set maxgraphpct 50
f6075eba 12327set maxwidth 16
232475d3 12328set revlistorder 0
757f17bc 12329set fastdate 0
6e8c8707
PM
12330set uparrowlen 5
12331set downarrowlen 5
12332set mingaplen 100
f8b28a40 12333set cmitmode "patch"
f1b86294 12334set wrapcomment "none"
b8ab2e17 12335set showneartags 1
ffe15297 12336set hideremotes 0
0a4dd8b8 12337set maxrefs 20
bde4a0f9 12338set visiblerefs {"master"}
322a8cc9 12339set maxlinelen 200
219ea3a9 12340set showlocalchanges 1
7a39a17a 12341set limitdiffs 1
e8b5f4be 12342set datetimeformat "%Y-%m-%d %H:%M:%S"
95293b58 12343set autoselect 1
21ac8a8d 12344set autosellen 40
39ee47ef 12345set perfile_attrs 0
0cc08ff7 12346set want_ttk 1
1d10f36d 12347
5fdcbb13
DS
12348if {[tk windowingsystem] eq "aqua"} {
12349 set extdifftool "opendiff"
12350} else {
12351 set extdifftool "meld"
12352}
314f5de1 12353
6e8fda5f 12354set colors {"#00ff00" red blue magenta darkgrey brown orange}
1924d1bc
PT
12355if {[tk windowingsystem] eq "win32"} {
12356 set uicolor SystemButtonFace
252c52df
12357 set uifgcolor SystemButtonText
12358 set uifgdisabledcolor SystemDisabledText
1924d1bc 12359 set bgcolor SystemWindow
252c52df 12360 set fgcolor SystemWindowText
1924d1bc 12361 set selectbgcolor SystemHighlight
3441de5b 12362 set web_browser "cmd /c start"
1924d1bc
PT
12363} else {
12364 set uicolor grey85
252c52df
12365 set uifgcolor black
12366 set uifgdisabledcolor "#999"
1924d1bc
PT
12367 set bgcolor white
12368 set fgcolor black
12369 set selectbgcolor gray85
3441de5b
PM
12370 if {[tk windowingsystem] eq "aqua"} {
12371 set web_browser "open"
12372 } else {
12373 set web_browser "xdg-open"
12374 }
1924d1bc 12375}
f8a2c0d1 12376set diffcolors {red "#00a000" blue}
890fae70 12377set diffcontext 3
6e8fda5f 12378set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
b9b86007 12379set ignorespace 0
ae4e3ff9 12380set worddiff ""
e3e901be 12381set markbgcolor "#e0e0ff"
1d10f36d 12382
6e8fda5f 12383set headbgcolor "#00ff00"
252c52df
12384set headfgcolor black
12385set headoutlinecolor black
12386set remotebgcolor #ffddaa
12387set tagbgcolor yellow
12388set tagfgcolor black
12389set tagoutlinecolor black
12390set reflinecolor black
12391set filesepbgcolor #aaaaaa
12392set filesepfgcolor black
12393set linehoverbgcolor #ffff80
12394set linehoverfgcolor black
12395set linehoveroutlinecolor black
12396set mainheadcirclecolor yellow
12397set workingfilescirclecolor red
6e8fda5f 12398set indexcirclecolor "#00ff00"
c11ff120 12399set circlecolors {white blue gray blue blue}
252c52df
12400set linkfgcolor blue
12401set circleoutlinecolor $fgcolor
12402set foundbgcolor yellow
12403set currentsearchhitbgcolor orange
c11ff120 12404
d277e89f
PM
12405# button for popping up context menus
12406if {[tk windowingsystem] eq "aqua"} {
12407 set ctxbut <Button-2>
12408} else {
12409 set ctxbut <Button-3>
12410}
12411
8f863398
AH
12412catch {
12413 # follow the XDG base directory specification by default. See
12414 # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12415 if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12416 # XDG_CONFIG_HOME environment variable is set
12417 set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12418 set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12419 } else {
12420 # default XDG_CONFIG_HOME
12421 set config_file "~/.config/git/gitk"
12422 set config_file_tmp "~/.config/git/gitk-tmp"
12423 }
12424 if {![file exists $config_file]} {
12425 # for backward compatibility use the old config file if it exists
12426 if {[file exists "~/.gitk"]} {
12427 set config_file "~/.gitk"
12428 set config_file_tmp "~/.gitk-tmp"
12429 } elseif {![file exists [file dirname $config_file]]} {
12430 file mkdir [file dirname $config_file]
12431 }
12432 }
12433 source $config_file
12434}
eaf7e835 12435config_check_tmp_exists 50
1d10f36d 12436
9fabefb1
MK
12437set config_variables {
12438 mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12439 cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12440 hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12441 bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12442 markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12443 extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12444 remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12445 filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12446 linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12447 indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
3441de5b 12448 web_browser
9fabefb1 12449}
995f792b
MK
12450foreach var $config_variables {
12451 config_init_trace $var
12452 trace add variable $var write config_variable_change_cb
12453}
9fabefb1 12454
0ed1dd3c
PM
12455parsefont mainfont $mainfont
12456eval font create mainfont [fontflags mainfont]
12457eval font create mainfontbold [fontflags mainfont 1]
12458
12459parsefont textfont $textfont
12460eval font create textfont [fontflags textfont]
12461eval font create textfontbold [fontflags textfont 1]
12462
12463parsefont uifont $uifont
12464eval font create uifont [fontflags uifont]
17386066 12465
51a7e8b6 12466setui $uicolor
5497f7a2 12467
b039f0a6
PM
12468setoptions
12469
cdaee5db 12470# check that we can find a .git directory somewhere...
86e847bc 12471if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
d990cedf 12472 show_error {} . [mc "Cannot find a git repository here."]
6c87d60c
AR
12473 exit 1
12474}
cdaee5db 12475
39816d60
AG
12476set selecthead {}
12477set selectheadid {}
12478
1d10f36d 12479set revtreeargs {}
cdaee5db
PM
12480set cmdline_files {}
12481set i 0
2d480856 12482set revtreeargscmd {}
1d10f36d 12483foreach arg $argv {
2d480856 12484 switch -glob -- $arg {
6ebedabf 12485 "" { }
cdaee5db
PM
12486 "--" {
12487 set cmdline_files [lrange $argv [expr {$i + 1}] end]
12488 break
12489 }
39816d60
AG
12490 "--select-commit=*" {
12491 set selecthead [string range $arg 16 end]
12492 }
2d480856
YD
12493 "--argscmd=*" {
12494 set revtreeargscmd [string range $arg 10 end]
12495 }
1d10f36d
PM
12496 default {
12497 lappend revtreeargs $arg
12498 }
12499 }
cdaee5db 12500 incr i
1db95b00 12501}
1d10f36d 12502
39816d60
AG
12503if {$selecthead eq "HEAD"} {
12504 set selecthead {}
12505}
12506
cdaee5db 12507if {$i >= [llength $argv] && $revtreeargs ne {}} {
3ed31a81 12508 # no -- on command line, but some arguments (other than --argscmd)
098dd8a3 12509 if {[catch {
8974c6f9 12510 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
098dd8a3
PM
12511 set cmdline_files [split $f "\n"]
12512 set n [llength $cmdline_files]
12513 set revtreeargs [lrange $revtreeargs 0 end-$n]
cdaee5db
PM
12514 # Unfortunately git rev-parse doesn't produce an error when
12515 # something is both a revision and a filename. To be consistent
12516 # with git log and git rev-list, check revtreeargs for filenames.
12517 foreach arg $revtreeargs {
12518 if {[file exists $arg]} {
d990cedf
CS
12519 show_error {} . [mc "Ambiguous argument '%s': both revision\
12520 and filename" $arg]
cdaee5db
PM
12521 exit 1
12522 }
12523 }
098dd8a3
PM
12524 } err]} {
12525 # unfortunately we get both stdout and stderr in $err,
12526 # so look for "fatal:".
12527 set i [string first "fatal:" $err]
12528 if {$i > 0} {
b5e09633 12529 set err [string range $err [expr {$i + 6}] end]
098dd8a3 12530 }
d990cedf 12531 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
098dd8a3
PM
12532 exit 1
12533 }
12534}
12535
219ea3a9 12536set nullid "0000000000000000000000000000000000000000"
8f489363 12537set nullid2 "0000000000000000000000000000000000000001"
314f5de1 12538set nullfile "/dev/null"
8f489363 12539
32f1b3e4 12540set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
0cc08ff7
PM
12541if {![info exists have_ttk]} {
12542 set have_ttk [llength [info commands ::ttk::style]]
d93f1713 12543}
0cc08ff7 12544set use_ttk [expr {$have_ttk && $want_ttk}]
d93f1713 12545set NS [expr {$use_ttk ? "ttk" : ""}]
0cc08ff7 12546
6cb73c84
GB
12547if {$use_ttk} {
12548 setttkstyle
12549}
12550
7add5aff 12551regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
219ea3a9 12552
7defefb1
KS
12553set show_notes {}
12554if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12555 set show_notes "--show-notes"
12556}
12557
3878e636
ZJS
12558set appname "gitk"
12559
7eb3cb9c 12560set runq {}
d698206c
PM
12561set history {}
12562set historyindex 0
908c3585 12563set fh_serial 0
908c3585 12564set nhl_names {}
63b79191 12565set highlight_paths {}
687c8765 12566set findpattern {}
1902c270 12567set searchdirn -forwards
28593d3f
PM
12568set boldids {}
12569set boldnameids {}
a8d610a2 12570set diffelide {0 0}
4fb0fa19 12571set markingmatches 0
97645683 12572set linkentercount 0
0380081c
PM
12573set need_redisplay 0
12574set nrows_drawn 0
32f1b3e4 12575set firsttabstop 0
9f1afe05 12576
50b44ece
PM
12577set nextviewnum 1
12578set curview 0
a90a6d24 12579set selectedview 0
b007ee20
CS
12580set selectedhlview [mc "None"]
12581set highlight_related [mc "None"]
687c8765 12582set highlight_files {}
50b44ece 12583set viewfiles(0) {}
a90a6d24 12584set viewperm(0) 0
995f792b 12585set viewchanged(0) 0
098dd8a3 12586set viewargs(0) {}
2d480856 12587set viewargscmd(0) {}
50b44ece 12588
94b4a69f 12589set selectedline {}
6df7403a 12590set numcommits 0
7fcc92bf 12591set loginstance 0
098dd8a3 12592set cmdlineok 0
1d10f36d 12593set stopped 0
0fba86b3 12594set stuffsaved 0
74daedb6 12595set patchnum 0
219ea3a9 12596set lserial 0
74cb884f 12597set hasworktree [hasworktree]
c332f445 12598set cdup {}
74cb884f 12599if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
c332f445
MZ
12600 set cdup [exec git rev-parse --show-cdup]
12601}
784b7e2f 12602set worktree [exec git rev-parse --show-toplevel]
1d10f36d 12603setcoords
d94f8cd6 12604makewindow
37871b73
GB
12605catch {
12606 image create photo gitlogo -width 16 -height 16
12607
12608 image create photo gitlogominus -width 4 -height 2
12609 gitlogominus put #C00000 -to 0 0 4 2
12610 gitlogo copy gitlogominus -to 1 5
12611 gitlogo copy gitlogominus -to 6 5
12612 gitlogo copy gitlogominus -to 11 5
12613 image delete gitlogominus
12614
12615 image create photo gitlogoplus -width 4 -height 4
12616 gitlogoplus put #008000 -to 1 0 3 4
12617 gitlogoplus put #008000 -to 0 1 4 3
12618 gitlogo copy gitlogoplus -to 1 9
12619 gitlogo copy gitlogoplus -to 6 9
12620 gitlogo copy gitlogoplus -to 11 9
12621 image delete gitlogoplus
12622
d38d7d49
SB
12623 image create photo gitlogo32 -width 32 -height 32
12624 gitlogo32 copy gitlogo -zoom 2 2
12625
12626 wm iconphoto . -default gitlogo gitlogo32
37871b73 12627}
0eafba14
PM
12628# wait for the window to become visible
12629tkwait visibility .
9922c5a3 12630set_window_title
478afad6 12631update
887fe3c4 12632readrefs
a8aaf19c 12633
2d480856 12634if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
50b44ece
PM
12635 # create a view for the files/dirs specified on the command line
12636 set curview 1
a90a6d24 12637 set selectedview 1
50b44ece 12638 set nextviewnum 2
d990cedf 12639 set viewname(1) [mc "Command line"]
50b44ece 12640 set viewfiles(1) $cmdline_files
098dd8a3 12641 set viewargs(1) $revtreeargs
2d480856 12642 set viewargscmd(1) $revtreeargscmd
a90a6d24 12643 set viewperm(1) 0
995f792b 12644 set viewchanged(1) 0
3ed31a81 12645 set vdatemode(1) 0
da7c24dd 12646 addviewmenu 1
28de5685
BB
12647 .bar.view entryconf [mca "&Edit view..."] -state normal
12648 .bar.view entryconf [mca "&Delete view"] -state normal
50b44ece 12649}
a90a6d24
PM
12650
12651if {[info exists permviews]} {
12652 foreach v $permviews {
12653 set n $nextviewnum
12654 incr nextviewnum
12655 set viewname($n) [lindex $v 0]
12656 set viewfiles($n) [lindex $v 1]
098dd8a3 12657 set viewargs($n) [lindex $v 2]
2d480856 12658 set viewargscmd($n) [lindex $v 3]
a90a6d24 12659 set viewperm($n) 1
995f792b 12660 set viewchanged($n) 0
da7c24dd 12661 addviewmenu $n
a90a6d24
PM
12662 }
12663}
e4df519f
JS
12664
12665if {[tk windowingsystem] eq "win32"} {
12666 focus -force .
12667}
12668
567c34e0 12669getcommits {}
adab0dab
PT
12670
12671# Local variables:
12672# mode: tcl
12673# indent-tabs-mode: t
12674# tab-width: 8
12675# End: