gitk: Enable mouse horizontal scrolling in diff pane
[git/git.git] / gitk
CommitLineData
1db95b00
PM
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
9e026d39 3exec wish "$0" -- "$@"
1db95b00 4
6c626a03 5# Copyright © 2005-2014 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
6df7403a 591 global targetid
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 {}
7fcc92bf
PM
603 catch {unset currentid}
604 catch {unset thickerline}
605 catch {unset treediffs}
606 readrefs
607 changedrefs
608 if {$showneartags} {
609 getallcommits
610 }
611 clear_display
612 catch {unset commitinterest}
613 catch {unset cached_commitrow}
42a671fc 614 catch {unset targetid}
7fcc92bf 615 setcanvscroll
567c34e0 616 getcommits $selid
e7297a1c 617 return 0
7fcc92bf
PM
618}
619
6e8c8707
PM
620# This makes a string representation of a positive integer which
621# sorts as a string in numerical order
622proc strrep {n} {
623 if {$n < 16} {
624 return [format "%x" $n]
625 } elseif {$n < 256} {
626 return [format "x%.2x" $n]
627 } elseif {$n < 65536} {
628 return [format "y%.4x" $n]
629 }
630 return [format "z%.8x" $n]
631}
632
7fcc92bf
PM
633# Procedures used in reordering commits from git log (without
634# --topo-order) into the order for display.
635
636proc varcinit {view} {
f3ea5ede
PM
637 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
638 global vtokmod varcmod vrowmod varcix vlastins
7fcc92bf 639
7fcc92bf
PM
640 set varcstart($view) {{}}
641 set vupptr($view) {0}
642 set vdownptr($view) {0}
643 set vleftptr($view) {0}
f3ea5ede 644 set vbackptr($view) {0}
7fcc92bf
PM
645 set varctok($view) {{}}
646 set varcrow($view) {{}}
647 set vtokmod($view) {}
648 set varcmod($view) 0
e5b37ac1 649 set vrowmod($view) 0
7fcc92bf 650 set varcix($view) {{}}
f3ea5ede 651 set vlastins($view) {0}
7fcc92bf
PM
652}
653
654proc resetvarcs {view} {
655 global varcid varccommits parents children vseedcount ordertok
22387f23 656 global vshortids
7fcc92bf
PM
657
658 foreach vid [array names varcid $view,*] {
659 unset varcid($vid)
660 unset children($vid)
661 unset parents($vid)
662 }
22387f23
PM
663 foreach vid [array names vshortids $view,*] {
664 unset vshortids($vid)
665 }
7fcc92bf
PM
666 # some commits might have children but haven't been seen yet
667 foreach vid [array names children $view,*] {
668 unset children($vid)
669 }
670 foreach va [array names varccommits $view,*] {
671 unset varccommits($va)
672 }
673 foreach vd [array names vseedcount $view,*] {
674 unset vseedcount($vd)
675 }
9257d8f7 676 catch {unset ordertok}
7fcc92bf
PM
677}
678
468bcaed
PM
679# returns a list of the commits with no children
680proc seeds {v} {
681 global vdownptr vleftptr varcstart
682
683 set ret {}
684 set a [lindex $vdownptr($v) 0]
685 while {$a != 0} {
686 lappend ret [lindex $varcstart($v) $a]
687 set a [lindex $vleftptr($v) $a]
688 }
689 return $ret
690}
691
7fcc92bf 692proc newvarc {view id} {
3ed31a81 693 global varcid varctok parents children vdatemode
f3ea5ede
PM
694 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
695 global commitdata commitinfo vseedcount varccommits vlastins
7fcc92bf
PM
696
697 set a [llength $varctok($view)]
698 set vid $view,$id
3ed31a81 699 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
7fcc92bf
PM
700 if {![info exists commitinfo($id)]} {
701 parsecommit $id $commitdata($id) 1
702 }
f5974d97 703 set cdate [lindex [lindex $commitinfo($id) 4] 0]
7fcc92bf
PM
704 if {![string is integer -strict $cdate]} {
705 set cdate 0
706 }
707 if {![info exists vseedcount($view,$cdate)]} {
708 set vseedcount($view,$cdate) -1
709 }
710 set c [incr vseedcount($view,$cdate)]
711 set cdate [expr {$cdate ^ 0xffffffff}]
712 set tok "s[strrep $cdate][strrep $c]"
7fcc92bf
PM
713 } else {
714 set tok {}
f3ea5ede
PM
715 }
716 set ka 0
717 if {[llength $children($vid)] > 0} {
718 set kid [lindex $children($vid) end]
719 set k $varcid($view,$kid)
720 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
721 set ki $kid
722 set ka $k
723 set tok [lindex $varctok($view) $k]
7fcc92bf 724 }
f3ea5ede
PM
725 }
726 if {$ka != 0} {
7fcc92bf
PM
727 set i [lsearch -exact $parents($view,$ki) $id]
728 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
7fcc92bf
PM
729 append tok [strrep $j]
730 }
f3ea5ede
PM
731 set c [lindex $vlastins($view) $ka]
732 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
733 set c $ka
734 set b [lindex $vdownptr($view) $ka]
735 } else {
736 set b [lindex $vleftptr($view) $c]
737 }
738 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
739 set c $b
740 set b [lindex $vleftptr($view) $c]
741 }
742 if {$c == $ka} {
743 lset vdownptr($view) $ka $a
744 lappend vbackptr($view) 0
745 } else {
746 lset vleftptr($view) $c $a
747 lappend vbackptr($view) $c
748 }
749 lset vlastins($view) $ka $a
750 lappend vupptr($view) $ka
751 lappend vleftptr($view) $b
752 if {$b != 0} {
753 lset vbackptr($view) $b $a
754 }
7fcc92bf
PM
755 lappend varctok($view) $tok
756 lappend varcstart($view) $id
757 lappend vdownptr($view) 0
758 lappend varcrow($view) {}
759 lappend varcix($view) {}
e5b37ac1 760 set varccommits($view,$a) {}
f3ea5ede 761 lappend vlastins($view) 0
7fcc92bf
PM
762 return $a
763}
764
765proc splitvarc {p v} {
52b8ea93 766 global varcid varcstart varccommits varctok vtokmod
f3ea5ede 767 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
7fcc92bf
PM
768
769 set oa $varcid($v,$p)
52b8ea93 770 set otok [lindex $varctok($v) $oa]
7fcc92bf
PM
771 set ac $varccommits($v,$oa)
772 set i [lsearch -exact $varccommits($v,$oa) $p]
773 if {$i <= 0} return
774 set na [llength $varctok($v)]
775 # "%" sorts before "0"...
52b8ea93 776 set tok "$otok%[strrep $i]"
7fcc92bf
PM
777 lappend varctok($v) $tok
778 lappend varcrow($v) {}
779 lappend varcix($v) {}
780 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
781 set varccommits($v,$na) [lrange $ac $i end]
782 lappend varcstart($v) $p
783 foreach id $varccommits($v,$na) {
784 set varcid($v,$id) $na
785 }
786 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
841ea824 787 lappend vlastins($v) [lindex $vlastins($v) $oa]
7fcc92bf 788 lset vdownptr($v) $oa $na
841ea824 789 lset vlastins($v) $oa 0
7fcc92bf
PM
790 lappend vupptr($v) $oa
791 lappend vleftptr($v) 0
f3ea5ede 792 lappend vbackptr($v) 0
7fcc92bf
PM
793 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
794 lset vupptr($v) $b $na
795 }
52b8ea93
PM
796 if {[string compare $otok $vtokmod($v)] <= 0} {
797 modify_arc $v $oa
798 }
7fcc92bf
PM
799}
800
801proc renumbervarc {a v} {
802 global parents children varctok varcstart varccommits
3ed31a81 803 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
7fcc92bf
PM
804
805 set t1 [clock clicks -milliseconds]
806 set todo {}
807 set isrelated($a) 1
f3ea5ede 808 set kidchanged($a) 1
7fcc92bf
PM
809 set ntot 0
810 while {$a != 0} {
811 if {[info exists isrelated($a)]} {
812 lappend todo $a
813 set id [lindex $varccommits($v,$a) end]
814 foreach p $parents($v,$id) {
815 if {[info exists varcid($v,$p)]} {
816 set isrelated($varcid($v,$p)) 1
817 }
818 }
819 }
820 incr ntot
821 set b [lindex $vdownptr($v) $a]
822 if {$b == 0} {
823 while {$a != 0} {
824 set b [lindex $vleftptr($v) $a]
825 if {$b != 0} break
826 set a [lindex $vupptr($v) $a]
827 }
828 }
829 set a $b
830 }
831 foreach a $todo {
f3ea5ede 832 if {![info exists kidchanged($a)]} continue
7fcc92bf 833 set id [lindex $varcstart($v) $a]
f3ea5ede
PM
834 if {[llength $children($v,$id)] > 1} {
835 set children($v,$id) [lsort -command [list vtokcmp $v] \
836 $children($v,$id)]
837 }
838 set oldtok [lindex $varctok($v) $a]
3ed31a81 839 if {!$vdatemode($v)} {
f3ea5ede
PM
840 set tok {}
841 } else {
842 set tok $oldtok
843 }
844 set ka 0
c8c9f3d9
PM
845 set kid [last_real_child $v,$id]
846 if {$kid ne {}} {
f3ea5ede
PM
847 set k $varcid($v,$kid)
848 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
849 set ki $kid
850 set ka $k
851 set tok [lindex $varctok($v) $k]
7fcc92bf
PM
852 }
853 }
f3ea5ede 854 if {$ka != 0} {
7fcc92bf
PM
855 set i [lsearch -exact $parents($v,$ki) $id]
856 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
857 append tok [strrep $j]
7fcc92bf 858 }
f3ea5ede
PM
859 if {$tok eq $oldtok} {
860 continue
861 }
862 set id [lindex $varccommits($v,$a) end]
863 foreach p $parents($v,$id) {
864 if {[info exists varcid($v,$p)]} {
865 set kidchanged($varcid($v,$p)) 1
866 } else {
867 set sortkids($p) 1
868 }
869 }
870 lset varctok($v) $a $tok
7fcc92bf
PM
871 set b [lindex $vupptr($v) $a]
872 if {$b != $ka} {
9257d8f7
PM
873 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
874 modify_arc $v $ka
38dfe939 875 }
9257d8f7
PM
876 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
877 modify_arc $v $b
38dfe939 878 }
f3ea5ede
PM
879 set c [lindex $vbackptr($v) $a]
880 set d [lindex $vleftptr($v) $a]
881 if {$c == 0} {
882 lset vdownptr($v) $b $d
7fcc92bf 883 } else {
f3ea5ede
PM
884 lset vleftptr($v) $c $d
885 }
886 if {$d != 0} {
887 lset vbackptr($v) $d $c
7fcc92bf 888 }
841ea824
PM
889 if {[lindex $vlastins($v) $b] == $a} {
890 lset vlastins($v) $b $c
891 }
7fcc92bf 892 lset vupptr($v) $a $ka
f3ea5ede
PM
893 set c [lindex $vlastins($v) $ka]
894 if {$c == 0 || \
895 [string compare $tok [lindex $varctok($v) $c]] < 0} {
896 set c $ka
897 set b [lindex $vdownptr($v) $ka]
898 } else {
899 set b [lindex $vleftptr($v) $c]
900 }
901 while {$b != 0 && \
902 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
903 set c $b
904 set b [lindex $vleftptr($v) $c]
7fcc92bf 905 }
f3ea5ede
PM
906 if {$c == $ka} {
907 lset vdownptr($v) $ka $a
908 lset vbackptr($v) $a 0
909 } else {
910 lset vleftptr($v) $c $a
911 lset vbackptr($v) $a $c
7fcc92bf 912 }
f3ea5ede
PM
913 lset vleftptr($v) $a $b
914 if {$b != 0} {
915 lset vbackptr($v) $b $a
916 }
917 lset vlastins($v) $ka $a
918 }
919 }
920 foreach id [array names sortkids] {
921 if {[llength $children($v,$id)] > 1} {
922 set children($v,$id) [lsort -command [list vtokcmp $v] \
923 $children($v,$id)]
7fcc92bf
PM
924 }
925 }
926 set t2 [clock clicks -milliseconds]
927 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
928}
929
f806f0fb
PM
930# Fix up the graph after we have found out that in view $v,
931# $p (a commit that we have already seen) is actually the parent
932# of the last commit in arc $a.
7fcc92bf 933proc fix_reversal {p a v} {
24f7a667 934 global varcid varcstart varctok vupptr
7fcc92bf
PM
935
936 set pa $varcid($v,$p)
937 if {$p ne [lindex $varcstart($v) $pa]} {
938 splitvarc $p $v
939 set pa $varcid($v,$p)
940 }
24f7a667
PM
941 # seeds always need to be renumbered
942 if {[lindex $vupptr($v) $pa] == 0 ||
943 [string compare [lindex $varctok($v) $a] \
944 [lindex $varctok($v) $pa]] > 0} {
7fcc92bf
PM
945 renumbervarc $pa $v
946 }
947}
948
949proc insertrow {id p v} {
b8a938cf
PM
950 global cmitlisted children parents varcid varctok vtokmod
951 global varccommits ordertok commitidx numcommits curview
22387f23 952 global targetid targetrow vshortids
b8a938cf
PM
953
954 readcommit $id
955 set vid $v,$id
956 set cmitlisted($vid) 1
957 set children($vid) {}
958 set parents($vid) [list $p]
959 set a [newvarc $v $id]
960 set varcid($vid) $a
22387f23 961 lappend vshortids($v,[string range $id 0 3]) $id
b8a938cf
PM
962 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
963 modify_arc $v $a
964 }
965 lappend varccommits($v,$a) $id
966 set vp $v,$p
967 if {[llength [lappend children($vp) $id]] > 1} {
968 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
969 catch {unset ordertok}
970 }
971 fix_reversal $p $a $v
972 incr commitidx($v)
973 if {$v == $curview} {
974 set numcommits $commitidx($v)
975 setcanvscroll
976 if {[info exists targetid]} {
977 if {![comes_before $targetid $p]} {
978 incr targetrow
979 }
980 }
981 }
982}
983
984proc insertfakerow {id p} {
9257d8f7 985 global varcid varccommits parents children cmitlisted
b8a938cf 986 global commitidx varctok vtokmod targetid targetrow curview numcommits
7fcc92bf 987
b8a938cf 988 set v $curview
7fcc92bf
PM
989 set a $varcid($v,$p)
990 set i [lsearch -exact $varccommits($v,$a) $p]
991 if {$i < 0} {
b8a938cf 992 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
7fcc92bf
PM
993 return
994 }
995 set children($v,$id) {}
996 set parents($v,$id) [list $p]
997 set varcid($v,$id) $a
9257d8f7 998 lappend children($v,$p) $id
7fcc92bf 999 set cmitlisted($v,$id) 1
b8a938cf 1000 set numcommits [incr commitidx($v)]
7fcc92bf
PM
1001 # note we deliberately don't update varcstart($v) even if $i == 0
1002 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
c9cfdc96 1003 modify_arc $v $a $i
42a671fc
PM
1004 if {[info exists targetid]} {
1005 if {![comes_before $targetid $p]} {
1006 incr targetrow
1007 }
1008 }
b8a938cf 1009 setcanvscroll
9257d8f7 1010 drawvisible
7fcc92bf
PM
1011}
1012
b8a938cf 1013proc removefakerow {id} {
9257d8f7 1014 global varcid varccommits parents children commitidx
fc2a256f 1015 global varctok vtokmod cmitlisted currentid selectedline
b8a938cf 1016 global targetid curview numcommits
7fcc92bf 1017
b8a938cf 1018 set v $curview
7fcc92bf 1019 if {[llength $parents($v,$id)] != 1} {
b8a938cf 1020 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
7fcc92bf
PM
1021 return
1022 }
1023 set p [lindex $parents($v,$id) 0]
1024 set a $varcid($v,$id)
1025 set i [lsearch -exact $varccommits($v,$a) $id]
1026 if {$i < 0} {
b8a938cf 1027 puts "oops: removefakerow can't find [shortids $id] on arc $a"
7fcc92bf
PM
1028 return
1029 }
1030 unset varcid($v,$id)
1031 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032 unset parents($v,$id)
1033 unset children($v,$id)
1034 unset cmitlisted($v,$id)
b8a938cf 1035 set numcommits [incr commitidx($v) -1]
7fcc92bf
PM
1036 set j [lsearch -exact $children($v,$p) $id]
1037 if {$j >= 0} {
1038 set children($v,$p) [lreplace $children($v,$p) $j $j]
1039 }
c9cfdc96 1040 modify_arc $v $a $i
fc2a256f
PM
1041 if {[info exist currentid] && $id eq $currentid} {
1042 unset currentid
94b4a69f 1043 set selectedline {}
fc2a256f 1044 }
42a671fc
PM
1045 if {[info exists targetid] && $targetid eq $id} {
1046 set targetid $p
1047 }
b8a938cf 1048 setcanvscroll
9257d8f7 1049 drawvisible
7fcc92bf
PM
1050}
1051
aa43561a
PM
1052proc real_children {vp} {
1053 global children nullid nullid2
1054
1055 set kids {}
1056 foreach id $children($vp) {
1057 if {$id ne $nullid && $id ne $nullid2} {
1058 lappend kids $id
1059 }
1060 }
1061 return $kids
1062}
1063
c8c9f3d9
PM
1064proc first_real_child {vp} {
1065 global children nullid nullid2
1066
1067 foreach id $children($vp) {
1068 if {$id ne $nullid && $id ne $nullid2} {
1069 return $id
1070 }
1071 }
1072 return {}
1073}
1074
1075proc last_real_child {vp} {
1076 global children nullid nullid2
1077
1078 set kids $children($vp)
1079 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080 set id [lindex $kids $i]
1081 if {$id ne $nullid && $id ne $nullid2} {
1082 return $id
1083 }
1084 }
1085 return {}
1086}
1087
7fcc92bf
PM
1088proc vtokcmp {v a b} {
1089 global varctok varcid
1090
1091 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092 [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
c9cfdc96
PM
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
e5b37ac1
PM
1097proc modify_arc {v a {lim {}}} {
1098 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
9257d8f7 1099
c9cfdc96
PM
1100 if {$lim ne {}} {
1101 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102 if {$c > 0} return
1103 if {$c == 0} {
1104 set r [lindex $varcrow($v) $a]
1105 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106 }
1107 }
9257d8f7
PM
1108 set vtokmod($v) [lindex $varctok($v) $a]
1109 set varcmod($v) $a
1110 if {$v == $curview} {
1111 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112 set a [lindex $vupptr($v) $a]
e5b37ac1 1113 set lim {}
9257d8f7 1114 }
e5b37ac1
PM
1115 set r 0
1116 if {$a != 0} {
1117 if {$lim eq {}} {
1118 set lim [llength $varccommits($v,$a)]
1119 }
1120 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121 }
1122 set vrowmod($v) $r
0c27886e 1123 undolayout $r
9257d8f7
PM
1124 }
1125}
1126
7fcc92bf 1127proc update_arcrows {v} {
e5b37ac1 1128 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
24f7a667 1129 global varcid vrownum varcorder varcix varccommits
7fcc92bf 1130 global vupptr vdownptr vleftptr varctok
24f7a667 1131 global displayorder parentlist curview cached_commitrow
7fcc92bf 1132
c9cfdc96
PM
1133 if {$vrowmod($v) == $commitidx($v)} return
1134 if {$v == $curview} {
1135 if {[llength $displayorder] > $vrowmod($v)} {
1136 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138 }
1139 catch {unset cached_commitrow}
1140 }
7fcc92bf
PM
1141 set narctot [expr {[llength $varctok($v)] - 1}]
1142 set a $varcmod($v)
1143 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144 # go up the tree until we find something that has a row number,
1145 # or we get to a seed
1146 set a [lindex $vupptr($v) $a]
1147 }
1148 if {$a == 0} {
1149 set a [lindex $vdownptr($v) 0]
1150 if {$a == 0} return
1151 set vrownum($v) {0}
1152 set varcorder($v) [list $a]
1153 lset varcix($v) $a 0
1154 lset varcrow($v) $a 0
1155 set arcn 0
1156 set row 0
1157 } else {
1158 set arcn [lindex $varcix($v) $a]
7fcc92bf
PM
1159 if {[llength $vrownum($v)] > $arcn + 1} {
1160 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162 }
1163 set row [lindex $varcrow($v) $a]
1164 }
7fcc92bf
PM
1165 while {1} {
1166 set p $a
1167 incr row [llength $varccommits($v,$a)]
1168 # go down if possible
1169 set b [lindex $vdownptr($v) $a]
1170 if {$b == 0} {
1171 # if not, go left, or go up until we can go left
1172 while {$a != 0} {
1173 set b [lindex $vleftptr($v) $a]
1174 if {$b != 0} break
1175 set a [lindex $vupptr($v) $a]
1176 }
1177 if {$a == 0} break
1178 }
1179 set a $b
1180 incr arcn
1181 lappend vrownum($v) $row
1182 lappend varcorder($v) $a
1183 lset varcix($v) $a $arcn
1184 lset varcrow($v) $a $row
1185 }
e5b37ac1
PM
1186 set vtokmod($v) [lindex $varctok($v) $p]
1187 set varcmod($v) $p
1188 set vrowmod($v) $row
7fcc92bf
PM
1189 if {[info exists currentid]} {
1190 set selectedline [rowofcommit $currentid]
1191 }
7fcc92bf
PM
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196 global varcid
1197
1198 return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203 global varcid varccommits varcrow curview cached_commitrow
9257d8f7 1204 global varctok vtokmod
7fcc92bf 1205
7fcc92bf
PM
1206 set v $curview
1207 if {![info exists varcid($v,$id)]} {
1208 puts "oops rowofcommit no arc for [shortids $id]"
1209 return {}
1210 }
1211 set a $varcid($v,$id)
fc2a256f 1212 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
9257d8f7
PM
1213 update_arcrows $v
1214 }
31c0eaa8
PM
1215 if {[info exists cached_commitrow($id)]} {
1216 return $cached_commitrow($id)
1217 }
7fcc92bf
PM
1218 set i [lsearch -exact $varccommits($v,$a) $id]
1219 if {$i < 0} {
1220 puts "oops didn't find commit [shortids $id] in arc $a"
1221 return {}
1222 }
1223 incr i [lindex $varcrow($v) $a]
1224 set cached_commitrow($id) $i
1225 return $i
1226}
1227
42a671fc
PM
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230 global varcid varctok curview
1231
1232 set v $curview
1233 if {$a eq $b || ![info exists varcid($v,$a)] || \
1234 ![info exists varcid($v,$b)]} {
1235 return 0
1236 }
1237 if {$varcid($v,$a) != $varcid($v,$b)} {
1238 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240 }
1241 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
7fcc92bf
PM
1244proc bsearch {l elt} {
1245 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246 return 0
1247 }
1248 set lo 0
1249 set hi [llength $l]
1250 while {$hi - $lo > 1} {
1251 set mid [expr {int(($lo + $hi) / 2)}]
1252 set t [lindex $l $mid]
1253 if {$elt < $t} {
1254 set hi $mid
1255 } elseif {$elt > $t} {
1256 set lo $mid
1257 } else {
1258 return $mid
1259 }
1260 }
1261 return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266 global vrownum curview commitidx displayorder parentlist
e5b37ac1 1267 global varccommits varcorder parents vrowmod varcrow
7fcc92bf
PM
1268 global d_valid_start d_valid_end
1269
e5b37ac1 1270 if {$end > $vrowmod($curview)} {
9257d8f7
PM
1271 update_arcrows $curview
1272 }
7fcc92bf
PM
1273 set ai [bsearch $vrownum($curview) $start]
1274 set start [lindex $vrownum($curview) $ai]
1275 set narc [llength $vrownum($curview)]
1276 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277 set a [lindex $varcorder($curview) $ai]
1278 set l [llength $displayorder]
1279 set al [llength $varccommits($curview,$a)]
1280 if {$l < $r + $al} {
1281 if {$l < $r} {
1282 set pad [ntimes [expr {$r - $l}] {}]
1283 set displayorder [concat $displayorder $pad]
1284 set parentlist [concat $parentlist $pad]
1285 } elseif {$l > $r} {
1286 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288 }
1289 foreach id $varccommits($curview,$a) {
1290 lappend displayorder $id
1291 lappend parentlist $parents($curview,$id)
1292 }
17529cf9 1293 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
7fcc92bf
PM
1294 set i $r
1295 foreach id $varccommits($curview,$a) {
1296 lset displayorder $i $id
1297 lset parentlist $i $parents($curview,$id)
1298 incr i
1299 }
1300 }
1301 incr r $al
1302 }
1303}
1304
1305proc commitonrow {row} {
1306 global displayorder
1307
1308 set id [lindex $displayorder $row]
1309 if {$id eq {}} {
1310 make_disporder $row [expr {$row + 1}]
1311 set id [lindex $displayorder $row]
1312 }
1313 return $id
1314}
1315
1316proc closevarcs {v} {
1317 global varctok varccommits varcid parents children
d375ef9b 1318 global cmitlisted commitidx vtokmod
7fcc92bf
PM
1319
1320 set missing_parents 0
1321 set scripts {}
1322 set narcs [llength $varctok($v)]
1323 for {set a 1} {$a < $narcs} {incr a} {
1324 set id [lindex $varccommits($v,$a) end]
1325 foreach p $parents($v,$id) {
1326 if {[info exists varcid($v,$p)]} continue
1327 # add p as a new commit
1328 incr missing_parents
1329 set cmitlisted($v,$p) 0
1330 set parents($v,$p) {}
1331 if {[llength $children($v,$p)] == 1 &&
1332 [llength $parents($v,$id)] == 1} {
1333 set b $a
1334 } else {
1335 set b [newvarc $v $p]
1336 }
1337 set varcid($v,$p) $b
9257d8f7
PM
1338 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339 modify_arc $v $b
7fcc92bf 1340 }
e5b37ac1 1341 lappend varccommits($v,$b) $p
7fcc92bf 1342 incr commitidx($v)
d375ef9b 1343 set scripts [check_interest $p $scripts]
7fcc92bf
PM
1344 }
1345 }
1346 if {$missing_parents > 0} {
7fcc92bf
PM
1347 foreach s $scripts {
1348 eval $s
1349 }
1350 }
1351}
1352
f806f0fb
PM
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356 global children parents varcid varctok vtokmod varccommits
1357
1358 foreach ch $children($v,$id) {
1359 # make $rwid be $ch's parent in place of $id
1360 set i [lsearch -exact $parents($v,$ch) $id]
1361 if {$i < 0} {
1362 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363 }
1364 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365 # add $ch to $rwid's children and sort the list if necessary
1366 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368 $children($v,$rwid)]
1369 }
1370 # fix the graph after joining $id to $rwid
1371 set a $varcid($v,$ch)
1372 fix_reversal $rwid $a $v
c9cfdc96
PM
1373 # parentlist is wrong for the last element of arc $a
1374 # even if displayorder is right, hence the 3rd arg here
1375 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
f806f0fb
PM
1376 }
1377}
1378
d375ef9b
PM
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit. To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID. Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385 global commitinterest
1386
1387 lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391 global commitinterest
1392
1393 set prefix [string range $id 0 3]
1394 if {[info exists commitinterest($prefix)]} {
1395 set newlist {}
1396 foreach {i script} $commitinterest($prefix) {
1397 if {[string match "$i*" $id]} {
1398 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399 } else {
1400 lappend newlist $i $script
1401 }
1402 }
1403 if {$newlist ne {}} {
1404 set commitinterest($prefix) $newlist
1405 } else {
1406 unset commitinterest($prefix)
1407 }
1408 }
1409 return $scripts
1410}
1411
f806f0fb 1412proc getcommitlines {fd inst view updating} {
d375ef9b 1413 global cmitlisted leftover
3ed31a81 1414 global commitidx commitdata vdatemode
7fcc92bf 1415 global parents children curview hlview
468bcaed 1416 global idpending ordertok
22387f23 1417 global varccommits varcid varctok vtokmod vfilelimit vshortids
9ccbdfbf 1418
d1e46756 1419 set stuff [read $fd 500000]
005a2f4e 1420 # git log doesn't terminate the last commit with a null...
7fcc92bf 1421 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
005a2f4e
PM
1422 set stuff "\0"
1423 }
b490a991 1424 if {$stuff == {}} {
7eb3cb9c
PM
1425 if {![eof $fd]} {
1426 return 1
1427 }
6df7403a 1428 global commfd viewcomplete viewactive viewname
7fcc92bf
PM
1429 global viewinstances
1430 unset commfd($inst)
1431 set i [lsearch -exact $viewinstances($view) $inst]
1432 if {$i >= 0} {
1433 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
b0cdca99 1434 }
f0654861 1435 # set it blocking so we wait for the process to terminate
da7c24dd 1436 fconfigure $fd -blocking 1
098dd8a3
PM
1437 if {[catch {close $fd} err]} {
1438 set fv {}
1439 if {$view != $curview} {
1440 set fv " for the \"$viewname($view)\" view"
da7c24dd 1441 }
098dd8a3
PM
1442 if {[string range $err 0 4] == "usage"} {
1443 set err "Gitk: error reading commits$fv:\
f9e0b6fb 1444 bad arguments to git log."
098dd8a3
PM
1445 if {$viewname($view) eq "Command line"} {
1446 append err \
f9e0b6fb 1447 " (Note: arguments to gitk are passed to git log\
098dd8a3
PM
1448 to allow selection of commits to be displayed.)"
1449 }
1450 } else {
1451 set err "Error reading commits$fv: $err"
1452 }
1453 error_popup $err
1d10f36d 1454 }
7fcc92bf
PM
1455 if {[incr viewactive($view) -1] <= 0} {
1456 set viewcomplete($view) 1
1457 # Check if we have seen any ids listed as parents that haven't
1458 # appeared in the list
1459 closevarcs $view
1460 notbusy $view
7fcc92bf 1461 }
098dd8a3 1462 if {$view == $curview} {
ac1276ab 1463 run chewcommits
9a40c50c 1464 }
7eb3cb9c 1465 return 0
9a40c50c 1466 }
b490a991 1467 set start 0
8f7d0cec 1468 set gotsome 0
7fcc92bf 1469 set scripts {}
b490a991
PM
1470 while 1 {
1471 set i [string first "\0" $stuff $start]
1472 if {$i < 0} {
7fcc92bf 1473 append leftover($inst) [string range $stuff $start end]
9f1afe05 1474 break
9ccbdfbf 1475 }
b490a991 1476 if {$start == 0} {
7fcc92bf 1477 set cmit $leftover($inst)
8f7d0cec 1478 append cmit [string range $stuff 0 [expr {$i - 1}]]
7fcc92bf 1479 set leftover($inst) {}
8f7d0cec
PM
1480 } else {
1481 set cmit [string range $stuff $start [expr {$i - 1}]]
b490a991
PM
1482 }
1483 set start [expr {$i + 1}]
e5ea701b
PM
1484 set j [string first "\n" $cmit]
1485 set ok 0
16c1ff96 1486 set listed 1
c961b228
PM
1487 if {$j >= 0 && [string match "commit *" $cmit]} {
1488 set ids [string range $cmit 7 [expr {$j - 1}]]
1407ade9 1489 if {[string match {[-^<>]*} $ids]} {
c961b228
PM
1490 switch -- [string index $ids 0] {
1491 "-" {set listed 0}
1407ade9
LT
1492 "^" {set listed 2}
1493 "<" {set listed 3}
1494 ">" {set listed 4}
c961b228 1495 }
16c1ff96
PM
1496 set ids [string range $ids 1 end]
1497 }
e5ea701b
PM
1498 set ok 1
1499 foreach id $ids {
8f7d0cec 1500 if {[string length $id] != 40} {
e5ea701b
PM
1501 set ok 0
1502 break
1503 }
1504 }
1505 }
1506 if {!$ok} {
7e952e79
PM
1507 set shortcmit $cmit
1508 if {[string length $shortcmit] > 80} {
1509 set shortcmit "[string range $shortcmit 0 80]..."
1510 }
d990cedf 1511 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
b490a991
PM
1512 exit 1
1513 }
e5ea701b 1514 set id [lindex $ids 0]
7fcc92bf 1515 set vid $view,$id
f806f0fb 1516
22387f23
PM
1517 lappend vshortids($view,[string range $id 0 3]) $id
1518
f806f0fb 1519 if {!$listed && $updating && ![info exists varcid($vid)] &&
3ed31a81 1520 $vfilelimit($view) ne {}} {
f806f0fb
PM
1521 # git log doesn't rewrite parents for unlisted commits
1522 # when doing path limiting, so work around that here
1523 # by working out the rewritten parent with git rev-list
1524 # and if we already know about it, using the rewritten
1525 # parent as a substitute parent for $id's children.
1526 if {![catch {
1527 set rwid [exec git rev-list --first-parent --max-count=1 \
3ed31a81 1528 $id -- $vfilelimit($view)]
f806f0fb
PM
1529 }]} {
1530 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531 # use $rwid in place of $id
1532 rewrite_commit $view $id $rwid
1533 continue
1534 }
1535 }
1536 }
1537
f1bf4ee6
PM
1538 set a 0
1539 if {[info exists varcid($vid)]} {
1540 if {$cmitlisted($vid) || !$listed} continue
1541 set a $varcid($vid)
1542 }
16c1ff96
PM
1543 if {$listed} {
1544 set olds [lrange $ids 1 end]
16c1ff96
PM
1545 } else {
1546 set olds {}
1547 }
f7a3e8d2 1548 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
7fcc92bf
PM
1549 set cmitlisted($vid) $listed
1550 set parents($vid) $olds
7fcc92bf
PM
1551 if {![info exists children($vid)]} {
1552 set children($vid) {}
f1bf4ee6 1553 } elseif {$a == 0 && [llength $children($vid)] == 1} {
f3ea5ede
PM
1554 set k [lindex $children($vid) 0]
1555 if {[llength $parents($view,$k)] == 1 &&
3ed31a81 1556 (!$vdatemode($view) ||
f3ea5ede
PM
1557 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558 set a $varcid($view,$k)
7fcc92bf 1559 }
da7c24dd 1560 }
7fcc92bf
PM
1561 if {$a == 0} {
1562 # new arc
1563 set a [newvarc $view $id]
1564 }
e5b37ac1
PM
1565 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566 modify_arc $view $a
1567 }
f1bf4ee6
PM
1568 if {![info exists varcid($vid)]} {
1569 set varcid($vid) $a
1570 lappend varccommits($view,$a) $id
1571 incr commitidx($view)
1572 }
e5b37ac1 1573
7fcc92bf
PM
1574 set i 0
1575 foreach p $olds {
1576 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577 set vp $view,$p
1578 if {[llength [lappend children($vp) $id]] > 1 &&
1579 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580 set children($vp) [lsort -command [list vtokcmp $view] \
1581 $children($vp)]
9257d8f7 1582 catch {unset ordertok}
7fcc92bf 1583 }
f3ea5ede
PM
1584 if {[info exists varcid($view,$p)]} {
1585 fix_reversal $p $a $view
1586 }
7fcc92bf
PM
1587 }
1588 incr i
1589 }
7fcc92bf 1590
d375ef9b 1591 set scripts [check_interest $id $scripts]
8f7d0cec
PM
1592 set gotsome 1
1593 }
1594 if {$gotsome} {
ac1276ab
PM
1595 global numcommits hlview
1596
1597 if {$view == $curview} {
1598 set numcommits $commitidx($view)
1599 run chewcommits
1600 }
1601 if {[info exists hlview] && $view == $hlview} {
1602 # we never actually get here...
1603 run vhighlightmore
1604 }
7fcc92bf
PM
1605 foreach s $scripts {
1606 eval $s
1607 }
9ccbdfbf 1608 }
7eb3cb9c 1609 return 2
9ccbdfbf
PM
1610}
1611
ac1276ab 1612proc chewcommits {} {
f5f3c2e2 1613 global curview hlview viewcomplete
7fcc92bf 1614 global pending_select
7eb3cb9c 1615
ac1276ab
PM
1616 layoutmore
1617 if {$viewcomplete($curview)} {
1618 global commitidx varctok
1619 global numcommits startmsecs
ac1276ab
PM
1620
1621 if {[info exists pending_select]} {
835e62ae
AG
1622 update
1623 reset_pending_select {}
1624
1625 if {[commitinview $pending_select $curview]} {
1626 selectline [rowofcommit $pending_select] 1
1627 } else {
1628 set row [first_real_row]
1629 selectline $row 1
1630 }
7eb3cb9c 1631 }
ac1276ab
PM
1632 if {$commitidx($curview) > 0} {
1633 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634 #puts "overall $ms ms for $numcommits commits"
1635 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636 } else {
1637 show_status [mc "No commits selected"]
1638 }
1639 notbusy layout
b664550c 1640 }
f5f3c2e2 1641 return 0
1db95b00
PM
1642}
1643
590915da
AG
1644proc do_readcommit {id} {
1645 global tclencoding
1646
1647 # Invoke git-log to handle automatic encoding conversion
1648 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649 # Read the results using i18n.logoutputencoding
1650 fconfigure $fd -translation lf -eofchar {}
1651 if {$tclencoding != {}} {
1652 fconfigure $fd -encoding $tclencoding
1653 }
1654 set contents [read $fd]
1655 close $fd
1656 # Remove the heading line
1657 regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659 return $contents
1660}
1661
1db95b00 1662proc readcommit {id} {
590915da
AG
1663 if {[catch {set contents [do_readcommit $id]}]} return
1664 parsecommit $id $contents 1
b490a991
PM
1665}
1666
8f7d0cec 1667proc parsecommit {id contents listed} {
ef73896b 1668 global commitinfo
b5c2f306
SV
1669
1670 set inhdr 1
1671 set comment {}
1672 set headline {}
1673 set auname {}
1674 set audate {}
1675 set comname {}
1676 set comdate {}
232475d3
PM
1677 set hdrend [string first "\n\n" $contents]
1678 if {$hdrend < 0} {
1679 # should never happen...
1680 set hdrend [string length $contents]
1681 }
1682 set header [string range $contents 0 [expr {$hdrend - 1}]]
1683 set comment [string range $contents [expr {$hdrend + 2}] end]
1684 foreach line [split $header "\n"] {
61f57cb0 1685 set line [split $line " "]
232475d3
PM
1686 set tag [lindex $line 0]
1687 if {$tag == "author"} {
f5974d97 1688 set audate [lrange $line end-1 end]
61f57cb0 1689 set auname [join [lrange $line 1 end-2] " "]
232475d3 1690 } elseif {$tag == "committer"} {
f5974d97 1691 set comdate [lrange $line end-1 end]
61f57cb0 1692 set comname [join [lrange $line 1 end-2] " "]
1db95b00
PM
1693 }
1694 }
232475d3 1695 set headline {}
43c25074
PM
1696 # take the first non-blank line of the comment as the headline
1697 set headline [string trimleft $comment]
1698 set i [string first "\n" $headline]
232475d3 1699 if {$i >= 0} {
43c25074
PM
1700 set headline [string range $headline 0 $i]
1701 }
1702 set headline [string trimright $headline]
1703 set i [string first "\r" $headline]
1704 if {$i >= 0} {
1705 set headline [string trimright [string range $headline 0 $i]]
232475d3
PM
1706 }
1707 if {!$listed} {
f9e0b6fb 1708 # git log indents the comment by 4 spaces;
8974c6f9 1709 # if we got this via git cat-file, add the indentation
232475d3
PM
1710 set newcomment {}
1711 foreach line [split $comment "\n"] {
1712 append newcomment " "
1713 append newcomment $line
f6e2869f 1714 append newcomment "\n"
232475d3
PM
1715 }
1716 set comment $newcomment
1db95b00 1717 }
36242490 1718 set hasnote [string first "\nNotes:\n" $contents]
b449eb2c
TR
1719 set diff ""
1720 # If there is diff output shown in the git-log stream, split it
1721 # out. But get rid of the empty line that always precedes the
1722 # diff.
1723 set i [string first "\n\ndiff" $comment]
1724 if {$i >= 0} {
1725 set diff [string range $comment $i+1 end]
1726 set comment [string range $comment 0 $i-1]
1727 }
e5c2d856 1728 set commitinfo($id) [list $headline $auname $audate \
b449eb2c 1729 $comname $comdate $comment $hasnote $diff]
1db95b00
PM
1730}
1731
f7a3e8d2 1732proc getcommit {id} {
79b2c75e 1733 global commitdata commitinfo
8ed16484 1734
f7a3e8d2
PM
1735 if {[info exists commitdata($id)]} {
1736 parsecommit $id $commitdata($id) 1
8ed16484
PM
1737 } else {
1738 readcommit $id
1739 if {![info exists commitinfo($id)]} {
d990cedf 1740 set commitinfo($id) [list [mc "No commit information available"]]
8ed16484
PM
1741 }
1742 }
1743 return 1
1744}
1745
d375ef9b
PM
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
22387f23 1750 global varcid curview vshortids
d375ef9b
PM
1751
1752 set ids {}
22387f23
PM
1753 if {[string length $prefix] >= 4} {
1754 set vshortid $curview,[string range $prefix 0 3]
1755 if {[info exists vshortids($vshortid)]} {
1756 foreach id $vshortids($vshortid) {
1757 if {[string match "$prefix*" $id]} {
1758 if {[lsearch -exact $ids $id] < 0} {
1759 lappend ids $id
1760 if {[llength $ids] >= 2} break
1761 }
1762 }
1763 }
1764 }
1765 } else {
1766 foreach match [array names varcid "$curview,$prefix*"] {
1767 lappend ids [lindex [split $match ","] 1]
1768 if {[llength $ids] >= 2} break
1769 }
d375ef9b
PM
1770 }
1771 return $ids
1772}
1773
887fe3c4 1774proc readrefs {} {
62d3ea65 1775 global tagids idtags headids idheads tagobjid
219ea3a9 1776 global otherrefids idotherrefs mainhead mainheadid
39816d60 1777 global selecthead selectheadid
ffe15297 1778 global hideremotes
106288cb 1779
b5c2f306
SV
1780 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781 catch {unset $v}
1782 }
62d3ea65
PM
1783 set refd [open [list | git show-ref -d] r]
1784 while {[gets $refd line] >= 0} {
1785 if {[string index $line 40] ne " "} continue
1786 set id [string range $line 0 39]
1787 set ref [string range $line 41 end]
1788 if {![string match "refs/*" $ref]} continue
1789 set name [string range $ref 5 end]
1790 if {[string match "remotes/*" $name]} {
ffe15297 1791 if {![string match "*/HEAD" $name] && !$hideremotes} {
62d3ea65
PM
1792 set headids($name) $id
1793 lappend idheads($id) $name
f1d83ba3 1794 }
62d3ea65
PM
1795 } elseif {[string match "heads/*" $name]} {
1796 set name [string range $name 6 end]
36a7cad6
JH
1797 set headids($name) $id
1798 lappend idheads($id) $name
62d3ea65
PM
1799 } elseif {[string match "tags/*" $name]} {
1800 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801 # which is what we want since the former is the commit ID
1802 set name [string range $name 5 end]
1803 if {[string match "*^{}" $name]} {
1804 set name [string range $name 0 end-3]
1805 } else {
1806 set tagobjid($name) $id
1807 }
1808 set tagids($name) $id
1809 lappend idtags($id) $name
36a7cad6
JH
1810 } else {
1811 set otherrefids($name) $id
1812 lappend idotherrefs($id) $name
f1d83ba3
PM
1813 }
1814 }
062d671f 1815 catch {close $refd}
8a48571c 1816 set mainhead {}
219ea3a9 1817 set mainheadid {}
8a48571c 1818 catch {
c11ff120 1819 set mainheadid [exec git rev-parse HEAD]
8a48571c
PM
1820 set thehead [exec git symbolic-ref HEAD]
1821 if {[string match "refs/heads/*" $thehead]} {
1822 set mainhead [string range $thehead 11 end]
1823 }
1824 }
39816d60
AG
1825 set selectheadid {}
1826 if {$selecthead ne {}} {
1827 catch {
1828 set selectheadid [exec git rev-parse --verify $selecthead]
1829 }
1830 }
887fe3c4
PM
1831}
1832
8f489363
PM
1833# skip over fake commits
1834proc first_real_row {} {
7fcc92bf 1835 global nullid nullid2 numcommits
8f489363
PM
1836
1837 for {set row 0} {$row < $numcommits} {incr row} {
7fcc92bf 1838 set id [commitonrow $row]
8f489363
PM
1839 if {$id ne $nullid && $id ne $nullid2} {
1840 break
1841 }
1842 }
1843 return $row
1844}
1845
e11f1233
PM
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848 global headids idheads
1849
1850 removehead $headids($name) $name
1851 set headids($name) $id
1852 lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857 global headids idheads
1858
1859 if {$idheads($id) eq $name} {
1860 unset idheads($id)
1861 } else {
1862 set i [lsearch -exact $idheads($id) $name]
1863 if {$i >= 0} {
1864 set idheads($id) [lreplace $idheads($id) $i $i]
1865 }
1866 }
1867 unset headids($name)
1868}
1869
d93f1713
PT
1870proc ttk_toplevel {w args} {
1871 global use_ttk
1872 eval [linsert $args 0 ::toplevel $w]
1873 if {$use_ttk} {
1874 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875 }
1876 return $w
1877}
1878
e7d64008
AG
1879proc make_transient {window origin} {
1880 global have_tk85
1881
1882 # In MacOS Tk 8.4 transient appears to work by setting
1883 # overrideredirect, which is utterly useless, since the
1884 # windows get no border, and are not even kept above
1885 # the parent.
1886 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888 wm transient $window $origin
1889
1890 # Windows fails to place transient windows normally, so
1891 # schedule a callback to center them on the parent.
1892 if {[tk windowingsystem] eq {win32}} {
1893 after idle [list tk::PlaceWindow $window widget $origin]
1894 }
1895}
1896
8d849957 1897proc show_error {w top msg {mc mc}} {
d93f1713 1898 global NS
3cb1f9c9 1899 if {![info exists NS]} {set NS ""}
d93f1713 1900 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
df3d83b1
PM
1901 message $w.m -text $msg -justify center -aspect 400
1902 pack $w.m -side top -fill x -padx 20 -pady 20
7a0ebbf8 1903 ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
df3d83b1 1904 pack $w.ok -side bottom -fill x
e54be9e3
PM
1905 bind $top <Visibility> "grab $top; focus $top"
1906 bind $top <Key-Return> "destroy $top"
76f15947
AG
1907 bind $top <Key-space> "destroy $top"
1908 bind $top <Key-Escape> "destroy $top"
e54be9e3 1909 tkwait window $top
df3d83b1
PM
1910}
1911
84a76f18 1912proc error_popup {msg {owner .}} {
d93f1713
PT
1913 if {[tk windowingsystem] eq "win32"} {
1914 tk_messageBox -icon error -type ok -title [wm title .] \
1915 -parent $owner -message $msg
1916 } else {
1917 set w .error
1918 ttk_toplevel $w
1919 make_transient $w $owner
1920 show_error $w $w $msg
1921 }
098dd8a3
PM
1922}
1923
84a76f18 1924proc confirm_popup {msg {owner .}} {
d93f1713 1925 global confirm_ok NS
10299152
PM
1926 set confirm_ok 0
1927 set w .confirm
d93f1713 1928 ttk_toplevel $w
e7d64008 1929 make_transient $w $owner
10299152
PM
1930 message $w.m -text $msg -justify center -aspect 400
1931 pack $w.m -side top -fill x -padx 20 -pady 20
d93f1713 1932 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
10299152 1933 pack $w.ok -side left -fill x
d93f1713 1934 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
10299152
PM
1935 pack $w.cancel -side right -fill x
1936 bind $w <Visibility> "grab $w; focus $w"
76f15947
AG
1937 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1939 bind $w <Key-Escape> "destroy $w"
d93f1713 1940 tk::PlaceWindow $w widget $owner
10299152
PM
1941 tkwait window $w
1942 return $confirm_ok
1943}
1944
b039f0a6 1945proc setoptions {} {
d93f1713
PT
1946 if {[tk windowingsystem] ne "win32"} {
1947 option add *Panedwindow.showHandle 1 startupFile
1948 option add *Panedwindow.sashRelief raised startupFile
1949 if {[tk windowingsystem] ne "aqua"} {
1950 option add *Menu.font uifont startupFile
1951 }
1952 } else {
1953 option add *Menu.TearOff 0 startupFile
1954 }
b039f0a6
PM
1955 option add *Button.font uifont startupFile
1956 option add *Checkbutton.font uifont startupFile
1957 option add *Radiobutton.font uifont startupFile
b039f0a6
PM
1958 option add *Menubutton.font uifont startupFile
1959 option add *Label.font uifont startupFile
1960 option add *Message.font uifont startupFile
b9b142ff
MH
1961 option add *Entry.font textfont startupFile
1962 option add *Text.font textfont startupFile
d93f1713 1963 option add *Labelframe.font uifont startupFile
0933b04e 1964 option add *Spinbox.font textfont startupFile
207ad7b8 1965 option add *Listbox.font mainfont startupFile
b039f0a6
PM
1966}
1967
79056034
PM
1968# Make a menu and submenus.
1969# m is the window name for the menu, items is the list of menu items to add.
1970# Each item is a list {mc label type description options...}
1971# mc is ignored; it's so we can put mc there to alert xgettext
1972# label is the string that appears in the menu
1973# type is cascade, command or radiobutton (should add checkbutton)
1974# description depends on type; it's the sublist for cascade, the
1975# command to invoke for command, or {variable value} for radiobutton
f2d0bbbd
PM
1976proc makemenu {m items} {
1977 menu $m
cea07cf8
AG
1978 if {[tk windowingsystem] eq {aqua}} {
1979 set Meta1 Cmd
1980 } else {
1981 set Meta1 Ctrl
1982 }
f2d0bbbd 1983 foreach i $items {
79056034
PM
1984 set name [mc [lindex $i 1]]
1985 set type [lindex $i 2]
1986 set thing [lindex $i 3]
f2d0bbbd
PM
1987 set params [list $type]
1988 if {$name ne {}} {
1989 set u [string first "&" [string map {&& x} $name]]
1990 lappend params -label [string map {&& & & {}} $name]
1991 if {$u >= 0} {
1992 lappend params -underline $u
1993 }
1994 }
1995 switch -- $type {
1996 "cascade" {
79056034 1997 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
f2d0bbbd
PM
1998 lappend params -menu $m.$submenu
1999 }
2000 "command" {
2001 lappend params -command $thing
2002 }
2003 "radiobutton" {
2004 lappend params -variable [lindex $thing 0] \
2005 -value [lindex $thing 1]
2006 }
2007 }
cea07cf8
AG
2008 set tail [lrange $i 4 end]
2009 regsub -all {\yMeta1\y} $tail $Meta1 tail
2010 eval $m add $params $tail
f2d0bbbd
PM
2011 if {$type eq "cascade"} {
2012 makemenu $m.$submenu $thing
2013 }
2014 }
2015}
2016
2017# translate string and remove ampersands
2018proc mca {str} {
2019 return [string map {&& & & {}} [mc $str]]
2020}
2021
39c12691
PM
2022proc cleardropsel {w} {
2023 $w selection clear
2024}
d93f1713
PT
2025proc makedroplist {w varname args} {
2026 global use_ttk
2027 if {$use_ttk} {
3cb1f9c9
PT
2028 set width 0
2029 foreach label $args {
2030 set cx [string length $label]
2031 if {$cx > $width} {set width $cx}
2032 }
2033 set gm [ttk::combobox $w -width $width -state readonly\
39c12691
PM
2034 -textvariable $varname -values $args \
2035 -exportselection false]
2036 bind $gm <<ComboboxSelected>> [list $gm selection clear]
d93f1713
PT
2037 } else {
2038 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039 }
2040 return $gm
2041}
2042
d94f8cd6 2043proc makewindow {} {
31c0eaa8 2044 global canv canv2 canv3 linespc charspc ctext cflist cscroll
9c311b32 2045 global tabstop
b74fd579 2046 global findtype findtypemenu findloc findstring fstring geometry
887fe3c4 2047 global entries sha1entry sha1string sha1but
890fae70 2048 global diffcontextstring diffcontext
b9b86007 2049 global ignorespace
94a2eede 2050 global maincursor textcursor curtextcursor
219ea3a9 2051 global rowctxmenu fakerowmenu mergemax wrapcomment
60f7a7dc 2052 global highlight_files gdttype
3ea06f9f 2053 global searchstring sstring
60378c0c 2054 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
252c52df
2055 global uifgcolor uifgdisabledcolor
2056 global filesepbgcolor filesepfgcolor
2057 global mergecolors foundbgcolor currentsearchhitbgcolor
bb3edc8b
PM
2058 global headctxmenu progresscanv progressitem progresscoords statusw
2059 global fprogitem fprogcoord lastprogupdate progupdatepending
6df7403a 2060 global rprogitem rprogcoord rownumsel numcommits
d93f1713 2061 global have_tk85 use_ttk NS
ae4e3ff9
TR
2062 global git_version
2063 global worddiff
9a40c50c 2064
79056034
PM
2065 # The "mc" arguments here are purely so that xgettext
2066 # sees the following string as needing to be translated
5fdcbb13
DS
2067 set file {
2068 mc "File" cascade {
79056034 2069 {mc "Update" command updatecommits -accelerator F5}
a135f214 2070 {mc "Reload" command reloadcommits -accelerator Shift-F5}
79056034 2071 {mc "Reread references" command rereadrefs}
cea07cf8 2072 {mc "List references" command showrefs -accelerator F2}
7fb0abb1
AG
2073 {xx "" separator}
2074 {mc "Start git gui" command {exec git gui &}}
2075 {xx "" separator}
cea07cf8 2076 {mc "Quit" command doquit -accelerator Meta1-Q}
f2d0bbbd 2077 }}
5fdcbb13
DS
2078 set edit {
2079 mc "Edit" cascade {
79056034 2080 {mc "Preferences" command doprefs}
f2d0bbbd 2081 }}
5fdcbb13
DS
2082 set view {
2083 mc "View" cascade {
cea07cf8
AG
2084 {mc "New view..." command {newview 0} -accelerator Shift-F4}
2085 {mc "Edit view..." command editview -state disabled -accelerator F4}
79056034
PM
2086 {mc "Delete view" command delview -state disabled}
2087 {xx "" separator}
2088 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
f2d0bbbd 2089 }}
5fdcbb13
DS
2090 if {[tk windowingsystem] ne "aqua"} {
2091 set help {
2092 mc "Help" cascade {
2093 {mc "About gitk" command about}
2094 {mc "Key bindings" command keys}
2095 }}
2096 set bar [list $file $edit $view $help]
2097 } else {
2098 proc ::tk::mac::ShowPreferences {} {doprefs}
2099 proc ::tk::mac::Quit {} {doquit}
2100 lset file end [lreplace [lindex $file end] end-1 end]
2101 set apple {
2102 xx "Apple" cascade {
79056034 2103 {mc "About gitk" command about}
5fdcbb13
DS
2104 {xx "" separator}
2105 }}
2106 set help {
2107 mc "Help" cascade {
79056034 2108 {mc "Key bindings" command keys}
f2d0bbbd 2109 }}
5fdcbb13 2110 set bar [list $apple $file $view $help]
f2d0bbbd 2111 }
5fdcbb13 2112 makemenu .bar $bar
9a40c50c
PM
2113 . configure -menu .bar
2114
d93f1713
PT
2115 if {$use_ttk} {
2116 # cover the non-themed toplevel with a themed frame.
2117 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118 }
2119
e9937d2a 2120 # the gui has upper and lower half, parts of a paned window.
d93f1713 2121 ${NS}::panedwindow .ctop -orient vertical
e9937d2a
JH
2122
2123 # possibly use assumed geometry
9ca72f4f 2124 if {![info exists geometry(pwsash0)]} {
e9937d2a
JH
2125 set geometry(topheight) [expr {15 * $linespc}]
2126 set geometry(topwidth) [expr {80 * $charspc}]
2127 set geometry(botheight) [expr {15 * $linespc}]
2128 set geometry(botwidth) [expr {50 * $charspc}]
d93f1713
PT
2129 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
e9937d2a
JH
2131 }
2132
2133 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
d93f1713
PT
2134 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135 ${NS}::frame .tf.histframe
2136 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137 if {!$use_ttk} {
2138 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139 }
e9937d2a
JH
2140
2141 # create three canvases
2142 set cscroll .tf.histframe.csb
2143 set canv .tf.histframe.pwclist.canv
9ca72f4f 2144 canvas $canv \
60378c0c 2145 -selectbackground $selectbgcolor \
f8a2c0d1 2146 -background $bgcolor -bd 0 \
9f1afe05 2147 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
e9937d2a
JH
2148 .tf.histframe.pwclist add $canv
2149 set canv2 .tf.histframe.pwclist.canv2
9ca72f4f 2150 canvas $canv2 \
60378c0c 2151 -selectbackground $selectbgcolor \
f8a2c0d1 2152 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a
JH
2153 .tf.histframe.pwclist add $canv2
2154 set canv3 .tf.histframe.pwclist.canv3
9ca72f4f 2155 canvas $canv3 \
60378c0c 2156 -selectbackground $selectbgcolor \
f8a2c0d1 2157 -background $bgcolor -bd 0 -yscrollincr $linespc
e9937d2a 2158 .tf.histframe.pwclist add $canv3
d93f1713
PT
2159 if {$use_ttk} {
2160 bind .tf.histframe.pwclist <Map> {
2161 bind %W <Map> {}
2162 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164 }
2165 } else {
2166 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168 }
e9937d2a
JH
2169
2170 # a scroll bar to rule them
d93f1713
PT
2171 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
e9937d2a
JH
2173 pack $cscroll -side right -fill y
2174 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
f8a2c0d1 2175 lappend bglist $canv $canv2 $canv3
e9937d2a 2176 pack .tf.histframe.pwclist -fill both -expand 1 -side left
98f350e5 2177
e9937d2a 2178 # we have two button bars at bottom of top frame. Bar 1
d93f1713
PT
2179 ${NS}::frame .tf.bar
2180 ${NS}::frame .tf.lbar -height 15
e9937d2a
JH
2181
2182 set sha1entry .tf.bar.sha1
887fe3c4 2183 set entries $sha1entry
e9937d2a 2184 set sha1but .tf.bar.sha1label
0359ba72 2185 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
b039f0a6 2186 -command gotocommit -width 8
887fe3c4 2187 $sha1but conf -disabledforeground [$sha1but cget -foreground]
e9937d2a 2188 pack .tf.bar.sha1label -side left
d93f1713 2189 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
887fe3c4 2190 trace add variable sha1string write sha1change
98f350e5 2191 pack $sha1entry -side left -pady 2
d698206c 2192
f062e50f 2193 set bm_left_data {
d698206c
PM
2194 #define left_width 16
2195 #define left_height 16
2196 static unsigned char left_bits[] = {
2197 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200 }
f062e50f 2201 set bm_right_data {
d698206c
PM
2202 #define right_width 16
2203 #define right_height 16
2204 static unsigned char right_bits[] = {
2205 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208 }
252c52df
2209 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
f062e50f 2213
62e9ac5e
MK
2214 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215 if {$use_ttk} {
2216 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217 } else {
2218 .tf.bar.leftbut configure -image bm-left
2219 }
e9937d2a 2220 pack .tf.bar.leftbut -side left -fill y
62e9ac5e
MK
2221 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222 if {$use_ttk} {
2223 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224 } else {
2225 .tf.bar.rightbut configure -image bm-right
2226 }
e9937d2a 2227 pack .tf.bar.rightbut -side left -fill y
d698206c 2228
d93f1713 2229 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
6df7403a 2230 set rownumsel {}
d93f1713 2231 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
6df7403a 2232 -relief sunken -anchor e
d93f1713
PT
2233 ${NS}::label .tf.bar.rowlabel2 -text "/"
2234 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
6df7403a
PM
2235 -relief sunken -anchor e
2236 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237 -side left
d93f1713
PT
2238 if {!$use_ttk} {
2239 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240 }
6df7403a 2241 global selectedline
94b4a69f 2242 trace add variable selectedline write selectedline_change
6df7403a 2243
bb3edc8b
PM
2244 # Status label and progress bar
2245 set statusw .tf.bar.status
d93f1713 2246 ${NS}::label $statusw -width 15 -relief sunken
bb3edc8b 2247 pack $statusw -side left -padx 5
d93f1713
PT
2248 if {$use_ttk} {
2249 set progresscanv [ttk::progressbar .tf.bar.progress]
2250 } else {
2251 set h [expr {[font metrics uifont -linespace] + 2}]
2252 set progresscanv .tf.bar.progress
2253 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257 }
2258 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
bb3edc8b
PM
2259 set progresscoords {0 0}
2260 set fprogcoord 0
a137a90f 2261 set rprogcoord 0
bb3edc8b
PM
2262 bind $progresscanv <Configure> adjustprogress
2263 set lastprogupdate [clock clicks -milliseconds]
2264 set progupdatepending 0
2265
687c8765 2266 # build up the bottom bar of upper window
d93f1713 2267 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
786f15c8
MB
2268
2269 set bm_down_data {
2270 #define down_width 16
2271 #define down_height 16
2272 static unsigned char down_bits[] = {
2273 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277 }
2278 image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279 ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280 .tf.lbar.fnext configure -image bm-down
2281
2282 set bm_up_data {
2283 #define up_width 16
2284 #define up_height 16
2285 static unsigned char up_bits[] = {
2286 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290 }
2291 image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292 ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293 .tf.lbar.fprev configure -image bm-up
2294
d93f1713 2295 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
786f15c8 2296
687c8765
PM
2297 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298 -side left -fill y
b007ee20 2299 set gdttype [mc "containing:"]
3cb1f9c9 2300 set gm [makedroplist .tf.lbar.gdttype gdttype \
b007ee20
CS
2301 [mc "containing:"] \
2302 [mc "touching paths:"] \
c33cb908
ML
2303 [mc "adding/removing string:"] \
2304 [mc "changing lines matching:"]]
687c8765 2305 trace add variable gdttype write gdttype_change
687c8765
PM
2306 pack .tf.lbar.gdttype -side left -fill y
2307
98f350e5 2308 set findstring {}
687c8765 2309 set fstring .tf.lbar.findstring
887fe3c4 2310 lappend entries $fstring
b9b142ff 2311 ${NS}::entry $fstring -width 30 -textvariable findstring
60f7a7dc 2312 trace add variable findstring write find_change
b007ee20 2313 set findtype [mc "Exact"]
d93f1713
PT
2314 set findtypemenu [makedroplist .tf.lbar.findtype \
2315 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
687c8765 2316 trace add variable findtype write findcom_change
b007ee20 2317 set findloc [mc "All fields"]
d93f1713 2318 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
b007ee20 2319 [mc "Comments"] [mc "Author"] [mc "Committer"]
60f7a7dc 2320 trace add variable findloc write find_change
687c8765
PM
2321 pack .tf.lbar.findloc -side right
2322 pack .tf.lbar.findtype -side right
2323 pack $fstring -side left -expand 1 -fill x
e9937d2a
JH
2324
2325 # Finish putting the upper half of the viewer together
2326 pack .tf.lbar -in .tf -side bottom -fill x
2327 pack .tf.bar -in .tf -side bottom -fill x
2328 pack .tf.histframe -fill both -side top -expand 1
2329 .ctop add .tf
d93f1713
PT
2330 if {!$use_ttk} {
2331 .ctop paneconfigure .tf -height $geometry(topheight)
2332 .ctop paneconfigure .tf -width $geometry(topwidth)
2333 }
e9937d2a
JH
2334
2335 # now build up the bottom
d93f1713 2336 ${NS}::panedwindow .pwbottom -orient horizontal
e9937d2a
JH
2337
2338 # lower left, a text box over search bar, scroll bar to the right
2339 # if we know window height, then that will set the lower text height, otherwise
2340 # we set lower text height which will drive window height
2341 if {[info exists geometry(main)]} {
d93f1713 2342 ${NS}::frame .bleft -width $geometry(botwidth)
e9937d2a 2343 } else {
d93f1713 2344 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
e9937d2a 2345 }
d93f1713
PT
2346 ${NS}::frame .bleft.top
2347 ${NS}::frame .bleft.mid
2348 ${NS}::frame .bleft.bottom
e9937d2a 2349
d93f1713 2350 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
e9937d2a
JH
2351 pack .bleft.top.search -side left -padx 5
2352 set sstring .bleft.top.sstring
d93f1713 2353 set searchstring ""
b9b142ff 2354 ${NS}::entry $sstring -width 20 -textvariable searchstring
3ea06f9f
PM
2355 lappend entries $sstring
2356 trace add variable searchstring write incrsearch
2357 pack $sstring -side left -expand 1 -fill x
d93f1713 2358 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
a8d610a2 2359 -command changediffdisp -variable diffelide -value {0 0}
d93f1713 2360 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
a8d610a2 2361 -command changediffdisp -variable diffelide -value {0 1}
d93f1713 2362 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
a8d610a2 2363 -command changediffdisp -variable diffelide -value {1 0}
d93f1713 2364 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
a8d610a2 2365 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
0933b04e 2366 spinbox .bleft.mid.diffcontext -width 5 \
a41ddbb6 2367 -from 0 -increment 1 -to 10000000 \
890fae70
SP
2368 -validate all -validatecommand "diffcontextvalidate %P" \
2369 -textvariable diffcontextstring
2370 .bleft.mid.diffcontext set $diffcontext
2371 trace add variable diffcontextstring write diffcontextchange
2372 lappend entries .bleft.mid.diffcontext
2373 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
d93f1713 2374 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
b9b86007
SP
2375 -command changeignorespace -variable ignorespace
2376 pack .bleft.mid.ignspace -side left -padx 5
ae4e3ff9
TR
2377
2378 set worddiff [mc "Line diff"]
2379 if {[package vcompare $git_version "1.7.2"] >= 0} {
2380 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381 [mc "Markup words"] [mc "Color words"]
2382 trace add variable worddiff write changeworddiff
2383 pack .bleft.mid.worddiff -side left -padx 5
2384 }
2385
8809d691 2386 set ctext .bleft.bottom.ctext
f8a2c0d1 2387 text $ctext -background $bgcolor -foreground $fgcolor \
9c311b32 2388 -state disabled -font textfont \
8809d691
PK
2389 -yscrollcommand scrolltext -wrap none \
2390 -xscrollcommand ".bleft.bottom.sbhorizontal set"
32f1b3e4
PM
2391 if {$have_tk85} {
2392 $ctext conf -tabstyle wordprocessor
2393 }
d93f1713
PT
2394 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
e9937d2a 2396 pack .bleft.top -side top -fill x
a8d610a2 2397 pack .bleft.mid -side top -fill x
8809d691
PK
2398 grid $ctext .bleft.bottom.sb -sticky nsew
2399 grid .bleft.bottom.sbhorizontal -sticky ew
2400 grid columnconfigure .bleft.bottom 0 -weight 1
2401 grid rowconfigure .bleft.bottom 0 -weight 1
2402 grid rowconfigure .bleft.bottom 1 -weight 0
2403 pack .bleft.bottom -side top -fill both -expand 1
f8a2c0d1
PM
2404 lappend bglist $ctext
2405 lappend fglist $ctext
d2610d11 2406
f1b86294 2407 $ctext tag conf comment -wrap $wrapcomment
252c52df 2408 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
f8a2c0d1
PM
2409 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410 $ctext tag conf d0 -fore [lindex $diffcolors 0]
8b07dca1 2411 $ctext tag conf dresult -fore [lindex $diffcolors 1]
252c52df
2412 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427 $ctext tag conf m15 -fore [lindex $mergecolors 15]
712fcc08 2428 $ctext tag conf mmax -fore darkgrey
b77b0278 2429 set mergemax 16
9c311b32
PM
2430 $ctext tag conf mresult -font textfontbold
2431 $ctext tag conf msep -font textfontbold
252c52df
2432 $ctext tag conf found -back $foundbgcolor
2433 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
76d64ca6 2434 $ctext tag conf wwrap -wrap word -lmargin2 1c
4399fe33 2435 $ctext tag conf bold -font textfontbold
e5c2d856 2436
e9937d2a 2437 .pwbottom add .bleft
d93f1713
PT
2438 if {!$use_ttk} {
2439 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440 }
e9937d2a
JH
2441
2442 # lower right
d93f1713
PT
2443 ${NS}::frame .bright
2444 ${NS}::frame .bright.mode
2445 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
f8b28a40 2446 -command reselectline -variable cmitmode -value "patch"
d93f1713 2447 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
f8b28a40 2448 -command reselectline -variable cmitmode -value "tree"
e9937d2a
JH
2449 grid .bright.mode.patch .bright.mode.tree -sticky ew
2450 pack .bright.mode -side top -fill x
2451 set cflist .bright.cfiles
9c311b32 2452 set indent [font measure mainfont "nn"]
e9937d2a 2453 text $cflist \
60378c0c 2454 -selectbackground $selectbgcolor \
f8a2c0d1 2455 -background $bgcolor -foreground $fgcolor \
9c311b32 2456 -font mainfont \
7fcceed7 2457 -tabs [list $indent [expr {2 * $indent}]] \
e9937d2a 2458 -yscrollcommand ".bright.sb set" \
7fcceed7
PM
2459 -cursor [. cget -cursor] \
2460 -spacing1 1 -spacing3 1
f8a2c0d1
PM
2461 lappend bglist $cflist
2462 lappend fglist $cflist
d93f1713 2463 ${NS}::scrollbar .bright.sb -command "$cflist yview"
e9937d2a 2464 pack .bright.sb -side right -fill y
d2610d11 2465 pack $cflist -side left -fill both -expand 1
89b11d3b
PM
2466 $cflist tag configure highlight \
2467 -background [$cflist cget -selectbackground]
9c311b32 2468 $cflist tag configure bold -font mainfontbold
d2610d11 2469
e9937d2a
JH
2470 .pwbottom add .bright
2471 .ctop add .pwbottom
1db95b00 2472
b9bee115 2473 # restore window width & height if known
e9937d2a 2474 if {[info exists geometry(main)]} {
b9bee115
PM
2475 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476 if {$w > [winfo screenwidth .]} {
2477 set w [winfo screenwidth .]
2478 }
2479 if {$h > [winfo screenheight .]} {
2480 set h [winfo screenheight .]
2481 }
2482 wm geometry . "${w}x$h"
2483 }
e9937d2a
JH
2484 }
2485
c876dbad
PT
2486 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487 wm state . $geometry(state)
2488 }
2489
d23d98d3
SP
2490 if {[tk windowingsystem] eq {aqua}} {
2491 set M1B M1
5fdcbb13 2492 set ::BM "3"
d23d98d3
SP
2493 } else {
2494 set M1B Control
5fdcbb13 2495 set ::BM "2"
d23d98d3
SP
2496 }
2497
d93f1713
PT
2498 if {$use_ttk} {
2499 bind .ctop <Map> {
2500 bind %W <Map> {}
2501 %W sashpos 0 $::geometry(topheight)
2502 }
2503 bind .pwbottom <Map> {
2504 bind %W <Map> {}
2505 %W sashpos 0 $::geometry(botwidth)
2506 }
2507 }
2508
e9937d2a
JH
2509 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510 pack .ctop -fill both -expand 1
c8dfbcf9
PM
2511 bindall <1> {selcanvline %W %x %y}
2512 #bindall <B1-Motion> {selcanvline %W %x %y}
314c3093
ML
2513 if {[tk windowingsystem] == "win32"} {
2514 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516 } else {
2517 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
122b8079
GM
2519 bind $ctext <Button> {
2520 if {"%b" eq 6} {
2521 $ctext xview scroll -5 units
2522 } elseif {"%b" eq 7} {
2523 $ctext xview scroll 5 units
2524 }
2525 }
5dd57d51
JS
2526 if {[tk windowingsystem] eq "aqua"} {
2527 bindall <MouseWheel> {
2528 set delta [expr {- (%D)}]
2529 allcanvs yview scroll $delta units
2530 }
5fdcbb13
DS
2531 bindall <Shift-MouseWheel> {
2532 set delta [expr {- (%D)}]
2533 $canv xview scroll $delta units
2534 }
5dd57d51 2535 }
314c3093 2536 }
5fdcbb13
DS
2537 bindall <$::BM> "canvscan mark %W %x %y"
2538 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
decd0a1e
JL
2539 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2540 bind . <$M1B-Key-w> doquit
6e5f7203
RN
2541 bindkey <Home> selfirstline
2542 bindkey <End> sellastline
17386066
PM
2543 bind . <Key-Up> "selnextline -1"
2544 bind . <Key-Down> "selnextline 1"
cca5d946
PM
2545 bind . <Shift-Key-Up> "dofind -1 0"
2546 bind . <Shift-Key-Down> "dofind 1 0"
6e5f7203
RN
2547 bindkey <Key-Right> "goforw"
2548 bindkey <Key-Left> "goback"
2549 bind . <Key-Prior> "selnextpage -1"
2550 bind . <Key-Next> "selnextpage 1"
d23d98d3
SP
2551 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2552 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2553 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2554 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2555 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2556 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
cfb4563c
PM
2557 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2558 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2559 bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1
PM
2560 bindkey p "selnextline -1"
2561 bindkey n "selnextline 1"
6e2dda35
RS
2562 bindkey z "goback"
2563 bindkey x "goforw"
811c70fc
JN
2564 bindkey k "selnextline -1"
2565 bindkey j "selnextline 1"
2566 bindkey h "goback"
6e2dda35 2567 bindkey l "goforw"
f4c54b3c 2568 bindkey b prevfile
cfb4563c
PM
2569 bindkey d "$ctext yview scroll 18 units"
2570 bindkey u "$ctext yview scroll -18 units"
97bed034 2571 bindkey / {focus $fstring}
b6e192db 2572 bindkey <Key-KP_Divide> {focus $fstring}
cca5d946
PM
2573 bindkey <Key-Return> {dofind 1 1}
2574 bindkey ? {dofind -1 1}
39ad8570 2575 bindkey f nextfile
cea07cf8 2576 bind . <F5> updatecommits
ebb91db8 2577 bindmodfunctionkey Shift 5 reloadcommits
cea07cf8 2578 bind . <F2> showrefs
69ecfcd6 2579 bindmodfunctionkey Shift 4 {newview 0}
cea07cf8 2580 bind . <F4> edit_or_newview
d23d98d3 2581 bind . <$M1B-q> doquit
cca5d946
PM
2582 bind . <$M1B-f> {dofind 1 1}
2583 bind . <$M1B-g> {dofind 1 0}
d23d98d3
SP
2584 bind . <$M1B-r> dosearchback
2585 bind . <$M1B-s> dosearch
2586 bind . <$M1B-equal> {incrfont 1}
646f3a14 2587 bind . <$M1B-plus> {incrfont 1}
d23d98d3
SP
2588 bind . <$M1B-KP_Add> {incrfont 1}
2589 bind . <$M1B-minus> {incrfont -1}
2590 bind . <$M1B-KP_Subtract> {incrfont -1}
b6047c5a 2591 wm protocol . WM_DELETE_WINDOW doquit
e2f90ee4 2592 bind . <Destroy> {stop_backends}
df3d83b1 2593 bind . <Button-1> "click %W"
cca5d946 2594 bind $fstring <Key-Return> {dofind 1 1}
968ce45c 2595 bind $sha1entry <Key-Return> {gotocommit; break}
ee3dc72e 2596 bind $sha1entry <<PasteSelection>> clearsha1
ada2ea16 2597 bind $sha1entry <<Paste>> clearsha1
7fcceed7
PM
2598 bind $cflist <1> {sel_flist %W %x %y; break}
2599 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
f8b28a40 2600 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
d277e89f
PM
2601 global ctxbut
2602 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
7cdc3556 2603 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
4adcbea0 2604 bind $ctext <Button-1> {focus %W}
c4614994 2605 bind $ctext <<Selection>> rehighlight_search_results
d4ec30b2
MK
2606 for {set i 1} {$i < 10} {incr i} {
2607 bind . <$M1B-Key-$i> [list go_to_parent $i]
2608 }
ea13cba1
PM
2609
2610 set maincursor [. cget -cursor]
2611 set textcursor [$ctext cget -cursor]
94a2eede 2612 set curtextcursor $textcursor
84ba7345 2613
c8dfbcf9 2614 set rowctxmenu .rowctxmenu
f2d0bbbd 2615 makemenu $rowctxmenu {
79056034
PM
2616 {mc "Diff this -> selected" command {diffvssel 0}}
2617 {mc "Diff selected -> this" command {diffvssel 1}}
2618 {mc "Make patch" command mkpatch}
2619 {mc "Create tag" command mktag}
2620 {mc "Write commit to file" command writecommit}
2621 {mc "Create new branch" command mkbranch}
2622 {mc "Cherry-pick this commit" command cherrypick}
2623 {mc "Reset HEAD branch to here" command resethead}
b9fdba7f
PM
2624 {mc "Mark this commit" command markhere}
2625 {mc "Return to mark" command gotomark}
2626 {mc "Find descendant of this and mark" command find_common_desc}
010509f2 2627 {mc "Compare with marked commit" command compare_commits}
6febdede
PM
2628 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2629 {mc "Diff marked commit -> this" command {diffvsmark 1}}
8f3ff933 2630 {mc "Revert this commit" command revert}
f2d0bbbd
PM
2631 }
2632 $rowctxmenu configure -tearoff 0
10299152 2633
219ea3a9 2634 set fakerowmenu .fakerowmenu
f2d0bbbd 2635 makemenu $fakerowmenu {
79056034
PM
2636 {mc "Diff this -> selected" command {diffvssel 0}}
2637 {mc "Diff selected -> this" command {diffvssel 1}}
2638 {mc "Make patch" command mkpatch}
6febdede
PM
2639 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2640 {mc "Diff marked commit -> this" command {diffvsmark 1}}
f2d0bbbd
PM
2641 }
2642 $fakerowmenu configure -tearoff 0
219ea3a9 2643
10299152 2644 set headctxmenu .headctxmenu
f2d0bbbd 2645 makemenu $headctxmenu {
79056034
PM
2646 {mc "Check out this branch" command cobranch}
2647 {mc "Remove this branch" command rmbranch}
f2d0bbbd
PM
2648 }
2649 $headctxmenu configure -tearoff 0
3244729a
PM
2650
2651 global flist_menu
2652 set flist_menu .flistctxmenu
f2d0bbbd 2653 makemenu $flist_menu {
79056034
PM
2654 {mc "Highlight this too" command {flist_hl 0}}
2655 {mc "Highlight this only" command {flist_hl 1}}
2656 {mc "External diff" command {external_diff}}
2657 {mc "Blame parent commit" command {external_blame 1}}
f2d0bbbd
PM
2658 }
2659 $flist_menu configure -tearoff 0
7cdc3556
AG
2660
2661 global diff_menu
2662 set diff_menu .diffctxmenu
2663 makemenu $diff_menu {
8a897742 2664 {mc "Show origin of this line" command show_line_source}
7cdc3556
AG
2665 {mc "Run git gui blame on this line" command {external_blame_diff}}
2666 }
2667 $diff_menu configure -tearoff 0
df3d83b1
PM
2668}
2669
314c3093
ML
2670# Windows sends all mouse wheel events to the current focused window, not
2671# the one where the mouse hovers, so bind those events here and redirect
2672# to the correct window
2673proc windows_mousewheel_redirector {W X Y D} {
2674 global canv canv2 canv3
2675 set w [winfo containing -displayof $W $X $Y]
2676 if {$w ne ""} {
2677 set u [expr {$D < 0 ? 5 : -5}]
2678 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2679 allcanvs yview scroll $u units
2680 } else {
2681 catch {
2682 $w yview scroll $u units
2683 }
2684 }
2685 }
2686}
2687
6df7403a
PM
2688# Update row number label when selectedline changes
2689proc selectedline_change {n1 n2 op} {
2690 global selectedline rownumsel
2691
94b4a69f 2692 if {$selectedline eq {}} {
6df7403a
PM
2693 set rownumsel {}
2694 } else {
2695 set rownumsel [expr {$selectedline + 1}]
2696 }
2697}
2698
be0cd098
PM
2699# mouse-2 makes all windows scan vertically, but only the one
2700# the cursor is in scans horizontally
2701proc canvscan {op w x y} {
2702 global canv canv2 canv3
2703 foreach c [list $canv $canv2 $canv3] {
2704 if {$c == $w} {
2705 $c scan $op $x $y
2706 } else {
2707 $c scan $op 0 $y
2708 }
2709 }
2710}
2711
9f1afe05
PM
2712proc scrollcanv {cscroll f0 f1} {
2713 $cscroll set $f0 $f1
31c0eaa8 2714 drawvisible
908c3585 2715 flushhighlights
9f1afe05
PM
2716}
2717
df3d83b1
PM
2718# when we make a key binding for the toplevel, make sure
2719# it doesn't get triggered when that key is pressed in the
2720# find string entry widget.
2721proc bindkey {ev script} {
887fe3c4 2722 global entries
df3d83b1
PM
2723 bind . $ev $script
2724 set escript [bind Entry $ev]
2725 if {$escript == {}} {
2726 set escript [bind Entry <Key>]
2727 }
887fe3c4
PM
2728 foreach e $entries {
2729 bind $e $ev "$escript; break"
2730 }
df3d83b1
PM
2731}
2732
69ecfcd6
AW
2733proc bindmodfunctionkey {mod n script} {
2734 bind . <$mod-F$n> $script
2735 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2736}
2737
df3d83b1 2738# set the focus back to the toplevel for any click outside
887fe3c4 2739# the entry widgets
df3d83b1 2740proc click {w} {
bd441de4
ML
2741 global ctext entries
2742 foreach e [concat $entries $ctext] {
887fe3c4 2743 if {$w == $e} return
df3d83b1 2744 }
887fe3c4 2745 focus .
0fba86b3
PM
2746}
2747
bb3edc8b
PM
2748# Adjust the progress bar for a change in requested extent or canvas size
2749proc adjustprogress {} {
2750 global progresscanv progressitem progresscoords
2751 global fprogitem fprogcoord lastprogupdate progupdatepending
d93f1713
PT
2752 global rprogitem rprogcoord use_ttk
2753
2754 if {$use_ttk} {
2755 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2756 return
2757 }
bb3edc8b
PM
2758
2759 set w [expr {[winfo width $progresscanv] - 4}]
2760 set x0 [expr {$w * [lindex $progresscoords 0]}]
2761 set x1 [expr {$w * [lindex $progresscoords 1]}]
2762 set h [winfo height $progresscanv]
2763 $progresscanv coords $progressitem $x0 0 $x1 $h
2764 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
a137a90f 2765 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
bb3edc8b
PM
2766 set now [clock clicks -milliseconds]
2767 if {$now >= $lastprogupdate + 100} {
2768 set progupdatepending 0
2769 update
2770 } elseif {!$progupdatepending} {
2771 set progupdatepending 1
2772 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2773 }
2774}
2775
2776proc doprogupdate {} {
2777 global lastprogupdate progupdatepending
2778
2779 if {$progupdatepending} {
2780 set progupdatepending 0
2781 set lastprogupdate [clock clicks -milliseconds]
2782 update
2783 }
2784}
2785
0fba86b3 2786proc savestuff {w} {
2d480856 2787 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
9fabefb1
MK
2788 global use_ttk
2789 global stuffsaved
8f863398 2790 global config_file config_file_tmp
9fabefb1 2791 global config_variables
4ef17537 2792
0fba86b3 2793 if {$stuffsaved} return
df3d83b1 2794 if {![winfo viewable .]} return
0fba86b3 2795 catch {
8f863398
AH
2796 if {[file exists $config_file_tmp]} {
2797 file delete -force $config_file_tmp
2798 }
2799 set f [open $config_file_tmp w]
9832e4f2 2800 if {$::tcl_platform(platform) eq {windows}} {
8f863398 2801 file attributes $config_file_tmp -hidden true
9832e4f2 2802 }
9fabefb1
MK
2803 foreach var_name $config_variables {
2804 upvar #0 $var_name var
2805 puts $f [list set $var_name $var]
2806 }
e9937d2a 2807
b6047c5a 2808 puts $f "set geometry(main) [wm geometry .]"
c876dbad 2809 puts $f "set geometry(state) [wm state .]"
e9937d2a
JH
2810 puts $f "set geometry(topwidth) [winfo width .tf]"
2811 puts $f "set geometry(topheight) [winfo height .tf]"
d93f1713
PT
2812 if {$use_ttk} {
2813 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2814 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2815 } else {
2816 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2817 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2818 }
e9937d2a
JH
2819 puts $f "set geometry(botwidth) [winfo width .bleft]"
2820 puts $f "set geometry(botheight) [winfo height .bleft]"
2821
a90a6d24
PM
2822 puts -nonewline $f "set permviews {"
2823 for {set v 0} {$v < $nextviewnum} {incr v} {
2824 if {$viewperm($v)} {
2d480856 2825 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
a90a6d24
PM
2826 }
2827 }
2828 puts $f "}"
0fba86b3 2829 close $f
8f863398 2830 file rename -force $config_file_tmp $config_file
0fba86b3
PM
2831 }
2832 set stuffsaved 1
1db95b00
PM
2833}
2834
43bddeb4 2835proc resizeclistpanes {win w} {
d93f1713 2836 global oldwidth use_ttk
418c4c7b 2837 if {[info exists oldwidth($win)]} {
d93f1713
PT
2838 if {$use_ttk} {
2839 set s0 [$win sashpos 0]
2840 set s1 [$win sashpos 1]
2841 } else {
2842 set s0 [$win sash coord 0]
2843 set s1 [$win sash coord 1]
2844 }
43bddeb4
PM
2845 if {$w < 60} {
2846 set sash0 [expr {int($w/2 - 2)}]
2847 set sash1 [expr {int($w*5/6 - 2)}]
2848 } else {
2849 set factor [expr {1.0 * $w / $oldwidth($win)}]
2850 set sash0 [expr {int($factor * [lindex $s0 0])}]
2851 set sash1 [expr {int($factor * [lindex $s1 0])}]
2852 if {$sash0 < 30} {
2853 set sash0 30
2854 }
2855 if {$sash1 < $sash0 + 20} {
2ed49d54 2856 set sash1 [expr {$sash0 + 20}]
43bddeb4
PM
2857 }
2858 if {$sash1 > $w - 10} {
2ed49d54 2859 set sash1 [expr {$w - 10}]
43bddeb4 2860 if {$sash0 > $sash1 - 20} {
2ed49d54 2861 set sash0 [expr {$sash1 - 20}]
43bddeb4
PM
2862 }
2863 }
2864 }
d93f1713
PT
2865 if {$use_ttk} {
2866 $win sashpos 0 $sash0
2867 $win sashpos 1 $sash1
2868 } else {
2869 $win sash place 0 $sash0 [lindex $s0 1]
2870 $win sash place 1 $sash1 [lindex $s1 1]
2871 }
43bddeb4
PM
2872 }
2873 set oldwidth($win) $w
2874}
2875
2876proc resizecdetpanes {win w} {
d93f1713 2877 global oldwidth use_ttk
418c4c7b 2878 if {[info exists oldwidth($win)]} {
d93f1713
PT
2879 if {$use_ttk} {
2880 set s0 [$win sashpos 0]
2881 } else {
2882 set s0 [$win sash coord 0]
2883 }
43bddeb4
PM
2884 if {$w < 60} {
2885 set sash0 [expr {int($w*3/4 - 2)}]
2886 } else {
2887 set factor [expr {1.0 * $w / $oldwidth($win)}]
2888 set sash0 [expr {int($factor * [lindex $s0 0])}]
2889 if {$sash0 < 45} {
2890 set sash0 45
2891 }
2892 if {$sash0 > $w - 15} {
2ed49d54 2893 set sash0 [expr {$w - 15}]
43bddeb4
PM
2894 }
2895 }
d93f1713
PT
2896 if {$use_ttk} {
2897 $win sashpos 0 $sash0
2898 } else {
2899 $win sash place 0 $sash0 [lindex $s0 1]
2900 }
43bddeb4
PM
2901 }
2902 set oldwidth($win) $w
2903}
2904
b5721c72
PM
2905proc allcanvs args {
2906 global canv canv2 canv3
2907 eval $canv $args
2908 eval $canv2 $args
2909 eval $canv3 $args
2910}
2911
2912proc bindall {event action} {
2913 global canv canv2 canv3
2914 bind $canv $event $action
2915 bind $canv2 $event $action
2916 bind $canv3 $event $action
2917}
2918
9a40c50c 2919proc about {} {
d93f1713 2920 global uifont NS
9a40c50c
PM
2921 set w .about
2922 if {[winfo exists $w]} {
2923 raise $w
2924 return
2925 }
d93f1713 2926 ttk_toplevel $w
d990cedf 2927 wm title $w [mc "About gitk"]
e7d64008 2928 make_transient $w .
d990cedf 2929 message $w.m -text [mc "
9f1afe05 2930Gitk - a commit viewer for git
9a40c50c 2931
6c626a03 2932Copyright \u00a9 2005-2014 Paul Mackerras
9a40c50c 2933
d990cedf 2934Use and redistribute under the terms of the GNU General Public License"] \
3a950e9a
ER
2935 -justify center -aspect 400 -border 2 -bg white -relief groove
2936 pack $w.m -side top -fill x -padx 2 -pady 2
d93f1713 2937 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
9a40c50c 2938 pack $w.ok -side bottom
3a950e9a
ER
2939 bind $w <Visibility> "focus $w.ok"
2940 bind $w <Key-Escape> "destroy $w"
2941 bind $w <Key-Return> "destroy $w"
d93f1713 2942 tk::PlaceWindow $w widget .
9a40c50c
PM
2943}
2944
4e95e1f7 2945proc keys {} {
d93f1713 2946 global NS
4e95e1f7
PM
2947 set w .keys
2948 if {[winfo exists $w]} {
2949 raise $w
2950 return
2951 }
d23d98d3
SP
2952 if {[tk windowingsystem] eq {aqua}} {
2953 set M1T Cmd
2954 } else {
2955 set M1T Ctrl
2956 }
d93f1713 2957 ttk_toplevel $w
d990cedf 2958 wm title $w [mc "Gitk key bindings"]
e7d64008 2959 make_transient $w .
3d2c998e
MB
2960 message $w.m -text "
2961[mc "Gitk key bindings:"]
2962
2963[mc "<%s-Q> Quit" $M1T]
decd0a1e 2964[mc "<%s-W> Close window" $M1T]
3d2c998e
MB
2965[mc "<Home> Move to first commit"]
2966[mc "<End> Move to last commit"]
811c70fc
JN
2967[mc "<Up>, p, k Move up one commit"]
2968[mc "<Down>, n, j Move down one commit"]
2969[mc "<Left>, z, h Go back in history list"]
3d2c998e 2970[mc "<Right>, x, l Go forward in history list"]
d4ec30b2 2971[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
3d2c998e
MB
2972[mc "<PageUp> Move up one page in commit list"]
2973[mc "<PageDown> Move down one page in commit list"]
2974[mc "<%s-Home> Scroll to top of commit list" $M1T]
2975[mc "<%s-End> Scroll to bottom of commit list" $M1T]
2976[mc "<%s-Up> Scroll commit list up one line" $M1T]
2977[mc "<%s-Down> Scroll commit list down one line" $M1T]
2978[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2979[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2980[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2981[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2982[mc "<Delete>, b Scroll diff view up one page"]
2983[mc "<Backspace> Scroll diff view up one page"]
2984[mc "<Space> Scroll diff view down one page"]
2985[mc "u Scroll diff view up 18 lines"]
2986[mc "d Scroll diff view down 18 lines"]
2987[mc "<%s-F> Find" $M1T]
2988[mc "<%s-G> Move to next find hit" $M1T]
2989[mc "<Return> Move to next find hit"]
97bed034 2990[mc "/ Focus the search box"]
3d2c998e
MB
2991[mc "? Move to previous find hit"]
2992[mc "f Scroll diff view to next file"]
2993[mc "<%s-S> Search for next hit in diff view" $M1T]
2994[mc "<%s-R> Search for previous hit in diff view" $M1T]
2995[mc "<%s-KP+> Increase font size" $M1T]
2996[mc "<%s-plus> Increase font size" $M1T]
2997[mc "<%s-KP-> Decrease font size" $M1T]
2998[mc "<%s-minus> Decrease font size" $M1T]
2999[mc "<F5> Update"]
3000" \
3a950e9a
ER
3001 -justify left -bg white -border 2 -relief groove
3002 pack $w.m -side top -fill both -padx 2 -pady 2
d93f1713 3003 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
76f15947 3004 bind $w <Key-Escape> [list destroy $w]
4e95e1f7 3005 pack $w.ok -side bottom
3a950e9a
ER
3006 bind $w <Visibility> "focus $w.ok"
3007 bind $w <Key-Escape> "destroy $w"
3008 bind $w <Key-Return> "destroy $w"
4e95e1f7
PM
3009}
3010
7fcceed7
PM
3011# Procedures for manipulating the file list window at the
3012# bottom right of the overall window.
f8b28a40
PM
3013
3014proc treeview {w l openlevs} {
3015 global treecontents treediropen treeheight treeparent treeindex
3016
3017 set ix 0
3018 set treeindex() 0
3019 set lev 0
3020 set prefix {}
3021 set prefixend -1
3022 set prefendstack {}
3023 set htstack {}
3024 set ht 0
3025 set treecontents() {}
3026 $w conf -state normal
3027 foreach f $l {
3028 while {[string range $f 0 $prefixend] ne $prefix} {
3029 if {$lev <= $openlevs} {
3030 $w mark set e:$treeindex($prefix) "end -1c"
3031 $w mark gravity e:$treeindex($prefix) left
3032 }
3033 set treeheight($prefix) $ht
3034 incr ht [lindex $htstack end]
3035 set htstack [lreplace $htstack end end]
3036 set prefixend [lindex $prefendstack end]
3037 set prefendstack [lreplace $prefendstack end end]
3038 set prefix [string range $prefix 0 $prefixend]
3039 incr lev -1
3040 }
3041 set tail [string range $f [expr {$prefixend+1}] end]
3042 while {[set slash [string first "/" $tail]] >= 0} {
3043 lappend htstack $ht
3044 set ht 0
3045 lappend prefendstack $prefixend
3046 incr prefixend [expr {$slash + 1}]
3047 set d [string range $tail 0 $slash]
3048 lappend treecontents($prefix) $d
3049 set oldprefix $prefix
3050 append prefix $d
3051 set treecontents($prefix) {}
3052 set treeindex($prefix) [incr ix]
3053 set treeparent($prefix) $oldprefix
3054 set tail [string range $tail [expr {$slash+1}] end]
3055 if {$lev <= $openlevs} {
3056 set ht 1
3057 set treediropen($prefix) [expr {$lev < $openlevs}]
3058 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3059 $w mark set d:$ix "end -1c"
3060 $w mark gravity d:$ix left
3061 set str "\n"
3062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3063 $w insert end $str
3064 $w image create end -align center -image $bm -padx 1 \
3065 -name a:$ix
45a9d505 3066 $w insert end $d [highlight_tag $prefix]
f8b28a40
PM
3067 $w mark set s:$ix "end -1c"
3068 $w mark gravity s:$ix left
3069 }
3070 incr lev
3071 }
3072 if {$tail ne {}} {
3073 if {$lev <= $openlevs} {
3074 incr ht
3075 set str "\n"
3076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3077 $w insert end $str
45a9d505 3078 $w insert end $tail [highlight_tag $f]
f8b28a40
PM
3079 }
3080 lappend treecontents($prefix) $tail
3081 }
3082 }
3083 while {$htstack ne {}} {
3084 set treeheight($prefix) $ht
3085 incr ht [lindex $htstack end]
3086 set htstack [lreplace $htstack end end]
096e96b4
BD
3087 set prefixend [lindex $prefendstack end]
3088 set prefendstack [lreplace $prefendstack end end]
3089 set prefix [string range $prefix 0 $prefixend]
f8b28a40
PM
3090 }
3091 $w conf -state disabled
3092}
3093
3094proc linetoelt {l} {
3095 global treeheight treecontents
3096
3097 set y 2
3098 set prefix {}
3099 while {1} {
3100 foreach e $treecontents($prefix) {
3101 if {$y == $l} {
3102 return "$prefix$e"
3103 }
3104 set n 1
3105 if {[string index $e end] eq "/"} {
3106 set n $treeheight($prefix$e)
3107 if {$y + $n > $l} {
3108 append prefix $e
3109 incr y
3110 break
3111 }
3112 }
3113 incr y $n
3114 }
3115 }
3116}
3117
45a9d505
PM
3118proc highlight_tree {y prefix} {
3119 global treeheight treecontents cflist
3120
3121 foreach e $treecontents($prefix) {
3122 set path $prefix$e
3123 if {[highlight_tag $path] ne {}} {
3124 $cflist tag add bold $y.0 "$y.0 lineend"
3125 }
3126 incr y
3127 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3128 set y [highlight_tree $y $path]
3129 }
3130 }
3131 return $y
3132}
3133
f8b28a40
PM
3134proc treeclosedir {w dir} {
3135 global treediropen treeheight treeparent treeindex
3136
3137 set ix $treeindex($dir)
3138 $w conf -state normal
3139 $w delete s:$ix e:$ix
3140 set treediropen($dir) 0
3141 $w image configure a:$ix -image tri-rt
3142 $w conf -state disabled
3143 set n [expr {1 - $treeheight($dir)}]
3144 while {$dir ne {}} {
3145 incr treeheight($dir) $n
3146 set dir $treeparent($dir)
3147 }
3148}
3149
3150proc treeopendir {w dir} {
3151 global treediropen treeheight treeparent treecontents treeindex
3152
3153 set ix $treeindex($dir)
3154 $w conf -state normal
3155 $w image configure a:$ix -image tri-dn
3156 $w mark set e:$ix s:$ix
3157 $w mark gravity e:$ix right
3158 set lev 0
3159 set str "\n"
3160 set n [llength $treecontents($dir)]
3161 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3162 incr lev
3163 append str "\t"
3164 incr treeheight($x) $n
3165 }
3166 foreach e $treecontents($dir) {
45a9d505 3167 set de $dir$e
f8b28a40 3168 if {[string index $e end] eq "/"} {
f8b28a40
PM
3169 set iy $treeindex($de)
3170 $w mark set d:$iy e:$ix
3171 $w mark gravity d:$iy left
3172 $w insert e:$ix $str
3173 set treediropen($de) 0
3174 $w image create e:$ix -align center -image tri-rt -padx 1 \
3175 -name a:$iy
45a9d505 3176 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3177 $w mark set s:$iy e:$ix
3178 $w mark gravity s:$iy left
3179 set treeheight($de) 1
3180 } else {
3181 $w insert e:$ix $str
45a9d505 3182 $w insert e:$ix $e [highlight_tag $de]
f8b28a40
PM
3183 }
3184 }
b8a640ee 3185 $w mark gravity e:$ix right
f8b28a40
PM
3186 $w conf -state disabled
3187 set treediropen($dir) 1
3188 set top [lindex [split [$w index @0,0] .] 0]
3189 set ht [$w cget -height]
3190 set l [lindex [split [$w index s:$ix] .] 0]
3191 if {$l < $top} {
3192 $w yview $l.0
3193 } elseif {$l + $n + 1 > $top + $ht} {
3194 set top [expr {$l + $n + 2 - $ht}]
3195 if {$l < $top} {
3196 set top $l
3197 }
3198 $w yview $top.0
3199 }
3200}
3201
3202proc treeclick {w x y} {
3203 global treediropen cmitmode ctext cflist cflist_top
3204
3205 if {$cmitmode ne "tree"} return
3206 if {![info exists cflist_top]} return
3207 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3208 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3209 $cflist tag add highlight $l.0 "$l.0 lineend"
3210 set cflist_top $l
3211 if {$l == 1} {
3212 $ctext yview 1.0
3213 return
3214 }
3215 set e [linetoelt $l]
3216 if {[string index $e end] ne "/"} {
3217 showfile $e
3218 } elseif {$treediropen($e)} {
3219 treeclosedir $w $e
3220 } else {
3221 treeopendir $w $e
3222 }
3223}
3224
3225proc setfilelist {id} {
8a897742 3226 global treefilelist cflist jump_to_here
f8b28a40
PM
3227
3228 treeview $cflist $treefilelist($id) 0
8a897742
PM
3229 if {$jump_to_here ne {}} {
3230 set f [lindex $jump_to_here 0]
3231 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3232 showfile $f
3233 }
3234 }
f8b28a40
PM
3235}
3236
3237image create bitmap tri-rt -background black -foreground blue -data {
3238 #define tri-rt_width 13
3239 #define tri-rt_height 13
3240 static unsigned char tri-rt_bits[] = {
3241 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3242 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3243 0x00, 0x00};
3244} -maskdata {
3245 #define tri-rt-mask_width 13
3246 #define tri-rt-mask_height 13
3247 static unsigned char tri-rt-mask_bits[] = {
3248 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3249 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3250 0x08, 0x00};
3251}
3252image create bitmap tri-dn -background black -foreground blue -data {
3253 #define tri-dn_width 13
3254 #define tri-dn_height 13
3255 static unsigned char tri-dn_bits[] = {
3256 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3257 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3258 0x00, 0x00};
3259} -maskdata {
3260 #define tri-dn-mask_width 13
3261 #define tri-dn-mask_height 13
3262 static unsigned char tri-dn-mask_bits[] = {
3263 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3264 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3265 0x00, 0x00};
3266}
3267
887c996e
PM
3268image create bitmap reficon-T -background black -foreground yellow -data {
3269 #define tagicon_width 13
3270 #define tagicon_height 9
3271 static unsigned char tagicon_bits[] = {
3272 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3273 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3274} -maskdata {
3275 #define tagicon-mask_width 13
3276 #define tagicon-mask_height 9
3277 static unsigned char tagicon-mask_bits[] = {
3278 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3279 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3280}
3281set rectdata {
3282 #define headicon_width 13
3283 #define headicon_height 9
3284 static unsigned char headicon_bits[] = {
3285 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3286 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3287}
3288set rectmask {
3289 #define headicon-mask_width 13
3290 #define headicon-mask_height 9
3291 static unsigned char headicon-mask_bits[] = {
3292 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3293 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3294}
3295image create bitmap reficon-H -background black -foreground green \
3296 -data $rectdata -maskdata $rectmask
3297image create bitmap reficon-o -background black -foreground "#ddddff" \
3298 -data $rectdata -maskdata $rectmask
3299
7fcceed7 3300proc init_flist {first} {
7fcc92bf 3301 global cflist cflist_top difffilestart
7fcceed7
PM
3302
3303 $cflist conf -state normal
3304 $cflist delete 0.0 end
3305 if {$first ne {}} {
3306 $cflist insert end $first
3307 set cflist_top 1
7fcceed7
PM
3308 $cflist tag add highlight 1.0 "1.0 lineend"
3309 } else {
3310 catch {unset cflist_top}
3311 }
3312 $cflist conf -state disabled
3313 set difffilestart {}
3314}
3315
63b79191
PM
3316proc highlight_tag {f} {
3317 global highlight_paths
3318
3319 foreach p $highlight_paths {
3320 if {[string match $p $f]} {
3321 return "bold"
3322 }
3323 }
3324 return {}
3325}
3326
3327proc highlight_filelist {} {
45a9d505 3328 global cmitmode cflist
63b79191 3329
45a9d505
PM
3330 $cflist conf -state normal
3331 if {$cmitmode ne "tree"} {
63b79191
PM
3332 set end [lindex [split [$cflist index end] .] 0]
3333 for {set l 2} {$l < $end} {incr l} {
3334 set line [$cflist get $l.0 "$l.0 lineend"]
3335 if {[highlight_tag $line] ne {}} {
3336 $cflist tag add bold $l.0 "$l.0 lineend"
3337 }
3338 }
45a9d505
PM
3339 } else {
3340 highlight_tree 2 {}
63b79191 3341 }
45a9d505 3342 $cflist conf -state disabled
63b79191
PM
3343}
3344
3345proc unhighlight_filelist {} {
45a9d505 3346 global cflist
63b79191 3347
45a9d505
PM
3348 $cflist conf -state normal
3349 $cflist tag remove bold 1.0 end
3350 $cflist conf -state disabled
63b79191
PM
3351}
3352
f8b28a40 3353proc add_flist {fl} {
45a9d505 3354 global cflist
7fcceed7 3355
45a9d505
PM
3356 $cflist conf -state normal
3357 foreach f $fl {
3358 $cflist insert end "\n"
3359 $cflist insert end $f [highlight_tag $f]
7fcceed7 3360 }
45a9d505 3361 $cflist conf -state disabled
7fcceed7
PM
3362}
3363
3364proc sel_flist {w x y} {
45a9d505 3365 global ctext difffilestart cflist cflist_top cmitmode
7fcceed7 3366
f8b28a40 3367 if {$cmitmode eq "tree"} return
7fcceed7
PM
3368 if {![info exists cflist_top]} return
3369 set l [lindex [split [$w index "@$x,$y"] "."] 0]
89b11d3b
PM
3370 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3371 $cflist tag add highlight $l.0 "$l.0 lineend"
3372 set cflist_top $l
f8b28a40
PM
3373 if {$l == 1} {
3374 $ctext yview 1.0
3375 } else {
3376 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
7fcceed7 3377 }
b967135d 3378 suppress_highlighting_file_for_current_scrollpos
7fcceed7
PM
3379}
3380
3244729a
PM
3381proc pop_flist_menu {w X Y x y} {
3382 global ctext cflist cmitmode flist_menu flist_menu_file
3383 global treediffs diffids
3384
bb3edc8b 3385 stopfinding
3244729a
PM
3386 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3387 if {$l <= 1} return
3388 if {$cmitmode eq "tree"} {
3389 set e [linetoelt $l]
3390 if {[string index $e end] eq "/"} return
3391 } else {
3392 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3393 }
3394 set flist_menu_file $e
314f5de1
TA
3395 set xdiffstate "normal"
3396 if {$cmitmode eq "tree"} {
3397 set xdiffstate "disabled"
3398 }
3399 # Disable "External diff" item in tree mode
3400 $flist_menu entryconf 2 -state $xdiffstate
3244729a
PM
3401 tk_popup $flist_menu $X $Y
3402}
3403
7cdc3556
AG
3404proc find_ctext_fileinfo {line} {
3405 global ctext_file_names ctext_file_lines
3406
3407 set ok [bsearch $ctext_file_lines $line]
3408 set tline [lindex $ctext_file_lines $ok]
3409
3410 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3411 return {}
3412 } else {
3413 return [list [lindex $ctext_file_names $ok] $tline]
3414 }
3415}
3416
3417proc pop_diff_menu {w X Y x y} {
3418 global ctext diff_menu flist_menu_file
3419 global diff_menu_txtpos diff_menu_line
3420 global diff_menu_filebase
3421
7cdc3556
AG
3422 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3423 set diff_menu_line [lindex $diff_menu_txtpos 0]
190ec52c
PM
3424 # don't pop up the menu on hunk-separator or file-separator lines
3425 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3426 return
3427 }
3428 stopfinding
7cdc3556
AG
3429 set f [find_ctext_fileinfo $diff_menu_line]
3430 if {$f eq {}} return
3431 set flist_menu_file [lindex $f 0]
3432 set diff_menu_filebase [lindex $f 1]
3433 tk_popup $diff_menu $X $Y
3434}
3435
3244729a 3436proc flist_hl {only} {
bb3edc8b 3437 global flist_menu_file findstring gdttype
3244729a
PM
3438
3439 set x [shellquote $flist_menu_file]
b007ee20 3440 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
bb3edc8b 3441 set findstring $x
3244729a 3442 } else {
bb3edc8b 3443 append findstring " " $x
3244729a 3444 }
b007ee20 3445 set gdttype [mc "touching paths:"]
3244729a
PM
3446}
3447
c21398be 3448proc gitknewtmpdir {} {
c7664f1a 3449 global diffnum gitktmpdir gitdir env
c21398be
PM
3450
3451 if {![info exists gitktmpdir]} {
c7664f1a
DA
3452 if {[info exists env(GITK_TMPDIR)]} {
3453 set tmpdir $env(GITK_TMPDIR)
3454 } elseif {[info exists env(TMPDIR)]} {
3455 set tmpdir $env(TMPDIR)
3456 } else {
3457 set tmpdir $gitdir
3458 }
105b5d3f 3459 set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
ac54a4b7
DA
3460 if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3461 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3462 }
c21398be
PM
3463 if {[catch {file mkdir $gitktmpdir} err]} {
3464 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3465 unset gitktmpdir
3466 return {}
3467 }
3468 set diffnum 0
3469 }
3470 incr diffnum
3471 set diffdir [file join $gitktmpdir $diffnum]
3472 if {[catch {file mkdir $diffdir} err]} {
3473 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3474 return {}
3475 }
3476 return $diffdir
3477}
3478
314f5de1
TA
3479proc save_file_from_commit {filename output what} {
3480 global nullfile
3481
3482 if {[catch {exec git show $filename -- > $output} err]} {
3483 if {[string match "fatal: bad revision *" $err]} {
3484 return $nullfile
3485 }
3945d2c0 3486 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
314f5de1
TA
3487 return {}
3488 }
3489 return $output
3490}
3491
3492proc external_diff_get_one_file {diffid filename diffdir} {
3493 global nullid nullid2 nullfile
784b7e2f 3494 global worktree
314f5de1
TA
3495
3496 if {$diffid == $nullid} {
784b7e2f 3497 set difffile [file join $worktree $filename]
314f5de1
TA
3498 if {[file exists $difffile]} {
3499 return $difffile
3500 }
3501 return $nullfile
3502 }
3503 if {$diffid == $nullid2} {
3504 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3505 return [save_file_from_commit :$filename $difffile index]
3506 }
3507 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3508 return [save_file_from_commit $diffid:$filename $difffile \
3509 "revision $diffid"]
3510}
3511
3512proc external_diff {} {
c21398be 3513 global nullid nullid2
314f5de1
TA
3514 global flist_menu_file
3515 global diffids
c21398be 3516 global extdifftool
314f5de1
TA
3517
3518 if {[llength $diffids] == 1} {
3519 # no reference commit given
3520 set diffidto [lindex $diffids 0]
3521 if {$diffidto eq $nullid} {
3522 # diffing working copy with index
3523 set diffidfrom $nullid2
3524 } elseif {$diffidto eq $nullid2} {
3525 # diffing index with HEAD
3526 set diffidfrom "HEAD"
3527 } else {
3528 # use first parent commit
3529 global parentlist selectedline
3530 set diffidfrom [lindex $parentlist $selectedline 0]
3531 }
3532 } else {
3533 set diffidfrom [lindex $diffids 0]
3534 set diffidto [lindex $diffids 1]
3535 }
3536
3537 # make sure that several diffs wont collide
c21398be
PM
3538 set diffdir [gitknewtmpdir]
3539 if {$diffdir eq {}} return
314f5de1
TA
3540
3541 # gather files to diff
3542 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3543 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3544
3545 if {$difffromfile ne {} && $difftofile ne {}} {
b575b2f1
PT
3546 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3547 if {[catch {set fl [open |$cmd r]} err]} {
314f5de1 3548 file delete -force $diffdir
3945d2c0 3549 error_popup "$extdifftool: [mc "command failed:"] $err"
314f5de1
TA
3550 } else {
3551 fconfigure $fl -blocking 0
3552 filerun $fl [list delete_at_eof $fl $diffdir]
3553 }
3554 }
3555}
3556
7cdc3556
AG
3557proc find_hunk_blamespec {base line} {
3558 global ctext
3559
3560 # Find and parse the hunk header
3561 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3562 if {$s_lix eq {}} return
3563
3564 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3565 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3566 s_line old_specs osz osz1 new_line nsz]} {
3567 return
3568 }
3569
3570 # base lines for the parents
3571 set base_lines [list $new_line]
3572 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3573 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3574 old_spec old_line osz]} {
3575 return
3576 }
3577 lappend base_lines $old_line
3578 }
3579
3580 # Now scan the lines to determine offset within the hunk
7cdc3556
AG
3581 set max_parent [expr {[llength $base_lines]-2}]
3582 set dline 0
3583 set s_lno [lindex [split $s_lix "."] 0]
3584
190ec52c
PM
3585 # Determine if the line is removed
3586 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3587 if {[string match {[-+ ]*} $chunk]} {
7cdc3556
AG
3588 set removed_idx [string first "-" $chunk]
3589 # Choose a parent index
190ec52c
PM
3590 if {$removed_idx >= 0} {
3591 set parent $removed_idx
3592 } else {
3593 set unchanged_idx [string first " " $chunk]
3594 if {$unchanged_idx >= 0} {
3595 set parent $unchanged_idx
7cdc3556 3596 } else {
190ec52c
PM
3597 # blame the current commit
3598 set parent -1
7cdc3556
AG
3599 }
3600 }
3601 # then count other lines that belong to it
190ec52c
PM
3602 for {set i $line} {[incr i -1] > $s_lno} {} {
3603 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3604 # Determine if the line is removed
3605 set removed_idx [string first "-" $chunk]
3606 if {$parent >= 0} {
3607 set code [string index $chunk $parent]
3608 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3609 incr dline
3610 }
3611 } else {
3612 if {$removed_idx < 0} {
3613 incr dline
3614 }
7cdc3556
AG
3615 }
3616 }
190ec52c
PM
3617 incr parent
3618 } else {
3619 set parent 0
7cdc3556
AG
3620 }
3621
7cdc3556
AG
3622 incr dline [lindex $base_lines $parent]
3623 return [list $parent $dline]
3624}
3625
3626proc external_blame_diff {} {
8b07dca1 3627 global currentid cmitmode
7cdc3556
AG
3628 global diff_menu_txtpos diff_menu_line
3629 global diff_menu_filebase flist_menu_file
3630
3631 if {$cmitmode eq "tree"} {
3632 set parent_idx 0
190ec52c 3633 set line [expr {$diff_menu_line - $diff_menu_filebase}]
7cdc3556
AG
3634 } else {
3635 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3636 if {$hinfo ne {}} {
3637 set parent_idx [lindex $hinfo 0]
3638 set line [lindex $hinfo 1]
3639 } else {
3640 set parent_idx 0
3641 set line 0
3642 }
3643 }
3644
3645 external_blame $parent_idx $line
3646}
3647
fc4977e1
PM
3648# Find the SHA1 ID of the blob for file $fname in the index
3649# at stage 0 or 2
3650proc index_sha1 {fname} {
3651 set f [open [list | git ls-files -s $fname] r]
3652 while {[gets $f line] >= 0} {
3653 set info [lindex [split $line "\t"] 0]
3654 set stage [lindex $info 2]
3655 if {$stage eq "0" || $stage eq "2"} {
3656 close $f
3657 return [lindex $info 1]
3658 }
3659 }
3660 close $f
3661 return {}
3662}
3663
9712b81a
PM
3664# Turn an absolute path into one relative to the current directory
3665proc make_relative {f} {
a4390ace
MH
3666 if {[file pathtype $f] eq "relative"} {
3667 return $f
3668 }
9712b81a
PM
3669 set elts [file split $f]
3670 set here [file split [pwd]]
3671 set ei 0
3672 set hi 0
3673 set res {}
3674 foreach d $here {
3675 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3676 lappend res ".."
3677 } else {
3678 incr ei
3679 }
3680 incr hi
3681 }
3682 set elts [concat $res [lrange $elts $ei end]]
3683 return [eval file join $elts]
3684}
3685
7cdc3556 3686proc external_blame {parent_idx {line {}}} {
0a2a9793 3687 global flist_menu_file cdup
77aa0ae8
AG
3688 global nullid nullid2
3689 global parentlist selectedline currentid
3690
3691 if {$parent_idx > 0} {
3692 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3693 } else {
3694 set base_commit $currentid
3695 }
3696
3697 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3698 error_popup [mc "No such commit"]
3699 return
3700 }
3701
7cdc3556
AG
3702 set cmdline [list git gui blame]
3703 if {$line ne {} && $line > 1} {
3704 lappend cmdline "--line=$line"
3705 }
0a2a9793 3706 set f [file join $cdup $flist_menu_file]
9712b81a
PM
3707 # Unfortunately it seems git gui blame doesn't like
3708 # being given an absolute path...
3709 set f [make_relative $f]
3710 lappend cmdline $base_commit $f
7cdc3556 3711 if {[catch {eval exec $cmdline &} err]} {
3945d2c0 3712 error_popup "[mc "git gui blame: command failed:"] $err"
77aa0ae8
AG
3713 }
3714}
3715
8a897742
PM
3716proc show_line_source {} {
3717 global cmitmode currentid parents curview blamestuff blameinst
3718 global diff_menu_line diff_menu_filebase flist_menu_file
9b6adf34 3719 global nullid nullid2 gitdir cdup
8a897742 3720
fc4977e1 3721 set from_index {}
8a897742
PM
3722 if {$cmitmode eq "tree"} {
3723 set id $currentid
3724 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3725 } else {
3726 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3727 if {$h eq {}} return
3728 set pi [lindex $h 0]
3729 if {$pi == 0} {
3730 mark_ctext_line $diff_menu_line
3731 return
3732 }
fc4977e1
PM
3733 incr pi -1
3734 if {$currentid eq $nullid} {
3735 if {$pi > 0} {
3736 # must be a merge in progress...
3737 if {[catch {
3738 # get the last line from .git/MERGE_HEAD
3739 set f [open [file join $gitdir MERGE_HEAD] r]
3740 set id [lindex [split [read $f] "\n"] end-1]
3741 close $f
3742 } err]} {
3743 error_popup [mc "Couldn't read merge head: %s" $err]
3744 return
3745 }
3746 } elseif {$parents($curview,$currentid) eq $nullid2} {
3747 # need to do the blame from the index
3748 if {[catch {
3749 set from_index [index_sha1 $flist_menu_file]
3750 } err]} {
3751 error_popup [mc "Error reading index: %s" $err]
3752 return
3753 }
9712b81a
PM
3754 } else {
3755 set id $parents($curview,$currentid)
fc4977e1
PM
3756 }
3757 } else {
3758 set id [lindex $parents($curview,$currentid) $pi]
3759 }
8a897742
PM
3760 set line [lindex $h 1]
3761 }
fc4977e1
PM
3762 set blameargs {}
3763 if {$from_index ne {}} {
3764 lappend blameargs | git cat-file blob $from_index
3765 }