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