Merge branch 'master' of git://repo.or.cz/alt-git
[git/dscho.git] / gitk-git / gitk
blobe7151e7ea8a4d1d311c6ffa318c84078a84f6595
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 catch {file delete "~/.gitk"}
2518 file rename -force "~/.gitk-new" "~/.gitk"
2520 set stuffsaved 1
2523 proc resizeclistpanes {win w} {
2524 global oldwidth
2525 if {[info exists oldwidth($win)]} {
2526 set s0 [$win sash coord 0]
2527 set s1 [$win sash coord 1]
2528 if {$w < 60} {
2529 set sash0 [expr {int($w/2 - 2)}]
2530 set sash1 [expr {int($w*5/6 - 2)}]
2531 } else {
2532 set factor [expr {1.0 * $w / $oldwidth($win)}]
2533 set sash0 [expr {int($factor * [lindex $s0 0])}]
2534 set sash1 [expr {int($factor * [lindex $s1 0])}]
2535 if {$sash0 < 30} {
2536 set sash0 30
2538 if {$sash1 < $sash0 + 20} {
2539 set sash1 [expr {$sash0 + 20}]
2541 if {$sash1 > $w - 10} {
2542 set sash1 [expr {$w - 10}]
2543 if {$sash0 > $sash1 - 20} {
2544 set sash0 [expr {$sash1 - 20}]
2548 $win sash place 0 $sash0 [lindex $s0 1]
2549 $win sash place 1 $sash1 [lindex $s1 1]
2551 set oldwidth($win) $w
2554 proc resizecdetpanes {win w} {
2555 global oldwidth
2556 if {[info exists oldwidth($win)]} {
2557 set s0 [$win sash coord 0]
2558 if {$w < 60} {
2559 set sash0 [expr {int($w*3/4 - 2)}]
2560 } else {
2561 set factor [expr {1.0 * $w / $oldwidth($win)}]
2562 set sash0 [expr {int($factor * [lindex $s0 0])}]
2563 if {$sash0 < 45} {
2564 set sash0 45
2566 if {$sash0 > $w - 15} {
2567 set sash0 [expr {$w - 15}]
2570 $win sash place 0 $sash0 [lindex $s0 1]
2572 set oldwidth($win) $w
2575 proc allcanvs args {
2576 global canv canv2 canv3
2577 eval $canv $args
2578 eval $canv2 $args
2579 eval $canv3 $args
2582 proc bindall {event action} {
2583 global canv canv2 canv3
2584 bind $canv $event $action
2585 bind $canv2 $event $action
2586 bind $canv3 $event $action
2589 proc about {} {
2590 global uifont
2591 set w .about
2592 if {[winfo exists $w]} {
2593 raise $w
2594 return
2596 toplevel $w
2597 wm title $w [mc "About gitk"]
2598 make_transient $w .
2599 message $w.m -text [mc "
2600 Gitk - a commit viewer for git
2602 Copyright © 2005-2008 Paul Mackerras
2604 Use and redistribute under the terms of the GNU General Public License"] \
2605 -justify center -aspect 400 -border 2 -bg white -relief groove
2606 pack $w.m -side top -fill x -padx 2 -pady 2
2607 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2608 pack $w.ok -side bottom
2609 bind $w <Visibility> "focus $w.ok"
2610 bind $w <Key-Escape> "destroy $w"
2611 bind $w <Key-Return> "destroy $w"
2614 proc keys {} {
2615 set w .keys
2616 if {[winfo exists $w]} {
2617 raise $w
2618 return
2620 if {[tk windowingsystem] eq {aqua}} {
2621 set M1T Cmd
2622 } else {
2623 set M1T Ctrl
2625 toplevel $w
2626 wm title $w [mc "Gitk key bindings"]
2627 make_transient $w .
2628 message $w.m -text "
2629 [mc "Gitk key bindings:"]
2631 [mc "<%s-Q> Quit" $M1T]
2632 [mc "<Home> Move to first commit"]
2633 [mc "<End> Move to last commit"]
2634 [mc "<Up>, p, i Move up one commit"]
2635 [mc "<Down>, n, k Move down one commit"]
2636 [mc "<Left>, z, j Go back in history list"]
2637 [mc "<Right>, x, l Go forward in history list"]
2638 [mc "<PageUp> Move up one page in commit list"]
2639 [mc "<PageDown> Move down one page in commit list"]
2640 [mc "<%s-Home> Scroll to top of commit list" $M1T]
2641 [mc "<%s-End> Scroll to bottom of commit list" $M1T]
2642 [mc "<%s-Up> Scroll commit list up one line" $M1T]
2643 [mc "<%s-Down> Scroll commit list down one line" $M1T]
2644 [mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2645 [mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2646 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2647 [mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2648 [mc "<Delete>, b Scroll diff view up one page"]
2649 [mc "<Backspace> Scroll diff view up one page"]
2650 [mc "<Space> Scroll diff view down one page"]
2651 [mc "u Scroll diff view up 18 lines"]
2652 [mc "d Scroll diff view down 18 lines"]
2653 [mc "<%s-F> Find" $M1T]
2654 [mc "<%s-G> Move to next find hit" $M1T]
2655 [mc "<Return> Move to next find hit"]
2656 [mc "/ Move to next find hit, or redo find"]
2657 [mc "? Move to previous find hit"]
2658 [mc "f Scroll diff view to next file"]
2659 [mc "<%s-S> Search for next hit in diff view" $M1T]
2660 [mc "<%s-R> Search for previous hit in diff view" $M1T]
2661 [mc "<%s-KP+> Increase font size" $M1T]
2662 [mc "<%s-plus> Increase font size" $M1T]
2663 [mc "<%s-KP-> Decrease font size" $M1T]
2664 [mc "<%s-minus> Decrease font size" $M1T]
2665 [mc "<F5> Update"]
2667 -justify left -bg white -border 2 -relief groove
2668 pack $w.m -side top -fill both -padx 2 -pady 2
2669 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2670 bind $w <Key-Escape> [list destroy $w]
2671 pack $w.ok -side bottom
2672 bind $w <Visibility> "focus $w.ok"
2673 bind $w <Key-Escape> "destroy $w"
2674 bind $w <Key-Return> "destroy $w"
2677 # Procedures for manipulating the file list window at the
2678 # bottom right of the overall window.
2680 proc treeview {w l openlevs} {
2681 global treecontents treediropen treeheight treeparent treeindex
2683 set ix 0
2684 set treeindex() 0
2685 set lev 0
2686 set prefix {}
2687 set prefixend -1
2688 set prefendstack {}
2689 set htstack {}
2690 set ht 0
2691 set treecontents() {}
2692 $w conf -state normal
2693 foreach f $l {
2694 while {[string range $f 0 $prefixend] ne $prefix} {
2695 if {$lev <= $openlevs} {
2696 $w mark set e:$treeindex($prefix) "end -1c"
2697 $w mark gravity e:$treeindex($prefix) left
2699 set treeheight($prefix) $ht
2700 incr ht [lindex $htstack end]
2701 set htstack [lreplace $htstack end end]
2702 set prefixend [lindex $prefendstack end]
2703 set prefendstack [lreplace $prefendstack end end]
2704 set prefix [string range $prefix 0 $prefixend]
2705 incr lev -1
2707 set tail [string range $f [expr {$prefixend+1}] end]
2708 while {[set slash [string first "/" $tail]] >= 0} {
2709 lappend htstack $ht
2710 set ht 0
2711 lappend prefendstack $prefixend
2712 incr prefixend [expr {$slash + 1}]
2713 set d [string range $tail 0 $slash]
2714 lappend treecontents($prefix) $d
2715 set oldprefix $prefix
2716 append prefix $d
2717 set treecontents($prefix) {}
2718 set treeindex($prefix) [incr ix]
2719 set treeparent($prefix) $oldprefix
2720 set tail [string range $tail [expr {$slash+1}] end]
2721 if {$lev <= $openlevs} {
2722 set ht 1
2723 set treediropen($prefix) [expr {$lev < $openlevs}]
2724 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2725 $w mark set d:$ix "end -1c"
2726 $w mark gravity d:$ix left
2727 set str "\n"
2728 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2729 $w insert end $str
2730 $w image create end -align center -image $bm -padx 1 \
2731 -name a:$ix
2732 $w insert end $d [highlight_tag $prefix]
2733 $w mark set s:$ix "end -1c"
2734 $w mark gravity s:$ix left
2736 incr lev
2738 if {$tail ne {}} {
2739 if {$lev <= $openlevs} {
2740 incr ht
2741 set str "\n"
2742 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2743 $w insert end $str
2744 $w insert end $tail [highlight_tag $f]
2746 lappend treecontents($prefix) $tail
2749 while {$htstack ne {}} {
2750 set treeheight($prefix) $ht
2751 incr ht [lindex $htstack end]
2752 set htstack [lreplace $htstack end end]
2753 set prefixend [lindex $prefendstack end]
2754 set prefendstack [lreplace $prefendstack end end]
2755 set prefix [string range $prefix 0 $prefixend]
2757 $w conf -state disabled
2760 proc linetoelt {l} {
2761 global treeheight treecontents
2763 set y 2
2764 set prefix {}
2765 while {1} {
2766 foreach e $treecontents($prefix) {
2767 if {$y == $l} {
2768 return "$prefix$e"
2770 set n 1
2771 if {[string index $e end] eq "/"} {
2772 set n $treeheight($prefix$e)
2773 if {$y + $n > $l} {
2774 append prefix $e
2775 incr y
2776 break
2779 incr y $n
2784 proc highlight_tree {y prefix} {
2785 global treeheight treecontents cflist
2787 foreach e $treecontents($prefix) {
2788 set path $prefix$e
2789 if {[highlight_tag $path] ne {}} {
2790 $cflist tag add bold $y.0 "$y.0 lineend"
2792 incr y
2793 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2794 set y [highlight_tree $y $path]
2797 return $y
2800 proc treeclosedir {w dir} {
2801 global treediropen treeheight treeparent treeindex
2803 set ix $treeindex($dir)
2804 $w conf -state normal
2805 $w delete s:$ix e:$ix
2806 set treediropen($dir) 0
2807 $w image configure a:$ix -image tri-rt
2808 $w conf -state disabled
2809 set n [expr {1 - $treeheight($dir)}]
2810 while {$dir ne {}} {
2811 incr treeheight($dir) $n
2812 set dir $treeparent($dir)
2816 proc treeopendir {w dir} {
2817 global treediropen treeheight treeparent treecontents treeindex
2819 set ix $treeindex($dir)
2820 $w conf -state normal
2821 $w image configure a:$ix -image tri-dn
2822 $w mark set e:$ix s:$ix
2823 $w mark gravity e:$ix right
2824 set lev 0
2825 set str "\n"
2826 set n [llength $treecontents($dir)]
2827 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2828 incr lev
2829 append str "\t"
2830 incr treeheight($x) $n
2832 foreach e $treecontents($dir) {
2833 set de $dir$e
2834 if {[string index $e end] eq "/"} {
2835 set iy $treeindex($de)
2836 $w mark set d:$iy e:$ix
2837 $w mark gravity d:$iy left
2838 $w insert e:$ix $str
2839 set treediropen($de) 0
2840 $w image create e:$ix -align center -image tri-rt -padx 1 \
2841 -name a:$iy
2842 $w insert e:$ix $e [highlight_tag $de]
2843 $w mark set s:$iy e:$ix
2844 $w mark gravity s:$iy left
2845 set treeheight($de) 1
2846 } else {
2847 $w insert e:$ix $str
2848 $w insert e:$ix $e [highlight_tag $de]
2851 $w mark gravity e:$ix right
2852 $w conf -state disabled
2853 set treediropen($dir) 1
2854 set top [lindex [split [$w index @0,0] .] 0]
2855 set ht [$w cget -height]
2856 set l [lindex [split [$w index s:$ix] .] 0]
2857 if {$l < $top} {
2858 $w yview $l.0
2859 } elseif {$l + $n + 1 > $top + $ht} {
2860 set top [expr {$l + $n + 2 - $ht}]
2861 if {$l < $top} {
2862 set top $l
2864 $w yview $top.0
2868 proc treeclick {w x y} {
2869 global treediropen cmitmode ctext cflist cflist_top
2871 if {$cmitmode ne "tree"} return
2872 if {![info exists cflist_top]} return
2873 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2874 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2875 $cflist tag add highlight $l.0 "$l.0 lineend"
2876 set cflist_top $l
2877 if {$l == 1} {
2878 $ctext yview 1.0
2879 return
2881 set e [linetoelt $l]
2882 if {[string index $e end] ne "/"} {
2883 showfile $e
2884 } elseif {$treediropen($e)} {
2885 treeclosedir $w $e
2886 } else {
2887 treeopendir $w $e
2891 proc setfilelist {id} {
2892 global treefilelist cflist jump_to_here
2894 treeview $cflist $treefilelist($id) 0
2895 if {$jump_to_here ne {}} {
2896 set f [lindex $jump_to_here 0]
2897 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
2898 showfile $f
2903 image create bitmap tri-rt -background black -foreground blue -data {
2904 #define tri-rt_width 13
2905 #define tri-rt_height 13
2906 static unsigned char tri-rt_bits[] = {
2907 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2908 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2909 0x00, 0x00};
2910 } -maskdata {
2911 #define tri-rt-mask_width 13
2912 #define tri-rt-mask_height 13
2913 static unsigned char tri-rt-mask_bits[] = {
2914 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2915 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2916 0x08, 0x00};
2918 image create bitmap tri-dn -background black -foreground blue -data {
2919 #define tri-dn_width 13
2920 #define tri-dn_height 13
2921 static unsigned char tri-dn_bits[] = {
2922 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2923 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2924 0x00, 0x00};
2925 } -maskdata {
2926 #define tri-dn-mask_width 13
2927 #define tri-dn-mask_height 13
2928 static unsigned char tri-dn-mask_bits[] = {
2929 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2930 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2931 0x00, 0x00};
2934 image create bitmap reficon-T -background black -foreground yellow -data {
2935 #define tagicon_width 13
2936 #define tagicon_height 9
2937 static unsigned char tagicon_bits[] = {
2938 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2939 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2940 } -maskdata {
2941 #define tagicon-mask_width 13
2942 #define tagicon-mask_height 9
2943 static unsigned char tagicon-mask_bits[] = {
2944 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2945 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2947 set rectdata {
2948 #define headicon_width 13
2949 #define headicon_height 9
2950 static unsigned char headicon_bits[] = {
2951 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2952 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2954 set rectmask {
2955 #define headicon-mask_width 13
2956 #define headicon-mask_height 9
2957 static unsigned char headicon-mask_bits[] = {
2958 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2959 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2961 image create bitmap reficon-H -background black -foreground green \
2962 -data $rectdata -maskdata $rectmask
2963 image create bitmap reficon-o -background black -foreground "#ddddff" \
2964 -data $rectdata -maskdata $rectmask
2966 proc init_flist {first} {
2967 global cflist cflist_top difffilestart
2969 $cflist conf -state normal
2970 $cflist delete 0.0 end
2971 if {$first ne {}} {
2972 $cflist insert end $first
2973 set cflist_top 1
2974 $cflist tag add highlight 1.0 "1.0 lineend"
2975 } else {
2976 catch {unset cflist_top}
2978 $cflist conf -state disabled
2979 set difffilestart {}
2982 proc highlight_tag {f} {
2983 global highlight_paths
2985 foreach p $highlight_paths {
2986 if {[string match $p $f]} {
2987 return "bold"
2990 return {}
2993 proc highlight_filelist {} {
2994 global cmitmode cflist
2996 $cflist conf -state normal
2997 if {$cmitmode ne "tree"} {
2998 set end [lindex [split [$cflist index end] .] 0]
2999 for {set l 2} {$l < $end} {incr l} {
3000 set line [$cflist get $l.0 "$l.0 lineend"]
3001 if {[highlight_tag $line] ne {}} {
3002 $cflist tag add bold $l.0 "$l.0 lineend"
3005 } else {
3006 highlight_tree 2 {}
3008 $cflist conf -state disabled
3011 proc unhighlight_filelist {} {
3012 global cflist
3014 $cflist conf -state normal
3015 $cflist tag remove bold 1.0 end
3016 $cflist conf -state disabled
3019 proc add_flist {fl} {
3020 global cflist
3022 $cflist conf -state normal
3023 foreach f $fl {
3024 $cflist insert end "\n"
3025 $cflist insert end $f [highlight_tag $f]
3027 $cflist conf -state disabled
3030 proc sel_flist {w x y} {
3031 global ctext difffilestart cflist cflist_top cmitmode
3033 if {$cmitmode eq "tree"} return
3034 if {![info exists cflist_top]} return
3035 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3036 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3037 $cflist tag add highlight $l.0 "$l.0 lineend"
3038 set cflist_top $l
3039 if {$l == 1} {
3040 $ctext yview 1.0
3041 } else {
3042 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3046 proc pop_flist_menu {w X Y x y} {
3047 global ctext cflist cmitmode flist_menu flist_menu_file
3048 global treediffs diffids
3050 stopfinding
3051 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3052 if {$l <= 1} return
3053 if {$cmitmode eq "tree"} {
3054 set e [linetoelt $l]
3055 if {[string index $e end] eq "/"} return
3056 } else {
3057 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3059 set flist_menu_file $e
3060 set xdiffstate "normal"
3061 if {$cmitmode eq "tree"} {
3062 set xdiffstate "disabled"
3064 # Disable "External diff" item in tree mode
3065 $flist_menu entryconf 2 -state $xdiffstate
3066 tk_popup $flist_menu $X $Y
3069 proc find_ctext_fileinfo {line} {
3070 global ctext_file_names ctext_file_lines
3072 set ok [bsearch $ctext_file_lines $line]
3073 set tline [lindex $ctext_file_lines $ok]
3075 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3076 return {}
3077 } else {
3078 return [list [lindex $ctext_file_names $ok] $tline]
3082 proc pop_diff_menu {w X Y x y} {
3083 global ctext diff_menu flist_menu_file
3084 global diff_menu_txtpos diff_menu_line
3085 global diff_menu_filebase
3087 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3088 set diff_menu_line [lindex $diff_menu_txtpos 0]
3089 # don't pop up the menu on hunk-separator or file-separator lines
3090 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3091 return
3093 stopfinding
3094 set f [find_ctext_fileinfo $diff_menu_line]
3095 if {$f eq {}} return
3096 set flist_menu_file [lindex $f 0]
3097 set diff_menu_filebase [lindex $f 1]
3098 tk_popup $diff_menu $X $Y
3101 proc flist_hl {only} {
3102 global flist_menu_file findstring gdttype
3104 set x [shellquote $flist_menu_file]
3105 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3106 set findstring $x
3107 } else {
3108 append findstring " " $x
3110 set gdttype [mc "touching paths:"]
3113 proc save_file_from_commit {filename output what} {
3114 global nullfile
3116 if {[catch {exec git show $filename -- > $output} err]} {
3117 if {[string match "fatal: bad revision *" $err]} {
3118 return $nullfile
3120 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3121 return {}
3123 return $output
3126 proc external_diff_get_one_file {diffid filename diffdir} {
3127 global nullid nullid2 nullfile
3128 global gitdir
3130 if {$diffid == $nullid} {
3131 set difffile [file join [file dirname $gitdir] $filename]
3132 if {[file exists $difffile]} {
3133 return $difffile
3135 return $nullfile
3137 if {$diffid == $nullid2} {
3138 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3139 return [save_file_from_commit :$filename $difffile index]
3141 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3142 return [save_file_from_commit $diffid:$filename $difffile \
3143 "revision $diffid"]
3146 proc external_diff {} {
3147 global gitktmpdir nullid nullid2
3148 global flist_menu_file
3149 global diffids
3150 global diffnum
3151 global gitdir extdifftool
3153 if {[llength $diffids] == 1} {
3154 # no reference commit given
3155 set diffidto [lindex $diffids 0]
3156 if {$diffidto eq $nullid} {
3157 # diffing working copy with index
3158 set diffidfrom $nullid2
3159 } elseif {$diffidto eq $nullid2} {
3160 # diffing index with HEAD
3161 set diffidfrom "HEAD"
3162 } else {
3163 # use first parent commit
3164 global parentlist selectedline
3165 set diffidfrom [lindex $parentlist $selectedline 0]
3167 } else {
3168 set diffidfrom [lindex $diffids 0]
3169 set diffidto [lindex $diffids 1]
3172 # make sure that several diffs wont collide
3173 if {![info exists gitktmpdir]} {
3174 set gitktmpdir [file join [file dirname $gitdir] \
3175 [format ".gitk-tmp.%s" [pid]]]
3176 if {[catch {file mkdir $gitktmpdir} err]} {
3177 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3178 unset gitktmpdir
3179 return
3181 set diffnum 0
3183 incr diffnum
3184 set diffdir [file join $gitktmpdir $diffnum]
3185 if {[catch {file mkdir $diffdir} err]} {
3186 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3187 return
3190 # gather files to diff
3191 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3192 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3194 if {$difffromfile ne {} && $difftofile ne {}} {
3195 set cmd [concat | [shellsplit $extdifftool] \
3196 [list $difffromfile $difftofile]]
3197 if {[catch {set fl [open $cmd r]} err]} {
3198 file delete -force $diffdir
3199 error_popup "$extdifftool: [mc "command failed:"] $err"
3200 } else {
3201 fconfigure $fl -blocking 0
3202 filerun $fl [list delete_at_eof $fl $diffdir]
3207 proc find_hunk_blamespec {base line} {
3208 global ctext
3210 # Find and parse the hunk header
3211 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3212 if {$s_lix eq {}} return
3214 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3215 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3216 s_line old_specs osz osz1 new_line nsz]} {
3217 return
3220 # base lines for the parents
3221 set base_lines [list $new_line]
3222 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3223 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3224 old_spec old_line osz]} {
3225 return
3227 lappend base_lines $old_line
3230 # Now scan the lines to determine offset within the hunk
3231 set max_parent [expr {[llength $base_lines]-2}]
3232 set dline 0
3233 set s_lno [lindex [split $s_lix "."] 0]
3235 # Determine if the line is removed
3236 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3237 if {[string match {[-+ ]*} $chunk]} {
3238 set removed_idx [string first "-" $chunk]
3239 # Choose a parent index
3240 if {$removed_idx >= 0} {
3241 set parent $removed_idx
3242 } else {
3243 set unchanged_idx [string first " " $chunk]
3244 if {$unchanged_idx >= 0} {
3245 set parent $unchanged_idx
3246 } else {
3247 # blame the current commit
3248 set parent -1
3251 # then count other lines that belong to it
3252 for {set i $line} {[incr i -1] > $s_lno} {} {
3253 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3254 # Determine if the line is removed
3255 set removed_idx [string first "-" $chunk]
3256 if {$parent >= 0} {
3257 set code [string index $chunk $parent]
3258 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3259 incr dline
3261 } else {
3262 if {$removed_idx < 0} {
3263 incr dline
3267 incr parent
3268 } else {
3269 set parent 0
3272 incr dline [lindex $base_lines $parent]
3273 return [list $parent $dline]
3276 proc external_blame_diff {} {
3277 global currentid cmitmode
3278 global diff_menu_txtpos diff_menu_line
3279 global diff_menu_filebase flist_menu_file
3281 if {$cmitmode eq "tree"} {
3282 set parent_idx 0
3283 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3284 } else {
3285 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3286 if {$hinfo ne {}} {
3287 set parent_idx [lindex $hinfo 0]
3288 set line [lindex $hinfo 1]
3289 } else {
3290 set parent_idx 0
3291 set line 0
3295 external_blame $parent_idx $line
3298 # Find the SHA1 ID of the blob for file $fname in the index
3299 # at stage 0 or 2
3300 proc index_sha1 {fname} {
3301 set f [open [list | git ls-files -s $fname] r]
3302 while {[gets $f line] >= 0} {
3303 set info [lindex [split $line "\t"] 0]
3304 set stage [lindex $info 2]
3305 if {$stage eq "0" || $stage eq "2"} {
3306 close $f
3307 return [lindex $info 1]
3310 close $f
3311 return {}
3314 proc external_blame {parent_idx {line {}}} {
3315 global flist_menu_file
3316 global nullid nullid2
3317 global parentlist selectedline currentid
3319 if {$parent_idx > 0} {
3320 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3321 } else {
3322 set base_commit $currentid
3325 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3326 error_popup [mc "No such commit"]
3327 return
3330 set cmdline [list git gui blame]
3331 if {$line ne {} && $line > 1} {
3332 lappend cmdline "--line=$line"
3334 lappend cmdline $base_commit $flist_menu_file
3335 if {[catch {eval exec $cmdline &} err]} {
3336 error_popup "[mc "git gui blame: command failed:"] $err"
3340 proc show_line_source {} {
3341 global cmitmode currentid parents curview blamestuff blameinst
3342 global diff_menu_line diff_menu_filebase flist_menu_file
3343 global nullid nullid2 gitdir
3345 set from_index {}
3346 if {$cmitmode eq "tree"} {
3347 set id $currentid
3348 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3349 } else {
3350 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3351 if {$h eq {}} return
3352 set pi [lindex $h 0]
3353 if {$pi == 0} {
3354 mark_ctext_line $diff_menu_line
3355 return
3357 incr pi -1
3358 if {$currentid eq $nullid} {
3359 if {$pi > 0} {
3360 # must be a merge in progress...
3361 if {[catch {
3362 # get the last line from .git/MERGE_HEAD
3363 set f [open [file join $gitdir MERGE_HEAD] r]
3364 set id [lindex [split [read $f] "\n"] end-1]
3365 close $f
3366 } err]} {
3367 error_popup [mc "Couldn't read merge head: %s" $err]
3368 return
3370 } elseif {$parents($curview,$currentid) eq $nullid2} {
3371 # need to do the blame from the index
3372 if {[catch {
3373 set from_index [index_sha1 $flist_menu_file]
3374 } err]} {
3375 error_popup [mc "Error reading index: %s" $err]
3376 return
3379 } else {
3380 set id [lindex $parents($curview,$currentid) $pi]
3382 set line [lindex $h 1]
3384 set blameargs {}
3385 if {$from_index ne {}} {
3386 lappend blameargs | git cat-file blob $from_index
3388 lappend blameargs | git blame -p -L$line,+1
3389 if {$from_index ne {}} {
3390 lappend blameargs --contents -
3391 } else {
3392 lappend blameargs $id
3394 lappend blameargs -- $flist_menu_file
3395 if {[catch {
3396 set f [open $blameargs r]
3397 } err]} {
3398 error_popup [mc "Couldn't start git blame: %s" $err]
3399 return
3401 fconfigure $f -blocking 0
3402 set i [reg_instance $f]
3403 set blamestuff($i) {}
3404 set blameinst $i
3405 filerun $f [list read_line_source $f $i]
3408 proc stopblaming {} {
3409 global blameinst
3411 if {[info exists blameinst]} {
3412 stop_instance $blameinst
3413 unset blameinst
3417 proc read_line_source {fd inst} {
3418 global blamestuff curview commfd blameinst nullid nullid2
3420 while {[gets $fd line] >= 0} {
3421 lappend blamestuff($inst) $line
3423 if {![eof $fd]} {
3424 return 1
3426 unset commfd($inst)
3427 unset blameinst
3428 fconfigure $fd -blocking 1
3429 if {[catch {close $fd} err]} {
3430 error_popup [mc "Error running git blame: %s" $err]
3431 return 0
3434 set fname {}
3435 set line [split [lindex $blamestuff($inst) 0] " "]
3436 set id [lindex $line 0]
3437 set lnum [lindex $line 1]
3438 if {[string length $id] == 40 && [string is xdigit $id] &&
3439 [string is digit -strict $lnum]} {
3440 # look for "filename" line
3441 foreach l $blamestuff($inst) {
3442 if {[string match "filename *" $l]} {
3443 set fname [string range $l 9 end]
3444 break
3448 if {$fname ne {}} {
3449 # all looks good, select it
3450 if {$id eq $nullid} {
3451 # blame uses all-zeroes to mean not committed,
3452 # which would mean a change in the index
3453 set id $nullid2
3455 if {[commitinview $id $curview]} {
3456 selectline [rowofcommit $id] 1 [list $fname $lnum]
3457 } else {
3458 error_popup [mc "That line comes from commit %s, \
3459 which is not in this view" [shortids $id]]
3461 } else {
3462 puts "oops couldn't parse git blame output"
3464 return 0
3467 # delete $dir when we see eof on $f (presumably because the child has exited)
3468 proc delete_at_eof {f dir} {
3469 while {[gets $f line] >= 0} {}
3470 if {[eof $f]} {
3471 if {[catch {close $f} err]} {
3472 error_popup "[mc "External diff viewer failed:"] $err"
3474 file delete -force $dir
3475 return 0
3477 return 1
3480 # Functions for adding and removing shell-type quoting
3482 proc shellquote {str} {
3483 if {![string match "*\['\"\\ \t]*" $str]} {
3484 return $str
3486 if {![string match "*\['\"\\]*" $str]} {
3487 return "\"$str\""
3489 if {![string match "*'*" $str]} {
3490 return "'$str'"
3492 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3495 proc shellarglist {l} {
3496 set str {}
3497 foreach a $l {
3498 if {$str ne {}} {
3499 append str " "
3501 append str [shellquote $a]
3503 return $str
3506 proc shelldequote {str} {
3507 set ret {}
3508 set used -1
3509 while {1} {
3510 incr used
3511 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3512 append ret [string range $str $used end]
3513 set used [string length $str]
3514 break
3516 set first [lindex $first 0]
3517 set ch [string index $str $first]
3518 if {$first > $used} {
3519 append ret [string range $str $used [expr {$first - 1}]]
3520 set used $first
3522 if {$ch eq " " || $ch eq "\t"} break
3523 incr used
3524 if {$ch eq "'"} {
3525 set first [string first "'" $str $used]
3526 if {$first < 0} {
3527 error "unmatched single-quote"
3529 append ret [string range $str $used [expr {$first - 1}]]
3530 set used $first
3531 continue
3533 if {$ch eq "\\"} {
3534 if {$used >= [string length $str]} {
3535 error "trailing backslash"
3537 append ret [string index $str $used]
3538 continue
3540 # here ch == "\""
3541 while {1} {
3542 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3543 error "unmatched double-quote"
3545 set first [lindex $first 0]
3546 set ch [string index $str $first]
3547 if {$first > $used} {
3548 append ret [string range $str $used [expr {$first - 1}]]
3549 set used $first
3551 if {$ch eq "\""} break
3552 incr used
3553 append ret [string index $str $used]
3554 incr used
3557 return [list $used $ret]
3560 proc shellsplit {str} {
3561 set l {}
3562 while {1} {
3563 set str [string trimleft $str]
3564 if {$str eq {}} break
3565 set dq [shelldequote $str]
3566 set n [lindex $dq 0]
3567 set word [lindex $dq 1]
3568 set str [string range $str $n end]
3569 lappend l $word
3571 return $l
3574 # Code to implement multiple views
3576 proc newview {ishighlight} {
3577 global nextviewnum newviewname newishighlight
3578 global revtreeargs viewargscmd newviewopts curview
3580 set newishighlight $ishighlight
3581 set top .gitkview
3582 if {[winfo exists $top]} {
3583 raise $top
3584 return
3586 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3587 set newviewopts($nextviewnum,perm) 0
3588 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3589 decode_view_opts $nextviewnum $revtreeargs
3590 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3593 set known_view_options {
3594 {perm b . {} {mc "Remember this view"}}
3595 {args t50= + {} {mc "Commits to include (arguments to git log):"}}
3596 {all b * "--all" {mc "Use all refs"}}
3597 {dorder b . {"--date-order" "-d"} {mc "Strictly sort by date"}}
3598 {lright b . "--left-right" {mc "Mark branch sides"}}
3599 {since t15 + {"--since=*" "--after=*"} {mc "Since date:"}}
3600 {until t15 . {"--until=*" "--before=*"} {mc "Until date:"}}
3601 {limit t10 + "--max-count=*" {mc "Max count:"}}
3602 {skip t10 . "--skip=*" {mc "Skip:"}}
3603 {first b . "--first-parent" {mc "Limit to first parent"}}
3604 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
3607 proc encode_view_opts {n} {
3608 global known_view_options newviewopts
3610 set rargs [list]
3611 foreach opt $known_view_options {
3612 set patterns [lindex $opt 3]
3613 if {$patterns eq {}} continue
3614 set pattern [lindex $patterns 0]
3616 set val $newviewopts($n,[lindex $opt 0])
3618 if {[lindex $opt 1] eq "b"} {
3619 if {$val} {
3620 lappend rargs $pattern
3622 } else {
3623 set val [string trim $val]
3624 if {$val ne {}} {
3625 set pfix [string range $pattern 0 end-1]
3626 lappend rargs $pfix$val
3630 return [concat $rargs [shellsplit $newviewopts($n,args)]]
3633 proc decode_view_opts {n view_args} {
3634 global known_view_options newviewopts
3636 foreach opt $known_view_options {
3637 if {[lindex $opt 1] eq "b"} {
3638 set val 0
3639 } else {
3640 set val {}
3642 set newviewopts($n,[lindex $opt 0]) $val
3644 set oargs [list]
3645 foreach arg $view_args {
3646 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
3647 && ![info exists found(limit)]} {
3648 set newviewopts($n,limit) $cnt
3649 set found(limit) 1
3650 continue
3652 catch { unset val }
3653 foreach opt $known_view_options {
3654 set id [lindex $opt 0]
3655 if {[info exists found($id)]} continue
3656 foreach pattern [lindex $opt 3] {
3657 if {![string match $pattern $arg]} continue
3658 if {[lindex $opt 1] ne "b"} {
3659 set size [string length $pattern]
3660 set val [string range $arg [expr {$size-1}] end]
3661 } else {
3662 set val 1
3664 set newviewopts($n,$id) $val
3665 set found($id) 1
3666 break
3668 if {[info exists val]} break
3670 if {[info exists val]} continue
3671 lappend oargs $arg
3673 set newviewopts($n,args) [shellarglist $oargs]
3676 proc edit_or_newview {} {
3677 global curview
3679 if {$curview > 0} {
3680 editview
3681 } else {
3682 newview 0
3686 proc editview {} {
3687 global curview
3688 global viewname viewperm newviewname newviewopts
3689 global viewargs viewargscmd
3691 set top .gitkvedit-$curview
3692 if {[winfo exists $top]} {
3693 raise $top
3694 return
3696 set newviewname($curview) $viewname($curview)
3697 set newviewopts($curview,perm) $viewperm($curview)
3698 set newviewopts($curview,cmd) $viewargscmd($curview)
3699 decode_view_opts $curview $viewargs($curview)
3700 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3703 proc vieweditor {top n title} {
3704 global newviewname newviewopts viewfiles bgcolor
3705 global known_view_options
3707 toplevel $top
3708 wm title $top $title
3709 make_transient $top .
3711 # View name
3712 frame $top.nfr
3713 label $top.nl -text [mc "Name"]
3714 entry $top.name -width 20 -textvariable newviewname($n)
3715 pack $top.nfr -in $top -fill x -pady 5 -padx 3
3716 pack $top.nl -in $top.nfr -side left -padx {0 30}
3717 pack $top.name -in $top.nfr -side left
3719 # View options
3720 set cframe $top.nfr
3721 set cexpand 0
3722 set cnt 0
3723 foreach opt $known_view_options {
3724 set id [lindex $opt 0]
3725 set type [lindex $opt 1]
3726 set flags [lindex $opt 2]
3727 set title [eval [lindex $opt 4]]
3728 set lxpad 0
3730 if {$flags eq "+" || $flags eq "*"} {
3731 set cframe $top.fr$cnt
3732 incr cnt
3733 frame $cframe
3734 pack $cframe -in $top -fill x -pady 3 -padx 3
3735 set cexpand [expr {$flags eq "*"}]
3736 } else {
3737 set lxpad 5
3740 if {$type eq "b"} {
3741 checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
3742 pack $cframe.c_$id -in $cframe -side left \
3743 -padx [list $lxpad 0] -expand $cexpand -anchor w
3744 } elseif {[regexp {^t(\d+)$} $type type sz]} {
3745 message $cframe.l_$id -aspect 1500 -text $title
3746 entry $cframe.e_$id -width $sz -background $bgcolor \
3747 -textvariable newviewopts($n,$id)
3748 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
3749 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
3750 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
3751 message $cframe.l_$id -aspect 1500 -text $title
3752 entry $cframe.e_$id -width $sz -background $bgcolor \
3753 -textvariable newviewopts($n,$id)
3754 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
3755 pack $cframe.e_$id -in $cframe -side top -fill x
3759 # Path list
3760 message $top.l -aspect 1500 \
3761 -text [mc "Enter files and directories to include, one per line:"]
3762 pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
3763 text $top.t -width 40 -height 5 -background $bgcolor -font uifont
3764 if {[info exists viewfiles($n)]} {
3765 foreach f $viewfiles($n) {
3766 $top.t insert end $f
3767 $top.t insert end "\n"
3769 $top.t delete {end - 1c} end
3770 $top.t mark set insert 0.0
3772 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
3773 frame $top.buts
3774 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3775 button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
3776 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3777 bind $top <Control-Return> [list newviewok $top $n]
3778 bind $top <F5> [list newviewok $top $n 1]
3779 bind $top <Escape> [list destroy $top]
3780 grid $top.buts.ok $top.buts.apply $top.buts.can
3781 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3782 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3783 grid columnconfigure $top.buts 2 -weight 1 -uniform a
3784 pack $top.buts -in $top -side top -fill x
3785 focus $top.t
3788 proc doviewmenu {m first cmd op argv} {
3789 set nmenu [$m index end]
3790 for {set i $first} {$i <= $nmenu} {incr i} {
3791 if {[$m entrycget $i -command] eq $cmd} {
3792 eval $m $op $i $argv
3793 break
3798 proc allviewmenus {n op args} {
3799 # global viewhlmenu
3801 doviewmenu .bar.view 5 [list showview $n] $op $args
3802 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3805 proc newviewok {top n {apply 0}} {
3806 global nextviewnum newviewperm newviewname newishighlight
3807 global viewname viewfiles viewperm selectedview curview
3808 global viewargs viewargscmd newviewopts viewhlmenu
3810 if {[catch {
3811 set newargs [encode_view_opts $n]
3812 } err]} {
3813 error_popup "[mc "Error in commit selection arguments:"] $err" $top
3814 return
3816 set files {}
3817 foreach f [split [$top.t get 0.0 end] "\n"] {
3818 set ft [string trim $f]
3819 if {$ft ne {}} {
3820 lappend files $ft
3823 if {![info exists viewfiles($n)]} {
3824 # creating a new view
3825 incr nextviewnum
3826 set viewname($n) $newviewname($n)
3827 set viewperm($n) $newviewopts($n,perm)
3828 set viewfiles($n) $files
3829 set viewargs($n) $newargs
3830 set viewargscmd($n) $newviewopts($n,cmd)
3831 addviewmenu $n
3832 if {!$newishighlight} {
3833 run showview $n
3834 } else {
3835 run addvhighlight $n
3837 } else {
3838 # editing an existing view
3839 set viewperm($n) $newviewopts($n,perm)
3840 if {$newviewname($n) ne $viewname($n)} {
3841 set viewname($n) $newviewname($n)
3842 doviewmenu .bar.view 5 [list showview $n] \
3843 entryconf [list -label $viewname($n)]
3844 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3845 # entryconf [list -label $viewname($n) -value $viewname($n)]
3847 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3848 $newviewopts($n,cmd) ne $viewargscmd($n)} {
3849 set viewfiles($n) $files
3850 set viewargs($n) $newargs
3851 set viewargscmd($n) $newviewopts($n,cmd)
3852 if {$curview == $n} {
3853 run reloadcommits
3857 if {$apply} return
3858 catch {destroy $top}
3861 proc delview {} {
3862 global curview viewperm hlview selectedhlview
3864 if {$curview == 0} return
3865 if {[info exists hlview] && $hlview == $curview} {
3866 set selectedhlview [mc "None"]
3867 unset hlview
3869 allviewmenus $curview delete
3870 set viewperm($curview) 0
3871 showview 0
3874 proc addviewmenu {n} {
3875 global viewname viewhlmenu
3877 .bar.view add radiobutton -label $viewname($n) \
3878 -command [list showview $n] -variable selectedview -value $n
3879 #$viewhlmenu add radiobutton -label $viewname($n) \
3880 # -command [list addvhighlight $n] -variable selectedhlview
3883 proc showview {n} {
3884 global curview cached_commitrow ordertok
3885 global displayorder parentlist rowidlist rowisopt rowfinal
3886 global colormap rowtextx nextcolor canvxmax
3887 global numcommits viewcomplete
3888 global selectedline currentid canv canvy0
3889 global treediffs
3890 global pending_select mainheadid
3891 global commitidx
3892 global selectedview
3893 global hlview selectedhlview commitinterest
3895 if {$n == $curview} return
3896 set selid {}
3897 set ymax [lindex [$canv cget -scrollregion] 3]
3898 set span [$canv yview]
3899 set ytop [expr {[lindex $span 0] * $ymax}]
3900 set ybot [expr {[lindex $span 1] * $ymax}]
3901 set yscreen [expr {($ybot - $ytop) / 2}]
3902 if {$selectedline ne {}} {
3903 set selid $currentid
3904 set y [yc $selectedline]
3905 if {$ytop < $y && $y < $ybot} {
3906 set yscreen [expr {$y - $ytop}]
3908 } elseif {[info exists pending_select]} {
3909 set selid $pending_select
3910 unset pending_select
3912 unselectline
3913 normalline
3914 catch {unset treediffs}
3915 clear_display
3916 if {[info exists hlview] && $hlview == $n} {
3917 unset hlview
3918 set selectedhlview [mc "None"]
3920 catch {unset commitinterest}
3921 catch {unset cached_commitrow}
3922 catch {unset ordertok}
3924 set curview $n
3925 set selectedview $n
3926 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3927 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3929 run refill_reflist
3930 if {![info exists viewcomplete($n)]} {
3931 getcommits $selid
3932 return
3935 set displayorder {}
3936 set parentlist {}
3937 set rowidlist {}
3938 set rowisopt {}
3939 set rowfinal {}
3940 set numcommits $commitidx($n)
3942 catch {unset colormap}
3943 catch {unset rowtextx}
3944 set nextcolor 0
3945 set canvxmax [$canv cget -width]
3946 set curview $n
3947 set row 0
3948 setcanvscroll
3949 set yf 0
3950 set row {}
3951 if {$selid ne {} && [commitinview $selid $n]} {
3952 set row [rowofcommit $selid]
3953 # try to get the selected row in the same position on the screen
3954 set ymax [lindex [$canv cget -scrollregion] 3]
3955 set ytop [expr {[yc $row] - $yscreen}]
3956 if {$ytop < 0} {
3957 set ytop 0
3959 set yf [expr {$ytop * 1.0 / $ymax}]
3961 allcanvs yview moveto $yf
3962 drawvisible
3963 if {$row ne {}} {
3964 selectline $row 0
3965 } elseif {!$viewcomplete($n)} {
3966 reset_pending_select $selid
3967 } else {
3968 reset_pending_select {}
3970 if {[commitinview $pending_select $curview]} {
3971 selectline [rowofcommit $pending_select] 1
3972 } else {
3973 set row [first_real_row]
3974 if {$row < $numcommits} {
3975 selectline $row 0
3979 if {!$viewcomplete($n)} {
3980 if {$numcommits == 0} {
3981 show_status [mc "Reading commits..."]
3983 } elseif {$numcommits == 0} {
3984 show_status [mc "No commits selected"]
3988 # Stuff relating to the highlighting facility
3990 proc ishighlighted {id} {
3991 global vhighlights fhighlights nhighlights rhighlights
3993 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3994 return $nhighlights($id)
3996 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3997 return $vhighlights($id)
3999 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4000 return $fhighlights($id)
4002 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4003 return $rhighlights($id)
4005 return 0
4008 proc bolden {row font} {
4009 global canv linehtag selectedline boldrows need_redisplay
4011 # need_redisplay = 1 means the display is stale and about to be redrawn
4012 if {$need_redisplay} return
4013 lappend boldrows $row
4014 $canv itemconf $linehtag($row) -font $font
4015 if {$row == $selectedline} {
4016 $canv delete secsel
4017 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
4018 -outline {{}} -tags secsel \
4019 -fill [$canv cget -selectbackground]]
4020 $canv lower $t
4024 proc bolden_name {row font} {
4025 global canv2 linentag selectedline boldnamerows need_redisplay
4027 if {$need_redisplay} return
4028 lappend boldnamerows $row
4029 $canv2 itemconf $linentag($row) -font $font
4030 if {$row == $selectedline} {
4031 $canv2 delete secsel
4032 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
4033 -outline {{}} -tags secsel \
4034 -fill [$canv2 cget -selectbackground]]
4035 $canv2 lower $t
4039 proc unbolden {} {
4040 global boldrows
4042 set stillbold {}
4043 foreach row $boldrows {
4044 if {![ishighlighted [commitonrow $row]]} {
4045 bolden $row mainfont
4046 } else {
4047 lappend stillbold $row
4050 set boldrows $stillbold
4053 proc addvhighlight {n} {
4054 global hlview viewcomplete curview vhl_done commitidx
4056 if {[info exists hlview]} {
4057 delvhighlight
4059 set hlview $n
4060 if {$n != $curview && ![info exists viewcomplete($n)]} {
4061 start_rev_list $n
4063 set vhl_done $commitidx($hlview)
4064 if {$vhl_done > 0} {
4065 drawvisible
4069 proc delvhighlight {} {
4070 global hlview vhighlights
4072 if {![info exists hlview]} return
4073 unset hlview
4074 catch {unset vhighlights}
4075 unbolden
4078 proc vhighlightmore {} {
4079 global hlview vhl_done commitidx vhighlights curview
4081 set max $commitidx($hlview)
4082 set vr [visiblerows]
4083 set r0 [lindex $vr 0]
4084 set r1 [lindex $vr 1]
4085 for {set i $vhl_done} {$i < $max} {incr i} {
4086 set id [commitonrow $i $hlview]
4087 if {[commitinview $id $curview]} {
4088 set row [rowofcommit $id]
4089 if {$r0 <= $row && $row <= $r1} {
4090 if {![highlighted $row]} {
4091 bolden $row mainfontbold
4093 set vhighlights($id) 1
4097 set vhl_done $max
4098 return 0
4101 proc askvhighlight {row id} {
4102 global hlview vhighlights iddrawn
4104 if {[commitinview $id $hlview]} {
4105 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4106 bolden $row mainfontbold
4108 set vhighlights($id) 1
4109 } else {
4110 set vhighlights($id) 0
4114 proc hfiles_change {} {
4115 global highlight_files filehighlight fhighlights fh_serial
4116 global highlight_paths gdttype
4118 if {[info exists filehighlight]} {
4119 # delete previous highlights
4120 catch {close $filehighlight}
4121 unset filehighlight
4122 catch {unset fhighlights}
4123 unbolden
4124 unhighlight_filelist
4126 set highlight_paths {}
4127 after cancel do_file_hl $fh_serial
4128 incr fh_serial
4129 if {$highlight_files ne {}} {
4130 after 300 do_file_hl $fh_serial
4134 proc gdttype_change {name ix op} {
4135 global gdttype highlight_files findstring findpattern
4137 stopfinding
4138 if {$findstring ne {}} {
4139 if {$gdttype eq [mc "containing:"]} {
4140 if {$highlight_files ne {}} {
4141 set highlight_files {}
4142 hfiles_change
4144 findcom_change
4145 } else {
4146 if {$findpattern ne {}} {
4147 set findpattern {}
4148 findcom_change
4150 set highlight_files $findstring
4151 hfiles_change
4153 drawvisible
4155 # enable/disable findtype/findloc menus too
4158 proc find_change {name ix op} {
4159 global gdttype findstring highlight_files
4161 stopfinding
4162 if {$gdttype eq [mc "containing:"]} {
4163 findcom_change
4164 } else {
4165 if {$highlight_files ne $findstring} {
4166 set highlight_files $findstring
4167 hfiles_change
4170 drawvisible
4173 proc findcom_change args {
4174 global nhighlights boldnamerows
4175 global findpattern findtype findstring gdttype
4177 stopfinding
4178 # delete previous highlights, if any
4179 foreach row $boldnamerows {
4180 bolden_name $row mainfont
4182 set boldnamerows {}
4183 catch {unset nhighlights}
4184 unbolden
4185 unmarkmatches
4186 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4187 set findpattern {}
4188 } elseif {$findtype eq [mc "Regexp"]} {
4189 set findpattern $findstring
4190 } else {
4191 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4192 $findstring]
4193 set findpattern "*$e*"
4197 proc makepatterns {l} {
4198 set ret {}
4199 foreach e $l {
4200 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4201 if {[string index $ee end] eq "/"} {
4202 lappend ret "$ee*"
4203 } else {
4204 lappend ret $ee
4205 lappend ret "$ee/*"
4208 return $ret
4211 proc do_file_hl {serial} {
4212 global highlight_files filehighlight highlight_paths gdttype fhl_list
4214 if {$gdttype eq [mc "touching paths:"]} {
4215 if {[catch {set paths [shellsplit $highlight_files]}]} return
4216 set highlight_paths [makepatterns $paths]
4217 highlight_filelist
4218 set gdtargs [concat -- $paths]
4219 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4220 set gdtargs [list "-S$highlight_files"]
4221 } else {
4222 # must be "containing:", i.e. we're searching commit info
4223 return
4225 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4226 set filehighlight [open $cmd r+]
4227 fconfigure $filehighlight -blocking 0
4228 filerun $filehighlight readfhighlight
4229 set fhl_list {}
4230 drawvisible
4231 flushhighlights
4234 proc flushhighlights {} {
4235 global filehighlight fhl_list
4237 if {[info exists filehighlight]} {
4238 lappend fhl_list {}
4239 puts $filehighlight ""
4240 flush $filehighlight
4244 proc askfilehighlight {row id} {
4245 global filehighlight fhighlights fhl_list
4247 lappend fhl_list $id
4248 set fhighlights($id) -1
4249 puts $filehighlight $id
4252 proc readfhighlight {} {
4253 global filehighlight fhighlights curview iddrawn
4254 global fhl_list find_dirn
4256 if {![info exists filehighlight]} {
4257 return 0
4259 set nr 0
4260 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4261 set line [string trim $line]
4262 set i [lsearch -exact $fhl_list $line]
4263 if {$i < 0} continue
4264 for {set j 0} {$j < $i} {incr j} {
4265 set id [lindex $fhl_list $j]
4266 set fhighlights($id) 0
4268 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4269 if {$line eq {}} continue
4270 if {![commitinview $line $curview]} continue
4271 set row [rowofcommit $line]
4272 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4273 bolden $row mainfontbold
4275 set fhighlights($line) 1
4277 if {[eof $filehighlight]} {
4278 # strange...
4279 puts "oops, git diff-tree died"
4280 catch {close $filehighlight}
4281 unset filehighlight
4282 return 0
4284 if {[info exists find_dirn]} {
4285 run findmore
4287 return 1
4290 proc doesmatch {f} {
4291 global findtype findpattern
4293 if {$findtype eq [mc "Regexp"]} {
4294 return [regexp $findpattern $f]
4295 } elseif {$findtype eq [mc "IgnCase"]} {
4296 return [string match -nocase $findpattern $f]
4297 } else {
4298 return [string match $findpattern $f]
4302 proc askfindhighlight {row id} {
4303 global nhighlights commitinfo iddrawn
4304 global findloc
4305 global markingmatches
4307 if {![info exists commitinfo($id)]} {
4308 getcommit $id
4310 set info $commitinfo($id)
4311 set isbold 0
4312 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4313 foreach f $info ty $fldtypes {
4314 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4315 [doesmatch $f]} {
4316 if {$ty eq [mc "Author"]} {
4317 set isbold 2
4318 break
4320 set isbold 1
4323 if {$isbold && [info exists iddrawn($id)]} {
4324 if {![ishighlighted $id]} {
4325 bolden $row mainfontbold
4326 if {$isbold > 1} {
4327 bolden_name $row mainfontbold
4330 if {$markingmatches} {
4331 markrowmatches $row $id
4334 set nhighlights($id) $isbold
4337 proc markrowmatches {row id} {
4338 global canv canv2 linehtag linentag commitinfo findloc
4340 set headline [lindex $commitinfo($id) 0]
4341 set author [lindex $commitinfo($id) 1]
4342 $canv delete match$row
4343 $canv2 delete match$row
4344 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4345 set m [findmatches $headline]
4346 if {$m ne {}} {
4347 markmatches $canv $row $headline $linehtag($row) $m \
4348 [$canv itemcget $linehtag($row) -font] $row
4351 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4352 set m [findmatches $author]
4353 if {$m ne {}} {
4354 markmatches $canv2 $row $author $linentag($row) $m \
4355 [$canv2 itemcget $linentag($row) -font] $row
4360 proc vrel_change {name ix op} {
4361 global highlight_related
4363 rhighlight_none
4364 if {$highlight_related ne [mc "None"]} {
4365 run drawvisible
4369 # prepare for testing whether commits are descendents or ancestors of a
4370 proc rhighlight_sel {a} {
4371 global descendent desc_todo ancestor anc_todo
4372 global highlight_related
4374 catch {unset descendent}
4375 set desc_todo [list $a]
4376 catch {unset ancestor}
4377 set anc_todo [list $a]
4378 if {$highlight_related ne [mc "None"]} {
4379 rhighlight_none
4380 run drawvisible
4384 proc rhighlight_none {} {
4385 global rhighlights
4387 catch {unset rhighlights}
4388 unbolden
4391 proc is_descendent {a} {
4392 global curview children descendent desc_todo
4394 set v $curview
4395 set la [rowofcommit $a]
4396 set todo $desc_todo
4397 set leftover {}
4398 set done 0
4399 for {set i 0} {$i < [llength $todo]} {incr i} {
4400 set do [lindex $todo $i]
4401 if {[rowofcommit $do] < $la} {
4402 lappend leftover $do
4403 continue
4405 foreach nk $children($v,$do) {
4406 if {![info exists descendent($nk)]} {
4407 set descendent($nk) 1
4408 lappend todo $nk
4409 if {$nk eq $a} {
4410 set done 1
4414 if {$done} {
4415 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4416 return
4419 set descendent($a) 0
4420 set desc_todo $leftover
4423 proc is_ancestor {a} {
4424 global curview parents ancestor anc_todo
4426 set v $curview
4427 set la [rowofcommit $a]
4428 set todo $anc_todo
4429 set leftover {}
4430 set done 0
4431 for {set i 0} {$i < [llength $todo]} {incr i} {
4432 set do [lindex $todo $i]
4433 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4434 lappend leftover $do
4435 continue
4437 foreach np $parents($v,$do) {
4438 if {![info exists ancestor($np)]} {
4439 set ancestor($np) 1
4440 lappend todo $np
4441 if {$np eq $a} {
4442 set done 1
4446 if {$done} {
4447 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4448 return
4451 set ancestor($a) 0
4452 set anc_todo $leftover
4455 proc askrelhighlight {row id} {
4456 global descendent highlight_related iddrawn rhighlights
4457 global selectedline ancestor
4459 if {$selectedline eq {}} return
4460 set isbold 0
4461 if {$highlight_related eq [mc "Descendant"] ||
4462 $highlight_related eq [mc "Not descendant"]} {
4463 if {![info exists descendent($id)]} {
4464 is_descendent $id
4466 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4467 set isbold 1
4469 } elseif {$highlight_related eq [mc "Ancestor"] ||
4470 $highlight_related eq [mc "Not ancestor"]} {
4471 if {![info exists ancestor($id)]} {
4472 is_ancestor $id
4474 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4475 set isbold 1
4478 if {[info exists iddrawn($id)]} {
4479 if {$isbold && ![ishighlighted $id]} {
4480 bolden $row mainfontbold
4483 set rhighlights($id) $isbold
4486 # Graph layout functions
4488 proc shortids {ids} {
4489 set res {}
4490 foreach id $ids {
4491 if {[llength $id] > 1} {
4492 lappend res [shortids $id]
4493 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4494 lappend res [string range $id 0 7]
4495 } else {
4496 lappend res $id
4499 return $res
4502 proc ntimes {n o} {
4503 set ret {}
4504 set o [list $o]
4505 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4506 if {($n & $mask) != 0} {
4507 set ret [concat $ret $o]
4509 set o [concat $o $o]
4511 return $ret
4514 proc ordertoken {id} {
4515 global ordertok curview varcid varcstart varctok curview parents children
4516 global nullid nullid2
4518 if {[info exists ordertok($id)]} {
4519 return $ordertok($id)
4521 set origid $id
4522 set todo {}
4523 while {1} {
4524 if {[info exists varcid($curview,$id)]} {
4525 set a $varcid($curview,$id)
4526 set p [lindex $varcstart($curview) $a]
4527 } else {
4528 set p [lindex $children($curview,$id) 0]
4530 if {[info exists ordertok($p)]} {
4531 set tok $ordertok($p)
4532 break
4534 set id [first_real_child $curview,$p]
4535 if {$id eq {}} {
4536 # it's a root
4537 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4538 break
4540 if {[llength $parents($curview,$id)] == 1} {
4541 lappend todo [list $p {}]
4542 } else {
4543 set j [lsearch -exact $parents($curview,$id) $p]
4544 if {$j < 0} {
4545 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4547 lappend todo [list $p [strrep $j]]
4550 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4551 set p [lindex $todo $i 0]
4552 append tok [lindex $todo $i 1]
4553 set ordertok($p) $tok
4555 set ordertok($origid) $tok
4556 return $tok
4559 # Work out where id should go in idlist so that order-token
4560 # values increase from left to right
4561 proc idcol {idlist id {i 0}} {
4562 set t [ordertoken $id]
4563 if {$i < 0} {
4564 set i 0
4566 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4567 if {$i > [llength $idlist]} {
4568 set i [llength $idlist]
4570 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4571 incr i
4572 } else {
4573 if {$t > [ordertoken [lindex $idlist $i]]} {
4574 while {[incr i] < [llength $idlist] &&
4575 $t >= [ordertoken [lindex $idlist $i]]} {}
4578 return $i
4581 proc initlayout {} {
4582 global rowidlist rowisopt rowfinal displayorder parentlist
4583 global numcommits canvxmax canv
4584 global nextcolor
4585 global colormap rowtextx
4587 set numcommits 0
4588 set displayorder {}
4589 set parentlist {}
4590 set nextcolor 0
4591 set rowidlist {}
4592 set rowisopt {}
4593 set rowfinal {}
4594 set canvxmax [$canv cget -width]
4595 catch {unset colormap}
4596 catch {unset rowtextx}
4597 setcanvscroll
4600 proc setcanvscroll {} {
4601 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4602 global lastscrollset lastscrollrows
4604 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4605 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4606 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4607 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4608 set lastscrollset [clock clicks -milliseconds]
4609 set lastscrollrows $numcommits
4612 proc visiblerows {} {
4613 global canv numcommits linespc
4615 set ymax [lindex [$canv cget -scrollregion] 3]
4616 if {$ymax eq {} || $ymax == 0} return
4617 set f [$canv yview]
4618 set y0 [expr {int([lindex $f 0] * $ymax)}]
4619 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4620 if {$r0 < 0} {
4621 set r0 0
4623 set y1 [expr {int([lindex $f 1] * $ymax)}]
4624 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4625 if {$r1 >= $numcommits} {
4626 set r1 [expr {$numcommits - 1}]
4628 return [list $r0 $r1]
4631 proc layoutmore {} {
4632 global commitidx viewcomplete curview
4633 global numcommits pending_select curview
4634 global lastscrollset lastscrollrows
4636 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4637 [clock clicks -milliseconds] - $lastscrollset > 500} {
4638 setcanvscroll
4640 if {[info exists pending_select] &&
4641 [commitinview $pending_select $curview]} {
4642 update
4643 selectline [rowofcommit $pending_select] 1
4645 drawvisible
4648 proc doshowlocalchanges {} {
4649 global curview mainheadid
4651 if {$mainheadid eq {}} return
4652 if {[commitinview $mainheadid $curview]} {
4653 dodiffindex
4654 } else {
4655 interestedin $mainheadid dodiffindex
4659 proc dohidelocalchanges {} {
4660 global nullid nullid2 lserial curview
4662 if {[commitinview $nullid $curview]} {
4663 removefakerow $nullid
4665 if {[commitinview $nullid2 $curview]} {
4666 removefakerow $nullid2
4668 incr lserial
4671 # spawn off a process to do git diff-index --cached HEAD
4672 proc dodiffindex {} {
4673 global lserial showlocalchanges
4674 global isworktree
4676 if {!$showlocalchanges || !$isworktree} return
4677 incr lserial
4678 set fd [open "|git diff-index --cached HEAD" r]
4679 fconfigure $fd -blocking 0
4680 set i [reg_instance $fd]
4681 filerun $fd [list readdiffindex $fd $lserial $i]
4684 proc readdiffindex {fd serial inst} {
4685 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4687 set isdiff 1
4688 if {[gets $fd line] < 0} {
4689 if {![eof $fd]} {
4690 return 1
4692 set isdiff 0
4694 # we only need to see one line and we don't really care what it says...
4695 stop_instance $inst
4697 if {$serial != $lserial} {
4698 return 0
4701 # now see if there are any local changes not checked in to the index
4702 set fd [open "|git diff-files" r]
4703 fconfigure $fd -blocking 0
4704 set i [reg_instance $fd]
4705 filerun $fd [list readdifffiles $fd $serial $i]
4707 if {$isdiff && ![commitinview $nullid2 $curview]} {
4708 # add the line for the changes in the index to the graph
4709 set hl [mc "Local changes checked in to index but not committed"]
4710 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4711 set commitdata($nullid2) "\n $hl\n"
4712 if {[commitinview $nullid $curview]} {
4713 removefakerow $nullid
4715 insertfakerow $nullid2 $mainheadid
4716 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4717 removefakerow $nullid2
4719 return 0
4722 proc readdifffiles {fd serial inst} {
4723 global mainheadid nullid nullid2 curview
4724 global commitinfo commitdata lserial
4726 set isdiff 1
4727 if {[gets $fd line] < 0} {
4728 if {![eof $fd]} {
4729 return 1
4731 set isdiff 0
4733 # we only need to see one line and we don't really care what it says...
4734 stop_instance $inst
4736 if {$serial != $lserial} {
4737 return 0
4740 if {$isdiff && ![commitinview $nullid $curview]} {
4741 # add the line for the local diff to the graph
4742 set hl [mc "Local uncommitted changes, not checked in to index"]
4743 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4744 set commitdata($nullid) "\n $hl\n"
4745 if {[commitinview $nullid2 $curview]} {
4746 set p $nullid2
4747 } else {
4748 set p $mainheadid
4750 insertfakerow $nullid $p
4751 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4752 removefakerow $nullid
4754 return 0
4757 proc nextuse {id row} {
4758 global curview children
4760 if {[info exists children($curview,$id)]} {
4761 foreach kid $children($curview,$id) {
4762 if {![commitinview $kid $curview]} {
4763 return -1
4765 if {[rowofcommit $kid] > $row} {
4766 return [rowofcommit $kid]
4770 if {[commitinview $id $curview]} {
4771 return [rowofcommit $id]
4773 return -1
4776 proc prevuse {id row} {
4777 global curview children
4779 set ret -1
4780 if {[info exists children($curview,$id)]} {
4781 foreach kid $children($curview,$id) {
4782 if {![commitinview $kid $curview]} break
4783 if {[rowofcommit $kid] < $row} {
4784 set ret [rowofcommit $kid]
4788 return $ret
4791 proc make_idlist {row} {
4792 global displayorder parentlist uparrowlen downarrowlen mingaplen
4793 global commitidx curview children
4795 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4796 if {$r < 0} {
4797 set r 0
4799 set ra [expr {$row - $downarrowlen}]
4800 if {$ra < 0} {
4801 set ra 0
4803 set rb [expr {$row + $uparrowlen}]
4804 if {$rb > $commitidx($curview)} {
4805 set rb $commitidx($curview)
4807 make_disporder $r [expr {$rb + 1}]
4808 set ids {}
4809 for {} {$r < $ra} {incr r} {
4810 set nextid [lindex $displayorder [expr {$r + 1}]]
4811 foreach p [lindex $parentlist $r] {
4812 if {$p eq $nextid} continue
4813 set rn [nextuse $p $r]
4814 if {$rn >= $row &&
4815 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4816 lappend ids [list [ordertoken $p] $p]
4820 for {} {$r < $row} {incr r} {
4821 set nextid [lindex $displayorder [expr {$r + 1}]]
4822 foreach p [lindex $parentlist $r] {
4823 if {$p eq $nextid} continue
4824 set rn [nextuse $p $r]
4825 if {$rn < 0 || $rn >= $row} {
4826 lappend ids [list [ordertoken $p] $p]
4830 set id [lindex $displayorder $row]
4831 lappend ids [list [ordertoken $id] $id]
4832 while {$r < $rb} {
4833 foreach p [lindex $parentlist $r] {
4834 set firstkid [lindex $children($curview,$p) 0]
4835 if {[rowofcommit $firstkid] < $row} {
4836 lappend ids [list [ordertoken $p] $p]
4839 incr r
4840 set id [lindex $displayorder $r]
4841 if {$id ne {}} {
4842 set firstkid [lindex $children($curview,$id) 0]
4843 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4844 lappend ids [list [ordertoken $id] $id]
4848 set idlist {}
4849 foreach idx [lsort -unique $ids] {
4850 lappend idlist [lindex $idx 1]
4852 return $idlist
4855 proc rowsequal {a b} {
4856 while {[set i [lsearch -exact $a {}]] >= 0} {
4857 set a [lreplace $a $i $i]
4859 while {[set i [lsearch -exact $b {}]] >= 0} {
4860 set b [lreplace $b $i $i]
4862 return [expr {$a eq $b}]
4865 proc makeupline {id row rend col} {
4866 global rowidlist uparrowlen downarrowlen mingaplen
4868 for {set r $rend} {1} {set r $rstart} {
4869 set rstart [prevuse $id $r]
4870 if {$rstart < 0} return
4871 if {$rstart < $row} break
4873 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4874 set rstart [expr {$rend - $uparrowlen - 1}]
4876 for {set r $rstart} {[incr r] <= $row} {} {
4877 set idlist [lindex $rowidlist $r]
4878 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4879 set col [idcol $idlist $id $col]
4880 lset rowidlist $r [linsert $idlist $col $id]
4881 changedrow $r
4886 proc layoutrows {row endrow} {
4887 global rowidlist rowisopt rowfinal displayorder
4888 global uparrowlen downarrowlen maxwidth mingaplen
4889 global children parentlist
4890 global commitidx viewcomplete curview
4892 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4893 set idlist {}
4894 if {$row > 0} {
4895 set rm1 [expr {$row - 1}]
4896 foreach id [lindex $rowidlist $rm1] {
4897 if {$id ne {}} {
4898 lappend idlist $id
4901 set final [lindex $rowfinal $rm1]
4903 for {} {$row < $endrow} {incr row} {
4904 set rm1 [expr {$row - 1}]
4905 if {$rm1 < 0 || $idlist eq {}} {
4906 set idlist [make_idlist $row]
4907 set final 1
4908 } else {
4909 set id [lindex $displayorder $rm1]
4910 set col [lsearch -exact $idlist $id]
4911 set idlist [lreplace $idlist $col $col]
4912 foreach p [lindex $parentlist $rm1] {
4913 if {[lsearch -exact $idlist $p] < 0} {
4914 set col [idcol $idlist $p $col]
4915 set idlist [linsert $idlist $col $p]
4916 # if not the first child, we have to insert a line going up
4917 if {$id ne [lindex $children($curview,$p) 0]} {
4918 makeupline $p $rm1 $row $col
4922 set id [lindex $displayorder $row]
4923 if {$row > $downarrowlen} {
4924 set termrow [expr {$row - $downarrowlen - 1}]
4925 foreach p [lindex $parentlist $termrow] {
4926 set i [lsearch -exact $idlist $p]
4927 if {$i < 0} continue
4928 set nr [nextuse $p $termrow]
4929 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4930 set idlist [lreplace $idlist $i $i]
4934 set col [lsearch -exact $idlist $id]
4935 if {$col < 0} {
4936 set col [idcol $idlist $id]
4937 set idlist [linsert $idlist $col $id]
4938 if {$children($curview,$id) ne {}} {
4939 makeupline $id $rm1 $row $col
4942 set r [expr {$row + $uparrowlen - 1}]
4943 if {$r < $commitidx($curview)} {
4944 set x $col
4945 foreach p [lindex $parentlist $r] {
4946 if {[lsearch -exact $idlist $p] >= 0} continue
4947 set fk [lindex $children($curview,$p) 0]
4948 if {[rowofcommit $fk] < $row} {
4949 set x [idcol $idlist $p $x]
4950 set idlist [linsert $idlist $x $p]
4953 if {[incr r] < $commitidx($curview)} {
4954 set p [lindex $displayorder $r]
4955 if {[lsearch -exact $idlist $p] < 0} {
4956 set fk [lindex $children($curview,$p) 0]
4957 if {$fk ne {} && [rowofcommit $fk] < $row} {
4958 set x [idcol $idlist $p $x]
4959 set idlist [linsert $idlist $x $p]
4965 if {$final && !$viewcomplete($curview) &&
4966 $row + $uparrowlen + $mingaplen + $downarrowlen
4967 >= $commitidx($curview)} {
4968 set final 0
4970 set l [llength $rowidlist]
4971 if {$row == $l} {
4972 lappend rowidlist $idlist
4973 lappend rowisopt 0
4974 lappend rowfinal $final
4975 } elseif {$row < $l} {
4976 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4977 lset rowidlist $row $idlist
4978 changedrow $row
4980 lset rowfinal $row $final
4981 } else {
4982 set pad [ntimes [expr {$row - $l}] {}]
4983 set rowidlist [concat $rowidlist $pad]
4984 lappend rowidlist $idlist
4985 set rowfinal [concat $rowfinal $pad]
4986 lappend rowfinal $final
4987 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4990 return $row
4993 proc changedrow {row} {
4994 global displayorder iddrawn rowisopt need_redisplay
4996 set l [llength $rowisopt]
4997 if {$row < $l} {
4998 lset rowisopt $row 0
4999 if {$row + 1 < $l} {
5000 lset rowisopt [expr {$row + 1}] 0
5001 if {$row + 2 < $l} {
5002 lset rowisopt [expr {$row + 2}] 0
5006 set id [lindex $displayorder $row]
5007 if {[info exists iddrawn($id)]} {
5008 set need_redisplay 1
5012 proc insert_pad {row col npad} {
5013 global rowidlist
5015 set pad [ntimes $npad {}]
5016 set idlist [lindex $rowidlist $row]
5017 set bef [lrange $idlist 0 [expr {$col - 1}]]
5018 set aft [lrange $idlist $col end]
5019 set i [lsearch -exact $aft {}]
5020 if {$i > 0} {
5021 set aft [lreplace $aft $i $i]
5023 lset rowidlist $row [concat $bef $pad $aft]
5024 changedrow $row
5027 proc optimize_rows {row col endrow} {
5028 global rowidlist rowisopt displayorder curview children
5030 if {$row < 1} {
5031 set row 1
5033 for {} {$row < $endrow} {incr row; set col 0} {
5034 if {[lindex $rowisopt $row]} continue
5035 set haspad 0
5036 set y0 [expr {$row - 1}]
5037 set ym [expr {$row - 2}]
5038 set idlist [lindex $rowidlist $row]
5039 set previdlist [lindex $rowidlist $y0]
5040 if {$idlist eq {} || $previdlist eq {}} continue
5041 if {$ym >= 0} {
5042 set pprevidlist [lindex $rowidlist $ym]
5043 if {$pprevidlist eq {}} continue
5044 } else {
5045 set pprevidlist {}
5047 set x0 -1
5048 set xm -1
5049 for {} {$col < [llength $idlist]} {incr col} {
5050 set id [lindex $idlist $col]
5051 if {[lindex $previdlist $col] eq $id} continue
5052 if {$id eq {}} {
5053 set haspad 1
5054 continue
5056 set x0 [lsearch -exact $previdlist $id]
5057 if {$x0 < 0} continue
5058 set z [expr {$x0 - $col}]
5059 set isarrow 0
5060 set z0 {}
5061 if {$ym >= 0} {
5062 set xm [lsearch -exact $pprevidlist $id]
5063 if {$xm >= 0} {
5064 set z0 [expr {$xm - $x0}]
5067 if {$z0 eq {}} {
5068 # if row y0 is the first child of $id then it's not an arrow
5069 if {[lindex $children($curview,$id) 0] ne
5070 [lindex $displayorder $y0]} {
5071 set isarrow 1
5074 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5075 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5076 set isarrow 1
5078 # Looking at lines from this row to the previous row,
5079 # make them go straight up if they end in an arrow on
5080 # the previous row; otherwise make them go straight up
5081 # or at 45 degrees.
5082 if {$z < -1 || ($z < 0 && $isarrow)} {
5083 # Line currently goes left too much;
5084 # insert pads in the previous row, then optimize it
5085 set npad [expr {-1 - $z + $isarrow}]
5086 insert_pad $y0 $x0 $npad
5087 if {$y0 > 0} {
5088 optimize_rows $y0 $x0 $row
5090 set previdlist [lindex $rowidlist $y0]
5091 set x0 [lsearch -exact $previdlist $id]
5092 set z [expr {$x0 - $col}]
5093 if {$z0 ne {}} {
5094 set pprevidlist [lindex $rowidlist $ym]
5095 set xm [lsearch -exact $pprevidlist $id]
5096 set z0 [expr {$xm - $x0}]
5098 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5099 # Line currently goes right too much;
5100 # insert pads in this line
5101 set npad [expr {$z - 1 + $isarrow}]
5102 insert_pad $row $col $npad
5103 set idlist [lindex $rowidlist $row]
5104 incr col $npad
5105 set z [expr {$x0 - $col}]
5106 set haspad 1
5108 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5109 # this line links to its first child on row $row-2
5110 set id [lindex $displayorder $ym]
5111 set xc [lsearch -exact $pprevidlist $id]
5112 if {$xc >= 0} {
5113 set z0 [expr {$xc - $x0}]
5116 # avoid lines jigging left then immediately right
5117 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5118 insert_pad $y0 $x0 1
5119 incr x0
5120 optimize_rows $y0 $x0 $row
5121 set previdlist [lindex $rowidlist $y0]
5124 if {!$haspad} {
5125 # Find the first column that doesn't have a line going right
5126 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5127 set id [lindex $idlist $col]
5128 if {$id eq {}} break
5129 set x0 [lsearch -exact $previdlist $id]
5130 if {$x0 < 0} {
5131 # check if this is the link to the first child
5132 set kid [lindex $displayorder $y0]
5133 if {[lindex $children($curview,$id) 0] eq $kid} {
5134 # it is, work out offset to child
5135 set x0 [lsearch -exact $previdlist $kid]
5138 if {$x0 <= $col} break
5140 # Insert a pad at that column as long as it has a line and
5141 # isn't the last column
5142 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5143 set idlist [linsert $idlist $col {}]
5144 lset rowidlist $row $idlist
5145 changedrow $row
5151 proc xc {row col} {
5152 global canvx0 linespc
5153 return [expr {$canvx0 + $col * $linespc}]
5156 proc yc {row} {
5157 global canvy0 linespc
5158 return [expr {$canvy0 + $row * $linespc}]
5161 proc linewidth {id} {
5162 global thickerline lthickness
5164 set wid $lthickness
5165 if {[info exists thickerline] && $id eq $thickerline} {
5166 set wid [expr {2 * $lthickness}]
5168 return $wid
5171 proc rowranges {id} {
5172 global curview children uparrowlen downarrowlen
5173 global rowidlist
5175 set kids $children($curview,$id)
5176 if {$kids eq {}} {
5177 return {}
5179 set ret {}
5180 lappend kids $id
5181 foreach child $kids {
5182 if {![commitinview $child $curview]} break
5183 set row [rowofcommit $child]
5184 if {![info exists prev]} {
5185 lappend ret [expr {$row + 1}]
5186 } else {
5187 if {$row <= $prevrow} {
5188 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5190 # see if the line extends the whole way from prevrow to row
5191 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5192 [lsearch -exact [lindex $rowidlist \
5193 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5194 # it doesn't, see where it ends
5195 set r [expr {$prevrow + $downarrowlen}]
5196 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5197 while {[incr r -1] > $prevrow &&
5198 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5199 } else {
5200 while {[incr r] <= $row &&
5201 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5202 incr r -1
5204 lappend ret $r
5205 # see where it starts up again
5206 set r [expr {$row - $uparrowlen}]
5207 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5208 while {[incr r] < $row &&
5209 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5210 } else {
5211 while {[incr r -1] >= $prevrow &&
5212 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5213 incr r
5215 lappend ret $r
5218 if {$child eq $id} {
5219 lappend ret $row
5221 set prev $child
5222 set prevrow $row
5224 return $ret
5227 proc drawlineseg {id row endrow arrowlow} {
5228 global rowidlist displayorder iddrawn linesegs
5229 global canv colormap linespc curview maxlinelen parentlist
5231 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5232 set le [expr {$row + 1}]
5233 set arrowhigh 1
5234 while {1} {
5235 set c [lsearch -exact [lindex $rowidlist $le] $id]
5236 if {$c < 0} {
5237 incr le -1
5238 break
5240 lappend cols $c
5241 set x [lindex $displayorder $le]
5242 if {$x eq $id} {
5243 set arrowhigh 0
5244 break
5246 if {[info exists iddrawn($x)] || $le == $endrow} {
5247 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5248 if {$c >= 0} {
5249 lappend cols $c
5250 set arrowhigh 0
5252 break
5254 incr le
5256 if {$le <= $row} {
5257 return $row
5260 set lines {}
5261 set i 0
5262 set joinhigh 0
5263 if {[info exists linesegs($id)]} {
5264 set lines $linesegs($id)
5265 foreach li $lines {
5266 set r0 [lindex $li 0]
5267 if {$r0 > $row} {
5268 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5269 set joinhigh 1
5271 break
5273 incr i
5276 set joinlow 0
5277 if {$i > 0} {
5278 set li [lindex $lines [expr {$i-1}]]
5279 set r1 [lindex $li 1]
5280 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5281 set joinlow 1
5285 set x [lindex $cols [expr {$le - $row}]]
5286 set xp [lindex $cols [expr {$le - 1 - $row}]]
5287 set dir [expr {$xp - $x}]
5288 if {$joinhigh} {
5289 set ith [lindex $lines $i 2]
5290 set coords [$canv coords $ith]
5291 set ah [$canv itemcget $ith -arrow]
5292 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5293 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5294 if {$x2 ne {} && $x - $x2 == $dir} {
5295 set coords [lrange $coords 0 end-2]
5297 } else {
5298 set coords [list [xc $le $x] [yc $le]]
5300 if {$joinlow} {
5301 set itl [lindex $lines [expr {$i-1}] 2]
5302 set al [$canv itemcget $itl -arrow]
5303 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5304 } elseif {$arrowlow} {
5305 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5306 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5307 set arrowlow 0
5310 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5311 for {set y $le} {[incr y -1] > $row} {} {
5312 set x $xp
5313 set xp [lindex $cols [expr {$y - 1 - $row}]]
5314 set ndir [expr {$xp - $x}]
5315 if {$dir != $ndir || $xp < 0} {
5316 lappend coords [xc $y $x] [yc $y]
5318 set dir $ndir
5320 if {!$joinlow} {
5321 if {$xp < 0} {
5322 # join parent line to first child
5323 set ch [lindex $displayorder $row]
5324 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5325 if {$xc < 0} {
5326 puts "oops: drawlineseg: child $ch not on row $row"
5327 } elseif {$xc != $x} {
5328 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5329 set d [expr {int(0.5 * $linespc)}]
5330 set x1 [xc $row $x]
5331 if {$xc < $x} {
5332 set x2 [expr {$x1 - $d}]
5333 } else {
5334 set x2 [expr {$x1 + $d}]
5336 set y2 [yc $row]
5337 set y1 [expr {$y2 + $d}]
5338 lappend coords $x1 $y1 $x2 $y2
5339 } elseif {$xc < $x - 1} {
5340 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5341 } elseif {$xc > $x + 1} {
5342 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5344 set x $xc
5346 lappend coords [xc $row $x] [yc $row]
5347 } else {
5348 set xn [xc $row $xp]
5349 set yn [yc $row]
5350 lappend coords $xn $yn
5352 if {!$joinhigh} {
5353 assigncolor $id
5354 set t [$canv create line $coords -width [linewidth $id] \
5355 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5356 $canv lower $t
5357 bindline $t $id
5358 set lines [linsert $lines $i [list $row $le $t]]
5359 } else {
5360 $canv coords $ith $coords
5361 if {$arrow ne $ah} {
5362 $canv itemconf $ith -arrow $arrow
5364 lset lines $i 0 $row
5366 } else {
5367 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5368 set ndir [expr {$xo - $xp}]
5369 set clow [$canv coords $itl]
5370 if {$dir == $ndir} {
5371 set clow [lrange $clow 2 end]
5373 set coords [concat $coords $clow]
5374 if {!$joinhigh} {
5375 lset lines [expr {$i-1}] 1 $le
5376 } else {
5377 # coalesce two pieces
5378 $canv delete $ith
5379 set b [lindex $lines [expr {$i-1}] 0]
5380 set e [lindex $lines $i 1]
5381 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5383 $canv coords $itl $coords
5384 if {$arrow ne $al} {
5385 $canv itemconf $itl -arrow $arrow
5389 set linesegs($id) $lines
5390 return $le
5393 proc drawparentlinks {id row} {
5394 global rowidlist canv colormap curview parentlist
5395 global idpos linespc
5397 set rowids [lindex $rowidlist $row]
5398 set col [lsearch -exact $rowids $id]
5399 if {$col < 0} return
5400 set olds [lindex $parentlist $row]
5401 set row2 [expr {$row + 1}]
5402 set x [xc $row $col]
5403 set y [yc $row]
5404 set y2 [yc $row2]
5405 set d [expr {int(0.5 * $linespc)}]
5406 set ymid [expr {$y + $d}]
5407 set ids [lindex $rowidlist $row2]
5408 # rmx = right-most X coord used
5409 set rmx 0
5410 foreach p $olds {
5411 set i [lsearch -exact $ids $p]
5412 if {$i < 0} {
5413 puts "oops, parent $p of $id not in list"
5414 continue
5416 set x2 [xc $row2 $i]
5417 if {$x2 > $rmx} {
5418 set rmx $x2
5420 set j [lsearch -exact $rowids $p]
5421 if {$j < 0} {
5422 # drawlineseg will do this one for us
5423 continue
5425 assigncolor $p
5426 # should handle duplicated parents here...
5427 set coords [list $x $y]
5428 if {$i != $col} {
5429 # if attaching to a vertical segment, draw a smaller
5430 # slant for visual distinctness
5431 if {$i == $j} {
5432 if {$i < $col} {
5433 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5434 } else {
5435 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5437 } elseif {$i < $col && $i < $j} {
5438 # segment slants towards us already
5439 lappend coords [xc $row $j] $y
5440 } else {
5441 if {$i < $col - 1} {
5442 lappend coords [expr {$x2 + $linespc}] $y
5443 } elseif {$i > $col + 1} {
5444 lappend coords [expr {$x2 - $linespc}] $y
5446 lappend coords $x2 $y2
5448 } else {
5449 lappend coords $x2 $y2
5451 set t [$canv create line $coords -width [linewidth $p] \
5452 -fill $colormap($p) -tags lines.$p]
5453 $canv lower $t
5454 bindline $t $p
5456 if {$rmx > [lindex $idpos($id) 1]} {
5457 lset idpos($id) 1 $rmx
5458 redrawtags $id
5462 proc drawlines {id} {
5463 global canv
5465 $canv itemconf lines.$id -width [linewidth $id]
5468 proc drawcmittext {id row col} {
5469 global linespc canv canv2 canv3 fgcolor curview
5470 global cmitlisted commitinfo rowidlist parentlist
5471 global rowtextx idpos idtags idheads idotherrefs
5472 global linehtag linentag linedtag selectedline
5473 global canvxmax boldrows boldnamerows fgcolor
5474 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5476 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5477 set listed $cmitlisted($curview,$id)
5478 if {$id eq $nullid} {
5479 set ofill red
5480 } elseif {$id eq $nullid2} {
5481 set ofill green
5482 } elseif {$id eq $mainheadid} {
5483 set ofill yellow
5484 } else {
5485 set ofill [lindex $circlecolors $listed]
5487 set x [xc $row $col]
5488 set y [yc $row]
5489 set orad [expr {$linespc / 3}]
5490 if {$listed <= 2} {
5491 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5492 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5493 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5494 } elseif {$listed == 3} {
5495 # triangle pointing left for left-side commits
5496 set t [$canv create polygon \
5497 [expr {$x - $orad}] $y \
5498 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5499 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5500 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5501 } else {
5502 # triangle pointing right for right-side commits
5503 set t [$canv create polygon \
5504 [expr {$x + $orad - 1}] $y \
5505 [expr {$x - $orad}] [expr {$y - $orad}] \
5506 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5507 -fill $ofill -outline $fgcolor -width 1 -tags circle]
5509 set circleitem($row) $t
5510 $canv raise $t
5511 $canv bind $t <1> {selcanvline {} %x %y}
5512 set rmx [llength [lindex $rowidlist $row]]
5513 set olds [lindex $parentlist $row]
5514 if {$olds ne {}} {
5515 set nextids [lindex $rowidlist [expr {$row + 1}]]
5516 foreach p $olds {
5517 set i [lsearch -exact $nextids $p]
5518 if {$i > $rmx} {
5519 set rmx $i
5523 set xt [xc $row $rmx]
5524 set rowtextx($row) $xt
5525 set idpos($id) [list $x $xt $y]
5526 if {[info exists idtags($id)] || [info exists idheads($id)]
5527 || [info exists idotherrefs($id)]} {
5528 set xt [drawtags $id $x $xt $y]
5530 set headline [lindex $commitinfo($id) 0]
5531 set name [lindex $commitinfo($id) 1]
5532 set date [lindex $commitinfo($id) 2]
5533 set date [formatdate $date]
5534 set font mainfont
5535 set nfont mainfont
5536 set isbold [ishighlighted $id]
5537 if {$isbold > 0} {
5538 lappend boldrows $row
5539 set font mainfontbold
5540 if {$isbold > 1} {
5541 lappend boldnamerows $row
5542 set nfont mainfontbold
5545 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
5546 -text $headline -font $font -tags text]
5547 $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
5548 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5549 -text $name -font $nfont -tags text]
5550 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5551 -text $date -font mainfont -tags text]
5552 if {$selectedline == $row} {
5553 make_secsel $row
5555 set xr [expr {$xt + [font measure $font $headline]}]
5556 if {$xr > $canvxmax} {
5557 set canvxmax $xr
5558 setcanvscroll
5562 proc drawcmitrow {row} {
5563 global displayorder rowidlist nrows_drawn
5564 global iddrawn markingmatches
5565 global commitinfo numcommits
5566 global filehighlight fhighlights findpattern nhighlights
5567 global hlview vhighlights
5568 global highlight_related rhighlights
5570 if {$row >= $numcommits} return
5572 set id [lindex $displayorder $row]
5573 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5574 askvhighlight $row $id
5576 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5577 askfilehighlight $row $id
5579 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5580 askfindhighlight $row $id
5582 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5583 askrelhighlight $row $id
5585 if {![info exists iddrawn($id)]} {
5586 set col [lsearch -exact [lindex $rowidlist $row] $id]
5587 if {$col < 0} {
5588 puts "oops, row $row id $id not in list"
5589 return
5591 if {![info exists commitinfo($id)]} {
5592 getcommit $id
5594 assigncolor $id
5595 drawcmittext $id $row $col
5596 set iddrawn($id) 1
5597 incr nrows_drawn
5599 if {$markingmatches} {
5600 markrowmatches $row $id
5604 proc drawcommits {row {endrow {}}} {
5605 global numcommits iddrawn displayorder curview need_redisplay
5606 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5608 if {$row < 0} {
5609 set row 0
5611 if {$endrow eq {}} {
5612 set endrow $row
5614 if {$endrow >= $numcommits} {
5615 set endrow [expr {$numcommits - 1}]
5618 set rl1 [expr {$row - $downarrowlen - 3}]
5619 if {$rl1 < 0} {
5620 set rl1 0
5622 set ro1 [expr {$row - 3}]
5623 if {$ro1 < 0} {
5624 set ro1 0
5626 set r2 [expr {$endrow + $uparrowlen + 3}]
5627 if {$r2 > $numcommits} {
5628 set r2 $numcommits
5630 for {set r $rl1} {$r < $r2} {incr r} {
5631 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5632 if {$rl1 < $r} {
5633 layoutrows $rl1 $r
5635 set rl1 [expr {$r + 1}]
5638 if {$rl1 < $r} {
5639 layoutrows $rl1 $r
5641 optimize_rows $ro1 0 $r2
5642 if {$need_redisplay || $nrows_drawn > 2000} {
5643 clear_display
5644 drawvisible
5647 # make the lines join to already-drawn rows either side
5648 set r [expr {$row - 1}]
5649 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5650 set r $row
5652 set er [expr {$endrow + 1}]
5653 if {$er >= $numcommits ||
5654 ![info exists iddrawn([lindex $displayorder $er])]} {
5655 set er $endrow
5657 for {} {$r <= $er} {incr r} {
5658 set id [lindex $displayorder $r]
5659 set wasdrawn [info exists iddrawn($id)]
5660 drawcmitrow $r
5661 if {$r == $er} break
5662 set nextid [lindex $displayorder [expr {$r + 1}]]
5663 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5664 drawparentlinks $id $r
5666 set rowids [lindex $rowidlist $r]
5667 foreach lid $rowids {
5668 if {$lid eq {}} continue
5669 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5670 if {$lid eq $id} {
5671 # see if this is the first child of any of its parents
5672 foreach p [lindex $parentlist $r] {
5673 if {[lsearch -exact $rowids $p] < 0} {
5674 # make this line extend up to the child
5675 set lineend($p) [drawlineseg $p $r $er 0]
5678 } else {
5679 set lineend($lid) [drawlineseg $lid $r $er 1]
5685 proc undolayout {row} {
5686 global uparrowlen mingaplen downarrowlen
5687 global rowidlist rowisopt rowfinal need_redisplay
5689 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5690 if {$r < 0} {
5691 set r 0
5693 if {[llength $rowidlist] > $r} {
5694 incr r -1
5695 set rowidlist [lrange $rowidlist 0 $r]
5696 set rowfinal [lrange $rowfinal 0 $r]
5697 set rowisopt [lrange $rowisopt 0 $r]
5698 set need_redisplay 1
5699 run drawvisible
5703 proc drawvisible {} {
5704 global canv linespc curview vrowmod selectedline targetrow targetid
5705 global need_redisplay cscroll numcommits
5707 set fs [$canv yview]
5708 set ymax [lindex [$canv cget -scrollregion] 3]
5709 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5710 set f0 [lindex $fs 0]
5711 set f1 [lindex $fs 1]
5712 set y0 [expr {int($f0 * $ymax)}]
5713 set y1 [expr {int($f1 * $ymax)}]
5715 if {[info exists targetid]} {
5716 if {[commitinview $targetid $curview]} {
5717 set r [rowofcommit $targetid]
5718 if {$r != $targetrow} {
5719 # Fix up the scrollregion and change the scrolling position
5720 # now that our target row has moved.
5721 set diff [expr {($r - $targetrow) * $linespc}]
5722 set targetrow $r
5723 setcanvscroll
5724 set ymax [lindex [$canv cget -scrollregion] 3]
5725 incr y0 $diff
5726 incr y1 $diff
5727 set f0 [expr {$y0 / $ymax}]
5728 set f1 [expr {$y1 / $ymax}]
5729 allcanvs yview moveto $f0
5730 $cscroll set $f0 $f1
5731 set need_redisplay 1
5733 } else {
5734 unset targetid
5738 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5739 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5740 if {$endrow >= $vrowmod($curview)} {
5741 update_arcrows $curview
5743 if {$selectedline ne {} &&
5744 $row <= $selectedline && $selectedline <= $endrow} {
5745 set targetrow $selectedline
5746 } elseif {[info exists targetid]} {
5747 set targetrow [expr {int(($row + $endrow) / 2)}]
5749 if {[info exists targetrow]} {
5750 if {$targetrow >= $numcommits} {
5751 set targetrow [expr {$numcommits - 1}]
5753 set targetid [commitonrow $targetrow]
5755 drawcommits $row $endrow
5758 proc clear_display {} {
5759 global iddrawn linesegs need_redisplay nrows_drawn
5760 global vhighlights fhighlights nhighlights rhighlights
5761 global linehtag linentag linedtag boldrows boldnamerows
5763 allcanvs delete all
5764 catch {unset iddrawn}
5765 catch {unset linesegs}
5766 catch {unset linehtag}
5767 catch {unset linentag}
5768 catch {unset linedtag}
5769 set boldrows {}
5770 set boldnamerows {}
5771 catch {unset vhighlights}
5772 catch {unset fhighlights}
5773 catch {unset nhighlights}
5774 catch {unset rhighlights}
5775 set need_redisplay 0
5776 set nrows_drawn 0
5779 proc findcrossings {id} {
5780 global rowidlist parentlist numcommits displayorder
5782 set cross {}
5783 set ccross {}
5784 foreach {s e} [rowranges $id] {
5785 if {$e >= $numcommits} {
5786 set e [expr {$numcommits - 1}]
5788 if {$e <= $s} continue
5789 for {set row $e} {[incr row -1] >= $s} {} {
5790 set x [lsearch -exact [lindex $rowidlist $row] $id]
5791 if {$x < 0} break
5792 set olds [lindex $parentlist $row]
5793 set kid [lindex $displayorder $row]
5794 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5795 if {$kidx < 0} continue
5796 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5797 foreach p $olds {
5798 set px [lsearch -exact $nextrow $p]
5799 if {$px < 0} continue
5800 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5801 if {[lsearch -exact $ccross $p] >= 0} continue
5802 if {$x == $px + ($kidx < $px? -1: 1)} {
5803 lappend ccross $p
5804 } elseif {[lsearch -exact $cross $p] < 0} {
5805 lappend cross $p
5811 return [concat $ccross {{}} $cross]
5814 proc assigncolor {id} {
5815 global colormap colors nextcolor
5816 global parents children children curview
5818 if {[info exists colormap($id)]} return
5819 set ncolors [llength $colors]
5820 if {[info exists children($curview,$id)]} {
5821 set kids $children($curview,$id)
5822 } else {
5823 set kids {}
5825 if {[llength $kids] == 1} {
5826 set child [lindex $kids 0]
5827 if {[info exists colormap($child)]
5828 && [llength $parents($curview,$child)] == 1} {
5829 set colormap($id) $colormap($child)
5830 return
5833 set badcolors {}
5834 set origbad {}
5835 foreach x [findcrossings $id] {
5836 if {$x eq {}} {
5837 # delimiter between corner crossings and other crossings
5838 if {[llength $badcolors] >= $ncolors - 1} break
5839 set origbad $badcolors
5841 if {[info exists colormap($x)]
5842 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5843 lappend badcolors $colormap($x)
5846 if {[llength $badcolors] >= $ncolors} {
5847 set badcolors $origbad
5849 set origbad $badcolors
5850 if {[llength $badcolors] < $ncolors - 1} {
5851 foreach child $kids {
5852 if {[info exists colormap($child)]
5853 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5854 lappend badcolors $colormap($child)
5856 foreach p $parents($curview,$child) {
5857 if {[info exists colormap($p)]
5858 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5859 lappend badcolors $colormap($p)
5863 if {[llength $badcolors] >= $ncolors} {
5864 set badcolors $origbad
5867 for {set i 0} {$i <= $ncolors} {incr i} {
5868 set c [lindex $colors $nextcolor]
5869 if {[incr nextcolor] >= $ncolors} {
5870 set nextcolor 0
5872 if {[lsearch -exact $badcolors $c]} break
5874 set colormap($id) $c
5877 proc bindline {t id} {
5878 global canv
5880 $canv bind $t <Enter> "lineenter %x %y $id"
5881 $canv bind $t <Motion> "linemotion %x %y $id"
5882 $canv bind $t <Leave> "lineleave $id"
5883 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5886 proc drawtags {id x xt y1} {
5887 global idtags idheads idotherrefs mainhead
5888 global linespc lthickness
5889 global canv rowtextx curview fgcolor bgcolor ctxbut
5891 set marks {}
5892 set ntags 0
5893 set nheads 0
5894 if {[info exists idtags($id)]} {
5895 set marks $idtags($id)
5896 set ntags [llength $marks]
5898 if {[info exists idheads($id)]} {
5899 set marks [concat $marks $idheads($id)]
5900 set nheads [llength $idheads($id)]
5902 if {[info exists idotherrefs($id)]} {
5903 set marks [concat $marks $idotherrefs($id)]
5905 if {$marks eq {}} {
5906 return $xt
5909 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5910 set yt [expr {$y1 - 0.5 * $linespc}]
5911 set yb [expr {$yt + $linespc - 1}]
5912 set xvals {}
5913 set wvals {}
5914 set i -1
5915 foreach tag $marks {
5916 incr i
5917 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5918 set wid [font measure mainfontbold $tag]
5919 } else {
5920 set wid [font measure mainfont $tag]
5922 lappend xvals $xt
5923 lappend wvals $wid
5924 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5926 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5927 -width $lthickness -fill black -tags tag.$id]
5928 $canv lower $t
5929 foreach tag $marks x $xvals wid $wvals {
5930 set xl [expr {$x + $delta}]
5931 set xr [expr {$x + $delta + $wid + $lthickness}]
5932 set font mainfont
5933 if {[incr ntags -1] >= 0} {
5934 # draw a tag
5935 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5936 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5937 -width 1 -outline black -fill yellow -tags tag.$id]
5938 $canv bind $t <1> [list showtag $tag 1]
5939 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5940 } else {
5941 # draw a head or other ref
5942 if {[incr nheads -1] >= 0} {
5943 set col green
5944 if {$tag eq $mainhead} {
5945 set font mainfontbold
5947 } else {
5948 set col "#ddddff"
5950 set xl [expr {$xl - $delta/2}]
5951 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5952 -width 1 -outline black -fill $col -tags tag.$id
5953 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5954 set rwid [font measure mainfont $remoteprefix]
5955 set xi [expr {$x + 1}]
5956 set yti [expr {$yt + 1}]
5957 set xri [expr {$x + $rwid}]
5958 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5959 -width 0 -fill "#ffddaa" -tags tag.$id
5962 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5963 -font $font -tags [list tag.$id text]]
5964 if {$ntags >= 0} {
5965 $canv bind $t <1> [list showtag $tag 1]
5966 } elseif {$nheads >= 0} {
5967 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5970 return $xt
5973 proc xcoord {i level ln} {
5974 global canvx0 xspc1 xspc2
5976 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5977 if {$i > 0 && $i == $level} {
5978 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5979 } elseif {$i > $level} {
5980 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5982 return $x
5985 proc show_status {msg} {
5986 global canv fgcolor
5988 clear_display
5989 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5990 -tags text -fill $fgcolor
5993 # Don't change the text pane cursor if it is currently the hand cursor,
5994 # showing that we are over a sha1 ID link.
5995 proc settextcursor {c} {
5996 global ctext curtextcursor
5998 if {[$ctext cget -cursor] == $curtextcursor} {
5999 $ctext config -cursor $c
6001 set curtextcursor $c
6004 proc nowbusy {what {name {}}} {
6005 global isbusy busyname statusw
6007 if {[array names isbusy] eq {}} {
6008 . config -cursor watch
6009 settextcursor watch
6011 set isbusy($what) 1
6012 set busyname($what) $name
6013 if {$name ne {}} {
6014 $statusw conf -text $name
6018 proc notbusy {what} {
6019 global isbusy maincursor textcursor busyname statusw
6021 catch {
6022 unset isbusy($what)
6023 if {$busyname($what) ne {} &&
6024 [$statusw cget -text] eq $busyname($what)} {
6025 $statusw conf -text {}
6028 if {[array names isbusy] eq {}} {
6029 . config -cursor $maincursor
6030 settextcursor $textcursor
6034 proc findmatches {f} {
6035 global findtype findstring
6036 if {$findtype == [mc "Regexp"]} {
6037 set matches [regexp -indices -all -inline $findstring $f]
6038 } else {
6039 set fs $findstring
6040 if {$findtype == [mc "IgnCase"]} {
6041 set f [string tolower $f]
6042 set fs [string tolower $fs]
6044 set matches {}
6045 set i 0
6046 set l [string length $fs]
6047 while {[set j [string first $fs $f $i]] >= 0} {
6048 lappend matches [list $j [expr {$j+$l-1}]]
6049 set i [expr {$j + $l}]
6052 return $matches
6055 proc dofind {{dirn 1} {wrap 1}} {
6056 global findstring findstartline findcurline selectedline numcommits
6057 global gdttype filehighlight fh_serial find_dirn findallowwrap
6059 if {[info exists find_dirn]} {
6060 if {$find_dirn == $dirn} return
6061 stopfinding
6063 focus .
6064 if {$findstring eq {} || $numcommits == 0} return
6065 if {$selectedline eq {}} {
6066 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6067 } else {
6068 set findstartline $selectedline
6070 set findcurline $findstartline
6071 nowbusy finding [mc "Searching"]
6072 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6073 after cancel do_file_hl $fh_serial
6074 do_file_hl $fh_serial
6076 set find_dirn $dirn
6077 set findallowwrap $wrap
6078 run findmore
6081 proc stopfinding {} {
6082 global find_dirn findcurline fprogcoord
6084 if {[info exists find_dirn]} {
6085 unset find_dirn
6086 unset findcurline
6087 notbusy finding
6088 set fprogcoord 0
6089 adjustprogress
6091 stopblaming
6094 proc findmore {} {
6095 global commitdata commitinfo numcommits findpattern findloc
6096 global findstartline findcurline findallowwrap
6097 global find_dirn gdttype fhighlights fprogcoord
6098 global curview varcorder vrownum varccommits vrowmod
6100 if {![info exists find_dirn]} {
6101 return 0
6103 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6104 set l $findcurline
6105 set moretodo 0
6106 if {$find_dirn > 0} {
6107 incr l
6108 if {$l >= $numcommits} {
6109 set l 0
6111 if {$l <= $findstartline} {
6112 set lim [expr {$findstartline + 1}]
6113 } else {
6114 set lim $numcommits
6115 set moretodo $findallowwrap
6117 } else {
6118 if {$l == 0} {
6119 set l $numcommits
6121 incr l -1
6122 if {$l >= $findstartline} {
6123 set lim [expr {$findstartline - 1}]
6124 } else {
6125 set lim -1
6126 set moretodo $findallowwrap
6129 set n [expr {($lim - $l) * $find_dirn}]
6130 if {$n > 500} {
6131 set n 500
6132 set moretodo 1
6134 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6135 update_arcrows $curview
6137 set found 0
6138 set domore 1
6139 set ai [bsearch $vrownum($curview) $l]
6140 set a [lindex $varcorder($curview) $ai]
6141 set arow [lindex $vrownum($curview) $ai]
6142 set ids [lindex $varccommits($curview,$a)]
6143 set arowend [expr {$arow + [llength $ids]}]
6144 if {$gdttype eq [mc "containing:"]} {
6145 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6146 if {$l < $arow || $l >= $arowend} {
6147 incr ai $find_dirn
6148 set a [lindex $varcorder($curview) $ai]
6149 set arow [lindex $vrownum($curview) $ai]
6150 set ids [lindex $varccommits($curview,$a)]
6151 set arowend [expr {$arow + [llength $ids]}]
6153 set id [lindex $ids [expr {$l - $arow}]]
6154 # shouldn't happen unless git log doesn't give all the commits...
6155 if {![info exists commitdata($id)] ||
6156 ![doesmatch $commitdata($id)]} {
6157 continue
6159 if {![info exists commitinfo($id)]} {
6160 getcommit $id
6162 set info $commitinfo($id)
6163 foreach f $info ty $fldtypes {
6164 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6165 [doesmatch $f]} {
6166 set found 1
6167 break
6170 if {$found} break
6172 } else {
6173 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6174 if {$l < $arow || $l >= $arowend} {
6175 incr ai $find_dirn
6176 set a [lindex $varcorder($curview) $ai]
6177 set arow [lindex $vrownum($curview) $ai]
6178 set ids [lindex $varccommits($curview,$a)]
6179 set arowend [expr {$arow + [llength $ids]}]
6181 set id [lindex $ids [expr {$l - $arow}]]
6182 if {![info exists fhighlights($id)]} {
6183 # this sets fhighlights($id) to -1
6184 askfilehighlight $l $id
6186 if {$fhighlights($id) > 0} {
6187 set found $domore
6188 break
6190 if {$fhighlights($id) < 0} {
6191 if {$domore} {
6192 set domore 0
6193 set findcurline [expr {$l - $find_dirn}]
6198 if {$found || ($domore && !$moretodo)} {
6199 unset findcurline
6200 unset find_dirn
6201 notbusy finding
6202 set fprogcoord 0
6203 adjustprogress
6204 if {$found} {
6205 findselectline $l
6206 } else {
6207 bell
6209 return 0
6211 if {!$domore} {
6212 flushhighlights
6213 } else {
6214 set findcurline [expr {$l - $find_dirn}]
6216 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6217 if {$n < 0} {
6218 incr n $numcommits
6220 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6221 adjustprogress
6222 return $domore
6225 proc findselectline {l} {
6226 global findloc commentend ctext findcurline markingmatches gdttype
6228 set markingmatches 1
6229 set findcurline $l
6230 selectline $l 1
6231 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
6232 # highlight the matches in the comments
6233 set f [$ctext get 1.0 $commentend]
6234 set matches [findmatches $f]
6235 foreach match $matches {
6236 set start [lindex $match 0]
6237 set end [expr {[lindex $match 1] + 1}]
6238 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6241 drawvisible
6244 # mark the bits of a headline or author that match a find string
6245 proc markmatches {canv l str tag matches font row} {
6246 global selectedline
6248 set bbox [$canv bbox $tag]
6249 set x0 [lindex $bbox 0]
6250 set y0 [lindex $bbox 1]
6251 set y1 [lindex $bbox 3]
6252 foreach match $matches {
6253 set start [lindex $match 0]
6254 set end [lindex $match 1]
6255 if {$start > $end} continue
6256 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6257 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6258 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6259 [expr {$x0+$xlen+2}] $y1 \
6260 -outline {} -tags [list match$l matches] -fill yellow]
6261 $canv lower $t
6262 if {$row == $selectedline} {
6263 $canv raise $t secsel
6268 proc unmarkmatches {} {
6269 global markingmatches
6271 allcanvs delete matches
6272 set markingmatches 0
6273 stopfinding
6276 proc selcanvline {w x y} {
6277 global canv canvy0 ctext linespc
6278 global rowtextx
6279 set ymax [lindex [$canv cget -scrollregion] 3]
6280 if {$ymax == {}} return
6281 set yfrac [lindex [$canv yview] 0]
6282 set y [expr {$y + $yfrac * $ymax}]
6283 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6284 if {$l < 0} {
6285 set l 0
6287 if {$w eq $canv} {
6288 set xmax [lindex [$canv cget -scrollregion] 2]
6289 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6290 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6292 unmarkmatches
6293 selectline $l 1
6296 proc commit_descriptor {p} {
6297 global commitinfo
6298 if {![info exists commitinfo($p)]} {
6299 getcommit $p
6301 set l "..."
6302 if {[llength $commitinfo($p)] > 1} {
6303 set l [lindex $commitinfo($p) 0]
6305 return "$p ($l)\n"
6308 # append some text to the ctext widget, and make any SHA1 ID
6309 # that we know about be a clickable link.
6310 proc appendwithlinks {text tags} {
6311 global ctext linknum curview
6313 set start [$ctext index "end - 1c"]
6314 $ctext insert end $text $tags
6315 set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6316 foreach l $links {
6317 set s [lindex $l 0]
6318 set e [lindex $l 1]
6319 set linkid [string range $text $s $e]
6320 incr e
6321 $ctext tag delete link$linknum
6322 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6323 setlink $linkid link$linknum
6324 incr linknum
6328 proc setlink {id lk} {
6329 global curview ctext pendinglinks
6331 set known 0
6332 if {[string length $id] < 40} {
6333 set matches [longid $id]
6334 if {[llength $matches] > 0} {
6335 if {[llength $matches] > 1} return
6336 set known 1
6337 set id [lindex $matches 0]
6339 } else {
6340 set known [commitinview $id $curview]
6342 if {$known} {
6343 $ctext tag conf $lk -foreground blue -underline 1
6344 $ctext tag bind $lk <1> [list selbyid $id]
6345 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6346 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6347 } else {
6348 lappend pendinglinks($id) $lk
6349 interestedin $id {makelink %P}
6353 proc makelink {id} {
6354 global pendinglinks
6356 if {![info exists pendinglinks($id)]} return
6357 foreach lk $pendinglinks($id) {
6358 setlink $id $lk
6360 unset pendinglinks($id)
6363 proc linkcursor {w inc} {
6364 global linkentercount curtextcursor
6366 if {[incr linkentercount $inc] > 0} {
6367 $w configure -cursor hand2
6368 } else {
6369 $w configure -cursor $curtextcursor
6370 if {$linkentercount < 0} {
6371 set linkentercount 0
6376 proc viewnextline {dir} {
6377 global canv linespc
6379 $canv delete hover
6380 set ymax [lindex [$canv cget -scrollregion] 3]
6381 set wnow [$canv yview]
6382 set wtop [expr {[lindex $wnow 0] * $ymax}]
6383 set newtop [expr {$wtop + $dir * $linespc}]
6384 if {$newtop < 0} {
6385 set newtop 0
6386 } elseif {$newtop > $ymax} {
6387 set newtop $ymax
6389 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6392 # add a list of tag or branch names at position pos
6393 # returns the number of names inserted
6394 proc appendrefs {pos ids var} {
6395 global ctext linknum curview $var maxrefs
6397 if {[catch {$ctext index $pos}]} {
6398 return 0
6400 $ctext conf -state normal
6401 $ctext delete $pos "$pos lineend"
6402 set tags {}
6403 foreach id $ids {
6404 foreach tag [set $var\($id\)] {
6405 lappend tags [list $tag $id]
6408 if {[llength $tags] > $maxrefs} {
6409 $ctext insert $pos "many ([llength $tags])"
6410 } else {
6411 set tags [lsort -index 0 -decreasing $tags]
6412 set sep {}
6413 foreach ti $tags {
6414 set id [lindex $ti 1]
6415 set lk link$linknum
6416 incr linknum
6417 $ctext tag delete $lk
6418 $ctext insert $pos $sep
6419 $ctext insert $pos [lindex $ti 0] $lk
6420 setlink $id $lk
6421 set sep ", "
6424 $ctext conf -state disabled
6425 return [llength $tags]
6428 # called when we have finished computing the nearby tags
6429 proc dispneartags {delay} {
6430 global selectedline currentid showneartags tagphase
6432 if {$selectedline eq {} || !$showneartags} return
6433 after cancel dispnexttag
6434 if {$delay} {
6435 after 200 dispnexttag
6436 set tagphase -1
6437 } else {
6438 after idle dispnexttag
6439 set tagphase 0
6443 proc dispnexttag {} {
6444 global selectedline currentid showneartags tagphase ctext
6446 if {$selectedline eq {} || !$showneartags} return
6447 switch -- $tagphase {
6449 set dtags [desctags $currentid]
6450 if {$dtags ne {}} {
6451 appendrefs precedes $dtags idtags
6455 set atags [anctags $currentid]
6456 if {$atags ne {}} {
6457 appendrefs follows $atags idtags
6461 set dheads [descheads $currentid]
6462 if {$dheads ne {}} {
6463 if {[appendrefs branch $dheads idheads] > 1
6464 && [$ctext get "branch -3c"] eq "h"} {
6465 # turn "Branch" into "Branches"
6466 $ctext conf -state normal
6467 $ctext insert "branch -2c" "es"
6468 $ctext conf -state disabled
6473 if {[incr tagphase] <= 2} {
6474 after idle dispnexttag
6478 proc make_secsel {l} {
6479 global linehtag linentag linedtag canv canv2 canv3
6481 if {![info exists linehtag($l)]} return
6482 $canv delete secsel
6483 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
6484 -tags secsel -fill [$canv cget -selectbackground]]
6485 $canv lower $t
6486 $canv2 delete secsel
6487 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
6488 -tags secsel -fill [$canv2 cget -selectbackground]]
6489 $canv2 lower $t
6490 $canv3 delete secsel
6491 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
6492 -tags secsel -fill [$canv3 cget -selectbackground]]
6493 $canv3 lower $t
6496 proc selectline {l isnew {desired_loc {}}} {
6497 global canv ctext commitinfo selectedline
6498 global canvy0 linespc parents children curview
6499 global currentid sha1entry
6500 global commentend idtags linknum
6501 global mergemax numcommits pending_select
6502 global cmitmode showneartags allcommits
6503 global targetrow targetid lastscrollrows
6504 global autoselect jump_to_here
6506 catch {unset pending_select}
6507 $canv delete hover
6508 normalline
6509 unsel_reflist
6510 stopfinding
6511 if {$l < 0 || $l >= $numcommits} return
6512 set id [commitonrow $l]
6513 set targetid $id
6514 set targetrow $l
6515 set selectedline $l
6516 set currentid $id
6517 if {$lastscrollrows < $numcommits} {
6518 setcanvscroll
6521 set y [expr {$canvy0 + $l * $linespc}]
6522 set ymax [lindex [$canv cget -scrollregion] 3]
6523 set ytop [expr {$y - $linespc - 1}]
6524 set ybot [expr {$y + $linespc + 1}]
6525 set wnow [$canv yview]
6526 set wtop [expr {[lindex $wnow 0] * $ymax}]
6527 set wbot [expr {[lindex $wnow 1] * $ymax}]
6528 set wh [expr {$wbot - $wtop}]
6529 set newtop $wtop
6530 if {$ytop < $wtop} {
6531 if {$ybot < $wtop} {
6532 set newtop [expr {$y - $wh / 2.0}]
6533 } else {
6534 set newtop $ytop
6535 if {$newtop > $wtop - $linespc} {
6536 set newtop [expr {$wtop - $linespc}]
6539 } elseif {$ybot > $wbot} {
6540 if {$ytop > $wbot} {
6541 set newtop [expr {$y - $wh / 2.0}]
6542 } else {
6543 set newtop [expr {$ybot - $wh}]
6544 if {$newtop < $wtop + $linespc} {
6545 set newtop [expr {$wtop + $linespc}]
6549 if {$newtop != $wtop} {
6550 if {$newtop < 0} {
6551 set newtop 0
6553 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6554 drawvisible
6557 make_secsel $l
6559 if {$isnew} {
6560 addtohistory [list selbyid $id]
6563 $sha1entry delete 0 end
6564 $sha1entry insert 0 $id
6565 if {$autoselect} {
6566 $sha1entry selection from 0
6567 $sha1entry selection to end
6569 rhighlight_sel $id
6571 $ctext conf -state normal
6572 clear_ctext
6573 set linknum 0
6574 if {![info exists commitinfo($id)]} {
6575 getcommit $id
6577 set info $commitinfo($id)
6578 set date [formatdate [lindex $info 2]]
6579 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6580 set date [formatdate [lindex $info 4]]
6581 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6582 if {[info exists idtags($id)]} {
6583 $ctext insert end [mc "Tags:"]
6584 foreach tag $idtags($id) {
6585 $ctext insert end " $tag"
6587 $ctext insert end "\n"
6590 set headers {}
6591 set olds $parents($curview,$id)
6592 if {[llength $olds] > 1} {
6593 set np 0
6594 foreach p $olds {
6595 if {$np >= $mergemax} {
6596 set tag mmax
6597 } else {
6598 set tag m$np
6600 $ctext insert end "[mc "Parent"]: " $tag
6601 appendwithlinks [commit_descriptor $p] {}
6602 incr np
6604 } else {
6605 foreach p $olds {
6606 append headers "[mc "Parent"]: [commit_descriptor $p]"
6610 foreach c $children($curview,$id) {
6611 append headers "[mc "Child"]: [commit_descriptor $c]"
6614 # make anything that looks like a SHA1 ID be a clickable link
6615 appendwithlinks $headers {}
6616 if {$showneartags} {
6617 if {![info exists allcommits]} {
6618 getallcommits
6620 $ctext insert end "[mc "Branch"]: "
6621 $ctext mark set branch "end -1c"
6622 $ctext mark gravity branch left
6623 $ctext insert end "\n[mc "Follows"]: "
6624 $ctext mark set follows "end -1c"
6625 $ctext mark gravity follows left
6626 $ctext insert end "\n[mc "Precedes"]: "
6627 $ctext mark set precedes "end -1c"
6628 $ctext mark gravity precedes left
6629 $ctext insert end "\n"
6630 dispneartags 1
6632 $ctext insert end "\n"
6633 set comment [lindex $info 5]
6634 if {[string first "\r" $comment] >= 0} {
6635 set comment [string map {"\r" "\n "} $comment]
6637 appendwithlinks $comment {comment}
6639 $ctext tag remove found 1.0 end
6640 $ctext conf -state disabled
6641 set commentend [$ctext index "end - 1c"]
6643 set jump_to_here $desired_loc
6644 init_flist [mc "Comments"]
6645 if {$cmitmode eq "tree"} {
6646 gettree $id
6647 } elseif {[llength $olds] <= 1} {
6648 startdiff $id
6649 } else {
6650 mergediff $id
6654 proc selfirstline {} {
6655 unmarkmatches
6656 selectline 0 1
6659 proc sellastline {} {
6660 global numcommits
6661 unmarkmatches
6662 set l [expr {$numcommits - 1}]
6663 selectline $l 1
6666 proc selnextline {dir} {
6667 global selectedline
6668 focus .
6669 if {$selectedline eq {}} return
6670 set l [expr {$selectedline + $dir}]
6671 unmarkmatches
6672 selectline $l 1
6675 proc selnextpage {dir} {
6676 global canv linespc selectedline numcommits
6678 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6679 if {$lpp < 1} {
6680 set lpp 1
6682 allcanvs yview scroll [expr {$dir * $lpp}] units
6683 drawvisible
6684 if {$selectedline eq {}} return
6685 set l [expr {$selectedline + $dir * $lpp}]
6686 if {$l < 0} {
6687 set l 0
6688 } elseif {$l >= $numcommits} {
6689 set l [expr $numcommits - 1]
6691 unmarkmatches
6692 selectline $l 1
6695 proc unselectline {} {
6696 global selectedline currentid
6698 set selectedline {}
6699 catch {unset currentid}
6700 allcanvs delete secsel
6701 rhighlight_none
6704 proc reselectline {} {
6705 global selectedline
6707 if {$selectedline ne {}} {
6708 selectline $selectedline 0
6712 proc addtohistory {cmd} {
6713 global history historyindex curview
6715 set elt [list $curview $cmd]
6716 if {$historyindex > 0
6717 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6718 return
6721 if {$historyindex < [llength $history]} {
6722 set history [lreplace $history $historyindex end $elt]
6723 } else {
6724 lappend history $elt
6726 incr historyindex
6727 if {$historyindex > 1} {
6728 .tf.bar.leftbut conf -state normal
6729 } else {
6730 .tf.bar.leftbut conf -state disabled
6732 .tf.bar.rightbut conf -state disabled
6735 proc godo {elt} {
6736 global curview
6738 set view [lindex $elt 0]
6739 set cmd [lindex $elt 1]
6740 if {$curview != $view} {
6741 showview $view
6743 eval $cmd
6746 proc goback {} {
6747 global history historyindex
6748 focus .
6750 if {$historyindex > 1} {
6751 incr historyindex -1
6752 godo [lindex $history [expr {$historyindex - 1}]]
6753 .tf.bar.rightbut conf -state normal
6755 if {$historyindex <= 1} {
6756 .tf.bar.leftbut conf -state disabled
6760 proc goforw {} {
6761 global history historyindex
6762 focus .
6764 if {$historyindex < [llength $history]} {
6765 set cmd [lindex $history $historyindex]
6766 incr historyindex
6767 godo $cmd
6768 .tf.bar.leftbut conf -state normal
6770 if {$historyindex >= [llength $history]} {
6771 .tf.bar.rightbut conf -state disabled
6775 proc gettree {id} {
6776 global treefilelist treeidlist diffids diffmergeid treepending
6777 global nullid nullid2
6779 set diffids $id
6780 catch {unset diffmergeid}
6781 if {![info exists treefilelist($id)]} {
6782 if {![info exists treepending]} {
6783 if {$id eq $nullid} {
6784 set cmd [list | git ls-files]
6785 } elseif {$id eq $nullid2} {
6786 set cmd [list | git ls-files --stage -t]
6787 } else {
6788 set cmd [list | git ls-tree -r $id]
6790 if {[catch {set gtf [open $cmd r]}]} {
6791 return
6793 set treepending $id
6794 set treefilelist($id) {}
6795 set treeidlist($id) {}
6796 fconfigure $gtf -blocking 0 -encoding binary
6797 filerun $gtf [list gettreeline $gtf $id]
6799 } else {
6800 setfilelist $id
6804 proc gettreeline {gtf id} {
6805 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6807 set nl 0
6808 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6809 if {$diffids eq $nullid} {
6810 set fname $line
6811 } else {
6812 set i [string first "\t" $line]
6813 if {$i < 0} continue
6814 set fname [string range $line [expr {$i+1}] end]
6815 set line [string range $line 0 [expr {$i-1}]]
6816 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6817 set sha1 [lindex $line 2]
6818 lappend treeidlist($id) $sha1
6820 if {[string index $fname 0] eq "\""} {
6821 set fname [lindex $fname 0]
6823 set fname [encoding convertfrom $fname]
6824 lappend treefilelist($id) $fname
6826 if {![eof $gtf]} {
6827 return [expr {$nl >= 1000? 2: 1}]
6829 close $gtf
6830 unset treepending
6831 if {$cmitmode ne "tree"} {
6832 if {![info exists diffmergeid]} {
6833 gettreediffs $diffids
6835 } elseif {$id ne $diffids} {
6836 gettree $diffids
6837 } else {
6838 setfilelist $id
6840 return 0
6843 proc showfile {f} {
6844 global treefilelist treeidlist diffids nullid nullid2
6845 global ctext_file_names ctext_file_lines
6846 global ctext commentend
6848 set i [lsearch -exact $treefilelist($diffids) $f]
6849 if {$i < 0} {
6850 puts "oops, $f not in list for id $diffids"
6851 return
6853 if {$diffids eq $nullid} {
6854 if {[catch {set bf [open $f r]} err]} {
6855 puts "oops, can't read $f: $err"
6856 return
6858 } else {
6859 set blob [lindex $treeidlist($diffids) $i]
6860 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6861 puts "oops, error reading blob $blob: $err"
6862 return
6865 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6866 filerun $bf [list getblobline $bf $diffids]
6867 $ctext config -state normal
6868 clear_ctext $commentend
6869 lappend ctext_file_names $f
6870 lappend ctext_file_lines [lindex [split $commentend "."] 0]
6871 $ctext insert end "\n"
6872 $ctext insert end "$f\n" filesep
6873 $ctext config -state disabled
6874 $ctext yview $commentend
6875 settabs 0
6878 proc getblobline {bf id} {
6879 global diffids cmitmode ctext
6881 if {$id ne $diffids || $cmitmode ne "tree"} {
6882 catch {close $bf}
6883 return 0
6885 $ctext config -state normal
6886 set nl 0
6887 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6888 $ctext insert end "$line\n"
6890 if {[eof $bf]} {
6891 global jump_to_here ctext_file_names commentend
6893 # delete last newline
6894 $ctext delete "end - 2c" "end - 1c"
6895 close $bf
6896 if {$jump_to_here ne {} &&
6897 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
6898 set lnum [expr {[lindex $jump_to_here 1] +
6899 [lindex [split $commentend .] 0]}]
6900 mark_ctext_line $lnum
6902 return 0
6904 $ctext config -state disabled
6905 return [expr {$nl >= 1000? 2: 1}]
6908 proc mark_ctext_line {lnum} {
6909 global ctext markbgcolor
6911 $ctext tag delete omark
6912 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
6913 $ctext tag conf omark -background $markbgcolor
6914 $ctext see $lnum.0
6917 proc mergediff {id} {
6918 global diffmergeid
6919 global diffids treediffs
6920 global parents curview
6922 set diffmergeid $id
6923 set diffids $id
6924 set treediffs($id) {}
6925 set np [llength $parents($curview,$id)]
6926 settabs $np
6927 getblobdiffs $id
6930 proc startdiff {ids} {
6931 global treediffs diffids treepending diffmergeid nullid nullid2
6933 settabs 1
6934 set diffids $ids
6935 catch {unset diffmergeid}
6936 if {![info exists treediffs($ids)] ||
6937 [lsearch -exact $ids $nullid] >= 0 ||
6938 [lsearch -exact $ids $nullid2] >= 0} {
6939 if {![info exists treepending]} {
6940 gettreediffs $ids
6942 } else {
6943 addtocflist $ids
6947 proc path_filter {filter name} {
6948 foreach p $filter {
6949 set l [string length $p]
6950 if {[string index $p end] eq "/"} {
6951 if {[string compare -length $l $p $name] == 0} {
6952 return 1
6954 } else {
6955 if {[string compare -length $l $p $name] == 0 &&
6956 ([string length $name] == $l ||
6957 [string index $name $l] eq "/")} {
6958 return 1
6962 return 0
6965 proc addtocflist {ids} {
6966 global treediffs
6968 add_flist $treediffs($ids)
6969 getblobdiffs $ids
6972 proc diffcmd {ids flags} {
6973 global nullid nullid2
6975 set i [lsearch -exact $ids $nullid]
6976 set j [lsearch -exact $ids $nullid2]
6977 if {$i >= 0} {
6978 if {[llength $ids] > 1 && $j < 0} {
6979 # comparing working directory with some specific revision
6980 set cmd [concat | git diff-index $flags]
6981 if {$i == 0} {
6982 lappend cmd -R [lindex $ids 1]
6983 } else {
6984 lappend cmd [lindex $ids 0]
6986 } else {
6987 # comparing working directory with index
6988 set cmd [concat | git diff-files $flags]
6989 if {$j == 1} {
6990 lappend cmd -R
6993 } elseif {$j >= 0} {
6994 set cmd [concat | git diff-index --cached $flags]
6995 if {[llength $ids] > 1} {
6996 # comparing index with specific revision
6997 if {$i == 0} {
6998 lappend cmd -R [lindex $ids 1]
6999 } else {
7000 lappend cmd [lindex $ids 0]
7002 } else {
7003 # comparing index with HEAD
7004 lappend cmd HEAD
7006 } else {
7007 set cmd [concat | git diff-tree -r $flags $ids]
7009 return $cmd
7012 proc gettreediffs {ids} {
7013 global treediff treepending
7015 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7017 set treepending $ids
7018 set treediff {}
7019 fconfigure $gdtf -blocking 0 -encoding binary
7020 filerun $gdtf [list gettreediffline $gdtf $ids]
7023 proc gettreediffline {gdtf ids} {
7024 global treediff treediffs treepending diffids diffmergeid
7025 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7027 set nr 0
7028 set sublist {}
7029 set max 1000
7030 if {$perfile_attrs} {
7031 # cache_gitattr is slow, and even slower on win32 where we
7032 # have to invoke it for only about 30 paths at a time
7033 set max 500
7034 if {[tk windowingsystem] == "win32"} {
7035 set max 120
7038 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7039 set i [string first "\t" $line]
7040 if {$i >= 0} {
7041 set file [string range $line [expr {$i+1}] end]
7042 if {[string index $file 0] eq "\""} {
7043 set file [lindex $file 0]
7045 set file [encoding convertfrom $file]
7046 if {$file ne [lindex $treediff end]} {
7047 lappend treediff $file
7048 lappend sublist $file
7052 if {$perfile_attrs} {
7053 cache_gitattr encoding $sublist
7055 if {![eof $gdtf]} {
7056 return [expr {$nr >= $max? 2: 1}]
7058 close $gdtf
7059 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7060 set flist {}
7061 foreach f $treediff {
7062 if {[path_filter $vfilelimit($curview) $f]} {
7063 lappend flist $f
7066 set treediffs($ids) $flist
7067 } else {
7068 set treediffs($ids) $treediff
7070 unset treepending
7071 if {$cmitmode eq "tree"} {
7072 gettree $diffids
7073 } elseif {$ids != $diffids} {
7074 if {![info exists diffmergeid]} {
7075 gettreediffs $diffids
7077 } else {
7078 addtocflist $ids
7080 return 0
7083 # empty string or positive integer
7084 proc diffcontextvalidate {v} {
7085 return [regexp {^(|[1-9][0-9]*)$} $v]
7088 proc diffcontextchange {n1 n2 op} {
7089 global diffcontextstring diffcontext
7091 if {[string is integer -strict $diffcontextstring]} {
7092 if {$diffcontextstring > 0} {
7093 set diffcontext $diffcontextstring
7094 reselectline
7099 proc changeignorespace {} {
7100 reselectline
7103 proc getblobdiffs {ids} {
7104 global blobdifffd diffids env
7105 global diffinhdr treediffs
7106 global diffcontext
7107 global ignorespace
7108 global limitdiffs vfilelimit curview
7109 global diffencoding targetline diffnparents
7111 set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7112 if {$ignorespace} {
7113 append cmd " -w"
7115 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7116 set cmd [concat $cmd -- $vfilelimit($curview)]
7118 if {[catch {set bdf [open $cmd r]} err]} {
7119 error_popup [mc "Error getting diffs: %s" $err]
7120 return
7122 set targetline {}
7123 set diffnparents 0
7124 set diffinhdr 0
7125 set diffencoding [get_path_encoding {}]
7126 fconfigure $bdf -blocking 0 -encoding binary
7127 set blobdifffd($ids) $bdf
7128 filerun $bdf [list getblobdiffline $bdf $diffids]
7131 proc setinlist {var i val} {
7132 global $var
7134 while {[llength [set $var]] < $i} {
7135 lappend $var {}
7137 if {[llength [set $var]] == $i} {
7138 lappend $var $val
7139 } else {
7140 lset $var $i $val
7144 proc makediffhdr {fname ids} {
7145 global ctext curdiffstart treediffs diffencoding
7146 global ctext_file_names jump_to_here targetline diffline
7148 set fname [encoding convertfrom $fname]
7149 set diffencoding [get_path_encoding $fname]
7150 set i [lsearch -exact $treediffs($ids) $fname]
7151 if {$i >= 0} {
7152 setinlist difffilestart $i $curdiffstart
7154 lset ctext_file_names end $fname
7155 set l [expr {(78 - [string length $fname]) / 2}]
7156 set pad [string range "----------------------------------------" 1 $l]
7157 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7158 set targetline {}
7159 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7160 set targetline [lindex $jump_to_here 1]
7162 set diffline 0
7165 proc getblobdiffline {bdf ids} {
7166 global diffids blobdifffd ctext curdiffstart
7167 global diffnexthead diffnextnote difffilestart
7168 global ctext_file_names ctext_file_lines
7169 global diffinhdr treediffs mergemax diffnparents
7170 global diffencoding jump_to_here targetline diffline
7172 set nr 0
7173 $ctext conf -state normal
7174 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7175 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7176 close $bdf
7177 return 0
7179 if {![string compare -length 5 "diff " $line]} {
7180 if {![regexp {^diff (--cc|--git) } $line m type]} {
7181 set line [encoding convertfrom $line]
7182 $ctext insert end "$line\n" hunksep
7183 continue
7185 # start of a new file
7186 set diffinhdr 1
7187 $ctext insert end "\n"
7188 set curdiffstart [$ctext index "end - 1c"]
7189 lappend ctext_file_names ""
7190 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7191 $ctext insert end "\n" filesep
7193 if {$type eq "--cc"} {
7194 # start of a new file in a merge diff
7195 set fname [string range $line 10 end]
7196 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7197 lappend treediffs($ids) $fname
7198 add_flist [list $fname]
7201 } else {
7202 set line [string range $line 11 end]
7203 # If the name hasn't changed the length will be odd,
7204 # the middle char will be a space, and the two bits either
7205 # side will be a/name and b/name, or "a/name" and "b/name".
7206 # If the name has changed we'll get "rename from" and
7207 # "rename to" or "copy from" and "copy to" lines following
7208 # this, and we'll use them to get the filenames.
7209 # This complexity is necessary because spaces in the
7210 # filename(s) don't get escaped.
7211 set l [string length $line]
7212 set i [expr {$l / 2}]
7213 if {!(($l & 1) && [string index $line $i] eq " " &&
7214 [string range $line 2 [expr {$i - 1}]] eq \
7215 [string range $line [expr {$i + 3}] end])} {
7216 continue
7218 # unescape if quoted and chop off the a/ from the front
7219 if {[string index $line 0] eq "\""} {
7220 set fname [string range [lindex $line 0] 2 end]
7221 } else {
7222 set fname [string range $line 2 [expr {$i - 1}]]
7225 makediffhdr $fname $ids
7227 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7228 set fname [encoding convertfrom [string range $line 16 end]]
7229 $ctext insert end "\n"
7230 set curdiffstart [$ctext index "end - 1c"]
7231 lappend ctext_file_names $fname
7232 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7233 $ctext insert end "$line\n" filesep
7234 set i [lsearch -exact $treediffs($ids) $fname]
7235 if {$i >= 0} {
7236 setinlist difffilestart $i $curdiffstart
7239 } elseif {![string compare -length 2 "@@" $line]} {
7240 regexp {^@@+} $line ats
7241 set line [encoding convertfrom $diffencoding $line]
7242 $ctext insert end "$line\n" hunksep
7243 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7244 set diffline $nl
7246 set diffnparents [expr {[string length $ats] - 1}]
7247 set diffinhdr 0
7249 } elseif {$diffinhdr} {
7250 if {![string compare -length 12 "rename from " $line]} {
7251 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7252 if {[string index $fname 0] eq "\""} {
7253 set fname [lindex $fname 0]
7255 set fname [encoding convertfrom $fname]
7256 set i [lsearch -exact $treediffs($ids) $fname]
7257 if {$i >= 0} {
7258 setinlist difffilestart $i $curdiffstart
7260 } elseif {![string compare -length 10 $line "rename to "] ||
7261 ![string compare -length 8 $line "copy to "]} {
7262 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7263 if {[string index $fname 0] eq "\""} {
7264 set fname [lindex $fname 0]
7266 makediffhdr $fname $ids
7267 } elseif {[string compare -length 3 $line "---"] == 0} {
7268 # do nothing
7269 continue
7270 } elseif {[string compare -length 3 $line "+++"] == 0} {
7271 set diffinhdr 0
7272 continue
7274 $ctext insert end "$line\n" filesep
7276 } else {
7277 set line [encoding convertfrom $diffencoding $line]
7278 # parse the prefix - one ' ', '-' or '+' for each parent
7279 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7280 set tag [expr {$diffnparents > 1? "m": "d"}]
7281 if {[string trim $prefix " -+"] eq {}} {
7282 # prefix only has " ", "-" and "+" in it: normal diff line
7283 set num [string first "-" $prefix]
7284 if {$num >= 0} {
7285 # removed line, first parent with line is $num
7286 if {$num >= $mergemax} {
7287 set num "max"
7289 $ctext insert end "$line\n" $tag$num
7290 } else {
7291 set tags {}
7292 if {[string first "+" $prefix] >= 0} {
7293 # added line
7294 lappend tags ${tag}result
7295 if {$diffnparents > 1} {
7296 set num [string first " " $prefix]
7297 if {$num >= 0} {
7298 if {$num >= $mergemax} {
7299 set num "max"
7301 lappend tags m$num
7305 if {$targetline ne {}} {
7306 if {$diffline == $targetline} {
7307 set seehere [$ctext index "end - 1 chars"]
7308 set targetline {}
7309 } else {
7310 incr diffline
7313 $ctext insert end "$line\n" $tags
7315 } else {
7316 # "\ No newline at end of file",
7317 # or something else we don't recognize
7318 $ctext insert end "$line\n" hunksep
7322 if {[info exists seehere]} {
7323 mark_ctext_line [lindex [split $seehere .] 0]
7325 $ctext conf -state disabled
7326 if {[eof $bdf]} {
7327 close $bdf
7328 return 0
7330 return [expr {$nr >= 1000? 2: 1}]
7333 proc changediffdisp {} {
7334 global ctext diffelide
7336 $ctext tag conf d0 -elide [lindex $diffelide 0]
7337 $ctext tag conf dresult -elide [lindex $diffelide 1]
7340 proc highlightfile {loc cline} {
7341 global ctext cflist cflist_top
7343 $ctext yview $loc
7344 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7345 $cflist tag add highlight $cline.0 "$cline.0 lineend"
7346 $cflist see $cline.0
7347 set cflist_top $cline
7350 proc prevfile {} {
7351 global difffilestart ctext cmitmode
7353 if {$cmitmode eq "tree"} return
7354 set prev 0.0
7355 set prevline 1
7356 set here [$ctext index @0,0]
7357 foreach loc $difffilestart {
7358 if {[$ctext compare $loc >= $here]} {
7359 highlightfile $prev $prevline
7360 return
7362 set prev $loc
7363 incr prevline
7365 highlightfile $prev $prevline
7368 proc nextfile {} {
7369 global difffilestart ctext cmitmode
7371 if {$cmitmode eq "tree"} return
7372 set here [$ctext index @0,0]
7373 set line 1
7374 foreach loc $difffilestart {
7375 incr line
7376 if {[$ctext compare $loc > $here]} {
7377 highlightfile $loc $line
7378 return
7383 proc clear_ctext {{first 1.0}} {
7384 global ctext smarktop smarkbot
7385 global ctext_file_names ctext_file_lines
7386 global pendinglinks
7388 set l [lindex [split $first .] 0]
7389 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7390 set smarktop $l
7392 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7393 set smarkbot $l
7395 $ctext delete $first end
7396 if {$first eq "1.0"} {
7397 catch {unset pendinglinks}
7399 set ctext_file_names {}
7400 set ctext_file_lines {}
7403 proc settabs {{firstab {}}} {
7404 global firsttabstop tabstop ctext have_tk85
7406 if {$firstab ne {} && $have_tk85} {
7407 set firsttabstop $firstab
7409 set w [font measure textfont "0"]
7410 if {$firsttabstop != 0} {
7411 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7412 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7413 } elseif {$have_tk85 || $tabstop != 8} {
7414 $ctext conf -tabs [expr {$tabstop * $w}]
7415 } else {
7416 $ctext conf -tabs {}
7420 proc incrsearch {name ix op} {
7421 global ctext searchstring searchdirn
7423 $ctext tag remove found 1.0 end
7424 if {[catch {$ctext index anchor}]} {
7425 # no anchor set, use start of selection, or of visible area
7426 set sel [$ctext tag ranges sel]
7427 if {$sel ne {}} {
7428 $ctext mark set anchor [lindex $sel 0]
7429 } elseif {$searchdirn eq "-forwards"} {
7430 $ctext mark set anchor @0,0
7431 } else {
7432 $ctext mark set anchor @0,[winfo height $ctext]
7435 if {$searchstring ne {}} {
7436 set here [$ctext search $searchdirn -- $searchstring anchor]
7437 if {$here ne {}} {
7438 $ctext see $here
7440 searchmarkvisible 1
7444 proc dosearch {} {
7445 global sstring ctext searchstring searchdirn
7447 focus $sstring
7448 $sstring icursor end
7449 set searchdirn -forwards
7450 if {$searchstring ne {}} {
7451 set sel [$ctext tag ranges sel]
7452 if {$sel ne {}} {
7453 set start "[lindex $sel 0] + 1c"
7454 } elseif {[catch {set start [$ctext index anchor]}]} {
7455 set start "@0,0"
7457 set match [$ctext search -count mlen -- $searchstring $start]
7458 $ctext tag remove sel 1.0 end
7459 if {$match eq {}} {
7460 bell
7461 return
7463 $ctext see $match
7464 set mend "$match + $mlen c"
7465 $ctext tag add sel $match $mend
7466 $ctext mark unset anchor
7470 proc dosearchback {} {
7471 global sstring ctext searchstring searchdirn
7473 focus $sstring
7474 $sstring icursor end
7475 set searchdirn -backwards
7476 if {$searchstring ne {}} {
7477 set sel [$ctext tag ranges sel]
7478 if {$sel ne {}} {
7479 set start [lindex $sel 0]
7480 } elseif {[catch {set start [$ctext index anchor]}]} {
7481 set start @0,[winfo height $ctext]
7483 set match [$ctext search -backwards -count ml -- $searchstring $start]
7484 $ctext tag remove sel 1.0 end
7485 if {$match eq {}} {
7486 bell
7487 return
7489 $ctext see $match
7490 set mend "$match + $ml c"
7491 $ctext tag add sel $match $mend
7492 $ctext mark unset anchor
7496 proc searchmark {first last} {
7497 global ctext searchstring
7499 set mend $first.0
7500 while {1} {
7501 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7502 if {$match eq {}} break
7503 set mend "$match + $mlen c"
7504 $ctext tag add found $match $mend
7508 proc searchmarkvisible {doall} {
7509 global ctext smarktop smarkbot
7511 set topline [lindex [split [$ctext index @0,0] .] 0]
7512 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7513 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7514 # no overlap with previous
7515 searchmark $topline $botline
7516 set smarktop $topline
7517 set smarkbot $botline
7518 } else {
7519 if {$topline < $smarktop} {
7520 searchmark $topline [expr {$smarktop-1}]
7521 set smarktop $topline
7523 if {$botline > $smarkbot} {
7524 searchmark [expr {$smarkbot+1}] $botline
7525 set smarkbot $botline
7530 proc scrolltext {f0 f1} {
7531 global searchstring
7533 .bleft.bottom.sb set $f0 $f1
7534 if {$searchstring ne {}} {
7535 searchmarkvisible 0
7539 proc setcoords {} {
7540 global linespc charspc canvx0 canvy0
7541 global xspc1 xspc2 lthickness
7543 set linespc [font metrics mainfont -linespace]
7544 set charspc [font measure mainfont "m"]
7545 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7546 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7547 set lthickness [expr {int($linespc / 9) + 1}]
7548 set xspc1(0) $linespc
7549 set xspc2 $linespc
7552 proc redisplay {} {
7553 global canv
7554 global selectedline
7556 set ymax [lindex [$canv cget -scrollregion] 3]
7557 if {$ymax eq {} || $ymax == 0} return
7558 set span [$canv yview]
7559 clear_display
7560 setcanvscroll
7561 allcanvs yview moveto [lindex $span 0]
7562 drawvisible
7563 if {$selectedline ne {}} {
7564 selectline $selectedline 0
7565 allcanvs yview moveto [lindex $span 0]
7569 proc parsefont {f n} {
7570 global fontattr
7572 set fontattr($f,family) [lindex $n 0]
7573 set s [lindex $n 1]
7574 if {$s eq {} || $s == 0} {
7575 set s 10
7576 } elseif {$s < 0} {
7577 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7579 set fontattr($f,size) $s
7580 set fontattr($f,weight) normal
7581 set fontattr($f,slant) roman
7582 foreach style [lrange $n 2 end] {
7583 switch -- $style {
7584 "normal" -
7585 "bold" {set fontattr($f,weight) $style}
7586 "roman" -
7587 "italic" {set fontattr($f,slant) $style}
7592 proc fontflags {f {isbold 0}} {
7593 global fontattr
7595 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7596 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7597 -slant $fontattr($f,slant)]
7600 proc fontname {f} {
7601 global fontattr
7603 set n [list $fontattr($f,family) $fontattr($f,size)]
7604 if {$fontattr($f,weight) eq "bold"} {
7605 lappend n "bold"
7607 if {$fontattr($f,slant) eq "italic"} {
7608 lappend n "italic"
7610 return $n
7613 proc incrfont {inc} {
7614 global mainfont textfont ctext canv cflist showrefstop
7615 global stopped entries fontattr
7617 unmarkmatches
7618 set s $fontattr(mainfont,size)
7619 incr s $inc
7620 if {$s < 1} {
7621 set s 1
7623 set fontattr(mainfont,size) $s
7624 font config mainfont -size $s
7625 font config mainfontbold -size $s
7626 set mainfont [fontname mainfont]
7627 set s $fontattr(textfont,size)
7628 incr s $inc
7629 if {$s < 1} {
7630 set s 1
7632 set fontattr(textfont,size) $s
7633 font config textfont -size $s
7634 font config textfontbold -size $s
7635 set textfont [fontname textfont]
7636 setcoords
7637 settabs
7638 redisplay
7641 proc clearsha1 {} {
7642 global sha1entry sha1string
7643 if {[string length $sha1string] == 40} {
7644 $sha1entry delete 0 end
7648 proc sha1change {n1 n2 op} {
7649 global sha1string currentid sha1but
7650 if {$sha1string == {}
7651 || ([info exists currentid] && $sha1string == $currentid)} {
7652 set state disabled
7653 } else {
7654 set state normal
7656 if {[$sha1but cget -state] == $state} return
7657 if {$state == "normal"} {
7658 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7659 } else {
7660 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7664 proc gotocommit {} {
7665 global sha1string tagids headids curview varcid
7667 if {$sha1string == {}
7668 || ([info exists currentid] && $sha1string == $currentid)} return
7669 if {[info exists tagids($sha1string)]} {
7670 set id $tagids($sha1string)
7671 } elseif {[info exists headids($sha1string)]} {
7672 set id $headids($sha1string)
7673 } else {
7674 set id [string tolower $sha1string]
7675 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7676 set matches [longid $id]
7677 if {$matches ne {}} {
7678 if {[llength $matches] > 1} {
7679 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7680 return
7682 set id [lindex $matches 0]
7686 if {[commitinview $id $curview]} {
7687 selectline [rowofcommit $id] 1
7688 return
7690 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7691 set msg [mc "SHA1 id %s is not known" $sha1string]
7692 } else {
7693 set msg [mc "Tag/Head %s is not known" $sha1string]
7695 error_popup $msg
7698 proc lineenter {x y id} {
7699 global hoverx hovery hoverid hovertimer
7700 global commitinfo canv
7702 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7703 set hoverx $x
7704 set hovery $y
7705 set hoverid $id
7706 if {[info exists hovertimer]} {
7707 after cancel $hovertimer
7709 set hovertimer [after 500 linehover]
7710 $canv delete hover
7713 proc linemotion {x y id} {
7714 global hoverx hovery hoverid hovertimer
7716 if {[info exists hoverid] && $id == $hoverid} {
7717 set hoverx $x
7718 set hovery $y
7719 if {[info exists hovertimer]} {
7720 after cancel $hovertimer
7722 set hovertimer [after 500 linehover]
7726 proc lineleave {id} {
7727 global hoverid hovertimer canv
7729 if {[info exists hoverid] && $id == $hoverid} {
7730 $canv delete hover
7731 if {[info exists hovertimer]} {
7732 after cancel $hovertimer
7733 unset hovertimer
7735 unset hoverid
7739 proc linehover {} {
7740 global hoverx hovery hoverid hovertimer
7741 global canv linespc lthickness
7742 global commitinfo
7744 set text [lindex $commitinfo($hoverid) 0]
7745 set ymax [lindex [$canv cget -scrollregion] 3]
7746 if {$ymax == {}} return
7747 set yfrac [lindex [$canv yview] 0]
7748 set x [expr {$hoverx + 2 * $linespc}]
7749 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7750 set x0 [expr {$x - 2 * $lthickness}]
7751 set y0 [expr {$y - 2 * $lthickness}]
7752 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7753 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7754 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7755 -fill \#ffff80 -outline black -width 1 -tags hover]
7756 $canv raise $t
7757 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7758 -font mainfont]
7759 $canv raise $t
7762 proc clickisonarrow {id y} {
7763 global lthickness
7765 set ranges [rowranges $id]
7766 set thresh [expr {2 * $lthickness + 6}]
7767 set n [expr {[llength $ranges] - 1}]
7768 for {set i 1} {$i < $n} {incr i} {
7769 set row [lindex $ranges $i]
7770 if {abs([yc $row] - $y) < $thresh} {
7771 return $i
7774 return {}
7777 proc arrowjump {id n y} {
7778 global canv
7780 # 1 <-> 2, 3 <-> 4, etc...
7781 set n [expr {(($n - 1) ^ 1) + 1}]
7782 set row [lindex [rowranges $id] $n]
7783 set yt [yc $row]
7784 set ymax [lindex [$canv cget -scrollregion] 3]
7785 if {$ymax eq {} || $ymax <= 0} return
7786 set view [$canv yview]
7787 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7788 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7789 if {$yfrac < 0} {
7790 set yfrac 0
7792 allcanvs yview moveto $yfrac
7795 proc lineclick {x y id isnew} {
7796 global ctext commitinfo children canv thickerline curview
7798 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7799 unmarkmatches
7800 unselectline
7801 normalline
7802 $canv delete hover
7803 # draw this line thicker than normal
7804 set thickerline $id
7805 drawlines $id
7806 if {$isnew} {
7807 set ymax [lindex [$canv cget -scrollregion] 3]
7808 if {$ymax eq {}} return
7809 set yfrac [lindex [$canv yview] 0]
7810 set y [expr {$y + $yfrac * $ymax}]
7812 set dirn [clickisonarrow $id $y]
7813 if {$dirn ne {}} {
7814 arrowjump $id $dirn $y
7815 return
7818 if {$isnew} {
7819 addtohistory [list lineclick $x $y $id 0]
7821 # fill the details pane with info about this line
7822 $ctext conf -state normal
7823 clear_ctext
7824 settabs 0
7825 $ctext insert end "[mc "Parent"]:\t"
7826 $ctext insert end $id link0
7827 setlink $id link0
7828 set info $commitinfo($id)
7829 $ctext insert end "\n\t[lindex $info 0]\n"
7830 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7831 set date [formatdate [lindex $info 2]]
7832 $ctext insert end "\t[mc "Date"]:\t$date\n"
7833 set kids $children($curview,$id)
7834 if {$kids ne {}} {
7835 $ctext insert end "\n[mc "Children"]:"
7836 set i 0
7837 foreach child $kids {
7838 incr i
7839 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7840 set info $commitinfo($child)
7841 $ctext insert end "\n\t"
7842 $ctext insert end $child link$i
7843 setlink $child link$i
7844 $ctext insert end "\n\t[lindex $info 0]"
7845 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7846 set date [formatdate [lindex $info 2]]
7847 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7850 $ctext conf -state disabled
7851 init_flist {}
7854 proc normalline {} {
7855 global thickerline
7856 if {[info exists thickerline]} {
7857 set id $thickerline
7858 unset thickerline
7859 drawlines $id
7863 proc selbyid {id} {
7864 global curview
7865 if {[commitinview $id $curview]} {
7866 selectline [rowofcommit $id] 1
7870 proc mstime {} {
7871 global startmstime
7872 if {![info exists startmstime]} {
7873 set startmstime [clock clicks -milliseconds]
7875 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7878 proc rowmenu {x y id} {
7879 global rowctxmenu selectedline rowmenuid curview
7880 global nullid nullid2 fakerowmenu mainhead
7882 stopfinding
7883 set rowmenuid $id
7884 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7885 set state disabled
7886 } else {
7887 set state normal
7889 if {$id ne $nullid && $id ne $nullid2} {
7890 set menu $rowctxmenu
7891 if {$mainhead ne {}} {
7892 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7893 } else {
7894 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7896 } else {
7897 set menu $fakerowmenu
7899 $menu entryconfigure [mca "Diff this -> selected"] -state $state
7900 $menu entryconfigure [mca "Diff selected -> this"] -state $state
7901 $menu entryconfigure [mca "Make patch"] -state $state
7902 tk_popup $menu $x $y
7905 proc diffvssel {dirn} {
7906 global rowmenuid selectedline
7908 if {$selectedline eq {}} return
7909 if {$dirn} {
7910 set oldid [commitonrow $selectedline]
7911 set newid $rowmenuid
7912 } else {
7913 set oldid $rowmenuid
7914 set newid [commitonrow $selectedline]
7916 addtohistory [list doseldiff $oldid $newid]
7917 doseldiff $oldid $newid
7920 proc doseldiff {oldid newid} {
7921 global ctext
7922 global commitinfo
7924 $ctext conf -state normal
7925 clear_ctext
7926 init_flist [mc "Top"]
7927 $ctext insert end "[mc "From"] "
7928 $ctext insert end $oldid link0
7929 setlink $oldid link0
7930 $ctext insert end "\n "
7931 $ctext insert end [lindex $commitinfo($oldid) 0]
7932 $ctext insert end "\n\n[mc "To"] "
7933 $ctext insert end $newid link1
7934 setlink $newid link1
7935 $ctext insert end "\n "
7936 $ctext insert end [lindex $commitinfo($newid) 0]
7937 $ctext insert end "\n"
7938 $ctext conf -state disabled
7939 $ctext tag remove found 1.0 end
7940 startdiff [list $oldid $newid]
7943 proc mkpatch {} {
7944 global rowmenuid currentid commitinfo patchtop patchnum
7946 if {![info exists currentid]} return
7947 set oldid $currentid
7948 set oldhead [lindex $commitinfo($oldid) 0]
7949 set newid $rowmenuid
7950 set newhead [lindex $commitinfo($newid) 0]
7951 set top .patch
7952 set patchtop $top
7953 catch {destroy $top}
7954 toplevel $top
7955 make_transient $top .
7956 label $top.title -text [mc "Generate patch"]
7957 grid $top.title - -pady 10
7958 label $top.from -text [mc "From:"]
7959 entry $top.fromsha1 -width 40 -relief flat
7960 $top.fromsha1 insert 0 $oldid
7961 $top.fromsha1 conf -state readonly
7962 grid $top.from $top.fromsha1 -sticky w
7963 entry $top.fromhead -width 60 -relief flat
7964 $top.fromhead insert 0 $oldhead
7965 $top.fromhead conf -state readonly
7966 grid x $top.fromhead -sticky w
7967 label $top.to -text [mc "To:"]
7968 entry $top.tosha1 -width 40 -relief flat
7969 $top.tosha1 insert 0 $newid
7970 $top.tosha1 conf -state readonly
7971 grid $top.to $top.tosha1 -sticky w
7972 entry $top.tohead -width 60 -relief flat
7973 $top.tohead insert 0 $newhead
7974 $top.tohead conf -state readonly
7975 grid x $top.tohead -sticky w
7976 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7977 grid $top.rev x -pady 10
7978 label $top.flab -text [mc "Output file:"]
7979 entry $top.fname -width 60
7980 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7981 incr patchnum
7982 grid $top.flab $top.fname -sticky w
7983 frame $top.buts
7984 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7985 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7986 bind $top <Key-Return> mkpatchgo
7987 bind $top <Key-Escape> mkpatchcan
7988 grid $top.buts.gen $top.buts.can
7989 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7990 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7991 grid $top.buts - -pady 10 -sticky ew
7992 focus $top.fname
7995 proc mkpatchrev {} {
7996 global patchtop
7998 set oldid [$patchtop.fromsha1 get]
7999 set oldhead [$patchtop.fromhead get]
8000 set newid [$patchtop.tosha1 get]
8001 set newhead [$patchtop.tohead get]
8002 foreach e [list fromsha1 fromhead tosha1 tohead] \
8003 v [list $newid $newhead $oldid $oldhead] {
8004 $patchtop.$e conf -state normal
8005 $patchtop.$e delete 0 end
8006 $patchtop.$e insert 0 $v
8007 $patchtop.$e conf -state readonly
8011 proc mkpatchgo {} {
8012 global patchtop nullid nullid2
8014 set oldid [$patchtop.fromsha1 get]
8015 set newid [$patchtop.tosha1 get]
8016 set fname [$patchtop.fname get]
8017 set cmd [diffcmd [list $oldid $newid] -p]
8018 # trim off the initial "|"
8019 set cmd [lrange $cmd 1 end]
8020 lappend cmd >$fname &
8021 if {[catch {eval exec $cmd} err]} {
8022 error_popup "[mc "Error creating patch:"] $err" $patchtop
8024 catch {destroy $patchtop}
8025 unset patchtop
8028 proc mkpatchcan {} {
8029 global patchtop
8031 catch {destroy $patchtop}
8032 unset patchtop
8035 proc mktag {} {
8036 global rowmenuid mktagtop commitinfo
8038 set top .maketag
8039 set mktagtop $top
8040 catch {destroy $top}
8041 toplevel $top
8042 make_transient $top .
8043 label $top.title -text [mc "Create tag"]
8044 grid $top.title - -pady 10
8045 label $top.id -text [mc "ID:"]
8046 entry $top.sha1 -width 40 -relief flat
8047 $top.sha1 insert 0 $rowmenuid
8048 $top.sha1 conf -state readonly
8049 grid $top.id $top.sha1 -sticky w
8050 entry $top.head -width 60 -relief flat
8051 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8052 $top.head conf -state readonly
8053 grid x $top.head -sticky w
8054 label $top.tlab -text [mc "Tag name:"]
8055 entry $top.tag -width 60
8056 grid $top.tlab $top.tag -sticky w
8057 frame $top.buts
8058 button $top.buts.gen -text [mc "Create"] -command mktaggo
8059 button $top.buts.can -text [mc "Cancel"] -command mktagcan
8060 bind $top <Key-Return> mktaggo
8061 bind $top <Key-Escape> mktagcan
8062 grid $top.buts.gen $top.buts.can
8063 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8064 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8065 grid $top.buts - -pady 10 -sticky ew
8066 focus $top.tag
8069 proc domktag {} {
8070 global mktagtop env tagids idtags
8072 set id [$mktagtop.sha1 get]
8073 set tag [$mktagtop.tag get]
8074 if {$tag == {}} {
8075 error_popup [mc "No tag name specified"] $mktagtop
8076 return 0
8078 if {[info exists tagids($tag)]} {
8079 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8080 return 0
8082 if {[catch {
8083 exec git tag $tag $id
8084 } err]} {
8085 error_popup "[mc "Error creating tag:"] $err" $mktagtop
8086 return 0
8089 set tagids($tag) $id
8090 lappend idtags($id) $tag
8091 redrawtags $id
8092 addedtag $id
8093 dispneartags 0
8094 run refill_reflist
8095 return 1
8098 proc redrawtags {id} {
8099 global canv linehtag idpos currentid curview cmitlisted
8100 global canvxmax iddrawn circleitem mainheadid circlecolors
8102 if {![commitinview $id $curview]} return
8103 if {![info exists iddrawn($id)]} return
8104 set row [rowofcommit $id]
8105 if {$id eq $mainheadid} {
8106 set ofill yellow
8107 } else {
8108 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8110 $canv itemconf $circleitem($row) -fill $ofill
8111 $canv delete tag.$id
8112 set xt [eval drawtags $id $idpos($id)]
8113 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
8114 set text [$canv itemcget $linehtag($row) -text]
8115 set font [$canv itemcget $linehtag($row) -font]
8116 set xr [expr {$xt + [font measure $font $text]}]
8117 if {$xr > $canvxmax} {
8118 set canvxmax $xr
8119 setcanvscroll
8121 if {[info exists currentid] && $currentid == $id} {
8122 make_secsel $row
8126 proc mktagcan {} {
8127 global mktagtop
8129 catch {destroy $mktagtop}
8130 unset mktagtop
8133 proc mktaggo {} {
8134 if {![domktag]} return
8135 mktagcan
8138 proc writecommit {} {
8139 global rowmenuid wrcomtop commitinfo wrcomcmd
8141 set top .writecommit
8142 set wrcomtop $top
8143 catch {destroy $top}
8144 toplevel $top
8145 make_transient $top .
8146 label $top.title -text [mc "Write commit to file"]
8147 grid $top.title - -pady 10
8148 label $top.id -text [mc "ID:"]
8149 entry $top.sha1 -width 40 -relief flat
8150 $top.sha1 insert 0 $rowmenuid
8151 $top.sha1 conf -state readonly
8152 grid $top.id $top.sha1 -sticky w
8153 entry $top.head -width 60 -relief flat
8154 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8155 $top.head conf -state readonly
8156 grid x $top.head -sticky w
8157 label $top.clab -text [mc "Command:"]
8158 entry $top.cmd -width 60 -textvariable wrcomcmd
8159 grid $top.clab $top.cmd -sticky w -pady 10
8160 label $top.flab -text [mc "Output file:"]
8161 entry $top.fname -width 60
8162 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8163 grid $top.flab $top.fname -sticky w
8164 frame $top.buts
8165 button $top.buts.gen -text [mc "Write"] -command wrcomgo
8166 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8167 bind $top <Key-Return> wrcomgo
8168 bind $top <Key-Escape> wrcomcan
8169 grid $top.buts.gen $top.buts.can
8170 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8171 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8172 grid $top.buts - -pady 10 -sticky ew
8173 focus $top.fname
8176 proc wrcomgo {} {
8177 global wrcomtop
8179 set id [$wrcomtop.sha1 get]
8180 set cmd "echo $id | [$wrcomtop.cmd get]"
8181 set fname [$wrcomtop.fname get]
8182 if {[catch {exec sh -c $cmd >$fname &} err]} {
8183 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8185 catch {destroy $wrcomtop}
8186 unset wrcomtop
8189 proc wrcomcan {} {
8190 global wrcomtop
8192 catch {destroy $wrcomtop}
8193 unset wrcomtop
8196 proc mkbranch {} {
8197 global rowmenuid mkbrtop
8199 set top .makebranch
8200 catch {destroy $top}
8201 toplevel $top
8202 make_transient $top .
8203 label $top.title -text [mc "Create new branch"]
8204 grid $top.title - -pady 10
8205 label $top.id -text [mc "ID:"]
8206 entry $top.sha1 -width 40 -relief flat
8207 $top.sha1 insert 0 $rowmenuid
8208 $top.sha1 conf -state readonly
8209 grid $top.id $top.sha1 -sticky w
8210 label $top.nlab -text [mc "Name:"]
8211 entry $top.name -width 40
8212 bind $top.name <Key-Return> "[list mkbrgo $top]"
8213 grid $top.nlab $top.name -sticky w
8214 frame $top.buts
8215 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8216 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8217 bind $top <Key-Return> [list mkbrgo $top]
8218 bind $top <Key-Escape> "catch {destroy $top}"
8219 grid $top.buts.go $top.buts.can
8220 grid columnconfigure $top.buts 0 -weight 1 -uniform a
8221 grid columnconfigure $top.buts 1 -weight 1 -uniform a
8222 grid $top.buts - -pady 10 -sticky ew
8223 focus $top.name
8226 proc mkbrgo {top} {
8227 global headids idheads
8229 set name [$top.name get]
8230 set id [$top.sha1 get]
8231 set cmdargs {}
8232 set old_id {}
8233 if {$name eq {}} {
8234 error_popup [mc "Please specify a name for the new branch"] $top
8235 return
8237 if {[info exists headids($name)]} {
8238 if {![confirm_popup [mc \
8239 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8240 return
8242 set old_id $headids($name)
8243 lappend cmdargs -f
8245 catch {destroy $top}
8246 lappend cmdargs $name $id
8247 nowbusy newbranch
8248 update
8249 if {[catch {
8250 eval exec git branch $cmdargs
8251 } err]} {
8252 notbusy newbranch
8253 error_popup $err
8254 } else {
8255 notbusy newbranch
8256 if {$old_id ne {}} {
8257 movehead $id $name
8258 movedhead $id $name
8259 redrawtags $old_id
8260 redrawtags $id
8261 } else {
8262 set headids($name) $id
8263 lappend idheads($id) $name
8264 addedhead $id $name
8265 redrawtags $id
8267 dispneartags 0
8268 run refill_reflist
8272 proc exec_citool {tool_args {baseid {}}} {
8273 global commitinfo env
8275 set save_env [array get env GIT_AUTHOR_*]
8277 if {$baseid ne {}} {
8278 if {![info exists commitinfo($baseid)]} {
8279 getcommit $baseid
8281 set author [lindex $commitinfo($baseid) 1]
8282 set date [lindex $commitinfo($baseid) 2]
8283 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8284 $author author name email]
8285 && $date ne {}} {
8286 set env(GIT_AUTHOR_NAME) $name
8287 set env(GIT_AUTHOR_EMAIL) $email
8288 set env(GIT_AUTHOR_DATE) $date
8292 eval exec git citool $tool_args &
8294 array unset env GIT_AUTHOR_*
8295 array set env $save_env
8298 proc cherrypick {} {
8299 global rowmenuid curview
8300 global mainhead mainheadid
8302 set oldhead [exec git rev-parse HEAD]
8303 set dheads [descheads $rowmenuid]
8304 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8305 set ok [confirm_popup [mc "Commit %s is already\
8306 included in branch %s -- really re-apply it?" \
8307 [string range $rowmenuid 0 7] $mainhead]]
8308 if {!$ok} return
8310 nowbusy cherrypick [mc "Cherry-picking"]
8311 update
8312 # Unfortunately git-cherry-pick writes stuff to stderr even when
8313 # no error occurs, and exec takes that as an indication of error...
8314 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8315 notbusy cherrypick
8316 if {[regexp -line \
8317 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8318 $err msg fname]} {
8319 error_popup [mc "Cherry-pick failed because of local changes\
8320 to file '%s'.\nPlease commit, reset or stash\
8321 your changes and try again." $fname]
8322 } elseif {[regexp -line \
8323 {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8324 $err]} {
8325 if {[confirm_popup [mc "Cherry-pick failed because of merge\
8326 conflict.\nDo you wish to run git citool to\
8327 resolve it?"]]} {
8328 # Force citool to read MERGE_MSG
8329 file delete [file join [gitdir] "GITGUI_MSG"]
8330 exec_citool {} $rowmenuid
8332 } else {
8333 error_popup $err
8335 run updatecommits
8336 return
8338 set newhead [exec git rev-parse HEAD]
8339 if {$newhead eq $oldhead} {
8340 notbusy cherrypick
8341 error_popup [mc "No changes committed"]
8342 return
8344 addnewchild $newhead $oldhead
8345 if {[commitinview $oldhead $curview]} {
8346 insertrow $newhead $oldhead $curview
8347 if {$mainhead ne {}} {
8348 movehead $newhead $mainhead
8349 movedhead $newhead $mainhead
8351 set mainheadid $newhead
8352 redrawtags $oldhead
8353 redrawtags $newhead
8354 selbyid $newhead
8356 notbusy cherrypick
8359 proc resethead {} {
8360 global mainhead rowmenuid confirm_ok resettype
8362 set confirm_ok 0
8363 set w ".confirmreset"
8364 toplevel $w
8365 make_transient $w .
8366 wm title $w [mc "Confirm reset"]
8367 message $w.m -text \
8368 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8369 -justify center -aspect 1000
8370 pack $w.m -side top -fill x -padx 20 -pady 20
8371 frame $w.f -relief sunken -border 2
8372 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8373 grid $w.f.rt -sticky w
8374 set resettype mixed
8375 radiobutton $w.f.soft -value soft -variable resettype -justify left \
8376 -text [mc "Soft: Leave working tree and index untouched"]
8377 grid $w.f.soft -sticky w
8378 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8379 -text [mc "Mixed: Leave working tree untouched, reset index"]
8380 grid $w.f.mixed -sticky w
8381 radiobutton $w.f.hard -value hard -variable resettype -justify left \
8382 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8383 grid $w.f.hard -sticky w
8384 pack $w.f -side top -fill x
8385 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8386 pack $w.ok -side left -fill x -padx 20 -pady 20
8387 button $w.cancel -text [mc Cancel] -command "destroy $w"
8388 bind $w <Key-Escape> [list destroy $w]
8389 pack $w.cancel -side right -fill x -padx 20 -pady 20
8390 bind $w <Visibility> "grab $w; focus $w"
8391 tkwait window $w
8392 if {!$confirm_ok} return
8393 if {[catch {set fd [open \
8394 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8395 error_popup $err
8396 } else {
8397 dohidelocalchanges
8398 filerun $fd [list readresetstat $fd]
8399 nowbusy reset [mc "Resetting"]
8400 selbyid $rowmenuid
8404 proc readresetstat {fd} {
8405 global mainhead mainheadid showlocalchanges rprogcoord
8407 if {[gets $fd line] >= 0} {
8408 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8409 set rprogcoord [expr {1.0 * $m / $n}]
8410 adjustprogress
8412 return 1
8414 set rprogcoord 0
8415 adjustprogress
8416 notbusy reset
8417 if {[catch {close $fd} err]} {
8418 error_popup $err
8420 set oldhead $mainheadid
8421 set newhead [exec git rev-parse HEAD]
8422 if {$newhead ne $oldhead} {
8423 movehead $newhead $mainhead
8424 movedhead $newhead $mainhead
8425 set mainheadid $newhead
8426 redrawtags $oldhead
8427 redrawtags $newhead
8429 if {$showlocalchanges} {
8430 doshowlocalchanges
8432 return 0
8435 # context menu for a head
8436 proc headmenu {x y id head} {
8437 global headmenuid headmenuhead headctxmenu mainhead
8439 stopfinding
8440 set headmenuid $id
8441 set headmenuhead $head
8442 set state normal
8443 if {$head eq $mainhead} {
8444 set state disabled
8446 $headctxmenu entryconfigure 0 -state $state
8447 $headctxmenu entryconfigure 1 -state $state
8448 tk_popup $headctxmenu $x $y
8451 proc cobranch {} {
8452 global headmenuid headmenuhead headids
8453 global showlocalchanges mainheadid
8455 # check the tree is clean first??
8456 nowbusy checkout [mc "Checking out"]
8457 update
8458 dohidelocalchanges
8459 if {[catch {
8460 set fd [open [list | git checkout $headmenuhead 2>@1] r]
8461 } err]} {
8462 notbusy checkout
8463 error_popup $err
8464 if {$showlocalchanges} {
8465 dodiffindex
8467 } else {
8468 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8472 proc readcheckoutstat {fd newhead newheadid} {
8473 global mainhead mainheadid headids showlocalchanges progresscoords
8475 if {[gets $fd line] >= 0} {
8476 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8477 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8478 adjustprogress
8480 return 1
8482 set progresscoords {0 0}
8483 adjustprogress
8484 notbusy checkout
8485 if {[catch {close $fd} err]} {
8486 error_popup $err
8488 set oldmainid $mainheadid
8489 set mainhead $newhead
8490 set mainheadid $newheadid
8491 redrawtags $oldmainid
8492 redrawtags $newheadid
8493 selbyid $newheadid
8494 if {$showlocalchanges} {
8495 dodiffindex
8499 proc rmbranch {} {
8500 global headmenuid headmenuhead mainhead
8501 global idheads
8503 set head $headmenuhead
8504 set id $headmenuid
8505 # this check shouldn't be needed any more...
8506 if {$head eq $mainhead} {
8507 error_popup [mc "Cannot delete the currently checked-out branch"]
8508 return
8510 set dheads [descheads $id]
8511 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8512 # the stuff on this branch isn't on any other branch
8513 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8514 branch.\nReally delete branch %s?" $head $head]]} return
8516 nowbusy rmbranch
8517 update
8518 if {[catch {exec git branch -D $head} err]} {
8519 notbusy rmbranch
8520 error_popup $err
8521 return
8523 removehead $id $head
8524 removedhead $id $head
8525 redrawtags $id
8526 notbusy rmbranch
8527 dispneartags 0
8528 run refill_reflist
8531 # Display a list of tags and heads
8532 proc showrefs {} {
8533 global showrefstop bgcolor fgcolor selectbgcolor
8534 global bglist fglist reflistfilter reflist maincursor
8536 set top .showrefs
8537 set showrefstop $top
8538 if {[winfo exists $top]} {
8539 raise $top
8540 refill_reflist
8541 return
8543 toplevel $top
8544 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8545 make_transient $top .
8546 text $top.list -background $bgcolor -foreground $fgcolor \
8547 -selectbackground $selectbgcolor -font mainfont \
8548 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8549 -width 30 -height 20 -cursor $maincursor \
8550 -spacing1 1 -spacing3 1 -state disabled
8551 $top.list tag configure highlight -background $selectbgcolor
8552 lappend bglist $top.list
8553 lappend fglist $top.list
8554 scrollbar $top.ysb -command "$top.list yview" -orient vertical
8555 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8556 grid $top.list $top.ysb -sticky nsew
8557 grid $top.xsb x -sticky ew
8558 frame $top.f
8559 label $top.f.l -text "[mc "Filter"]: "
8560 entry $top.f.e -width 20 -textvariable reflistfilter
8561 set reflistfilter "*"
8562 trace add variable reflistfilter write reflistfilter_change
8563 pack $top.f.e -side right -fill x -expand 1
8564 pack $top.f.l -side left
8565 grid $top.f - -sticky ew -pady 2
8566 button $top.close -command [list destroy $top] -text [mc "Close"]
8567 bind $top <Key-Escape> [list destroy $top]
8568 grid $top.close -
8569 grid columnconfigure $top 0 -weight 1
8570 grid rowconfigure $top 0 -weight 1
8571 bind $top.list <1> {break}
8572 bind $top.list <B1-Motion> {break}
8573 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8574 set reflist {}
8575 refill_reflist
8578 proc sel_reflist {w x y} {
8579 global showrefstop reflist headids tagids otherrefids
8581 if {![winfo exists $showrefstop]} return
8582 set l [lindex [split [$w index "@$x,$y"] "."] 0]
8583 set ref [lindex $reflist [expr {$l-1}]]
8584 set n [lindex $ref 0]
8585 switch -- [lindex $ref 1] {
8586 "H" {selbyid $headids($n)}
8587 "T" {selbyid $tagids($n)}
8588 "o" {selbyid $otherrefids($n)}
8590 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8593 proc unsel_reflist {} {
8594 global showrefstop
8596 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8597 $showrefstop.list tag remove highlight 0.0 end
8600 proc reflistfilter_change {n1 n2 op} {
8601 global reflistfilter
8603 after cancel refill_reflist
8604 after 200 refill_reflist
8607 proc refill_reflist {} {
8608 global reflist reflistfilter showrefstop headids tagids otherrefids
8609 global curview
8611 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8612 set refs {}
8613 foreach n [array names headids] {
8614 if {[string match $reflistfilter $n]} {
8615 if {[commitinview $headids($n) $curview]} {
8616 lappend refs [list $n H]
8617 } else {
8618 interestedin $headids($n) {run refill_reflist}
8622 foreach n [array names tagids] {
8623 if {[string match $reflistfilter $n]} {
8624 if {[commitinview $tagids($n) $curview]} {
8625 lappend refs [list $n T]
8626 } else {
8627 interestedin $tagids($n) {run refill_reflist}
8631 foreach n [array names otherrefids] {
8632 if {[string match $reflistfilter $n]} {
8633 if {[commitinview $otherrefids($n) $curview]} {
8634 lappend refs [list $n o]
8635 } else {
8636 interestedin $otherrefids($n) {run refill_reflist}
8640 set refs [lsort -index 0 $refs]
8641 if {$refs eq $reflist} return
8643 # Update the contents of $showrefstop.list according to the
8644 # differences between $reflist (old) and $refs (new)
8645 $showrefstop.list conf -state normal
8646 $showrefstop.list insert end "\n"
8647 set i 0
8648 set j 0
8649 while {$i < [llength $reflist] || $j < [llength $refs]} {
8650 if {$i < [llength $reflist]} {
8651 if {$j < [llength $refs]} {
8652 set cmp [string compare [lindex $reflist $i 0] \
8653 [lindex $refs $j 0]]
8654 if {$cmp == 0} {
8655 set cmp [string compare [lindex $reflist $i 1] \
8656 [lindex $refs $j 1]]
8658 } else {
8659 set cmp -1
8661 } else {
8662 set cmp 1
8664 switch -- $cmp {
8665 -1 {
8666 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8667 incr i
8670 incr i
8671 incr j
8674 set l [expr {$j + 1}]
8675 $showrefstop.list image create $l.0 -align baseline \
8676 -image reficon-[lindex $refs $j 1] -padx 2
8677 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8678 incr j
8682 set reflist $refs
8683 # delete last newline
8684 $showrefstop.list delete end-2c end-1c
8685 $showrefstop.list conf -state disabled
8688 # Stuff for finding nearby tags
8689 proc getallcommits {} {
8690 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8691 global idheads idtags idotherrefs allparents tagobjid
8693 if {![info exists allcommits]} {
8694 set nextarc 0
8695 set allcommits 0
8696 set seeds {}
8697 set allcwait 0
8698 set cachedarcs 0
8699 set allccache [file join [gitdir] "gitk.cache"]
8700 if {![catch {
8701 set f [open $allccache r]
8702 set allcwait 1
8703 getcache $f
8704 }]} return
8707 if {$allcwait} {
8708 return
8710 set cmd [list | git rev-list --parents]
8711 set allcupdate [expr {$seeds ne {}}]
8712 if {!$allcupdate} {
8713 set ids "--all"
8714 } else {
8715 set refs [concat [array names idheads] [array names idtags] \
8716 [array names idotherrefs]]
8717 set ids {}
8718 set tagobjs {}
8719 foreach name [array names tagobjid] {
8720 lappend tagobjs $tagobjid($name)
8722 foreach id [lsort -unique $refs] {
8723 if {![info exists allparents($id)] &&
8724 [lsearch -exact $tagobjs $id] < 0} {
8725 lappend ids $id
8728 if {$ids ne {}} {
8729 foreach id $seeds {
8730 lappend ids "^$id"
8734 if {$ids ne {}} {
8735 set fd [open [concat $cmd $ids] r]
8736 fconfigure $fd -blocking 0
8737 incr allcommits
8738 nowbusy allcommits
8739 filerun $fd [list getallclines $fd]
8740 } else {
8741 dispneartags 0
8745 # Since most commits have 1 parent and 1 child, we group strings of
8746 # such commits into "arcs" joining branch/merge points (BMPs), which
8747 # are commits that either don't have 1 parent or don't have 1 child.
8749 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8750 # arcout(id) - outgoing arcs for BMP
8751 # arcids(a) - list of IDs on arc including end but not start
8752 # arcstart(a) - BMP ID at start of arc
8753 # arcend(a) - BMP ID at end of arc
8754 # growing(a) - arc a is still growing
8755 # arctags(a) - IDs out of arcids (excluding end) that have tags
8756 # archeads(a) - IDs out of arcids (excluding end) that have heads
8757 # The start of an arc is at the descendent end, so "incoming" means
8758 # coming from descendents, and "outgoing" means going towards ancestors.
8760 proc getallclines {fd} {
8761 global allparents allchildren idtags idheads nextarc
8762 global arcnos arcids arctags arcout arcend arcstart archeads growing
8763 global seeds allcommits cachedarcs allcupdate
8765 set nid 0
8766 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8767 set id [lindex $line 0]
8768 if {[info exists allparents($id)]} {
8769 # seen it already
8770 continue
8772 set cachedarcs 0
8773 set olds [lrange $line 1 end]
8774 set allparents($id) $olds
8775 if {![info exists allchildren($id)]} {
8776 set allchildren($id) {}
8777 set arcnos($id) {}
8778 lappend seeds $id
8779 } else {
8780 set a $arcnos($id)
8781 if {[llength $olds] == 1 && [llength $a] == 1} {
8782 lappend arcids($a) $id
8783 if {[info exists idtags($id)]} {
8784 lappend arctags($a) $id
8786 if {[info exists idheads($id)]} {
8787 lappend archeads($a) $id
8789 if {[info exists allparents($olds)]} {
8790 # seen parent already
8791 if {![info exists arcout($olds)]} {
8792 splitarc $olds
8794 lappend arcids($a) $olds
8795 set arcend($a) $olds
8796 unset growing($a)
8798 lappend allchildren($olds) $id
8799 lappend arcnos($olds) $a
8800 continue
8803 foreach a $arcnos($id) {
8804 lappend arcids($a) $id
8805 set arcend($a) $id
8806 unset growing($a)
8809 set ao {}
8810 foreach p $olds {
8811 lappend allchildren($p) $id
8812 set a [incr nextarc]
8813 set arcstart($a) $id
8814 set archeads($a) {}
8815 set arctags($a) {}
8816 set archeads($a) {}
8817 set arcids($a) {}
8818 lappend ao $a
8819 set growing($a) 1
8820 if {[info exists allparents($p)]} {
8821 # seen it already, may need to make a new branch
8822 if {![info exists arcout($p)]} {
8823 splitarc $p
8825 lappend arcids($a) $p
8826 set arcend($a) $p
8827 unset growing($a)
8829 lappend arcnos($p) $a
8831 set arcout($id) $ao
8833 if {$nid > 0} {
8834 global cached_dheads cached_dtags cached_atags
8835 catch {unset cached_dheads}
8836 catch {unset cached_dtags}
8837 catch {unset cached_atags}
8839 if {![eof $fd]} {
8840 return [expr {$nid >= 1000? 2: 1}]
8842 set cacheok 1
8843 if {[catch {
8844 fconfigure $fd -blocking 1
8845 close $fd
8846 } err]} {
8847 # got an error reading the list of commits
8848 # if we were updating, try rereading the whole thing again
8849 if {$allcupdate} {
8850 incr allcommits -1
8851 dropcache $err
8852 return
8854 error_popup "[mc "Error reading commit topology information;\
8855 branch and preceding/following tag information\
8856 will be incomplete."]\n($err)"
8857 set cacheok 0
8859 if {[incr allcommits -1] == 0} {
8860 notbusy allcommits
8861 if {$cacheok} {
8862 run savecache
8865 dispneartags 0
8866 return 0
8869 proc recalcarc {a} {
8870 global arctags archeads arcids idtags idheads
8872 set at {}
8873 set ah {}
8874 foreach id [lrange $arcids($a) 0 end-1] {
8875 if {[info exists idtags($id)]} {
8876 lappend at $id
8878 if {[info exists idheads($id)]} {
8879 lappend ah $id
8882 set arctags($a) $at
8883 set archeads($a) $ah
8886 proc splitarc {p} {
8887 global arcnos arcids nextarc arctags archeads idtags idheads
8888 global arcstart arcend arcout allparents growing
8890 set a $arcnos($p)
8891 if {[llength $a] != 1} {
8892 puts "oops splitarc called but [llength $a] arcs already"
8893 return
8895 set a [lindex $a 0]
8896 set i [lsearch -exact $arcids($a) $p]
8897 if {$i < 0} {
8898 puts "oops splitarc $p not in arc $a"
8899 return
8901 set na [incr nextarc]
8902 if {[info exists arcend($a)]} {
8903 set arcend($na) $arcend($a)
8904 } else {
8905 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8906 set j [lsearch -exact $arcnos($l) $a]
8907 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8909 set tail [lrange $arcids($a) [expr {$i+1}] end]
8910 set arcids($a) [lrange $arcids($a) 0 $i]
8911 set arcend($a) $p
8912 set arcstart($na) $p
8913 set arcout($p) $na
8914 set arcids($na) $tail
8915 if {[info exists growing($a)]} {
8916 set growing($na) 1
8917 unset growing($a)
8920 foreach id $tail {
8921 if {[llength $arcnos($id)] == 1} {
8922 set arcnos($id) $na
8923 } else {
8924 set j [lsearch -exact $arcnos($id) $a]
8925 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8929 # reconstruct tags and heads lists
8930 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8931 recalcarc $a
8932 recalcarc $na
8933 } else {
8934 set arctags($na) {}
8935 set archeads($na) {}
8939 # Update things for a new commit added that is a child of one
8940 # existing commit. Used when cherry-picking.
8941 proc addnewchild {id p} {
8942 global allparents allchildren idtags nextarc
8943 global arcnos arcids arctags arcout arcend arcstart archeads growing
8944 global seeds allcommits
8946 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8947 set allparents($id) [list $p]
8948 set allchildren($id) {}
8949 set arcnos($id) {}
8950 lappend seeds $id
8951 lappend allchildren($p) $id
8952 set a [incr nextarc]
8953 set arcstart($a) $id
8954 set archeads($a) {}
8955 set arctags($a) {}
8956 set arcids($a) [list $p]
8957 set arcend($a) $p
8958 if {![info exists arcout($p)]} {
8959 splitarc $p
8961 lappend arcnos($p) $a
8962 set arcout($id) [list $a]
8965 # This implements a cache for the topology information.
8966 # The cache saves, for each arc, the start and end of the arc,
8967 # the ids on the arc, and the outgoing arcs from the end.
8968 proc readcache {f} {
8969 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8970 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8971 global allcwait
8973 set a $nextarc
8974 set lim $cachedarcs
8975 if {$lim - $a > 500} {
8976 set lim [expr {$a + 500}]
8978 if {[catch {
8979 if {$a == $lim} {
8980 # finish reading the cache and setting up arctags, etc.
8981 set line [gets $f]
8982 if {$line ne "1"} {error "bad final version"}
8983 close $f
8984 foreach id [array names idtags] {
8985 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8986 [llength $allparents($id)] == 1} {
8987 set a [lindex $arcnos($id) 0]
8988 if {$arctags($a) eq {}} {
8989 recalcarc $a
8993 foreach id [array names idheads] {
8994 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8995 [llength $allparents($id)] == 1} {
8996 set a [lindex $arcnos($id) 0]
8997 if {$archeads($a) eq {}} {
8998 recalcarc $a
9002 foreach id [lsort -unique $possible_seeds] {
9003 if {$arcnos($id) eq {}} {
9004 lappend seeds $id
9007 set allcwait 0
9008 } else {
9009 while {[incr a] <= $lim} {
9010 set line [gets $f]
9011 if {[llength $line] != 3} {error "bad line"}
9012 set s [lindex $line 0]
9013 set arcstart($a) $s
9014 lappend arcout($s) $a
9015 if {![info exists arcnos($s)]} {
9016 lappend possible_seeds $s
9017 set arcnos($s) {}
9019 set e [lindex $line 1]
9020 if {$e eq {}} {
9021 set growing($a) 1
9022 } else {
9023 set arcend($a) $e
9024 if {![info exists arcout($e)]} {
9025 set arcout($e) {}
9028 set arcids($a) [lindex $line 2]
9029 foreach id $arcids($a) {
9030 lappend allparents($s) $id
9031 set s $id
9032 lappend arcnos($id) $a
9034 if {![info exists allparents($s)]} {
9035 set allparents($s) {}
9037 set arctags($a) {}
9038 set archeads($a) {}
9040 set nextarc [expr {$a - 1}]
9042 } err]} {
9043 dropcache $err
9044 return 0
9046 if {!$allcwait} {
9047 getallcommits
9049 return $allcwait
9052 proc getcache {f} {
9053 global nextarc cachedarcs possible_seeds
9055 if {[catch {
9056 set line [gets $f]
9057 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9058 # make sure it's an integer
9059 set cachedarcs [expr {int([lindex $line 1])}]
9060 if {$cachedarcs < 0} {error "bad number of arcs"}
9061 set nextarc 0
9062 set possible_seeds {}
9063 run readcache $f
9064 } err]} {
9065 dropcache $err
9067 return 0
9070 proc dropcache {err} {
9071 global allcwait nextarc cachedarcs seeds
9073 #puts "dropping cache ($err)"
9074 foreach v {arcnos arcout arcids arcstart arcend growing \
9075 arctags archeads allparents allchildren} {
9076 global $v
9077 catch {unset $v}
9079 set allcwait 0
9080 set nextarc 0
9081 set cachedarcs 0
9082 set seeds {}
9083 getallcommits
9086 proc writecache {f} {
9087 global cachearc cachedarcs allccache
9088 global arcstart arcend arcnos arcids arcout
9090 set a $cachearc
9091 set lim $cachedarcs
9092 if {$lim - $a > 1000} {
9093 set lim [expr {$a + 1000}]
9095 if {[catch {
9096 while {[incr a] <= $lim} {
9097 if {[info exists arcend($a)]} {
9098 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9099 } else {
9100 puts $f [list $arcstart($a) {} $arcids($a)]
9103 } err]} {
9104 catch {close $f}
9105 catch {file delete $allccache}
9106 #puts "writing cache failed ($err)"
9107 return 0
9109 set cachearc [expr {$a - 1}]
9110 if {$a > $cachedarcs} {
9111 puts $f "1"
9112 close $f
9113 return 0
9115 return 1
9118 proc savecache {} {
9119 global nextarc cachedarcs cachearc allccache
9121 if {$nextarc == $cachedarcs} return
9122 set cachearc 0
9123 set cachedarcs $nextarc
9124 catch {
9125 set f [open $allccache w]
9126 puts $f [list 1 $cachedarcs]
9127 run writecache $f
9131 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9132 # or 0 if neither is true.
9133 proc anc_or_desc {a b} {
9134 global arcout arcstart arcend arcnos cached_isanc
9136 if {$arcnos($a) eq $arcnos($b)} {
9137 # Both are on the same arc(s); either both are the same BMP,
9138 # or if one is not a BMP, the other is also not a BMP or is
9139 # the BMP at end of the arc (and it only has 1 incoming arc).
9140 # Or both can be BMPs with no incoming arcs.
9141 if {$a eq $b || $arcnos($a) eq {}} {
9142 return 0
9144 # assert {[llength $arcnos($a)] == 1}
9145 set arc [lindex $arcnos($a) 0]
9146 set i [lsearch -exact $arcids($arc) $a]
9147 set j [lsearch -exact $arcids($arc) $b]
9148 if {$i < 0 || $i > $j} {
9149 return 1
9150 } else {
9151 return -1
9155 if {![info exists arcout($a)]} {
9156 set arc [lindex $arcnos($a) 0]
9157 if {[info exists arcend($arc)]} {
9158 set aend $arcend($arc)
9159 } else {
9160 set aend {}
9162 set a $arcstart($arc)
9163 } else {
9164 set aend $a
9166 if {![info exists arcout($b)]} {
9167 set arc [lindex $arcnos($b) 0]
9168 if {[info exists arcend($arc)]} {
9169 set bend $arcend($arc)
9170 } else {
9171 set bend {}
9173 set b $arcstart($arc)
9174 } else {
9175 set bend $b
9177 if {$a eq $bend} {
9178 return 1
9180 if {$b eq $aend} {
9181 return -1
9183 if {[info exists cached_isanc($a,$bend)]} {
9184 if {$cached_isanc($a,$bend)} {
9185 return 1
9188 if {[info exists cached_isanc($b,$aend)]} {
9189 if {$cached_isanc($b,$aend)} {
9190 return -1
9192 if {[info exists cached_isanc($a,$bend)]} {
9193 return 0
9197 set todo [list $a $b]
9198 set anc($a) a
9199 set anc($b) b
9200 for {set i 0} {$i < [llength $todo]} {incr i} {
9201 set x [lindex $todo $i]
9202 if {$anc($x) eq {}} {
9203 continue
9205 foreach arc $arcnos($x) {
9206 set xd $arcstart($arc)
9207 if {$xd eq $bend} {
9208 set cached_isanc($a,$bend) 1
9209 set cached_isanc($b,$aend) 0
9210 return 1
9211 } elseif {$xd eq $aend} {
9212 set cached_isanc($b,$aend) 1
9213 set cached_isanc($a,$bend) 0
9214 return -1
9216 if {![info exists anc($xd)]} {
9217 set anc($xd) $anc($x)
9218 lappend todo $xd
9219 } elseif {$anc($xd) ne $anc($x)} {
9220 set anc($xd) {}
9224 set cached_isanc($a,$bend) 0
9225 set cached_isanc($b,$aend) 0
9226 return 0
9229 # This identifies whether $desc has an ancestor that is
9230 # a growing tip of the graph and which is not an ancestor of $anc
9231 # and returns 0 if so and 1 if not.
9232 # If we subsequently discover a tag on such a growing tip, and that
9233 # turns out to be a descendent of $anc (which it could, since we
9234 # don't necessarily see children before parents), then $desc
9235 # isn't a good choice to display as a descendent tag of
9236 # $anc (since it is the descendent of another tag which is
9237 # a descendent of $anc). Similarly, $anc isn't a good choice to
9238 # display as a ancestor tag of $desc.
9240 proc is_certain {desc anc} {
9241 global arcnos arcout arcstart arcend growing problems
9243 set certain {}
9244 if {[llength $arcnos($anc)] == 1} {
9245 # tags on the same arc are certain
9246 if {$arcnos($desc) eq $arcnos($anc)} {
9247 return 1
9249 if {![info exists arcout($anc)]} {
9250 # if $anc is partway along an arc, use the start of the arc instead
9251 set a [lindex $arcnos($anc) 0]
9252 set anc $arcstart($a)
9255 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9256 set x $desc
9257 } else {
9258 set a [lindex $arcnos($desc) 0]
9259 set x $arcend($a)
9261 if {$x == $anc} {
9262 return 1
9264 set anclist [list $x]
9265 set dl($x) 1
9266 set nnh 1
9267 set ngrowanc 0
9268 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9269 set x [lindex $anclist $i]
9270 if {$dl($x)} {
9271 incr nnh -1
9273 set done($x) 1
9274 foreach a $arcout($x) {
9275 if {[info exists growing($a)]} {
9276 if {![info exists growanc($x)] && $dl($x)} {
9277 set growanc($x) 1
9278 incr ngrowanc
9280 } else {
9281 set y $arcend($a)
9282 if {[info exists dl($y)]} {
9283 if {$dl($y)} {
9284 if {!$dl($x)} {
9285 set dl($y) 0
9286 if {![info exists done($y)]} {
9287 incr nnh -1
9289 if {[info exists growanc($x)]} {
9290 incr ngrowanc -1
9292 set xl [list $y]
9293 for {set k 0} {$k < [llength $xl]} {incr k} {
9294 set z [lindex $xl $k]
9295 foreach c $arcout($z) {
9296 if {[info exists arcend($c)]} {
9297 set v $arcend($c)
9298 if {[info exists dl($v)] && $dl($v)} {
9299 set dl($v) 0
9300 if {![info exists done($v)]} {
9301 incr nnh -1
9303 if {[info exists growanc($v)]} {
9304 incr ngrowanc -1
9306 lappend xl $v
9313 } elseif {$y eq $anc || !$dl($x)} {
9314 set dl($y) 0
9315 lappend anclist $y
9316 } else {
9317 set dl($y) 1
9318 lappend anclist $y
9319 incr nnh
9324 foreach x [array names growanc] {
9325 if {$dl($x)} {
9326 return 0
9328 return 0
9330 return 1
9333 proc validate_arctags {a} {
9334 global arctags idtags
9336 set i -1
9337 set na $arctags($a)
9338 foreach id $arctags($a) {
9339 incr i
9340 if {![info exists idtags($id)]} {
9341 set na [lreplace $na $i $i]
9342 incr i -1
9345 set arctags($a) $na
9348 proc validate_archeads {a} {
9349 global archeads idheads
9351 set i -1
9352 set na $archeads($a)
9353 foreach id $archeads($a) {
9354 incr i
9355 if {![info exists idheads($id)]} {
9356 set na [lreplace $na $i $i]
9357 incr i -1
9360 set archeads($a) $na
9363 # Return the list of IDs that have tags that are descendents of id,
9364 # ignoring IDs that are descendents of IDs already reported.
9365 proc desctags {id} {
9366 global arcnos arcstart arcids arctags idtags allparents
9367 global growing cached_dtags
9369 if {![info exists allparents($id)]} {
9370 return {}
9372 set t1 [clock clicks -milliseconds]
9373 set argid $id
9374 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9375 # part-way along an arc; check that arc first
9376 set a [lindex $arcnos($id) 0]
9377 if {$arctags($a) ne {}} {
9378 validate_arctags $a
9379 set i [lsearch -exact $arcids($a) $id]
9380 set tid {}
9381 foreach t $arctags($a) {
9382 set j [lsearch -exact $arcids($a) $t]
9383 if {$j >= $i} break
9384 set tid $t
9386 if {$tid ne {}} {
9387 return $tid
9390 set id $arcstart($a)
9391 if {[info exists idtags($id)]} {
9392 return $id
9395 if {[info exists cached_dtags($id)]} {
9396 return $cached_dtags($id)
9399 set origid $id
9400 set todo [list $id]
9401 set queued($id) 1
9402 set nc 1
9403 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9404 set id [lindex $todo $i]
9405 set done($id) 1
9406 set ta [info exists hastaggedancestor($id)]
9407 if {!$ta} {
9408 incr nc -1
9410 # ignore tags on starting node
9411 if {!$ta && $i > 0} {
9412 if {[info exists idtags($id)]} {
9413 set tagloc($id) $id
9414 set ta 1
9415 } elseif {[info exists cached_dtags($id)]} {
9416 set tagloc($id) $cached_dtags($id)
9417 set ta 1
9420 foreach a $arcnos($id) {
9421 set d $arcstart($a)
9422 if {!$ta && $arctags($a) ne {}} {
9423 validate_arctags $a
9424 if {$arctags($a) ne {}} {
9425 lappend tagloc($id) [lindex $arctags($a) end]
9428 if {$ta || $arctags($a) ne {}} {
9429 set tomark [list $d]
9430 for {set j 0} {$j < [llength $tomark]} {incr j} {
9431 set dd [lindex $tomark $j]
9432 if {![info exists hastaggedancestor($dd)]} {
9433 if {[info exists done($dd)]} {
9434 foreach b $arcnos($dd) {
9435 lappend tomark $arcstart($b)
9437 if {[info exists tagloc($dd)]} {
9438 unset tagloc($dd)
9440 } elseif {[info exists queued($dd)]} {
9441 incr nc -1
9443 set hastaggedancestor($dd) 1
9447 if {![info exists queued($d)]} {
9448 lappend todo $d
9449 set queued($d) 1
9450 if {![info exists hastaggedancestor($d)]} {
9451 incr nc
9456 set tags {}
9457 foreach id [array names tagloc] {
9458 if {![info exists hastaggedancestor($id)]} {
9459 foreach t $tagloc($id) {
9460 if {[lsearch -exact $tags $t] < 0} {
9461 lappend tags $t
9466 set t2 [clock clicks -milliseconds]
9467 set loopix $i
9469 # remove tags that are descendents of other tags
9470 for {set i 0} {$i < [llength $tags]} {incr i} {
9471 set a [lindex $tags $i]
9472 for {set j 0} {$j < $i} {incr j} {
9473 set b [lindex $tags $j]
9474 set r [anc_or_desc $a $b]
9475 if {$r == 1} {
9476 set tags [lreplace $tags $j $j]
9477 incr j -1
9478 incr i -1
9479 } elseif {$r == -1} {
9480 set tags [lreplace $tags $i $i]
9481 incr i -1
9482 break
9487 if {[array names growing] ne {}} {
9488 # graph isn't finished, need to check if any tag could get
9489 # eclipsed by another tag coming later. Simply ignore any
9490 # tags that could later get eclipsed.
9491 set ctags {}
9492 foreach t $tags {
9493 if {[is_certain $t $origid]} {
9494 lappend ctags $t
9497 if {$tags eq $ctags} {
9498 set cached_dtags($origid) $tags
9499 } else {
9500 set tags $ctags
9502 } else {
9503 set cached_dtags($origid) $tags
9505 set t3 [clock clicks -milliseconds]
9506 if {0 && $t3 - $t1 >= 100} {
9507 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9508 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9510 return $tags
9513 proc anctags {id} {
9514 global arcnos arcids arcout arcend arctags idtags allparents
9515 global growing cached_atags
9517 if {![info exists allparents($id)]} {
9518 return {}
9520 set t1 [clock clicks -milliseconds]
9521 set argid $id
9522 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9523 # part-way along an arc; check that arc first
9524 set a [lindex $arcnos($id) 0]
9525 if {$arctags($a) ne {}} {
9526 validate_arctags $a
9527 set i [lsearch -exact $arcids($a) $id]
9528 foreach t $arctags($a) {
9529 set j [lsearch -exact $arcids($a) $t]
9530 if {$j > $i} {
9531 return $t
9535 if {![info exists arcend($a)]} {
9536 return {}
9538 set id $arcend($a)
9539 if {[info exists idtags($id)]} {
9540 return $id
9543 if {[info exists cached_atags($id)]} {
9544 return $cached_atags($id)
9547 set origid $id
9548 set todo [list $id]
9549 set queued($id) 1
9550 set taglist {}
9551 set nc 1
9552 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9553 set id [lindex $todo $i]
9554 set done($id) 1
9555 set td [info exists hastaggeddescendent($id)]
9556 if {!$td} {
9557 incr nc -1
9559 # ignore tags on starting node
9560 if {!$td && $i > 0} {
9561 if {[info exists idtags($id)]} {
9562 set tagloc($id) $id
9563 set td 1
9564 } elseif {[info exists cached_atags($id)]} {
9565 set tagloc($id) $cached_atags($id)
9566 set td 1
9569 foreach a $arcout($id) {
9570 if {!$td && $arctags($a) ne {}} {
9571 validate_arctags $a
9572 if {$arctags($a) ne {}} {
9573 lappend tagloc($id) [lindex $arctags($a) 0]
9576 if {![info exists arcend($a)]} continue
9577 set d $arcend($a)
9578 if {$td || $arctags($a) ne {}} {
9579 set tomark [list $d]
9580 for {set j 0} {$j < [llength $tomark]} {incr j} {
9581 set dd [lindex $tomark $j]
9582 if {![info exists hastaggeddescendent($dd)]} {
9583 if {[info exists done($dd)]} {
9584 foreach b $arcout($dd) {
9585 if {[info exists arcend($b)]} {
9586 lappend tomark $arcend($b)
9589 if {[info exists tagloc($dd)]} {
9590 unset tagloc($dd)
9592 } elseif {[info exists queued($dd)]} {
9593 incr nc -1
9595 set hastaggeddescendent($dd) 1
9599 if {![info exists queued($d)]} {
9600 lappend todo $d
9601 set queued($d) 1
9602 if {![info exists hastaggeddescendent($d)]} {
9603 incr nc
9608 set t2 [clock clicks -milliseconds]
9609 set loopix $i
9610 set tags {}
9611 foreach id [array names tagloc] {
9612 if {![info exists hastaggeddescendent($id)]} {
9613 foreach t $tagloc($id) {
9614 if {[lsearch -exact $tags $t] < 0} {
9615 lappend tags $t
9621 # remove tags that are ancestors of other tags
9622 for {set i 0} {$i < [llength $tags]} {incr i} {
9623 set a [lindex $tags $i]
9624 for {set j 0} {$j < $i} {incr j} {
9625 set b [lindex $tags $j]
9626 set r [anc_or_desc $a $b]
9627 if {$r == -1} {
9628 set tags [lreplace $tags $j $j]
9629 incr j -1
9630 incr i -1
9631 } elseif {$r == 1} {
9632 set tags [lreplace $tags $i $i]
9633 incr i -1
9634 break
9639 if {[array names growing] ne {}} {
9640 # graph isn't finished, need to check if any tag could get
9641 # eclipsed by another tag coming later. Simply ignore any
9642 # tags that could later get eclipsed.
9643 set ctags {}
9644 foreach t $tags {
9645 if {[is_certain $origid $t]} {
9646 lappend ctags $t
9649 if {$tags eq $ctags} {
9650 set cached_atags($origid) $tags
9651 } else {
9652 set tags $ctags
9654 } else {
9655 set cached_atags($origid) $tags
9657 set t3 [clock clicks -milliseconds]
9658 if {0 && $t3 - $t1 >= 100} {
9659 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9660 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9662 return $tags
9665 # Return the list of IDs that have heads that are descendents of id,
9666 # including id itself if it has a head.
9667 proc descheads {id} {
9668 global arcnos arcstart arcids archeads idheads cached_dheads
9669 global allparents
9671 if {![info exists allparents($id)]} {
9672 return {}
9674 set aret {}
9675 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9676 # part-way along an arc; check it first
9677 set a [lindex $arcnos($id) 0]
9678 if {$archeads($a) ne {}} {
9679 validate_archeads $a
9680 set i [lsearch -exact $arcids($a) $id]
9681 foreach t $archeads($a) {
9682 set j [lsearch -exact $arcids($a) $t]
9683 if {$j > $i} break
9684 lappend aret $t
9687 set id $arcstart($a)
9689 set origid $id
9690 set todo [list $id]
9691 set seen($id) 1
9692 set ret {}
9693 for {set i 0} {$i < [llength $todo]} {incr i} {
9694 set id [lindex $todo $i]
9695 if {[info exists cached_dheads($id)]} {
9696 set ret [concat $ret $cached_dheads($id)]
9697 } else {
9698 if {[info exists idheads($id)]} {
9699 lappend ret $id
9701 foreach a $arcnos($id) {
9702 if {$archeads($a) ne {}} {
9703 validate_archeads $a
9704 if {$archeads($a) ne {}} {
9705 set ret [concat $ret $archeads($a)]
9708 set d $arcstart($a)
9709 if {![info exists seen($d)]} {
9710 lappend todo $d
9711 set seen($d) 1
9716 set ret [lsort -unique $ret]
9717 set cached_dheads($origid) $ret
9718 return [concat $ret $aret]
9721 proc addedtag {id} {
9722 global arcnos arcout cached_dtags cached_atags
9724 if {![info exists arcnos($id)]} return
9725 if {![info exists arcout($id)]} {
9726 recalcarc [lindex $arcnos($id) 0]
9728 catch {unset cached_dtags}
9729 catch {unset cached_atags}
9732 proc addedhead {hid head} {
9733 global arcnos arcout cached_dheads
9735 if {![info exists arcnos($hid)]} return
9736 if {![info exists arcout($hid)]} {
9737 recalcarc [lindex $arcnos($hid) 0]
9739 catch {unset cached_dheads}
9742 proc removedhead {hid head} {
9743 global cached_dheads
9745 catch {unset cached_dheads}
9748 proc movedhead {hid head} {
9749 global arcnos arcout cached_dheads
9751 if {![info exists arcnos($hid)]} return
9752 if {![info exists arcout($hid)]} {
9753 recalcarc [lindex $arcnos($hid) 0]
9755 catch {unset cached_dheads}
9758 proc changedrefs {} {
9759 global cached_dheads cached_dtags cached_atags
9760 global arctags archeads arcnos arcout idheads idtags
9762 foreach id [concat [array names idheads] [array names idtags]] {
9763 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9764 set a [lindex $arcnos($id) 0]
9765 if {![info exists donearc($a)]} {
9766 recalcarc $a
9767 set donearc($a) 1
9771 catch {unset cached_dtags}
9772 catch {unset cached_atags}
9773 catch {unset cached_dheads}
9776 proc rereadrefs {} {
9777 global idtags idheads idotherrefs mainheadid
9779 set refids [concat [array names idtags] \
9780 [array names idheads] [array names idotherrefs]]
9781 foreach id $refids {
9782 if {![info exists ref($id)]} {
9783 set ref($id) [listrefs $id]
9786 set oldmainhead $mainheadid
9787 readrefs
9788 changedrefs
9789 set refids [lsort -unique [concat $refids [array names idtags] \
9790 [array names idheads] [array names idotherrefs]]]
9791 foreach id $refids {
9792 set v [listrefs $id]
9793 if {![info exists ref($id)] || $ref($id) != $v} {
9794 redrawtags $id
9797 if {$oldmainhead ne $mainheadid} {
9798 redrawtags $oldmainhead
9799 redrawtags $mainheadid
9801 run refill_reflist
9804 proc listrefs {id} {
9805 global idtags idheads idotherrefs
9807 set x {}
9808 if {[info exists idtags($id)]} {
9809 set x $idtags($id)
9811 set y {}
9812 if {[info exists idheads($id)]} {
9813 set y $idheads($id)
9815 set z {}
9816 if {[info exists idotherrefs($id)]} {
9817 set z $idotherrefs($id)
9819 return [list $x $y $z]
9822 proc showtag {tag isnew} {
9823 global ctext tagcontents tagids linknum tagobjid
9825 if {$isnew} {
9826 addtohistory [list showtag $tag 0]
9828 $ctext conf -state normal
9829 clear_ctext
9830 settabs 0
9831 set linknum 0
9832 if {![info exists tagcontents($tag)]} {
9833 catch {
9834 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9837 if {[info exists tagcontents($tag)]} {
9838 set text $tagcontents($tag)
9839 } else {
9840 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9842 appendwithlinks $text {}
9843 $ctext conf -state disabled
9844 init_flist {}
9847 proc doquit {} {
9848 global stopped
9849 global gitktmpdir
9851 set stopped 100
9852 savestuff .
9853 destroy .
9855 if {[info exists gitktmpdir]} {
9856 catch {file delete -force $gitktmpdir}
9860 proc mkfontdisp {font top which} {
9861 global fontattr fontpref $font
9863 set fontpref($font) [set $font]
9864 button $top.${font}but -text $which -font optionfont \
9865 -command [list choosefont $font $which]
9866 label $top.$font -relief flat -font $font \
9867 -text $fontattr($font,family) -justify left
9868 grid x $top.${font}but $top.$font -sticky w
9871 proc choosefont {font which} {
9872 global fontparam fontlist fonttop fontattr
9873 global prefstop
9875 set fontparam(which) $which
9876 set fontparam(font) $font
9877 set fontparam(family) [font actual $font -family]
9878 set fontparam(size) $fontattr($font,size)
9879 set fontparam(weight) $fontattr($font,weight)
9880 set fontparam(slant) $fontattr($font,slant)
9881 set top .gitkfont
9882 set fonttop $top
9883 if {![winfo exists $top]} {
9884 font create sample
9885 eval font config sample [font actual $font]
9886 toplevel $top
9887 make_transient $top $prefstop
9888 wm title $top [mc "Gitk font chooser"]
9889 label $top.l -textvariable fontparam(which)
9890 pack $top.l -side top
9891 set fontlist [lsort [font families]]
9892 frame $top.f
9893 listbox $top.f.fam -listvariable fontlist \
9894 -yscrollcommand [list $top.f.sb set]
9895 bind $top.f.fam <<ListboxSelect>> selfontfam
9896 scrollbar $top.f.sb -command [list $top.f.fam yview]
9897 pack $top.f.sb -side right -fill y
9898 pack $top.f.fam -side left -fill both -expand 1
9899 pack $top.f -side top -fill both -expand 1
9900 frame $top.g
9901 spinbox $top.g.size -from 4 -to 40 -width 4 \
9902 -textvariable fontparam(size) \
9903 -validatecommand {string is integer -strict %s}
9904 checkbutton $top.g.bold -padx 5 \
9905 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9906 -variable fontparam(weight) -onvalue bold -offvalue normal
9907 checkbutton $top.g.ital -padx 5 \
9908 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9909 -variable fontparam(slant) -onvalue italic -offvalue roman
9910 pack $top.g.size $top.g.bold $top.g.ital -side left
9911 pack $top.g -side top
9912 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9913 -background white
9914 $top.c create text 100 25 -anchor center -text $which -font sample \
9915 -fill black -tags text
9916 bind $top.c <Configure> [list centertext $top.c]
9917 pack $top.c -side top -fill x
9918 frame $top.buts
9919 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9920 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9921 bind $top <Key-Return> fontok
9922 bind $top <Key-Escape> fontcan
9923 grid $top.buts.ok $top.buts.can
9924 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9925 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9926 pack $top.buts -side bottom -fill x
9927 trace add variable fontparam write chg_fontparam
9928 } else {
9929 raise $top
9930 $top.c itemconf text -text $which
9932 set i [lsearch -exact $fontlist $fontparam(family)]
9933 if {$i >= 0} {
9934 $top.f.fam selection set $i
9935 $top.f.fam see $i
9939 proc centertext {w} {
9940 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9943 proc fontok {} {
9944 global fontparam fontpref prefstop
9946 set f $fontparam(font)
9947 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9948 if {$fontparam(weight) eq "bold"} {
9949 lappend fontpref($f) "bold"
9951 if {$fontparam(slant) eq "italic"} {
9952 lappend fontpref($f) "italic"
9954 set w $prefstop.$f
9955 $w conf -text $fontparam(family) -font $fontpref($f)
9957 fontcan
9960 proc fontcan {} {
9961 global fonttop fontparam
9963 if {[info exists fonttop]} {
9964 catch {destroy $fonttop}
9965 catch {font delete sample}
9966 unset fonttop
9967 unset fontparam
9971 proc selfontfam {} {
9972 global fonttop fontparam
9974 set i [$fonttop.f.fam curselection]
9975 if {$i ne {}} {
9976 set fontparam(family) [$fonttop.f.fam get $i]
9980 proc chg_fontparam {v sub op} {
9981 global fontparam
9983 font config sample -$sub $fontparam($sub)
9986 proc doprefs {} {
9987 global maxwidth maxgraphpct
9988 global oldprefs prefstop showneartags showlocalchanges
9989 global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
9990 global tabstop limitdiffs autoselect extdifftool perfile_attrs
9992 set top .gitkprefs
9993 set prefstop $top
9994 if {[winfo exists $top]} {
9995 raise $top
9996 return
9998 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9999 limitdiffs tabstop perfile_attrs} {
10000 set oldprefs($v) [set $v]
10002 toplevel $top
10003 wm title $top [mc "Gitk preferences"]
10004 make_transient $top .
10005 label $top.ldisp -text [mc "Commit list display options"]
10006 grid $top.ldisp - -sticky w -pady 10
10007 label $top.spacer -text " "
10008 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10009 -font optionfont
10010 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10011 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10012 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10013 -font optionfont
10014 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10015 grid x $top.maxpctl $top.maxpct -sticky w
10016 frame $top.showlocal
10017 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
10018 checkbutton $top.showlocal.b -variable showlocalchanges
10019 pack $top.showlocal.b $top.showlocal.l -side left
10020 grid x $top.showlocal -sticky w
10021 frame $top.autoselect
10022 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
10023 checkbutton $top.autoselect.b -variable autoselect
10024 pack $top.autoselect.b $top.autoselect.l -side left
10025 grid x $top.autoselect -sticky w
10027 label $top.ddisp -text [mc "Diff display options"]
10028 grid $top.ddisp - -sticky w -pady 10
10029 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10030 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10031 grid x $top.tabstopl $top.tabstop -sticky w
10032 frame $top.ntag
10033 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
10034 checkbutton $top.ntag.b -variable showneartags
10035 pack $top.ntag.b $top.ntag.l -side left
10036 grid x $top.ntag -sticky w
10037 frame $top.ldiff
10038 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
10039 checkbutton $top.ldiff.b -variable limitdiffs
10040 pack $top.ldiff.b $top.ldiff.l -side left
10041 grid x $top.ldiff -sticky w
10042 frame $top.lattr
10043 label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
10044 checkbutton $top.lattr.b -variable perfile_attrs
10045 pack $top.lattr.b $top.lattr.l -side left
10046 grid x $top.lattr -sticky w
10048 entry $top.extdifft -textvariable extdifftool
10049 frame $top.extdifff
10050 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10051 -padx 10
10052 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10053 -command choose_extdiff
10054 pack $top.extdifff.l $top.extdifff.b -side left
10055 grid x $top.extdifff $top.extdifft -sticky w
10057 label $top.cdisp -text [mc "Colors: press to choose"]
10058 grid $top.cdisp - -sticky w -pady 10
10059 label $top.bg -padx 40 -relief sunk -background $bgcolor
10060 button $top.bgbut -text [mc "Background"] -font optionfont \
10061 -command [list choosecolor bgcolor {} $top.bg background setbg]
10062 grid x $top.bgbut $top.bg -sticky w
10063 label $top.fg -padx 40 -relief sunk -background $fgcolor
10064 button $top.fgbut -text [mc "Foreground"] -font optionfont \
10065 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
10066 grid x $top.fgbut $top.fg -sticky w
10067 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10068 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10069 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
10070 [list $ctext tag conf d0 -foreground]]
10071 grid x $top.diffoldbut $top.diffold -sticky w
10072 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10073 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10074 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
10075 [list $ctext tag conf dresult -foreground]]
10076 grid x $top.diffnewbut $top.diffnew -sticky w
10077 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10078 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10079 -command [list choosecolor diffcolors 2 $top.hunksep \
10080 "diff hunk header" \
10081 [list $ctext tag conf hunksep -foreground]]
10082 grid x $top.hunksepbut $top.hunksep -sticky w
10083 label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10084 button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10085 -command [list choosecolor markbgcolor {} $top.markbgsep \
10086 [mc "marked line background"] \
10087 [list $ctext tag conf omark -background]]
10088 grid x $top.markbgbut $top.markbgsep -sticky w
10089 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10090 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10091 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
10092 grid x $top.selbgbut $top.selbgsep -sticky w
10094 label $top.cfont -text [mc "Fonts: press to choose"]
10095 grid $top.cfont - -sticky w -pady 10
10096 mkfontdisp mainfont $top [mc "Main font"]
10097 mkfontdisp textfont $top [mc "Diff display font"]
10098 mkfontdisp uifont $top [mc "User interface font"]
10100 frame $top.buts
10101 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10102 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10103 bind $top <Key-Return> prefsok
10104 bind $top <Key-Escape> prefscan
10105 grid $top.buts.ok $top.buts.can
10106 grid columnconfigure $top.buts 0 -weight 1 -uniform a
10107 grid columnconfigure $top.buts 1 -weight 1 -uniform a
10108 grid $top.buts - - -pady 10 -sticky ew
10109 bind $top <Visibility> "focus $top.buts.ok"
10112 proc choose_extdiff {} {
10113 global extdifftool
10115 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
10116 if {$prog ne {}} {
10117 set extdifftool $prog
10121 proc choosecolor {v vi w x cmd} {
10122 global $v
10124 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10125 -title [mc "Gitk: choose color for %s" $x]]
10126 if {$c eq {}} return
10127 $w conf -background $c
10128 lset $v $vi $c
10129 eval $cmd $c
10132 proc setselbg {c} {
10133 global bglist cflist
10134 foreach w $bglist {
10135 $w configure -selectbackground $c
10137 $cflist tag configure highlight \
10138 -background [$cflist cget -selectbackground]
10139 allcanvs itemconf secsel -fill $c
10142 proc setbg {c} {
10143 global bglist
10145 foreach w $bglist {
10146 $w conf -background $c
10150 proc setfg {c} {
10151 global fglist canv
10153 foreach w $fglist {
10154 $w conf -foreground $c
10156 allcanvs itemconf text -fill $c
10157 $canv itemconf circle -outline $c
10160 proc prefscan {} {
10161 global oldprefs prefstop
10163 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10164 limitdiffs tabstop perfile_attrs} {
10165 global $v
10166 set $v $oldprefs($v)
10168 catch {destroy $prefstop}
10169 unset prefstop
10170 fontcan
10173 proc prefsok {} {
10174 global maxwidth maxgraphpct
10175 global oldprefs prefstop showneartags showlocalchanges
10176 global fontpref mainfont textfont uifont
10177 global limitdiffs treediffs perfile_attrs
10179 catch {destroy $prefstop}
10180 unset prefstop
10181 fontcan
10182 set fontchanged 0
10183 if {$mainfont ne $fontpref(mainfont)} {
10184 set mainfont $fontpref(mainfont)
10185 parsefont mainfont $mainfont
10186 eval font configure mainfont [fontflags mainfont]
10187 eval font configure mainfontbold [fontflags mainfont 1]
10188 setcoords
10189 set fontchanged 1
10191 if {$textfont ne $fontpref(textfont)} {
10192 set textfont $fontpref(textfont)
10193 parsefont textfont $textfont
10194 eval font configure textfont [fontflags textfont]
10195 eval font configure textfontbold [fontflags textfont 1]
10197 if {$uifont ne $fontpref(uifont)} {
10198 set uifont $fontpref(uifont)
10199 parsefont uifont $uifont
10200 eval font configure uifont [fontflags uifont]
10202 settabs
10203 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10204 if {$showlocalchanges} {
10205 doshowlocalchanges
10206 } else {
10207 dohidelocalchanges
10210 if {$limitdiffs != $oldprefs(limitdiffs) ||
10211 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10212 # treediffs elements are limited by path;
10213 # won't have encodings cached if perfile_attrs was just turned on
10214 catch {unset treediffs}
10216 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10217 || $maxgraphpct != $oldprefs(maxgraphpct)} {
10218 redisplay
10219 } elseif {$showneartags != $oldprefs(showneartags) ||
10220 $limitdiffs != $oldprefs(limitdiffs)} {
10221 reselectline
10225 proc formatdate {d} {
10226 global datetimeformat
10227 if {$d ne {}} {
10228 set d [clock format $d -format $datetimeformat]
10230 return $d
10233 # This list of encoding names and aliases is distilled from
10234 # http://www.iana.org/assignments/character-sets.
10235 # Not all of them are supported by Tcl.
10236 set encoding_aliases {
10237 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10238 ISO646-US US-ASCII us IBM367 cp367 csASCII }
10239 { ISO-10646-UTF-1 csISO10646UTF1 }
10240 { ISO_646.basic:1983 ref csISO646basic1983 }
10241 { INVARIANT csINVARIANT }
10242 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10243 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10244 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10245 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10246 { NATS-DANO iso-ir-9-1 csNATSDANO }
10247 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10248 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10249 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10250 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10251 { ISO-2022-KR csISO2022KR }
10252 { EUC-KR csEUCKR }
10253 { ISO-2022-JP csISO2022JP }
10254 { ISO-2022-JP-2 csISO2022JP2 }
10255 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10256 csISO13JISC6220jp }
10257 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10258 { IT iso-ir-15 ISO646-IT csISO15Italian }
10259 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10260 { ES iso-ir-17 ISO646-ES csISO17Spanish }
10261 { greek7-old iso-ir-18 csISO18Greek7Old }
10262 { latin-greek iso-ir-19 csISO19LatinGreek }
10263 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10264 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10265 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10266 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10267 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10268 { BS_viewdata iso-ir-47 csISO47BSViewdata }
10269 { INIS iso-ir-49 csISO49INIS }
10270 { INIS-8 iso-ir-50 csISO50INIS8 }
10271 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10272 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10273 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10274 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10275 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10276 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10277 csISO60Norwegian1 }
10278 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10279 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10280 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10281 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10282 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10283 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10284 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10285 { greek7 iso-ir-88 csISO88Greek7 }
10286 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10287 { iso-ir-90 csISO90 }
10288 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10289 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10290 csISO92JISC62991984b }
10291 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10292 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10293 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10294 csISO95JIS62291984handadd }
10295 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10296 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10297 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10298 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10299 CP819 csISOLatin1 }
10300 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10301 { T.61-7bit iso-ir-102 csISO102T617bit }
10302 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10303 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10304 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10305 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10306 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10307 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10308 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10309 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10310 arabic csISOLatinArabic }
10311 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10312 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10313 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10314 greek greek8 csISOLatinGreek }
10315 { T.101-G2 iso-ir-128 csISO128T101G2 }
10316 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10317 csISOLatinHebrew }
10318 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10319 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10320 { CSN_369103 iso-ir-139 csISO139CSN369103 }
10321 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10322 { ISO_6937-2-add iso-ir-142 csISOTextComm }
10323 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10324 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10325 csISOLatinCyrillic }
10326 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10327 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10328 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10329 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10330 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10331 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10332 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10333 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10334 { ISO_10367-box iso-ir-155 csISO10367Box }
10335 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10336 { latin-lap lap iso-ir-158 csISO158Lap }
10337 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10338 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10339 { us-dk csUSDK }
10340 { dk-us csDKUS }
10341 { JIS_X0201 X0201 csHalfWidthKatakana }
10342 { KSC5636 ISO646-KR csKSC5636 }
10343 { ISO-10646-UCS-2 csUnicode }
10344 { ISO-10646-UCS-4 csUCS4 }
10345 { DEC-MCS dec csDECMCS }
10346 { hp-roman8 roman8 r8 csHPRoman8 }
10347 { macintosh mac csMacintosh }
10348 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10349 csIBM037 }
10350 { IBM038 EBCDIC-INT cp038 csIBM038 }
10351 { IBM273 CP273 csIBM273 }
10352 { IBM274 EBCDIC-BE CP274 csIBM274 }
10353 { IBM275 EBCDIC-BR cp275 csIBM275 }
10354 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10355 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10356 { IBM280 CP280 ebcdic-cp-it csIBM280 }
10357 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10358 { IBM284 CP284 ebcdic-cp-es csIBM284 }
10359 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10360 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10361 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10362 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10363 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10364 { IBM424 cp424 ebcdic-cp-he csIBM424 }
10365 { IBM437 cp437 437 csPC8CodePage437 }
10366 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10367 { IBM775 cp775 csPC775Baltic }
10368 { IBM850 cp850 850 csPC850Multilingual }
10369 { IBM851 cp851 851 csIBM851 }
10370 { IBM852 cp852 852 csPCp852 }
10371 { IBM855 cp855 855 csIBM855 }
10372 { IBM857 cp857 857 csIBM857 }
10373 { IBM860 cp860 860 csIBM860 }
10374 { IBM861 cp861 861 cp-is csIBM861 }
10375 { IBM862 cp862 862 csPC862LatinHebrew }
10376 { IBM863 cp863 863 csIBM863 }
10377 { IBM864 cp864 csIBM864 }
10378 { IBM865 cp865 865 csIBM865 }
10379 { IBM866 cp866 866 csIBM866 }
10380 { IBM868 CP868 cp-ar csIBM868 }
10381 { IBM869 cp869 869 cp-gr csIBM869 }
10382 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10383 { IBM871 CP871 ebcdic-cp-is csIBM871 }
10384 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10385 { IBM891 cp891 csIBM891 }
10386 { IBM903 cp903 csIBM903 }
10387 { IBM904 cp904 904 csIBBM904 }
10388 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10389 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10390 { IBM1026 CP1026 csIBM1026 }
10391 { EBCDIC-AT-DE csIBMEBCDICATDE }
10392 { EBCDIC-AT-DE-A csEBCDICATDEA }
10393 { EBCDIC-CA-FR csEBCDICCAFR }
10394 { EBCDIC-DK-NO csEBCDICDKNO }
10395 { EBCDIC-DK-NO-A csEBCDICDKNOA }
10396 { EBCDIC-FI-SE csEBCDICFISE }
10397 { EBCDIC-FI-SE-A csEBCDICFISEA }
10398 { EBCDIC-FR csEBCDICFR }
10399 { EBCDIC-IT csEBCDICIT }
10400 { EBCDIC-PT csEBCDICPT }
10401 { EBCDIC-ES csEBCDICES }
10402 { EBCDIC-ES-A csEBCDICESA }
10403 { EBCDIC-ES-S csEBCDICESS }
10404 { EBCDIC-UK csEBCDICUK }
10405 { EBCDIC-US csEBCDICUS }
10406 { UNKNOWN-8BIT csUnknown8BiT }
10407 { MNEMONIC csMnemonic }
10408 { MNEM csMnem }
10409 { VISCII csVISCII }
10410 { VIQR csVIQR }
10411 { KOI8-R csKOI8R }
10412 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10413 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10414 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10415 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10416 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10417 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10418 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10419 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10420 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10421 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10422 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10423 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10424 { IBM1047 IBM-1047 }
10425 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10426 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10427 { UNICODE-1-1 csUnicode11 }
10428 { CESU-8 csCESU-8 }
10429 { BOCU-1 csBOCU-1 }
10430 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10431 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10432 l8 }
10433 { ISO-8859-15 ISO_8859-15 Latin-9 }
10434 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10435 { GBK CP936 MS936 windows-936 }
10436 { JIS_Encoding csJISEncoding }
10437 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10438 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10439 EUC-JP }
10440 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10441 { ISO-10646-UCS-Basic csUnicodeASCII }
10442 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10443 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10444 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10445 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10446 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10447 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10448 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10449 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10450 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10451 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10452 { Adobe-Standard-Encoding csAdobeStandardEncoding }
10453 { Ventura-US csVenturaUS }
10454 { Ventura-International csVenturaInternational }
10455 { PC8-Danish-Norwegian csPC8DanishNorwegian }
10456 { PC8-Turkish csPC8Turkish }
10457 { IBM-Symbols csIBMSymbols }
10458 { IBM-Thai csIBMThai }
10459 { HP-Legal csHPLegal }
10460 { HP-Pi-font csHPPiFont }
10461 { HP-Math8 csHPMath8 }
10462 { Adobe-Symbol-Encoding csHPPSMath }
10463 { HP-DeskTop csHPDesktop }
10464 { Ventura-Math csVenturaMath }
10465 { Microsoft-Publishing csMicrosoftPublishing }
10466 { Windows-31J csWindows31J }
10467 { GB2312 csGB2312 }
10468 { Big5 csBig5 }
10471 proc tcl_encoding {enc} {
10472 global encoding_aliases tcl_encoding_cache
10473 if {[info exists tcl_encoding_cache($enc)]} {
10474 return $tcl_encoding_cache($enc)
10476 set names [encoding names]
10477 set lcnames [string tolower $names]
10478 set enc [string tolower $enc]
10479 set i [lsearch -exact $lcnames $enc]
10480 if {$i < 0} {
10481 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10482 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10483 set i [lsearch -exact $lcnames $encx]
10486 if {$i < 0} {
10487 foreach l $encoding_aliases {
10488 set ll [string tolower $l]
10489 if {[lsearch -exact $ll $enc] < 0} continue
10490 # look through the aliases for one that tcl knows about
10491 foreach e $ll {
10492 set i [lsearch -exact $lcnames $e]
10493 if {$i < 0} {
10494 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10495 set i [lsearch -exact $lcnames $ex]
10498 if {$i >= 0} break
10500 break
10503 set tclenc {}
10504 if {$i >= 0} {
10505 set tclenc [lindex $names $i]
10507 set tcl_encoding_cache($enc) $tclenc
10508 return $tclenc
10511 proc gitattr {path attr default} {
10512 global path_attr_cache
10513 if {[info exists path_attr_cache($attr,$path)]} {
10514 set r $path_attr_cache($attr,$path)
10515 } else {
10516 set r "unspecified"
10517 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10518 regexp "(.*): encoding: (.*)" $line m f r
10520 set path_attr_cache($attr,$path) $r
10522 if {$r eq "unspecified"} {
10523 return $default
10525 return $r
10528 proc cache_gitattr {attr pathlist} {
10529 global path_attr_cache
10530 set newlist {}
10531 foreach path $pathlist {
10532 if {![info exists path_attr_cache($attr,$path)]} {
10533 lappend newlist $path
10536 set lim 1000
10537 if {[tk windowingsystem] == "win32"} {
10538 # windows has a 32k limit on the arguments to a command...
10539 set lim 30
10541 while {$newlist ne {}} {
10542 set head [lrange $newlist 0 [expr {$lim - 1}]]
10543 set newlist [lrange $newlist $lim end]
10544 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10545 foreach row [split $rlist "\n"] {
10546 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10547 if {[string index $path 0] eq "\""} {
10548 set path [encoding convertfrom [lindex $path 0]]
10550 set path_attr_cache($attr,$path) $value
10557 proc get_path_encoding {path} {
10558 global gui_encoding perfile_attrs
10559 set tcl_enc $gui_encoding
10560 if {$path ne {} && $perfile_attrs} {
10561 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10562 if {$enc2 ne {}} {
10563 set tcl_enc $enc2
10566 return $tcl_enc
10569 # First check that Tcl/Tk is recent enough
10570 if {[catch {package require Tk 8.4} err]} {
10571 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10572 Gitk requires at least Tcl/Tk 8.4."]
10573 exit 1
10576 # defaults...
10577 set wrcomcmd "git diff-tree --stdin -p --pretty"
10579 set gitencoding {}
10580 catch {
10581 set gitencoding [exec git config --get i18n.commitencoding]
10583 catch {
10584 set gitencoding [exec git config --get i18n.logoutputencoding]
10586 if {$gitencoding == ""} {
10587 set gitencoding "utf-8"
10589 set tclencoding [tcl_encoding $gitencoding]
10590 if {$tclencoding == {}} {
10591 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10594 set gui_encoding [encoding system]
10595 catch {
10596 set enc [exec git config --get gui.encoding]
10597 if {$enc ne {}} {
10598 set tclenc [tcl_encoding $enc]
10599 if {$tclenc ne {}} {
10600 set gui_encoding $tclenc
10601 } else {
10602 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10607 set mainfont {Helvetica 9}
10608 set textfont {Courier 9}
10609 set uifont {Helvetica 9 bold}
10610 set tabstop 8
10611 set findmergefiles 0
10612 set maxgraphpct 50
10613 set maxwidth 16
10614 set revlistorder 0
10615 set fastdate 0
10616 set uparrowlen 5
10617 set downarrowlen 5
10618 set mingaplen 100
10619 set cmitmode "patch"
10620 set wrapcomment "none"
10621 set showneartags 1
10622 set maxrefs 20
10623 set maxlinelen 200
10624 set showlocalchanges 1
10625 set limitdiffs 1
10626 set datetimeformat "%Y-%m-%d %H:%M:%S"
10627 set autoselect 1
10628 set perfile_attrs 0
10630 set extdifftool "meld"
10632 set colors {green red blue magenta darkgrey brown orange}
10633 set bgcolor white
10634 set fgcolor black
10635 set diffcolors {red "#00a000" blue}
10636 set diffcontext 3
10637 set ignorespace 0
10638 set selectbgcolor gray85
10639 set markbgcolor "#e0e0ff"
10641 set circlecolors {white blue gray blue blue}
10643 # button for popping up context menus
10644 if {[tk windowingsystem] eq "aqua"} {
10645 set ctxbut <Button-2>
10646 } else {
10647 set ctxbut <Button-3>
10650 ## For msgcat loading, first locate the installation location.
10651 if { [info exists ::env(GITK_MSGSDIR)] } {
10652 ## Msgsdir was manually set in the environment.
10653 set gitk_msgsdir $::env(GITK_MSGSDIR)
10654 } else {
10655 ## Let's guess the prefix from argv0.
10656 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10657 set gitk_libdir [file join $gitk_prefix share gitk lib]
10658 set gitk_msgsdir [file join $gitk_libdir msgs]
10659 unset gitk_prefix
10662 ## Internationalization (i18n) through msgcat and gettext. See
10663 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10664 package require msgcat
10665 namespace import ::msgcat::mc
10666 ## And eventually load the actual message catalog
10667 ::msgcat::mcload $gitk_msgsdir
10669 catch {source ~/.gitk}
10671 font create optionfont -family sans-serif -size -12
10673 parsefont mainfont $mainfont
10674 eval font create mainfont [fontflags mainfont]
10675 eval font create mainfontbold [fontflags mainfont 1]
10677 parsefont textfont $textfont
10678 eval font create textfont [fontflags textfont]
10679 eval font create textfontbold [fontflags textfont 1]
10681 parsefont uifont $uifont
10682 eval font create uifont [fontflags uifont]
10684 setoptions
10686 # check that we can find a .git directory somewhere...
10687 if {[catch {set gitdir [gitdir]}]} {
10688 show_error {} . [mc "Cannot find a git repository here."]
10689 exit 1
10691 if {![file isdirectory $gitdir]} {
10692 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10693 exit 1
10696 set selecthead {}
10697 set selectheadid {}
10699 set revtreeargs {}
10700 set cmdline_files {}
10701 set i 0
10702 set revtreeargscmd {}
10703 foreach arg $argv {
10704 switch -glob -- $arg {
10705 "" { }
10706 "--" {
10707 set cmdline_files [lrange $argv [expr {$i + 1}] end]
10708 break
10710 "--select-commit=*" {
10711 set selecthead [string range $arg 16 end]
10713 "--argscmd=*" {
10714 set revtreeargscmd [string range $arg 10 end]
10716 default {
10717 lappend revtreeargs $arg
10720 incr i
10723 if {$selecthead eq "HEAD"} {
10724 set selecthead {}
10727 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10728 # no -- on command line, but some arguments (other than --argscmd)
10729 if {[catch {
10730 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10731 set cmdline_files [split $f "\n"]
10732 set n [llength $cmdline_files]
10733 set revtreeargs [lrange $revtreeargs 0 end-$n]
10734 # Unfortunately git rev-parse doesn't produce an error when
10735 # something is both a revision and a filename. To be consistent
10736 # with git log and git rev-list, check revtreeargs for filenames.
10737 foreach arg $revtreeargs {
10738 if {[file exists $arg]} {
10739 show_error {} . [mc "Ambiguous argument '%s': both revision\
10740 and filename" $arg]
10741 exit 1
10744 } err]} {
10745 # unfortunately we get both stdout and stderr in $err,
10746 # so look for "fatal:".
10747 set i [string first "fatal:" $err]
10748 if {$i > 0} {
10749 set err [string range $err [expr {$i + 6}] end]
10751 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10752 exit 1
10756 set nullid "0000000000000000000000000000000000000000"
10757 set nullid2 "0000000000000000000000000000000000000001"
10758 set nullfile "/dev/null"
10760 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10762 set runq {}
10763 set history {}
10764 set historyindex 0
10765 set fh_serial 0
10766 set nhl_names {}
10767 set highlight_paths {}
10768 set findpattern {}
10769 set searchdirn -forwards
10770 set boldrows {}
10771 set boldnamerows {}
10772 set diffelide {0 0}
10773 set markingmatches 0
10774 set linkentercount 0
10775 set need_redisplay 0
10776 set nrows_drawn 0
10777 set firsttabstop 0
10779 set nextviewnum 1
10780 set curview 0
10781 set selectedview 0
10782 set selectedhlview [mc "None"]
10783 set highlight_related [mc "None"]
10784 set highlight_files {}
10785 set viewfiles(0) {}
10786 set viewperm(0) 0
10787 set viewargs(0) {}
10788 set viewargscmd(0) {}
10790 set selectedline {}
10791 set numcommits 0
10792 set loginstance 0
10793 set cmdlineok 0
10794 set stopped 0
10795 set stuffsaved 0
10796 set patchnum 0
10797 set lserial 0
10798 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10799 setcoords
10800 makewindow
10801 # wait for the window to become visible
10802 tkwait visibility .
10803 wm title . "[file tail $argv0]: [file tail [pwd]]"
10804 readrefs
10806 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10807 # create a view for the files/dirs specified on the command line
10808 set curview 1
10809 set selectedview 1
10810 set nextviewnum 2
10811 set viewname(1) [mc "Command line"]
10812 set viewfiles(1) $cmdline_files
10813 set viewargs(1) $revtreeargs
10814 set viewargscmd(1) $revtreeargscmd
10815 set viewperm(1) 0
10816 set vdatemode(1) 0
10817 addviewmenu 1
10818 .bar.view entryconf [mca "Edit view..."] -state normal
10819 .bar.view entryconf [mca "Delete view"] -state normal
10822 if {[info exists permviews]} {
10823 foreach v $permviews {
10824 set n $nextviewnum
10825 incr nextviewnum
10826 set viewname($n) [lindex $v 0]
10827 set viewfiles($n) [lindex $v 1]
10828 set viewargs($n) [lindex $v 2]
10829 set viewargscmd($n) [lindex $v 3]
10830 set viewperm($n) 1
10831 addviewmenu $n
10834 getcommits {}