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