gitk: Enable mouse horizontal scrolling in diff pane
[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 bind $ctext <Button> {
2520 if {"%b" eq 6} {
2521 $ctext xview scroll -5 units
2522 } elseif {"%b" eq 7} {
2523 $ctext xview scroll 5 units
2524 }
2525 }
2526 if {[tk windowingsystem] eq "aqua"} {
2527 bindall <MouseWheel> {
2528 set delta [expr {- (%D)}]
2529 allcanvs yview scroll $delta units
2530 }
2531 bindall <Shift-MouseWheel> {
2532 set delta [expr {- (%D)}]
2533 $canv xview scroll $delta units
2534 }
2535 }
2536 }
2537 bindall <$::BM> "canvscan mark %W %x %y"
2538 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2539 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2540 bind . <$M1B-Key-w> doquit
2541 bindkey <Home> selfirstline
2542 bindkey <End> sellastline
2543 bind . <Key-Up> "selnextline -1"
2544 bind . <Key-Down> "selnextline 1"
2545 bind . <Shift-Key-Up> "dofind -1 0"
2546 bind . <Shift-Key-Down> "dofind 1 0"
2547 bindkey <Key-Right> "goforw"
2548 bindkey <Key-Left> "goback"
2549 bind . <Key-Prior> "selnextpage -1"
2550 bind . <Key-Next> "selnextpage 1"
2551 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2552 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2553 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2554 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2555 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2556 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2557 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2558 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2559 bindkey <Key-space> "$ctext yview scroll 1 pages"
2560 bindkey p "selnextline -1"
2561 bindkey n "selnextline 1"
2562 bindkey z "goback"
2563 bindkey x "goforw"
2564 bindkey k "selnextline -1"
2565 bindkey j "selnextline 1"
2566 bindkey h "goback"
2567 bindkey l "goforw"
2568 bindkey b prevfile
2569 bindkey d "$ctext yview scroll 18 units"
2570 bindkey u "$ctext yview scroll -18 units"
2571 bindkey / {focus $fstring}
2572 bindkey <Key-KP_Divide> {focus $fstring}
2573 bindkey <Key-Return> {dofind 1 1}
2574 bindkey ? {dofind -1 1}
2575 bindkey f nextfile
2576 bind . <F5> updatecommits
2577 bindmodfunctionkey Shift 5 reloadcommits
2578 bind . <F2> showrefs
2579 bindmodfunctionkey Shift 4 {newview 0}
2580 bind . <F4> edit_or_newview
2581 bind . <$M1B-q> doquit
2582 bind . <$M1B-f> {dofind 1 1}
2583 bind . <$M1B-g> {dofind 1 0}
2584 bind . <$M1B-r> dosearchback
2585 bind . <$M1B-s> dosearch
2586 bind . <$M1B-equal> {incrfont 1}
2587 bind . <$M1B-plus> {incrfont 1}
2588 bind . <$M1B-KP_Add> {incrfont 1}
2589 bind . <$M1B-minus> {incrfont -1}
2590 bind . <$M1B-KP_Subtract> {incrfont -1}
2591 wm protocol . WM_DELETE_WINDOW doquit
2592 bind . <Destroy> {stop_backends}
2593 bind . <Button-1> "click %W"
2594 bind $fstring <Key-Return> {dofind 1 1}
2595 bind $sha1entry <Key-Return> {gotocommit; break}
2596 bind $sha1entry <<PasteSelection>> clearsha1
2597 bind $sha1entry <<Paste>> clearsha1
2598 bind $cflist <1> {sel_flist %W %x %y; break}
2599 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2600 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2601 global ctxbut
2602 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2603 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2604 bind $ctext <Button-1> {focus %W}
2605 bind $ctext <<Selection>> rehighlight_search_results
2606 for {set i 1} {$i < 10} {incr i} {
2607 bind . <$M1B-Key-$i> [list go_to_parent $i]
2608 }
2609
2610 set maincursor [. cget -cursor]
2611 set textcursor [$ctext cget -cursor]
2612 set curtextcursor $textcursor
2613
2614 set rowctxmenu .rowctxmenu
2615 makemenu $rowctxmenu {
2616 {mc "Diff this -> selected" command {diffvssel 0}}
2617 {mc "Diff selected -> this" command {diffvssel 1}}
2618 {mc "Make patch" command mkpatch}
2619 {mc "Create tag" command mktag}
2620 {mc "Write commit to file" command writecommit}
2621 {mc "Create new branch" command mkbranch}
2622 {mc "Cherry-pick this commit" command cherrypick}
2623 {mc "Reset HEAD branch to here" command resethead}
2624 {mc "Mark this commit" command markhere}
2625 {mc "Return to mark" command gotomark}
2626 {mc "Find descendant of this and mark" command find_common_desc}
2627 {mc "Compare with marked commit" command compare_commits}
2628 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2629 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2630 {mc "Revert this commit" command revert}
2631 }
2632 $rowctxmenu configure -tearoff 0
2633
2634 set fakerowmenu .fakerowmenu
2635 makemenu $fakerowmenu {
2636 {mc "Diff this -> selected" command {diffvssel 0}}
2637 {mc "Diff selected -> this" command {diffvssel 1}}
2638 {mc "Make patch" command mkpatch}
2639 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2640 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2641 }
2642 $fakerowmenu configure -tearoff 0
2643
2644 set headctxmenu .headctxmenu
2645 makemenu $headctxmenu {
2646 {mc "Check out this branch" command cobranch}
2647 {mc "Remove this branch" command rmbranch}
2648 }
2649 $headctxmenu configure -tearoff 0
2650
2651 global flist_menu
2652 set flist_menu .flistctxmenu
2653 makemenu $flist_menu {
2654 {mc "Highlight this too" command {flist_hl 0}}
2655 {mc "Highlight this only" command {flist_hl 1}}
2656 {mc "External diff" command {external_diff}}
2657 {mc "Blame parent commit" command {external_blame 1}}
2658 }
2659 $flist_menu configure -tearoff 0
2660
2661 global diff_menu
2662 set diff_menu .diffctxmenu
2663 makemenu $diff_menu {
2664 {mc "Show origin of this line" command show_line_source}
2665 {mc "Run git gui blame on this line" command {external_blame_diff}}
2666 }
2667 $diff_menu configure -tearoff 0
2668 }
2669
2670 # Windows sends all mouse wheel events to the current focused window, not
2671 # the one where the mouse hovers, so bind those events here and redirect
2672 # to the correct window
2673 proc windows_mousewheel_redirector {W X Y D} {
2674 global canv canv2 canv3
2675 set w [winfo containing -displayof $W $X $Y]
2676 if {$w ne ""} {
2677 set u [expr {$D < 0 ? 5 : -5}]
2678 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2679 allcanvs yview scroll $u units
2680 } else {
2681 catch {
2682 $w yview scroll $u units
2683 }
2684 }
2685 }
2686 }
2687
2688 # Update row number label when selectedline changes
2689 proc selectedline_change {n1 n2 op} {
2690 global selectedline rownumsel
2691
2692 if {$selectedline eq {}} {
2693 set rownumsel {}
2694 } else {
2695 set rownumsel [expr {$selectedline + 1}]
2696 }
2697 }
2698
2699 # mouse-2 makes all windows scan vertically, but only the one
2700 # the cursor is in scans horizontally
2701 proc canvscan {op w x y} {
2702 global canv canv2 canv3
2703 foreach c [list $canv $canv2 $canv3] {
2704 if {$c == $w} {
2705 $c scan $op $x $y
2706 } else {
2707 $c scan $op 0 $y
2708 }
2709 }
2710 }
2711
2712 proc scrollcanv {cscroll f0 f1} {
2713 $cscroll set $f0 $f1
2714 drawvisible
2715 flushhighlights
2716 }
2717
2718 # when we make a key binding for the toplevel, make sure
2719 # it doesn't get triggered when that key is pressed in the
2720 # find string entry widget.
2721 proc bindkey {ev script} {
2722 global entries
2723 bind . $ev $script
2724 set escript [bind Entry $ev]
2725 if {$escript == {}} {
2726 set escript [bind Entry <Key>]
2727 }
2728 foreach e $entries {
2729 bind $e $ev "$escript; break"
2730 }
2731 }
2732
2733 proc bindmodfunctionkey {mod n script} {
2734 bind . <$mod-F$n> $script
2735 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2736 }
2737
2738 # set the focus back to the toplevel for any click outside
2739 # the entry widgets
2740 proc click {w} {
2741 global ctext entries
2742 foreach e [concat $entries $ctext] {
2743 if {$w == $e} return
2744 }
2745 focus .
2746 }
2747
2748 # Adjust the progress bar for a change in requested extent or canvas size
2749 proc adjustprogress {} {
2750 global progresscanv progressitem progresscoords
2751 global fprogitem fprogcoord lastprogupdate progupdatepending
2752 global rprogitem rprogcoord use_ttk
2753
2754 if {$use_ttk} {
2755 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2756 return
2757 }
2758
2759 set w [expr {[winfo width $progresscanv] - 4}]
2760 set x0 [expr {$w * [lindex $progresscoords 0]}]
2761 set x1 [expr {$w * [lindex $progresscoords 1]}]
2762 set h [winfo height $progresscanv]
2763 $progresscanv coords $progressitem $x0 0 $x1 $h
2764 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2765 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2766 set now [clock clicks -milliseconds]
2767 if {$now >= $lastprogupdate + 100} {
2768 set progupdatepending 0
2769 update
2770 } elseif {!$progupdatepending} {
2771 set progupdatepending 1
2772 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2773 }
2774 }
2775
2776 proc doprogupdate {} {
2777 global lastprogupdate progupdatepending
2778
2779 if {$progupdatepending} {
2780 set progupdatepending 0
2781 set lastprogupdate [clock clicks -milliseconds]
2782 update
2783 }
2784 }
2785
2786 proc savestuff {w} {
2787 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2788 global use_ttk
2789 global stuffsaved
2790 global config_file config_file_tmp
2791 global config_variables
2792
2793 if {$stuffsaved} return
2794 if {![winfo viewable .]} return
2795 catch {
2796 if {[file exists $config_file_tmp]} {
2797 file delete -force $config_file_tmp
2798 }
2799 set f [open $config_file_tmp w]
2800 if {$::tcl_platform(platform) eq {windows}} {
2801 file attributes $config_file_tmp -hidden true
2802 }
2803 foreach var_name $config_variables {
2804 upvar #0 $var_name var
2805 puts $f [list set $var_name $var]
2806 }
2807
2808 puts $f "set geometry(main) [wm geometry .]"
2809 puts $f "set geometry(state) [wm state .]"
2810 puts $f "set geometry(topwidth) [winfo width .tf]"
2811 puts $f "set geometry(topheight) [winfo height .tf]"
2812 if {$use_ttk} {
2813 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2814 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2815 } else {
2816 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2817 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2818 }
2819 puts $f "set geometry(botwidth) [winfo width .bleft]"
2820 puts $f "set geometry(botheight) [winfo height .bleft]"
2821
2822 puts -nonewline $f "set permviews {"
2823 for {set v 0} {$v < $nextviewnum} {incr v} {
2824 if {$viewperm($v)} {
2825 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2826 }
2827 }
2828 puts $f "}"
2829 close $f
2830 file rename -force $config_file_tmp $config_file
2831 }
2832 set stuffsaved 1
2833 }
2834
2835 proc resizeclistpanes {win w} {
2836 global oldwidth use_ttk
2837 if {[info exists oldwidth($win)]} {
2838 if {$use_ttk} {
2839 set s0 [$win sashpos 0]
2840 set s1 [$win sashpos 1]
2841 } else {
2842 set s0 [$win sash coord 0]
2843 set s1 [$win sash coord 1]
2844 }
2845 if {$w < 60} {
2846 set sash0 [expr {int($w/2 - 2)}]
2847 set sash1 [expr {int($w*5/6 - 2)}]
2848 } else {
2849 set factor [expr {1.0 * $w / $oldwidth($win)}]
2850 set sash0 [expr {int($factor * [lindex $s0 0])}]
2851 set sash1 [expr {int($factor * [lindex $s1 0])}]
2852 if {$sash0 < 30} {
2853 set sash0 30
2854 }
2855 if {$sash1 < $sash0 + 20} {
2856 set sash1 [expr {$sash0 + 20}]
2857 }
2858 if {$sash1 > $w - 10} {
2859 set sash1 [expr {$w - 10}]
2860 if {$sash0 > $sash1 - 20} {
2861 set sash0 [expr {$sash1 - 20}]
2862 }
2863 }
2864 }
2865 if {$use_ttk} {
2866 $win sashpos 0 $sash0
2867 $win sashpos 1 $sash1
2868 } else {
2869 $win sash place 0 $sash0 [lindex $s0 1]
2870 $win sash place 1 $sash1 [lindex $s1 1]
2871 }
2872 }
2873 set oldwidth($win) $w
2874 }
2875
2876 proc resizecdetpanes {win w} {
2877 global oldwidth use_ttk
2878 if {[info exists oldwidth($win)]} {
2879 if {$use_ttk} {
2880 set s0 [$win sashpos 0]
2881 } else {
2882 set s0 [$win sash coord 0]
2883 }
2884 if {$w < 60} {
2885 set sash0 [expr {int($w*3/4 - 2)}]
2886 } else {
2887 set factor [expr {1.0 * $w / $oldwidth($win)}]
2888 set sash0 [expr {int($factor * [lindex $s0 0])}]
2889 if {$sash0 < 45} {
2890 set sash0 45
2891 }
2892 if {$sash0 > $w - 15} {
2893 set sash0 [expr {$w - 15}]
2894 }
2895 }
2896 if {$use_ttk} {
2897 $win sashpos 0 $sash0
2898 } else {
2899 $win sash place 0 $sash0 [lindex $s0 1]
2900 }
2901 }
2902 set oldwidth($win) $w
2903 }
2904
2905 proc allcanvs args {
2906 global canv canv2 canv3
2907 eval $canv $args
2908 eval $canv2 $args
2909 eval $canv3 $args
2910 }
2911
2912 proc bindall {event action} {
2913 global canv canv2 canv3
2914 bind $canv $event $action
2915 bind $canv2 $event $action
2916 bind $canv3 $event $action
2917 }
2918
2919 proc about {} {
2920 global uifont NS
2921 set w .about
2922 if {[winfo exists $w]} {
2923 raise $w
2924 return
2925 }
2926 ttk_toplevel $w
2927 wm title $w [mc "About gitk"]
2928 make_transient $w .
2929 message $w.m -text [mc "
2930 Gitk - a commit viewer for git
2931
2932 Copyright \u00a9 2005-2014 Paul Mackerras
2933
2934 Use and redistribute under the terms of the GNU General Public License"] \
2935 -justify center -aspect 400 -border 2 -bg white -relief groove
2936 pack $w.m -side top -fill x -padx 2 -pady 2
2937 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2938 pack $w.ok -side bottom
2939 bind $w <Visibility> "focus $w.ok"
2940 bind $w <Key-Escape> "destroy $w"
2941 bind $w <Key-Return> "destroy $w"
2942 tk::PlaceWindow $w widget .
2943 }
2944
2945 proc keys {} {
2946 global NS
2947 set w .keys
2948 if {[winfo exists $w]} {
2949 raise $w
2950 return
2951 }
2952 if {[tk windowingsystem] eq {aqua}} {
2953 set M1T Cmd
2954 } else {
2955 set M1T Ctrl
2956 }
2957 ttk_toplevel $w
2958 wm title $w [mc "Gitk key bindings"]
2959 make_transient $w .
2960 message $w.m -text "
2961 [mc "Gitk key bindings:"]
2962
2963 [mc "<%s-Q> Quit" $M1T]
2964 [mc "<%s-W> Close window" $M1T]
2965 [mc "<Home> Move to first commit"]
2966 [mc "<End> Move to last commit"]
2967 [mc "<Up>, p, k Move up one commit"]
2968 [mc "<Down>, n, j Move down one commit"]
2969 [mc "<Left>, z, h Go back in history list"]
2970 [mc "<Right>, x, l Go forward in history list"]
2971 [mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
2972 [mc "<PageUp> Move up one page in commit list"]
2973 [mc "<PageDown> Move down one page in commit list"]
2974 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2975 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2976 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2977 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2978 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2979 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2980 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2981 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2982 [mc "<Delete>, b Scroll diff view up one page"]
2983 [mc "<Backspace> Scroll diff view up one page"]
2984 [mc "<Space> Scroll diff view down one page"]
2985 [mc "u Scroll diff view up 18 lines"]
2986 [mc "d Scroll diff view down 18 lines"]
2987 [mc "<%s-F> Find" $M1T]
2988 [mc "<%s-G> Move to next find hit" $M1T]
2989 [mc "<Return> Move to next find hit"]
2990 [mc "/ Focus the search box"]
2991 [mc "? Move to previous find hit"]
2992 [mc "f Scroll diff view to next file"]
2993 [mc "<%s-S> Search for next hit in diff view" $M1T]
2994 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2995 [mc "<%s-KP+> Increase font size" $M1T]
2996 [mc "<%s-plus> Increase font size" $M1T]
2997 [mc "<%s-KP-> Decrease font size" $M1T]
2998 [mc "<%s-minus> Decrease font size" $M1T]
2999 [mc "<F5> Update"]
3000 " \
3001 -justify left -bg white -border 2 -relief groove
3002 pack $w.m -side top -fill both -padx 2 -pady 2
3003 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3004 bind $w <Key-Escape> [list destroy $w]
3005 pack $w.ok -side bottom
3006 bind $w <Visibility> "focus $w.ok"
3007 bind $w <Key-Escape> "destroy $w"
3008 bind $w <Key-Return> "destroy $w"
3009 }
3010
3011 # Procedures for manipulating the file list window at the
3012 # bottom right of the overall window.
3013
3014 proc treeview {w l openlevs} {
3015 global treecontents treediropen treeheight treeparent treeindex
3016
3017 set ix 0
3018 set treeindex() 0
3019 set lev 0
3020 set prefix {}
3021 set prefixend -1
3022 set prefendstack {}
3023 set htstack {}
3024 set ht 0
3025 set treecontents() {}
3026 $w conf -state normal
3027 foreach f $l {
3028 while {[string range $f 0 $prefixend] ne $prefix} {
3029 if {$lev <= $openlevs} {
3030 $w mark set e:$treeindex($prefix) "end -1c"
3031 $w mark gravity e:$treeindex($prefix) left
3032 }
3033 set treeheight($prefix) $ht
3034 incr ht [lindex $htstack end]
3035 set htstack [lreplace $htstack end end]
3036 set prefixend [lindex $prefendstack end]
3037 set prefendstack [lreplace $prefendstack end end]
3038 set prefix [string range $prefix 0 $prefixend]
3039 incr lev -1
3040 }
3041 set tail [string range $f [expr {$prefixend+1}] end]
3042 while {[set slash [string first "/" $tail]] >= 0} {
3043 lappend htstack $ht
3044 set ht 0
3045 lappend prefendstack $prefixend
3046 incr prefixend [expr {$slash + 1}]
3047 set d [string range $tail 0 $slash]
3048 lappend treecontents($prefix) $d
3049 set oldprefix $prefix
3050 append prefix $d
3051 set treecontents($prefix) {}
3052 set treeindex($prefix) [incr ix]
3053 set treeparent($prefix) $oldprefix
3054 set tail [string range $tail [expr {$slash+1}] end]
3055 if {$lev <= $openlevs} {
3056 set ht 1
3057 set treediropen($prefix) [expr {$lev < $openlevs}]
3058 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3059 $w mark set d:$ix "end -1c"
3060 $w mark gravity d:$ix left
3061 set str "\n"
3062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3063 $w insert end $str
3064 $w image create end -align center -image $bm -padx 1 \
3065 -name a:$ix
3066 $w insert end $d [highlight_tag $prefix]
3067 $w mark set s:$ix "end -1c"
3068 $w mark gravity s:$ix left
3069 }
3070 incr lev
3071 }
3072 if {$tail ne {}} {
3073 if {$lev <= $openlevs} {
3074 incr ht
3075 set str "\n"
3076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3077 $w insert end $str
3078 $w insert end $tail [highlight_tag $f]
3079 }
3080 lappend treecontents($prefix) $tail
3081 }
3082 }
3083 while {$htstack ne {}} {
3084 set treeheight($prefix) $ht
3085 incr ht [lindex $htstack end]
3086 set htstack [lreplace $htstack end end]
3087 set prefixend [lindex $prefendstack end]
3088 set prefendstack [lreplace $prefendstack end end]
3089 set prefix [string range $prefix 0 $prefixend]
3090 }
3091 $w conf -state disabled
3092 }
3093
3094 proc linetoelt {l} {
3095 global treeheight treecontents
3096
3097 set y 2
3098 set prefix {}
3099 while {1} {
3100 foreach e $treecontents($prefix) {
3101 if {$y == $l} {
3102 return "$prefix$e"
3103 }
3104 set n 1
3105 if {[string index $e end] eq "/"} {
3106 set n $treeheight($prefix$e)
3107 if {$y + $n > $l} {
3108 append prefix $e
3109 incr y
3110 break
3111 }
3112 }
3113 incr y $n
3114 }
3115 }
3116 }
3117
3118 proc highlight_tree {y prefix} {
3119 global treeheight treecontents cflist
3120
3121 foreach e $treecontents($prefix) {
3122 set path $prefix$e
3123 if {[highlight_tag $path] ne {}} {
3124 $cflist tag add bold $y.0 "$y.0 lineend"
3125 }
3126 incr y
3127 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3128 set y [highlight_tree $y $path]
3129 }
3130 }
3131 return $y
3132 }
3133
3134 proc treeclosedir {w dir} {
3135 global treediropen treeheight treeparent treeindex
3136
3137 set ix $treeindex($dir)
3138 $w conf -state normal
3139 $w delete s:$ix e:$ix
3140 set treediropen($dir) 0
3141 $w image configure a:$ix -image tri-rt
3142 $w conf -state disabled
3143 set n [expr {1 - $treeheight($dir)}]
3144 while {$dir ne {}} {
3145 incr treeheight($dir) $n
3146 set dir $treeparent($dir)
3147 }
3148 }
3149
3150 proc treeopendir {w dir} {
3151 global treediropen treeheight treeparent treecontents treeindex
3152
3153 set ix $treeindex($dir)
3154 $w conf -state normal
3155 $w image configure a:$ix -image tri-dn
3156 $w mark set e:$ix s:$ix
3157 $w mark gravity e:$ix right
3158 set lev 0
3159 set str "\n"
3160 set n [llength $treecontents($dir)]
3161 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3162 incr lev
3163 append str "\t"
3164 incr treeheight($x) $n
3165 }
3166 foreach e $treecontents($dir) {
3167 set de $dir$e
3168 if {[string index $e end] eq "/"} {
3169 set iy $treeindex($de)
3170 $w mark set d:$iy e:$ix
3171 $w mark gravity d:$iy left
3172 $w insert e:$ix $str
3173 set treediropen($de) 0
3174 $w image create e:$ix -align center -image tri-rt -padx 1 \
3175 -name a:$iy
3176 $w insert e:$ix $e [highlight_tag $de]
3177 $w mark set s:$iy e:$ix
3178 $w mark gravity s:$iy left
3179 set treeheight($de) 1
3180 } else {
3181 $w insert e:$ix $str
3182 $w insert e:$ix $e [highlight_tag $de]
3183 }
3184 }
3185 $w mark gravity e:$ix right
3186 $w conf -state disabled
3187 set treediropen($dir) 1
3188 set top [lindex [split [$w index @0,0] .] 0]
3189 set ht [$w cget -height]
3190 set l [lindex [split [$w index s:$ix] .] 0]
3191 if {$l < $top} {
3192 $w yview $l.0
3193 } elseif {$l + $n + 1 > $top + $ht} {
3194 set top [expr {$l + $n + 2 - $ht}]
3195 if {$l < $top} {
3196 set top $l
3197 }
3198 $w yview $top.0
3199 }
3200 }
3201
3202 proc treeclick {w x y} {
3203 global treediropen cmitmode ctext cflist cflist_top
3204
3205 if {$cmitmode ne "tree"} return
3206 if {![info exists cflist_top]} return
3207 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3208 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3209 $cflist tag add highlight $l.0 "$l.0 lineend"
3210 set cflist_top $l
3211 if {$l == 1} {
3212 $ctext yview 1.0
3213 return
3214 }
3215 set e [linetoelt $l]
3216 if {[string index $e end] ne "/"} {
3217 showfile $e
3218 } elseif {$treediropen($e)} {
3219 treeclosedir $w $e
3220 } else {
3221 treeopendir $w $e
3222 }
3223 }
3224
3225 proc setfilelist {id} {
3226 global treefilelist cflist jump_to_here
3227
3228 treeview $cflist $treefilelist($id) 0
3229 if {$jump_to_here ne {}} {
3230 set f [lindex $jump_to_here 0]
3231 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3232 showfile $f
3233 }
3234 }
3235 }
3236
3237 image create bitmap tri-rt -background black -foreground blue -data {
3238 #define tri-rt_width 13
3239 #define tri-rt_height 13
3240 static unsigned char tri-rt_bits[] = {
3241 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3242 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3243 0x00, 0x00};
3244 } -maskdata {
3245 #define tri-rt-mask_width 13
3246 #define tri-rt-mask_height 13
3247 static unsigned char tri-rt-mask_bits[] = {
3248 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3249 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3250 0x08, 0x00};
3251 }
3252 image create bitmap tri-dn -background black -foreground blue -data {
3253 #define tri-dn_width 13
3254 #define tri-dn_height 13
3255 static unsigned char tri-dn_bits[] = {
3256 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3257 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3258 0x00, 0x00};
3259 } -maskdata {
3260 #define tri-dn-mask_width 13
3261 #define tri-dn-mask_height 13
3262 static unsigned char tri-dn-mask_bits[] = {
3263 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3264 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3265 0x00, 0x00};
3266 }
3267
3268 image create bitmap reficon-T -background black -foreground yellow -data {
3269 #define tagicon_width 13
3270 #define tagicon_height 9
3271 static unsigned char tagicon_bits[] = {
3272 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3273 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3274 } -maskdata {
3275 #define tagicon-mask_width 13
3276 #define tagicon-mask_height 9
3277 static unsigned char tagicon-mask_bits[] = {
3278 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3279 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3280 }
3281 set rectdata {
3282 #define headicon_width 13
3283 #define headicon_height 9
3284 static unsigned char headicon_bits[] = {
3285 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3286 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3287 }
3288 set rectmask {
3289 #define headicon-mask_width 13
3290 #define headicon-mask_height 9
3291 static unsigned char headicon-mask_bits[] = {
3292 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3293 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3294 }
3295 image create bitmap reficon-H -background black -foreground green \
3296 -data $rectdata -maskdata $rectmask
3297 image create bitmap reficon-o -background black -foreground "#ddddff" \
3298 -data $rectdata -maskdata $rectmask
3299
3300 proc init_flist {first} {
3301 global cflist cflist_top difffilestart
3302
3303 $cflist conf -state normal
3304 $cflist delete 0.0 end
3305 if {$first ne {}} {
3306 $cflist insert end $first
3307 set cflist_top 1
3308 $cflist tag add highlight 1.0 "1.0 lineend"
3309 } else {
3310 catch {unset cflist_top}
3311 }
3312 $cflist conf -state disabled
3313 set difffilestart {}
3314 }
3315
3316 proc highlight_tag {f} {
3317 global highlight_paths
3318
3319 foreach p $highlight_paths {
3320 if {[string match $p $f]} {
3321 return "bold"
3322 }
3323 }
3324 return {}
3325 }
3326
3327 proc highlight_filelist {} {
3328 global cmitmode cflist
3329
3330 $cflist conf -state normal
3331 if {$cmitmode ne "tree"} {
3332 set end [lindex [split [$cflist index end] .] 0]
3333 for {set l 2} {$l < $end} {incr l} {
3334 set line [$cflist get $l.0 "$l.0 lineend"]
3335 if {[highlight_tag $line] ne {}} {
3336 $cflist tag add bold $l.0 "$l.0 lineend"
3337 }
3338 }
3339 } else {
3340 highlight_tree 2 {}
3341 }
3342 $cflist conf -state disabled
3343 }
3344
3345 proc unhighlight_filelist {} {
3346 global cflist
3347
3348 $cflist conf -state normal
3349 $cflist tag remove bold 1.0 end
3350 $cflist conf -state disabled
3351 }
3352
3353 proc add_flist {fl} {
3354 global cflist
3355
3356 $cflist conf -state normal
3357 foreach f $fl {
3358 $cflist insert end "\n"
3359 $cflist insert end $f [highlight_tag $f]
3360 }
3361 $cflist conf -state disabled
3362 }
3363
3364 proc sel_flist {w x y} {
3365 global ctext difffilestart cflist cflist_top cmitmode
3366
3367 if {$cmitmode eq "tree"} return
3368 if {![info exists cflist_top]} return
3369 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3370 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3371 $cflist tag add highlight $l.0 "$l.0 lineend"
3372 set cflist_top $l
3373 if {$l == 1} {
3374 $ctext yview 1.0
3375 } else {
3376 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3377 }
3378 suppress_highlighting_file_for_current_scrollpos
3379 }
3380
3381 proc pop_flist_menu {w X Y x y} {
3382 global ctext cflist cmitmode flist_menu flist_menu_file
3383 global treediffs diffids
3384
3385 stopfinding
3386 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3387 if {$l <= 1} return
3388 if {$cmitmode eq "tree"} {
3389 set e [linetoelt $l]
3390 if {[string index $e end] eq "/"} return
3391 } else {
3392 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3393 }
3394 set flist_menu_file $e
3395 set xdiffstate "normal"
3396 if {$cmitmode eq "tree"} {
3397 set xdiffstate "disabled"
3398 }
3399 # Disable "External diff" item in tree mode
3400 $flist_menu entryconf 2 -state $xdiffstate
3401 tk_popup $flist_menu $X $Y
3402 }
3403
3404 proc find_ctext_fileinfo {line} {
3405 global ctext_file_names ctext_file_lines
3406
3407 set ok [bsearch $ctext_file_lines $line]
3408 set tline [lindex $ctext_file_lines $ok]
3409
3410 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3411 return {}
3412 } else {
3413 return [list [lindex $ctext_file_names $ok] $tline]
3414 }
3415 }
3416
3417 proc pop_diff_menu {w X Y x y} {
3418 global ctext diff_menu flist_menu_file
3419 global diff_menu_txtpos diff_menu_line
3420 global diff_menu_filebase
3421
3422 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3423 set diff_menu_line [lindex $diff_menu_txtpos 0]
3424 # don't pop up the menu on hunk-separator or file-separator lines
3425 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3426 return
3427 }
3428 stopfinding
3429 set f [find_ctext_fileinfo $diff_menu_line]
3430 if {$f eq {}} return
3431 set flist_menu_file [lindex $f 0]
3432 set diff_menu_filebase [lindex $f 1]
3433 tk_popup $diff_menu $X $Y
3434 }
3435
3436 proc flist_hl {only} {
3437 global flist_menu_file findstring gdttype
3438
3439 set x [shellquote $flist_menu_file]
3440 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3441 set findstring $x
3442 } else {
3443 append findstring " " $x
3444 }
3445 set gdttype [mc "touching paths:"]
3446 }
3447
3448 proc gitknewtmpdir {} {
3449 global diffnum gitktmpdir gitdir env
3450
3451 if {![info exists gitktmpdir]} {
3452 if {[info exists env(GITK_TMPDIR)]} {
3453 set tmpdir $env(GITK_TMPDIR)
3454 } elseif {[info exists env(TMPDIR)]} {
3455 set tmpdir $env(TMPDIR)
3456 } else {
3457 set tmpdir $gitdir
3458 }
3459 set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3460 if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3461 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3462 }
3463 if {[catch {file mkdir $gitktmpdir} err]} {
3464 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3465 unset gitktmpdir
3466 return {}
3467 }
3468 set diffnum 0
3469 }
3470 incr diffnum
3471 set diffdir [file join $gitktmpdir $diffnum]
3472 if {[catch {file mkdir $diffdir} err]} {
3473 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3474 return {}
3475 }
3476 return $diffdir
3477 }
3478
3479 proc save_file_from_commit {filename output what} {
3480 global nullfile
3481
3482 if {[catch {exec git show $filename -- > $output} err]} {
3483 if {[string match "fatal: bad revision *" $err]} {
3484 return $nullfile
3485 }
3486 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3487 return {}
3488 }
3489 return $output
3490 }
3491
3492 proc external_diff_get_one_file {diffid filename diffdir} {
3493 global nullid nullid2 nullfile
3494 global worktree
3495
3496 if {$diffid == $nullid} {
3497 set difffile [file join $worktree $filename]
3498 if {[file exists $difffile]} {
3499 return $difffile
3500 }
3501 return $nullfile
3502 }
3503 if {$diffid == $nullid2} {
3504 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3505 return [save_file_from_commit :$filename $difffile index]
3506 }
3507 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3508 return [save_file_from_commit $diffid:$filename $difffile \
3509 "revision $diffid"]
3510 }
3511
3512 proc external_diff {} {
3513 global nullid nullid2
3514 global flist_menu_file
3515 global diffids
3516 global extdifftool
3517
3518 if {[llength $diffids] == 1} {
3519 # no reference commit given
3520 set diffidto [lindex $diffids 0]
3521 if {$diffidto eq $nullid} {
3522 # diffing working copy with index
3523 set diffidfrom $nullid2
3524 } elseif {$diffidto eq $nullid2} {
3525 # diffing index with HEAD
3526 set diffidfrom "HEAD"
3527 } else {
3528 # use first parent commit
3529 global parentlist selectedline
3530 set diffidfrom [lindex $parentlist $selectedline 0]
3531 }
3532 } else {
3533 set diffidfrom [lindex $diffids 0]
3534 set diffidto [lindex $diffids 1]
3535 }
3536
3537 # make sure that several diffs wont collide
3538 set diffdir [gitknewtmpdir]
3539 if {$diffdir eq {}} return
3540
3541 # gather files to diff
3542 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3543 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3544
3545 if {$difffromfile ne {} && $difftofile ne {}} {
3546 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3547 if {[catch {set fl [open |$cmd r]} err]} {
3548 file delete -force $diffdir
3549 error_popup "$extdifftool: [mc "command failed:"] $err"
3550 } else {
3551 fconfigure $fl -blocking 0
3552 filerun $fl [list delete_at_eof $fl $diffdir]
3553 }
3554 }
3555 }
3556
3557 proc find_hunk_blamespec {base line} {
3558 global ctext
3559
3560 # Find and parse the hunk header
3561 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3562 if {$s_lix eq {}} return
3563
3564 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3565 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3566 s_line old_specs osz osz1 new_line nsz]} {
3567 return
3568 }
3569
3570 # base lines for the parents
3571 set base_lines [list $new_line]
3572 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3573 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3574 old_spec old_line osz]} {
3575 return
3576 }
3577 lappend base_lines $old_line
3578 }
3579
3580 # Now scan the lines to determine offset within the hunk
3581 set max_parent [expr {[llength $base_lines]-2}]
3582 set dline 0
3583 set s_lno [lindex [split $s_lix "."] 0]
3584
3585 # Determine if the line is removed
3586 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3587 if {[string match {[-+ ]*} $chunk]} {
3588 set removed_idx [string first "-" $chunk]
3589 # Choose a parent index
3590 if {$removed_idx >= 0} {
3591 set parent $removed_idx
3592 } else {
3593 set unchanged_idx [string first " " $chunk]
3594 if {$unchanged_idx >= 0} {
3595 set parent $unchanged_idx
3596 } else {
3597 # blame the current commit
3598 set parent -1
3599 }
3600 }
3601 # then count other lines that belong to it
3602 for {set i $line} {[incr i -1] > $s_lno} {} {
3603 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3604 # Determine if the line is removed
3605 set removed_idx [string first "-" $chunk]
3606 if {$parent >= 0} {
3607 set code [string index $chunk $parent]
3608 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3609 incr dline
3610 }
3611 } else {
3612 if {$removed_idx < 0} {
3613 incr dline
3614 }
3615 }
3616 }
3617 incr parent
3618 } else {
3619 set parent 0
3620 }
3621
3622 incr dline [lindex $base_lines $parent]
3623 return [list $parent $dline]
3624 }
3625
3626 proc external_blame_diff {} {
3627 global currentid cmitmode
3628 global diff_menu_txtpos diff_menu_line
3629 global diff_menu_filebase flist_menu_file
3630
3631 if {$cmitmode eq "tree"} {
3632 set parent_idx 0
3633 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3634 } else {
3635 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3636 if {$hinfo ne {}} {
3637 set parent_idx [lindex $hinfo 0]
3638 set line [lindex $hinfo 1]
3639 } else {
3640 set parent_idx 0
3641 set line 0
3642 }
3643 }
3644
3645 external_blame $parent_idx $line
3646 }
3647
3648 # Find the SHA1 ID of the blob for file $fname in the index
3649 # at stage 0 or 2
3650 proc index_sha1 {fname} {
3651 set f [open [list | git ls-files -s $fname] r]
3652 while {[gets $f line] >= 0} {
3653 set info [lindex [split $line "\t"] 0]
3654 set stage [lindex $info 2]
3655 if {$stage eq "0" || $stage eq "2"} {
3656 close $f
3657 return [lindex $info 1]
3658 }
3659 }
3660 close $f
3661 return {}
3662 }
3663
3664 # Turn an absolute path into one relative to the current directory
3665 proc make_relative {f} {
3666 if {[file pathtype $f] eq "relative"} {
3667 return $f
3668 }
3669 set elts [file split $f]
3670 set here [file split [pwd]]
3671 set ei 0
3672 set hi 0
3673 set res {}
3674 foreach d $here {
3675 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3676 lappend res ".."
3677 } else {
3678 incr ei
3679 }
3680 incr hi
3681 }
3682 set elts [concat $res [lrange $elts $ei end]]
3683 return [eval file join $elts]
3684 }
3685
3686 proc external_blame {parent_idx {line {}}} {
3687 global flist_menu_file cdup
3688 global nullid nullid2
3689 global parentlist selectedline currentid
3690
3691 if {$parent_idx > 0} {
3692 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3693 } else {
3694 set base_commit $currentid
3695 }
3696
3697 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3698 error_popup [mc "No such commit"]
3699 return
3700 }
3701
3702 set cmdline [list git gui blame]
3703 if {$line ne {} && $line > 1} {
3704 lappend cmdline "--line=$line"
3705 }
3706 set f [file join $cdup $flist_menu_file]
3707 # Unfortunately it seems git gui blame doesn't like
3708 # being given an absolute path...
3709 set f [make_relative $f]
3710 lappend cmdline $base_commit $f
3711 if {[catch {eval exec $cmdline &} err]} {
3712 error_popup "[mc "git gui blame: command failed:"] $err"
3713 }
3714 }
3715
3716 proc show_line_source {} {
3717 global cmitmode currentid parents curview blamestuff blameinst
3718 global diff_menu_line diff_menu_filebase flist_menu_file
3719 global nullid nullid2 gitdir cdup
3720
3721 set from_index {}
3722 if {$cmitmode eq "tree"} {
3723 set id $currentid
3724 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3725 } else {
3726 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3727 if {$h eq {}} return
3728 set pi [lindex $h 0]
3729 if {$pi == 0} {
3730 mark_ctext_line $diff_menu_line
3731 return
3732 }
3733 incr pi -1
3734 if {$currentid eq $nullid} {
3735 if {$pi > 0} {
3736 # must be a merge in progress...
3737 if {[catch {
3738 # get the last line from .git/MERGE_HEAD
3739 set f [open [file join $gitdir MERGE_HEAD] r]
3740 set id [lindex [split [read $f] "\n"] end-1]
3741 close $f
3742 } err]} {
3743 error_popup [mc "Couldn't read merge head: %s" $err]
3744 return
3745 }
3746 } elseif {$parents($curview,$currentid) eq $nullid2} {
3747 # need to do the blame from the index
3748 if {[catch {
3749 set from_index [index_sha1 $flist_menu_file]
3750 } err]} {
3751 error_popup [mc "Error reading index: %s" $err]
3752 return
3753 }
3754 } else {
3755 set id $parents($curview,$currentid)
3756 }
3757 } else {
3758 set id [lindex $parents($curview,$currentid) $pi]
3759 }
3760 set line [lindex $h 1]
3761 }
3762 set blameargs {}
3763 if {$from_index ne {}} {
3764 lappend blameargs | git cat-file blob $from_index
3765 }
3766 lappend blameargs | git blame -p -L$line,+1
3767 if {$from_index ne {}} {
3768 lappend blameargs --contents -
3769 } else {
3770 lappend blameargs $id
3771 }
3772 lappend blameargs -- [file join $cdup $flist_menu_file]
3773 if {[catch {
3774 set f [open $blameargs r]
3775 } err]} {
3776 error_popup [mc "Couldn't start git blame: %s" $err]
3777 return
3778 }
3779 nowbusy blaming [mc "Searching"]
3780 fconfigure $f -blocking 0
3781 set i [reg_instance $f]
3782 set blamestuff($i) {}
3783 set blameinst $i
3784 filerun $f [list read_line_source $f $i]
3785 }
3786
3787 proc stopblaming {} {
3788 global blameinst
3789
3790 if {[info exists blameinst]} {
3791 stop_instance $blameinst
3792 unset blameinst
3793 notbusy blaming
3794 }
3795 }
3796
3797 proc read_line_source {fd inst} {
3798 global blamestuff curview commfd blameinst nullid nullid2
3799
3800 while {[gets $fd line] >= 0} {
3801 lappend blamestuff($inst) $line
3802 }
3803 if {![eof $fd]} {
3804 return 1
3805 }
3806 unset commfd($inst)
3807 unset blameinst
3808 notbusy blaming
3809 fconfigure $fd -blocking 1
3810 if {[catch {close $fd} err]} {
3811 error_popup [mc "Error running git blame: %s" $err]
3812 return 0
3813 }
3814
3815 set fname {}
3816 set line [split [lindex $blamestuff($inst) 0] " "]
3817 set id [lindex $line 0]
3818 set lnum [lindex $line 1]
3819 if {[string length $id] == 40 && [string is xdigit $id] &&
3820 [string is digit -strict $lnum]} {
3821 # look for "filename" line
3822 foreach l $blamestuff($inst) {
3823 if {[string match "filename *" $l]} {
3824 set fname [string range $l 9 end]
3825 break
3826 }
3827 }
3828 }
3829 if {$fname ne {}} {
3830 # all looks good, select it
3831 if {$id eq $nullid} {
3832 # blame uses all-zeroes to mean not committed,
3833 # which would mean a change in the index
3834 set id $nullid2
3835 }
3836 if {[commitinview $id $curview]} {
3837 selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3838 } else {
3839 error_popup [mc "That line comes from commit %s, \
3840 which is not in this view" [shortids $id]]
3841 }
3842 } else {
3843 puts "oops couldn't parse git blame output"
3844 }
3845 return 0
3846 }
3847
3848 # delete $dir when we see eof on $f (presumably because the child has exited)
3849 proc delete_at_eof {f dir} {
3850 while {[gets $f line] >= 0} {}
3851 if {[eof $f]} {
3852 if {[catch {close $f} err]} {
3853 error_popup "[mc "External diff viewer failed:"] $err"
3854 }
3855 file delete -force $dir
3856 return 0
3857 }
3858 return 1
3859 }
3860
3861 # Functions for adding and removing shell-type quoting
3862
3863 proc shellquote {str} {
3864 if {![string match "*\['\"\\ \t]*" $str]} {
3865 return $str
3866 }
3867 if {![string match "*\['\"\\]*" $str]} {
3868 return "\"$str\""
3869 }
3870 if {![string match "*'*" $str]} {
3871 return "'$str'"
3872 }
3873 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3874 }
3875
3876 proc shellarglist {l} {
3877 set str {}
3878 foreach a $l {
3879 if {$str ne {}} {
3880 append str " "
3881 }
3882 append str [shellquote $a]
3883 }
3884 return $str
3885 }
3886
3887 proc shelldequote {str} {
3888 set ret {}
3889 set used -1
3890 while {1} {
3891 incr used
3892 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3893 append ret [string range $str $used end]
3894 set used [string length $str]
3895 break
3896 }
3897 set first [lindex $first 0]
3898 set ch [string index $str $first]
3899 if {$first > $used} {
3900 append ret [string range $str $used [expr {$first - 1}]]
3901 set used $first
3902 }
3903 if {$ch eq " " || $ch eq "\t"} break
3904 incr used
3905 if {$ch eq "'"} {
3906 set first [string first "'" $str $used]
3907 if {$first < 0} {
3908 error "unmatched single-quote"
3909 }
3910 append ret [string range $str $used [expr {$first - 1}]]
3911 set used $first
3912 continue
3913 }
3914 if {$ch eq "\\"} {
3915 if {$used >= [string length $str]} {
3916 error "trailing backslash"
3917 }
3918 append ret [string index $str $used]
3919 continue
3920 }
3921 # here ch == "\""
3922 while {1} {
3923 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3924 error "unmatched double-quote"
3925 }
3926 set first [lindex $first 0]
3927 set ch [string index $str $first]
3928 if {$first > $used} {
3929 append ret [string range $str $used [expr {$first - 1}]]
3930 set used $first
3931 }
3932 if {$ch eq "\""} break
3933 incr used
3934 append ret [string index $str $used]
3935 incr used
3936 }
3937 }
3938 return [list $used $ret]
3939 }
3940
3941 proc shellsplit {str} {
3942 set l {}
3943 while {1} {
3944 set str [string trimleft $str]
3945 if {$str eq {}} break
3946 set dq [shelldequote $str]
3947 set n [lindex $dq 0]
3948 set word [lindex $dq 1]
3949 set str [string range $str $n end]
3950 lappend l $word
3951 }
3952 return $l
3953 }
3954
3955 # Code to implement multiple views
3956
3957 proc newview {ishighlight} {
3958 global nextviewnum newviewname newishighlight
3959 global revtreeargs viewargscmd newviewopts curview
3960
3961 set newishighlight $ishighlight
3962 set top .gitkview
3963 if {[winfo exists $top]} {
3964 raise $top
3965 return
3966 }
3967 decode_view_opts $nextviewnum $revtreeargs
3968 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3969 set newviewopts($nextviewnum,perm) 0
3970 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3971 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3972 }
3973
3974 set known_view_options {
3975 {perm b . {} {mc "Remember this view"}}
3976 {reflabel l + {} {mc "References (space separated list):"}}
3977 {refs t15 .. {} {mc "Branches & tags:"}}
3978 {allrefs b *. "--all" {mc "All refs"}}
3979 {branches b . "--branches" {mc "All (local) branches"}}
3980 {tags b . "--tags" {mc "All tags"}}
3981 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3982 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3983 {author t15 .. "--author=*" {mc "Author:"}}
3984 {committer t15 . "--committer=*" {mc "Committer:"}}
3985 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3986 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3987 {changes_l l + {} {mc "Changes to Files:"}}
3988 {pickaxe_s r0 . {} {mc "Fixed String"}}
3989 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3990 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3991 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3992 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3993 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3994 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3995 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3996 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3997 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3998 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3999 {lright b . "--left-right" {mc "Mark branch sides"}}
4000 {first b . "--first-parent" {mc "Limit to first parent"}}
4001 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
4002 {args t50 *. {} {mc "Additional arguments to git log:"}}
4003 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4004 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
4005 }
4006
4007 # Convert $newviewopts($n, ...) into args for git log.
4008 proc encode_view_opts {n} {
4009 global known_view_options newviewopts
4010
4011 set rargs [list]
4012 foreach opt $known_view_options {
4013 set patterns [lindex $opt 3]
4014 if {$patterns eq {}} continue
4015 set pattern [lindex $patterns 0]
4016
4017 if {[lindex $opt 1] eq "b"} {
4018 set val $newviewopts($n,[lindex $opt 0])
4019 if {$val} {
4020 lappend rargs $pattern
4021 }
4022 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4023 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4024 set val $newviewopts($n,$button_id)
4025 if {$val eq $value} {
4026 lappend rargs $pattern
4027 }
4028 } else {
4029 set val $newviewopts($n,[lindex $opt 0])
4030 set val [string trim $val]
4031 if {$val ne {}} {
4032 set pfix [string range $pattern 0 end-1]
4033 lappend rargs $pfix$val
4034 }
4035 }
4036 }
4037 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4038 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4039 }
4040
4041 # Fill $newviewopts($n, ...) based on args for git log.
4042 proc decode_view_opts {n view_args} {
4043 global known_view_options newviewopts
4044
4045 foreach opt $known_view_options {
4046 set id [lindex $opt 0]
4047 if {[lindex $opt 1] eq "b"} {
4048 # Checkboxes
4049 set val 0
4050 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4051 # Radiobuttons
4052 regexp {^(.*_)} $id uselessvar id
4053 set val 0
4054 } else {
4055 # Text fields
4056 set val {}
4057 }
4058 set newviewopts($n,$id) $val
4059 }
4060 set oargs [list]
4061 set refargs [list]
4062 foreach arg $view_args {
4063 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4064 && ![info exists found(limit)]} {
4065 set newviewopts($n,limit) $cnt
4066 set found(limit) 1
4067 continue
4068 }
4069 catch { unset val }
4070 foreach opt $known_view_options {
4071 set id [lindex $opt 0]
4072 if {[info exists found($id)]} continue
4073 foreach pattern [lindex $opt 3] {
4074 if {![string match $pattern $arg]} continue
4075 if {[lindex $opt 1] eq "b"} {
4076 # Check buttons
4077 set val 1
4078 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4079 # Radio buttons
4080 regexp {^(.*_)} $id uselessvar id
4081 set val $num
4082 } else {
4083 # Text input fields
4084 set size [string length $pattern]
4085 set val [string range $arg [expr {$size-1}] end]
4086 }
4087 set newviewopts($n,$id) $val
4088 set found($id) 1
4089 break
4090 }
4091 if {[info exists val]} break
4092 }