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