gitk: Fix commit encoding support
[git/jnareb-git.git] / gitk
blob3864d3826de6ea24fb807cc2346d74d84c39db42
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright © 2005-2008 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.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return [exec git rev-parse --git-dir]
19 # A simple scheduler for compute-intensive stuff.
20 # The aim is to make sure that event handlers for GUI actions can
21 # run at least every 50-100 ms. Unfortunately fileevent handlers are
22 # run before X event handlers, so reading from a fast source can
23 # make the GUI completely unresponsive.
24 proc run args {
25 global isonrunq runq currunq
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {} && ![info exists currunq]} {
30 after idle dorunq
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
36 proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
40 proc filereadable {fd script} {
41 global runq currunq
43 fileevent $fd readable {}
44 if {$runq eq {} && ![info exists currunq]} {
45 after idle dorunq
47 lappend runq [list $fd $script]
50 proc nukefile {fd} {
51 global runq
53 for {set i 0} {$i < [llength $runq]} {} {
54 if {[lindex $runq $i 0] eq $fd} {
55 set runq [lreplace $runq $i $i]
56 } else {
57 incr i
62 proc dorunq {} {
63 global isonrunq runq currunq
65 set tstart [clock clicks -milliseconds]
66 set t0 $tstart
67 while {[llength $runq] > 0} {
68 set fd [lindex $runq 0 0]
69 set script [lindex $runq 0 1]
70 set currunq [lindex $runq 0]
71 set runq [lrange $runq 1 end]
72 set repeat [eval $script]
73 unset currunq
74 set t1 [clock clicks -milliseconds]
75 set t [expr {$t1 - $t0}]
76 if {$repeat ne {} && $repeat} {
77 if {$fd eq {} || $repeat == 2} {
78 # script returns 1 if it wants to be readded
79 # file readers return 2 if they could do more straight away
80 lappend runq [list $fd $script]
81 } else {
82 fileevent $fd readable [list filereadable $fd $script]
84 } elseif {$fd eq {}} {
85 unset isonrunq($script)
87 set t0 $t1
88 if {$t1 - $tstart >= 80} break
90 if {$runq ne {}} {
91 after idle dorunq
95 proc reg_instance {fd} {
96 global commfd leftover loginstance
98 set i [incr loginstance]
99 set commfd($i) $fd
100 set leftover($i) {}
101 return $i
104 proc unmerged_files {files} {
105 global nr_unmerged
107 # find the list of unmerged files
108 set mlist {}
109 set nr_unmerged 0
110 if {[catch {
111 set fd [open "| git ls-files -u" r]
112 } err]} {
113 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
114 exit 1
116 while {[gets $fd line] >= 0} {
117 set i [string first "\t" $line]
118 if {$i < 0} continue
119 set fname [string range $line [expr {$i+1}] end]
120 if {[lsearch -exact $mlist $fname] >= 0} continue
121 incr nr_unmerged
122 if {$files eq {} || [path_filter $files $fname]} {
123 lappend mlist $fname
126 catch {close $fd}
127 return $mlist
130 proc parseviewargs {n arglist} {
131 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
133 set vdatemode($n) 0
134 set vmergeonly($n) 0
135 set glflags {}
136 set diffargs {}
137 set nextisval 0
138 set revargs {}
139 set origargs $arglist
140 set allknown 1
141 set filtered 0
142 set i -1
143 foreach arg $arglist {
144 incr i
145 if {$nextisval} {
146 lappend glflags $arg
147 set nextisval 0
148 continue
150 switch -glob -- $arg {
151 "-d" -
152 "--date-order" {
153 set vdatemode($n) 1
154 # remove from origargs in case we hit an unknown option
155 set origargs [lreplace $origargs $i $i]
156 incr i -1
158 # These request or affect diff output, which we don't want.
159 # Some could be used to set our defaults for diff display.
160 "-[puabwcrRBMC]" -
161 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
162 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
163 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
164 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
165 "--ignore-space-change" - "-U*" - "--unified=*" {
166 lappend diffargs $arg
168 # These cause our parsing of git log's output to fail, or else
169 # they're options we want to set ourselves, so ignore them.
170 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
171 "--name-only" - "--name-status" - "--color" - "--color-words" -
172 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
173 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
174 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
175 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
176 "--objects" - "--objects-edge" - "--reverse" {
178 # These are harmless, and some are even useful
179 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
180 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
181 "--full-history" - "--dense" - "--sparse" -
182 "--follow" - "--left-right" - "--encoding=*" {
183 lappend glflags $arg
185 # These mean that we get a subset of the commits
186 "--diff-filter=*" - "--no-merges" - "--unpacked" -
187 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
188 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
189 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
190 "--remove-empty" - "--first-parent" - "--cherry-pick" -
191 "-S*" - "--pickaxe-all" - "--pickaxe-regex" - {
192 set filtered 1
193 lappend glflags $arg
195 # This appears to be the only one that has a value as a
196 # separate word following it
197 "-n" {
198 set filtered 1
199 set nextisval 1
200 lappend glflags $arg
202 "--not" {
203 set notflag [expr {!$notflag}]
204 lappend revargs $arg
206 "--all" {
207 lappend revargs $arg
209 "--merge" {
210 set vmergeonly($n) 1
211 # git rev-parse doesn't understand --merge
212 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
214 # Other flag arguments including -<n>
215 "-*" {
216 if {[string is digit -strict [string range $arg 1 end]]} {
217 set filtered 1
218 } else {
219 # a flag argument that we don't recognize;
220 # that means we can't optimize
221 set allknown 0
223 lappend glflags $arg
225 # Non-flag arguments specify commits or ranges of commits
226 default {
227 if {[string match "*...*" $arg]} {
228 lappend revargs --gitk-symmetric-diff-marker
230 lappend revargs $arg
234 set vdflags($n) $diffargs
235 set vflags($n) $glflags
236 set vrevs($n) $revargs
237 set vfiltered($n) $filtered
238 set vorigargs($n) $origargs
239 return $allknown
242 proc parseviewrevs {view revs} {
243 global vposids vnegids
245 if {$revs eq {}} {
246 set revs HEAD
248 if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
249 # we get stdout followed by stderr in $err
250 # for an unknown rev, git rev-parse echoes it and then errors out
251 set errlines [split $err "\n"]
252 set badrev {}
253 for {set l 0} {$l < [llength $errlines]} {incr l} {
254 set line [lindex $errlines $l]
255 if {!([string length $line] == 40 && [string is xdigit $line])} {
256 if {[string match "fatal:*" $line]} {
257 if {[string match "fatal: ambiguous argument*" $line]
258 && $badrev ne {}} {
259 if {[llength $badrev] == 1} {
260 set err "unknown revision $badrev"
261 } else {
262 set err "unknown revisions: [join $badrev ", "]"
264 } else {
265 set err [join [lrange $errlines $l end] "\n"]
267 break
269 lappend badrev $line
272 error_popup "[mc "Error parsing revisions:"] $err"
273 return {}
275 set ret {}
276 set pos {}
277 set neg {}
278 set sdm 0
279 foreach id [split $ids "\n"] {
280 if {$id eq "--gitk-symmetric-diff-marker"} {
281 set sdm 4
282 } elseif {[string match "^*" $id]} {
283 if {$sdm != 1} {
284 lappend ret $id
285 if {$sdm == 3} {
286 set sdm 0
289 lappend neg [string range $id 1 end]
290 } else {
291 if {$sdm != 2} {
292 lappend ret $id
293 } else {
294 lset ret end [lindex $ret end]...$id
296 lappend pos $id
298 incr sdm -1
300 set vposids($view) $pos
301 set vnegids($view) $neg
302 return $ret
305 # Start off a git log process and arrange to read its output
306 proc start_rev_list {view} {
307 global startmsecs commitidx viewcomplete curview
308 global tclencoding
309 global viewargs viewargscmd viewfiles vfilelimit
310 global showlocalchanges
311 global viewactive viewinstances vmergeonly
312 global mainheadid
313 global vcanopt vflags vrevs vorigargs
315 set startmsecs [clock clicks -milliseconds]
316 set commitidx($view) 0
317 # these are set this way for the error exits
318 set viewcomplete($view) 1
319 set viewactive($view) 0
320 varcinit $view
322 set args $viewargs($view)
323 if {$viewargscmd($view) ne {}} {
324 if {[catch {
325 set str [exec sh -c $viewargscmd($view)]
326 } err]} {
327 error_popup "[mc "Error executing --argscmd command:"] $err"
328 return 0
330 set args [concat $args [split $str "\n"]]
332 set vcanopt($view) [parseviewargs $view $args]
334 set files $viewfiles($view)
335 if {$vmergeonly($view)} {
336 set files [unmerged_files $files]
337 if {$files eq {}} {
338 global nr_unmerged
339 if {$nr_unmerged == 0} {
340 error_popup [mc "No files selected: --merge specified but\
341 no files are unmerged."]
342 } else {
343 error_popup [mc "No files selected: --merge specified but\
344 no unmerged files are within file limit."]
346 return 0
349 set vfilelimit($view) $files
351 if {$vcanopt($view)} {
352 set revs [parseviewrevs $view $vrevs($view)]
353 if {$revs eq {}} {
354 return 0
356 set args [concat $vflags($view) $revs]
357 } else {
358 set args $vorigargs($view)
361 if {[catch {
362 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
363 --boundary $args "--" $files] r]
364 } err]} {
365 error_popup "[mc "Error executing git log:"] $err"
366 return 0
368 set i [reg_instance $fd]
369 set viewinstances($view) [list $i]
370 if {$showlocalchanges && $mainheadid ne {}} {
371 interestedin $mainheadid dodiffindex
373 fconfigure $fd -blocking 0 -translation lf -eofchar {}
374 if {$tclencoding != {}} {
375 fconfigure $fd -encoding $tclencoding
377 filerun $fd [list getcommitlines $fd $i $view 0]
378 nowbusy $view [mc "Reading"]
379 set viewcomplete($view) 0
380 set viewactive($view) 1
381 return 1
384 proc stop_instance {inst} {
385 global commfd leftover
387 set fd $commfd($inst)
388 catch {
389 set pid [pid $fd]
391 if {$::tcl_platform(platform) eq {windows}} {
392 exec kill -f $pid
393 } else {
394 exec kill $pid
397 catch {close $fd}
398 nukefile $fd
399 unset commfd($inst)
400 unset leftover($inst)
403 proc stop_backends {} {
404 global commfd
406 foreach inst [array names commfd] {
407 stop_instance $inst
411 proc stop_rev_list {view} {
412 global viewinstances
414 foreach inst $viewinstances($view) {
415 stop_instance $inst
417 set viewinstances($view) {}
420 proc reset_pending_select {selid} {
421 global pending_select mainheadid selectheadid
423 if {$selid ne {}} {
424 set pending_select $selid
425 } elseif {$selectheadid ne {}} {
426 set pending_select $selectheadid
427 } else {
428 set pending_select $mainheadid
432 proc getcommits {selid} {
433 global canv curview need_redisplay viewactive
435 initlayout
436 if {[start_rev_list $curview]} {
437 reset_pending_select $selid
438 show_status [mc "Reading commits..."]
439 set need_redisplay 1
440 } else {
441 show_status [mc "No commits selected"]
445 proc updatecommits {} {
446 global curview vcanopt vorigargs vfilelimit viewinstances
447 global viewactive viewcomplete tclencoding
448 global startmsecs showneartags showlocalchanges
449 global mainheadid pending_select
450 global isworktree
451 global varcid vposids vnegids vflags vrevs
453 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
454 set oldmainid $mainheadid
455 rereadrefs
456 if {$showlocalchanges} {
457 if {$mainheadid ne $oldmainid} {
458 dohidelocalchanges
460 if {[commitinview $mainheadid $curview]} {
461 dodiffindex
464 set view $curview
465 if {$vcanopt($view)} {
466 set oldpos $vposids($view)
467 set oldneg $vnegids($view)
468 set revs [parseviewrevs $view $vrevs($view)]
469 if {$revs eq {}} {
470 return
472 # note: getting the delta when negative refs change is hard,
473 # and could require multiple git log invocations, so in that
474 # case we ask git log for all the commits (not just the delta)
475 if {$oldneg eq $vnegids($view)} {
476 set newrevs {}
477 set npos 0
478 # take out positive refs that we asked for before or
479 # that we have already seen
480 foreach rev $revs {
481 if {[string length $rev] == 40} {
482 if {[lsearch -exact $oldpos $rev] < 0
483 && ![info exists varcid($view,$rev)]} {
484 lappend newrevs $rev
485 incr npos
487 } else {
488 lappend $newrevs $rev
491 if {$npos == 0} return
492 set revs $newrevs
493 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
495 set args [concat $vflags($view) $revs --not $oldpos]
496 } else {
497 set args $vorigargs($view)
499 if {[catch {
500 set fd [open [concat | git log --no-color -z --pretty=raw --parents \
501 --boundary $args "--" $vfilelimit($view)] r]
502 } err]} {
503 error_popup "[mc "Error executing git log:"] $err"
504 return
506 if {$viewactive($view) == 0} {
507 set startmsecs [clock clicks -milliseconds]
509 set i [reg_instance $fd]
510 lappend viewinstances($view) $i
511 fconfigure $fd -blocking 0 -translation lf -eofchar {}
512 if {$tclencoding != {}} {
513 fconfigure $fd -encoding $tclencoding
515 filerun $fd [list getcommitlines $fd $i $view 1]
516 incr viewactive($view)
517 set viewcomplete($view) 0
518 reset_pending_select {}
519 nowbusy $view "Reading"
520 if {$showneartags} {
521 getallcommits
525 proc reloadcommits {} {
526 global curview viewcomplete selectedline currentid thickerline
527 global showneartags treediffs commitinterest cached_commitrow
528 global targetid
530 set selid {}
531 if {$selectedline ne {}} {
532 set selid $currentid
535 if {!$viewcomplete($curview)} {
536 stop_rev_list $curview
538 resetvarcs $curview
539 set selectedline {}
540 catch {unset currentid}
541 catch {unset thickerline}
542 catch {unset treediffs}
543 readrefs
544 changedrefs
545 if {$showneartags} {
546 getallcommits
548 clear_display
549 catch {unset commitinterest}
550 catch {unset cached_commitrow}
551 catch {unset targetid}
552 setcanvscroll
553 getcommits $selid
554 return 0
557 # This makes a string representation of a positive integer which
558 # sorts as a string in numerical order
559 proc strrep {n} {
560 if {$n < 16} {
561 return [format "%x" $n]
562 } elseif {$n < 256} {
563 return [format "x%.2x" $n]
564 } elseif {$n < 65536} {
565 return [format "y%.4x" $n]
567 return [format "z%.8x" $n]
570 # Procedures used in reordering commits from git log (without
571 # --topo-order) into the order for display.
573 proc varcinit {view} {
574 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
575 global vtokmod varcmod vrowmod varcix vlastins
577 set varcstart($view) {{}}
578 set vupptr($view) {0}
579 set vdownptr($view) {0}
580 set vleftptr($view) {0}
581 set vbackptr($view) {0}
582 set varctok($view) {{}}
583 set varcrow($view) {{}}
584 set vtokmod($view) {}
585 set varcmod($view) 0
586 set vrowmod($view) 0
587 set varcix($view) {{}}
588 set vlastins($view) {0}
591 proc resetvarcs {view} {
592 global varcid varccommits parents children vseedcount ordertok
594 foreach vid [array names varcid $view,*] {
595 unset varcid($vid)
596 unset children($vid)
597 unset parents($vid)
599 # some commits might have children but haven't been seen yet
600 foreach vid [array names children $view,*] {
601 unset children($vid)
603 foreach va [array names varccommits $view,*] {
604 unset varccommits($va)
606 foreach vd [array names vseedcount $view,*] {
607 unset vseedcount($vd)
609 catch {unset ordertok}
612 # returns a list of the commits with no children
613 proc seeds {v} {
614 global vdownptr vleftptr varcstart
616 set ret {}
617 set a [lindex $vdownptr($v) 0]
618 while {$a != 0} {
619 lappend ret [lindex $varcstart($v) $a]
620 set a [lindex $vleftptr($v) $a]
622 return $ret
625 proc newvarc {view id} {
626 global varcid varctok parents children vdatemode
627 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
628 global commitdata commitinfo vseedcount varccommits vlastins
630 set a [llength $varctok($view)]
631 set vid $view,$id
632 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
633 if {![info exists commitinfo($id)]} {
634 parsecommit $id $commitdata($id) 1
636 set cdate [lindex $commitinfo($id) 4]
637 if {![string is integer -strict $cdate]} {
638 set cdate 0
640 if {![info exists vseedcount($view,$cdate)]} {
641 set vseedcount($view,$cdate) -1
643 set c [incr vseedcount($view,$cdate)]
644 set cdate [expr {$cdate ^ 0xffffffff}]
645 set tok "s[strrep $cdate][strrep $c]"
646 } else {
647 set tok {}
649 set ka 0
650 if {[llength $children($vid)] > 0} {
651 set kid [lindex $children($vid) end]
652 set k $varcid($view,$kid)
653 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
654 set ki $kid
655 set ka $k
656 set tok [lindex $varctok($view) $k]
659 if {$ka != 0} {
660 set i [lsearch -exact $parents($view,$ki) $id]
661 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
662 append tok [strrep $j]
664 set c [lindex $vlastins($view) $ka]
665 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
666 set c $ka
667 set b [lindex $vdownptr($view) $ka]
668 } else {
669 set b [lindex $vleftptr($view) $c]
671 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
672 set c $b
673 set b [lindex $vleftptr($view) $c]
675 if {$c == $ka} {
676 lset vdownptr($view) $ka $a
677 lappend vbackptr($view) 0
678 } else {
679 lset vleftptr($view) $c $a
680 lappend vbackptr($view) $c
682 lset vlastins($view) $ka $a
683 lappend vupptr($view) $ka
684 lappend vleftptr($view) $b
685 if {$b != 0} {
686 lset vbackptr($view) $b $a
688 lappend varctok($view) $tok
689 lappend varcstart($view) $id
690 lappend vdownptr($view) 0
691 lappend varcrow($view) {}
692 lappend varcix($view) {}
693 set varccommits($view,$a) {}
694 lappend vlastins($view) 0
695 return $a
698 proc splitvarc {p v} {
699 global varcid varcstart varccommits varctok
700 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
702 set oa $varcid($v,$p)
703 set ac $varccommits($v,$oa)
704 set i [lsearch -exact $varccommits($v,$oa) $p]
705 if {$i <= 0} return
706 set na [llength $varctok($v)]
707 # "%" sorts before "0"...
708 set tok "[lindex $varctok($v) $oa]%[strrep $i]"
709 lappend varctok($v) $tok
710 lappend varcrow($v) {}
711 lappend varcix($v) {}
712 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
713 set varccommits($v,$na) [lrange $ac $i end]
714 lappend varcstart($v) $p
715 foreach id $varccommits($v,$na) {
716 set varcid($v,$id) $na
718 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
719 lappend vlastins($v) [lindex $vlastins($v) $oa]
720 lset vdownptr($v) $oa $na
721 lset vlastins($v) $oa 0
722 lappend vupptr($v) $oa
723 lappend vleftptr($v) 0
724 lappend vbackptr($v) 0
725 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
726 lset vupptr($v) $b $na
730 proc renumbervarc {a v} {
731 global parents children varctok varcstart varccommits
732 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
734 set t1 [clock clicks -milliseconds]
735 set todo {}
736 set isrelated($a) 1
737 set kidchanged($a) 1
738 set ntot 0
739 while {$a != 0} {
740 if {[info exists isrelated($a)]} {
741 lappend todo $a
742 set id [lindex $varccommits($v,$a) end]
743 foreach p $parents($v,$id) {
744 if {[info exists varcid($v,$p)]} {
745 set isrelated($varcid($v,$p)) 1
749 incr ntot
750 set b [lindex $vdownptr($v) $a]
751 if {$b == 0} {
752 while {$a != 0} {
753 set b [lindex $vleftptr($v) $a]
754 if {$b != 0} break
755 set a [lindex $vupptr($v) $a]
758 set a $b
760 foreach a $todo {
761 if {![info exists kidchanged($a)]} continue
762 set id [lindex $varcstart($v) $a]
763 if {[llength $children($v,$id)] > 1} {
764 set children($v,$id) [lsort -command [list vtokcmp $v] \
765 $children($v,$id)]
767 set oldtok [lindex $varctok($v) $a]
768 if {!$vdatemode($v)} {
769 set tok {}
770 } else {
771 set tok $oldtok
773 set ka 0
774 set kid [last_real_child $v,$id]
775 if {$kid ne {}} {
776 set k $varcid($v,$kid)
777 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
778 set ki $kid
779 set ka $k
780 set tok [lindex $varctok($v) $k]
783 if {$ka != 0} {
784 set i [lsearch -exact $parents($v,$ki) $id]
785 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
786 append tok [strrep $j]
788 if {$tok eq $oldtok} {
789 continue
791 set id [lindex $varccommits($v,$a) end]
792 foreach p $parents($v,$id) {
793 if {[info exists varcid($v,$p)]} {
794 set kidchanged($varcid($v,$p)) 1
795 } else {
796 set sortkids($p) 1
799 lset varctok($v) $a $tok
800 set b [lindex $vupptr($v) $a]
801 if {$b != $ka} {
802 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
803 modify_arc $v $ka
805 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
806 modify_arc $v $b
808 set c [lindex $vbackptr($v) $a]
809 set d [lindex $vleftptr($v) $a]
810 if {$c == 0} {
811 lset vdownptr($v) $b $d
812 } else {
813 lset vleftptr($v) $c $d
815 if {$d != 0} {
816 lset vbackptr($v) $d $c
818 if {[lindex $vlastins($v) $b] == $a} {
819 lset vlastins($v) $b $c
821 lset vupptr($v) $a $ka
822 set c [lindex $vlastins($v) $ka]
823 if {$c == 0 || \
824 [string compare $tok [lindex $varctok($v) $c]] < 0} {
825 set c $ka
826 set b [lindex $vdownptr($v) $ka]
827 } else {
828 set b [lindex $vleftptr($v) $c]
830 while {$b != 0 && \
831 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
832 set c $b
833 set b [lindex $vleftptr($v) $c]
835 if {$c == $ka} {
836 lset vdownptr($v) $ka $a
837 lset vbackptr($v) $a 0
838 } else {
839 lset vleftptr($v) $c $a
840 lset vbackptr($v) $a $c
842 lset vleftptr($v) $a $b
843 if {$b != 0} {
844 lset vbackptr($v) $b $a
846 lset vlastins($v) $ka $a
849 foreach id [array names sortkids] {
850 if {[llength $children($v,$id)] > 1} {
851 set children($v,$id) [lsort -command [list vtokcmp $v] \
852 $children($v,$id)]
855 set t2 [clock clicks -milliseconds]
856 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
859 # Fix up the graph after we have found out that in view $v,
860 # $p (a commit that we have already seen) is actually the parent
861 # of the last commit in arc $a.
862 proc fix_reversal {p a v} {
863 global varcid varcstart varctok vupptr
865 set pa $varcid($v,$p)
866 if {$p ne [lindex $varcstart($v) $pa]} {
867 splitvarc $p $v
868 set pa $varcid($v,$p)
870 # seeds always need to be renumbered
871 if {[lindex $vupptr($v) $pa] == 0 ||
872 [string compare [lindex $varctok($v) $a] \
873 [lindex $varctok($v) $pa]] > 0} {
874 renumbervarc $pa $v
878 proc insertrow {id p v} {
879 global cmitlisted children parents varcid varctok vtokmod
880 global varccommits ordertok commitidx numcommits curview
881 global targetid targetrow
883 readcommit $id
884 set vid $v,$id
885 set cmitlisted($vid) 1
886 set children($vid) {}
887 set parents($vid) [list $p]
888 set a [newvarc $v $id]
889 set varcid($vid) $a
890 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
891 modify_arc $v $a
893 lappend varccommits($v,$a) $id
894 set vp $v,$p
895 if {[llength [lappend children($vp) $id]] > 1} {
896 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
897 catch {unset ordertok}
899 fix_reversal $p $a $v
900 incr commitidx($v)
901 if {$v == $curview} {
902 set numcommits $commitidx($v)
903 setcanvscroll
904 if {[info exists targetid]} {
905 if {![comes_before $targetid $p]} {
906 incr targetrow
912 proc insertfakerow {id p} {
913 global varcid varccommits parents children cmitlisted
914 global commitidx varctok vtokmod targetid targetrow curview numcommits
916 set v $curview
917 set a $varcid($v,$p)
918 set i [lsearch -exact $varccommits($v,$a) $p]
919 if {$i < 0} {
920 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
921 return
923 set children($v,$id) {}
924 set parents($v,$id) [list $p]
925 set varcid($v,$id) $a
926 lappend children($v,$p) $id
927 set cmitlisted($v,$id) 1
928 set numcommits [incr commitidx($v)]
929 # note we deliberately don't update varcstart($v) even if $i == 0
930 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
931 modify_arc $v $a $i
932 if {[info exists targetid]} {
933 if {![comes_before $targetid $p]} {
934 incr targetrow
937 setcanvscroll
938 drawvisible
941 proc removefakerow {id} {
942 global varcid varccommits parents children commitidx
943 global varctok vtokmod cmitlisted currentid selectedline
944 global targetid curview numcommits
946 set v $curview
947 if {[llength $parents($v,$id)] != 1} {
948 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
949 return
951 set p [lindex $parents($v,$id) 0]
952 set a $varcid($v,$id)
953 set i [lsearch -exact $varccommits($v,$a) $id]
954 if {$i < 0} {
955 puts "oops: removefakerow can't find [shortids $id] on arc $a"
956 return
958 unset varcid($v,$id)
959 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
960 unset parents($v,$id)
961 unset children($v,$id)
962 unset cmitlisted($v,$id)
963 set numcommits [incr commitidx($v) -1]
964 set j [lsearch -exact $children($v,$p) $id]
965 if {$j >= 0} {
966 set children($v,$p) [lreplace $children($v,$p) $j $j]
968 modify_arc $v $a $i
969 if {[info exist currentid] && $id eq $currentid} {
970 unset currentid
971 set selectedline {}
973 if {[info exists targetid] && $targetid eq $id} {
974 set targetid $p
976 setcanvscroll
977 drawvisible
980 proc first_real_child {vp} {
981 global children nullid nullid2
983 foreach id $children($vp) {
984 if {$id ne $nullid && $id ne $nullid2} {
985 return $id
988 return {}
991 proc last_real_child {vp} {
992 global children nullid nullid2
994 set kids $children($vp)
995 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
996 set id [lindex $kids $i]
997 if {$id ne $nullid && $id ne $nullid2} {
998 return $id
1001 return {}
1004 proc vtokcmp {v a b} {
1005 global varctok varcid
1007 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1008 [lindex $varctok($v) $varcid($v,$b)]]
1011 # This assumes that if lim is not given, the caller has checked that
1012 # arc a's token is less than $vtokmod($v)
1013 proc modify_arc {v a {lim {}}} {
1014 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1016 if {$lim ne {}} {
1017 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1018 if {$c > 0} return
1019 if {$c == 0} {
1020 set r [lindex $varcrow($v) $a]
1021 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1024 set vtokmod($v) [lindex $varctok($v) $a]
1025 set varcmod($v) $a
1026 if {$v == $curview} {
1027 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1028 set a [lindex $vupptr($v) $a]
1029 set lim {}
1031 set r 0
1032 if {$a != 0} {
1033 if {$lim eq {}} {
1034 set lim [llength $varccommits($v,$a)]
1036 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1038 set vrowmod($v) $r
1039 undolayout $r
1043 proc update_arcrows {v} {
1044 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1045 global varcid vrownum varcorder varcix varccommits
1046 global vupptr vdownptr vleftptr varctok
1047 global displayorder parentlist curview cached_commitrow
1049 if {$vrowmod($v) == $commitidx($v)} return
1050 if {$v == $curview} {
1051 if {[llength $displayorder] > $vrowmod($v)} {
1052 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1053 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1055 catch {unset cached_commitrow}
1057 set narctot [expr {[llength $varctok($v)] - 1}]
1058 set a $varcmod($v)
1059 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1060 # go up the tree until we find something that has a row number,
1061 # or we get to a seed
1062 set a [lindex $vupptr($v) $a]
1064 if {$a == 0} {
1065 set a [lindex $vdownptr($v) 0]
1066 if {$a == 0} return
1067 set vrownum($v) {0}
1068 set varcorder($v) [list $a]
1069 lset varcix($v) $a 0
1070 lset varcrow($v) $a 0
1071 set arcn 0
1072 set row 0
1073 } else {
1074 set arcn [lindex $varcix($v) $a]
1075 if {[llength $vrownum($v)] > $arcn + 1} {
1076 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1077 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1079 set row [lindex $varcrow($v) $a]
1081 while {1} {
1082 set p $a
1083 incr row [llength $varccommits($v,$a)]
1084 # go down if possible
1085 set b [lindex $vdownptr($v) $a]
1086 if {$b == 0} {
1087 # if not, go left, or go up until we can go left
1088 while {$a != 0} {
1089 set b [lindex $vleftptr($v) $a]
1090 if {$b != 0} break
1091 set a [lindex $vupptr($v) $a]
1093 if {$a == 0} break
1095 set a $b
1096 incr arcn
1097 lappend vrownum($v) $row
1098 lappend varcorder($v) $a
1099 lset varcix($v) $a $arcn
1100 lset varcrow($v) $a $row
1102 set vtokmod($v) [lindex $varctok($v) $p]
1103 set varcmod($v) $p
1104 set vrowmod($v) $row
1105 if {[info exists currentid]} {
1106 set selectedline [rowofcommit $currentid]
1110 # Test whether view $v contains commit $id
1111 proc commitinview {id v} {
1112 global varcid
1114 return [info exists varcid($v,$id)]
1117 # Return the row number for commit $id in the current view
1118 proc rowofcommit {id} {
1119 global varcid varccommits varcrow curview cached_commitrow
1120 global varctok vtokmod
1122 set v $curview
1123 if {![info exists varcid($v,$id)]} {
1124 puts "oops rowofcommit no arc for [shortids $id]"
1125 return {}
1127 set a $varcid($v,$id)
1128 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1129 update_arcrows $v
1131 if {[info exists cached_commitrow($id)]} {
1132 return $cached_commitrow($id)
1134 set i [lsearch -exact $varccommits($v,$a) $id]
1135 if {$i < 0} {
1136 puts "oops didn't find commit [shortids $id] in arc $a"
1137 return {}
1139 incr i [lindex $varcrow($v) $a]
1140 set cached_commitrow($id) $i
1141 return $i
1144 # Returns 1 if a is on an earlier row than b, otherwise 0
1145 proc comes_before {a b} {
1146 global varcid varctok curview
1148 set v $curview
1149 if {$a eq $b || ![info exists varcid($v,$a)] || \
1150 ![info exists varcid($v,$b)]} {
1151 return 0
1153 if {$varcid($v,$a) != $varcid($v,$b)} {
1154 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1155 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1157 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1160 proc bsearch {l elt} {
1161 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1162 return 0
1164 set lo 0
1165 set hi [llength $l]
1166 while {$hi - $lo > 1} {
1167 set mid [expr {int(($lo + $hi) / 2)}]
1168 set t [lindex $l $mid]
1169 if {$elt < $t} {
1170 set hi $mid
1171 } elseif {$elt > $t} {
1172 set lo $mid
1173 } else {
1174 return $mid
1177 return $lo
1180 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1181 proc make_disporder {start end} {
1182 global vrownum curview commitidx displayorder parentlist
1183 global varccommits varcorder parents vrowmod varcrow
1184 global d_valid_start d_valid_end
1186 if {$end > $vrowmod($curview)} {
1187 update_arcrows $curview
1189 set ai [bsearch $vrownum($curview) $start]
1190 set start [lindex $vrownum($curview) $ai]
1191 set narc [llength $vrownum($curview)]
1192 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1193 set a [lindex $varcorder($curview) $ai]
1194 set l [llength $displayorder]
1195 set al [llength $varccommits($curview,$a)]
1196 if {$l < $r + $al} {
1197 if {$l < $r} {
1198 set pad [ntimes [expr {$r - $l}] {}]
1199 set displayorder [concat $displayorder $pad]
1200 set parentlist [concat $parentlist $pad]
1201 } elseif {$l > $r} {
1202 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1203 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1205 foreach id $varccommits($curview,$a) {
1206 lappend displayorder $id
1207 lappend parentlist $parents($curview,$id)
1209 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1210 set i $r
1211 foreach id $varccommits($curview,$a) {
1212 lset displayorder $i $id
1213 lset parentlist $i $parents($curview,$id)
1214 incr i
1217 incr r $al
1221 proc commitonrow {row} {
1222 global displayorder
1224 set id [lindex $displayorder $row]
1225 if {$id eq {}} {
1226 make_disporder $row [expr {$row + 1}]
1227 set id [lindex $displayorder $row]
1229 return $id
1232 proc closevarcs {v} {
1233 global varctok varccommits varcid parents children
1234 global cmitlisted commitidx vtokmod
1236 set missing_parents 0
1237 set scripts {}
1238 set narcs [llength $varctok($v)]
1239 for {set a 1} {$a < $narcs} {incr a} {
1240 set id [lindex $varccommits($v,$a) end]
1241 foreach p $parents($v,$id) {
1242 if {[info exists varcid($v,$p)]} continue
1243 # add p as a new commit
1244 incr missing_parents
1245 set cmitlisted($v,$p) 0
1246 set parents($v,$p) {}
1247 if {[llength $children($v,$p)] == 1 &&
1248 [llength $parents($v,$id)] == 1} {
1249 set b $a
1250 } else {
1251 set b [newvarc $v $p]
1253 set varcid($v,$p) $b
1254 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1255 modify_arc $v $b
1257 lappend varccommits($v,$b) $p
1258 incr commitidx($v)
1259 set scripts [check_interest $p $scripts]
1262 if {$missing_parents > 0} {
1263 foreach s $scripts {
1264 eval $s
1269 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1270 # Assumes we already have an arc for $rwid.
1271 proc rewrite_commit {v id rwid} {
1272 global children parents varcid varctok vtokmod varccommits
1274 foreach ch $children($v,$id) {
1275 # make $rwid be $ch's parent in place of $id
1276 set i [lsearch -exact $parents($v,$ch) $id]
1277 if {$i < 0} {
1278 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1280 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1281 # add $ch to $rwid's children and sort the list if necessary
1282 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1283 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1284 $children($v,$rwid)]
1286 # fix the graph after joining $id to $rwid
1287 set a $varcid($v,$ch)
1288 fix_reversal $rwid $a $v
1289 # parentlist is wrong for the last element of arc $a
1290 # even if displayorder is right, hence the 3rd arg here
1291 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1295 # Mechanism for registering a command to be executed when we come
1296 # across a particular commit. To handle the case when only the
1297 # prefix of the commit is known, the commitinterest array is now
1298 # indexed by the first 4 characters of the ID. Each element is a
1299 # list of id, cmd pairs.
1300 proc interestedin {id cmd} {
1301 global commitinterest
1303 lappend commitinterest([string range $id 0 3]) $id $cmd
1306 proc check_interest {id scripts} {
1307 global commitinterest
1309 set prefix [string range $id 0 3]
1310 if {[info exists commitinterest($prefix)]} {
1311 set newlist {}
1312 foreach {i script} $commitinterest($prefix) {
1313 if {[string match "$i*" $id]} {
1314 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1315 } else {
1316 lappend newlist $i $script
1319 if {$newlist ne {}} {
1320 set commitinterest($prefix) $newlist
1321 } else {
1322 unset commitinterest($prefix)
1325 return $scripts
1328 proc getcommitlines {fd inst view updating} {
1329 global cmitlisted leftover
1330 global commitidx commitdata vdatemode
1331 global parents children curview hlview
1332 global idpending ordertok
1333 global varccommits varcid varctok vtokmod vfilelimit
1335 set stuff [read $fd 500000]
1336 # git log doesn't terminate the last commit with a null...
1337 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1338 set stuff "\0"
1340 if {$stuff == {}} {
1341 if {![eof $fd]} {
1342 return 1
1344 global commfd viewcomplete viewactive viewname
1345 global viewinstances
1346 unset commfd($inst)
1347 set i [lsearch -exact $viewinstances($view) $inst]
1348 if {$i >= 0} {
1349 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1351 # set it blocking so we wait for the process to terminate
1352 fconfigure $fd -blocking 1
1353 if {[catch {close $fd} err]} {
1354 set fv {}
1355 if {$view != $curview} {
1356 set fv " for the \"$viewname($view)\" view"
1358 if {[string range $err 0 4] == "usage"} {
1359 set err "Gitk: error reading commits$fv:\
1360 bad arguments to git log."
1361 if {$viewname($view) eq "Command line"} {
1362 append err \
1363 " (Note: arguments to gitk are passed to git log\
1364 to allow selection of commits to be displayed.)"
1366 } else {
1367 set err "Error reading commits$fv: $err"
1369 error_popup $err
1371 if {[incr viewactive($view) -1] <= 0} {
1372 set viewcomplete($view) 1
1373 # Check if we have seen any ids listed as parents that haven't
1374 # appeared in the list
1375 closevarcs $view
1376 notbusy $view
1378 if {$view == $curview} {
1379 run chewcommits
1381 return 0
1383 set start 0
1384 set gotsome 0
1385 set scripts {}
1386 while 1 {
1387 set i [string first "\0" $stuff $start]
1388 if {$i < 0} {
1389 append leftover($inst) [string range $stuff $start end]
1390 break
1392 if {$start == 0} {
1393 set cmit $leftover($inst)
1394 append cmit [string range $stuff 0 [expr {$i - 1}]]
1395 set leftover($inst) {}
1396 } else {
1397 set cmit [string range $stuff $start [expr {$i - 1}]]
1399 set start [expr {$i + 1}]
1400 set j [string first "\n" $cmit]
1401 set ok 0
1402 set listed 1
1403 if {$j >= 0 && [string match "commit *" $cmit]} {
1404 set ids [string range $cmit 7 [expr {$j - 1}]]
1405 if {[string match {[-^<>]*} $ids]} {
1406 switch -- [string index $ids 0] {
1407 "-" {set listed 0}
1408 "^" {set listed 2}
1409 "<" {set listed 3}
1410 ">" {set listed 4}
1412 set ids [string range $ids 1 end]
1414 set ok 1
1415 foreach id $ids {
1416 if {[string length $id] != 40} {
1417 set ok 0
1418 break
1422 if {!$ok} {
1423 set shortcmit $cmit
1424 if {[string length $shortcmit] > 80} {
1425 set shortcmit "[string range $shortcmit 0 80]..."
1427 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1428 exit 1
1430 set id [lindex $ids 0]
1431 set vid $view,$id
1433 if {!$listed && $updating && ![info exists varcid($vid)] &&
1434 $vfilelimit($view) ne {}} {
1435 # git log doesn't rewrite parents for unlisted commits
1436 # when doing path limiting, so work around that here
1437 # by working out the rewritten parent with git rev-list
1438 # and if we already know about it, using the rewritten
1439 # parent as a substitute parent for $id's children.
1440 if {![catch {
1441 set rwid [exec git rev-list --first-parent --max-count=1 \
1442 $id -- $vfilelimit($view)]
1443 }]} {
1444 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1445 # use $rwid in place of $id
1446 rewrite_commit $view $id $rwid
1447 continue
1452 set a 0
1453 if {[info exists varcid($vid)]} {
1454 if {$cmitlisted($vid) || !$listed} continue
1455 set a $varcid($vid)
1457 if {$listed} {
1458 set olds [lrange $ids 1 end]
1459 } else {
1460 set olds {}
1462 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1463 set cmitlisted($vid) $listed
1464 set parents($vid) $olds
1465 if {![info exists children($vid)]} {
1466 set children($vid) {}
1467 } elseif {$a == 0 && [llength $children($vid)] == 1} {
1468 set k [lindex $children($vid) 0]
1469 if {[llength $parents($view,$k)] == 1 &&
1470 (!$vdatemode($view) ||
1471 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1472 set a $varcid($view,$k)
1475 if {$a == 0} {
1476 # new arc
1477 set a [newvarc $view $id]
1479 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1480 modify_arc $view $a
1482 if {![info exists varcid($vid)]} {
1483 set varcid($vid) $a
1484 lappend varccommits($view,$a) $id
1485 incr commitidx($view)
1488 set i 0
1489 foreach p $olds {
1490 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1491 set vp $view,$p
1492 if {[llength [lappend children($vp) $id]] > 1 &&
1493 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1494 set children($vp) [lsort -command [list vtokcmp $view] \
1495 $children($vp)]
1496 catch {unset ordertok}
1498 if {[info exists varcid($view,$p)]} {
1499 fix_reversal $p $a $view
1502 incr i
1505 set scripts [check_interest $id $scripts]
1506 set gotsome 1
1508 if {$gotsome} {
1509 global numcommits hlview
1511 if {$view == $curview} {
1512 set numcommits $commitidx($view)
1513 run chewcommits
1515 if {[info exists hlview] && $view == $hlview} {
1516 # we never actually get here...
1517 run vhighlightmore
1519 foreach s $scripts {
1520 eval $s
1523 return 2
1526 proc chewcommits {} {
1527 global curview hlview viewcomplete
1528 global pending_select
1530 layoutmore
1531 if {$viewcomplete($curview)} {
1532 global commitidx varctok
1533 global numcommits startmsecs
1535 if {[info exists pending_select]} {
1536 update
1537 reset_pending_select {}
1539 if {[commitinview $pending_select $curview]} {
1540 selectline [rowofcommit $pending_select] 1
1541 } else {
1542 set row [first_real_row]
1543 selectline $row 1
1546 if {$commitidx($curview) > 0} {
1547 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1548 #puts "overall $ms ms for $numcommits commits"
1549 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1550 } else {
1551 show_status [mc "No commits selected"]
1553 notbusy layout
1555 return 0
1558 proc do_readcommit {id} {
1559 global tclencoding
1561 # Invoke git-log to handle automatic encoding conversion
1562 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1563 # Read the results using i18n.logoutputencoding
1564 fconfigure $fd -translation lf -eofchar {}
1565 if {$tclencoding != {}} {
1566 fconfigure $fd -encoding $tclencoding
1568 set contents [read $fd]
1569 close $fd
1570 # Remove the heading line
1571 regsub {^commit [0-9a-f]+\n} $contents {} contents
1573 return $contents
1576 proc readcommit {id} {
1577 if {[catch {set contents [do_readcommit $id]}]} return
1578 parsecommit $id $contents 1
1581 proc parsecommit {id contents listed} {
1582 global commitinfo cdate
1584 set inhdr 1
1585 set comment {}
1586 set headline {}
1587 set auname {}
1588 set audate {}
1589 set comname {}
1590 set comdate {}
1591 set hdrend [string first "\n\n" $contents]
1592 if {$hdrend < 0} {
1593 # should never happen...
1594 set hdrend [string length $contents]
1596 set header [string range $contents 0 [expr {$hdrend - 1}]]
1597 set comment [string range $contents [expr {$hdrend + 2}] end]
1598 foreach line [split $header "\n"] {
1599 set tag [lindex $line 0]
1600 if {$tag == "author"} {
1601 set audate [lindex $line end-1]
1602 set auname [lrange $line 1 end-2]
1603 } elseif {$tag == "committer"} {
1604 set comdate [lindex $line end-1]
1605 set comname [lrange $line 1 end-2]
1608 set headline {}
1609 # take the first non-blank line of the comment as the headline
1610 set headline [string trimleft $comment]
1611 set i [string first "\n" $headline]
1612 if {$i >= 0} {
1613 set headline [string range $headline 0 $i]
1615 set headline [string trimright $headline]
1616 set i [string first "\r" $headline]
1617 if {$i >= 0} {
1618 set headline [string trimright [string range $headline 0 $i]]
1620 if {!$listed} {
1621 # git log indents the comment by 4 spaces;
1622 # if we got this via git cat-file, add the indentation
1623 set newcomment {}
1624 foreach line [split $comment "\n"] {
1625 append newcomment " "
1626 append newcomment $line
1627 append newcomment "\n"
1629 set comment $newcomment
1631 if {$comdate != {}} {
1632 set cdate($id) $comdate
1634 set commitinfo($id) [list $headline $auname $audate \
1635 $comname $comdate $comment]
1638 proc getcommit {id} {
1639 global commitdata commitinfo
1641 if {[info exists commitdata($id)]} {
1642 parsecommit $id $commitdata($id) 1
1643 } else {
1644 readcommit $id
1645 if {![info exists commitinfo($id)]} {
1646 set commitinfo($id) [list [mc "No commit information available"]]
1649 return 1
1652 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1653 # and are present in the current view.
1654 # This is fairly slow...
1655 proc longid {prefix} {
1656 global varcid curview
1658 set ids {}
1659 foreach match [array names varcid "$curview,$prefix*"] {
1660 lappend ids [lindex [split $match ","] 1]
1662 return $ids
1665 proc readrefs {} {
1666 global tagids idtags headids idheads tagobjid
1667 global otherrefids idotherrefs mainhead mainheadid
1668 global selecthead selectheadid
1670 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1671 catch {unset $v}
1673 set refd [open [list | git show-ref -d] r]
1674 while {[gets $refd line] >= 0} {
1675 if {[string index $line 40] ne " "} continue
1676 set id [string range $line 0 39]
1677 set ref [string range $line 41 end]
1678 if {![string match "refs/*" $ref]} continue
1679 set name [string range $ref 5 end]
1680 if {[string match "remotes/*" $name]} {
1681 if {![string match "*/HEAD" $name]} {
1682 set headids($name) $id
1683 lappend idheads($id) $name
1685 } elseif {[string match "heads/*" $name]} {
1686 set name [string range $name 6 end]
1687 set headids($name) $id
1688 lappend idheads($id) $name
1689 } elseif {[string match "tags/*" $name]} {
1690 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1691 # which is what we want since the former is the commit ID
1692 set name [string range $name 5 end]
1693 if {[string match "*^{}" $name]} {
1694 set name [string range $name 0 end-3]
1695 } else {
1696 set tagobjid($name) $id
1698 set tagids($name) $id
1699 lappend idtags($id) $name
1700 } else {
1701 set otherrefids($name) $id
1702 lappend idotherrefs($id) $name
1705 catch {close $refd}
1706 set mainhead {}
1707 set mainheadid {}
1708 catch {
1709 set mainheadid [exec git rev-parse HEAD]
1710 set thehead [exec git symbolic-ref HEAD]
1711 if {[string match "refs/heads/*" $thehead]} {
1712 set mainhead [string range $thehead 11 end]
1715 set selectheadid {}
1716 if {$selecthead ne {}} {
1717 catch {
1718 set selectheadid [exec git rev-parse --verify $selecthead]
1723 # skip over fake commits
1724 proc first_real_row {} {
1725 global nullid nullid2 numcommits
1727 for {set row 0} {$row < $numcommits} {incr row} {
1728 set id [commitonrow $row]
1729 if {$id ne $nullid && $id ne $nullid2} {
1730 break
1733 return $row
1736 # update things for a head moved to a child of its previous location
1737 proc movehead {id name} {
1738 global headids idheads
1740 removehead $headids($name) $name
1741 set headids($name) $id
1742 lappend idheads($id) $name
1745 # update things when a head has been removed
1746 proc removehead {id name} {
1747 global headids idheads
1749 if {$idheads($id) eq $name} {
1750 unset idheads($id)
1751 } else {
1752 set i [lsearch -exact $idheads($id) $name]
1753 if {$i >= 0} {
1754 set idheads($id) [lreplace $idheads($id) $i $i]
1757 unset headids($name)
1760 proc make_transient {window origin} {
1761 global have_tk85
1763 # In MacOS Tk 8.4 transient appears to work by setting
1764 # overrideredirect, which is utterly useless, since the
1765 # windows get no border, and are not even kept above
1766 # the parent.
1767 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1769 wm transient $window $origin
1771 # Windows fails to place transient windows normally, so
1772 # schedule a callback to center them on the parent.
1773 if {[tk windowingsystem] eq {win32}} {
1774 after idle [list tk::PlaceWindow $window widget $origin]
1778 proc show_error {w top msg} {
1779 message $w.m -text $msg -justify center -aspect 400
1780 pack $w.m -side top -fill x -padx 20 -pady 20
1781 button $w.ok -text [mc OK] -command "destroy $top"
1782 pack $w.ok -side bottom -fill x
1783 bind $top <Visibility> "grab $top; focus $top"
1784 bind $top <Key-Return> "destroy $top"
1785 bind $top <Key-space> "destroy $top"
1786 bind $top <Key-Escape> "destroy $top"
1787 tkwait window $top
1790 proc error_popup {msg {owner .}} {
1791 set w .error
1792 toplevel $w
1793 make_transient $w $owner
1794 show_error $w $w $msg
1797 proc confirm_popup {msg {owner .}} {
1798 global confirm_ok
1799 set confirm_ok 0
1800 set w .confirm
1801 toplevel $w
1802 make_transient $w $owner
1803 message $w.m -text $msg -justify center -aspect 400
1804 pack $w.m -side top -fill x -padx 20 -pady 20
1805 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1806 pack $w.ok -side left -fill x
1807 button $w.cancel -text [mc Cancel] -command "destroy $w"
1808 pack $w.cancel -side right -fill x
1809 bind $w <Visibility> "grab $w; focus $w"
1810 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1811 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1812 bind $w <Key-Escape> "destroy $w"
1813 tkwait window $w
1814 return $confirm_ok
1817 proc setoptions {} {
1818 option add *Panedwindow.showHandle 1 startupFile
1819 option add *Panedwindow.sashRelief raised startupFile
1820 option add *Button.font uifont startupFile
1821 option add *Checkbutton.font uifont startupFile
1822 option add *Radiobutton.font uifont startupFile
1823 option add *Menu.font uifont startupFile
1824 option add *Menubutton.font uifont startupFile
1825 option add *Label.font uifont startupFile
1826 option add *Message.font uifont startupFile
1827 option add *Entry.font uifont startupFile
1830 # Make a menu and submenus.
1831 # m is the window name for the menu, items is the list of menu items to add.
1832 # Each item is a list {mc label type description options...}
1833 # mc is ignored; it's so we can put mc there to alert xgettext
1834 # label is the string that appears in the menu
1835 # type is cascade, command or radiobutton (should add checkbutton)
1836 # description depends on type; it's the sublist for cascade, the
1837 # command to invoke for command, or {variable value} for radiobutton
1838 proc makemenu {m items} {
1839 menu $m
1840 if {[tk windowingsystem] eq {aqua}} {
1841 set Meta1 Cmd
1842 } else {
1843 set Meta1 Ctrl
1845 foreach i $items {
1846 set name [mc [lindex $i 1]]
1847 set type [lindex $i 2]
1848 set thing [lindex $i 3]
1849 set params [list $type]
1850 if {$name ne {}} {
1851 set u [string first "&" [string map {&& x} $name]]
1852 lappend params -label [string map {&& & & {}} $name]
1853 if {$u >= 0} {
1854 lappend params -underline $u
1857 switch -- $type {
1858 "cascade" {
1859 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1860 lappend params -menu $m.$submenu
1862 "command" {
1863 lappend params -command $thing
1865 "radiobutton" {
1866 lappend params -variable [lindex $thing 0] \
1867 -value [lindex $thing 1]
1870 set tail [lrange $i 4 end]
1871 regsub -all {\yMeta1\y} $tail $Meta1 tail
1872 eval $m add $params $tail
1873 if {$type eq "cascade"} {
1874 makemenu $m.$submenu $thing
1879 # translate string and remove ampersands
1880 proc mca {str} {
1881 return [string map {&& & & {}} [mc $str]]
1884 proc makewindow {} {
1885 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1886 global tabstop
1887 global findtype findtypemenu findloc findstring fstring geometry
1888 global entries sha1entry sha1string sha1but
1889 global diffcontextstring diffcontext
1890 global ignorespace
1891 global maincursor textcursor curtextcursor
1892 global rowctxmenu fakerowmenu mergemax wrapcomment
1893 global highlight_files gdttype
1894 global searchstring sstring
1895 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1896 global headctxmenu progresscanv progressitem progresscoords statusw
1897 global fprogitem fprogcoord lastprogupdate progupdatepending
1898 global rprogitem rprogcoord rownumsel numcommits
1899 global have_tk85
1901 # The "mc" arguments here are purely so that xgettext
1902 # sees the following string as needing to be translated
1903 makemenu .bar {
1904 {mc "File" cascade {
1905 {mc "Update" command updatecommits -accelerator F5}
1906 {mc "Reload" command reloadcommits -accelerator Meta1-F5}
1907 {mc "Reread references" command rereadrefs}
1908 {mc "List references" command showrefs -accelerator F2}
1909 {mc "Quit" command doquit -accelerator Meta1-Q}
1911 {mc "Edit" cascade {
1912 {mc "Preferences" command doprefs}
1914 {mc "View" cascade {
1915 {mc "New view..." command {newview 0} -accelerator Shift-F4}
1916 {mc "Edit view..." command editview -state disabled -accelerator F4}
1917 {mc "Delete view" command delview -state disabled}
1918 {xx "" separator}
1919 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
1921 {mc "Help" cascade {
1922 {mc "About gitk" command about}
1923 {mc "Key bindings" command keys}
1926 . configure -menu .bar
1928 # the gui has upper and lower half, parts of a paned window.
1929 panedwindow .ctop -orient vertical
1931 # possibly use assumed geometry
1932 if {![info exists geometry(pwsash0)]} {
1933 set geometry(topheight) [expr {15 * $linespc}]
1934 set geometry(topwidth) [expr {80 * $charspc}]
1935 set geometry(botheight) [expr {15 * $linespc}]
1936 set geometry(botwidth) [expr {50 * $charspc}]
1937 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1938 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1941 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1942 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1943 frame .tf.histframe
1944 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1946 # create three canvases
1947 set cscroll .tf.histframe.csb
1948 set canv .tf.histframe.pwclist.canv
1949 canvas $canv \
1950 -selectbackground $selectbgcolor \
1951 -background $bgcolor -bd 0 \
1952 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1953 .tf.histframe.pwclist add $canv
1954 set canv2 .tf.histframe.pwclist.canv2
1955 canvas $canv2 \
1956 -selectbackground $selectbgcolor \
1957 -background $bgcolor -bd 0 -yscrollincr $linespc
1958 .tf.histframe.pwclist add $canv2
1959 set canv3 .tf.histframe.pwclist.canv3
1960 canvas $canv3 \
1961 -selectbackground $selectbgcolor \
1962 -background $bgcolor -bd 0 -yscrollincr $linespc
1963 .tf.histframe.pwclist add $canv3
1964 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1965 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1967 # a scroll bar to rule them
1968 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1969 pack $cscroll -side right -fill y
1970 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1971 lappend bglist $canv $canv2 $canv3
1972 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1974 # we have two button bars at bottom of top frame. Bar 1
1975 frame .tf.bar
1976 frame .tf.lbar -height 15
1978 set sha1entry .tf.bar.sha1
1979 set entries $sha1entry
1980 set sha1but .tf.bar.sha1label
1981 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1982 -command gotocommit -width 8
1983 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1984 pack .tf.bar.sha1label -side left
1985 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1986 trace add variable sha1string write sha1change
1987 pack $sha1entry -side left -pady 2
1989 image create bitmap bm-left -data {
1990 #define left_width 16
1991 #define left_height 16
1992 static unsigned char left_bits[] = {
1993 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1994 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1995 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1997 image create bitmap bm-right -data {
1998 #define right_width 16
1999 #define right_height 16
2000 static unsigned char right_bits[] = {
2001 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2002 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2003 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2005 button .tf.bar.leftbut -image bm-left -command goback \
2006 -state disabled -width 26
2007 pack .tf.bar.leftbut -side left -fill y
2008 button .tf.bar.rightbut -image bm-right -command goforw \
2009 -state disabled -width 26
2010 pack .tf.bar.rightbut -side left -fill y
2012 label .tf.bar.rowlabel -text [mc "Row"]
2013 set rownumsel {}
2014 label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
2015 -relief sunken -anchor e
2016 label .tf.bar.rowlabel2 -text "/"
2017 label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
2018 -relief sunken -anchor e
2019 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2020 -side left
2021 global selectedline
2022 trace add variable selectedline write selectedline_change
2024 # Status label and progress bar
2025 set statusw .tf.bar.status
2026 label $statusw -width 15 -relief sunken
2027 pack $statusw -side left -padx 5
2028 set h [expr {[font metrics uifont -linespace] + 2}]
2029 set progresscanv .tf.bar.progress
2030 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2031 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2032 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2033 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2034 pack $progresscanv -side right -expand 1 -fill x
2035 set progresscoords {0 0}
2036 set fprogcoord 0
2037 set rprogcoord 0
2038 bind $progresscanv <Configure> adjustprogress
2039 set lastprogupdate [clock clicks -milliseconds]
2040 set progupdatepending 0
2042 # build up the bottom bar of upper window
2043 label .tf.lbar.flabel -text "[mc "Find"] "
2044 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2045 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2046 label .tf.lbar.flab2 -text " [mc "commit"] "
2047 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2048 -side left -fill y
2049 set gdttype [mc "containing:"]
2050 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
2051 [mc "containing:"] \
2052 [mc "touching paths:"] \
2053 [mc "adding/removing string:"]]
2054 trace add variable gdttype write gdttype_change
2055 pack .tf.lbar.gdttype -side left -fill y
2057 set findstring {}
2058 set fstring .tf.lbar.findstring
2059 lappend entries $fstring
2060 entry $fstring -width 30 -font textfont -textvariable findstring
2061 trace add variable findstring write find_change
2062 set findtype [mc "Exact"]
2063 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
2064 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2065 trace add variable findtype write findcom_change
2066 set findloc [mc "All fields"]
2067 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2068 [mc "Comments"] [mc "Author"] [mc "Committer"]
2069 trace add variable findloc write find_change
2070 pack .tf.lbar.findloc -side right
2071 pack .tf.lbar.findtype -side right
2072 pack $fstring -side left -expand 1 -fill x
2074 # Finish putting the upper half of the viewer together
2075 pack .tf.lbar -in .tf -side bottom -fill x
2076 pack .tf.bar -in .tf -side bottom -fill x
2077 pack .tf.histframe -fill both -side top -expand 1
2078 .ctop add .tf
2079 .ctop paneconfigure .tf -height $geometry(topheight)
2080 .ctop paneconfigure .tf -width $geometry(topwidth)
2082 # now build up the bottom
2083 panedwindow .pwbottom -orient horizontal
2085 # lower left, a text box over search bar, scroll bar to the right
2086 # if we know window height, then that will set the lower text height, otherwise
2087 # we set lower text height which will drive window height
2088 if {[info exists geometry(main)]} {
2089 frame .bleft -width $geometry(botwidth)
2090 } else {
2091 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2093 frame .bleft.top
2094 frame .bleft.mid
2095 frame .bleft.bottom
2097 button .bleft.top.search -text [mc "Search"] -command dosearch
2098 pack .bleft.top.search -side left -padx 5
2099 set sstring .bleft.top.sstring
2100 entry $sstring -width 20 -font textfont -textvariable searchstring
2101 lappend entries $sstring
2102 trace add variable searchstring write incrsearch
2103 pack $sstring -side left -expand 1 -fill x
2104 radiobutton .bleft.mid.diff -text [mc "Diff"] \
2105 -command changediffdisp -variable diffelide -value {0 0}
2106 radiobutton .bleft.mid.old -text [mc "Old version"] \
2107 -command changediffdisp -variable diffelide -value {0 1}
2108 radiobutton .bleft.mid.new -text [mc "New version"] \
2109 -command changediffdisp -variable diffelide -value {1 0}
2110 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
2111 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2112 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
2113 -from 1 -increment 1 -to 10000000 \
2114 -validate all -validatecommand "diffcontextvalidate %P" \
2115 -textvariable diffcontextstring
2116 .bleft.mid.diffcontext set $diffcontext
2117 trace add variable diffcontextstring write diffcontextchange
2118 lappend entries .bleft.mid.diffcontext
2119 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2120 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2121 -command changeignorespace -variable ignorespace
2122 pack .bleft.mid.ignspace -side left -padx 5
2123 set ctext .bleft.bottom.ctext
2124 text $ctext -background $bgcolor -foreground $fgcolor \
2125 -state disabled -font textfont \
2126 -yscrollcommand scrolltext -wrap none \
2127 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2128 if {$have_tk85} {
2129 $ctext conf -tabstyle wordprocessor
2131 scrollbar .bleft.bottom.sb -command "$ctext yview"
2132 scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
2133 -width 10
2134 pack .bleft.top -side top -fill x
2135 pack .bleft.mid -side top -fill x
2136 grid $ctext .bleft.bottom.sb -sticky nsew
2137 grid .bleft.bottom.sbhorizontal -sticky ew
2138 grid columnconfigure .bleft.bottom 0 -weight 1
2139 grid rowconfigure .bleft.bottom 0 -weight 1
2140 grid rowconfigure .bleft.bottom 1 -weight 0
2141 pack .bleft.bottom -side top -fill both -expand 1
2142 lappend bglist $ctext
2143 lappend fglist $ctext
2145 $ctext tag conf comment -wrap $wrapcomment
2146 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2147 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2148 $ctext tag conf d0 -fore [lindex $diffcolors 0]
2149 $ctext tag conf dresult -fore [lindex $diffcolors 1]
2150 $ctext tag conf m0 -fore red
2151 $ctext tag conf m1 -fore blue
2152 $ctext tag conf m2 -fore green
2153 $ctext tag conf m3 -fore purple
2154 $ctext tag conf m4 -fore brown
2155 $ctext tag conf m5 -fore "#009090"
2156 $ctext tag conf m6 -fore magenta
2157 $ctext tag conf m7 -fore "#808000"
2158 $ctext tag conf m8 -fore "#009000"
2159 $ctext tag conf m9 -fore "#ff0080"
2160 $ctext tag conf m10 -fore cyan
2161 $ctext tag conf m11 -fore "#b07070"
2162 $ctext tag conf m12 -fore "#70b0f0"
2163 $ctext tag conf m13 -fore "#70f0b0"
2164 $ctext tag conf m14 -fore "#f0b070"
2165 $ctext tag conf m15 -fore "#ff70b0"
2166 $ctext tag conf mmax -fore darkgrey
2167 set mergemax 16
2168 $ctext tag conf mresult -font textfontbold
2169 $ctext tag conf msep -font textfontbold
2170 $ctext tag conf found -back yellow
2172 .pwbottom add .bleft
2173 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2175 # lower right
2176 frame .bright
2177 frame .bright.mode
2178 radiobutton .bright.mode.patch -text [mc "Patch"] \
2179 -command reselectline -variable cmitmode -value "patch"
2180 radiobutton .bright.mode.tree -text [mc "Tree"] \
2181 -command reselectline -variable cmitmode -value "tree"
2182 grid .bright.mode.patch .bright.mode.tree -sticky ew
2183 pack .bright.mode -side top -fill x
2184 set cflist .bright.cfiles
2185 set indent [font measure mainfont "nn"]
2186 text $cflist \
2187 -selectbackground $selectbgcolor \
2188 -background $bgcolor -foreground $fgcolor \
2189 -font mainfont \
2190 -tabs [list $indent [expr {2 * $indent}]] \
2191 -yscrollcommand ".bright.sb set" \
2192 -cursor [. cget -cursor] \
2193 -spacing1 1 -spacing3 1
2194 lappend bglist $cflist
2195 lappend fglist $cflist
2196 scrollbar .bright.sb -command "$cflist yview"
2197 pack .bright.sb -side right -fill y
2198 pack $cflist -side left -fill both -expand 1
2199 $cflist tag configure highlight \
2200 -background [$cflist cget -selectbackground]
2201 $cflist tag configure bold -font mainfontbold
2203 .pwbottom add .bright
2204 .ctop add .pwbottom
2206 # restore window width & height if known
2207 if {[info exists geometry(main)]} {
2208 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2209 if {$w > [winfo screenwidth .]} {
2210 set w [winfo screenwidth .]
2212 if {$h > [winfo screenheight .]} {
2213 set h [winfo screenheight .]
2215 wm geometry . "${w}x$h"
2219 if {[tk windowingsystem] eq {aqua}} {
2220 set M1B M1
2221 } else {
2222 set M1B Control
2225 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2226 pack .ctop -fill both -expand 1
2227 bindall <1> {selcanvline %W %x %y}
2228 #bindall <B1-Motion> {selcanvline %W %x %y}
2229 if {[tk windowingsystem] == "win32"} {
2230 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2231 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2232 } else {
2233 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2234 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2235 if {[tk windowingsystem] eq "aqua"} {
2236 bindall <MouseWheel> {
2237 set delta [expr {- (%D)}]
2238 allcanvs yview scroll $delta units
2242 bindall <2> "canvscan mark %W %x %y"
2243 bindall <B2-Motion> "canvscan dragto %W %x %y"
2244 bindkey <Home> selfirstline
2245 bindkey <End> sellastline
2246 bind . <Key-Up> "selnextline -1"
2247 bind . <Key-Down> "selnextline 1"
2248 bind . <Shift-Key-Up> "dofind -1 0"
2249 bind . <Shift-Key-Down> "dofind 1 0"
2250 bindkey <Key-Right> "goforw"
2251 bindkey <Key-Left> "goback"
2252 bind . <Key-Prior> "selnextpage -1"
2253 bind . <Key-Next> "selnextpage 1"
2254 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2255 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2256 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2257 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2258 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2259 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2260 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2261 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2262 bindkey <Key-space> "$ctext yview scroll 1 pages"
2263 bindkey p "selnextline -1"
2264 bindkey n "selnextline 1"
2265 bindkey z "goback"
2266 bindkey x "goforw"
2267 bindkey i "selnextline -1"
2268 bindkey k "selnextline 1"
2269 bindkey j "goback"
2270 bindkey l "goforw"
2271 bindkey b prevfile
2272 bindkey d "$ctext yview scroll 18 units"
2273 bindkey u "$ctext yview scroll -18 units"
2274 bindkey / {dofind 1 1}
2275 bindkey <Key-Return> {dofind 1 1}
2276 bindkey ? {dofind -1 1}
2277 bindkey f nextfile
2278 bind . <F5> updatecommits
2279 bind . <$M1B-F5> reloadcommits
2280 bind . <F2> showrefs
2281 bind . <Shift-F4> {newview 0}
2282 catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
2283 bind . <F4> edit_or_newview
2284 bind . <$M1B-q> doquit
2285 bind . <$M1B-f> {dofind 1 1}
2286 bind . <$M1B-g> {dofind 1 0}
2287 bind . <$M1B-r> dosearchback
2288 bind . <$M1B-s> dosearch
2289 bind . <$M1B-equal> {incrfont 1}
2290 bind . <$M1B-plus> {incrfont 1}
2291 bind . <$M1B-KP_Add> {incrfont 1}
2292 bind . <$M1B-minus> {incrfont -1}
2293 bind . <$M1B-KP_Subtract> {incrfont -1}
2294 wm protocol . WM_DELETE_WINDOW doquit
2295 bind . <Destroy> {stop_backends}
2296 bind . <Button-1> "click %W"
2297 bind $fstring <Key-Return> {dofind 1 1}
2298 bind $sha1entry <Key-Return> {gotocommit; break}
2299 bind $sha1entry <<PasteSelection>> clearsha1
2300 bind $cflist <1> {sel_flist %W %x %y; break}
2301 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2302 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2303 global ctxbut
2304 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2305 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2307 set maincursor [. cget -cursor]
2308 set textcursor [$ctext cget -cursor]
2309 set curtextcursor $textcursor
2311 set rowctxmenu .rowctxmenu
2312 makemenu $rowctxmenu {
2313 {mc "Diff this -> selected" command {diffvssel 0}}
2314 {mc "Diff selected -> this" command {diffvssel 1}}
2315 {mc "Make patch" command mkpatch}
2316 {mc "Create tag" command mktag}
2317 {mc "Write commit to file" command writecommit}
2318 {mc "Create new branch" command mkbranch}
2319 {mc "Cherry-pick this commit" command cherrypick}
2320 {mc "Reset HEAD branch to here" command resethead}
2322 $rowctxmenu configure -tearoff 0
2324 set fakerowmenu .fakerowmenu
2325 makemenu $fakerowmenu {
2326 {mc "Diff this -> selected" command {diffvssel 0}}
2327 {mc "Diff selected -> this" command {diffvssel 1}}
2328 {mc "Make patch" command mkpatch}
2330 $fakerowmenu configure -tearoff 0
2332 set headctxmenu .headctxmenu
2333 makemenu $headctxmenu {
2334 {mc "Check out this branch" command cobranch}
2335 {mc "Remove this branch" command rmbranch}
2337 $headctxmenu configure -tearoff 0
2339 global flist_menu
2340 set flist_menu .flistctxmenu
2341 makemenu $flist_menu {
2342 {mc "Highlight this too" command {flist_hl 0}}
2343 {mc "Highlight this only" command {flist_hl 1}}
2344 {mc "External diff" command {external_diff}}
2345 {mc "Blame parent commit" command {external_blame 1}}
2347 $flist_menu configure -tearoff 0
2349 global diff_menu
2350 set diff_menu .diffctxmenu
2351 makemenu $diff_menu {
2352 {mc "Show origin of this line" command show_line_source}
2353 {mc "Run git gui blame on this line" command {external_blame_diff}}
2355 $diff_menu configure -tearoff 0
2358 # Windows sends all mouse wheel events to the current focused window, not
2359 # the one where the mouse hovers, so bind those events here and redirect
2360 # to the correct window
2361 proc windows_mousewheel_redirector {W X Y D} {
2362 global canv canv2 canv3
2363 set w [winfo containing -displayof $W $X $Y]
2364 if {$w ne ""} {
2365 set u [expr {$D < 0 ? 5 : -5}]
2366 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2367 allcanvs yview scroll $u units
2368 } else {
2369 catch {
2370 $w yview scroll $u units
2376 # Update row number label when selectedline changes
2377 proc selectedline_change {n1 n2 op} {
2378 global selectedline rownumsel
2380 if {$selectedline eq {}} {
2381 set rownumsel {}
2382 } else {
2383 set rownumsel [expr {$selectedline + 1}]
2387 # mouse-2 makes all windows scan vertically, but only the one
2388 # the cursor is in scans horizontally
2389 proc canvscan {op w x y} {
2390 global canv canv2 canv3
2391 foreach c [list $canv $canv2 $canv3] {
2392 if {$c == $w} {
2393 $c scan $op $x $y
2394 } else {
2395 $c scan $op 0 $y
2400 proc scrollcanv {cscroll f0 f1} {
2401 $cscroll set $f0 $f1
2402 drawvisible
2403 flushhighlights
2406 # when we make a key binding for the toplevel, make sure
2407 # it doesn't get triggered when that key is pressed in the
2408 # find string entry widget.
2409 proc bindkey {ev script} {
2410 global entries
2411 bind . $ev $script
2412 set escript [bind Entry $ev]
2413 if {$escript == {}} {
2414 set escript [bind Entry <Key>]
2416 foreach e $entries {
2417 bind $e $ev "$escript; break"
2421 # set the focus back to the toplevel for any click outside
2422 # the entry widgets
2423 proc click {w} {
2424 global ctext entries
2425 foreach e [concat $entries $ctext] {
2426 if {$w == $e} return
2428 focus .
2431 # Adjust the progress bar for a change in requested extent or canvas size
2432 proc adjustprogress {} {
2433 global progresscanv progressitem progresscoords
2434 global fprogitem fprogcoord lastprogupdate progupdatepending
2435 global rprogitem rprogcoord
2437 set w [expr {[winfo width $progresscanv] - 4}]
2438 set x0 [expr {$w * [lindex $progresscoords 0]}]
2439 set x1 [expr {$w * [lindex $progresscoords 1]}]
2440 set h [winfo height $progresscanv]
2441 $progresscanv coords $progressitem $x0 0 $x1 $h
2442 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2443 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2444 set now [clock clicks -milliseconds]
2445 if {$now >= $lastprogupdate + 100} {
2446 set progupdatepending 0
2447 update
2448 } elseif {!$progupdatepending} {
2449 set progupdatepending 1
2450 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2454 proc doprogupdate {} {
2455 global lastprogupdate progupdatepending
2457 if {$progupdatepending} {
2458 set progupdatepending 0
2459 set lastprogupdate [clock clicks -milliseconds]
2460 update
2464 proc savestuff {w} {
2465 global canv canv2 canv3 mainfont textfont uifont tabstop
2466 global stuffsaved findmergefiles maxgraphpct
2467 global maxwidth showneartags showlocalchanges
2468 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2469 global cmitmode wrapcomment datetimeformat limitdiffs
2470 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2471 global autoselect extdifftool perfile_attrs markbgcolor
2473 if {$stuffsaved} return
2474 if {![winfo viewable .]} return
2475 catch {
2476 set f [open "~/.gitk-new" w]
2477 puts $f [list set mainfont $mainfont]
2478 puts $f [list set textfont $textfont]
2479 puts $f [list set uifont $uifont]
2480 puts $f [list set tabstop $tabstop]
2481 puts $f [list set findmergefiles $findmergefiles]
2482 puts $f [list set maxgraphpct $maxgraphpct]
2483 puts $f [list set maxwidth $maxwidth]
2484 puts $f [list set cmitmode $cmitmode]
2485 puts $f [list set wrapcomment $wrapcomment]
2486 puts $f [list set autoselect $autoselect]
2487 puts $f [list set showneartags $showneartags]
2488 puts $f [list set showlocalchanges $showlocalchanges]
2489 puts $f [list set datetimeformat $datetimeformat]
2490 puts $f [list set limitdiffs $limitdiffs]
2491 puts $f [list set bgcolor $bgcolor]
2492 puts $f [list set fgcolor $fgcolor]
2493 puts $f [list set colors $colors]
2494 puts $f [list set diffcolors $diffcolors]
2495 puts $f [list set markbgcolor $markbgcolor]
2496 puts $f [list set diffcontext $diffcontext]
2497 puts $f [list set selectbgcolor $selectbgcolor]
2498 puts $f [list set extdifftool $extdifftool]
2499 puts $f [list set perfile_attrs $perfile_attrs]
2501 puts $f "set geometry(main) [wm geometry .]"
2502 puts $f "set geometry(topwidth) [winfo width .tf]"
2503 puts $f "set geometry(topheight) [winfo height .tf]"
2504 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2505 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2506 puts $f "set geometry(botwidth) [winfo width .bleft]"
2507 puts $f "set geometry(botheight) [winfo height .bleft]"
2509 puts -nonewline $f "set permviews {"
2510 for {set v 0} {$v < $nextviewnum} {incr v} {
2511 if {$viewperm($v)} {
2512 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2515 puts $f "}"
2516 close $f
2517 file rename -force "~/.gitk-new" "~/.gitk"
2519 set stuffsaved 1
2522 proc resizeclistpanes {win w} {
2523 global oldwidth
2524 if {[info exists oldwidth($win)]} {
2525 set s0 [$win sash coord 0]
2526 set s1 [$win sash coord 1]
2527 if {$w < 60} {
2528 set sash0 [expr {int($w/2 - 2)}]
2529 set sash1 [expr {int($w*5/6 - 2)}]
2530 } else {
2531 set factor [expr {1.0 * $w / $oldwidth($win)}]
2532 set sash0 [expr {int($factor * [lindex $s0 0])}]
2533 set sash1 [expr {int($factor * [lindex $s1 0])}]
2534 if {$sash0 < 30} {
2535 set sash0 30
2537 if {$sash1 < $sash0 + 20} {
2538 set sash1 [expr {$sash0 + 20}]
2540 if {$sash1 > $w - 10} {
2541 set sash1 [expr {$w - 10}]
2542 if {$sash0 > $sash1 - 20} {
2543 set sash0 [expr {$sash1 - 20}]
2547 $win sash place 0 $sash0 [lindex $s0 1]
2548 $win sash place 1 $sash1 [lindex $s1 1]
2550 set oldwidth($win) $w
2553 proc resizecdetpanes {win w} {
2554 global oldwidth
2555 if {[info exists oldwidth($win)]} {
2556 set s0 [$win sash coord 0]
2557 if {$w < 60} {
2558 set sash0 [expr {int($w*3/4 - 2)}]
2559 } else {
2560 set factor [expr {1.0 * $w / $oldwidth($win)}]
2561 set sash0 [expr {int($factor * [lindex $s0 0])}]
2562 if {$sash0 < 45} {
2563 set sash0 45
2565 if {$sash0 > $w - 15} {
2566 set sash0 [expr {$w - 15}]
2569 $win sash place 0 $sash0 [lindex $s0 1]
2571 set oldwidth($win) $w
2574 proc allcanvs args {
2575 global canv canv2 canv3
2576 eval $canv $args
2577 eval $canv2 $args
2578 eval $canv3 $args
2581 proc bindall {event action} {
2582 global canv canv2 canv3
2583 bind $canv $event $action
2584 bind $canv2 $event $action
2585 bind $canv3 $event $action
2588 proc about {} {
2589 global uifont
2590 set w .about
2591 if {[winfo exists $w]} {
2592 raise $w
2593 return
2595 toplevel $w
2596 wm title $w [mc "About gitk"]
2597 make_transient $w .
2598 message $w.m -text [mc "
2599 Gitk - a commit viewer for git
2601 Copyright © 2005-2008 Paul Mackerras
2603 Use and redistribute under the terms of the GNU General Public License"] \
2604 -justify center -aspect 400 -border 2 -bg white -relief groove
2605 pack $w.m -side top -fill x -padx 2 -pady 2
2606 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2607 pack $w.ok -side bottom
2608 bind $w <Visibility> "focus $w.ok"
2609 bind $w <Key-Escape> "destroy $w"
2610 bind $w <Key-Return> "destroy $w"
2613 proc keys {} {
2614 set w .keys
2615 if {[winfo exists $w]} {
2616 raise $w
2617 return
2619 if {[tk windowingsystem] eq {aqua}} {
2620 set M1T Cmd
2621 } else {
2622 set M1T Ctrl
2624 toplevel $w
2625 wm title $w [mc "Gitk key bindings"]
2626 make_transient $w .
2627 message $w.m -text "
2628 [mc "Gitk key bindings:"]
2630 [mc "<%s-Q> Quit" $M1T]
2631 [mc "<Home> Move to first commit"]
2632 [mc "<End> Move to last commit"]
2633 [mc "<Up>, p, i Move up one commit"]
2634 [mc "<Down>, n, k Move down one commit"]
2635 [mc "<Left>, z, j Go back in history list"]
2636 [mc "<Right>, x, l Go forward in history list"]
2637 [mc "<PageUp> Move up one page in commit list"]
2638 [mc "<PageDown> Move down one page in commit list"]
2639 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2640 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2641 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2642 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2643 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2644 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2645 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2646 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2647 [mc "<Delete>, b Scroll diff view up one page"]
2648 [mc "<Backspace> Scroll diff view up one page"]
2649 [mc "<Space> Scroll diff view down one page"]
2650 [mc "u Scroll diff view up 18 lines"]
2651 [mc "d Scroll diff view down 18 lines"]
2652 [mc "<%s-F> Find" $M1T]
2653 [mc "<%s-G> Move to next find hit" $M1T]
2654 [mc "<Return> Move to next find hit"]
2655 [mc "/ Move to next find hit, or redo find"]
2656 [mc "? Move to previous find hit"]
2657 [mc "f Scroll diff view to next file"]
2658 [mc "<%s-S> Search for next hit in diff view" $M1T]
2659 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2660 [mc "<%s-KP+> Increase font size" $M1T]
2661 [mc "<%s-plus> Increase font size" $M1T]
2662 [mc "<%s-KP-> Decrease font size" $M1T]
2663 [mc "<%s-minus> Decrease font size" $M1T]
2664 [mc "<F5> Update"]
2666 -justify left -bg white -border 2 -relief groove
2667 pack $w.m -side top -fill both -padx 2 -pady 2
2668 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2669 bind $w <Key-Escape> [list destroy $w]
2670 pack $w.ok -side bottom
2671 bind $w <Visibility> "focus $w.ok"
2672 bind $w <Key-Escape> "destroy $w"
2673 bind $w <Key-Return> "destroy $w"
2676 # Procedures for manipulating the file list window at the
2677 # bottom right of the overall window.
2679 proc treeview {w l openlevs} {
2680 global treecontents treediropen treeheight treeparent treeindex
2682 set ix 0
2683 set treeindex() 0
2684 set lev 0
2685 set prefix {}
2686 set prefixend -1
2687 set prefendstack {}
2688 set htstack {}
2689 set ht 0
2690 set treecontents() {}
2691 $w conf -state normal
2692 foreach f $l {
2693 while {[string range $f 0 $prefixend] ne $prefix} {
2694 if {$lev <= $openlevs} {
2695 $w mark set e:$treeindex($prefix) "end -1c"
2696 $w mark gravity e:$treeindex($prefix) left
2698 set treeheight($prefix) $ht
2699 incr ht [lindex $htstack end]
2700 set htstack [lreplace $htstack end end]
2701 set prefixend [lindex $prefendstack end]
2702 set prefendstack [lreplace $prefendstack end end]
2703 set prefix [string range $prefix 0 $prefixend]
2704 incr lev -1
2706 set tail [string range $f [expr {$prefixend+1}] end]
2707 while {[set slash [string first "/" $tail]] >= 0} {
2708 lappend htstack $ht
2709 set ht 0
2710 lappend prefendstack $prefixend
2711 incr prefixend [expr {$slash + 1}]
2712 set d [string range $tail 0 $slash]
2713 lappend treecontents($prefix) $d
2714 set oldprefix $prefix
2715 append prefix $d
2716 set treecontents($prefix) {}
2717 set treeindex($prefix) [incr ix]
2718 set treeparent($prefix) $oldprefix
2719 set tail [string range $tail [expr {$slash+1}] end]
2720 if {$lev <= $openlevs} {
2721 set ht 1
2722 set treediropen($prefix) [expr {$lev < $openlevs}]
2723 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2724 $w mark set d:$ix "end -1c"
2725 $w mark gravity d:$ix left
2726 set str "\n"
2727 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2728 $w insert end $str
2729 $w image create end -align center -image $bm -padx 1 \
2730 -name a:$ix
2731 $w insert end $d [highlight_tag $prefix]
2732 $w mark set s:$ix "end -1c"
2733 $w mark gravity s:$ix left
2735 incr lev
2737 if {$tail ne {}} {
2738 if {$lev <= $openlevs} {
2739 incr ht
2740 set str "\n"
2741 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2742 $w insert end $str
2743 $w insert end $tail [highlight_tag $f]
2745 lappend treecontents($prefix) $tail
2748 while {$htstack ne {}} {
2749 set treeheight($prefix) $ht
2750 incr ht [lindex $htstack end]
2751 set htstack [lreplace $htstack end end]
2752 set prefixend [lindex $prefendstack end]
2753 set prefendstack [lreplace $prefendstack end end]
2754 set prefix [string range $prefix 0 $prefixend]
2756 $w conf -state disabled
2759 proc linetoelt {l} {
2760 global treeheight treecontents
2762 set y 2
2763 set prefix {}
2764 while {1} {
2765 foreach e $treecontents($prefix) {
2766 if {$y == $l} {
2767 return "$prefix$e"
2769 set n 1
2770 if {[string index $e end] eq "/"} {
2771 set n $treeheight($prefix$e)
2772 if {$y + $n > $l} {
2773 append prefix $e
2774 incr y
2775 break
2778 incr y $n
2783 proc highlight_tree {y prefix} {
2784 global treeheight treecontents cflist
2786 foreach e $treecontents($prefix) {
2787 set path $prefix$e
2788 if {[highlight_tag $path] ne {}} {
2789 $cflist tag add bold $y.0 "$y.0 lineend"
2791 incr y
2792 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2793 set y [highlight_tree $y $path]
2796 return $y
2799 proc treeclosedir {w dir} {
2800 global treediropen treeheight treeparent treeindex
2802 set ix $treeindex($dir)
2803 $w conf -state normal
2804 $w delete s:$ix e:$ix
2805 set treediropen($dir) 0
2806 $w image configure a:$ix -image tri-rt
2807 $w conf -state disabled
2808 set n [expr {1 - $treeheight($dir)}]
2809 while {$dir ne {}} {
2810 incr treeheight($dir) $n
2811 set dir $treeparent($dir)
2815 proc treeopendir {w dir} {
2816 global treediropen treeheight treeparent treecontents treeindex
2818 set ix $treeindex($dir)
2819 $w conf -state normal
2820 $w image configure a:$ix -image tri-dn
2821 $w mark set e:$ix s:$ix
2822 $w mark gravity e:$ix right
2823 set lev 0
2824 set str "\n"
2825 set n [llength $treecontents($dir)]
2826 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2827 incr lev
2828 append str "\t"
2829 incr treeheight($x) $n
2831 foreach e $treecontents($dir) {
2832 set de $dir$e
2833 if {[string index $e end] eq "/"} {
2834 set iy $treeindex($de)
2835 $w mark set d:$iy e:$ix
2836 $w mark gravity d:$iy left
2837 $w insert e:$ix $str
2838 set treediropen($de) 0
2839 $w image create e:$ix -align center -image tri-rt -padx 1 \
2840 -name a:$iy
2841 $w insert e:$ix $e [highlight_tag $de]
2842 $w mark set s:$iy e:$ix
2843 $w mark gravity s:$iy left
2844 set treeheight($de) 1
2845 } else {
2846 $w insert e:$ix $str
2847 $w insert e:$ix $e [highlight_tag $de]
2850 $w mark gravity e:$ix right
2851 $w conf -state disabled
2852 set treediropen($dir) 1
2853 set top [lindex [split [$w index @0,0] .] 0]
2854 set ht [$w cget -height]
2855 set l [lindex [split [$w index s:$ix] .] 0]
2856 if {$l < $top} {
2857 $w yview $l.0
2858 } elseif {$l + $n + 1 > $top + $ht} {
2859 set top [expr {$l + $n + 2 - $ht}]
2860 if {$l < $top} {
2861 set top $l
2863 $w yview $top.0
2867 proc treeclick {w x y} {
2868 global treediropen cmitmode ctext cflist cflist_top
2870 if {$cmitmode ne "tree"} return
2871 if {![info exists cflist_top]} return
2872 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2873 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2874 $cflist tag add highlight $l.0 "$l.0 lineend"
2875 set cflist_top $l
2876 if {$l == 1} {
2877 $ctext yview 1.0
2878 return
2880 set e [linetoelt $l]
2881 if {[string index $e end] ne "/"} {
2882 showfile $e
2883 } elseif {$treediropen($e)} {
2884 treeclosedir $w $e
2885 } else {
2886 treeopendir $w $e
2890 proc setfilelist {id} {
2891 global treefilelist cflist jump_to_here
2893 treeview $cflist $treefilelist($id) 0
2894 if {$jump_to_here ne {}} {
2895 set f [lindex $jump_to_here 0]
2896 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2897 showfile $f
2902 image create bitmap tri-rt -background black -foreground blue -data {
2903 #define tri-rt_width 13
2904 #define tri-rt_height 13
2905 static unsigned char tri-rt_bits[] = {
2906 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2907 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2908 0x00, 0x00};
2909 } -maskdata {
2910 #define tri-rt-mask_width 13
2911 #define tri-rt-mask_height 13
2912 static unsigned char tri-rt-mask_bits[] = {
2913 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2914 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2915 0x08, 0x00};
2917 image create bitmap tri-dn -background black -foreground blue -data {
2918 #define tri-dn_width 13
2919 #define tri-dn_height 13
2920 static unsigned char tri-dn_bits[] = {
2921 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2922 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2923 0x00, 0x00};
2924 } -maskdata {
2925 #define tri-dn-mask_width 13
2926 #define tri-dn-mask_height 13
2927 static unsigned char tri-dn-mask_bits[] = {
2928 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2929 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2930 0x00, 0x00};
2933 image create bitmap reficon-T -background black -foreground yellow -data {
2934 #define tagicon_width 13
2935 #define tagicon_height 9
2936 static unsigned char tagicon_bits[] = {
2937 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2938 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2939 } -maskdata {
2940 #define tagicon-mask_width 13
2941 #define tagicon-mask_height 9
2942 static unsigned char tagicon-mask_bits[] = {
2943 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2944 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2946 set rectdata {
2947 #define headicon_width 13
2948 #define headicon_height 9
2949 static unsigned char headicon_bits[] = {
2950 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2951 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2953 set rectmask {
2954 #define headicon-mask_width 13
2955 #define headicon-mask_height 9
2956 static unsigned char headicon-mask_bits[] = {
2957 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2958 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2960 image create bitmap reficon-H -background black -foreground green \
2961 -data $rectdata -maskdata $rectmask
2962 image create bitmap reficon-o -background black -foreground "#ddddff" \
2963 -data $rectdata -maskdata $rectmask
2965 proc init_flist {first} {
2966 global cflist cflist_top difffilestart
2968 $cflist conf -state normal
2969 $cflist delete 0.0 end
2970 if {$first ne {}} {
2971 $cflist insert end $first
2972 set cflist_top 1
2973 $cflist tag add highlight 1.0 "1.0 lineend"
2974 } else {
2975 catch {unset cflist_top}
2977 $cflist conf -state disabled
2978 set difffilestart {}
2981 proc highlight_tag {f} {
2982 global highlight_paths
2984 foreach p $highlight_paths {
2985 if {[string match $p $f]} {
2986 return "bold"
2989 return {}
2992 proc highlight_filelist {} {
2993 global cmitmode cflist
2995 $cflist conf -state normal
2996 if {$cmitmode ne "tree"} {
2997 set end [lindex [split [$cflist index end] .] 0]
2998 for {set l 2} {$l < $end} {incr l} {
2999 set line [$cflist get $l.0 "$l.0 lineend"]
3000 if {[highlight_tag $line] ne {}} {
3001 $cflist tag add bold $l.0 "$l.0 lineend"
3004 } else {
3005 highlight_tree 2 {}
3007 $cflist conf -state disabled
3010 proc unhighlight_filelist {} {
3011 global cflist
3013 $cflist conf -state normal
3014 $cflist tag remove bold 1.0 end
3015 $cflist conf -state disabled
3018 proc add_flist {fl} {
3019 global cflist
3021 $cflist conf -state normal
3022 foreach f $fl {
3023 $cflist insert end "\n"
3024 $cflist insert end $f [highlight_tag $f]
3026 $cflist conf -state disabled
3029 proc sel_flist {w x y} {
3030 global ctext difffilestart cflist cflist_top cmitmode
3032 if {$cmitmode eq "tree"} return
3033 if {![info exists cflist_top]} return
3034 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3035 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3036 $cflist tag add highlight $l.0 "$l.0 lineend"
3037 set cflist_top $l
3038 if {$l == 1} {
3039 $ctext yview 1.0
3040 } else {
3041 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3045 proc pop_flist_menu {w X Y x y} {
3046 global ctext cflist cmitmode flist_menu flist_menu_file
3047 global treediffs diffids
3049 stopfinding
3050 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3051 if {$l <= 1} return
3052 if {$cmitmode eq "tree"} {
3053 set e [linetoelt $l]
3054 if {[string index $e end] eq "/"} return
3055 } else {
3056 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3058 set flist_menu_file $e
3059 set xdiffstate "normal"
3060 if {$cmitmode eq "tree"} {
3061 set xdiffstate "disabled"
3063 # Disable "External diff" item in tree mode
3064 $flist_menu entryconf 2 -state $xdiffstate
3065 tk_popup $flist_menu $X $Y
3068 proc find_ctext_fileinfo {line} {
3069 global ctext_file_names ctext_file_lines
3071 set ok [bsearch $ctext_file_lines $line]
3072 set tline [lindex $ctext_file_lines $ok]
3074 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3075 return {}
3076 } else {
3077 return [list [lindex $ctext_file_names $ok] $tline]
3081 proc pop_diff_menu {w X Y x y} {
3082 global ctext diff_menu flist_menu_file
3083 global diff_menu_txtpos diff_menu_line
3084 global diff_menu_filebase
3086 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3087 set diff_menu_line [lindex $diff_menu_txtpos 0]
3088 # don't pop up the menu on hunk-separator or file-separator lines
3089 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3090 return
3092 stopfinding
3093 set f [find_ctext_fileinfo $diff_menu_line]
3094 if {$f eq {}} return
3095 set flist_menu_file [lindex $f 0]
3096 set diff_menu_filebase [lindex $f 1]
3097 tk_popup $diff_menu $X $Y
3100 proc flist_hl {only} {
3101 global flist_menu_file findstring gdttype
3103 set x [shellquote $flist_menu_file]
3104 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3105 set findstring $x
3106 } else {
3107 append findstring " " $x
3109 set gdttype [mc "touching paths:"]
3112 proc save_file_from_commit {filename output what} {
3113 global nullfile
3115 if {[catch {exec git show $filename -- > $output} err]} {
3116 if {[string match "fatal: bad revision *" $err]} {
3117 return $nullfile
3119 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3120 return {}
3122 return $output
3125 proc external_diff_get_one_file {diffid filename diffdir} {
3126 global nullid nullid2 nullfile
3127 global gitdir
3129 if {$diffid == $nullid} {
3130 set difffile [file join [file dirname $gitdir] $filename]
3131 if {[file exists $difffile]} {
3132 return $difffile
3134 return $nullfile
3136 if {$diffid == $nullid2} {
3137 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3138 return [save_file_from_commit :$filename $difffile index]
3140 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3141 return [save_file_from_commit $diffid:$filename $difffile \
3142 "revision $diffid"]
3145 proc external_diff {} {
3146 global gitktmpdir nullid nullid2
3147 global flist_menu_file
3148 global diffids
3149 global diffnum
3150 global gitdir extdifftool
3152 if {[llength $diffids] == 1} {
3153 # no reference commit given
3154 set diffidto [lindex $diffids 0]
3155 if {$diffidto eq $nullid} {
3156 # diffing working copy with index
3157 set diffidfrom $nullid2
3158 } elseif {$diffidto eq $nullid2} {
3159 # diffing index with HEAD
3160 set diffidfrom "HEAD"
3161 } else {
3162 # use first parent commit
3163 global parentlist selectedline
3164 set diffidfrom [lindex $parentlist $selectedline 0]
3166 } else {
3167 set diffidfrom [lindex $diffids 0]
3168 set diffidto [lindex $diffids 1]
3171 # make sure that several diffs wont collide
3172 if {![info exists gitktmpdir]} {
3173 set gitktmpdir [file join [file dirname $gitdir] \
3174 [format ".gitk-tmp.%s" [pid]]]
3175 if {[catch {file mkdir $gitktmpdir} err]} {
3176 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3177 unset gitktmpdir
3178 return
3180 set diffnum 0
3182 incr diffnum
3183 set diffdir [file join $gitktmpdir $diffnum]
3184 if {[catch {file mkdir $diffdir} err]} {
3185 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3186 return
3189 # gather files to diff
3190 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3191 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3193 if {$difffromfile ne {} && $difftofile ne {}} {
3194 set cmd [concat | [shellsplit $extdifftool] \
3195 [list $difffromfile $difftofile]]
3196 if {[catch {set fl [open $cmd r]} err]} {
3197 file delete -force $diffdir
3198 error_popup "$extdifftool: [mc "command failed:"] $err"
3199 } else {
3200 fconfigure $fl -blocking 0
3201 filerun $fl [list delete_at_eof $fl $diffdir]
3206 proc find_hunk_blamespec {base line} {
3207 global ctext
3209 # Find and parse the hunk header
3210 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3211 if {$s_lix eq {}} return
3213 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3214 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3215 s_line old_specs osz osz1 new_line nsz]} {
3216 return
3219 # base lines for the parents
3220 set base_lines [list $new_line]
3221 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3222 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3223 old_spec old_line osz]} {
3224 return
3226 lappend base_lines $old_line
3229 # Now scan the lines to determine offset within the hunk
3230 set max_parent [expr {[llength $base_lines]-2}]
3231 set dline 0
3232 set s_lno [lindex [split $s_lix "."] 0]
3234 # Determine if the line is removed
3235 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3236 if {[string match {[-+ ]*} $chunk]} {
3237 set removed_idx [string first "-" $chunk]
3238 # Choose a parent index
3239 if {$removed_idx >= 0} {
3240 set parent $removed_idx
3241 } else {
3242 set unchanged_idx [string first " " $chunk]
3243 if {$unchanged_idx >= 0} {
3244 set parent $unchanged_idx
3245 } else {
3246 # blame the current commit
3247 set parent -1
3250 # then count other lines that belong to it
3251 for {set i $line} {[incr i -1] > $s_lno} {} {
3252 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3253 # Determine if the line is removed
3254 set removed_idx [string first "-" $chunk]
3255 if {$parent >= 0} {
3256 set code [string index $chunk $parent]
3257 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3258 incr dline
3260 } else {
3261 if {$removed_idx < 0} {
3262 incr dline
3266 incr parent
3267 } else {
3268 set parent 0
3271 incr dline [lindex $base_lines $parent]
3272 return [list $parent $dline]
3275 proc external_blame_diff {} {
3276 global currentid cmitmode
3277 global diff_menu_txtpos diff_menu_line
3278 global diff_menu_filebase flist_menu_file
3280 if {$cmitmode eq "tree"} {
3281 set parent_idx 0
3282 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3283 } else {
3284 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3285 if {$hinfo ne {}} {
3286 set parent_idx [lindex $hinfo 0]
3287 set line [lindex $hinfo 1]
3288 } else {
3289 set parent_idx 0
3290 set line 0
3294 external_blame $parent_idx $line
3297 # Find the SHA1 ID of the blob for file $fname in the index
3298 # at stage 0 or 2
3299 proc index_sha1 {fname} {
3300 set f [open [list | git ls-files -s $fname] r]
3301 while {[gets $f line] >= 0} {
3302 set info [lindex [split $line "\t"] 0]
3303 set stage [lindex $info 2]
3304 if {$stage eq "0" || $stage eq "2"} {
3305 close $f
3306 return [lindex $info 1]
3309 close $f
3310 return {}
3313 proc external_blame {parent_idx {line {}}} {
3314 global flist_menu_file
3315 global nullid nullid2
3316 global parentlist selectedline currentid
3318 if {$parent_idx > 0} {
3319 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3320 } else {
3321 set base_commit $currentid
3324 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3325 error_popup [mc "No such commit"]
3326 return
3329 set cmdline [list git gui blame]
3330 if {$line ne {} && $line > 1} {
3331 lappend cmdline "--line=$line"
3333 lappend cmdline $base_commit $flist_menu_file
3334 if {[catch {eval exec $cmdline &} err]} {
3335 error_popup "[mc "git gui blame: command failed:"] $err"
3339 proc show_line_source {} {
3340 global cmitmode currentid parents curview blamestuff blameinst
3341 global diff_menu_line diff_menu_filebase flist_menu_file
3342 global nullid nullid2 gitdir
3344 set from_index {}
3345 if {$cmitmode eq "tree"} {
3346 set id $currentid
3347 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3348 } else {
3349 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3350 if {$h eq {}} return
3351 set pi [lindex $h 0]
3352 if {$pi == 0} {
3353 mark_ctext_line $diff_menu_line
3354 return
3356 incr pi -1
3357 if {$currentid eq $nullid} {
3358 if {$pi > 0} {
3359 # must be a merge in progress...
3360 if {[catch {
3361 # get the last line from .git/MERGE_HEAD
3362 set f [open [file join $gitdir MERGE_HEAD] r]
3363 set id [lindex [split [read $f] "\n"] end-1]
3364 close $f
3365 } err]} {
3366 error_popup [mc "Couldn't read merge head: %s" $err]
3367 return
3369 } elseif {$parents($curview,$currentid) eq $nullid2} {
3370 # need to do the blame from the index
3371 if {[catch {
3372 set from_index [index_sha1 $flist_menu_file]
3373 } err]} {
3374 error_popup [mc "Error reading index: %s" $err]
3375 return
3378 } else {
3379 set id [lindex $parents($curview,$currentid) $pi]
3381 set line [lindex $h 1]
3383 set blameargs {}
3384 if {$from_index ne {}} {
3385 lappend blameargs | git cat-file blob $from_index
3387 lappend blameargs | git blame -p -L$line,+1
3388 if {$from_index ne {}} {
3389 lappend blameargs --contents -
3390 } else {
3391 lappend blameargs $id
3393 lappend blameargs -- $flist_menu_file
3394 if {[catch {
3395 set f [open $blameargs r]
3396 } err]} {
3397 error_popup [mc "Couldn't start git blame: %s" $err]
3398 return
3400 fconfigure $f -blocking 0
3401 set i [reg_instance $f]
3402 set blamestuff($i) {}
3403 set blameinst $i
3404 filerun $f [list read_line_source $f $i]
3407 proc stopblaming {} {
3408 global blameinst
3410 if {[info exists blameinst]} {
3411 stop_instance $blameinst
3412 unset blameinst
3416 proc read_line_source {fd inst} {
3417 global blamestuff curview commfd blameinst nullid nullid2
3419 while {[gets $fd line] >= 0} {
3420 lappend blamestuff($inst) $line
3422 if {![eof $fd]} {
3423 return 1
3425 unset commfd($inst)
3426 unset blameinst
3427 fconfigure $fd -blocking 1
3428 if {[catch {close $fd} err]} {
3429 error_popup [mc "Error running git blame: %s" $err]
3430 return 0
3433 set fname {}
3434 set line [split [lindex $blamestuff($inst) 0] " "]
3435 set id [lindex $line 0]
3436 set lnum [lindex $line 1]
3437 if {[string length $id] == 40 && [string is xdigit $id] &&
3438 [string is digit -strict $lnum]} {
3439 # look for "filename" line
3440 foreach l $blamestuff($inst) {
3441 if {[string match "filename *" $l]} {
3442 set fname [string range $l 9 end]
3443 break
3447 if {$fname ne {}} {
3448 # all looks good, select it
3449 if {$id eq $nullid} {
3450 # blame uses all-zeroes to mean not committed,
3451 # which would mean a change in the index
3452 set id $nullid2
3454 if {[commitinview $id $curview]} {
3455 selectline [rowofcommit $id] 1 [list $fname $lnum]
3456 } else {
3457 error_popup [mc "That line comes from commit %s, \
3458 which is not in this view" [shortids $id]]
3460 } else {
3461 puts "oops couldn't parse git blame output"
3463 return 0
3466 # delete $dir when we see eof on $f (presumably because the child has exited)
3467 proc delete_at_eof {f dir} {
3468 while {[gets $f line] >= 0} {}
3469 if {[eof $f]} {
3470 if {[catch {close $f} err]} {
3471 error_popup "[mc "External diff viewer failed:"] $err"
3473 file delete -force $dir
3474 return 0
3476 return 1
3479 # Functions for adding and removing shell-type quoting
3481 proc shellquote {str} {
3482 if {![string match "*\['\"\\ \t]*" $str]} {
3483 return $str
3485 if {![string match "*\['\"\\]*" $str]} {
3486 return "\"$str\""
3488 if {![string match "*'*" $str]} {
3489 return "'$str'"
3491 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3494 proc shellarglist {l} {
3495 set str {}
3496 foreach a $l {
3497 if {$str ne {}} {
3498 append str " "
3500 append str [shellquote $a]
3502 return $str
3505 proc shelldequote {str} {
3506 set ret {}
3507 set used -1
3508 while {1} {
3509 incr used
3510 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3511 append ret [string range $str $used end]
3512 set used [string length $str]
3513 break
3515 set first [lindex $first 0]
3516 set ch [string index $str $first]
3517 if {$first > $used} {
3518 append ret [string range $str $used [expr {$first - 1}]]
3519 set used $first
3521 if {$ch eq " " || $ch eq "\t"} break
3522 incr used
3523 if {$ch eq "'"} {
3524 set first [string first "'" $str $used]
3525 if {$first < 0} {
3526 error "unmatched single-quote"
3528 append ret [string range $str $used [expr {$first - 1}]]
3529 set used $first
3530 continue
3532 if {$ch eq "\\"} {
3533 if {$used >= [string length $str]} {
3534 error "trailing backslash"
3536 append ret [string index $str $used]
3537 continue
3539 # here ch == "\""
3540 while {1} {
3541 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3542 error "unmatched double-quote"
3544 set first [lindex $first 0]
3545 set ch [string index $str $first]
3546 if {$first > $used} {
3547 append ret [string range $str $used [expr {$first - 1}]]
3548 set used $first
3550 if {$ch eq "\""} break
3551 incr used
3552 append ret [string index $str $used]
3553 incr used
3556 return [list $used $ret]
3559 proc shellsplit {str} {
3560 set l {}
3561 while {1} {
3562 set str [string trimleft $str]
3563 if {$str eq {}} break
3564 set dq [shelldequote $str]
3565 set n [lindex $dq 0]
3566 set word [lindex $dq 1]
3567 set str [string range $str $n end]
3568 lappend l $word
3570 return $l
3573 # Code to implement multiple views
3575 proc newview {ishighlight} {
3576 global nextviewnum newviewname newishighlight
3577 global revtreeargs viewargscmd newviewopts curview
3579 set newishighlight $ishighlight
3580 set top .gitkview
3581 if {[winfo exists $top]} {
3582 raise $top
3583 return
3585 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3586 set newviewopts($nextviewnum,perm) 0
3587 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3588 decode_view_opts $nextviewnum $revtreeargs
3589 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3592 set known_view_options {
3593 {perm b . {} {mc "Remember this view"}}
3594 {args t50= + {} {mc "Commits to include (arguments to git log):"}}
3595 {all b * "--all" {mc "Use all refs"}}
3596 {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
3597 {lright b . "--left-right" {mc "Mark branch sides"}}
3598 {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
3599 {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
3600 {limit t10 + "--max-count=*" {mc "Max count:"}}
3601 {skip t10 . "--skip=*" {mc "Skip:"}}
3602 {first b . "--first-parent" {mc "Limit to first parent"}}
3603 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3606 proc encode_view_opts {n} {
3607 global known_view_options newviewopts
3609 set rargs [list]
3610 foreach opt $known_view_options {
3611 set patterns [lindex $opt 3]
3612 if {$patterns eq {}} continue
3613 set pattern [lindex $patterns 0]
3615 set val $newviewopts($n,[lindex $opt 0])
3617 if {[lindex $opt 1] eq "b"} {
3618 if {$val} {
3619 lappend rargs $pattern
3621 } else {
3622 set val [string trim $val]
3623 if {$val ne {}} {
3624 set pfix [string range $pattern 0 end-1]
3625 lappend rargs $pfix$val
3629 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3632 proc decode_view_opts {n view_args} {
3633 global known_view_options newviewopts
3635 foreach opt $known_view_options {
3636 if {[lindex $opt 1] eq "b"} {
3637 set val 0
3638 } else {
3639 set val {}
3641 set newviewopts($n,[lindex $opt 0]) $val
3643 set oargs [list]
3644 foreach arg $view_args {
3645 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3646 && ![info exists found(limit)]} {
3647 set newviewopts($n,limit) $cnt
3648 set found(limit) 1
3649 continue
3651 catch { unset val }
3652 foreach opt $known_view_options {
3653 set id [lindex $opt 0]
3654 if {[info exists found($id)]} continue
3655 foreach pattern [lindex $opt 3] {
3656 if {![string match $pattern $arg]} continue
3657 if {[lindex $opt 1] ne "b"} {
3658 set size [string length $pattern]
3659 set val [string range $arg [expr {$size-1}] end]
3660 } else {
3661 set val 1
3663 set newviewopts($n,$id) $val
3664 set found($id) 1
3665 break
3667 if {[info exists val]} break
3669 if {[info exists val]} continue
3670 lappend oargs $arg
3672 set newviewopts($n,args) [shellarglist $oargs]
3675 proc edit_or_newview {} {
3676 global curview
3678 if {$curview > 0} {
3679 editview
3680 } else {
3681 newview 0
3685 proc editview {} {
3686 global curview
3687 global viewname viewperm newviewname newviewopts
3688 global viewargs viewargscmd
3690 set top .gitkvedit-$curview
3691 if {[winfo exists $top]} {
3692 raise $top
3693 return
3695 set newviewname($curview) $viewname($curview)
3696 set newviewopts($curview,perm) $viewperm($curview)
3697 set newviewopts($curview,cmd) $viewargscmd($curview)
3698 decode_view_opts $curview $viewargs($curview)
3699 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3702 proc vieweditor {top n title} {
3703 global newviewname newviewopts viewfiles bgcolor
3704 global known_view_options
3706 toplevel $top
3707 wm title $top $title
3708 make_transient $top .
3710 # View name
3711 frame $top.nfr
3712 label $top.nl -text [mc "Name"]
3713 entry $top.name -width 20 -textvariable newviewname($n)
3714 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3715 pack $top.nl -in $top.nfr -side left -padx {0 30}
3716 pack $top.name -in $top.nfr -side left
3718 # View options
3719 set cframe $top.nfr
3720 set cexpand 0
3721 set cnt 0
3722 foreach opt $known_view_options {
3723 set id [lindex $opt 0]
3724 set type [lindex $opt 1]
3725 set flags [lindex $opt 2]
3726 set title [eval [lindex $opt 4]]
3727 set lxpad 0
3729 if {$flags eq "+" || $flags eq "*"} {
3730 set cframe $top.fr$cnt
3731 incr cnt
3732 frame $cframe
3733 pack $cframe -in $top -fill x -pady 3 -padx 3
3734 set cexpand [expr {$flags eq "*"}]
3735 } else {
3736 set lxpad 5
3739 if {$type eq "b"} {
3740 checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3741 pack $cframe.c_$id -in $cframe -side left \
3742 -padx [list $lxpad 0] -expand $cexpand -anchor w
3743 } elseif {[regexp {^t(\d+)$} $type type sz]} {
3744 message $cframe.l_$id -aspect 1500 -text $title
3745 entry $cframe.e_$id -width $sz -background $bgcolor \
3746 -textvariable newviewopts($n,$id)
3747 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3748 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3749 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3750 message $cframe.l_$id -aspect 1500 -text $title
3751 entry $cframe.e_$id -width $sz -background $bgcolor \
3752 -textvariable newviewopts($n,$id)
3753 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3754 pack $cframe.e_$id -in $cframe -side top -fill x
3758 # Path list
3759 message $top.l -aspect 1500 \
3760 -text [mc "Enter files and directories to include, one per line:"]
3761 pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
3762 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3763 if {[info exists viewfiles($n)]} {
3764 foreach f $viewfiles($n) {
3765 $top.t insert end $f
3766 $top.t insert end "\n"
3768 $top.t delete {end - 1c} end
3769 $top.t mark set insert 0.0
3771 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3772 frame $top.buts
3773 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3774 button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3775 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3776 bind $top <Control-Return> [list newviewok $top $n]
3777 bind $top <F5> [list newviewok $top $n 1]
3778 bind $top <Escape> [list destroy $top]
3779 grid $top.buts.ok $top.buts.apply $top.buts.can
3780 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3781 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3782 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3783 pack $top.buts -in $top -side top -fill x
3784 focus $top.t
3787 proc doviewmenu {m first cmd op argv} {
3788 set nmenu [$m index end]
3789 for {set i $first} {$i <= $nmenu} {incr i} {
3790 if {[$m entrycget $i -command] eq $cmd} {
3791 eval $m $op $i $argv
3792 break
3797 proc allviewmenus {n op args} {
3798 # global viewhlmenu
3800 doviewmenu .bar.view 5 [list showview $n] $op $args
3801 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3804 proc newviewok {top n {apply 0}} {
3805 global nextviewnum newviewperm newviewname newishighlight
3806 global viewname viewfiles viewperm selectedview curview
3807 global viewargs viewargscmd newviewopts viewhlmenu
3809 if {[catch {
3810 set newargs [encode_view_opts $n]
3811 } err]} {
3812 error_popup "[mc "Error in commit selection arguments:"] $err" $top
3813 return
3815 set files {}
3816 foreach f [split [$top.t get 0.0 end] "\n"] {
3817 set ft [string trim $f]
3818 if {$ft ne {}} {
3819 lappend files $ft
3822 if {![info exists viewfiles($n)]} {
3823 # creating a new view
3824 incr nextviewnum
3825 set viewname($n) $newviewname($n)
3826 set viewperm($n) $newviewopts($n,perm)
3827 set viewfiles($n) $files
3828 set viewargs($n) $newargs
3829 set viewargscmd($n) $newviewopts($n,cmd)
3830 addviewmenu $n
3831 if {!$newishighlight} {
3832 run showview $n
3833 } else {
3834 run addvhighlight $n
3836 } else {
3837 # editing an existing view
3838 set viewperm($n) $newviewopts($n,perm)
3839 if {$newviewname($n) ne $viewname($n)} {
3840 set viewname($n) $newviewname($n)
3841 doviewmenu .bar.view 5 [list showview $n] \
3842 entryconf [list -label $viewname($n)]
3843 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3844 # entryconf [list -label $viewname($n) -value $viewname($n)]
3846 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3847 $newviewopts($n,cmd) ne $viewargscmd($n)} {
3848 set viewfiles($n) $files
3849 set viewargs($n) $newargs
3850 set viewargscmd($n) $newviewopts($n,cmd)
3851 if {$curview == $n} {
3852 run reloadcommits
3856 if {$apply} return
3857 catch {destroy $top}
3860 proc delview {} {
3861 global curview viewperm hlview selectedhlview
3863 if {$curview == 0} return
3864 if {[info exists hlview] && $hlview == $curview} {
3865 set selectedhlview [mc "None"]
3866 unset hlview
3868 allviewmenus $curview delete
3869 set viewperm($curview) 0
3870 showview 0
3873 proc addviewmenu {n} {
3874 global viewname viewhlmenu
3876 .bar.view add radiobutton -label $viewname($n) \
3877 -command [list showview $n] -variable selectedview -value $n
3878 #$viewhlmenu add radiobutton -label $viewname($n) \
3879 # -command [list addvhighlight $n] -variable selectedhlview
3882 proc showview {n} {
3883 global curview cached_commitrow ordertok
3884 global displayorder parentlist rowidlist rowisopt rowfinal
3885 global colormap rowtextx nextcolor canvxmax
3886 global numcommits viewcomplete
3887 global selectedline currentid canv canvy0
3888 global treediffs
3889 global pending_select mainheadid
3890 global commitidx
3891 global selectedview
3892 global hlview selectedhlview commitinterest
3894 if {$n == $curview} return
3895 set selid {}
3896 set ymax [lindex [$canv cget -scrollregion] 3]
3897 set span [$canv yview]
3898 set ytop [expr {[lindex $span 0] * $ymax}]
3899 set ybot [expr {[lindex $span 1] * $ymax}]
3900 set yscreen [expr {($ybot - $ytop) / 2}]
3901 if {$selectedline ne {}} {
3902 set selid $currentid
3903 set y [yc $selectedline]
3904 if {$ytop < $y && $y < $ybot} {
3905 set yscreen [expr {$y - $ytop}]
3907 } elseif {[info exists pending_select]} {
3908 set selid $pending_select
3909 unset pending_select
3911 unselectline
3912 normalline
3913 catch {unset treediffs}
3914 clear_display
3915 if {[info exists hlview] && $hlview == $n} {
3916 unset hlview
3917 set selectedhlview [mc "None"]
3919 catch {unset commitinterest}
3920 catch {unset cached_commitrow}
3921 catch {unset ordertok}
3923 set curview $n
3924 set selectedview $n
3925 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3926 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3928 run refill_reflist
3929 if {![info exists viewcomplete($n)]} {
3930 getcommits $selid
3931 return
3934 set displayorder {}
3935 set parentlist {}
3936 set rowidlist {}
3937 set rowisopt {}
3938 set rowfinal {}
3939 set numcommits $commitidx($n)
3941 catch {unset colormap}
3942 catch {unset rowtextx}
3943 set nextcolor 0
3944 set canvxmax [$canv cget -width]
3945 set curview $n
3946 set row 0
3947 setcanvscroll
3948 set yf 0
3949 set row {}
3950 if {$selid ne {} && [commitinview $selid $n]} {
3951 set row [rowofcommit $selid]
3952 # try to get the selected row in the same position on the screen
3953 set ymax [lindex [$canv cget -scrollregion] 3]
3954 set ytop [expr {[yc $row] - $yscreen}]
3955 if {$ytop < 0} {
3956 set ytop 0
3958 set yf [expr {$ytop * 1.0 / $ymax}]
3960 allcanvs yview moveto $yf
3961 drawvisible
3962 if {$row ne {}} {
3963 selectline $row 0
3964 } elseif {!$viewcomplete($n)} {
3965 reset_pending_select $selid
3966 } else {
3967 reset_pending_select {}
3969 if {[commitinview $pending_select $curview]} {
3970 selectline [rowofcommit $pending_select] 1
3971 } else {
3972 set row [first_real_row]
3973 if {$row < $numcommits} {
3974 selectline $row 0
3978 if {!$viewcomplete($n)} {
3979 if {$numcommits == 0} {
3980 show_status [mc "Reading commits..."]
3982 } elseif {$numcommits == 0} {
3983 show_status [mc "No commits selected"]
3987 # Stuff relating to the highlighting facility
3989 proc ishighlighted {id} {
3990 global vhighlights fhighlights nhighlights rhighlights
3992 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3993 return $nhighlights($id)
3995 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3996 return $vhighlights($id)
3998 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3999 return $fhighlights($id)
4001 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4002 return $rhighlights($id)
4004 return 0
4007 proc bolden {row font} {
4008 global canv linehtag selectedline boldrows
4010 lappend boldrows $row
4011 $canv itemconf $linehtag($row) -font $font
4012 if {$row == $selectedline} {
4013 $canv delete secsel
4014 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
4015 -outline {{}} -tags secsel \
4016 -fill [$canv cget -selectbackground]]
4017 $canv lower $t
4021 proc bolden_name {row font} {
4022 global canv2 linentag selectedline boldnamerows
4024 lappend boldnamerows $row
4025 $canv2 itemconf $linentag($row) -font $font
4026 if {$row == $selectedline} {
4027 $canv2 delete secsel
4028 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
4029 -outline {{}} -tags secsel \
4030 -fill [$canv2 cget -selectbackground]]
4031 $canv2 lower $t
4035 proc unbolden {} {
4036 global boldrows
4038 set stillbold {}
4039 foreach row $boldrows {
4040 if {![ishighlighted [commitonrow $row]]} {
4041 bolden $row mainfont
4042 } else {
4043 lappend stillbold $row
4046 set boldrows $stillbold
4049 proc addvhighlight {n} {
4050 global hlview viewcomplete curview vhl_done commitidx
4052 if {[info exists hlview]} {
4053 delvhighlight
4055 set hlview $n
4056 if {$n != $curview && ![info exists viewcomplete($n)]} {
4057 start_rev_list $n
4059 set vhl_done $commitidx($hlview)
4060 if {$vhl_done > 0} {
4061 drawvisible
4065 proc delvhighlight {} {
4066 global hlview vhighlights
4068 if {![info exists hlview]} return
4069 unset hlview
4070 catch {unset vhighlights}
4071 unbolden
4074 proc vhighlightmore {} {
4075 global hlview vhl_done commitidx vhighlights curview
4077 set max $commitidx($hlview)
4078 set vr [visiblerows]
4079 set r0 [lindex $vr 0]
4080 set r1 [lindex $vr 1]
4081 for {set i $vhl_done} {$i < $max} {incr i} {
4082 set id [commitonrow $i $hlview]
4083 if {[commitinview $id $curview]} {
4084 set row [rowofcommit $id]
4085 if {$r0 <= $row && $row <= $r1} {
4086 if {![highlighted $row]} {
4087 bolden $row mainfontbold
4089 set vhighlights($id) 1
4093 set vhl_done $max
4094 return 0
4097 proc askvhighlight {row id} {
4098 global hlview vhighlights iddrawn
4100 if {[commitinview $id $hlview]} {
4101 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4102 bolden $row mainfontbold
4104 set vhighlights($id) 1
4105 } else {
4106 set vhighlights($id) 0
4110 proc hfiles_change {} {
4111 global highlight_files filehighlight fhighlights fh_serial
4112 global highlight_paths gdttype
4114 if {[info exists filehighlight]} {
4115 # delete previous highlights
4116 catch {close $filehighlight}
4117 unset filehighlight
4118 catch {unset fhighlights}
4119 unbolden
4120 unhighlight_filelist
4122 set highlight_paths {}
4123 after cancel do_file_hl $fh_serial
4124 incr fh_serial
4125 if {$highlight_files ne {}} {
4126 after 300 do_file_hl $fh_serial
4130 proc gdttype_change {name ix op} {
4131 global gdttype highlight_files findstring findpattern
4133 stopfinding
4134 if {$findstring ne {}} {
4135 if {$gdttype eq [mc "containing:"]} {
4136 if {$highlight_files ne {}} {
4137 set highlight_files {}
4138 hfiles_change
4140 findcom_change
4141 } else {
4142 if {$findpattern ne {}} {
4143 set findpattern {}
4144 findcom_change
4146 set highlight_files $findstring
4147 hfiles_change
4149 drawvisible
4151 # enable/disable findtype/findloc menus too
4154 proc find_change {name ix op} {
4155 global gdttype findstring highlight_files
4157 stopfinding
4158 if {$gdttype eq [mc "containing:"]} {
4159 findcom_change
4160 } else {
4161 if {$highlight_files ne $findstring} {
4162 set highlight_files $findstring
4163 hfiles_change
4166 drawvisible
4169 proc findcom_change args {
4170 global nhighlights boldnamerows
4171 global findpattern findtype findstring gdttype
4173 stopfinding
4174 # delete previous highlights, if any
4175 foreach row $boldnamerows {
4176 bolden_name $row mainfont
4178 set boldnamerows {}
4179 catch {unset nhighlights}
4180 unbolden
4181 unmarkmatches
4182 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4183 set findpattern {}
4184 } elseif {$findtype eq [mc "Regexp"]} {
4185 set findpattern $findstring
4186 } else {
4187 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4188 $findstring]
4189 set findpattern "*$e*"
4193 proc makepatterns {l} {
4194 set ret {}
4195 foreach e $l {
4196 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4197 if {[string index $ee end] eq "/"} {
4198 lappend ret "$ee*"
4199 } else {
4200 lappend ret $ee
4201 lappend ret "$ee/*"
4204 return $ret
4207 proc do_file_hl {serial} {
4208 global highlight_files filehighlight highlight_paths gdttype fhl_list
4210 if {$gdttype eq [mc "touching paths:"]} {
4211 if {[catch {set paths [shellsplit $highlight_files]}]} return
4212 set highlight_paths [makepatterns $paths]
4213 highlight_filelist
4214 set gdtargs [concat -- $paths]
4215 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4216 set gdtargs [list "-S$highlight_files"]
4217 } else {
4218 # must be "containing:", i.e. we're searching commit info
4219 return
4221 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4222 set filehighlight [open $cmd r+]
4223 fconfigure $filehighlight -blocking 0
4224 filerun $filehighlight readfhighlight
4225 set fhl_list {}
4226 drawvisible
4227 flushhighlights
4230 proc flushhighlights {} {
4231 global filehighlight fhl_list
4233 if {[info exists filehighlight]} {
4234 lappend fhl_list {}
4235 puts $filehighlight ""
4236 flush $filehighlight
4240 proc askfilehighlight {row id} {
4241 global filehighlight fhighlights fhl_list
4243 lappend fhl_list $id
4244 set fhighlights($id) -1
4245 puts $filehighlight $id
4248 proc readfhighlight {} {
4249 global filehighlight fhighlights curview iddrawn
4250 global fhl_list find_dirn
4252 if {![info exists filehighlight]} {
4253 return 0
4255 set nr 0
4256 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4257 set line [string trim $line]
4258 set i [lsearch -exact $fhl_list $line]
4259 if {$i < 0} continue
4260 for {set j 0} {$j < $i} {incr j} {
4261 set id [lindex $fhl_list $j]
4262 set fhighlights($id) 0
4264 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4265 if {$line eq {}} continue
4266 if {![commitinview $line $curview]} continue
4267 set row [rowofcommit $line]
4268 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4269 bolden $row mainfontbold
4271 set fhighlights($line) 1
4273 if {[eof $filehighlight]} {
4274 # strange...
4275 puts "oops, git diff-tree died"
4276 catch {close $filehighlight}
4277 unset filehighlight
4278 return 0
4280 if {[info exists find_dirn]} {
4281 run findmore
4283 return 1
4286 proc doesmatch {f} {
4287 global findtype findpattern
4289 if {$findtype eq [mc "Regexp"]} {
4290 return [regexp $findpattern $f]
4291 } elseif {$findtype eq [mc "IgnCase"]} {
4292 return [string match -nocase $findpattern $f]
4293 } else {
4294 return [string match $findpattern $f]
4298 proc askfindhighlight {row id} {
4299 global nhighlights commitinfo iddrawn
4300 global findloc
4301 global markingmatches
4303 if {![info exists commitinfo($id)]} {
4304 getcommit $id
4306 set info $commitinfo($id)
4307 set isbold 0
4308 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4309 foreach f $info ty $fldtypes {
4310 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4311 [doesmatch $f]} {
4312 if {$ty eq [mc "Author"]} {
4313 set isbold 2
4314 break
4316 set isbold 1
4319 if {$isbold && [info exists iddrawn($id)]} {
4320 if {![ishighlighted $id]} {
4321 bolden $row mainfontbold
4322 if {$isbold > 1} {
4323 bolden_name $row mainfontbold
4326 if {$markingmatches} {
4327 markrowmatches $row $id
4330 set nhighlights($id) $isbold
4333 proc markrowmatches {row id} {
4334 global canv canv2 linehtag linentag commitinfo findloc
4336 set headline [lindex $commitinfo($id) 0]
4337 set author [lindex $commitinfo($id) 1]
4338 $canv delete match$row
4339 $canv2 delete match$row
4340 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4341 set m [findmatches $headline]
4342 if {$m ne {}} {
4343 markmatches $canv $row $headline $linehtag($row) $m \
4344 [$canv itemcget $linehtag($row) -font] $row
4347 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4348 set m [findmatches $author]
4349 if {$m ne {}} {
4350 markmatches $canv2 $row $author $linentag($row) $m \
4351 [$canv2 itemcget $linentag($row) -font] $row
4356 proc vrel_change {name ix op} {
4357 global highlight_related
4359 rhighlight_none
4360 if {$highlight_related ne [mc "None"]} {
4361 run drawvisible
4365 # prepare for testing whether commits are descendents or ancestors of a
4366 proc rhighlight_sel {a} {
4367 global descendent desc_todo ancestor anc_todo
4368 global highlight_related
4370 catch {unset descendent}
4371 set desc_todo [list $a]
4372 catch {unset ancestor}
4373 set anc_todo [list $a]
4374 if {$highlight_related ne [mc "None"]} {
4375 rhighlight_none
4376 run drawvisible
4380 proc rhighlight_none {} {
4381 global rhighlights
4383 catch {unset rhighlights}
4384 unbolden
4387 proc is_descendent {a} {
4388 global curview children descendent desc_todo
4390 set v $curview
4391 set la [rowofcommit $a]
4392 set todo $desc_todo
4393 set leftover {}
4394 set done 0
4395 for {set i 0} {$i < [llength $todo]} {incr i} {
4396 set do [lindex $todo $i]
4397 if {[rowofcommit $do] < $la} {
4398 lappend leftover $do
4399 continue
4401 foreach nk $children($v,$do) {
4402 if {![info exists descendent($nk)]} {
4403 set descendent($nk) 1
4404 lappend todo $nk
4405 if {$nk eq $a} {
4406 set done 1
4410 if {$done} {
4411 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4412 return
4415 set descendent($a) 0
4416 set desc_todo $leftover
4419 proc is_ancestor {a} {
4420 global curview parents ancestor anc_todo
4422 set v $curview
4423 set la [rowofcommit $a]
4424 set todo $anc_todo
4425 set leftover {}
4426 set done 0
4427 for {set i 0} {$i < [llength $todo]} {incr i} {
4428 set do [lindex $todo $i]
4429 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4430 lappend leftover $do
4431 continue
4433 foreach np $parents($v,$do) {
4434 if {![info exists ancestor($np)]} {
4435 set ancestor($np) 1
4436 lappend todo $np
4437 if {$np eq $a} {
4438 set done 1
4442 if {$done} {
4443 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4444 return
4447 set ancestor($a) 0
4448 set anc_todo $leftover
4451 proc askrelhighlight {row id} {
4452 global descendent highlight_related iddrawn rhighlights
4453 global selectedline ancestor
4455 if {$selectedline eq {}} return
4456 set isbold 0
4457 if {$highlight_related eq [mc "Descendant"] ||
4458 $highlight_related eq [mc "Not descendant"]} {
4459 if {![info exists descendent($id)]} {
4460 is_descendent $id
4462 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4463 set isbold 1
4465 } elseif {$highlight_related eq [mc "Ancestor"] ||
4466 $highlight_related eq [mc "Not ancestor"]} {
4467 if {![info exists ancestor($id)]} {
4468 is_ancestor $id
4470 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4471 set isbold 1
4474 if {[info exists iddrawn($id)]} {
4475 if {$isbold && ![ishighlighted $id]} {
4476 bolden $row mainfontbold
4479 set rhighlights($id) $isbold
4482 # Graph layout functions
4484 proc shortids {ids} {
4485 set res {}
4486 foreach id $ids {
4487 if {[llength $id] > 1} {
4488 lappend res [shortids $id]
4489 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4490 lappend res [string range $id 0 7]
4491 } else {
4492 lappend res $id
4495 return $res
4498 proc ntimes {n o} {
4499 set ret {}
4500 set o [list $o]
4501 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4502 if {($n & $mask) != 0} {
4503 set ret [concat $ret $o]
4505 set o [concat $o $o]
4507 return $ret
4510 proc ordertoken {id} {
4511 global ordertok curview varcid varcstart varctok curview parents children
4512 global nullid nullid2
4514 if {[info exists ordertok($id)]} {
4515 return $ordertok($id)
4517 set origid $id
4518 set todo {}
4519 while {1} {
4520 if {[info exists varcid($curview,$id)]} {
4521 set a $varcid($curview,$id)
4522 set p [lindex $varcstart($curview) $a]
4523 } else {
4524 set p [lindex $children($curview,$id) 0]
4526 if {[info exists ordertok($p)]} {
4527 set tok $ordertok($p)
4528 break
4530 set id [first_real_child $curview,$p]
4531 if {$id eq {}} {
4532 # it's a root
4533 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4534 break
4536 if {[llength $parents($curview,$id)] == 1} {
4537 lappend todo [list $p {}]
4538 } else {
4539 set j [lsearch -exact $parents($curview,$id) $p]
4540 if {$j < 0} {
4541 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4543 lappend todo [list $p [strrep $j]]
4546 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4547 set p [lindex $todo $i 0]
4548 append tok [lindex $todo $i 1]
4549 set ordertok($p) $tok
4551 set ordertok($origid) $tok
4552 return $tok
4555 # Work out where id should go in idlist so that order-token
4556 # values increase from left to right
4557 proc idcol {idlist id {i 0}} {
4558 set t [ordertoken $id]
4559 if {$i < 0} {
4560 set i 0
4562 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4563 if {$i > [llength $idlist]} {
4564 set i [llength $idlist]
4566 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4567 incr i
4568 } else {
4569 if {$t > [ordertoken [lindex $idlist $i]]} {
4570 while {[incr i] < [llength $idlist] &&
4571 $t >= [ordertoken [lindex $idlist $i]]} {}
4574 return $i
4577 proc initlayout {} {
4578 global rowidlist rowisopt rowfinal displayorder parentlist
4579 global numcommits canvxmax canv
4580 global nextcolor
4581 global colormap rowtextx
4583 set numcommits 0
4584 set displayorder {}
4585 set parentlist {}
4586 set nextcolor 0
4587 set rowidlist {}
4588 set rowisopt {}
4589 set rowfinal {}
4590 set canvxmax [$canv cget -width]
4591 catch {unset colormap}
4592 catch {unset rowtextx}
4593 setcanvscroll
4596 proc setcanvscroll {} {
4597 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4598 global lastscrollset lastscrollrows
4600 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4601 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4602 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4603 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4604 set lastscrollset [clock clicks -milliseconds]
4605 set lastscrollrows $numcommits
4608 proc visiblerows {} {
4609 global canv numcommits linespc
4611 set ymax [lindex [$canv cget -scrollregion] 3]
4612 if {$ymax eq {} || $ymax == 0} return
4613 set f [$canv yview]
4614 set y0 [expr {int([lindex $f 0] * $ymax)}]
4615 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4616 if {$r0 < 0} {
4617 set r0 0
4619 set y1 [expr {int([lindex $f 1] * $ymax)}]
4620 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4621 if {$r1 >= $numcommits} {
4622 set r1 [expr {$numcommits - 1}]
4624 return [list $r0 $r1]
4627 proc layoutmore {} {
4628 global commitidx viewcomplete curview
4629 global numcommits pending_select curview
4630 global lastscrollset lastscrollrows
4632 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4633 [clock clicks -milliseconds] - $lastscrollset > 500} {
4634 setcanvscroll
4636 if {[info exists pending_select] &&
4637 [commitinview $pending_select $curview]} {
4638 update
4639 selectline [rowofcommit $pending_select] 1
4641 drawvisible
4644 proc doshowlocalchanges {} {
4645 global curview mainheadid
4647 if {$mainheadid eq {}} return
4648 if {[commitinview $mainheadid $curview]} {
4649 dodiffindex
4650 } else {
4651 interestedin $mainheadid dodiffindex
4655 proc dohidelocalchanges {} {
4656 global nullid nullid2 lserial curview
4658 if {[commitinview $nullid $curview]} {
4659 removefakerow $nullid
4661 if {[commitinview $nullid2 $curview]} {
4662 removefakerow $nullid2
4664 incr lserial
4667 # spawn off a process to do git diff-index --cached HEAD
4668 proc dodiffindex {} {
4669 global lserial showlocalchanges
4670 global isworktree
4672 if {!$showlocalchanges || !$isworktree} return
4673 incr lserial
4674 set fd [open "|git diff-index --cached HEAD" r]
4675 fconfigure $fd -blocking 0
4676 set i [reg_instance $fd]
4677 filerun $fd [list readdiffindex $fd $lserial $i]
4680 proc readdiffindex {fd serial inst} {
4681 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4683 set isdiff 1
4684 if {[gets $fd line] < 0} {
4685 if {![eof $fd]} {
4686 return 1
4688 set isdiff 0
4690 # we only need to see one line and we don't really care what it says...
4691 stop_instance $inst
4693 if {$serial != $lserial} {
4694 return 0
4697 # now see if there are any local changes not checked in to the index
4698 set fd [open "|git diff-files" r]
4699 fconfigure $fd -blocking 0
4700 set i [reg_instance $fd]
4701 filerun $fd [list readdifffiles $fd $serial $i]
4703 if {$isdiff && ![commitinview $nullid2 $curview]} {
4704 # add the line for the changes in the index to the graph
4705 set hl [mc "Local changes checked in to index but not committed"]
4706 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4707 set commitdata($nullid2) "\n $hl\n"
4708 if {[commitinview $nullid $curview]} {
4709 removefakerow $nullid
4711 insertfakerow $nullid2 $mainheadid
4712 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4713 removefakerow $nullid2
4715 return 0
4718 proc readdifffiles {fd serial inst} {
4719 global mainheadid nullid nullid2 curview
4720 global commitinfo commitdata lserial
4722 set isdiff 1
4723 if {[gets $fd line] < 0} {
4724 if {![eof $fd]} {
4725 return 1
4727 set isdiff 0
4729 # we only need to see one line and we don't really care what it says...
4730 stop_instance $inst
4732 if {$serial != $lserial} {
4733 return 0
4736 if {$isdiff && ![commitinview $nullid $curview]} {
4737 # add the line for the local diff to the graph
4738 set hl [mc "Local uncommitted changes, not checked in to index"]
4739 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4740 set commitdata($nullid) "\n $hl\n"
4741 if {[commitinview $nullid2 $curview]} {
4742 set p $nullid2
4743 } else {
4744 set p $mainheadid
4746 insertfakerow $nullid $p
4747 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4748 removefakerow $nullid
4750 return 0
4753 proc nextuse {id row} {
4754 global curview children
4756 if {[info exists children($curview,$id)]} {
4757 foreach kid $children($curview,$id) {
4758 if {![commitinview $kid $curview]} {
4759 return -1
4761 if {[rowofcommit $kid] > $row} {
4762 return [rowofcommit $kid]
4766 if {[commitinview $id $curview]} {
4767 return [rowofcommit $id]
4769 return -1
4772 proc prevuse {id row} {
4773 global curview children
4775 set ret -1
4776 if {[info exists children($curview,$id)]} {
4777 foreach kid $children($curview,$id) {
4778 if {![commitinview $kid $curview]} break
4779 if {[rowofcommit $kid] < $row} {
4780 set ret [rowofcommit $kid]
4784 return $ret
4787 proc make_idlist {row} {
4788 global displayorder parentlist uparrowlen downarrowlen mingaplen
4789 global commitidx curview children
4791 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4792 if {$r < 0} {
4793 set r 0
4795 set ra [expr {$row - $downarrowlen}]
4796 if {$ra < 0} {
4797 set ra 0
4799 set rb [expr {$row + $uparrowlen}]
4800 if {$rb > $commitidx($curview)} {
4801 set rb $commitidx($curview)
4803 make_disporder $r [expr {$rb + 1}]
4804 set ids {}
4805 for {} {$r < $ra} {incr r} {
4806 set nextid [lindex $displayorder [expr {$r + 1}]]
4807 foreach p [lindex $parentlist $r] {
4808 if {$p eq $nextid} continue
4809 set rn [nextuse $p $r]
4810 if {$rn >= $row &&
4811 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4812 lappend ids [list [ordertoken $p] $p]
4816 for {} {$r < $row} {incr r} {
4817 set nextid [lindex $displayorder [expr {$r + 1}]]
4818 foreach p [lindex $parentlist $r] {
4819 if {$p eq $nextid} continue
4820 set rn [nextuse $p $r]
4821 if {$rn < 0 || $rn >= $row} {
4822 lappend ids [list [ordertoken $p] $p]
4826 set id [lindex $displayorder $row]
4827 lappend ids [list [ordertoken $id] $id]
4828 while {$r < $rb} {
4829 foreach p [lindex $parentlist $r] {
4830 set firstkid [lindex $children($curview,$p) 0]
4831 if {[rowofcommit $firstkid] < $row} {
4832 lappend ids [list [ordertoken $p] $p]
4835 incr r
4836 set id [lindex $displayorder $r]
4837 if {$id ne {}} {
4838 set firstkid [lindex $children($curview,$id) 0]
4839 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4840 lappend ids [list [ordertoken $id] $id]
4844 set idlist {}
4845 foreach idx [lsort -unique $ids] {
4846 lappend idlist [lindex $idx 1]
4848 return $idlist
4851 proc rowsequal {a b} {
4852 while {[set i [lsearch -exact $a {}]] >= 0} {
4853 set a [lreplace $a $i $i]
4855 while {[set i [lsearch -exact $b {}]] >= 0} {
4856 set b [lreplace $b $i $i]
4858 return [expr {$a eq $b}]
4861 proc makeupline {id row rend col} {
4862 global rowidlist uparrowlen downarrowlen mingaplen
4864 for {set r $rend} {1} {set r $rstart} {
4865 set rstart [prevuse $id $r]
4866 if {$rstart < 0} return
4867 if {$rstart < $row} break
4869 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4870 set rstart [expr {$rend - $uparrowlen - 1}]
4872 for {set r $rstart} {[incr r] <= $row} {} {
4873 set idlist [lindex $rowidlist $r]
4874 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4875 set col [idcol $idlist $id $col]
4876 lset rowidlist $r [linsert $idlist $col $id]
4877 changedrow $r
4882 proc layoutrows {row endrow} {
4883 global rowidlist rowisopt rowfinal displayorder
4884 global uparrowlen downarrowlen maxwidth mingaplen
4885 global children parentlist
4886 global commitidx viewcomplete curview
4888 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4889 set idlist {}
4890 if {$row > 0} {
4891 set rm1 [expr {$row - 1}]
4892 foreach id [lindex $rowidlist $rm1] {
4893 if {$id ne {}} {
4894 lappend idlist $id
4897 set final [lindex $rowfinal $rm1]
4899 for {} {$row < $endrow} {incr row} {
4900 set rm1 [expr {$row - 1}]
4901 if {$rm1 < 0 || $idlist eq {}} {
4902 set idlist [make_idlist $row]
4903 set final 1
4904 } else {
4905 set id [lindex $displayorder $rm1]
4906 set col [lsearch -exact $idlist $id]
4907 set idlist [lreplace $idlist $col $col]
4908 foreach p [lindex $parentlist $rm1] {
4909 if {[lsearch -exact $idlist $p] < 0} {
4910 set col [idcol $idlist $p $col]
4911 set idlist [linsert $idlist $col $p]
4912 # if not the first child, we have to insert a line going up
4913 if {$id ne [lindex $children($curview,$p) 0]} {
4914 makeupline $p $rm1 $row $col
4918 set id [lindex $displayorder $row]
4919 if {$row > $downarrowlen} {
4920 set termrow [expr {$row - $downarrowlen - 1}]
4921 foreach p [lindex $parentlist $termrow] {
4922 set i [lsearch -exact $idlist $p]
4923 if {$i < 0} continue
4924 set nr [nextuse $p $termrow]
4925 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4926 set idlist [lreplace $idlist $i $i]
4930 set col [lsearch -exact $idlist $id]
4931 if {$col < 0} {
4932 set col [idcol $idlist $id]
4933 set idlist [linsert $idlist $col $id]
4934 if {$children($curview,$id) ne {}} {
4935 makeupline $id $rm1 $row $col
4938 set r [expr {$row + $uparrowlen - 1}]
4939 if {$r < $commitidx($curview)} {
4940 set x $col
4941 foreach p [lindex $parentlist $r] {
4942 if {[lsearch -exact $idlist $p] >= 0} continue
4943 set fk [lindex $children($curview,$p) 0]
4944 if {[rowofcommit $fk] < $row} {
4945 set x [idcol $idlist $p $x]
4946 set idlist [linsert $idlist $x $p]
4949 if {[incr r] < $commitidx($curview)} {
4950 set p [lindex $displayorder $r]
4951 if {[lsearch -exact $idlist $p] < 0} {
4952 set fk [lindex $children($curview,$p) 0]
4953 if {$fk ne {} && [rowofcommit $fk] < $row} {
4954 set x [idcol $idlist $p $x]
4955 set idlist [linsert $idlist $x $p]
4961 if {$final && !$viewcomplete($curview) &&
4962 $row + $uparrowlen + $mingaplen + $downarrowlen
4963 >= $commitidx($curview)} {
4964 set final 0
4966 set l [llength $rowidlist]
4967 if {$row == $l} {
4968 lappend rowidlist $idlist
4969 lappend rowisopt 0
4970 lappend rowfinal $final
4971 } elseif {$row < $l} {
4972 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4973 lset rowidlist $row $idlist
4974 changedrow $row
4976 lset rowfinal $row $final
4977 } else {
4978 set pad [ntimes [expr {$row - $l}] {}]
4979 set rowidlist [concat $rowidlist $pad]
4980 lappend rowidlist $idlist
4981 set rowfinal [concat $rowfinal $pad]
4982 lappend rowfinal $final
4983 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4986 return $row
4989 proc changedrow {row} {
4990 global displayorder iddrawn rowisopt need_redisplay
4992 set l [llength $rowisopt]
4993 if {$row < $l} {
4994 lset rowisopt $row 0
4995 if {$row + 1 < $l} {
4996 lset rowisopt [expr {$row + 1}] 0
4997 if {$row + 2 < $l} {
4998 lset rowisopt [expr {$row + 2}] 0
5002 set id [lindex $displayorder $row]
5003 if {[info exists iddrawn($id)]} {
5004 set need_redisplay 1
5008 proc insert_pad {row col npad} {
5009 global rowidlist
5011 set pad [ntimes $npad {}]
5012 set idlist [lindex $rowidlist $row]
5013 set bef [lrange $idlist 0 [expr {$col - 1}]]
5014 set aft [lrange $idlist $col end]
5015 set i [lsearch -exact $aft {}]
5016 if {$i > 0} {
5017 set aft [lreplace $aft $i $i]
5019 lset rowidlist $row [concat $bef $pad $aft]
5020 changedrow $row
5023 proc optimize_rows {row col endrow} {
5024 global rowidlist rowisopt displayorder curview children
5026 if {$row < 1} {
5027 set row 1
5029 for {} {$row < $endrow} {incr row; set col 0} {
5030 if {[lindex $rowisopt $row]} continue
5031 set haspad 0
5032 set y0 [expr {$row - 1}]
5033 set ym [expr {$row - 2}]
5034 set idlist [lindex $rowidlist $row]
5035 set previdlist [lindex $rowidlist $y0]
5036 if {$idlist eq {} || $previdlist eq {}} continue
5037 if {$ym >= 0} {
5038 set pprevidlist [lindex $rowidlist $ym]
5039 if {$pprevidlist eq {}} continue
5040 } else {
5041 set pprevidlist {}
5043 set x0 -1
5044 set xm -1
5045 for {} {$col < [llength $idlist]} {incr col} {
5046 set id [lindex $idlist $col]
5047 if {[lindex $previdlist $col] eq $id} continue
5048 if {$id eq {}} {
5049 set haspad 1
5050 continue
5052 set x0 [lsearch -exact $previdlist $id]
5053 if {$x0 < 0} continue
5054 set z [expr {$x0 - $col}]
5055 set isarrow 0
5056 set z0 {}
5057 if {$ym >= 0} {
5058 set xm [lsearch -exact $pprevidlist $id]
5059 if {$xm >= 0} {
5060 set z0 [expr {$xm - $x0}]
5063 if {$z0 eq {}} {
5064 # if row y0 is the first child of $id then it's not an arrow
5065 if {[lindex $children($curview,$id) 0] ne
5066 [lindex $displayorder $y0]} {
5067 set isarrow 1
5070 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5071 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5072 set isarrow 1
5074 # Looking at lines from this row to the previous row,
5075 # make them go straight up if they end in an arrow on
5076 # the previous row; otherwise make them go straight up
5077 # or at 45 degrees.
5078 if {$z < -1 || ($z < 0 && $isarrow)} {
5079 # Line currently goes left too much;
5080 # insert pads in the previous row, then optimize it
5081 set npad [expr {-1 - $z + $isarrow}]
5082 insert_pad $y0 $x0 $npad
5083 if {$y0 > 0} {
5084 optimize_rows $y0 $x0 $row
5086 set previdlist [lindex $rowidlist $y0]
5087 set x0 [lsearch -exact $previdlist $id]
5088 set z [expr {$x0 - $col}]
5089 if {$z0 ne {}} {
5090 set pprevidlist [lindex $rowidlist $ym]
5091 set xm [lsearch -exact $pprevidlist $id]
5092 set z0 [expr {$xm - $x0}]
5094 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5095 # Line currently goes right too much;
5096 # insert pads in this line
5097 set npad [expr {$z - 1 + $isarrow}]
5098 insert_pad $row $col $npad
5099 set idlist [lindex $rowidlist $row]
5100 incr col $npad
5101 set z [expr {$x0 - $col}]
5102 set haspad 1
5104 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5105 # this line links to its first child on row $row-2
5106 set id [lindex $displayorder $ym]
5107 set xc [lsearch -exact $pprevidlist $id]
5108 if {$xc >= 0} {
5109 set z0 [expr {$xc - $x0}]
5112 # avoid lines jigging left then immediately right
5113 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5114 insert_pad $y0 $x0 1
5115 incr x0
5116 optimize_rows $y0 $x0 $row
5117 set previdlist [lindex $rowidlist $y0]
5120 if {!$haspad} {
5121 # Find the first column that doesn't have a line going right
5122 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5123 set id [lindex $idlist $col]
5124 if {$id eq {}} break
5125 set x0 [lsearch -exact $previdlist $id]
5126 if {$x0 < 0} {
5127 # check if this is the link to the first child
5128 set kid [lindex $displayorder $y0]
5129 if {[lindex $children($curview,$id) 0] eq $kid} {
5130 # it is, work out offset to child
5131 set x0 [lsearch -exact $previdlist $kid]
5134 if {$x0 <= $col} break
5136 # Insert a pad at that column as long as it has a line and
5137 # isn't the last column
5138 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5139 set idlist [linsert $idlist $col {}]
5140 lset rowidlist $row $idlist
5141 changedrow $row
5147 proc xc {row col} {
5148 global canvx0 linespc
5149 return [expr {$canvx0 + $col * $linespc}]
5152 proc yc {row} {
5153 global canvy0 linespc
5154 return [expr {$canvy0 + $row * $linespc}]
5157 proc linewidth {id} {
5158 global thickerline lthickness
5160 set wid $lthickness
5161 if {[info exists thickerline] && $id eq $thickerline} {
5162 set wid [expr {2 * $lthickness}]
5164 return $wid
5167 proc rowranges {id} {
5168 global curview children uparrowlen downarrowlen
5169 global rowidlist
5171 set kids $children($curview,$id)
5172 if {$kids eq {}} {
5173 return {}
5175 set ret {}
5176 lappend kids $id
5177 foreach child $kids {
5178 if {![commitinview $child $curview]} break
5179 set row [rowofcommit $child]
5180 if {![info exists prev]} {
5181 lappend ret [expr {$row + 1}]
5182 } else {
5183 if {$row <= $prevrow} {
5184 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5186 # see if the line extends the whole way from prevrow to row
5187 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5188 [lsearch -exact [lindex $rowidlist \
5189 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5190 # it doesn't, see where it ends
5191 set r [expr {$prevrow + $downarrowlen}]
5192 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5193 while {[incr r -1] > $prevrow &&
5194 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5195 } else {
5196 while {[incr r] <= $row &&
5197 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5198 incr r -1
5200 lappend ret $r
5201 # see where it starts up again
5202 set r [expr {$row - $uparrowlen}]
5203 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5204 while {[incr r] < $row &&
5205 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5206 } else {
5207 while {[incr r -1] >= $prevrow &&
5208 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5209 incr r
5211 lappend ret $r
5214 if {$child eq $id} {
5215 lappend ret $row
5217 set prev $child
5218 set prevrow $row
5220 return $ret
5223 proc drawlineseg {id row endrow arrowlow} {
5224 global rowidlist displayorder iddrawn linesegs
5225 global canv colormap linespc curview maxlinelen parentlist
5227 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5228 set le [expr {$row + 1}]
5229 set arrowhigh 1
5230 while {1} {
5231 set c [lsearch -exact [lindex $rowidlist $le] $id]
5232 if {$c < 0} {
5233 incr le -1
5234 break
5236 lappend cols $c
5237 set x [lindex $displayorder $le]
5238 if {$x eq $id} {
5239 set arrowhigh 0
5240 break
5242 if {[info exists iddrawn($x)] || $le == $endrow} {
5243 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5244 if {$c >= 0} {
5245 lappend cols $c
5246 set arrowhigh 0
5248 break
5250 incr le
5252 if {$le <= $row} {
5253 return $row
5256 set lines {}
5257 set i 0
5258 set joinhigh 0
5259 if {[info exists linesegs($id)]} {
5260 set lines $linesegs($id)
5261 foreach li $lines {
5262 set r0 [lindex $li 0]
5263 if {$r0 > $row} {
5264 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5265 set joinhigh 1
5267 break
5269 incr i
5272 set joinlow 0
5273 if {$i > 0} {
5274 set li [lindex $lines [expr {$i-1}]]
5275 set r1 [lindex $li 1]
5276 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5277 set joinlow 1
5281 set x [lindex $cols [expr {$le - $row}]]
5282 set xp [lindex $cols [expr {$le - 1 - $row}]]
5283 set dir [expr {$xp - $x}]
5284 if {$joinhigh} {
5285 set ith [lindex $lines $i 2]
5286 set coords [$canv coords $ith]
5287 set ah [$canv itemcget $ith -arrow]
5288 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5289 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5290 if {$x2 ne {} && $x - $x2 == $dir} {
5291 set coords [lrange $coords 0 end-2]
5293 } else {
5294 set coords [list [xc $le $x] [yc $le]]
5296 if {$joinlow} {
5297 set itl [lindex $lines [expr {$i-1}] 2]
5298 set al [$canv itemcget $itl -arrow]
5299 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5300 } elseif {$arrowlow} {
5301 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5302 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5303 set arrowlow 0
5306 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5307 for {set y $le} {[incr y -1] > $row} {} {
5308 set x $xp
5309 set xp [lindex $cols [expr {$y - 1 - $row}]]
5310 set ndir [expr {$xp - $x}]
5311 if {$dir != $ndir || $xp < 0} {
5312 lappend coords [xc $y $x] [yc $y]
5314 set dir $ndir
5316 if {!$joinlow} {
5317 if {$xp < 0} {
5318 # join parent line to first child
5319 set ch [lindex $displayorder $row]
5320 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5321 if {$xc < 0} {
5322 puts "oops: drawlineseg: child $ch not on row $row"
5323 } elseif {$xc != $x} {
5324 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5325 set d [expr {int(0.5 * $linespc)}]
5326 set x1 [xc $row $x]
5327 if {$xc < $x} {
5328 set x2 [expr {$x1 - $d}]
5329 } else {
5330 set x2 [expr {$x1 + $d}]
5332 set y2 [yc $row]
5333 set y1 [expr {$y2 + $d}]
5334 lappend coords $x1 $y1 $x2 $y2
5335 } elseif {$xc < $x - 1} {
5336 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5337 } elseif {$xc > $x + 1} {
5338 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5340 set x $xc
5342 lappend coords [xc $row $x] [yc $row]
5343 } else {
5344 set xn [xc $row $xp]
5345 set yn [yc $row]
5346 lappend coords $xn $yn
5348 if {!$joinhigh} {
5349 assigncolor $id
5350 set t [$canv create line $coords -width [linewidth $id] \
5351 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5352 $canv lower $t
5353 bindline $t $id
5354 set lines [linsert $lines $i [list $row $le $t]]
5355 } else {
5356 $canv coords $ith $coords
5357 if {$arrow ne $ah} {
5358 $canv itemconf $ith -arrow $arrow
5360 lset lines $i 0 $row
5362 } else {
5363 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5364 set ndir [expr {$xo - $xp}]
5365 set clow [$canv coords $itl]
5366 if {$dir == $ndir} {
5367 set clow [lrange $clow 2 end]
5369 set coords [concat $coords $clow]
5370 if {!$joinhigh} {
5371 lset lines [expr {$i-1}] 1 $le
5372 } else {
5373 # coalesce two pieces
5374 $canv delete $ith
5375 set b [lindex $lines [expr {$i-1}] 0]
5376 set e [lindex $lines $i 1]
5377 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5379 $canv coords $itl $coords
5380 if {$arrow ne $al} {
5381 $canv itemconf $itl -arrow $arrow
5385 set linesegs($id) $lines
5386 return $le
5389 proc drawparentlinks {id row} {
5390 global rowidlist canv colormap curview parentlist
5391 global idpos linespc
5393 set rowids [lindex $rowidlist $row]
5394 set col [lsearch -exact $rowids $id]
5395 if {$col < 0} return
5396 set olds [lindex $parentlist $row]
5397 set row2 [expr {$row + 1}]
5398 set x [xc $row $col]
5399 set y [yc $row]
5400 set y2 [yc $row2]
5401 set d [expr {int(0.5 * $linespc)}]
5402 set ymid [expr {$y + $d}]
5403 set ids [lindex $rowidlist $row2]
5404 # rmx = right-most X coord used
5405 set rmx 0
5406 foreach p $olds {
5407 set i [lsearch -exact $ids $p]
5408 if {$i < 0} {
5409 puts "oops, parent $p of $id not in list"
5410 continue
5412 set x2 [xc $row2 $i]
5413 if {$x2 > $rmx} {
5414 set rmx $x2
5416 set j [lsearch -exact $rowids $p]
5417 if {$j < 0} {
5418 # drawlineseg will do this one for us
5419 continue
5421 assigncolor $p
5422 # should handle duplicated parents here...
5423 set coords [list $x $y]
5424 if {$i != $col} {
5425 # if attaching to a vertical segment, draw a smaller
5426 # slant for visual distinctness
5427 if {$i == $j} {
5428 if {$i < $col} {
5429 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5430 } else {
5431 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5433 } elseif {$i < $col && $i < $j} {
5434 # segment slants towards us already
5435 lappend coords [xc $row $j] $y
5436 } else {
5437 if {$i < $col - 1} {
5438 lappend coords [expr {$x2 + $linespc}] $y
5439 } elseif {$i > $col + 1} {
5440 lappend coords [expr {$x2 - $linespc}] $y
5442 lappend coords $x2 $y2
5444 } else {
5445 lappend coords $x2 $y2
5447 set t [$canv create line $coords -width [linewidth $p] \
5448 -fill $colormap($p) -tags lines.$p]
5449 $canv lower $t
5450 bindline $t $p
5452 if {$rmx > [lindex $idpos($id) 1]} {
5453 lset idpos($id) 1 $rmx
5454 redrawtags $id
5458 proc drawlines {id} {
5459 global canv
5461 $canv itemconf lines.$id -width [linewidth $id]
5464 proc drawcmittext {id row col} {
5465 global linespc canv canv2 canv3 fgcolor curview
5466 global cmitlisted commitinfo rowidlist parentlist
5467 global rowtextx idpos idtags idheads idotherrefs
5468 global linehtag linentag linedtag selectedline
5469 global canvxmax boldrows boldnamerows fgcolor
5470 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5472 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5473 set listed $cmitlisted($curview,$id)
5474 if {$id eq $nullid} {
5475 set ofill red
5476 } elseif {$id eq $nullid2} {
5477 set ofill green
5478 } elseif {$id eq $mainheadid} {
5479 set ofill yellow
5480 } else {
5481 set ofill [lindex $circlecolors $listed]
5483 set x [xc $row $col]
5484 set y [yc $row]
5485 set orad [expr {$linespc / 3}]
5486 if {$listed <= 2} {
5487 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5488 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5489 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5490 } elseif {$listed == 3} {
5491 # triangle pointing left for left-side commits
5492 set t [$canv create polygon \
5493 [expr {$x - $orad}] $y \
5494 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5495 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5496 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5497 } else {
5498 # triangle pointing right for right-side commits
5499 set t [$canv create polygon \
5500 [expr {$x + $orad - 1}] $y \
5501 [expr {$x - $orad}] [expr {$y - $orad}] \
5502 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5503 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5505 set circleitem($row) $t
5506 $canv raise $t
5507 $canv bind $t <1> {selcanvline {} %x %y}
5508 set rmx [llength [lindex $rowidlist $row]]
5509 set olds [lindex $parentlist $row]
5510 if {$olds ne {}} {
5511 set nextids [lindex $rowidlist [expr {$row + 1}]]
5512 foreach p $olds {
5513 set i [lsearch -exact $nextids $p]
5514 if {$i > $rmx} {
5515 set rmx $i
5519 set xt [xc $row $rmx]
5520 set rowtextx($row) $xt
5521 set idpos($id) [list $x $xt $y]
5522 if {[info exists idtags($id)] || [info exists idheads($id)]
5523 || [info exists idotherrefs($id)]} {
5524 set xt [drawtags $id $x $xt $y]
5526 set headline [lindex $commitinfo($id) 0]
5527 set name [lindex $commitinfo($id) 1]
5528 set date [lindex $commitinfo($id) 2]
5529 set date [formatdate $date]
5530 set font mainfont
5531 set nfont mainfont
5532 set isbold [ishighlighted $id]
5533 if {$isbold > 0} {
5534 lappend boldrows $row
5535 set font mainfontbold
5536 if {$isbold > 1} {
5537 lappend boldnamerows $row
5538 set nfont mainfontbold
5541 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
5542 -text $headline -font $font -tags text]
5543 $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
5544 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5545 -text $name -font $nfont -tags text]
5546 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5547 -text $date -font mainfont -tags text]
5548 if {$selectedline == $row} {
5549 make_secsel $row
5551 set xr [expr {$xt + [font measure $font $headline]}]
5552 if {$xr > $canvxmax} {
5553 set canvxmax $xr
5554 setcanvscroll
5558 proc drawcmitrow {row} {
5559 global displayorder rowidlist nrows_drawn
5560 global iddrawn markingmatches
5561 global commitinfo numcommits
5562 global filehighlight fhighlights findpattern nhighlights
5563 global hlview vhighlights
5564 global highlight_related rhighlights
5566 if {$row >= $numcommits} return
5568 set id [lindex $displayorder $row]
5569 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5570 askvhighlight $row $id
5572 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5573 askfilehighlight $row $id
5575 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5576 askfindhighlight $row $id
5578 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5579 askrelhighlight $row $id
5581 if {![info exists iddrawn($id)]} {
5582 set col [lsearch -exact [lindex $rowidlist $row] $id]
5583 if {$col < 0} {
5584 puts "oops, row $row id $id not in list"
5585 return
5587 if {![info exists commitinfo($id)]} {
5588 getcommit $id
5590 assigncolor $id
5591 drawcmittext $id $row $col
5592 set iddrawn($id) 1
5593 incr nrows_drawn
5595 if {$markingmatches} {
5596 markrowmatches $row $id
5600 proc drawcommits {row {endrow {}}} {
5601 global numcommits iddrawn displayorder curview need_redisplay
5602 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5604 if {$row < 0} {
5605 set row 0
5607 if {$endrow eq {}} {
5608 set endrow $row
5610 if {$endrow >= $numcommits} {
5611 set endrow [expr {$numcommits - 1}]
5614 set rl1 [expr {$row - $downarrowlen - 3}]
5615 if {$rl1 < 0} {
5616 set rl1 0
5618 set ro1 [expr {$row - 3}]
5619 if {$ro1 < 0} {
5620 set ro1 0
5622 set r2 [expr {$endrow + $uparrowlen + 3}]
5623 if {$r2 > $numcommits} {
5624 set r2 $numcommits
5626 for {set r $rl1} {$r < $r2} {incr r} {
5627 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5628 if {$rl1 < $r} {
5629 layoutrows $rl1 $r
5631 set rl1 [expr {$r + 1}]
5634 if {$rl1 < $r} {
5635 layoutrows $rl1 $r
5637 optimize_rows $ro1 0 $r2
5638 if {$need_redisplay || $nrows_drawn > 2000} {
5639 clear_display
5640 drawvisible
5643 # make the lines join to already-drawn rows either side
5644 set r [expr {$row - 1}]
5645 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5646 set r $row
5648 set er [expr {$endrow + 1}]
5649 if {$er >= $numcommits ||
5650 ![info exists iddrawn([lindex $displayorder $er])]} {
5651 set er $endrow
5653 for {} {$r <= $er} {incr r} {
5654 set id [lindex $displayorder $r]
5655 set wasdrawn [info exists iddrawn($id)]
5656 drawcmitrow $r
5657 if {$r == $er} break
5658 set nextid [lindex $displayorder [expr {$r + 1}]]
5659 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5660 drawparentlinks $id $r
5662 set rowids [lindex $rowidlist $r]
5663 foreach lid $rowids {
5664 if {$lid eq {}} continue
5665 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5666 if {$lid eq $id} {
5667 # see if this is the first child of any of its parents
5668 foreach p [lindex $parentlist $r] {
5669 if {[lsearch -exact $rowids $p] < 0} {
5670 # make this line extend up to the child
5671 set lineend($p) [drawlineseg $p $r $er 0]
5674 } else {
5675 set lineend($lid) [drawlineseg $lid $r $er 1]
5681 proc undolayout {row} {
5682 global uparrowlen mingaplen downarrowlen
5683 global rowidlist rowisopt rowfinal need_redisplay
5685 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5686 if {$r < 0} {
5687 set r 0
5689 if {[llength $rowidlist] > $r} {
5690 incr r -1
5691 set rowidlist [lrange $rowidlist 0 $r]
5692 set rowfinal [lrange $rowfinal 0 $r]
5693 set rowisopt [lrange $rowisopt 0 $r]
5694 set need_redisplay 1
5695 run drawvisible
5699 proc drawvisible {} {
5700 global canv linespc curview vrowmod selectedline targetrow targetid
5701 global need_redisplay cscroll numcommits
5703 set fs [$canv yview]
5704 set ymax [lindex [$canv cget -scrollregion] 3]
5705 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5706 set f0 [lindex $fs 0]
5707 set f1 [lindex $fs 1]
5708 set y0 [expr {int($f0 * $ymax)}]
5709 set y1 [expr {int($f1 * $ymax)}]
5711 if {[info exists targetid]} {
5712 if {[commitinview $targetid $curview]} {
5713 set r [rowofcommit $targetid]
5714 if {$r != $targetrow} {
5715 # Fix up the scrollregion and change the scrolling position
5716 # now that our target row has moved.
5717 set diff [expr {($r - $targetrow) * $linespc}]
5718 set targetrow $r
5719 setcanvscroll
5720 set ymax [lindex [$canv cget -scrollregion] 3]
5721 incr y0 $diff
5722 incr y1 $diff
5723 set f0 [expr {$y0 / $ymax}]
5724 set f1 [expr {$y1 / $ymax}]
5725 allcanvs yview moveto $f0
5726 $cscroll set $f0 $f1
5727 set need_redisplay 1
5729 } else {
5730 unset targetid
5734 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5735 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5736 if {$endrow >= $vrowmod($curview)} {
5737 update_arcrows $curview
5739 if {$selectedline ne {} &&
5740 $row <= $selectedline && $selectedline <= $endrow} {
5741 set targetrow $selectedline
5742 } elseif {[info exists targetid]} {
5743 set targetrow [expr {int(($row + $endrow) / 2)}]
5745 if {[info exists targetrow]} {
5746 if {$targetrow >= $numcommits} {
5747 set targetrow [expr {$numcommits - 1}]
5749 set targetid [commitonrow $targetrow]
5751 drawcommits $row $endrow
5754 proc clear_display {} {
5755 global iddrawn linesegs need_redisplay nrows_drawn
5756 global vhighlights fhighlights nhighlights rhighlights
5757 global linehtag linentag linedtag boldrows boldnamerows
5759 allcanvs delete all
5760 catch {unset iddrawn}
5761 catch {unset linesegs}
5762 catch {unset linehtag}
5763 catch {unset linentag}
5764 catch {unset linedtag}
5765 set boldrows {}
5766 set boldnamerows {}
5767 catch {unset vhighlights}
5768 catch {unset fhighlights}
5769 catch {unset nhighlights}
5770 catch {unset rhighlights}
5771 set need_redisplay 0
5772 set nrows_drawn 0
5775 proc findcrossings {id} {
5776 global rowidlist parentlist numcommits displayorder
5778 set cross {}
5779 set ccross {}
5780 foreach {s e} [rowranges $id] {
5781 if {$e >= $numcommits} {
5782 set e [expr {$numcommits - 1}]
5784 if {$e <= $s} continue
5785 for {set row $e} {[incr row -1] >= $s} {} {
5786 set x [lsearch -exact [lindex $rowidlist $row] $id]
5787 if {$x < 0} break
5788 set olds [lindex $parentlist $row]
5789 set kid [lindex $displayorder $row]
5790 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5791 if {$kidx < 0} continue
5792 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5793 foreach p $olds {
5794 set px [lsearch -exact $nextrow $p]
5795 if {$px < 0} continue
5796 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5797 if {[lsearch -exact $ccross $p] >= 0} continue
5798 if {$x == $px + ($kidx < $px? -1: 1)} {
5799 lappend ccross $p
5800 } elseif {[lsearch -exact $cross $p] < 0} {
5801 lappend cross $p
5807 return [concat $ccross {{}} $cross]
5810 proc assigncolor {id} {
5811 global colormap colors nextcolor
5812 global parents children children curview
5814 if {[info exists colormap($id)]} return
5815 set ncolors [llength $colors]
5816 if {[info exists children($curview,$id)]} {
5817 set kids $children($curview,$id)
5818 } else {
5819 set kids {}
5821 if {[llength $kids] == 1} {
5822 set child [lindex $kids 0]
5823 if {[info exists colormap($child)]
5824 && [llength $parents($curview,$child)] == 1} {
5825 set colormap($id) $colormap($child)
5826 return
5829 set badcolors {}
5830 set origbad {}
5831 foreach x [findcrossings $id] {
5832 if {$x eq {}} {
5833 # delimiter between corner crossings and other crossings
5834 if {[llength $badcolors] >= $ncolors - 1} break
5835 set origbad $badcolors
5837 if {[info exists colormap($x)]
5838 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5839 lappend badcolors $colormap($x)
5842 if {[llength $badcolors] >= $ncolors} {
5843 set badcolors $origbad
5845 set origbad $badcolors
5846 if {[llength $badcolors] < $ncolors - 1} {
5847 foreach child $kids {
5848 if {[info exists colormap($child)]
5849 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5850 lappend badcolors $colormap($child)
5852 foreach p $parents($curview,$child) {
5853 if {[info exists colormap($p)]
5854 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5855 lappend badcolors $colormap($p)
5859 if {[llength $badcolors] >= $ncolors} {
5860 set badcolors $origbad
5863 for {set i 0} {$i <= $ncolors} {incr i} {
5864 set c [lindex $colors $nextcolor]
5865 if {[incr nextcolor] >= $ncolors} {
5866 set nextcolor 0
5868 if {[lsearch -exact $badcolors $c]} break
5870 set colormap($id) $c
5873 proc bindline {t id} {
5874 global canv
5876 $canv bind $t <Enter> "lineenter %x %y $id"
5877 $canv bind $t <Motion> "linemotion %x %y $id"
5878 $canv bind $t <Leave> "lineleave $id"
5879 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5882 proc drawtags {id x xt y1} {
5883 global idtags idheads idotherrefs mainhead
5884 global linespc lthickness
5885 global canv rowtextx curview fgcolor bgcolor ctxbut
5887 set marks {}
5888 set ntags 0
5889 set nheads 0
5890 if {[info exists idtags($id)]} {
5891 set marks $idtags($id)
5892 set ntags [llength $marks]
5894 if {[info exists idheads($id)]} {
5895 set marks [concat $marks $idheads($id)]
5896 set nheads [llength $idheads($id)]
5898 if {[info exists idotherrefs($id)]} {
5899 set marks [concat $marks $idotherrefs($id)]
5901 if {$marks eq {}} {
5902 return $xt
5905 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5906 set yt [expr {$y1 - 0.5 * $linespc}]
5907 set yb [expr {$yt + $linespc - 1}]
5908 set xvals {}
5909 set wvals {}
5910 set i -1
5911 foreach tag $marks {
5912 incr i
5913 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5914 set wid [font measure mainfontbold $tag]
5915 } else {
5916 set wid [font measure mainfont $tag]
5918 lappend xvals $xt
5919 lappend wvals $wid
5920 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5922 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5923 -width $lthickness -fill black -tags tag.$id]
5924 $canv lower $t
5925 foreach tag $marks x $xvals wid $wvals {
5926 set xl [expr {$x + $delta}]
5927 set xr [expr {$x + $delta + $wid + $lthickness}]
5928 set font mainfont
5929 if {[incr ntags -1] >= 0} {
5930 # draw a tag
5931 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5932 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5933 -width 1 -outline black -fill yellow -tags tag.$id]
5934 $canv bind $t <1> [list showtag $tag 1]
5935 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5936 } else {
5937 # draw a head or other ref
5938 if {[incr nheads -1] >= 0} {
5939 set col green
5940 if {$tag eq $mainhead} {
5941 set font mainfontbold
5943 } else {
5944 set col "#ddddff"
5946 set xl [expr {$xl - $delta/2}]
5947 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5948 -width 1 -outline black -fill $col -tags tag.$id
5949 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5950 set rwid [font measure mainfont $remoteprefix]
5951 set xi [expr {$x + 1}]
5952 set yti [expr {$yt + 1}]
5953 set xri [expr {$x + $rwid}]
5954 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5955 -width 0 -fill "#ffddaa" -tags tag.$id
5958 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5959 -font $font -tags [list tag.$id text]]
5960 if {$ntags >= 0} {
5961 $canv bind $t <1> [list showtag $tag 1]
5962 } elseif {$nheads >= 0} {
5963 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5966 return $xt
5969 proc xcoord {i level ln} {
5970 global canvx0 xspc1 xspc2
5972 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5973 if {$i > 0 && $i == $level} {
5974 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5975 } elseif {$i > $level} {
5976 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5978 return $x
5981 proc show_status {msg} {
5982 global canv fgcolor
5984 clear_display
5985 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5986 -tags text -fill $fgcolor
5989 # Don't change the text pane cursor if it is currently the hand cursor,
5990 # showing that we are over a sha1 ID link.
5991 proc settextcursor {c} {
5992 global ctext curtextcursor
5994 if {[$ctext cget -cursor] == $curtextcursor} {
5995 $ctext config -cursor $c
5997 set curtextcursor $c
6000 proc nowbusy {what {name {}}} {
6001 global isbusy busyname statusw
6003 if {[array names isbusy] eq {}} {
6004 . config -cursor watch
6005 settextcursor watch
6007 set isbusy($what) 1
6008 set busyname($what) $name
6009 if {$name ne {}} {
6010 $statusw conf -text $name
6014 proc notbusy {what} {
6015 global isbusy maincursor textcursor busyname statusw
6017 catch {
6018 unset isbusy($what)
6019 if {$busyname($what) ne {} &&
6020 [$statusw cget -text] eq $busyname($what)} {
6021 $statusw conf -text {}
6024 if {[array names isbusy] eq {}} {
6025 . config -cursor $maincursor
6026 settextcursor $textcursor
6030 proc findmatches {f} {
6031 global findtype findstring
6032 if {$findtype == [mc "Regexp"]} {
6033 set matches [regexp -indices -all -inline $findstring $f]
6034 } else {
6035 set fs $findstring
6036 if {$findtype == [mc "IgnCase"]} {
6037 set f [string tolower $f]
6038 set fs [string tolower $fs]
6040 set matches {}
6041 set i 0
6042 set l [string length $fs]
6043 while {[set j [string first $fs $f $i]] >= 0} {
6044 lappend matches [list $j [expr {$j+$l-1}]]
6045 set i [expr {$j + $l}]
6048 return $matches
6051 proc dofind {{dirn 1} {wrap 1}} {
6052 global findstring findstartline findcurline selectedline numcommits
6053 global gdttype filehighlight fh_serial find_dirn findallowwrap
6055 if {[info exists find_dirn]} {
6056 if {$find_dirn == $dirn} return
6057 stopfinding
6059 focus .
6060 if {$findstring eq {} || $numcommits == 0} return
6061 if {$selectedline eq {}} {
6062 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6063 } else {
6064 set findstartline $selectedline
6066 set findcurline $findstartline
6067 nowbusy finding [mc "Searching"]
6068 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6069 after cancel do_file_hl $fh_serial
6070 do_file_hl $fh_serial
6072 set find_dirn $dirn
6073 set findallowwrap $wrap
6074 run findmore
6077 proc stopfinding {} {
6078 global find_dirn findcurline fprogcoord
6080 if {[info exists find_dirn]} {
6081 unset find_dirn
6082 unset findcurline
6083 notbusy finding
6084 set fprogcoord 0
6085 adjustprogress
6087 stopblaming
6090 proc findmore {} {
6091 global commitdata commitinfo numcommits findpattern findloc
6092 global findstartline findcurline findallowwrap
6093 global find_dirn gdttype fhighlights fprogcoord
6094 global curview varcorder vrownum varccommits vrowmod
6096 if {![info exists find_dirn]} {
6097 return 0
6099 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6100 set l $findcurline
6101 set moretodo 0
6102 if {$find_dirn > 0} {
6103 incr l
6104 if {$l >= $numcommits} {
6105 set l 0
6107 if {$l <= $findstartline} {
6108 set lim [expr {$findstartline + 1}]
6109 } else {
6110 set lim $numcommits
6111 set moretodo $findallowwrap
6113 } else {
6114 if {$l == 0} {
6115 set l $numcommits
6117 incr l -1
6118 if {$l >= $findstartline} {
6119 set lim [expr {$findstartline - 1}]
6120 } else {
6121 set lim -1
6122 set moretodo $findallowwrap
6125 set n [expr {($lim - $l) * $find_dirn}]
6126 if {$n > 500} {
6127 set n 500
6128 set moretodo 1
6130 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6131 update_arcrows $curview
6133 set found 0
6134 set domore 1
6135 set ai [bsearch $vrownum($curview) $l]
6136 set a [lindex $varcorder($curview) $ai]
6137 set arow [lindex $vrownum($curview) $ai]
6138 set ids [lindex $varccommits($curview,$a)]
6139 set arowend [expr {$arow + [llength $ids]}]
6140 if {$gdttype eq [mc "containing:"]} {
6141 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6142 if {$l < $arow || $l >= $arowend} {
6143 incr ai $find_dirn
6144 set a [lindex $varcorder($curview) $ai]
6145 set arow [lindex $vrownum($curview) $ai]
6146 set ids [lindex $varccommits($curview,$a)]
6147 set arowend [expr {$arow + [llength $ids]}]
6149 set id [lindex $ids [expr {$l - $arow}]]
6150 # shouldn't happen unless git log doesn't give all the commits...
6151 if {![info exists commitdata($id)] ||
6152 ![doesmatch $commitdata($id)]} {
6153 continue
6155 if {![info exists commitinfo($id)]} {
6156 getcommit $id
6158 set info $commitinfo($id)
6159 foreach f $info ty $fldtypes {
6160 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6161 [doesmatch $f]} {
6162 set found 1
6163 break
6166 if {$found} break
6168 } else {
6169 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6170 if {$l < $arow || $l >= $arowend} {
6171 incr ai $find_dirn
6172 set a [lindex $varcorder($curview) $ai]
6173 set arow [lindex $vrownum($curview) $ai]
6174 set ids [lindex $varccommits($curview,$a)]
6175 set arowend [expr {$arow + [llength $ids]}]
6177 set id [lindex $ids [expr {$l - $arow}]]
6178 if {![info exists fhighlights($id)]} {
6179 # this sets fhighlights($id) to -1
6180 askfilehighlight $l $id
6182 if {$fhighlights($id) > 0} {
6183 set found $domore
6184 break
6186 if {$fhighlights($id) < 0} {
6187 if {$domore} {
6188 set domore 0
6189 set findcurline [expr {$l - $find_dirn}]
6194 if {$found || ($domore && !$moretodo)} {
6195 unset findcurline
6196 unset find_dirn
6197 notbusy finding
6198 set fprogcoord 0
6199 adjustprogress
6200 if {$found} {
6201 findselectline $l
6202 } else {
6203 bell
6205 return 0
6207 if {!$domore} {
6208 flushhighlights
6209 } else {
6210 set findcurline [expr {$l - $find_dirn}]
6212 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6213 if {$n < 0} {
6214 incr n $numcommits
6216 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6217 adjustprogress
6218 return $domore
6221 proc findselectline {l} {
6222 global findloc commentend ctext findcurline markingmatches gdttype
6224 set markingmatches 1
6225 set findcurline $l
6226 selectline $l 1
6227 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
6228 # highlight the matches in the comments
6229 set f [$ctext get 1.0 $commentend]
6230 set matches [findmatches $f]
6231 foreach match $matches {
6232 set start [lindex $match 0]
6233 set end [expr {[lindex $match 1] + 1}]
6234 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6237 drawvisible
6240 # mark the bits of a headline or author that match a find string
6241 proc markmatches {canv l str tag matches font row} {
6242 global selectedline
6244 set bbox [$canv bbox $tag]
6245 set x0 [lindex $bbox 0]
6246 set y0 [lindex $bbox 1]
6247 set y1 [lindex $bbox 3]
6248 foreach match $matches {
6249 set start [lindex $match 0]
6250 set end [lindex $match 1]
6251 if {$start > $end} continue
6252 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6253 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6254 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6255 [expr {$x0+$xlen+2}] $y1 \
6256 -outline {} -tags [list match$l matches] -fill yellow]
6257 $canv lower $t
6258 if {$row == $selectedline} {
6259 $canv raise $t secsel
6264 proc unmarkmatches {} {
6265 global markingmatches
6267 allcanvs delete matches
6268 set markingmatches 0
6269 stopfinding
6272 proc selcanvline {w x y} {
6273 global canv canvy0 ctext linespc
6274 global rowtextx
6275 set ymax [lindex [$canv cget -scrollregion] 3]
6276 if {$ymax == {}} return
6277 set yfrac [lindex [$canv yview] 0]
6278 set y [expr {$y + $yfrac * $ymax}]
6279 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6280 if {$l < 0} {
6281 set l 0
6283 if {$w eq $canv} {
6284 set xmax [lindex [$canv cget -scrollregion] 2]
6285 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6286 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6288 unmarkmatches
6289 selectline $l 1
6292 proc commit_descriptor {p} {
6293 global commitinfo
6294 if {![info exists commitinfo($p)]} {
6295 getcommit $p
6297 set l "..."
6298 if {[llength $commitinfo($p)] > 1} {
6299 set l [lindex $commitinfo($p) 0]
6301 return "$p ($l)\n"
6304 # append some text to the ctext widget, and make any SHA1 ID
6305 # that we know about be a clickable link.
6306 proc appendwithlinks {text tags} {
6307 global ctext linknum curview
6309 set start [$ctext index "end - 1c"]
6310 $ctext insert end $text $tags
6311 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6312 foreach l $links {
6313 set s [lindex $l 0]
6314 set e [lindex $l 1]
6315 set linkid [string range $text $s $e]
6316 incr e
6317 $ctext tag delete link$linknum
6318 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6319 setlink $linkid link$linknum
6320 incr linknum
6324 proc setlink {id lk} {
6325 global curview ctext pendinglinks
6327 set known 0
6328 if {[string length $id] < 40} {
6329 set matches [longid $id]
6330 if {[llength $matches] > 0} {
6331 if {[llength $matches] > 1} return
6332 set known 1
6333 set id [lindex $matches 0]
6335 } else {
6336 set known [commitinview $id $curview]
6338 if {$known} {
6339 $ctext tag conf $lk -foreground blue -underline 1
6340 $ctext tag bind $lk <1> [list selbyid $id]
6341 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6342 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6343 } else {
6344 lappend pendinglinks($id) $lk
6345 interestedin $id {makelink %P}
6349 proc makelink {id} {
6350 global pendinglinks
6352 if {![info exists pendinglinks($id)]} return
6353 foreach lk $pendinglinks($id) {
6354 setlink $id $lk
6356 unset pendinglinks($id)
6359 proc linkcursor {w inc} {
6360 global linkentercount curtextcursor
6362 if {[incr linkentercount $inc] > 0} {
6363 $w configure -cursor hand2
6364 } else {
6365 $w configure -cursor $curtextcursor
6366 if {$linkentercount < 0} {
6367 set linkentercount 0
6372 proc viewnextline {dir} {
6373 global canv linespc
6375 $canv delete hover
6376 set ymax [lindex [$canv cget -scrollregion] 3]
6377 set wnow [$canv yview]
6378 set wtop [expr {[lindex $wnow 0] * $ymax}]
6379 set newtop [expr {$wtop + $dir * $linespc}]
6380 if {$newtop < 0} {
6381 set newtop 0
6382 } elseif {$newtop > $ymax} {
6383 set newtop $ymax
6385 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6388 # add a list of tag or branch names at position pos
6389 # returns the number of names inserted
6390 proc appendrefs {pos ids var} {
6391 global ctext linknum curview $var maxrefs
6393 if {[catch {$ctext index $pos}]} {
6394 return 0
6396 $ctext conf -state normal
6397 $ctext delete $pos "$pos lineend"
6398 set tags {}
6399 foreach id $ids {
6400 foreach tag [set $var\($id\)] {
6401 lappend tags [list $tag $id]
6404 if {[llength $tags] > $maxrefs} {
6405 $ctext insert $pos "many ([llength $tags])"
6406 } else {
6407 set tags [lsort -index 0 -decreasing $tags]
6408 set sep {}
6409 foreach ti $tags {
6410 set id [lindex $ti 1]
6411 set lk link$linknum
6412 incr linknum
6413 $ctext tag delete $lk
6414 $ctext insert $pos $sep
6415 $ctext insert $pos [lindex $ti 0] $lk
6416 setlink $id $lk
6417 set sep ", "
6420 $ctext conf -state disabled
6421 return [llength $tags]
6424 # called when we have finished computing the nearby tags
6425 proc dispneartags {delay} {
6426 global selectedline currentid showneartags tagphase
6428 if {$selectedline eq {} || !$showneartags} return
6429 after cancel dispnexttag
6430 if {$delay} {
6431 after 200 dispnexttag
6432 set tagphase -1
6433 } else {
6434 after idle dispnexttag
6435 set tagphase 0
6439 proc dispnexttag {} {
6440 global selectedline currentid showneartags tagphase ctext
6442 if {$selectedline eq {} || !$showneartags} return
6443 switch -- $tagphase {
6445 set dtags [desctags $currentid]
6446 if {$dtags ne {}} {
6447 appendrefs precedes $dtags idtags
6451 set atags [anctags $currentid]
6452 if {$atags ne {}} {
6453 appendrefs follows $atags idtags
6457 set dheads [descheads $currentid]
6458 if {$dheads ne {}} {
6459 if {[appendrefs branch $dheads idheads] > 1
6460 && [$ctext get "branch -3c"] eq "h"} {
6461 # turn "Branch" into "Branches"
6462 $ctext conf -state normal
6463 $ctext insert "branch -2c" "es"
6464 $ctext conf -state disabled
6469 if {[incr tagphase] <= 2} {
6470 after idle dispnexttag
6474 proc make_secsel {l} {
6475 global linehtag linentag linedtag canv canv2 canv3
6477 if {![info exists linehtag($l)]} return
6478 $canv delete secsel
6479 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
6480 -tags secsel -fill [$canv cget -selectbackground]]
6481 $canv lower $t
6482 $canv2 delete secsel
6483 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
6484 -tags secsel -fill [$canv2 cget -selectbackground]]
6485 $canv2 lower $t
6486 $canv3 delete secsel
6487 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
6488 -tags secsel -fill [$canv3 cget -selectbackground]]
6489 $canv3 lower $t
6492 proc selectline {l isnew {desired_loc {}}} {
6493 global canv ctext commitinfo selectedline
6494 global canvy0 linespc parents children curview
6495 global currentid sha1entry
6496 global commentend idtags linknum
6497 global mergemax numcommits pending_select
6498 global cmitmode showneartags allcommits
6499 global targetrow targetid lastscrollrows
6500 global autoselect jump_to_here
6502 catch {unset pending_select}
6503 $canv delete hover
6504 normalline
6505 unsel_reflist
6506 stopfinding
6507 if {$l < 0 || $l >= $numcommits} return
6508 set id [commitonrow $l]
6509 set targetid $id
6510 set targetrow $l
6511 set selectedline $l
6512 set currentid $id
6513 if {$lastscrollrows < $numcommits} {
6514 setcanvscroll
6517 set y [expr {$canvy0 + $l * $linespc}]
6518 set ymax [lindex [$canv cget -scrollregion] 3]
6519 set ytop [expr {$y - $linespc - 1}]
6520 set ybot [expr {$y + $linespc + 1}]
6521 set wnow [$canv yview]
6522 set wtop [expr {[lindex $wnow 0] * $ymax}]
6523 set wbot [expr {[lindex $wnow 1] * $ymax}]
6524 set wh [expr {$wbot - $wtop}]
6525 set newtop $wtop
6526 if {$ytop < $wtop} {
6527 if {$ybot < $wtop} {
6528 set newtop [expr {$y - $wh / 2.0}]
6529 } else {
6530 set newtop $ytop
6531 if {$newtop > $wtop - $linespc} {
6532 set newtop [expr {$wtop - $linespc}]
6535 } elseif {$ybot > $wbot} {
6536 if {$ytop > $wbot} {
6537 set newtop [expr {$y - $wh / 2.0}]
6538 } else {
6539 set newtop [expr {$ybot - $wh}]
6540 if {$newtop < $wtop + $linespc} {
6541 set newtop [expr {$wtop + $linespc}]
6545 if {$newtop != $wtop} {
6546 if {$newtop < 0} {
6547 set newtop 0
6549 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6550 drawvisible
6553 make_secsel $l
6555 if {$isnew} {
6556 addtohistory [list selbyid $id]
6559 $sha1entry delete 0 end
6560 $sha1entry insert 0 $id
6561 if {$autoselect} {
6562 $sha1entry selection from 0
6563 $sha1entry selection to end
6565 rhighlight_sel $id
6567 $ctext conf -state normal
6568 clear_ctext
6569 set linknum 0
6570 if {![info exists commitinfo($id)]} {
6571 getcommit $id
6573 set info $commitinfo($id)
6574 set date [formatdate [lindex $info 2]]
6575 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6576 set date [formatdate [lindex $info 4]]
6577 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6578 if {[info exists idtags($id)]} {
6579 $ctext insert end [mc "Tags:"]
6580 foreach tag $idtags($id) {
6581 $ctext insert end " $tag"
6583 $ctext insert end "\n"
6586 set headers {}
6587 set olds $parents($curview,$id)
6588 if {[llength $olds] > 1} {
6589 set np 0
6590 foreach p $olds {
6591 if {$np >= $mergemax} {
6592 set tag mmax
6593 } else {
6594 set tag m$np
6596 $ctext insert end "[mc "Parent"]: " $tag
6597 appendwithlinks [commit_descriptor $p] {}
6598 incr np
6600 } else {
6601 foreach p $olds {
6602 append headers "[mc "Parent"]: [commit_descriptor $p]"
6606 foreach c $children($curview,$id) {
6607 append headers "[mc "Child"]: [commit_descriptor $c]"
6610 # make anything that looks like a SHA1 ID be a clickable link
6611 appendwithlinks $headers {}
6612 if {$showneartags} {
6613 if {![info exists allcommits]} {
6614 getallcommits
6616 $ctext insert end "[mc "Branch"]: "
6617 $ctext mark set branch "end -1c"
6618 $ctext mark gravity branch left
6619 $ctext insert end "\n[mc "Follows"]: "
6620 $ctext mark set follows "end -1c"
6621 $ctext mark gravity follows left
6622 $ctext insert end "\n[mc "Precedes"]: "
6623 $ctext mark set precedes "end -1c"
6624 $ctext mark gravity precedes left
6625 $ctext insert end "\n"
6626 dispneartags 1
6628 $ctext insert end "\n"
6629 set comment [lindex $info 5]
6630 if {[string first "\r" $comment] >= 0} {
6631 set comment [string map {"\r" "\n "} $comment]
6633 appendwithlinks $comment {comment}
6635 $ctext tag remove found 1.0 end
6636 $ctext conf -state disabled
6637 set commentend [$ctext index "end - 1c"]
6639 set jump_to_here $desired_loc
6640 init_flist [mc "Comments"]
6641 if {$cmitmode eq "tree"} {
6642 gettree $id
6643 } elseif {[llength $olds] <= 1} {
6644 startdiff $id
6645 } else {
6646 mergediff $id
6650 proc selfirstline {} {
6651 unmarkmatches
6652 selectline 0 1
6655 proc sellastline {} {
6656 global numcommits
6657 unmarkmatches
6658 set l [expr {$numcommits - 1}]
6659 selectline $l 1
6662 proc selnextline {dir} {
6663 global selectedline
6664 focus .
6665 if {$selectedline eq {}} return
6666 set l [expr {$selectedline + $dir}]
6667 unmarkmatches
6668 selectline $l 1
6671 proc selnextpage {dir} {
6672 global canv linespc selectedline numcommits
6674 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6675 if {$lpp < 1} {
6676 set lpp 1
6678 allcanvs yview scroll [expr {$dir * $lpp}] units
6679 drawvisible
6680 if {$selectedline eq {}} return
6681 set l [expr {$selectedline + $dir * $lpp}]
6682 if {$l < 0} {
6683 set l 0
6684 } elseif {$l >= $numcommits} {
6685 set l [expr $numcommits - 1]
6687 unmarkmatches
6688 selectline $l 1
6691 proc unselectline {} {
6692 global selectedline currentid
6694 set selectedline {}
6695 catch {unset currentid}
6696 allcanvs delete secsel
6697 rhighlight_none
6700 proc reselectline {} {
6701 global selectedline
6703 if {$selectedline ne {}} {
6704 selectline $selectedline 0
6708 proc addtohistory {cmd} {
6709 global history historyindex curview
6711 set elt [list $curview $cmd]
6712 if {$historyindex > 0
6713 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6714 return
6717 if {$historyindex < [llength $history]} {
6718 set history [lreplace $history $historyindex end $elt]
6719 } else {
6720 lappend history $elt
6722 incr historyindex
6723 if {$historyindex > 1} {
6724 .tf.bar.leftbut conf -state normal
6725 } else {
6726 .tf.bar.leftbut conf -state disabled
6728 .tf.bar.rightbut conf -state disabled
6731 proc godo {elt} {
6732 global curview
6734 set view [lindex $elt 0]
6735 set cmd [lindex $elt 1]
6736 if {$curview != $view} {
6737 showview $view
6739 eval $cmd
6742 proc goback {} {
6743 global history historyindex
6744 focus .
6746 if {$historyindex > 1} {
6747 incr historyindex -1
6748 godo [lindex $history [expr {$historyindex - 1}]]
6749 .tf.bar.rightbut conf -state normal
6751 if {$historyindex <= 1} {
6752 .tf.bar.leftbut conf -state disabled
6756 proc goforw {} {
6757 global history historyindex
6758 focus .
6760 if {$historyindex < [llength $history]} {
6761 set cmd [lindex $history $historyindex]
6762 incr historyindex
6763 godo $cmd
6764 .tf.bar.leftbut conf -state normal
6766 if {$historyindex >= [llength $history]} {
6767 .tf.bar.rightbut conf -state disabled
6771 proc gettree {id} {
6772 global treefilelist treeidlist diffids diffmergeid treepending
6773 global nullid nullid2
6775 set diffids $id
6776 catch {unset diffmergeid}
6777 if {![info exists treefilelist($id)]} {
6778 if {![info exists treepending]} {
6779 if {$id eq $nullid} {
6780 set cmd [list | git ls-files]
6781 } elseif {$id eq $nullid2} {
6782 set cmd [list | git ls-files --stage -t]
6783 } else {
6784 set cmd [list | git ls-tree -r $id]
6786 if {[catch {set gtf [open $cmd r]}]} {
6787 return
6789 set treepending $id
6790 set treefilelist($id) {}
6791 set treeidlist($id) {}
6792 fconfigure $gtf -blocking 0 -encoding binary
6793 filerun $gtf [list gettreeline $gtf $id]
6795 } else {
6796 setfilelist $id
6800 proc gettreeline {gtf id} {
6801 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6803 set nl 0
6804 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6805 if {$diffids eq $nullid} {
6806 set fname $line
6807 } else {
6808 set i [string first "\t" $line]
6809 if {$i < 0} continue
6810 set fname [string range $line [expr {$i+1}] end]
6811 set line [string range $line 0 [expr {$i-1}]]
6812 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6813 set sha1 [lindex $line 2]
6814 lappend treeidlist($id) $sha1
6816 if {[string index $fname 0] eq "\""} {
6817 set fname [lindex $fname 0]
6819 set fname [encoding convertfrom $fname]
6820 lappend treefilelist($id) $fname
6822 if {![eof $gtf]} {
6823 return [expr {$nl >= 1000? 2: 1}]
6825 close $gtf
6826 unset treepending
6827 if {$cmitmode ne "tree"} {
6828 if {![info exists diffmergeid]} {
6829 gettreediffs $diffids
6831 } elseif {$id ne $diffids} {
6832 gettree $diffids
6833 } else {
6834 setfilelist $id
6836 return 0
6839 proc showfile {f} {
6840 global treefilelist treeidlist diffids nullid nullid2
6841 global ctext_file_names ctext_file_lines
6842 global ctext commentend
6844 set i [lsearch -exact $treefilelist($diffids) $f]
6845 if {$i < 0} {
6846 puts "oops, $f not in list for id $diffids"
6847 return
6849 if {$diffids eq $nullid} {
6850 if {[catch {set bf [open $f r]} err]} {
6851 puts "oops, can't read $f: $err"
6852 return
6854 } else {
6855 set blob [lindex $treeidlist($diffids) $i]
6856 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6857 puts "oops, error reading blob $blob: $err"
6858 return
6861 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6862 filerun $bf [list getblobline $bf $diffids]
6863 $ctext config -state normal
6864 clear_ctext $commentend
6865 lappend ctext_file_names $f
6866 lappend ctext_file_lines [lindex [split $commentend "."] 0]
6867 $ctext insert end "\n"
6868 $ctext insert end "$f\n" filesep
6869 $ctext config -state disabled
6870 $ctext yview $commentend
6871 settabs 0
6874 proc getblobline {bf id} {
6875 global diffids cmitmode ctext
6877 if {$id ne $diffids || $cmitmode ne "tree"} {
6878 catch {close $bf}
6879 return 0
6881 $ctext config -state normal
6882 set nl 0
6883 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6884 $ctext insert end "$line\n"
6886 if {[eof $bf]} {
6887 global jump_to_here ctext_file_names commentend
6889 # delete last newline
6890 $ctext delete "end - 2c" "end - 1c"
6891 close $bf
6892 if {$jump_to_here ne {} &&
6893 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
6894 set lnum [expr {[lindex $jump_to_here 1] +
6895 [lindex [split $commentend .] 0]}]
6896 mark_ctext_line $lnum
6898 return 0
6900 $ctext config -state disabled
6901 return [expr {$nl >= 1000? 2: 1}]
6904 proc mark_ctext_line {lnum} {
6905 global ctext markbgcolor
6907 $ctext tag delete omark
6908 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
6909 $ctext tag conf omark -background $markbgcolor
6910 $ctext see $lnum.0
6913 proc mergediff {id} {
6914 global diffmergeid
6915 global diffids treediffs
6916 global parents curview
6918 set diffmergeid $id
6919 set diffids $id
6920 set treediffs($id) {}
6921 set np [llength $parents($curview,$id)]
6922 settabs $np
6923 getblobdiffs $id
6926 proc startdiff {ids} {
6927 global treediffs diffids treepending diffmergeid nullid nullid2
6929 settabs 1
6930 set diffids $ids
6931 catch {unset diffmergeid}
6932 if {![info exists treediffs($ids)] ||
6933 [lsearch -exact $ids $nullid] >= 0 ||
6934 [lsearch -exact $ids $nullid2] >= 0} {
6935 if {![info exists treepending]} {
6936 gettreediffs $ids
6938 } else {
6939 addtocflist $ids
6943 proc path_filter {filter name} {
6944 foreach p $filter {
6945 set l [string length $p]
6946 if {[string index $p end] eq "/"} {
6947 if {[string compare -length $l $p $name] == 0} {
6948 return 1
6950 } else {
6951 if {[string compare -length $l $p $name] == 0 &&
6952 ([string length $name] == $l ||
6953 [string index $name $l] eq "/")} {
6954 return 1
6958 return 0
6961 proc addtocflist {ids} {
6962 global treediffs
6964 add_flist $treediffs($ids)
6965 getblobdiffs $ids
6968 proc diffcmd {ids flags} {
6969 global nullid nullid2
6971 set i [lsearch -exact $ids $nullid]
6972 set j [lsearch -exact $ids $nullid2]
6973 if {$i >= 0} {
6974 if {[llength $ids] > 1 && $j < 0} {
6975 # comparing working directory with some specific revision
6976 set cmd [concat | git diff-index $flags]
6977 if {$i == 0} {
6978 lappend cmd -R [lindex $ids 1]
6979 } else {
6980 lappend cmd [lindex $ids 0]
6982 } else {
6983 # comparing working directory with index
6984 set cmd [concat | git diff-files $flags]
6985 if {$j == 1} {
6986 lappend cmd -R
6989 } elseif {$j >= 0} {
6990 set cmd [concat | git diff-index --cached $flags]
6991 if {[llength $ids] > 1} {
6992 # comparing index with specific revision
6993 if {$i == 0} {
6994 lappend cmd -R [lindex $ids 1]
6995 } else {
6996 lappend cmd [lindex $ids 0]
6998 } else {
6999 # comparing index with HEAD
7000 lappend cmd HEAD
7002 } else {
7003 set cmd [concat | git diff-tree -r $flags $ids]
7005 return $cmd
7008 proc gettreediffs {ids} {
7009 global treediff treepending
7011 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7013 set treepending $ids
7014 set treediff {}
7015 fconfigure $gdtf -blocking 0 -encoding binary
7016 filerun $gdtf [list gettreediffline $gdtf $ids]
7019 proc gettreediffline {gdtf ids} {
7020 global treediff treediffs treepending diffids diffmergeid
7021 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7023 set nr 0
7024 set sublist {}
7025 set max 1000
7026 if {$perfile_attrs} {
7027 # cache_gitattr is slow, and even slower on win32 where we
7028 # have to invoke it for only about 30 paths at a time
7029 set max 500
7030 if {[tk windowingsystem] == "win32"} {
7031 set max 120
7034 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7035 set i [string first "\t" $line]
7036 if {$i >= 0} {
7037 set file [string range $line [expr {$i+1}] end]
7038 if {[string index $file 0] eq "\""} {
7039 set file [lindex $file 0]
7041 set file [encoding convertfrom $file]
7042 if {$file ne [lindex $treediff end]} {
7043 lappend treediff $file
7044 lappend sublist $file
7048 if {$perfile_attrs} {
7049 cache_gitattr encoding $sublist
7051 if {![eof $gdtf]} {
7052 return [expr {$nr >= $max? 2: 1}]
7054 close $gdtf
7055 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7056 set flist {}
7057 foreach f $treediff {
7058 if {[path_filter $vfilelimit($curview) $f]} {
7059 lappend flist $f
7062 set treediffs($ids) $flist
7063 } else {
7064 set treediffs($ids) $treediff
7066 unset treepending
7067 if {$cmitmode eq "tree"} {
7068 gettree $diffids
7069 } elseif {$ids != $diffids} {
7070 if {![info exists diffmergeid]} {
7071 gettreediffs $diffids
7073 } else {
7074 addtocflist $ids
7076 return 0
7079 # empty string or positive integer
7080 proc diffcontextvalidate {v} {
7081 return [regexp {^(|[1-9][0-9]*)$} $v]
7084 proc diffcontextchange {n1 n2 op} {
7085 global diffcontextstring diffcontext
7087 if {[string is integer -strict $diffcontextstring]} {
7088 if {$diffcontextstring > 0} {
7089 set diffcontext $diffcontextstring
7090 reselectline
7095 proc changeignorespace {} {
7096 reselectline
7099 proc getblobdiffs {ids} {
7100 global blobdifffd diffids env
7101 global diffinhdr treediffs
7102 global diffcontext
7103 global ignorespace
7104 global limitdiffs vfilelimit curview
7105 global diffencoding targetline diffnparents
7107 set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7108 if {$ignorespace} {
7109 append cmd " -w"
7111 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7112 set cmd [concat $cmd -- $vfilelimit($curview)]
7114 if {[catch {set bdf [open $cmd r]} err]} {
7115 error_popup [mc "Error getting diffs: %s" $err]
7116 return
7118 set targetline {}
7119 set diffnparents 0
7120 set diffinhdr 0
7121 set diffencoding [get_path_encoding {}]
7122 fconfigure $bdf -blocking 0 -encoding binary
7123 set blobdifffd($ids) $bdf
7124 filerun $bdf [list getblobdiffline $bdf $diffids]
7127 proc setinlist {var i val} {
7128 global $var
7130 while {[llength [set $var]] < $i} {
7131 lappend $var {}
7133 if {[llength [set $var]] == $i} {
7134 lappend $var $val
7135 } else {
7136 lset $var $i $val
7140 proc makediffhdr {fname ids} {
7141 global ctext curdiffstart treediffs diffencoding
7142 global ctext_file_names jump_to_here targetline diffline
7144 set fname [encoding convertfrom $fname]
7145 set diffencoding [get_path_encoding $fname]
7146 set i [lsearch -exact $treediffs($ids) $fname]
7147 if {$i >= 0} {
7148 setinlist difffilestart $i $curdiffstart
7150 lset ctext_file_names end $fname
7151 set l [expr {(78 - [string length $fname]) / 2}]
7152 set pad [string range "----------------------------------------" 1 $l]
7153 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7154 set targetline {}
7155 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7156 set targetline [lindex $jump_to_here 1]
7158 set diffline 0
7161 proc getblobdiffline {bdf ids} {
7162 global diffids blobdifffd ctext curdiffstart
7163 global diffnexthead diffnextnote difffilestart
7164 global ctext_file_names ctext_file_lines
7165 global diffinhdr treediffs mergemax diffnparents
7166 global diffencoding jump_to_here targetline diffline
7168 set nr 0
7169 $ctext conf -state normal
7170 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7171 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7172 close $bdf
7173 return 0
7175 if {![string compare -length 5 "diff " $line]} {
7176 if {![regexp {^diff (--cc|--git) } $line m type]} {
7177 set line [encoding convertfrom $line]
7178 $ctext insert end "$line\n" hunksep
7179 continue
7181 # start of a new file
7182 set diffinhdr 1
7183 $ctext insert end "\n"
7184 set curdiffstart [$ctext index "end - 1c"]
7185 lappend ctext_file_names ""
7186 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7187 $ctext insert end "\n" filesep
7189 if {$type eq "--cc"} {
7190 # start of a new file in a merge diff
7191 set fname [string range $line 10 end]
7192 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7193 lappend treediffs($ids) $fname
7194 add_flist [list $fname]
7197 } else {
7198 set line [string range $line 11 end]
7199 # If the name hasn't changed the length will be odd,
7200 # the middle char will be a space, and the two bits either
7201 # side will be a/name and b/name, or "a/name" and "b/name".
7202 # If the name has changed we'll get "rename from" and
7203 # "rename to" or "copy from" and "copy to" lines following
7204 # this, and we'll use them to get the filenames.
7205 # This complexity is necessary because spaces in the
7206 # filename(s) don't get escaped.
7207 set l [string length $line]
7208 set i [expr {$l / 2}]
7209 if {!(($l & 1) && [string index $line $i] eq " " &&
7210 [string range $line 2 [expr {$i - 1}]] eq \
7211 [string range $line [expr {$i + 3}] end])} {
7212 continue
7214 # unescape if quoted and chop off the a/ from the front
7215 if {[string index $line 0] eq "\""} {
7216 set fname [string range [lindex $line 0] 2 end]
7217 } else {
7218 set fname [string range $line 2 [expr {$i - 1}]]
7221 makediffhdr $fname $ids
7223 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7224 set fname [encoding convertfrom [string range $line 16 end]]
7225 $ctext insert end "\n"
7226 set curdiffstart [$ctext index "end - 1c"]
7227 lappend ctext_file_names $fname
7228 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7229 $ctext insert end "$line\n" filesep
7230 set i [lsearch -exact $treediffs($ids) $fname]
7231 if {$i >= 0} {
7232 setinlist difffilestart $i $curdiffstart
7235 } elseif {![string compare -length 2 "@@" $line]} {
7236 regexp {^@@+} $line ats
7237 set line [encoding convertfrom $diffencoding $line]
7238 $ctext insert end "$line\n" hunksep
7239 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7240 set diffline $nl
7242 set diffnparents [expr {[string length $ats] - 1}]
7243 set diffinhdr 0
7245 } elseif {$diffinhdr} {
7246 if {![string compare -length 12 "rename from " $line]} {
7247 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7248 if {[string index $fname 0] eq "\""} {
7249 set fname [lindex $fname 0]
7251 set fname [encoding convertfrom $fname]
7252 set i [lsearch -exact $treediffs($ids) $fname]
7253 if {$i >= 0} {
7254 setinlist difffilestart $i $curdiffstart
7256 } elseif {![string compare -length 10 $line "rename to "] ||
7257 ![string compare -length 8 $line "copy to "]} {
7258 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7259 if {[string index $fname 0] eq "\""} {
7260 set fname [lindex $fname 0]
7262 makediffhdr $fname $ids
7263 } elseif {[string compare -length 3 $line "---"] == 0} {
7264 # do nothing
7265 continue
7266 } elseif {[string compare -length 3 $line "+++"] == 0} {
7267 set diffinhdr 0
7268 continue
7270 $ctext insert end "$line\n" filesep
7272 } else {
7273 set line [encoding convertfrom $diffencoding $line]
7274 # parse the prefix - one ' ', '-' or '+' for each parent
7275 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7276 set tag [expr {$diffnparents > 1? "m": "d"}]
7277 if {[string trim $prefix " -+"] eq {}} {
7278 # prefix only has " ", "-" and "+" in it: normal diff line
7279 set num [string first "-" $prefix]
7280 if {$num >= 0} {
7281 # removed line, first parent with line is $num
7282 if {$num >= $mergemax} {
7283 set num "max"
7285 $ctext insert end "$line\n" $tag$num
7286 } else {
7287 set tags {}
7288 if {[string first "+" $prefix] >= 0} {
7289 # added line
7290 lappend tags ${tag}result
7291 if {$diffnparents > 1} {
7292 set num [string first " " $prefix]
7293 if {$num >= 0} {
7294 if {$num >= $mergemax} {
7295 set num "max"
7297 lappend tags m$num
7301 if {$targetline ne {}} {
7302 if {$diffline == $targetline} {
7303 set seehere [$ctext index "end - 1 chars"]
7304 set targetline {}
7305 } else {
7306 incr diffline
7309 $ctext insert end "$line\n" $tags
7311 } else {
7312 # "\ No newline at end of file",
7313 # or something else we don't recognize
7314 $ctext insert end "$line\n" hunksep
7318 if {[info exists seehere]} {
7319 mark_ctext_line [lindex [split $seehere .] 0]
7321 $ctext conf -state disabled
7322 if {[eof $bdf]} {
7323 close $bdf
7324 return 0
7326 return [expr {$nr >= 1000? 2: 1}]
7329 proc changediffdisp {} {
7330 global ctext diffelide
7332 $ctext tag conf d0 -elide [lindex $diffelide 0]
7333 $ctext tag conf dresult -elide [lindex $diffelide 1]
7336 proc highlightfile {loc cline} {
7337 global ctext cflist cflist_top
7339 $ctext yview $loc
7340 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7341 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7342 $cflist see $cline.0
7343 set cflist_top $cline
7346 proc prevfile {} {
7347 global difffilestart ctext cmitmode
7349 if {$cmitmode eq "tree"} return
7350 set prev 0.0
7351 set prevline 1
7352 set here [$ctext index @0,0]
7353 foreach loc $difffilestart {
7354 if {[$ctext compare $loc >= $here]} {
7355 highlightfile $prev $prevline
7356 return
7358 set prev $loc
7359 incr prevline
7361 highlightfile $prev $prevline
7364 proc nextfile {} {
7365 global difffilestart ctext cmitmode
7367 if {$cmitmode eq "tree"} return
7368 set here [$ctext index @0,0]
7369 set line 1
7370 foreach loc $difffilestart {
7371 incr line
7372 if {[$ctext compare $loc > $here]} {
7373 highlightfile $loc $line
7374 return
7379 proc clear_ctext {{first 1.0}} {
7380 global ctext smarktop smarkbot
7381 global ctext_file_names ctext_file_lines
7382 global pendinglinks
7384 set l [lindex [split $first .] 0]
7385 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7386 set smarktop $l
7388 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7389 set smarkbot $l
7391 $ctext delete $first end
7392 if {$first eq "1.0"} {
7393 catch {unset pendinglinks}
7395 set ctext_file_names {}
7396 set ctext_file_lines {}
7399 proc settabs {{firstab {}}} {
7400 global firsttabstop tabstop ctext have_tk85
7402 if {$firstab ne {} && $have_tk85} {
7403 set firsttabstop $firstab
7405 set w [font measure textfont "0"]
7406 if {$firsttabstop != 0} {
7407 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7408 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7409 } elseif {$have_tk85 || $tabstop != 8} {
7410 $ctext conf -tabs [expr {$tabstop * $w}]
7411 } else {
7412 $ctext conf -tabs {}
7416 proc incrsearch {name ix op} {
7417 global ctext searchstring searchdirn
7419 $ctext tag remove found 1.0 end
7420 if {[catch {$ctext index anchor}]} {
7421 # no anchor set, use start of selection, or of visible area
7422 set sel [$ctext tag ranges sel]
7423 if {$sel ne {}} {
7424 $ctext mark set anchor [lindex $sel 0]
7425 } elseif {$searchdirn eq "-forwards"} {
7426 $ctext mark set anchor @0,0
7427 } else {
7428 $ctext mark set anchor @0,[winfo height $ctext]
7431 if {$searchstring ne {}} {
7432 set here [$ctext search $searchdirn -- $searchstring anchor]
7433 if {$here ne {}} {
7434 $ctext see $here
7436 searchmarkvisible 1
7440 proc dosearch {} {
7441 global sstring ctext searchstring searchdirn
7443 focus $sstring
7444 $sstring icursor end
7445 set searchdirn -forwards
7446 if {$searchstring ne {}} {
7447 set sel [$ctext tag ranges sel]
7448 if {$sel ne {}} {
7449 set start "[lindex $sel 0] + 1c"
7450 } elseif {[catch {set start [$ctext index anchor]}]} {
7451 set start "@0,0"
7453 set match [$ctext search -count mlen -- $searchstring $start]
7454 $ctext tag remove sel 1.0 end
7455 if {$match eq {}} {
7456 bell
7457 return
7459 $ctext see $match
7460 set mend "$match + $mlen c"
7461 $ctext tag add sel $match $mend
7462 $ctext mark unset anchor
7466 proc dosearchback {} {
7467 global sstring ctext searchstring searchdirn
7469 focus $sstring
7470 $sstring icursor end
7471 set searchdirn -backwards
7472 if {$searchstring ne {}} {
7473 set sel [$ctext tag ranges sel]
7474 if {$sel ne {}} {
7475 set start [lindex $sel 0]
7476 } elseif {[catch {set start [$ctext index anchor]}]} {
7477 set start @0,[winfo height $ctext]
7479 set match [$ctext search -backwards -count ml -- $searchstring $start]
7480 $ctext tag remove sel 1.0 end
7481 if {$match eq {}} {
7482 bell
7483 return
7485 $ctext see $match
7486 set mend "$match + $ml c"
7487 $ctext tag add sel $match $mend
7488 $ctext mark unset anchor
7492 proc searchmark {first last} {
7493 global ctext searchstring
7495 set mend $first.0
7496 while {1} {
7497 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7498 if {$match eq {}} break
7499 set mend "$match + $mlen c"
7500 $ctext tag add found $match $mend
7504 proc searchmarkvisible {doall} {
7505 global ctext smarktop smarkbot
7507 set topline [lindex [split [$ctext index @0,0] .] 0]
7508 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7509 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7510 # no overlap with previous
7511 searchmark $topline $botline
7512 set smarktop $topline
7513 set smarkbot $botline
7514 } else {
7515 if {$topline < $smarktop} {
7516 searchmark $topline [expr {$smarktop-1}]
7517 set smarktop $topline
7519 if {$botline > $smarkbot} {
7520 searchmark [expr {$smarkbot+1}] $botline
7521 set smarkbot $botline
7526 proc scrolltext {f0 f1} {
7527 global searchstring
7529 .bleft.bottom.sb set $f0 $f1
7530 if {$searchstring ne {}} {
7531 searchmarkvisible 0
7535 proc setcoords {} {
7536 global linespc charspc canvx0 canvy0
7537 global xspc1 xspc2 lthickness
7539 set linespc [font metrics mainfont -linespace]
7540 set charspc [font measure mainfont "m"]
7541 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7542 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7543 set lthickness [expr {int($linespc / 9) + 1}]
7544 set xspc1(0) $linespc
7545 set xspc2 $linespc
7548 proc redisplay {} {
7549 global canv
7550 global selectedline
7552 set ymax [lindex [$canv cget -scrollregion] 3]
7553 if {$ymax eq {} || $ymax == 0} return
7554 set span [$canv yview]
7555 clear_display
7556 setcanvscroll
7557 allcanvs yview moveto [lindex $span 0]
7558 drawvisible
7559 if {$selectedline ne {}} {
7560 selectline $selectedline 0
7561 allcanvs yview moveto [lindex $span 0]
7565 proc parsefont {f n} {
7566 global fontattr
7568 set fontattr($f,family) [lindex $n 0]
7569 set s [lindex $n 1]
7570 if {$s eq {} || $s == 0} {
7571 set s 10
7572 } elseif {$s < 0} {
7573 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7575 set fontattr($f,size) $s
7576 set fontattr($f,weight) normal
7577 set fontattr($f,slant) roman
7578 foreach style [lrange $n 2 end] {
7579 switch -- $style {
7580 "normal" -
7581 "bold" {set fontattr($f,weight) $style}
7582 "roman" -
7583 "italic" {set fontattr($f,slant) $style}
7588 proc fontflags {f {isbold 0}} {
7589 global fontattr
7591 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7592 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7593 -slant $fontattr($f,slant)]
7596 proc fontname {f} {
7597 global fontattr
7599 set n [list $fontattr($f,family) $fontattr($f,size)]
7600 if {$fontattr($f,weight) eq "bold"} {
7601 lappend n "bold"
7603 if {$fontattr($f,slant) eq "italic"} {
7604 lappend n "italic"
7606 return $n
7609 proc incrfont {inc} {
7610 global mainfont textfont ctext canv cflist showrefstop
7611 global stopped entries fontattr
7613 unmarkmatches
7614 set s $fontattr(mainfont,size)
7615 incr s $inc
7616 if {$s < 1} {
7617 set s 1
7619 set fontattr(mainfont,size) $s
7620 font config mainfont -size $s
7621 font config mainfontbold -size $s
7622 set mainfont [fontname mainfont]
7623 set s $fontattr(textfont,size)
7624 incr s $inc
7625 if {$s < 1} {
7626 set s 1
7628 set fontattr(textfont,size) $s
7629 font config textfont -size $s
7630 font config textfontbold -size $s
7631 set textfont [fontname textfont]
7632 setcoords
7633 settabs
7634 redisplay
7637 proc clearsha1 {} {
7638 global sha1entry sha1string
7639 if {[string length $sha1string] == 40} {
7640 $sha1entry delete 0 end
7644 proc sha1change {n1 n2 op} {
7645 global sha1string currentid sha1but
7646 if {$sha1string == {}
7647 || ([info exists currentid] && $sha1string == $currentid)} {
7648 set state disabled
7649 } else {
7650 set state normal
7652 if {[$sha1but cget -state] == $state} return
7653 if {$state == "normal"} {
7654 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7655 } else {
7656 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7660 proc gotocommit {} {
7661 global sha1string tagids headids curview varcid
7663 if {$sha1string == {}
7664 || ([info exists currentid] && $sha1string == $currentid)} return
7665 if {[info exists tagids($sha1string)]} {
7666 set id $tagids($sha1string)
7667 } elseif {[info exists headids($sha1string)]} {
7668 set id $headids($sha1string)
7669 } else {
7670 set id [string tolower $sha1string]
7671 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7672 set matches [longid $id]
7673 if {$matches ne {}} {
7674 if {[llength $matches] > 1} {
7675 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7676 return
7678 set id [lindex $matches 0]
7682 if {[commitinview $id $curview]} {
7683 selectline [rowofcommit $id] 1
7684 return
7686 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7687 set msg [mc "SHA1 id %s is not known" $sha1string]
7688 } else {
7689 set msg [mc "Tag/Head %s is not known" $sha1string]
7691 error_popup $msg
7694 proc lineenter {x y id} {
7695 global hoverx hovery hoverid hovertimer
7696 global commitinfo canv
7698 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7699 set hoverx $x
7700 set hovery $y
7701 set hoverid $id
7702 if {[info exists hovertimer]} {
7703 after cancel $hovertimer
7705 set hovertimer [after 500 linehover]
7706 $canv delete hover
7709 proc linemotion {x y id} {
7710 global hoverx hovery hoverid hovertimer
7712 if {[info exists hoverid] && $id == $hoverid} {
7713 set hoverx $x
7714 set hovery $y
7715 if {[info exists hovertimer]} {
7716 after cancel $hovertimer
7718 set hovertimer [after 500 linehover]
7722 proc lineleave {id} {
7723 global hoverid hovertimer canv
7725 if {[info exists hoverid] && $id == $hoverid} {
7726 $canv delete hover
7727 if {[info exists hovertimer]} {
7728 after cancel $hovertimer
7729 unset hovertimer
7731 unset hoverid
7735 proc linehover {} {
7736 global hoverx hovery hoverid hovertimer
7737 global canv linespc lthickness
7738 global commitinfo
7740 set text [lindex $commitinfo($hoverid) 0]
7741 set ymax [lindex [$canv cget -scrollregion] 3]
7742 if {$ymax == {}} return
7743 set yfrac [lindex [$canv yview] 0]
7744 set x [expr {$hoverx + 2 * $linespc}]
7745 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7746 set x0 [expr {$x - 2 * $lthickness}]
7747 set y0 [expr {$y - 2 * $lthickness}]
7748 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7749 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7750 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7751 -fill \#ffff80 -outline black -width 1 -tags hover]
7752 $canv raise $t
7753 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7754 -font mainfont]
7755 $canv raise $t
7758 proc clickisonarrow {id y} {
7759 global lthickness
7761 set ranges [rowranges $id]
7762 set thresh [expr {2 * $lthickness + 6}]
7763 set n [expr {[llength $ranges] - 1}]
7764 for {set i 1} {$i < $n} {incr i} {
7765 set row [lindex $ranges $i]
7766 if {abs([yc $row] - $y) < $thresh} {
7767 return $i
7770 return {}
7773 proc arrowjump {id n y} {
7774 global canv
7776 # 1 <-> 2, 3 <-> 4, etc...
7777 set n [expr {(($n - 1) ^ 1) + 1}]
7778 set row [lindex [rowranges $id] $n]
7779 set yt [yc $row]
7780 set ymax [lindex [$canv cget -scrollregion] 3]
7781 if {$ymax eq {} || $ymax <= 0} return
7782 set view [$canv yview]
7783 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7784 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7785 if {$yfrac < 0} {
7786 set yfrac 0
7788 allcanvs yview moveto $yfrac
7791 proc lineclick {x y id isnew} {
7792 global ctext commitinfo children canv thickerline curview
7794 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7795 unmarkmatches
7796 unselectline
7797 normalline
7798 $canv delete hover
7799 # draw this line thicker than normal
7800 set thickerline $id
7801 drawlines $id
7802 if {$isnew} {
7803 set ymax [lindex [$canv cget -scrollregion] 3]
7804 if {$ymax eq {}} return
7805 set yfrac [lindex [$canv yview] 0]
7806 set y [expr {$y + $yfrac * $ymax}]
7808 set dirn [clickisonarrow $id $y]
7809 if {$dirn ne {}} {
7810 arrowjump $id $dirn $y
7811 return
7814 if {$isnew} {
7815 addtohistory [list lineclick $x $y $id 0]
7817 # fill the details pane with info about this line
7818 $ctext conf -state normal
7819 clear_ctext
7820 settabs 0
7821 $ctext insert end "[mc "Parent"]:\t"
7822 $ctext insert end $id link0
7823 setlink $id link0
7824 set info $commitinfo($id)
7825 $ctext insert end "\n\t[lindex $info 0]\n"
7826 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7827 set date [formatdate [lindex $info 2]]
7828 $ctext insert end "\t[mc "Date"]:\t$date\n"
7829 set kids $children($curview,$id)
7830 if {$kids ne {}} {
7831 $ctext insert end "\n[mc "Children"]:"
7832 set i 0
7833 foreach child $kids {
7834 incr i
7835 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7836 set info $commitinfo($child)
7837 $ctext insert end "\n\t"
7838 $ctext insert end $child link$i
7839 setlink $child link$i
7840 $ctext insert end "\n\t[lindex $info 0]"
7841 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7842 set date [formatdate [lindex $info 2]]
7843 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7846 $ctext conf -state disabled
7847 init_flist {}
7850 proc normalline {} {
7851 global thickerline
7852 if {[info exists thickerline]} {
7853 set id $thickerline
7854 unset thickerline
7855 drawlines $id
7859 proc selbyid {id} {
7860 global curview
7861 if {[commitinview $id $curview]} {
7862 selectline [rowofcommit $id] 1
7866 proc mstime {} {
7867 global startmstime
7868 if {![info exists startmstime]} {
7869 set startmstime [clock clicks -milliseconds]
7871 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7874 proc rowmenu {x y id} {
7875 global rowctxmenu selectedline rowmenuid curview
7876 global nullid nullid2 fakerowmenu mainhead
7878 stopfinding
7879 set rowmenuid $id
7880 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7881 set state disabled
7882 } else {
7883 set state normal
7885 if {$id ne $nullid && $id ne $nullid2} {
7886 set menu $rowctxmenu
7887 if {$mainhead ne {}} {
7888 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7889 } else {
7890 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7892 } else {
7893 set menu $fakerowmenu
7895 $menu entryconfigure [mca "Diff this -> selected"] -state $state
7896 $menu entryconfigure [mca "Diff selected -> this"] -state $state
7897 $menu entryconfigure [mca "Make patch"] -state $state
7898 tk_popup $menu $x $y
7901 proc diffvssel {dirn} {
7902 global rowmenuid selectedline
7904 if {$selectedline eq {}} return
7905 if {$dirn} {
7906 set oldid [commitonrow $selectedline]
7907 set newid $rowmenuid
7908 } else {
7909 set oldid $rowmenuid
7910 set newid [commitonrow $selectedline]
7912 addtohistory [list doseldiff $oldid $newid]
7913 doseldiff $oldid $newid
7916 proc doseldiff {oldid newid} {
7917 global ctext
7918 global commitinfo
7920 $ctext conf -state normal
7921 clear_ctext
7922 init_flist [mc "Top"]
7923 $ctext insert end "[mc "From"] "
7924 $ctext insert end $oldid link0
7925 setlink $oldid link0
7926 $ctext insert end "\n "
7927 $ctext insert end [lindex $commitinfo($oldid) 0]
7928 $ctext insert end "\n\n[mc "To"] "
7929 $ctext insert end $newid link1
7930 setlink $newid link1
7931 $ctext insert end "\n "
7932 $ctext insert end [lindex $commitinfo($newid) 0]
7933 $ctext insert end "\n"
7934 $ctext conf -state disabled
7935 $ctext tag remove found 1.0 end
7936 startdiff [list $oldid $newid]
7939 proc mkpatch {} {
7940 global rowmenuid currentid commitinfo patchtop patchnum
7942 if {![info exists currentid]} return
7943 set oldid $currentid
7944 set oldhead [lindex $commitinfo($oldid) 0]
7945 set newid $rowmenuid
7946 set newhead [lindex $commitinfo($newid) 0]
7947 set top .patch
7948 set patchtop $top
7949 catch {destroy $top}
7950 toplevel $top
7951 make_transient $top .
7952 label $top.title -text [mc "Generate patch"]
7953 grid $top.title - -pady 10
7954 label $top.from -text [mc "From:"]
7955 entry $top.fromsha1 -width 40 -relief flat
7956 $top.fromsha1 insert 0 $oldid
7957 $top.fromsha1 conf -state readonly
7958 grid $top.from $top.fromsha1 -sticky w
7959 entry $top.fromhead -width 60 -relief flat
7960 $top.fromhead insert 0 $oldhead
7961 $top.fromhead conf -state readonly
7962 grid x $top.fromhead -sticky w
7963 label $top.to -text [mc "To:"]
7964 entry $top.tosha1 -width 40 -relief flat
7965 $top.tosha1 insert 0 $newid
7966 $top.tosha1 conf -state readonly
7967 grid $top.to $top.tosha1 -sticky w
7968 entry $top.tohead -width 60 -relief flat
7969 $top.tohead insert 0 $newhead
7970 $top.tohead conf -state readonly
7971 grid x $top.tohead -sticky w
7972 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7973 grid $top.rev x -pady 10
7974 label $top.flab -text [mc "Output file:"]
7975 entry $top.fname -width 60
7976 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7977 incr patchnum
7978 grid $top.flab $top.fname -sticky w
7979 frame $top.buts
7980 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7981 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7982 bind $top <Key-Return> mkpatchgo
7983 bind $top <Key-Escape> mkpatchcan
7984 grid $top.buts.gen $top.buts.can
7985 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7986 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7987 grid $top.buts - -pady 10 -sticky ew
7988 focus $top.fname
7991 proc mkpatchrev {} {
7992 global patchtop
7994 set oldid [$patchtop.fromsha1 get]
7995 set oldhead [$patchtop.fromhead get]
7996 set newid [$patchtop.tosha1 get]
7997 set newhead [$patchtop.tohead get]
7998 foreach e [list fromsha1 fromhead tosha1 tohead] \
7999 v [list $newid $newhead $oldid $oldhead] {
8000 $patchtop.$e conf -state normal
8001 $patchtop.$e delete 0 end
8002 $patchtop.$e insert 0 $v
8003 $patchtop.$e conf -state readonly
8007 proc mkpatchgo {} {
8008 global patchtop nullid nullid2
8010 set oldid [$patchtop.fromsha1 get]
8011 set newid [$patchtop.tosha1 get]
8012 set fname [$patchtop.fname get]
8013 set cmd [diffcmd [list $oldid $newid] -p]
8014 # trim off the initial "|"
8015 set cmd [lrange $cmd 1 end]
8016 lappend cmd >$fname &
8017 if {[catch {eval exec $cmd} err]} {
8018 error_popup "[mc "Error creating patch:"] $err" $patchtop
8020 catch {destroy $patchtop}
8021 unset patchtop
8024 proc mkpatchcan {} {
8025 global patchtop
8027 catch {destroy $patchtop}
8028 unset patchtop
8031 proc mktag {} {
8032 global rowmenuid mktagtop commitinfo
8034 set top .maketag
8035 set mktagtop $top
8036 catch {destroy $top}
8037 toplevel $top
8038 make_transient $top .
8039 label $top.title -text [mc "Create tag"]
8040 grid $top.title - -pady 10
8041 label $top.id -text [mc "ID:"]
8042 entry $top.sha1 -width 40 -relief flat
8043 $top.sha1 insert 0 $rowmenuid
8044 $top.sha1 conf -state readonly
8045 grid $top.id $top.sha1 -sticky w
8046 entry $top.head -width 60 -relief flat
8047 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8048 $top.head conf -state readonly
8049 grid x $top.head -sticky w
8050 label $top.tlab -text [mc "Tag name:"]
8051 entry $top.tag -width 60
8052 grid $top.tlab $top.tag -sticky w
8053 frame $top.buts
8054 button $top.buts.gen -text [mc "Create"] -command mktaggo
8055 button $top.buts.can -text [mc "Cancel"] -command mktagcan
8056 bind $top <Key-Return> mktaggo
8057 bind $top <Key-Escape> mktagcan
8058 grid $top.buts.gen $top.buts.can
8059 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8060 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8061 grid $top.buts - -pady 10 -sticky ew
8062 focus $top.tag
8065 proc domktag {} {
8066 global mktagtop env tagids idtags
8068 set id [$mktagtop.sha1 get]
8069 set tag [$mktagtop.tag get]
8070 if {$tag == {}} {
8071 error_popup [mc "No tag name specified"] $mktagtop
8072 return 0
8074 if {[info exists tagids($tag)]} {
8075 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8076 return 0
8078 if {[catch {
8079 exec git tag $tag $id
8080 } err]} {
8081 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8082 return 0
8085 set tagids($tag) $id
8086 lappend idtags($id) $tag
8087 redrawtags $id
8088 addedtag $id
8089 dispneartags 0
8090 run refill_reflist
8091 return 1
8094 proc redrawtags {id} {
8095 global canv linehtag idpos currentid curview cmitlisted
8096 global canvxmax iddrawn circleitem mainheadid circlecolors
8098 if {![commitinview $id $curview]} return
8099 if {![info exists iddrawn($id)]} return
8100 set row [rowofcommit $id]
8101 if {$id eq $mainheadid} {
8102 set ofill yellow
8103 } else {
8104 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8106 $canv itemconf $circleitem($row) -fill $ofill
8107 $canv delete tag.$id
8108 set xt [eval drawtags $id $idpos($id)]
8109 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
8110 set text [$canv itemcget $linehtag($row) -text]
8111 set font [$canv itemcget $linehtag($row) -font]
8112 set xr [expr {$xt + [font measure $font $text]}]
8113 if {$xr > $canvxmax} {
8114 set canvxmax $xr
8115 setcanvscroll
8117 if {[info exists currentid] && $currentid == $id} {
8118 make_secsel $row
8122 proc mktagcan {} {
8123 global mktagtop
8125 catch {destroy $mktagtop}
8126 unset mktagtop
8129 proc mktaggo {} {
8130 if {![domktag]} return
8131 mktagcan
8134 proc writecommit {} {
8135 global rowmenuid wrcomtop commitinfo wrcomcmd
8137 set top .writecommit
8138 set wrcomtop $top
8139 catch {destroy $top}
8140 toplevel $top
8141 make_transient $top .
8142 label $top.title -text [mc "Write commit to file"]
8143 grid $top.title - -pady 10
8144 label $top.id -text [mc "ID:"]
8145 entry $top.sha1 -width 40 -relief flat
8146 $top.sha1 insert 0 $rowmenuid
8147 $top.sha1 conf -state readonly
8148 grid $top.id $top.sha1 -sticky w
8149 entry $top.head -width 60 -relief flat
8150 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8151 $top.head conf -state readonly
8152 grid x $top.head -sticky w
8153 label $top.clab -text [mc "Command:"]
8154 entry $top.cmd -width 60 -textvariable wrcomcmd
8155 grid $top.clab $top.cmd -sticky w -pady 10
8156 label $top.flab -text [mc "Output file:"]
8157 entry $top.fname -width 60
8158 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8159 grid $top.flab $top.fname -sticky w
8160 frame $top.buts
8161 button $top.buts.gen -text [mc "Write"] -command wrcomgo
8162 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8163 bind $top <Key-Return> wrcomgo
8164 bind $top <Key-Escape> wrcomcan
8165 grid $top.buts.gen $top.buts.can
8166 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8167 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8168 grid $top.buts - -pady 10 -sticky ew
8169 focus $top.fname
8172 proc wrcomgo {} {
8173 global wrcomtop
8175 set id [$wrcomtop.sha1 get]
8176 set cmd "echo $id | [$wrcomtop.cmd get]"
8177 set fname [$wrcomtop.fname get]
8178 if {[catch {exec sh -c $cmd >$fname &} err]} {
8179 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8181 catch {destroy $wrcomtop}
8182 unset wrcomtop
8185 proc wrcomcan {} {
8186 global wrcomtop
8188 catch {destroy $wrcomtop}
8189 unset wrcomtop
8192 proc mkbranch {} {
8193 global rowmenuid mkbrtop
8195 set top .makebranch
8196 catch {destroy $top}
8197 toplevel $top
8198 make_transient $top .
8199 label $top.title -text [mc "Create new branch"]
8200 grid $top.title - -pady 10
8201 label $top.id -text [mc "ID:"]
8202 entry $top.sha1 -width 40 -relief flat
8203 $top.sha1 insert 0 $rowmenuid
8204 $top.sha1 conf -state readonly
8205 grid $top.id $top.sha1 -sticky w
8206 label $top.nlab -text [mc "Name:"]
8207 entry $top.name -width 40
8208 bind $top.name <Key-Return> "[list mkbrgo $top]"
8209 grid $top.nlab $top.name -sticky w
8210 frame $top.buts
8211 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8212 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8213 bind $top <Key-Return> [list mkbrgo $top]
8214 bind $top <Key-Escape> "catch {destroy $top}"
8215 grid $top.buts.go $top.buts.can
8216 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8217 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8218 grid $top.buts - -pady 10 -sticky ew
8219 focus $top.name
8222 proc mkbrgo {top} {
8223 global headids idheads
8225 set name [$top.name get]
8226 set id [$top.sha1 get]
8227 set cmdargs {}
8228 set old_id {}
8229 if {$name eq {}} {
8230 error_popup [mc "Please specify a name for the new branch"] $top
8231 return
8233 if {[info exists headids($name)]} {
8234 if {![confirm_popup [mc \
8235 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8236 return
8238 set old_id $headids($name)
8239 lappend cmdargs -f
8241 catch {destroy $top}
8242 lappend cmdargs $name $id
8243 nowbusy newbranch
8244 update
8245 if {[catch {
8246 eval exec git branch $cmdargs
8247 } err]} {
8248 notbusy newbranch
8249 error_popup $err
8250 } else {
8251 notbusy newbranch
8252 if {$old_id ne {}} {
8253 movehead $id $name
8254 movedhead $id $name
8255 redrawtags $old_id
8256 redrawtags $id
8257 } else {
8258 set headids($name) $id
8259 lappend idheads($id) $name
8260 addedhead $id $name
8261 redrawtags $id
8263 dispneartags 0
8264 run refill_reflist
8268 proc exec_citool {tool_args {baseid {}}} {
8269 global commitinfo env
8271 set save_env [array get env GIT_AUTHOR_*]
8273 if {$baseid ne {}} {
8274 if {![info exists commitinfo($baseid)]} {
8275 getcommit $baseid
8277 set author [lindex $commitinfo($baseid) 1]
8278 set date [lindex $commitinfo($baseid) 2]
8279 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8280 $author author name email]
8281 && $date ne {}} {
8282 set env(GIT_AUTHOR_NAME) $name
8283 set env(GIT_AUTHOR_EMAIL) $email
8284 set env(GIT_AUTHOR_DATE) $date
8288 eval exec git citool $tool_args &
8290 array unset env GIT_AUTHOR_*
8291 array set env $save_env
8294 proc cherrypick {} {
8295 global rowmenuid curview
8296 global mainhead mainheadid
8298 set oldhead [exec git rev-parse HEAD]
8299 set dheads [descheads $rowmenuid]
8300 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8301 set ok [confirm_popup [mc "Commit %s is already\
8302 included in branch %s -- really re-apply it?" \
8303 [string range $rowmenuid 0 7] $mainhead]]
8304 if {!$ok} return
8306 nowbusy cherrypick [mc "Cherry-picking"]
8307 update
8308 # Unfortunately git-cherry-pick writes stuff to stderr even when
8309 # no error occurs, and exec takes that as an indication of error...
8310 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8311 notbusy cherrypick
8312 if {[regexp -line \
8313 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8314 $err msg fname]} {
8315 error_popup [mc "Cherry-pick failed because of local changes\
8316 to file '%s'.\nPlease commit, reset or stash\
8317 your changes and try again." $fname]
8318 } elseif {[regexp -line \
8319 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8320 $err]} {
8321 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8322 conflict.\nDo you wish to run git citool to\
8323 resolve it?"]]} {
8324 # Force citool to read MERGE_MSG
8325 file delete [file join [gitdir] "GITGUI_MSG"]
8326 exec_citool {} $rowmenuid
8328 } else {
8329 error_popup $err
8331 run updatecommits
8332 return
8334 set newhead [exec git rev-parse HEAD]
8335 if {$newhead eq $oldhead} {
8336 notbusy cherrypick
8337 error_popup [mc "No changes committed"]
8338 return
8340 addnewchild $newhead $oldhead
8341 if {[commitinview $oldhead $curview]} {
8342 insertrow $newhead $oldhead $curview
8343 if {$mainhead ne {}} {
8344 movehead $newhead $mainhead
8345 movedhead $newhead $mainhead
8347 set mainheadid $newhead
8348 redrawtags $oldhead
8349 redrawtags $newhead
8350 selbyid $newhead
8352 notbusy cherrypick
8355 proc resethead {} {
8356 global mainhead rowmenuid confirm_ok resettype
8358 set confirm_ok 0
8359 set w ".confirmreset"
8360 toplevel $w
8361 make_transient $w .
8362 wm title $w [mc "Confirm reset"]
8363 message $w.m -text \
8364 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8365 -justify center -aspect 1000
8366 pack $w.m -side top -fill x -padx 20 -pady 20
8367 frame $w.f -relief sunken -border 2
8368 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8369 grid $w.f.rt -sticky w
8370 set resettype mixed
8371 radiobutton $w.f.soft -value soft -variable resettype -justify left \
8372 -text [mc "Soft: Leave working tree and index untouched"]
8373 grid $w.f.soft -sticky w
8374 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8375 -text [mc "Mixed: Leave working tree untouched, reset index"]
8376 grid $w.f.mixed -sticky w
8377 radiobutton $w.f.hard -value hard -variable resettype -justify left \
8378 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8379 grid $w.f.hard -sticky w
8380 pack $w.f -side top -fill x
8381 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8382 pack $w.ok -side left -fill x -padx 20 -pady 20
8383 button $w.cancel -text [mc Cancel] -command "destroy $w"
8384 bind $w <Key-Escape> [list destroy $w]
8385 pack $w.cancel -side right -fill x -padx 20 -pady 20
8386 bind $w <Visibility> "grab $w; focus $w"
8387 tkwait window $w
8388 if {!$confirm_ok} return
8389 if {[catch {set fd [open \
8390 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8391 error_popup $err
8392 } else {
8393 dohidelocalchanges
8394 filerun $fd [list readresetstat $fd]
8395 nowbusy reset [mc "Resetting"]
8396 selbyid $rowmenuid
8400 proc readresetstat {fd} {
8401 global mainhead mainheadid showlocalchanges rprogcoord
8403 if {[gets $fd line] >= 0} {
8404 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8405 set rprogcoord [expr {1.0 * $m / $n}]
8406 adjustprogress
8408 return 1
8410 set rprogcoord 0
8411 adjustprogress
8412 notbusy reset
8413 if {[catch {close $fd} err]} {
8414 error_popup $err
8416 set oldhead $mainheadid
8417 set newhead [exec git rev-parse HEAD]
8418 if {$newhead ne $oldhead} {
8419 movehead $newhead $mainhead
8420 movedhead $newhead $mainhead
8421 set mainheadid $newhead
8422 redrawtags $oldhead
8423 redrawtags $newhead
8425 if {$showlocalchanges} {
8426 doshowlocalchanges
8428 return 0
8431 # context menu for a head
8432 proc headmenu {x y id head} {
8433 global headmenuid headmenuhead headctxmenu mainhead
8435 stopfinding
8436 set headmenuid $id
8437 set headmenuhead $head
8438 set state normal
8439 if {$head eq $mainhead} {
8440 set state disabled
8442 $headctxmenu entryconfigure 0 -state $state
8443 $headctxmenu entryconfigure 1 -state $state
8444 tk_popup $headctxmenu $x $y
8447 proc cobranch {} {
8448 global headmenuid headmenuhead headids
8449 global showlocalchanges mainheadid
8451 # check the tree is clean first??
8452 nowbusy checkout [mc "Checking out"]
8453 update
8454 dohidelocalchanges
8455 if {[catch {
8456 set fd [open [list | git checkout $headmenuhead 2>@1] r]
8457 } err]} {
8458 notbusy checkout
8459 error_popup $err
8460 if {$showlocalchanges} {
8461 dodiffindex
8463 } else {
8464 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8468 proc readcheckoutstat {fd newhead newheadid} {
8469 global mainhead mainheadid headids showlocalchanges progresscoords
8471 if {[gets $fd line] >= 0} {
8472 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8473 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8474 adjustprogress
8476 return 1
8478 set progresscoords {0 0}
8479 adjustprogress
8480 notbusy checkout
8481 if {[catch {close $fd} err]} {
8482 error_popup $err
8484 set oldmainid $mainheadid
8485 set mainhead $newhead
8486 set mainheadid $newheadid
8487 redrawtags $oldmainid
8488 redrawtags $newheadid
8489 selbyid $newheadid
8490 if {$showlocalchanges} {
8491 dodiffindex
8495 proc rmbranch {} {
8496 global headmenuid headmenuhead mainhead
8497 global idheads
8499 set head $headmenuhead
8500 set id $headmenuid
8501 # this check shouldn't be needed any more...
8502 if {$head eq $mainhead} {
8503 error_popup [mc "Cannot delete the currently checked-out branch"]
8504 return
8506 set dheads [descheads $id]
8507 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8508 # the stuff on this branch isn't on any other branch
8509 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8510 branch.\nReally delete branch %s?" $head $head]]} return
8512 nowbusy rmbranch
8513 update
8514 if {[catch {exec git branch -D $head} err]} {
8515 notbusy rmbranch
8516 error_popup $err
8517 return
8519 removehead $id $head
8520 removedhead $id $head
8521 redrawtags $id
8522 notbusy rmbranch
8523 dispneartags 0
8524 run refill_reflist
8527 # Display a list of tags and heads
8528 proc showrefs {} {
8529 global showrefstop bgcolor fgcolor selectbgcolor
8530 global bglist fglist reflistfilter reflist maincursor
8532 set top .showrefs
8533 set showrefstop $top
8534 if {[winfo exists $top]} {
8535 raise $top
8536 refill_reflist
8537 return
8539 toplevel $top
8540 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8541 make_transient $top .
8542 text $top.list -background $bgcolor -foreground $fgcolor \
8543 -selectbackground $selectbgcolor -font mainfont \
8544 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8545 -width 30 -height 20 -cursor $maincursor \
8546 -spacing1 1 -spacing3 1 -state disabled
8547 $top.list tag configure highlight -background $selectbgcolor
8548 lappend bglist $top.list
8549 lappend fglist $top.list
8550 scrollbar $top.ysb -command "$top.list yview" -orient vertical
8551 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8552 grid $top.list $top.ysb -sticky nsew
8553 grid $top.xsb x -sticky ew
8554 frame $top.f
8555 label $top.f.l -text "[mc "Filter"]: "
8556 entry $top.f.e -width 20 -textvariable reflistfilter
8557 set reflistfilter "*"
8558 trace add variable reflistfilter write reflistfilter_change
8559 pack $top.f.e -side right -fill x -expand 1
8560 pack $top.f.l -side left
8561 grid $top.f - -sticky ew -pady 2
8562 button $top.close -command [list destroy $top] -text [mc "Close"]
8563 bind $top <Key-Escape> [list destroy $top]
8564 grid $top.close -
8565 grid columnconfigure $top 0 -weight 1
8566 grid rowconfigure $top 0 -weight 1
8567 bind $top.list <1> {break}
8568 bind $top.list <B1-Motion> {break}
8569 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8570 set reflist {}
8571 refill_reflist
8574 proc sel_reflist {w x y} {
8575 global showrefstop reflist headids tagids otherrefids
8577 if {![winfo exists $showrefstop]} return
8578 set l [lindex [split [$w index "@$x,$y"] "."] 0]
8579 set ref [lindex $reflist [expr {$l-1}]]
8580 set n [lindex $ref 0]
8581 switch -- [lindex $ref 1] {
8582 "H" {selbyid $headids($n)}
8583 "T" {selbyid $tagids($n)}
8584 "o" {selbyid $otherrefids($n)}
8586 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8589 proc unsel_reflist {} {
8590 global showrefstop
8592 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8593 $showrefstop.list tag remove highlight 0.0 end
8596 proc reflistfilter_change {n1 n2 op} {
8597 global reflistfilter
8599 after cancel refill_reflist
8600 after 200 refill_reflist
8603 proc refill_reflist {} {
8604 global reflist reflistfilter showrefstop headids tagids otherrefids
8605 global curview
8607 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8608 set refs {}
8609 foreach n [array names headids] {
8610 if {[string match $reflistfilter $n]} {
8611 if {[commitinview $headids($n) $curview]} {
8612 lappend refs [list $n H]
8613 } else {
8614 interestedin $headids($n) {run refill_reflist}
8618 foreach n [array names tagids] {
8619 if {[string match $reflistfilter $n]} {
8620 if {[commitinview $tagids($n) $curview]} {
8621 lappend refs [list $n T]
8622 } else {
8623 interestedin $tagids($n) {run refill_reflist}
8627 foreach n [array names otherrefids] {
8628 if {[string match $reflistfilter $n]} {
8629 if {[commitinview $otherrefids($n) $curview]} {
8630 lappend refs [list $n o]
8631 } else {
8632 interestedin $otherrefids($n) {run refill_reflist}
8636 set refs [lsort -index 0 $refs]
8637 if {$refs eq $reflist} return
8639 # Update the contents of $showrefstop.list according to the
8640 # differences between $reflist (old) and $refs (new)
8641 $showrefstop.list conf -state normal
8642 $showrefstop.list insert end "\n"
8643 set i 0
8644 set j 0
8645 while {$i < [llength $reflist] || $j < [llength $refs]} {
8646 if {$i < [llength $reflist]} {
8647 if {$j < [llength $refs]} {
8648 set cmp [string compare [lindex $reflist $i 0] \
8649 [lindex $refs $j 0]]
8650 if {$cmp == 0} {
8651 set cmp [string compare [lindex $reflist $i 1] \
8652 [lindex $refs $j 1]]
8654 } else {
8655 set cmp -1
8657 } else {
8658 set cmp 1
8660 switch -- $cmp {
8661 -1 {
8662 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8663 incr i
8666 incr i
8667 incr j
8670 set l [expr {$j + 1}]
8671 $showrefstop.list image create $l.0 -align baseline \
8672 -image reficon-[lindex $refs $j 1] -padx 2
8673 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8674 incr j
8678 set reflist $refs
8679 # delete last newline
8680 $showrefstop.list delete end-2c end-1c
8681 $showrefstop.list conf -state disabled
8684 # Stuff for finding nearby tags
8685 proc getallcommits {} {
8686 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8687 global idheads idtags idotherrefs allparents tagobjid
8689 if {![info exists allcommits]} {
8690 set nextarc 0
8691 set allcommits 0
8692 set seeds {}
8693 set allcwait 0
8694 set cachedarcs 0
8695 set allccache [file join [gitdir] "gitk.cache"]
8696 if {![catch {
8697 set f [open $allccache r]
8698 set allcwait 1
8699 getcache $f
8700 }]} return
8703 if {$allcwait} {
8704 return
8706 set cmd [list | git rev-list --parents]
8707 set allcupdate [expr {$seeds ne {}}]
8708 if {!$allcupdate} {
8709 set ids "--all"
8710 } else {
8711 set refs [concat [array names idheads] [array names idtags] \
8712 [array names idotherrefs]]
8713 set ids {}
8714 set tagobjs {}
8715 foreach name [array names tagobjid] {
8716 lappend tagobjs $tagobjid($name)
8718 foreach id [lsort -unique $refs] {
8719 if {![info exists allparents($id)] &&
8720 [lsearch -exact $tagobjs $id] < 0} {
8721 lappend ids $id
8724 if {$ids ne {}} {
8725 foreach id $seeds {
8726 lappend ids "^$id"
8730 if {$ids ne {}} {
8731 set fd [open [concat $cmd $ids] r]
8732 fconfigure $fd -blocking 0
8733 incr allcommits
8734 nowbusy allcommits
8735 filerun $fd [list getallclines $fd]
8736 } else {
8737 dispneartags 0
8741 # Since most commits have 1 parent and 1 child, we group strings of
8742 # such commits into "arcs" joining branch/merge points (BMPs), which
8743 # are commits that either don't have 1 parent or don't have 1 child.
8745 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8746 # arcout(id) - outgoing arcs for BMP
8747 # arcids(a) - list of IDs on arc including end but not start
8748 # arcstart(a) - BMP ID at start of arc
8749 # arcend(a) - BMP ID at end of arc
8750 # growing(a) - arc a is still growing
8751 # arctags(a) - IDs out of arcids (excluding end) that have tags
8752 # archeads(a) - IDs out of arcids (excluding end) that have heads
8753 # The start of an arc is at the descendent end, so "incoming" means
8754 # coming from descendents, and "outgoing" means going towards ancestors.
8756 proc getallclines {fd} {
8757 global allparents allchildren idtags idheads nextarc
8758 global arcnos arcids arctags arcout arcend arcstart archeads growing
8759 global seeds allcommits cachedarcs allcupdate
8761 set nid 0
8762 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8763 set id [lindex $line 0]
8764 if {[info exists allparents($id)]} {
8765 # seen it already
8766 continue
8768 set cachedarcs 0
8769 set olds [lrange $line 1 end]
8770 set allparents($id) $olds
8771 if {![info exists allchildren($id)]} {
8772 set allchildren($id) {}
8773 set arcnos($id) {}
8774 lappend seeds $id
8775 } else {
8776 set a $arcnos($id)
8777 if {[llength $olds] == 1 && [llength $a] == 1} {
8778 lappend arcids($a) $id
8779 if {[info exists idtags($id)]} {
8780 lappend arctags($a) $id
8782 if {[info exists idheads($id)]} {
8783 lappend archeads($a) $id
8785 if {[info exists allparents($olds)]} {
8786 # seen parent already
8787 if {![info exists arcout($olds)]} {
8788 splitarc $olds
8790 lappend arcids($a) $olds
8791 set arcend($a) $olds
8792 unset growing($a)
8794 lappend allchildren($olds) $id
8795 lappend arcnos($olds) $a
8796 continue
8799 foreach a $arcnos($id) {
8800 lappend arcids($a) $id
8801 set arcend($a) $id
8802 unset growing($a)
8805 set ao {}
8806 foreach p $olds {
8807 lappend allchildren($p) $id
8808 set a [incr nextarc]
8809 set arcstart($a) $id
8810 set archeads($a) {}
8811 set arctags($a) {}
8812 set archeads($a) {}
8813 set arcids($a) {}
8814 lappend ao $a
8815 set growing($a) 1
8816 if {[info exists allparents($p)]} {
8817 # seen it already, may need to make a new branch
8818 if {![info exists arcout($p)]} {
8819 splitarc $p
8821 lappend arcids($a) $p
8822 set arcend($a) $p
8823 unset growing($a)
8825 lappend arcnos($p) $a
8827 set arcout($id) $ao
8829 if {$nid > 0} {
8830 global cached_dheads cached_dtags cached_atags
8831 catch {unset cached_dheads}
8832 catch {unset cached_dtags}
8833 catch {unset cached_atags}
8835 if {![eof $fd]} {
8836 return [expr {$nid >= 1000? 2: 1}]
8838 set cacheok 1
8839 if {[catch {
8840 fconfigure $fd -blocking 1
8841 close $fd
8842 } err]} {
8843 # got an error reading the list of commits
8844 # if we were updating, try rereading the whole thing again
8845 if {$allcupdate} {
8846 incr allcommits -1
8847 dropcache $err
8848 return
8850 error_popup "[mc "Error reading commit topology information;\
8851 branch and preceding/following tag information\
8852 will be incomplete."]\n($err)"
8853 set cacheok 0
8855 if {[incr allcommits -1] == 0} {
8856 notbusy allcommits
8857 if {$cacheok} {
8858 run savecache
8861 dispneartags 0
8862 return 0
8865 proc recalcarc {a} {
8866 global arctags archeads arcids idtags idheads
8868 set at {}
8869 set ah {}
8870 foreach id [lrange $arcids($a) 0 end-1] {
8871 if {[info exists idtags($id)]} {
8872 lappend at $id
8874 if {[info exists idheads($id)]} {
8875 lappend ah $id
8878 set arctags($a) $at
8879 set archeads($a) $ah
8882 proc splitarc {p} {
8883 global arcnos arcids nextarc arctags archeads idtags idheads
8884 global arcstart arcend arcout allparents growing
8886 set a $arcnos($p)
8887 if {[llength $a] != 1} {
8888 puts "oops splitarc called but [llength $a] arcs already"
8889 return
8891 set a [lindex $a 0]
8892 set i [lsearch -exact $arcids($a) $p]
8893 if {$i < 0} {
8894 puts "oops splitarc $p not in arc $a"
8895 return
8897 set na [incr nextarc]
8898 if {[info exists arcend($a)]} {
8899 set arcend($na) $arcend($a)
8900 } else {
8901 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8902 set j [lsearch -exact $arcnos($l) $a]
8903 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8905 set tail [lrange $arcids($a) [expr {$i+1}] end]
8906 set arcids($a) [lrange $arcids($a) 0 $i]
8907 set arcend($a) $p
8908 set arcstart($na) $p
8909 set arcout($p) $na
8910 set arcids($na) $tail
8911 if {[info exists growing($a)]} {
8912 set growing($na) 1
8913 unset growing($a)
8916 foreach id $tail {
8917 if {[llength $arcnos($id)] == 1} {
8918 set arcnos($id) $na
8919 } else {
8920 set j [lsearch -exact $arcnos($id) $a]
8921 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8925 # reconstruct tags and heads lists
8926 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8927 recalcarc $a
8928 recalcarc $na
8929 } else {
8930 set arctags($na) {}
8931 set archeads($na) {}
8935 # Update things for a new commit added that is a child of one
8936 # existing commit. Used when cherry-picking.
8937 proc addnewchild {id p} {
8938 global allparents allchildren idtags nextarc
8939 global arcnos arcids arctags arcout arcend arcstart archeads growing
8940 global seeds allcommits
8942 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8943 set allparents($id) [list $p]
8944 set allchildren($id) {}
8945 set arcnos($id) {}
8946 lappend seeds $id
8947 lappend allchildren($p) $id
8948 set a [incr nextarc]
8949 set arcstart($a) $id
8950 set archeads($a) {}
8951 set arctags($a) {}
8952 set arcids($a) [list $p]
8953 set arcend($a) $p
8954 if {![info exists arcout($p)]} {
8955 splitarc $p
8957 lappend arcnos($p) $a
8958 set arcout($id) [list $a]
8961 # This implements a cache for the topology information.
8962 # The cache saves, for each arc, the start and end of the arc,
8963 # the ids on the arc, and the outgoing arcs from the end.
8964 proc readcache {f} {
8965 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8966 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8967 global allcwait
8969 set a $nextarc
8970 set lim $cachedarcs
8971 if {$lim - $a > 500} {
8972 set lim [expr {$a + 500}]
8974 if {[catch {
8975 if {$a == $lim} {
8976 # finish reading the cache and setting up arctags, etc.
8977 set line [gets $f]
8978 if {$line ne "1"} {error "bad final version"}
8979 close $f
8980 foreach id [array names idtags] {
8981 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8982 [llength $allparents($id)] == 1} {
8983 set a [lindex $arcnos($id) 0]
8984 if {$arctags($a) eq {}} {
8985 recalcarc $a
8989 foreach id [array names idheads] {
8990 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8991 [llength $allparents($id)] == 1} {
8992 set a [lindex $arcnos($id) 0]
8993 if {$archeads($a) eq {}} {
8994 recalcarc $a
8998 foreach id [lsort -unique $possible_seeds] {
8999 if {$arcnos($id) eq {}} {
9000 lappend seeds $id
9003 set allcwait 0
9004 } else {
9005 while {[incr a] <= $lim} {
9006 set line [gets $f]
9007 if {[llength $line] != 3} {error "bad line"}
9008 set s [lindex $line 0]
9009 set arcstart($a) $s
9010 lappend arcout($s) $a
9011 if {![info exists arcnos($s)]} {
9012 lappend possible_seeds $s
9013 set arcnos($s) {}
9015 set e [lindex $line 1]
9016 if {$e eq {}} {
9017 set growing($a) 1
9018 } else {
9019 set arcend($a) $e
9020 if {![info exists arcout($e)]} {
9021 set arcout($e) {}
9024 set arcids($a) [lindex $line 2]
9025 foreach id $arcids($a) {
9026 lappend allparents($s) $id
9027 set s $id
9028 lappend arcnos($id) $a
9030 if {![info exists allparents($s)]} {
9031 set allparents($s) {}
9033 set arctags($a) {}
9034 set archeads($a) {}
9036 set nextarc [expr {$a - 1}]
9038 } err]} {
9039 dropcache $err
9040 return 0
9042 if {!$allcwait} {
9043 getallcommits
9045 return $allcwait
9048 proc getcache {f} {
9049 global nextarc cachedarcs possible_seeds
9051 if {[catch {
9052 set line [gets $f]
9053 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9054 # make sure it's an integer
9055 set cachedarcs [expr {int([lindex $line 1])}]
9056 if {$cachedarcs < 0} {error "bad number of arcs"}
9057 set nextarc 0
9058 set possible_seeds {}
9059 run readcache $f
9060 } err]} {
9061 dropcache $err
9063 return 0
9066 proc dropcache {err} {
9067 global allcwait nextarc cachedarcs seeds
9069 #puts "dropping cache ($err)"
9070 foreach v {arcnos arcout arcids arcstart arcend growing \
9071 arctags archeads allparents allchildren} {
9072 global $v
9073 catch {unset $v}
9075 set allcwait 0
9076 set nextarc 0
9077 set cachedarcs 0
9078 set seeds {}
9079 getallcommits
9082 proc writecache {f} {
9083 global cachearc cachedarcs allccache
9084 global arcstart arcend arcnos arcids arcout
9086 set a $cachearc
9087 set lim $cachedarcs
9088 if {$lim - $a > 1000} {
9089 set lim [expr {$a + 1000}]
9091 if {[catch {
9092 while {[incr a] <= $lim} {
9093 if {[info exists arcend($a)]} {
9094 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9095 } else {
9096 puts $f [list $arcstart($a) {} $arcids($a)]
9099 } err]} {
9100 catch {close $f}
9101 catch {file delete $allccache}
9102 #puts "writing cache failed ($err)"
9103 return 0
9105 set cachearc [expr {$a - 1}]
9106 if {$a > $cachedarcs} {
9107 puts $f "1"
9108 close $f
9109 return 0
9111 return 1
9114 proc savecache {} {
9115 global nextarc cachedarcs cachearc allccache
9117 if {$nextarc == $cachedarcs} return
9118 set cachearc 0
9119 set cachedarcs $nextarc
9120 catch {
9121 set f [open $allccache w]
9122 puts $f [list 1 $cachedarcs]
9123 run writecache $f
9127 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9128 # or 0 if neither is true.
9129 proc anc_or_desc {a b} {
9130 global arcout arcstart arcend arcnos cached_isanc
9132 if {$arcnos($a) eq $arcnos($b)} {
9133 # Both are on the same arc(s); either both are the same BMP,
9134 # or if one is not a BMP, the other is also not a BMP or is
9135 # the BMP at end of the arc (and it only has 1 incoming arc).
9136 # Or both can be BMPs with no incoming arcs.
9137 if {$a eq $b || $arcnos($a) eq {}} {
9138 return 0
9140 # assert {[llength $arcnos($a)] == 1}
9141 set arc [lindex $arcnos($a) 0]
9142 set i [lsearch -exact $arcids($arc) $a]
9143 set j [lsearch -exact $arcids($arc) $b]
9144 if {$i < 0 || $i > $j} {
9145 return 1
9146 } else {
9147 return -1
9151 if {![info exists arcout($a)]} {
9152 set arc [lindex $arcnos($a) 0]
9153 if {[info exists arcend($arc)]} {
9154 set aend $arcend($arc)
9155 } else {
9156 set aend {}
9158 set a $arcstart($arc)
9159 } else {
9160 set aend $a
9162 if {![info exists arcout($b)]} {
9163 set arc [lindex $arcnos($b) 0]
9164 if {[info exists arcend($arc)]} {
9165 set bend $arcend($arc)
9166 } else {
9167 set bend {}
9169 set b $arcstart($arc)
9170 } else {
9171 set bend $b
9173 if {$a eq $bend} {
9174 return 1
9176 if {$b eq $aend} {
9177 return -1
9179 if {[info exists cached_isanc($a,$bend)]} {
9180 if {$cached_isanc($a,$bend)} {
9181 return 1
9184 if {[info exists cached_isanc($b,$aend)]} {
9185 if {$cached_isanc($b,$aend)} {
9186 return -1
9188 if {[info exists cached_isanc($a,$bend)]} {
9189 return 0
9193 set todo [list $a $b]
9194 set anc($a) a
9195 set anc($b) b
9196 for {set i 0} {$i < [llength $todo]} {incr i} {
9197 set x [lindex $todo $i]
9198 if {$anc($x) eq {}} {
9199 continue
9201 foreach arc $arcnos($x) {
9202 set xd $arcstart($arc)
9203 if {$xd eq $bend} {
9204 set cached_isanc($a,$bend) 1
9205 set cached_isanc($b,$aend) 0
9206 return 1
9207 } elseif {$xd eq $aend} {
9208 set cached_isanc($b,$aend) 1
9209 set cached_isanc($a,$bend) 0
9210 return -1
9212 if {![info exists anc($xd)]} {
9213 set anc($xd) $anc($x)
9214 lappend todo $xd
9215 } elseif {$anc($xd) ne $anc($x)} {
9216 set anc($xd) {}
9220 set cached_isanc($a,$bend) 0
9221 set cached_isanc($b,$aend) 0
9222 return 0
9225 # This identifies whether $desc has an ancestor that is
9226 # a growing tip of the graph and which is not an ancestor of $anc
9227 # and returns 0 if so and 1 if not.
9228 # If we subsequently discover a tag on such a growing tip, and that
9229 # turns out to be a descendent of $anc (which it could, since we
9230 # don't necessarily see children before parents), then $desc
9231 # isn't a good choice to display as a descendent tag of
9232 # $anc (since it is the descendent of another tag which is
9233 # a descendent of $anc). Similarly, $anc isn't a good choice to
9234 # display as a ancestor tag of $desc.
9236 proc is_certain {desc anc} {
9237 global arcnos arcout arcstart arcend growing problems
9239 set certain {}
9240 if {[llength $arcnos($anc)] == 1} {
9241 # tags on the same arc are certain
9242 if {$arcnos($desc) eq $arcnos($anc)} {
9243 return 1
9245 if {![info exists arcout($anc)]} {
9246 # if $anc is partway along an arc, use the start of the arc instead
9247 set a [lindex $arcnos($anc) 0]
9248 set anc $arcstart($a)
9251 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9252 set x $desc
9253 } else {
9254 set a [lindex $arcnos($desc) 0]
9255 set x $arcend($a)
9257 if {$x == $anc} {
9258 return 1
9260 set anclist [list $x]
9261 set dl($x) 1
9262 set nnh 1
9263 set ngrowanc 0
9264 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9265 set x [lindex $anclist $i]
9266 if {$dl($x)} {
9267 incr nnh -1
9269 set done($x) 1
9270 foreach a $arcout($x) {
9271 if {[info exists growing($a)]} {
9272 if {![info exists growanc($x)] && $dl($x)} {
9273 set growanc($x) 1
9274 incr ngrowanc
9276 } else {
9277 set y $arcend($a)
9278 if {[info exists dl($y)]} {
9279 if {$dl($y)} {
9280 if {!$dl($x)} {
9281 set dl($y) 0
9282 if {![info exists done($y)]} {
9283 incr nnh -1
9285 if {[info exists growanc($x)]} {
9286 incr ngrowanc -1
9288 set xl [list $y]
9289 for {set k 0} {$k < [llength $xl]} {incr k} {
9290 set z [lindex $xl $k]
9291 foreach c $arcout($z) {
9292 if {[info exists arcend($c)]} {
9293 set v $arcend($c)
9294 if {[info exists dl($v)] && $dl($v)} {
9295 set dl($v) 0
9296 if {![info exists done($v)]} {
9297 incr nnh -1
9299 if {[info exists growanc($v)]} {
9300 incr ngrowanc -1
9302 lappend xl $v
9309 } elseif {$y eq $anc || !$dl($x)} {
9310 set dl($y) 0
9311 lappend anclist $y
9312 } else {
9313 set dl($y) 1
9314 lappend anclist $y
9315 incr nnh
9320 foreach x [array names growanc] {
9321 if {$dl($x)} {
9322 return 0
9324 return 0
9326 return 1
9329 proc validate_arctags {a} {
9330 global arctags idtags
9332 set i -1
9333 set na $arctags($a)
9334 foreach id $arctags($a) {
9335 incr i
9336 if {![info exists idtags($id)]} {
9337 set na [lreplace $na $i $i]
9338 incr i -1
9341 set arctags($a) $na
9344 proc validate_archeads {a} {
9345 global archeads idheads
9347 set i -1
9348 set na $archeads($a)
9349 foreach id $archeads($a) {
9350 incr i
9351 if {![info exists idheads($id)]} {
9352 set na [lreplace $na $i $i]
9353 incr i -1
9356 set archeads($a) $na
9359 # Return the list of IDs that have tags that are descendents of id,
9360 # ignoring IDs that are descendents of IDs already reported.
9361 proc desctags {id} {
9362 global arcnos arcstart arcids arctags idtags allparents
9363 global growing cached_dtags
9365 if {![info exists allparents($id)]} {
9366 return {}
9368 set t1 [clock clicks -milliseconds]
9369 set argid $id
9370 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9371 # part-way along an arc; check that arc first
9372 set a [lindex $arcnos($id) 0]
9373 if {$arctags($a) ne {}} {
9374 validate_arctags $a
9375 set i [lsearch -exact $arcids($a) $id]
9376 set tid {}
9377 foreach t $arctags($a) {
9378 set j [lsearch -exact $arcids($a) $t]
9379 if {$j >= $i} break
9380 set tid $t
9382 if {$tid ne {}} {
9383 return $tid
9386 set id $arcstart($a)
9387 if {[info exists idtags($id)]} {
9388 return $id
9391 if {[info exists cached_dtags($id)]} {
9392 return $cached_dtags($id)
9395 set origid $id
9396 set todo [list $id]
9397 set queued($id) 1
9398 set nc 1
9399 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9400 set id [lindex $todo $i]
9401 set done($id) 1
9402 set ta [info exists hastaggedancestor($id)]
9403 if {!$ta} {
9404 incr nc -1
9406 # ignore tags on starting node
9407 if {!$ta && $i > 0} {
9408 if {[info exists idtags($id)]} {
9409 set tagloc($id) $id
9410 set ta 1
9411 } elseif {[info exists cached_dtags($id)]} {
9412 set tagloc($id) $cached_dtags($id)
9413 set ta 1
9416 foreach a $arcnos($id) {
9417 set d $arcstart($a)
9418 if {!$ta && $arctags($a) ne {}} {
9419 validate_arctags $a
9420 if {$arctags($a) ne {}} {
9421 lappend tagloc($id) [lindex $arctags($a) end]
9424 if {$ta || $arctags($a) ne {}} {
9425 set tomark [list $d]
9426 for {set j 0} {$j < [llength $tomark]} {incr j} {
9427 set dd [lindex $tomark $j]
9428 if {![info exists hastaggedancestor($dd)]} {
9429 if {[info exists done($dd)]} {
9430 foreach b $arcnos($dd) {
9431 lappend tomark $arcstart($b)
9433 if {[info exists tagloc($dd)]} {
9434 unset tagloc($dd)
9436 } elseif {[info exists queued($dd)]} {
9437 incr nc -1
9439 set hastaggedancestor($dd) 1
9443 if {![info exists queued($d)]} {
9444 lappend todo $d
9445 set queued($d) 1
9446 if {![info exists hastaggedancestor($d)]} {
9447 incr nc
9452 set tags {}
9453 foreach id [array names tagloc] {
9454 if {![info exists hastaggedancestor($id)]} {
9455 foreach t $tagloc($id) {
9456 if {[lsearch -exact $tags $t] < 0} {
9457 lappend tags $t
9462 set t2 [clock clicks -milliseconds]
9463 set loopix $i
9465 # remove tags that are descendents of other tags
9466 for {set i 0} {$i < [llength $tags]} {incr i} {
9467 set a [lindex $tags $i]
9468 for {set j 0} {$j < $i} {incr j} {
9469 set b [lindex $tags $j]
9470 set r [anc_or_desc $a $b]
9471 if {$r == 1} {
9472 set tags [lreplace $tags $j $j]
9473 incr j -1
9474 incr i -1
9475 } elseif {$r == -1} {
9476 set tags [lreplace $tags $i $i]
9477 incr i -1
9478 break
9483 if {[array names growing] ne {}} {
9484 # graph isn't finished, need to check if any tag could get
9485 # eclipsed by another tag coming later. Simply ignore any
9486 # tags that could later get eclipsed.
9487 set ctags {}
9488 foreach t $tags {
9489 if {[is_certain $t $origid]} {
9490 lappend ctags $t
9493 if {$tags eq $ctags} {
9494 set cached_dtags($origid) $tags
9495 } else {
9496 set tags $ctags
9498 } else {
9499 set cached_dtags($origid) $tags
9501 set t3 [clock clicks -milliseconds]
9502 if {0 && $t3 - $t1 >= 100} {
9503 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9504 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9506 return $tags
9509 proc anctags {id} {
9510 global arcnos arcids arcout arcend arctags idtags allparents
9511 global growing cached_atags
9513 if {![info exists allparents($id)]} {
9514 return {}
9516 set t1 [clock clicks -milliseconds]
9517 set argid $id
9518 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9519 # part-way along an arc; check that arc first
9520 set a [lindex $arcnos($id) 0]
9521 if {$arctags($a) ne {}} {
9522 validate_arctags $a
9523 set i [lsearch -exact $arcids($a) $id]
9524 foreach t $arctags($a) {
9525 set j [lsearch -exact $arcids($a) $t]
9526 if {$j > $i} {
9527 return $t
9531 if {![info exists arcend($a)]} {
9532 return {}
9534 set id $arcend($a)
9535 if {[info exists idtags($id)]} {
9536 return $id
9539 if {[info exists cached_atags($id)]} {
9540 return $cached_atags($id)
9543 set origid $id
9544 set todo [list $id]
9545 set queued($id) 1
9546 set taglist {}
9547 set nc 1
9548 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9549 set id [lindex $todo $i]
9550 set done($id) 1
9551 set td [info exists hastaggeddescendent($id)]
9552 if {!$td} {
9553 incr nc -1
9555 # ignore tags on starting node
9556 if {!$td && $i > 0} {
9557 if {[info exists idtags($id)]} {
9558 set tagloc($id) $id
9559 set td 1
9560 } elseif {[info exists cached_atags($id)]} {
9561 set tagloc($id) $cached_atags($id)
9562 set td 1
9565 foreach a $arcout($id) {
9566 if {!$td && $arctags($a) ne {}} {
9567 validate_arctags $a
9568 if {$arctags($a) ne {}} {
9569 lappend tagloc($id) [lindex $arctags($a) 0]
9572 if {![info exists arcend($a)]} continue
9573 set d $arcend($a)
9574 if {$td || $arctags($a) ne {}} {
9575 set tomark [list $d]
9576 for {set j 0} {$j < [llength $tomark]} {incr j} {
9577 set dd [lindex $tomark $j]
9578 if {![info exists hastaggeddescendent($dd)]} {
9579 if {[info exists done($dd)]} {
9580 foreach b $arcout($dd) {
9581 if {[info exists arcend($b)]} {
9582 lappend tomark $arcend($b)
9585 if {[info exists tagloc($dd)]} {
9586 unset tagloc($dd)
9588 } elseif {[info exists queued($dd)]} {
9589 incr nc -1
9591 set hastaggeddescendent($dd) 1
9595 if {![info exists queued($d)]} {
9596 lappend todo $d
9597 set queued($d) 1
9598 if {![info exists hastaggeddescendent($d)]} {
9599 incr nc
9604 set t2 [clock clicks -milliseconds]
9605 set loopix $i
9606 set tags {}
9607 foreach id [array names tagloc] {
9608 if {![info exists hastaggeddescendent($id)]} {
9609 foreach t $tagloc($id) {
9610 if {[lsearch -exact $tags $t] < 0} {
9611 lappend tags $t
9617 # remove tags that are ancestors of other tags
9618 for {set i 0} {$i < [llength $tags]} {incr i} {
9619 set a [lindex $tags $i]
9620 for {set j 0} {$j < $i} {incr j} {
9621 set b [lindex $tags $j]
9622 set r [anc_or_desc $a $b]
9623 if {$r == -1} {
9624 set tags [lreplace $tags $j $j]
9625 incr j -1
9626 incr i -1
9627 } elseif {$r == 1} {
9628 set tags [lreplace $tags $i $i]
9629 incr i -1
9630 break
9635 if {[array names growing] ne {}} {
9636 # graph isn't finished, need to check if any tag could get
9637 # eclipsed by another tag coming later. Simply ignore any
9638 # tags that could later get eclipsed.
9639 set ctags {}
9640 foreach t $tags {
9641 if {[is_certain $origid $t]} {
9642 lappend ctags $t
9645 if {$tags eq $ctags} {
9646 set cached_atags($origid) $tags
9647 } else {
9648 set tags $ctags
9650 } else {
9651 set cached_atags($origid) $tags
9653 set t3 [clock clicks -milliseconds]
9654 if {0 && $t3 - $t1 >= 100} {
9655 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9656 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9658 return $tags
9661 # Return the list of IDs that have heads that are descendents of id,
9662 # including id itself if it has a head.
9663 proc descheads {id} {
9664 global arcnos arcstart arcids archeads idheads cached_dheads
9665 global allparents
9667 if {![info exists allparents($id)]} {
9668 return {}
9670 set aret {}
9671 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9672 # part-way along an arc; check it first
9673 set a [lindex $arcnos($id) 0]
9674 if {$archeads($a) ne {}} {
9675 validate_archeads $a
9676 set i [lsearch -exact $arcids($a) $id]
9677 foreach t $archeads($a) {
9678 set j [lsearch -exact $arcids($a) $t]
9679 if {$j > $i} break
9680 lappend aret $t
9683 set id $arcstart($a)
9685 set origid $id
9686 set todo [list $id]
9687 set seen($id) 1
9688 set ret {}
9689 for {set i 0} {$i < [llength $todo]} {incr i} {
9690 set id [lindex $todo $i]
9691 if {[info exists cached_dheads($id)]} {
9692 set ret [concat $ret $cached_dheads($id)]
9693 } else {
9694 if {[info exists idheads($id)]} {
9695 lappend ret $id
9697 foreach a $arcnos($id) {
9698 if {$archeads($a) ne {}} {
9699 validate_archeads $a
9700 if {$archeads($a) ne {}} {
9701 set ret [concat $ret $archeads($a)]
9704 set d $arcstart($a)
9705 if {![info exists seen($d)]} {
9706 lappend todo $d
9707 set seen($d) 1
9712 set ret [lsort -unique $ret]
9713 set cached_dheads($origid) $ret
9714 return [concat $ret $aret]
9717 proc addedtag {id} {
9718 global arcnos arcout cached_dtags cached_atags
9720 if {![info exists arcnos($id)]} return
9721 if {![info exists arcout($id)]} {
9722 recalcarc [lindex $arcnos($id) 0]
9724 catch {unset cached_dtags}
9725 catch {unset cached_atags}
9728 proc addedhead {hid head} {
9729 global arcnos arcout cached_dheads
9731 if {![info exists arcnos($hid)]} return
9732 if {![info exists arcout($hid)]} {
9733 recalcarc [lindex $arcnos($hid) 0]
9735 catch {unset cached_dheads}
9738 proc removedhead {hid head} {
9739 global cached_dheads
9741 catch {unset cached_dheads}
9744 proc movedhead {hid head} {
9745 global arcnos arcout cached_dheads
9747 if {![info exists arcnos($hid)]} return
9748 if {![info exists arcout($hid)]} {
9749 recalcarc [lindex $arcnos($hid) 0]
9751 catch {unset cached_dheads}
9754 proc changedrefs {} {
9755 global cached_dheads cached_dtags cached_atags
9756 global arctags archeads arcnos arcout idheads idtags
9758 foreach id [concat [array names idheads] [array names idtags]] {
9759 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9760 set a [lindex $arcnos($id) 0]
9761 if {![info exists donearc($a)]} {
9762 recalcarc $a
9763 set donearc($a) 1
9767 catch {unset cached_dtags}
9768 catch {unset cached_atags}
9769 catch {unset cached_dheads}
9772 proc rereadrefs {} {
9773 global idtags idheads idotherrefs mainheadid
9775 set refids [concat [array names idtags] \
9776 [array names idheads] [array names idotherrefs]]
9777 foreach id $refids {
9778 if {![info exists ref($id)]} {
9779 set ref($id) [listrefs $id]
9782 set oldmainhead $mainheadid
9783 readrefs
9784 changedrefs
9785 set refids [lsort -unique [concat $refids [array names idtags] \
9786 [array names idheads] [array names idotherrefs]]]
9787 foreach id $refids {
9788 set v [listrefs $id]
9789 if {![info exists ref($id)] || $ref($id) != $v} {
9790 redrawtags $id
9793 if {$oldmainhead ne $mainheadid} {
9794 redrawtags $oldmainhead
9795 redrawtags $mainheadid
9797 run refill_reflist
9800 proc listrefs {id} {
9801 global idtags idheads idotherrefs
9803 set x {}
9804 if {[info exists idtags($id)]} {
9805 set x $idtags($id)
9807 set y {}
9808 if {[info exists idheads($id)]} {
9809 set y $idheads($id)
9811 set z {}
9812 if {[info exists idotherrefs($id)]} {
9813 set z $idotherrefs($id)
9815 return [list $x $y $z]
9818 proc showtag {tag isnew} {
9819 global ctext tagcontents tagids linknum tagobjid
9821 if {$isnew} {
9822 addtohistory [list showtag $tag 0]
9824 $ctext conf -state normal
9825 clear_ctext
9826 settabs 0
9827 set linknum 0
9828 if {![info exists tagcontents($tag)]} {
9829 catch {
9830 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9833 if {[info exists tagcontents($tag)]} {
9834 set text $tagcontents($tag)
9835 } else {
9836 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9838 appendwithlinks $text {}
9839 $ctext conf -state disabled
9840 init_flist {}
9843 proc doquit {} {
9844 global stopped
9845 global gitktmpdir
9847 set stopped 100
9848 savestuff .
9849 destroy .
9851 if {[info exists gitktmpdir]} {
9852 catch {file delete -force $gitktmpdir}
9856 proc mkfontdisp {font top which} {
9857 global fontattr fontpref $font
9859 set fontpref($font) [set $font]
9860 button $top.${font}but -text $which -font optionfont \
9861 -command [list choosefont $font $which]
9862 label $top.$font -relief flat -font $font \
9863 -text $fontattr($font,family) -justify left
9864 grid x $top.${font}but $top.$font -sticky w
9867 proc choosefont {font which} {
9868 global fontparam fontlist fonttop fontattr
9869 global prefstop
9871 set fontparam(which) $which
9872 set fontparam(font) $font
9873 set fontparam(family) [font actual $font -family]
9874 set fontparam(size) $fontattr($font,size)
9875 set fontparam(weight) $fontattr($font,weight)
9876 set fontparam(slant) $fontattr($font,slant)
9877 set top .gitkfont
9878 set fonttop $top
9879 if {![winfo exists $top]} {
9880 font create sample
9881 eval font config sample [font actual $font]
9882 toplevel $top
9883 make_transient $top $prefstop
9884 wm title $top [mc "Gitk font chooser"]
9885 label $top.l -textvariable fontparam(which)
9886 pack $top.l -side top
9887 set fontlist [lsort [font families]]
9888 frame $top.f
9889 listbox $top.f.fam -listvariable fontlist \
9890 -yscrollcommand [list $top.f.sb set]
9891 bind $top.f.fam <<ListboxSelect>> selfontfam
9892 scrollbar $top.f.sb -command [list $top.f.fam yview]
9893 pack $top.f.sb -side right -fill y
9894 pack $top.f.fam -side left -fill both -expand 1
9895 pack $top.f -side top -fill both -expand 1
9896 frame $top.g
9897 spinbox $top.g.size -from 4 -to 40 -width 4 \
9898 -textvariable fontparam(size) \
9899 -validatecommand {string is integer -strict %s}
9900 checkbutton $top.g.bold -padx 5 \
9901 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9902 -variable fontparam(weight) -onvalue bold -offvalue normal
9903 checkbutton $top.g.ital -padx 5 \
9904 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9905 -variable fontparam(slant) -onvalue italic -offvalue roman
9906 pack $top.g.size $top.g.bold $top.g.ital -side left
9907 pack $top.g -side top
9908 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9909 -background white
9910 $top.c create text 100 25 -anchor center -text $which -font sample \
9911 -fill black -tags text
9912 bind $top.c <Configure> [list centertext $top.c]
9913 pack $top.c -side top -fill x
9914 frame $top.buts
9915 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9916 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9917 bind $top <Key-Return> fontok
9918 bind $top <Key-Escape> fontcan
9919 grid $top.buts.ok $top.buts.can
9920 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9921 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9922 pack $top.buts -side bottom -fill x
9923 trace add variable fontparam write chg_fontparam
9924 } else {
9925 raise $top
9926 $top.c itemconf text -text $which
9928 set i [lsearch -exact $fontlist $fontparam(family)]
9929 if {$i >= 0} {
9930 $top.f.fam selection set $i
9931 $top.f.fam see $i
9935 proc centertext {w} {
9936 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9939 proc fontok {} {
9940 global fontparam fontpref prefstop
9942 set f $fontparam(font)
9943 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9944 if {$fontparam(weight) eq "bold"} {
9945 lappend fontpref($f) "bold"
9947 if {$fontparam(slant) eq "italic"} {
9948 lappend fontpref($f) "italic"
9950 set w $prefstop.$f
9951 $w conf -text $fontparam(family) -font $fontpref($f)
9953 fontcan
9956 proc fontcan {} {
9957 global fonttop fontparam
9959 if {[info exists fonttop]} {
9960 catch {destroy $fonttop}
9961 catch {font delete sample}
9962 unset fonttop
9963 unset fontparam
9967 proc selfontfam {} {
9968 global fonttop fontparam
9970 set i [$fonttop.f.fam curselection]
9971 if {$i ne {}} {
9972 set fontparam(family) [$fonttop.f.fam get $i]
9976 proc chg_fontparam {v sub op} {
9977 global fontparam
9979 font config sample -$sub $fontparam($sub)
9982 proc doprefs {} {
9983 global maxwidth maxgraphpct
9984 global oldprefs prefstop showneartags showlocalchanges
9985 global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
9986 global tabstop limitdiffs autoselect extdifftool perfile_attrs
9988 set top .gitkprefs
9989 set prefstop $top
9990 if {[winfo exists $top]} {
9991 raise $top
9992 return
9994 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9995 limitdiffs tabstop perfile_attrs} {
9996 set oldprefs($v) [set $v]
9998 toplevel $top
9999 wm title $top [mc "Gitk preferences"]
10000 make_transient $top .
10001 label $top.ldisp -text [mc "Commit list display options"]
10002 grid $top.ldisp - -sticky w -pady 10
10003 label $top.spacer -text " "
10004 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10005 -font optionfont
10006 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10007 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10008 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10009 -font optionfont
10010 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10011 grid x $top.maxpctl $top.maxpct -sticky w
10012 frame $top.showlocal
10013 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
10014 checkbutton $top.showlocal.b -variable showlocalchanges
10015 pack $top.showlocal.b $top.showlocal.l -side left
10016 grid x $top.showlocal -sticky w
10017 frame $top.autoselect
10018 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
10019 checkbutton $top.autoselect.b -variable autoselect
10020 pack $top.autoselect.b $top.autoselect.l -side left
10021 grid x $top.autoselect -sticky w
10023 label $top.ddisp -text [mc "Diff display options"]
10024 grid $top.ddisp - -sticky w -pady 10
10025 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10026 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10027 grid x $top.tabstopl $top.tabstop -sticky w
10028 frame $top.ntag
10029 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
10030 checkbutton $top.ntag.b -variable showneartags
10031 pack $top.ntag.b $top.ntag.l -side left
10032 grid x $top.ntag -sticky w
10033 frame $top.ldiff
10034 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
10035 checkbutton $top.ldiff.b -variable limitdiffs
10036 pack $top.ldiff.b $top.ldiff.l -side left
10037 grid x $top.ldiff -sticky w
10038 frame $top.lattr
10039 label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
10040 checkbutton $top.lattr.b -variable perfile_attrs
10041 pack $top.lattr.b $top.lattr.l -side left
10042 grid x $top.lattr -sticky w
10044 entry $top.extdifft -textvariable extdifftool
10045 frame $top.extdifff
10046 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10047 -padx 10
10048 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10049 -command choose_extdiff
10050 pack $top.extdifff.l $top.extdifff.b -side left
10051 grid x $top.extdifff $top.extdifft -sticky w
10053 label $top.cdisp -text [mc "Colors: press to choose"]
10054 grid $top.cdisp - -sticky w -pady 10
10055 label $top.bg -padx 40 -relief sunk -background $bgcolor
10056 button $top.bgbut -text [mc "Background"] -font optionfont \
10057 -command [list choosecolor bgcolor {} $top.bg background setbg]
10058 grid x $top.bgbut $top.bg -sticky w
10059 label $top.fg -padx 40 -relief sunk -background $fgcolor
10060 button $top.fgbut -text [mc "Foreground"] -font optionfont \
10061 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
10062 grid x $top.fgbut $top.fg -sticky w
10063 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10064 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10065 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
10066 [list $ctext tag conf d0 -foreground]]
10067 grid x $top.diffoldbut $top.diffold -sticky w
10068 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10069 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10070 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
10071 [list $ctext tag conf dresult -foreground]]
10072 grid x $top.diffnewbut $top.diffnew -sticky w
10073 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10074 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10075 -command [list choosecolor diffcolors 2 $top.hunksep \
10076 "diff hunk header" \
10077 [list $ctext tag conf hunksep -foreground]]
10078 grid x $top.hunksepbut $top.hunksep -sticky w
10079 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10080 button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10081 -command [list choosecolor markbgcolor {} $top.markbgsep \
10082 [mc "marked line background"] \
10083 [list $ctext tag conf omark -background]]
10084 grid x $top.markbgbut $top.markbgsep -sticky w
10085 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10086 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10087 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
10088 grid x $top.selbgbut $top.selbgsep -sticky w
10090 label $top.cfont -text [mc "Fonts: press to choose"]
10091 grid $top.cfont - -sticky w -pady 10
10092 mkfontdisp mainfont $top [mc "Main font"]
10093 mkfontdisp textfont $top [mc "Diff display font"]
10094 mkfontdisp uifont $top [mc "User interface font"]
10096 frame $top.buts
10097 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10098 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10099 bind $top <Key-Return> prefsok
10100 bind $top <Key-Escape> prefscan
10101 grid $top.buts.ok $top.buts.can
10102 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10103 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10104 grid $top.buts - - -pady 10 -sticky ew
10105 bind $top <Visibility> "focus $top.buts.ok"
10108 proc choose_extdiff {} {
10109 global extdifftool
10111 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
10112 if {$prog ne {}} {
10113 set extdifftool $prog
10117 proc choosecolor {v vi w x cmd} {
10118 global $v
10120 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10121 -title [mc "Gitk: choose color for %s" $x]]
10122 if {$c eq {}} return
10123 $w conf -background $c
10124 lset $v $vi $c
10125 eval $cmd $c
10128 proc setselbg {c} {
10129 global bglist cflist
10130 foreach w $bglist {
10131 $w configure -selectbackground $c
10133 $cflist tag configure highlight \
10134 -background [$cflist cget -selectbackground]
10135 allcanvs itemconf secsel -fill $c
10138 proc setbg {c} {
10139 global bglist
10141 foreach w $bglist {
10142 $w conf -background $c
10146 proc setfg {c} {
10147 global fglist canv
10149 foreach w $fglist {
10150 $w conf -foreground $c
10152 allcanvs itemconf text -fill $c
10153 $canv itemconf circle -outline $c
10156 proc prefscan {} {
10157 global oldprefs prefstop
10159 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10160 limitdiffs tabstop perfile_attrs} {
10161 global $v
10162 set $v $oldprefs($v)
10164 catch {destroy $prefstop}
10165 unset prefstop
10166 fontcan
10169 proc prefsok {} {
10170 global maxwidth maxgraphpct
10171 global oldprefs prefstop showneartags showlocalchanges
10172 global fontpref mainfont textfont uifont
10173 global limitdiffs treediffs perfile_attrs
10175 catch {destroy $prefstop}
10176 unset prefstop
10177 fontcan
10178 set fontchanged 0
10179 if {$mainfont ne $fontpref(mainfont)} {
10180 set mainfont $fontpref(mainfont)
10181 parsefont mainfont $mainfont
10182 eval font configure mainfont [fontflags mainfont]
10183 eval font configure mainfontbold [fontflags mainfont 1]
10184 setcoords
10185 set fontchanged 1
10187 if {$textfont ne $fontpref(textfont)} {
10188 set textfont $fontpref(textfont)
10189 parsefont textfont $textfont
10190 eval font configure textfont [fontflags textfont]
10191 eval font configure textfontbold [fontflags textfont 1]
10193 if {$uifont ne $fontpref(uifont)} {
10194 set uifont $fontpref(uifont)
10195 parsefont uifont $uifont
10196 eval font configure uifont [fontflags uifont]
10198 settabs
10199 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10200 if {$showlocalchanges} {
10201 doshowlocalchanges
10202 } else {
10203 dohidelocalchanges
10206 if {$limitdiffs != $oldprefs(limitdiffs) ||
10207 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10208 # treediffs elements are limited by path;
10209 # won't have encodings cached if perfile_attrs was just turned on
10210 catch {unset treediffs}
10212 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10213 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10214 redisplay
10215 } elseif {$showneartags != $oldprefs(showneartags) ||
10216 $limitdiffs != $oldprefs(limitdiffs)} {
10217 reselectline
10221 proc formatdate {d} {
10222 global datetimeformat
10223 if {$d ne {}} {
10224 set d [clock format $d -format $datetimeformat]
10226 return $d
10229 # This list of encoding names and aliases is distilled from
10230 # http://www.iana.org/assignments/character-sets.
10231 # Not all of them are supported by Tcl.
10232 set encoding_aliases {
10233 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10234 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10235 { ISO-10646-UTF-1 csISO10646UTF1 }
10236 { ISO_646.basic:1983 ref csISO646basic1983 }
10237 { INVARIANT csINVARIANT }
10238 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10239 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10240 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10241 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10242 { NATS-DANO iso-ir-9-1 csNATSDANO }
10243 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10244 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10245 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10246 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10247 { ISO-2022-KR csISO2022KR }
10248 { EUC-KR csEUCKR }
10249 { ISO-2022-JP csISO2022JP }
10250 { ISO-2022-JP-2 csISO2022JP2 }
10251 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10252 csISO13JISC6220jp }
10253 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10254 { IT iso-ir-15 ISO646-IT csISO15Italian }
10255 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10256 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10257 { greek7-old iso-ir-18 csISO18Greek7Old }
10258 { latin-greek iso-ir-19 csISO19LatinGreek }
10259 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10260 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10261 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10262 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10263 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10264 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10265 { INIS iso-ir-49 csISO49INIS }
10266 { INIS-8 iso-ir-50 csISO50INIS8 }
10267 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10268 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10269 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10270 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10271 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10272 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10273 csISO60Norwegian1 }
10274 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10275 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10276 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10277 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10278 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10279 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10280 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10281 { greek7 iso-ir-88 csISO88Greek7 }
10282 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10283 { iso-ir-90 csISO90 }
10284 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10285 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10286 csISO92JISC62991984b }
10287 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10288 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10289 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10290 csISO95JIS62291984handadd }
10291 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10292 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10293 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10294 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10295 CP819 csISOLatin1 }
10296 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10297 { T.61-7bit iso-ir-102 csISO102T617bit }
10298 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10299 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10300 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10301 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10302 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10303 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10304 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10305 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10306 arabic csISOLatinArabic }
10307 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10308 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10309 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10310 greek greek8 csISOLatinGreek }
10311 { T.101-G2 iso-ir-128 csISO128T101G2 }
10312 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10313 csISOLatinHebrew }
10314 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10315 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10316 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10317 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10318 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10319 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10320 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10321 csISOLatinCyrillic }
10322 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10323 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10324 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10325 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10326 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10327 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10328 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10329 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10330 { ISO_10367-box iso-ir-155 csISO10367Box }
10331 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10332 { latin-lap lap iso-ir-158 csISO158Lap }
10333 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10334 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10335 { us-dk csUSDK }
10336 { dk-us csDKUS }
10337 { JIS_X0201 X0201 csHalfWidthKatakana }
10338 { KSC5636 ISO646-KR csKSC5636 }
10339 { ISO-10646-UCS-2 csUnicode }
10340 { ISO-10646-UCS-4 csUCS4 }
10341 { DEC-MCS dec csDECMCS }
10342 { hp-roman8 roman8 r8 csHPRoman8 }
10343 { macintosh mac csMacintosh }
10344 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10345 csIBM037 }
10346 { IBM038 EBCDIC-INT cp038 csIBM038 }
10347 { IBM273 CP273 csIBM273 }
10348 { IBM274 EBCDIC-BE CP274 csIBM274 }
10349 { IBM275 EBCDIC-BR cp275 csIBM275 }
10350 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10351 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10352 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10353 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10354 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10355 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10356 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10357 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10358 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10359 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10360 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10361 { IBM437 cp437 437 csPC8CodePage437 }
10362 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10363 { IBM775 cp775 csPC775Baltic }
10364 { IBM850 cp850 850 csPC850Multilingual }
10365 { IBM851 cp851 851 csIBM851 }
10366 { IBM852 cp852 852 csPCp852 }
10367 { IBM855 cp855 855 csIBM855 }
10368 { IBM857 cp857 857 csIBM857 }
10369 { IBM860 cp860 860 csIBM860 }
10370 { IBM861 cp861 861 cp-is csIBM861 }
10371 { IBM862 cp862 862 csPC862LatinHebrew }
10372 { IBM863 cp863 863 csIBM863 }
10373 { IBM864 cp864 csIBM864 }
10374 { IBM865 cp865 865 csIBM865 }
10375 { IBM866 cp866 866 csIBM866 }
10376 { IBM868 CP868 cp-ar csIBM868 }
10377 { IBM869 cp869 869 cp-gr csIBM869 }
10378 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10379 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10380 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10381 { IBM891 cp891 csIBM891 }
10382 { IBM903 cp903 csIBM903 }
10383 { IBM904 cp904 904 csIBBM904 }
10384 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10385 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10386 { IBM1026 CP1026 csIBM1026 }
10387 { EBCDIC-AT-DE csIBMEBCDICATDE }
10388 { EBCDIC-AT-DE-A csEBCDICATDEA }
10389 { EBCDIC-CA-FR csEBCDICCAFR }
10390 { EBCDIC-DK-NO csEBCDICDKNO }
10391 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10392 { EBCDIC-FI-SE csEBCDICFISE }
10393 { EBCDIC-FI-SE-A csEBCDICFISEA }
10394 { EBCDIC-FR csEBCDICFR }
10395 { EBCDIC-IT csEBCDICIT }
10396 { EBCDIC-PT csEBCDICPT }
10397 { EBCDIC-ES csEBCDICES }
10398 { EBCDIC-ES-A csEBCDICESA }
10399 { EBCDIC-ES-S csEBCDICESS }
10400 { EBCDIC-UK csEBCDICUK }
10401 { EBCDIC-US csEBCDICUS }
10402 { UNKNOWN-8BIT csUnknown8BiT }
10403 { MNEMONIC csMnemonic }
10404 { MNEM csMnem }
10405 { VISCII csVISCII }
10406 { VIQR csVIQR }
10407 { KOI8-R csKOI8R }
10408 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10409 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10410 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10411 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10412 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10413 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10414 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10415 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10416 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10417 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10418 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10419 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10420 { IBM1047 IBM-1047 }
10421 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10422 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10423 { UNICODE-1-1 csUnicode11 }
10424 { CESU-8 csCESU-8 }
10425 { BOCU-1 csBOCU-1 }
10426 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10427 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10428 l8 }
10429 { ISO-8859-15 ISO_8859-15 Latin-9 }
10430 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10431 { GBK CP936 MS936 windows-936 }
10432 { JIS_Encoding csJISEncoding }
10433 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10434 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10435 EUC-JP }
10436 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10437 { ISO-10646-UCS-Basic csUnicodeASCII }
10438 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10439 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10440 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10441 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10442 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10443 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10444 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10445 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10446 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10447 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10448 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10449 { Ventura-US csVenturaUS }
10450 { Ventura-International csVenturaInternational }
10451 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10452 { PC8-Turkish csPC8Turkish }
10453 { IBM-Symbols csIBMSymbols }
10454 { IBM-Thai csIBMThai }
10455 { HP-Legal csHPLegal }
10456 { HP-Pi-font csHPPiFont }
10457 { HP-Math8 csHPMath8 }
10458 { Adobe-Symbol-Encoding csHPPSMath }
10459 { HP-DeskTop csHPDesktop }
10460 { Ventura-Math csVenturaMath }
10461 { Microsoft-Publishing csMicrosoftPublishing }
10462 { Windows-31J csWindows31J }
10463 { GB2312 csGB2312 }
10464 { Big5 csBig5 }
10467 proc tcl_encoding {enc} {
10468 global encoding_aliases tcl_encoding_cache
10469 if {[info exists tcl_encoding_cache($enc)]} {
10470 return $tcl_encoding_cache($enc)
10472 set names [encoding names]
10473 set lcnames [string tolower $names]
10474 set enc [string tolower $enc]
10475 set i [lsearch -exact $lcnames $enc]
10476 if {$i < 0} {
10477 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10478 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10479 set i [lsearch -exact $lcnames $encx]
10482 if {$i < 0} {
10483 foreach l $encoding_aliases {
10484 set ll [string tolower $l]
10485 if {[lsearch -exact $ll $enc] < 0} continue
10486 # look through the aliases for one that tcl knows about
10487 foreach e $ll {
10488 set i [lsearch -exact $lcnames $e]
10489 if {$i < 0} {
10490 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10491 set i [lsearch -exact $lcnames $ex]
10494 if {$i >= 0} break
10496 break
10499 set tclenc {}
10500 if {$i >= 0} {
10501 set tclenc [lindex $names $i]
10503 set tcl_encoding_cache($enc) $tclenc
10504 return $tclenc
10507 proc gitattr {path attr default} {
10508 global path_attr_cache
10509 if {[info exists path_attr_cache($attr,$path)]} {
10510 set r $path_attr_cache($attr,$path)
10511 } else {
10512 set r "unspecified"
10513 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10514 regexp "(.*): encoding: (.*)" $line m f r
10516 set path_attr_cache($attr,$path) $r
10518 if {$r eq "unspecified"} {
10519 return $default
10521 return $r
10524 proc cache_gitattr {attr pathlist} {
10525 global path_attr_cache
10526 set newlist {}
10527 foreach path $pathlist {
10528 if {![info exists path_attr_cache($attr,$path)]} {
10529 lappend newlist $path
10532 set lim 1000
10533 if {[tk windowingsystem] == "win32"} {
10534 # windows has a 32k limit on the arguments to a command...
10535 set lim 30
10537 while {$newlist ne {}} {
10538 set head [lrange $newlist 0 [expr {$lim - 1}]]
10539 set newlist [lrange $newlist $lim end]
10540 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10541 foreach row [split $rlist "\n"] {
10542 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10543 if {[string index $path 0] eq "\""} {
10544 set path [encoding convertfrom [lindex $path 0]]
10546 set path_attr_cache($attr,$path) $value
10553 proc get_path_encoding {path} {
10554 global gui_encoding perfile_attrs
10555 set tcl_enc $gui_encoding
10556 if {$path ne {} && $perfile_attrs} {
10557 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10558 if {$enc2 ne {}} {
10559 set tcl_enc $enc2
10562 return $tcl_enc
10565 # First check that Tcl/Tk is recent enough
10566 if {[catch {package require Tk 8.4} err]} {
10567 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10568 Gitk requires at least Tcl/Tk 8.4."]
10569 exit 1
10572 # defaults...
10573 set wrcomcmd "git diff-tree --stdin -p --pretty"
10575 set gitencoding {}
10576 catch {
10577 set gitencoding [exec git config --get i18n.commitencoding]
10579 catch {
10580 set gitencoding [exec git config --get i18n.logoutputencoding]
10582 if {$gitencoding == ""} {
10583 set gitencoding "utf-8"
10585 set tclencoding [tcl_encoding $gitencoding]
10586 if {$tclencoding == {}} {
10587 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10590 set gui_encoding [encoding system]
10591 catch {
10592 set enc [exec git config --get gui.encoding]
10593 if {$enc ne {}} {
10594 set tclenc [tcl_encoding $enc]
10595 if {$tclenc ne {}} {
10596 set gui_encoding $tclenc
10597 } else {
10598 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10603 set mainfont {Helvetica 9}
10604 set textfont {Courier 9}
10605 set uifont {Helvetica 9 bold}
10606 set tabstop 8
10607 set findmergefiles 0
10608 set maxgraphpct 50
10609 set maxwidth 16
10610 set revlistorder 0
10611 set fastdate 0
10612 set uparrowlen 5
10613 set downarrowlen 5
10614 set mingaplen 100
10615 set cmitmode "patch"
10616 set wrapcomment "none"
10617 set showneartags 1
10618 set maxrefs 20
10619 set maxlinelen 200
10620 set showlocalchanges 1
10621 set limitdiffs 1
10622 set datetimeformat "%Y-%m-%d %H:%M:%S"
10623 set autoselect 1
10624 set perfile_attrs 0
10626 set extdifftool "meld"
10628 set colors {green red blue magenta darkgrey brown orange}
10629 set bgcolor white
10630 set fgcolor black
10631 set diffcolors {red "#00a000" blue}
10632 set diffcontext 3
10633 set ignorespace 0
10634 set selectbgcolor gray85
10635 set markbgcolor "#e0e0ff"
10637 set circlecolors {white blue gray blue blue}
10639 # button for popping up context menus
10640 if {[tk windowingsystem] eq "aqua"} {
10641 set ctxbut <Button-2>
10642 } else {
10643 set ctxbut <Button-3>
10646 ## For msgcat loading, first locate the installation location.
10647 if { [info exists ::env(GITK_MSGSDIR)] } {
10648 ## Msgsdir was manually set in the environment.
10649 set gitk_msgsdir $::env(GITK_MSGSDIR)
10650 } else {
10651 ## Let's guess the prefix from argv0.
10652 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10653 set gitk_libdir [file join $gitk_prefix share gitk lib]
10654 set gitk_msgsdir [file join $gitk_libdir msgs]
10655 unset gitk_prefix
10658 ## Internationalization (i18n) through msgcat and gettext. See
10659 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10660 package require msgcat
10661 namespace import ::msgcat::mc
10662 ## And eventually load the actual message catalog
10663 ::msgcat::mcload $gitk_msgsdir
10665 catch {source ~/.gitk}
10667 font create optionfont -family sans-serif -size -12
10669 parsefont mainfont $mainfont
10670 eval font create mainfont [fontflags mainfont]
10671 eval font create mainfontbold [fontflags mainfont 1]
10673 parsefont textfont $textfont
10674 eval font create textfont [fontflags textfont]
10675 eval font create textfontbold [fontflags textfont 1]
10677 parsefont uifont $uifont
10678 eval font create uifont [fontflags uifont]
10680 setoptions
10682 # check that we can find a .git directory somewhere...
10683 if {[catch {set gitdir [gitdir]}]} {
10684 show_error {} . [mc "Cannot find a git repository here."]
10685 exit 1
10687 if {![file isdirectory $gitdir]} {
10688 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10689 exit 1
10692 set selecthead {}
10693 set selectheadid {}
10695 set revtreeargs {}
10696 set cmdline_files {}
10697 set i 0
10698 set revtreeargscmd {}
10699 foreach arg $argv {
10700 switch -glob -- $arg {
10701 "" { }
10702 "--" {
10703 set cmdline_files [lrange $argv [expr {$i + 1}] end]
10704 break
10706 "--select-commit=*" {
10707 set selecthead [string range $arg 16 end]
10709 "--argscmd=*" {
10710 set revtreeargscmd [string range $arg 10 end]
10712 default {
10713 lappend revtreeargs $arg
10716 incr i
10719 if {$selecthead eq "HEAD"} {
10720 set selecthead {}
10723 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10724 # no -- on command line, but some arguments (other than --argscmd)
10725 if {[catch {
10726 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10727 set cmdline_files [split $f "\n"]
10728 set n [llength $cmdline_files]
10729 set revtreeargs [lrange $revtreeargs 0 end-$n]
10730 # Unfortunately git rev-parse doesn't produce an error when
10731 # something is both a revision and a filename. To be consistent
10732 # with git log and git rev-list, check revtreeargs for filenames.
10733 foreach arg $revtreeargs {
10734 if {[file exists $arg]} {
10735 show_error {} . [mc "Ambiguous argument '%s': both revision\
10736 and filename" $arg]
10737 exit 1
10740 } err]} {
10741 # unfortunately we get both stdout and stderr in $err,
10742 # so look for "fatal:".
10743 set i [string first "fatal:" $err]
10744 if {$i > 0} {
10745 set err [string range $err [expr {$i + 6}] end]
10747 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10748 exit 1
10752 set nullid "0000000000000000000000000000000000000000"
10753 set nullid2 "0000000000000000000000000000000000000001"
10754 set nullfile "/dev/null"
10756 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10758 set runq {}
10759 set history {}
10760 set historyindex 0
10761 set fh_serial 0
10762 set nhl_names {}
10763 set highlight_paths {}
10764 set findpattern {}
10765 set searchdirn -forwards
10766 set boldrows {}
10767 set boldnamerows {}
10768 set diffelide {0 0}
10769 set markingmatches 0
10770 set linkentercount 0
10771 set need_redisplay 0
10772 set nrows_drawn 0
10773 set firsttabstop 0
10775 set nextviewnum 1
10776 set curview 0
10777 set selectedview 0
10778 set selectedhlview [mc "None"]
10779 set highlight_related [mc "None"]
10780 set highlight_files {}
10781 set viewfiles(0) {}
10782 set viewperm(0) 0
10783 set viewargs(0) {}
10784 set viewargscmd(0) {}
10786 set selectedline {}
10787 set numcommits 0
10788 set loginstance 0
10789 set cmdlineok 0
10790 set stopped 0
10791 set stuffsaved 0
10792 set patchnum 0
10793 set lserial 0
10794 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10795 setcoords
10796 makewindow
10797 # wait for the window to become visible
10798 tkwait visibility .
10799 wm title . "[file tail $argv0]: [file tail [pwd]]"
10800 readrefs
10802 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10803 # create a view for the files/dirs specified on the command line
10804 set curview 1
10805 set selectedview 1
10806 set nextviewnum 2
10807 set viewname(1) [mc "Command line"]
10808 set viewfiles(1) $cmdline_files
10809 set viewargs(1) $revtreeargs
10810 set viewargscmd(1) $revtreeargscmd
10811 set viewperm(1) 0
10812 set vdatemode(1) 0
10813 addviewmenu 1
10814 .bar.view entryconf [mca "Edit view..."] -state normal
10815 .bar.view entryconf [mca "Delete view"] -state normal
10818 if {[info exists permviews]} {
10819 foreach v $permviews {
10820 set n $nextviewnum
10821 incr nextviewnum
10822 set viewname($n) [lindex $v 0]
10823 set viewfiles($n) [lindex $v 1]
10824 set viewargs($n) [lindex $v 2]
10825 set viewargscmd($n) [lindex $v 3]
10826 set viewperm($n) 1
10827 addviewmenu $n
10830 getcommits {}