1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
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.
9
10proc 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]
16 }
17}
18
19# A simple scheduler for compute-intensive stuff.
20# The aim is to make sure that event handlers for GUI actions can
21# run at least every 50-100 ms. Unfortunately fileevent handlers are
22# run before X event handlers, so reading from a fast source can
23# make the GUI completely unresponsive.
24proc run args {
25 global isonrunq runq currunq
26
27 set script $args
28 if {[info exists isonrunq($script)]} return
29 if {$runq eq {} && ![info exists currunq]} {
30 after idle dorunq
31 }
32 lappend runq [list {} $script]
33 set isonrunq($script) 1
34}
35
36proc filerun {fd script} {
37 fileevent $fd readable [list filereadable $fd $script]
38}
39
40proc filereadable {fd script} {
41 global runq currunq
42
43 fileevent $fd readable {}
44 if {$runq eq {} && ![info exists currunq]} {
45 after idle dorunq
46 }
47 lappend runq [list $fd $script]
48}
49
50proc nukefile {fd} {
51 global runq
52
53 for {set i 0} {$i < [llength $runq]} {} {
54 if {[lindex $runq $i 0] eq $fd} {
55 set runq [lreplace $runq $i $i]
56 } else {
57 incr i
58 }
59 }
60}
61
62proc dorunq {} {
63 global isonrunq runq currunq
64
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]
83 }
84 } elseif {$fd eq {}} {
85 unset isonrunq($script)
86 }
87 set t0 $t1
88 if {$t1 - $tstart >= 80} break
89 }
90 if {$runq ne {}} {
91 after idle dorunq
92 }
93}
94
95proc reg_instance {fd} {
96 global commfd leftover loginstance
97
98 set i [incr loginstance]
99 set commfd($i) $fd
100 set leftover($i) {}
101 return $i
102}
103
104proc unmerged_files {files} {
105 global nr_unmerged
106
107 # find the list of unmerged files
108 set mlist {}
109 set nr_unmerged 0
110 if {[catch {
111 set fd [open "| git ls-files -u" r]
112 } err]} {
113 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
114 exit 1
115 }
116 while {[gets $fd line] >= 0} {
117 set i [string first "\t" $line]
118 if {$i < 0} continue
119 set fname [string range $line [expr {$i+1}] end]
120 if {[lsearch -exact $mlist $fname] >= 0} continue
121 incr nr_unmerged
122 if {$files eq {} || [path_filter $files $fname]} {
123 lappend mlist $fname
124 }
125 }
126 catch {close $fd}
127 return $mlist
128}
129
130proc parseviewargs {n arglist} {
131 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
132
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
149 }
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
157 }
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
167 }
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" {
177 }
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
184 }
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
194 }
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
201 }
202 "--not" {
203 set notflag [expr {!$notflag}]
204 lappend revargs $arg
205 }
206 "--all" {
207 lappend revargs $arg
208 }
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
213 }
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
222 }
223 lappend glflags $arg
224 }
225 # Non-flag arguments specify commits or ranges of commits
226 default {
227 if {[string match "*...*" $arg]} {
228 lappend revargs --gitk-symmetric-diff-marker
229 }
230 lappend revargs $arg
231 }
232 }
233 }
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
240}
241
242proc parseviewrevs {view revs} {
243 global vposids vnegids
244
245 if {$revs eq {}} {
246 set revs HEAD
247 }
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 ", "]"
263 }
264 } else {
265 set err [join [lrange $errlines $l end] "\n"]
266 }
267 break
268 }
269 lappend badrev $line
270 }
271 }
272 error_popup "[mc "Error parsing revisions:"] $err"
273 return {}
274 }
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
287 }
288 }
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
295 }
296 lappend pos $id
297 }
298 incr sdm -1
299 }
300 set vposids($view) $pos
301 set vnegids($view) $neg
302 return $ret
303}
304
305# Start off a git log process and arrange to read its output
306proc start_rev_list {view} {
307 global startmsecs commitidx viewcomplete curview
308 global tclencoding
309 global viewargs viewargscmd viewfiles vfilelimit
310 global showlocalchanges commitinterest
311 global viewactive viewinstances vmergeonly
312 global mainheadid
313 global vcanopt vflags vrevs vorigargs
314
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
321
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
329 }
330 set args [concat $args [split $str "\n"]]
331 }
332 set vcanopt($view) [parseviewargs $view $args]
333
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."]
345 }
346 return 0
347 }
348 }
349 set vfilelimit($view) $files
350
351 if {$vcanopt($view)} {
352 set revs [parseviewrevs $view $vrevs($view)]
353 if {$revs eq {}} {
354 return 0
355 }
356 set args [concat $vflags($view) $revs]
357 } else {
358 set args $vorigargs($view)
359 }
360
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
367 }
368 set i [reg_instance $fd]
369 set viewinstances($view) [list $i]
370 if {$showlocalchanges && $mainheadid ne {}} {
371 lappend commitinterest($mainheadid) {dodiffindex}
372 }
373 fconfigure $fd -blocking 0 -translation lf -eofchar {}
374 if {$tclencoding != {}} {
375 fconfigure $fd -encoding $tclencoding
376 }
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
382}
383
384proc stop_instance {inst} {
385 global commfd leftover
386
387 set fd $commfd($inst)
388 catch {
389 set pid [pid $fd]
390
391 if {$::tcl_platform(platform) eq {windows}} {
392 exec kill -f $pid
393 } else {
394 exec kill $pid
395 }
396 }
397 catch {close $fd}
398 nukefile $fd
399 unset commfd($inst)
400 unset leftover($inst)
401}
402
403proc stop_backends {} {
404 global commfd
405
406 foreach inst [array names commfd] {
407 stop_instance $inst
408 }
409}
410
411proc stop_rev_list {view} {
412 global viewinstances
413
414 foreach inst $viewinstances($view) {
415 stop_instance $inst
416 }
417 set viewinstances($view) {}
418}
419
420proc reset_pending_select {selid} {
421 global pending_select mainheadid selectheadid
422
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
429 }
430}
431
432proc getcommits {selid} {
433 global canv curview need_redisplay viewactive
434
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"]
442 }
443}
444
445proc 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
452
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
459 }
460 if {[commitinview $mainheadid $curview]} {
461 dodiffindex
462 }
463 }
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
471 }
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
486 }
487 } else {
488 lappend $newrevs $rev
489 }
490 }
491 if {$npos == 0} return
492 set revs $newrevs
493 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
494 }
495 set args [concat $vflags($view) $revs --not $oldpos]
496 } else {
497 set args $vorigargs($view)
498 }
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
505 }
506 if {$viewactive($view) == 0} {
507 set startmsecs [clock clicks -milliseconds]
508 }
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
514 }
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
522 }
523}
524
525proc reloadcommits {} {
526 global curview viewcomplete selectedline currentid thickerline
527 global showneartags treediffs commitinterest cached_commitrow
528 global targetid
529
530 set selid {}
531 if {$selectedline ne {}} {
532 set selid $currentid
533 }
534
535 if {!$viewcomplete($curview)} {
536 stop_rev_list $curview
537 }
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
547 }
548 clear_display
549 catch {unset commitinterest}
550 catch {unset cached_commitrow}
551 catch {unset targetid}
552 setcanvscroll
553 getcommits $selid
554 return 0
555}
556
557# This makes a string representation of a positive integer which
558# sorts as a string in numerical order
559proc 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]
566 }
567 return [format "z%.8x" $n]
568}
569
570# Procedures used in reordering commits from git log (without
571# --topo-order) into the order for display.
572
573proc varcinit {view} {
574 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
575 global vtokmod varcmod vrowmod varcix vlastins
576
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}
589}
590
591proc resetvarcs {view} {
592 global varcid varccommits parents children vseedcount ordertok
593
594 foreach vid [array names varcid $view,*] {
595 unset varcid($vid)
596 unset children($vid)
597 unset parents($vid)
598 }
599 # some commits might have children but haven't been seen yet
600 foreach vid [array names children $view,*] {
601 unset children($vid)
602 }
603 foreach va [array names varccommits $view,*] {
604 unset varccommits($va)
605 }
606 foreach vd [array names vseedcount $view,*] {
607 unset vseedcount($vd)
608 }
609 catch {unset ordertok}
610}
611
612# returns a list of the commits with no children
613proc seeds {v} {
614 global vdownptr vleftptr varcstart
615
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]
621 }
622 return $ret
623}
624
625proc 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
629
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
635 }
636 set cdate [lindex $commitinfo($id) 4]
637 if {![string is integer -strict $cdate]} {
638 set cdate 0
639 }
640 if {![info exists vseedcount($view,$cdate)]} {
641 set vseedcount($view,$cdate) -1
642 }
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 {}
648 }
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]
657 }
658 }
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]
663 }
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]
670 }
671 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
672 set c $b
673 set b [lindex $vleftptr($view) $c]
674 }
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
681 }
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
687 }
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
696}
697
698proc splitvarc {p v} {
699 global varcid varcstart varccommits varctok
700 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
701
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
717 }
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
727 }
728}
729
730proc renumbervarc {a v} {
731 global parents children varctok varcstart varccommits
732 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
733
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
746 }
747 }
748 }
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]
756 }
757 }
758 set a $b
759 }
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)]
766 }
767 set oldtok [lindex $varctok($v) $a]
768 if {!$vdatemode($v)} {
769 set tok {}
770 } else {
771 set tok $oldtok
772 }
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]
781 }
782 }
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]
787 }
788 if {$tok eq $oldtok} {
789 continue
790 }
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
797 }
798 }
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
804 }
805 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
806 modify_arc $v $b
807 }
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
814 }
815 if {$d != 0} {
816 lset vbackptr($v) $d $c
817 }
818 if {[lindex $vlastins($v) $b] == $a} {
819 lset vlastins($v) $b $c
820 }
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]
829 }
830 while {$b != 0 && \
831 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
832 set c $b
833 set b [lindex $vleftptr($v) $c]
834 }
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
841 }
842 lset vleftptr($v) $a $b
843 if {$b != 0} {
844 lset vbackptr($v) $b $a
845 }
846 lset vlastins($v) $ka $a
847 }
848 }
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)]
853 }
854 }
855 set t2 [clock clicks -milliseconds]
856 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
857}
858
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.
862proc fix_reversal {p a v} {
863 global varcid varcstart varctok vupptr
864
865 set pa $varcid($v,$p)
866 if {$p ne [lindex $varcstart($v) $pa]} {
867 splitvarc $p $v
868 set pa $varcid($v,$p)
869 }
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
875 }
876}
877
878proc insertrow {id p v} {
879 global cmitlisted children parents varcid varctok vtokmod
880 global varccommits ordertok commitidx numcommits curview
881 global targetid targetrow
882
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
892 }
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}
898 }
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
907 }
908 }
909 }
910}
911
912proc insertfakerow {id p} {
913 global varcid varccommits parents children cmitlisted
914 global commitidx varctok vtokmod targetid targetrow curview numcommits
915
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
922 }
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
935 }
936 }
937 setcanvscroll
938 drawvisible
939}
940
941proc removefakerow {id} {
942 global varcid varccommits parents children commitidx
943 global varctok vtokmod cmitlisted currentid selectedline
944 global targetid curview numcommits
945
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
950 }
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
957 }
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]
967 }
968 modify_arc $v $a $i
969 if {[info exist currentid] && $id eq $currentid} {
970 unset currentid
971 set selectedline {}
972 }
973 if {[info exists targetid] && $targetid eq $id} {
974 set targetid $p
975 }
976 setcanvscroll
977 drawvisible
978}
979
980proc first_real_child {vp} {
981 global children nullid nullid2
982
983 foreach id $children($vp) {
984 if {$id ne $nullid && $id ne $nullid2} {
985 return $id
986 }
987 }
988 return {}
989}
990
991proc last_real_child {vp} {
992 global children nullid nullid2
993
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
999 }
1000 }
1001 return {}
1002}
1003
1004proc vtokcmp {v a b} {
1005 global varctok varcid
1006
1007 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1008 [lindex $varctok($v) $varcid($v,$b)]]
1009}
1010
1011# This assumes that if lim is not given, the caller has checked that
1012# arc a's token is less than $vtokmod($v)
1013proc modify_arc {v a {lim {}}} {
1014 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1015
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
1022 }
1023 }
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 {}
1030 }
1031 set r 0
1032 if {$a != 0} {
1033 if {$lim eq {}} {
1034 set lim [llength $varccommits($v,$a)]
1035 }
1036 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1037 }
1038 set vrowmod($v) $r
1039 undolayout $r
1040 }
1041}
1042
1043proc 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
1048
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}]]
1054 }
1055 catch {unset cached_commitrow}
1056 }
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]
1063 }
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]
1078 }
1079 set row [lindex $varcrow($v) $a]
1080 }
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]
1092 }
1093 if {$a == 0} break
1094 }
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
1101 }
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]
1107 }
1108}
1109
1110# Test whether view $v contains commit $id
1111proc commitinview {id v} {
1112 global varcid
1113
1114 return [info exists varcid($v,$id)]
1115}
1116
1117# Return the row number for commit $id in the current view
1118proc rowofcommit {id} {
1119 global varcid varccommits varcrow curview cached_commitrow
1120 global varctok vtokmod
1121
1122 set v $curview
1123 if {![info exists varcid($v,$id)]} {
1124 puts "oops rowofcommit no arc for [shortids $id]"
1125 return {}
1126 }
1127 set a $varcid($v,$id)
1128 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1129 update_arcrows $v
1130 }
1131 if {[info exists cached_commitrow($id)]} {
1132 return $cached_commitrow($id)
1133 }
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 {}
1138 }
1139 incr i [lindex $varcrow($v) $a]
1140 set cached_commitrow($id) $i
1141 return $i
1142}
1143
1144# Returns 1 if a is on an earlier row than b, otherwise 0
1145proc comes_before {a b} {
1146 global varcid varctok curview
1147
1148 set v $curview
1149 if {$a eq $b || ![info exists varcid($v,$a)] || \
1150 ![info exists varcid($v,$b)]} {
1151 return 0
1152 }
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}]
1156 }
1157 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1158}
1159
1160proc bsearch {l elt} {
1161 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1162 return 0
1163 }
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
1175 }
1176 }
1177 return $lo
1178}
1179
1180# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1181proc 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
1185
1186 if {$end > $vrowmod($curview)} {
1187 update_arcrows $curview
1188 }
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}]]
1204 }
1205 foreach id $varccommits($curview,$a) {
1206 lappend displayorder $id
1207 lappend parentlist $parents($curview,$id)
1208 }
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
1215 }
1216 }
1217 incr r $al
1218 }
1219}
1220
1221proc commitonrow {row} {
1222 global displayorder
1223
1224 set id [lindex $displayorder $row]
1225 if {$id eq {}} {
1226 make_disporder $row [expr {$row + 1}]
1227 set id [lindex $displayorder $row]
1228 }
1229 return $id
1230}
1231
1232proc closevarcs {v} {
1233 global varctok varccommits varcid parents children
1234 global cmitlisted commitidx commitinterest vtokmod
1235
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]
1252 }
1253 set varcid($v,$p) $b
1254 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1255 modify_arc $v $b
1256 }
1257 lappend varccommits($v,$b) $p
1258 incr commitidx($v)
1259 if {[info exists commitinterest($p)]} {
1260 foreach script $commitinterest($p) {
1261 lappend scripts [string map [list "%I" $p] $script]
1262 }
1263 unset commitinterest($id)
1264 }
1265 }
1266 }
1267 if {$missing_parents > 0} {
1268 foreach s $scripts {
1269 eval $s
1270 }
1271 }
1272}
1273
1274# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1275# Assumes we already have an arc for $rwid.
1276proc rewrite_commit {v id rwid} {
1277 global children parents varcid varctok vtokmod varccommits
1278
1279 foreach ch $children($v,$id) {
1280 # make $rwid be $ch's parent in place of $id
1281 set i [lsearch -exact $parents($v,$ch) $id]
1282 if {$i < 0} {
1283 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1284 }
1285 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1286 # add $ch to $rwid's children and sort the list if necessary
1287 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1288 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1289 $children($v,$rwid)]
1290 }
1291 # fix the graph after joining $id to $rwid
1292 set a $varcid($v,$ch)
1293 fix_reversal $rwid $a $v
1294 # parentlist is wrong for the last element of arc $a
1295 # even if displayorder is right, hence the 3rd arg here
1296 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1297 }
1298}
1299
1300proc getcommitlines {fd inst view updating} {
1301 global cmitlisted commitinterest leftover
1302 global commitidx commitdata vdatemode
1303 global parents children curview hlview
1304 global idpending ordertok
1305 global varccommits varcid varctok vtokmod vfilelimit
1306
1307 set stuff [read $fd 500000]
1308 # git log doesn't terminate the last commit with a null...
1309 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1310 set stuff "\0"
1311 }
1312 if {$stuff == {}} {
1313 if {![eof $fd]} {
1314 return 1
1315 }
1316 global commfd viewcomplete viewactive viewname
1317 global viewinstances
1318 unset commfd($inst)
1319 set i [lsearch -exact $viewinstances($view) $inst]
1320 if {$i >= 0} {
1321 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1322 }
1323 # set it blocking so we wait for the process to terminate
1324 fconfigure $fd -blocking 1
1325 if {[catch {close $fd} err]} {
1326 set fv {}
1327 if {$view != $curview} {
1328 set fv " for the \"$viewname($view)\" view"
1329 }
1330 if {[string range $err 0 4] == "usage"} {
1331 set err "Gitk: error reading commits$fv:\
1332 bad arguments to git log."
1333 if {$viewname($view) eq "Command line"} {
1334 append err \
1335 " (Note: arguments to gitk are passed to git log\
1336 to allow selection of commits to be displayed.)"
1337 }
1338 } else {
1339 set err "Error reading commits$fv: $err"
1340 }
1341 error_popup $err
1342 }
1343 if {[incr viewactive($view) -1] <= 0} {
1344 set viewcomplete($view) 1
1345 # Check if we have seen any ids listed as parents that haven't
1346 # appeared in the list
1347 closevarcs $view
1348 notbusy $view
1349 }
1350 if {$view == $curview} {
1351 run chewcommits
1352 }
1353 return 0
1354 }
1355 set start 0
1356 set gotsome 0
1357 set scripts {}
1358 while 1 {
1359 set i [string first "\0" $stuff $start]
1360 if {$i < 0} {
1361 append leftover($inst) [string range $stuff $start end]
1362 break
1363 }
1364 if {$start == 0} {
1365 set cmit $leftover($inst)
1366 append cmit [string range $stuff 0 [expr {$i - 1}]]
1367 set leftover($inst) {}
1368 } else {
1369 set cmit [string range $stuff $start [expr {$i - 1}]]
1370 }
1371 set start [expr {$i + 1}]
1372 set j [string first "\n" $cmit]
1373 set ok 0
1374 set listed 1
1375 if {$j >= 0 && [string match "commit *" $cmit]} {
1376 set ids [string range $cmit 7 [expr {$j - 1}]]
1377 if {[string match {[-^<>]*} $ids]} {
1378 switch -- [string index $ids 0] {
1379 "-" {set listed 0}
1380 "^" {set listed 2}
1381 "<" {set listed 3}
1382 ">" {set listed 4}
1383 }
1384 set ids [string range $ids 1 end]
1385 }
1386 set ok 1
1387 foreach id $ids {
1388 if {[string length $id] != 40} {
1389 set ok 0
1390 break
1391 }
1392 }
1393 }
1394 if {!$ok} {
1395 set shortcmit $cmit
1396 if {[string length $shortcmit] > 80} {
1397 set shortcmit "[string range $shortcmit 0 80]..."
1398 }
1399 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1400 exit 1
1401 }
1402 set id [lindex $ids 0]
1403 set vid $view,$id
1404
1405 if {!$listed && $updating && ![info exists varcid($vid)] &&
1406 $vfilelimit($view) ne {}} {
1407 # git log doesn't rewrite parents for unlisted commits
1408 # when doing path limiting, so work around that here
1409 # by working out the rewritten parent with git rev-list
1410 # and if we already know about it, using the rewritten
1411 # parent as a substitute parent for $id's children.
1412 if {![catch {
1413 set rwid [exec git rev-list --first-parent --max-count=1 \
1414 $id -- $vfilelimit($view)]
1415 }]} {
1416 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1417 # use $rwid in place of $id
1418 rewrite_commit $view $id $rwid
1419 continue
1420 }
1421 }
1422 }
1423
1424 set a 0
1425 if {[info exists varcid($vid)]} {
1426 if {$cmitlisted($vid) || !$listed} continue
1427 set a $varcid($vid)
1428 }
1429 if {$listed} {
1430 set olds [lrange $ids 1 end]
1431 } else {
1432 set olds {}
1433 }
1434 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1435 set cmitlisted($vid) $listed
1436 set parents($vid) $olds
1437 if {![info exists children($vid)]} {
1438 set children($vid) {}
1439 } elseif {$a == 0 && [llength $children($vid)] == 1} {
1440 set k [lindex $children($vid) 0]
1441 if {[llength $parents($view,$k)] == 1 &&
1442 (!$vdatemode($view) ||
1443 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1444 set a $varcid($view,$k)
1445 }
1446 }
1447 if {$a == 0} {
1448 # new arc
1449 set a [newvarc $view $id]
1450 }
1451 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1452 modify_arc $view $a
1453 }
1454 if {![info exists varcid($vid)]} {
1455 set varcid($vid) $a
1456 lappend varccommits($view,$a) $id
1457 incr commitidx($view)
1458 }
1459
1460 set i 0
1461 foreach p $olds {
1462 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1463 set vp $view,$p
1464 if {[llength [lappend children($vp) $id]] > 1 &&
1465 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1466 set children($vp) [lsort -command [list vtokcmp $view] \
1467 $children($vp)]
1468 catch {unset ordertok}
1469 }
1470 if {[info exists varcid($view,$p)]} {
1471 fix_reversal $p $a $view
1472 }
1473 }
1474 incr i
1475 }
1476
1477 if {[info exists commitinterest($id)]} {
1478 foreach script $commitinterest($id) {
1479 lappend scripts [string map [list "%I" $id] $script]
1480 }
1481 unset commitinterest($id)
1482 }
1483 set gotsome 1
1484 }
1485 if {$gotsome} {
1486 global numcommits hlview
1487
1488 if {$view == $curview} {
1489 set numcommits $commitidx($view)
1490 run chewcommits
1491 }
1492 if {[info exists hlview] && $view == $hlview} {
1493 # we never actually get here...
1494 run vhighlightmore
1495 }
1496 foreach s $scripts {
1497 eval $s
1498 }
1499 }
1500 return 2
1501}
1502
1503proc chewcommits {} {
1504 global curview hlview viewcomplete
1505 global pending_select
1506
1507 layoutmore
1508 if {$viewcomplete($curview)} {
1509 global commitidx varctok
1510 global numcommits startmsecs
1511
1512 if {[info exists pending_select]} {
1513 update
1514 reset_pending_select {}
1515
1516 if {[commitinview $pending_select $curview]} {
1517 selectline [rowofcommit $pending_select] 1
1518 } else {
1519 set row [first_real_row]
1520 selectline $row 1
1521 }
1522 }
1523 if {$commitidx($curview) > 0} {
1524 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1525 #puts "overall $ms ms for $numcommits commits"
1526 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1527 } else {
1528 show_status [mc "No commits selected"]
1529 }
1530 notbusy layout
1531 }
1532 return 0
1533}
1534
1535proc readcommit {id} {
1536 if {[catch {set contents [exec git cat-file commit $id]}]} return
1537 parsecommit $id $contents 0
1538}
1539
1540proc parsecommit {id contents listed} {
1541 global commitinfo cdate
1542
1543 set inhdr 1
1544 set comment {}
1545 set headline {}
1546 set auname {}
1547 set audate {}
1548 set comname {}
1549 set comdate {}
1550 set hdrend [string first "\n\n" $contents]
1551 if {$hdrend < 0} {
1552 # should never happen...
1553 set hdrend [string length $contents]
1554 }
1555 set header [string range $contents 0 [expr {$hdrend - 1}]]
1556 set comment [string range $contents [expr {$hdrend + 2}] end]
1557 foreach line [split $header "\n"] {
1558 set tag [lindex $line 0]
1559 if {$tag == "author"} {
1560 set audate [lindex $line end-1]
1561 set auname [lrange $line 1 end-2]
1562 } elseif {$tag == "committer"} {
1563 set comdate [lindex $line end-1]
1564 set comname [lrange $line 1 end-2]
1565 }
1566 }
1567 set headline {}
1568 # take the first non-blank line of the comment as the headline
1569 set headline [string trimleft $comment]
1570 set i [string first "\n" $headline]
1571 if {$i >= 0} {
1572 set headline [string range $headline 0 $i]
1573 }
1574 set headline [string trimright $headline]
1575 set i [string first "\r" $headline]
1576 if {$i >= 0} {
1577 set headline [string trimright [string range $headline 0 $i]]
1578 }
1579 if {!$listed} {
1580 # git log indents the comment by 4 spaces;
1581 # if we got this via git cat-file, add the indentation
1582 set newcomment {}
1583 foreach line [split $comment "\n"] {
1584 append newcomment " "
1585 append newcomment $line
1586 append newcomment "\n"
1587 }
1588 set comment $newcomment
1589 }
1590 if {$comdate != {}} {
1591 set cdate($id) $comdate
1592 }
1593 set commitinfo($id) [list $headline $auname $audate \
1594 $comname $comdate $comment]
1595}
1596
1597proc getcommit {id} {
1598 global commitdata commitinfo
1599
1600 if {[info exists commitdata($id)]} {
1601 parsecommit $id $commitdata($id) 1
1602 } else {
1603 readcommit $id
1604 if {![info exists commitinfo($id)]} {
1605 set commitinfo($id) [list [mc "No commit information available"]]
1606 }
1607 }
1608 return 1
1609}
1610
1611proc readrefs {} {
1612 global tagids idtags headids idheads tagobjid
1613 global otherrefids idotherrefs mainhead mainheadid
1614 global selecthead selectheadid
1615
1616 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1617 catch {unset $v}
1618 }
1619 set refd [open [list | git show-ref -d] r]
1620 while {[gets $refd line] >= 0} {
1621 if {[string index $line 40] ne " "} continue
1622 set id [string range $line 0 39]
1623 set ref [string range $line 41 end]
1624 if {![string match "refs/*" $ref]} continue
1625 set name [string range $ref 5 end]
1626 if {[string match "remotes/*" $name]} {
1627 if {![string match "*/HEAD" $name]} {
1628 set headids($name) $id
1629 lappend idheads($id) $name
1630 }
1631 } elseif {[string match "heads/*" $name]} {
1632 set name [string range $name 6 end]
1633 set headids($name) $id
1634 lappend idheads($id) $name
1635 } elseif {[string match "tags/*" $name]} {
1636 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1637 # which is what we want since the former is the commit ID
1638 set name [string range $name 5 end]
1639 if {[string match "*^{}" $name]} {
1640 set name [string range $name 0 end-3]
1641 } else {
1642 set tagobjid($name) $id
1643 }
1644 set tagids($name) $id
1645 lappend idtags($id) $name
1646 } else {
1647 set otherrefids($name) $id
1648 lappend idotherrefs($id) $name
1649 }
1650 }
1651 catch {close $refd}
1652 set mainhead {}
1653 set mainheadid {}
1654 catch {
1655 set mainheadid [exec git rev-parse HEAD]
1656 set thehead [exec git symbolic-ref HEAD]
1657 if {[string match "refs/heads/*" $thehead]} {
1658 set mainhead [string range $thehead 11 end]
1659 }
1660 }
1661 set selectheadid {}
1662 if {$selecthead ne {}} {
1663 catch {
1664 set selectheadid [exec git rev-parse --verify $selecthead]
1665 }
1666 }
1667}
1668
1669# skip over fake commits
1670proc first_real_row {} {
1671 global nullid nullid2 numcommits
1672
1673 for {set row 0} {$row < $numcommits} {incr row} {
1674 set id [commitonrow $row]
1675 if {$id ne $nullid && $id ne $nullid2} {
1676 break
1677 }
1678 }
1679 return $row
1680}
1681
1682# update things for a head moved to a child of its previous location
1683proc movehead {id name} {
1684 global headids idheads
1685
1686 removehead $headids($name) $name
1687 set headids($name) $id
1688 lappend idheads($id) $name
1689}
1690
1691# update things when a head has been removed
1692proc removehead {id name} {
1693 global headids idheads
1694
1695 if {$idheads($id) eq $name} {
1696 unset idheads($id)
1697 } else {
1698 set i [lsearch -exact $idheads($id) $name]
1699 if {$i >= 0} {
1700 set idheads($id) [lreplace $idheads($id) $i $i]
1701 }
1702 }
1703 unset headids($name)
1704}
1705
1706proc show_error {w top msg} {
1707 message $w.m -text $msg -justify center -aspect 400
1708 pack $w.m -side top -fill x -padx 20 -pady 20
1709 button $w.ok -text [mc OK] -command "destroy $top"
1710 pack $w.ok -side bottom -fill x
1711 bind $top <Visibility> "grab $top; focus $top"
1712 bind $top <Key-Return> "destroy $top"
1713 tkwait window $top
1714}
1715
1716proc error_popup msg {
1717 set w .error
1718 toplevel $w
1719 wm transient $w .
1720 show_error $w $w $msg
1721}
1722
1723proc confirm_popup msg {
1724 global confirm_ok
1725 set confirm_ok 0
1726 set w .confirm
1727 toplevel $w
1728 wm transient $w .
1729 message $w.m -text $msg -justify center -aspect 400
1730 pack $w.m -side top -fill x -padx 20 -pady 20
1731 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1732 pack $w.ok -side left -fill x
1733 button $w.cancel -text [mc Cancel] -command "destroy $w"
1734 pack $w.cancel -side right -fill x
1735 bind $w <Visibility> "grab $w; focus $w"
1736 tkwait window $w
1737 return $confirm_ok
1738}
1739
1740proc setoptions {} {
1741 option add *Panedwindow.showHandle 1 startupFile
1742 option add *Panedwindow.sashRelief raised startupFile
1743 option add *Button.font uifont startupFile
1744 option add *Checkbutton.font uifont startupFile
1745 option add *Radiobutton.font uifont startupFile
1746 option add *Menu.font uifont startupFile
1747 option add *Menubutton.font uifont startupFile
1748 option add *Label.font uifont startupFile
1749 option add *Message.font uifont startupFile
1750 option add *Entry.font uifont startupFile
1751}
1752
1753proc makewindow {} {
1754 global canv canv2 canv3 linespc charspc ctext cflist cscroll
1755 global tabstop
1756 global findtype findtypemenu findloc findstring fstring geometry
1757 global entries sha1entry sha1string sha1but
1758 global diffcontextstring diffcontext
1759 global ignorespace
1760 global maincursor textcursor curtextcursor
1761 global rowctxmenu fakerowmenu mergemax wrapcomment
1762 global highlight_files gdttype
1763 global searchstring sstring
1764 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1765 global headctxmenu progresscanv progressitem progresscoords statusw
1766 global fprogitem fprogcoord lastprogupdate progupdatepending
1767 global rprogitem rprogcoord rownumsel numcommits
1768 global have_tk85
1769
1770 menu .bar
1771 .bar add cascade -label [mc "File"] -menu .bar.file
1772 menu .bar.file
1773 .bar.file add command -label [mc "Update"] -command updatecommits
1774 .bar.file add command -label [mc "Reload"] -command reloadcommits
1775 .bar.file add command -label [mc "Reread references"] -command rereadrefs
1776 .bar.file add command -label [mc "List references"] -command showrefs
1777 .bar.file add command -label [mc "Quit"] -command doquit
1778 menu .bar.edit
1779 .bar add cascade -label [mc "Edit"] -menu .bar.edit
1780 .bar.edit add command -label [mc "Preferences"] -command doprefs
1781
1782 menu .bar.view
1783 .bar add cascade -label [mc "View"] -menu .bar.view
1784 .bar.view add command -label [mc "New view..."] -command {newview 0}
1785 .bar.view add command -label [mc "Edit view..."] -command editview \
1786 -state disabled
1787 .bar.view add command -label [mc "Delete view"] -command delview -state disabled
1788 .bar.view add separator
1789 .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
1790 -variable selectedview -value 0
1791
1792 menu .bar.help
1793 .bar add cascade -label [mc "Help"] -menu .bar.help
1794 .bar.help add command -label [mc "About gitk"] -command about
1795 .bar.help add command -label [mc "Key bindings"] -command keys
1796 .bar.help configure
1797 . configure -menu .bar
1798
1799 # the gui has upper and lower half, parts of a paned window.
1800 panedwindow .ctop -orient vertical
1801
1802 # possibly use assumed geometry
1803 if {![info exists geometry(pwsash0)]} {
1804 set geometry(topheight) [expr {15 * $linespc}]
1805 set geometry(topwidth) [expr {80 * $charspc}]
1806 set geometry(botheight) [expr {15 * $linespc}]
1807 set geometry(botwidth) [expr {50 * $charspc}]
1808 set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1809 set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1810 }
1811
1812 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1813 frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1814 frame .tf.histframe
1815 panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1816
1817 # create three canvases
1818 set cscroll .tf.histframe.csb
1819 set canv .tf.histframe.pwclist.canv
1820 canvas $canv \
1821 -selectbackground $selectbgcolor \
1822 -background $bgcolor -bd 0 \
1823 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1824 .tf.histframe.pwclist add $canv
1825 set canv2 .tf.histframe.pwclist.canv2
1826 canvas $canv2 \
1827 -selectbackground $selectbgcolor \
1828 -background $bgcolor -bd 0 -yscrollincr $linespc
1829 .tf.histframe.pwclist add $canv2
1830 set canv3 .tf.histframe.pwclist.canv3
1831 canvas $canv3 \
1832 -selectbackground $selectbgcolor \
1833 -background $bgcolor -bd 0 -yscrollincr $linespc
1834 .tf.histframe.pwclist add $canv3
1835 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1836 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1837
1838 # a scroll bar to rule them
1839 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1840 pack $cscroll -side right -fill y
1841 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1842 lappend bglist $canv $canv2 $canv3
1843 pack .tf.histframe.pwclist -fill both -expand 1 -side left
1844
1845 # we have two button bars at bottom of top frame. Bar 1
1846 frame .tf.bar
1847 frame .tf.lbar -height 15
1848
1849 set sha1entry .tf.bar.sha1
1850 set entries $sha1entry
1851 set sha1but .tf.bar.sha1label
1852 button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
1853 -command gotocommit -width 8
1854 $sha1but conf -disabledforeground [$sha1but cget -foreground]
1855 pack .tf.bar.sha1label -side left
1856 entry $sha1entry -width 40 -font textfont -textvariable sha1string
1857 trace add variable sha1string write sha1change
1858 pack $sha1entry -side left -pady 2
1859
1860 image create bitmap bm-left -data {
1861 #define left_width 16
1862 #define left_height 16
1863 static unsigned char left_bits[] = {
1864 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1865 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1866 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1867 }
1868 image create bitmap bm-right -data {
1869 #define right_width 16
1870 #define right_height 16
1871 static unsigned char right_bits[] = {
1872 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1873 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1874 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1875 }
1876 button .tf.bar.leftbut -image bm-left -command goback \
1877 -state disabled -width 26
1878 pack .tf.bar.leftbut -side left -fill y
1879 button .tf.bar.rightbut -image bm-right -command goforw \
1880 -state disabled -width 26
1881 pack .tf.bar.rightbut -side left -fill y
1882
1883 label .tf.bar.rowlabel -text [mc "Row"]
1884 set rownumsel {}
1885 label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
1886 -relief sunken -anchor e
1887 label .tf.bar.rowlabel2 -text "/"
1888 label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
1889 -relief sunken -anchor e
1890 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
1891 -side left
1892 global selectedline
1893 trace add variable selectedline write selectedline_change
1894
1895 # Status label and progress bar
1896 set statusw .tf.bar.status
1897 label $statusw -width 15 -relief sunken
1898 pack $statusw -side left -padx 5
1899 set h [expr {[font metrics uifont -linespace] + 2}]
1900 set progresscanv .tf.bar.progress
1901 canvas $progresscanv -relief sunken -height $h -borderwidth 2
1902 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1903 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1904 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1905 pack $progresscanv -side right -expand 1 -fill x
1906 set progresscoords {0 0}
1907 set fprogcoord 0
1908 set rprogcoord 0
1909 bind $progresscanv <Configure> adjustprogress
1910 set lastprogupdate [clock clicks -milliseconds]
1911 set progupdatepending 0
1912
1913 # build up the bottom bar of upper window
1914 label .tf.lbar.flabel -text "[mc "Find"] "
1915 button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
1916 button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
1917 label .tf.lbar.flab2 -text " [mc "commit"] "
1918 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1919 -side left -fill y
1920 set gdttype [mc "containing:"]
1921 set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1922 [mc "containing:"] \
1923 [mc "touching paths:"] \
1924 [mc "adding/removing string:"]]
1925 trace add variable gdttype write gdttype_change
1926 pack .tf.lbar.gdttype -side left -fill y
1927
1928 set findstring {}
1929 set fstring .tf.lbar.findstring
1930 lappend entries $fstring
1931 entry $fstring -width 30 -font textfont -textvariable findstring
1932 trace add variable findstring write find_change
1933 set findtype [mc "Exact"]
1934 set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1935 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
1936 trace add variable findtype write findcom_change
1937 set findloc [mc "All fields"]
1938 tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
1939 [mc "Comments"] [mc "Author"] [mc "Committer"]
1940 trace add variable findloc write find_change
1941 pack .tf.lbar.findloc -side right
1942 pack .tf.lbar.findtype -side right
1943 pack $fstring -side left -expand 1 -fill x
1944
1945 # Finish putting the upper half of the viewer together
1946 pack .tf.lbar -in .tf -side bottom -fill x
1947 pack .tf.bar -in .tf -side bottom -fill x
1948 pack .tf.histframe -fill both -side top -expand 1
1949 .ctop add .tf
1950 .ctop paneconfigure .tf -height $geometry(topheight)
1951 .ctop paneconfigure .tf -width $geometry(topwidth)
1952
1953 # now build up the bottom
1954 panedwindow .pwbottom -orient horizontal
1955
1956 # lower left, a text box over search bar, scroll bar to the right
1957 # if we know window height, then that will set the lower text height, otherwise
1958 # we set lower text height which will drive window height
1959 if {[info exists geometry(main)]} {
1960 frame .bleft -width $geometry(botwidth)
1961 } else {
1962 frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1963 }
1964 frame .bleft.top
1965 frame .bleft.mid
1966 frame .bleft.bottom
1967
1968 button .bleft.top.search -text [mc "Search"] -command dosearch
1969 pack .bleft.top.search -side left -padx 5
1970 set sstring .bleft.top.sstring
1971 entry $sstring -width 20 -font textfont -textvariable searchstring
1972 lappend entries $sstring
1973 trace add variable searchstring write incrsearch
1974 pack $sstring -side left -expand 1 -fill x
1975 radiobutton .bleft.mid.diff -text [mc "Diff"] \
1976 -command changediffdisp -variable diffelide -value {0 0}
1977 radiobutton .bleft.mid.old -text [mc "Old version"] \
1978 -command changediffdisp -variable diffelide -value {0 1}
1979 radiobutton .bleft.mid.new -text [mc "New version"] \
1980 -command changediffdisp -variable diffelide -value {1 0}
1981 label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
1982 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1983 spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1984 -from 1 -increment 1 -to 10000000 \
1985 -validate all -validatecommand "diffcontextvalidate %P" \
1986 -textvariable diffcontextstring
1987 .bleft.mid.diffcontext set $diffcontext
1988 trace add variable diffcontextstring write diffcontextchange
1989 lappend entries .bleft.mid.diffcontext
1990 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1991 checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
1992 -command changeignorespace -variable ignorespace
1993 pack .bleft.mid.ignspace -side left -padx 5
1994 set ctext .bleft.bottom.ctext
1995 text $ctext -background $bgcolor -foreground $fgcolor \
1996 -state disabled -font textfont \
1997 -yscrollcommand scrolltext -wrap none \
1998 -xscrollcommand ".bleft.bottom.sbhorizontal set"
1999 if {$have_tk85} {
2000 $ctext conf -tabstyle wordprocessor
2001 }
2002 scrollbar .bleft.bottom.sb -command "$ctext yview"
2003 scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \
2004 -width 10
2005 pack .bleft.top -side top -fill x
2006 pack .bleft.mid -side top -fill x
2007 grid $ctext .bleft.bottom.sb -sticky nsew
2008 grid .bleft.bottom.sbhorizontal -sticky ew
2009 grid columnconfigure .bleft.bottom 0 -weight 1
2010 grid rowconfigure .bleft.bottom 0 -weight 1
2011 grid rowconfigure .bleft.bottom 1 -weight 0
2012 pack .bleft.bottom -side top -fill both -expand 1
2013 lappend bglist $ctext
2014 lappend fglist $ctext
2015
2016 $ctext tag conf comment -wrap $wrapcomment
2017 $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2018 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2019 $ctext tag conf d0 -fore [lindex $diffcolors 0]
2020 $ctext tag conf d1 -fore [lindex $diffcolors 1]
2021 $ctext tag conf m0 -fore red
2022 $ctext tag conf m1 -fore blue
2023 $ctext tag conf m2 -fore green
2024 $ctext tag conf m3 -fore purple
2025 $ctext tag conf m4 -fore brown
2026 $ctext tag conf m5 -fore "#009090"
2027 $ctext tag conf m6 -fore magenta
2028 $ctext tag conf m7 -fore "#808000"
2029 $ctext tag conf m8 -fore "#009000"
2030 $ctext tag conf m9 -fore "#ff0080"
2031 $ctext tag conf m10 -fore cyan
2032 $ctext tag conf m11 -fore "#b07070"
2033 $ctext tag conf m12 -fore "#70b0f0"
2034 $ctext tag conf m13 -fore "#70f0b0"
2035 $ctext tag conf m14 -fore "#f0b070"
2036 $ctext tag conf m15 -fore "#ff70b0"
2037 $ctext tag conf mmax -fore darkgrey
2038 set mergemax 16
2039 $ctext tag conf mresult -font textfontbold
2040 $ctext tag conf msep -font textfontbold
2041 $ctext tag conf found -back yellow
2042
2043 .pwbottom add .bleft
2044 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2045
2046 # lower right
2047 frame .bright
2048 frame .bright.mode
2049 radiobutton .bright.mode.patch -text [mc "Patch"] \
2050 -command reselectline -variable cmitmode -value "patch"
2051 radiobutton .bright.mode.tree -text [mc "Tree"] \
2052 -command reselectline -variable cmitmode -value "tree"
2053 grid .bright.mode.patch .bright.mode.tree -sticky ew
2054 pack .bright.mode -side top -fill x
2055 set cflist .bright.cfiles
2056 set indent [font measure mainfont "nn"]
2057 text $cflist \
2058 -selectbackground $selectbgcolor \
2059 -background $bgcolor -foreground $fgcolor \
2060 -font mainfont \
2061 -tabs [list $indent [expr {2 * $indent}]] \
2062 -yscrollcommand ".bright.sb set" \
2063 -cursor [. cget -cursor] \
2064 -spacing1 1 -spacing3 1
2065 lappend bglist $cflist
2066 lappend fglist $cflist
2067 scrollbar .bright.sb -command "$cflist yview"
2068 pack .bright.sb -side right -fill y
2069 pack $cflist -side left -fill both -expand 1
2070 $cflist tag configure highlight \
2071 -background [$cflist cget -selectbackground]
2072 $cflist tag configure bold -font mainfontbold
2073
2074 .pwbottom add .bright
2075 .ctop add .pwbottom
2076
2077 # restore window width & height if known
2078 if {[info exists geometry(main)]} {
2079 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2080 if {$w > [winfo screenwidth .]} {
2081 set w [winfo screenwidth .]
2082 }
2083 if {$h > [winfo screenheight .]} {
2084 set h [winfo screenheight .]
2085 }
2086 wm geometry . "${w}x$h"
2087 }
2088 }
2089
2090 if {[tk windowingsystem] eq {aqua}} {
2091 set M1B M1
2092 } else {
2093 set M1B Control
2094 }
2095
2096 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2097 pack .ctop -fill both -expand 1
2098 bindall <1> {selcanvline %W %x %y}
2099 #bindall <B1-Motion> {selcanvline %W %x %y}
2100 if {[tk windowingsystem] == "win32"} {
2101 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2102 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2103 } else {
2104 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2105 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2106 if {[tk windowingsystem] eq "aqua"} {
2107 bindall <MouseWheel> {
2108 set delta [expr {- (%D)}]
2109 allcanvs yview scroll $delta units
2110 }
2111 }
2112 }
2113 bindall <2> "canvscan mark %W %x %y"
2114 bindall <B2-Motion> "canvscan dragto %W %x %y"
2115 bindkey <Home> selfirstline
2116 bindkey <End> sellastline
2117 bind . <Key-Up> "selnextline -1"
2118 bind . <Key-Down> "selnextline 1"
2119 bind . <Shift-Key-Up> "dofind -1 0"
2120 bind . <Shift-Key-Down> "dofind 1 0"
2121 bindkey <Key-Right> "goforw"
2122 bindkey <Key-Left> "goback"
2123 bind . <Key-Prior> "selnextpage -1"
2124 bind . <Key-Next> "selnextpage 1"
2125 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2126 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2127 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2128 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2129 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2130 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2131 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2132 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2133 bindkey <Key-space> "$ctext yview scroll 1 pages"
2134 bindkey p "selnextline -1"
2135 bindkey n "selnextline 1"
2136 bindkey z "goback"
2137 bindkey x "goforw"
2138 bindkey i "selnextline -1"
2139 bindkey k "selnextline 1"
2140 bindkey j "goback"
2141 bindkey l "goforw"
2142 bindkey b prevfile
2143 bindkey d "$ctext yview scroll 18 units"
2144 bindkey u "$ctext yview scroll -18 units"
2145 bindkey / {dofind 1 1}
2146 bindkey <Key-Return> {dofind 1 1}
2147 bindkey ? {dofind -1 1}
2148 bindkey f nextfile
2149 bindkey <F5> updatecommits
2150 bind . <$M1B-q> doquit
2151 bind . <$M1B-f> {dofind 1 1}
2152 bind . <$M1B-g> {dofind 1 0}
2153 bind . <$M1B-r> dosearchback
2154 bind . <$M1B-s> dosearch
2155 bind . <$M1B-equal> {incrfont 1}
2156 bind . <$M1B-plus> {incrfont 1}
2157 bind . <$M1B-KP_Add> {incrfont 1}
2158 bind . <$M1B-minus> {incrfont -1}
2159 bind . <$M1B-KP_Subtract> {incrfont -1}
2160 wm protocol . WM_DELETE_WINDOW doquit
2161 bind . <Destroy> {stop_backends}
2162 bind . <Button-1> "click %W"
2163 bind $fstring <Key-Return> {dofind 1 1}
2164 bind $sha1entry <Key-Return> gotocommit
2165 bind $sha1entry <<PasteSelection>> clearsha1
2166 bind $cflist <1> {sel_flist %W %x %y; break}
2167 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2168 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2169 global ctxbut
2170 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2171
2172 set maincursor [. cget -cursor]
2173 set textcursor [$ctext cget -cursor]
2174 set curtextcursor $textcursor
2175
2176 set rowctxmenu .rowctxmenu
2177 menu $rowctxmenu -tearoff 0
2178 $rowctxmenu add command -label [mc "Diff this -> selected"] \
2179 -command {diffvssel 0}
2180 $rowctxmenu add command -label [mc "Diff selected -> this"] \
2181 -command {diffvssel 1}
2182 $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
2183 $rowctxmenu add command -label [mc "Create tag"] -command mktag
2184 $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
2185 $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
2186 $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
2187 -command cherrypick
2188 $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
2189 -command resethead
2190
2191 set fakerowmenu .fakerowmenu
2192 menu $fakerowmenu -tearoff 0
2193 $fakerowmenu add command -label [mc "Diff this -> selected"] \
2194 -command {diffvssel 0}
2195 $fakerowmenu add command -label [mc "Diff selected -> this"] \
2196 -command {diffvssel 1}
2197 $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
2198# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
2199# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
2200# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
2201
2202 set headctxmenu .headctxmenu
2203 menu $headctxmenu -tearoff 0
2204 $headctxmenu add command -label [mc "Check out this branch"] \
2205 -command cobranch
2206 $headctxmenu add command -label [mc "Remove this branch"] \
2207 -command rmbranch
2208
2209 global flist_menu
2210 set flist_menu .flistctxmenu
2211 menu $flist_menu -tearoff 0
2212 $flist_menu add command -label [mc "Highlight this too"] \
2213 -command {flist_hl 0}
2214 $flist_menu add command -label [mc "Highlight this only"] \
2215 -command {flist_hl 1}
2216 $flist_menu add command -label [mc "External diff"] \
2217 -command {external_diff}
2218 $flist_menu add command -label [mc "Blame parent commit"] \
2219 -command {external_blame 1}
2220}
2221
2222# Windows sends all mouse wheel events to the current focused window, not
2223# the one where the mouse hovers, so bind those events here and redirect
2224# to the correct window
2225proc windows_mousewheel_redirector {W X Y D} {
2226 global canv canv2 canv3
2227 set w [winfo containing -displayof $W $X $Y]
2228 if {$w ne ""} {
2229 set u [expr {$D < 0 ? 5 : -5}]
2230 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2231 allcanvs yview scroll $u units
2232 } else {
2233 catch {
2234 $w yview scroll $u units
2235 }
2236 }
2237 }
2238}
2239
2240# Update row number label when selectedline changes
2241proc selectedline_change {n1 n2 op} {
2242 global selectedline rownumsel
2243
2244 if {$selectedline eq {}} {
2245 set rownumsel {}
2246 } else {
2247 set rownumsel [expr {$selectedline + 1}]
2248 }
2249}
2250
2251# mouse-2 makes all windows scan vertically, but only the one
2252# the cursor is in scans horizontally
2253proc canvscan {op w x y} {
2254 global canv canv2 canv3
2255 foreach c [list $canv $canv2 $canv3] {
2256 if {$c == $w} {
2257 $c scan $op $x $y
2258 } else {
2259 $c scan $op 0 $y
2260 }
2261 }
2262}
2263
2264proc scrollcanv {cscroll f0 f1} {
2265 $cscroll set $f0 $f1
2266 drawvisible
2267 flushhighlights
2268}
2269
2270# when we make a key binding for the toplevel, make sure
2271# it doesn't get triggered when that key is pressed in the
2272# find string entry widget.
2273proc bindkey {ev script} {
2274 global entries
2275 bind . $ev $script
2276 set escript [bind Entry $ev]
2277 if {$escript == {}} {
2278 set escript [bind Entry <Key>]
2279 }
2280 foreach e $entries {
2281 bind $e $ev "$escript; break"
2282 }
2283}
2284
2285# set the focus back to the toplevel for any click outside
2286# the entry widgets
2287proc click {w} {
2288 global ctext entries
2289 foreach e [concat $entries $ctext] {
2290 if {$w == $e} return
2291 }
2292 focus .
2293}
2294
2295# Adjust the progress bar for a change in requested extent or canvas size
2296proc adjustprogress {} {
2297 global progresscanv progressitem progresscoords
2298 global fprogitem fprogcoord lastprogupdate progupdatepending
2299 global rprogitem rprogcoord
2300
2301 set w [expr {[winfo width $progresscanv] - 4}]
2302 set x0 [expr {$w * [lindex $progresscoords 0]}]
2303 set x1 [expr {$w * [lindex $progresscoords 1]}]
2304 set h [winfo height $progresscanv]
2305 $progresscanv coords $progressitem $x0 0 $x1 $h
2306 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2307 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2308 set now [clock clicks -milliseconds]
2309 if {$now >= $lastprogupdate + 100} {
2310 set progupdatepending 0
2311 update
2312 } elseif {!$progupdatepending} {
2313 set progupdatepending 1
2314 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2315 }
2316}
2317
2318proc doprogupdate {} {
2319 global lastprogupdate progupdatepending
2320
2321 if {$progupdatepending} {
2322 set progupdatepending 0
2323 set lastprogupdate [clock clicks -milliseconds]
2324 update
2325 }
2326}
2327
2328proc savestuff {w} {
2329 global canv canv2 canv3 mainfont textfont uifont tabstop
2330 global stuffsaved findmergefiles maxgraphpct
2331 global maxwidth showneartags showlocalchanges
2332 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2333 global cmitmode wrapcomment datetimeformat limitdiffs
2334 global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2335 global autoselect extdifftool perfile_attrs
2336
2337 if {$stuffsaved} return
2338 if {![winfo viewable .]} return
2339 catch {
2340 set f [open "~/.gitk-new" w]
2341 puts $f [list set mainfont $mainfont]
2342 puts $f [list set textfont $textfont]
2343 puts $f [list set uifont $uifont]
2344 puts $f [list set tabstop $tabstop]
2345 puts $f [list set findmergefiles $findmergefiles]
2346 puts $f [list set maxgraphpct $maxgraphpct]
2347 puts $f [list set maxwidth $maxwidth]
2348 puts $f [list set cmitmode $cmitmode]
2349 puts $f [list set wrapcomment $wrapcomment]
2350 puts $f [list set autoselect $autoselect]
2351 puts $f [list set showneartags $showneartags]
2352 puts $f [list set showlocalchanges $showlocalchanges]
2353 puts $f [list set datetimeformat $datetimeformat]
2354 puts $f [list set limitdiffs $limitdiffs]
2355 puts $f [list set bgcolor $bgcolor]
2356 puts $f [list set fgcolor $fgcolor]
2357 puts $f [list set colors $colors]
2358 puts $f [list set diffcolors $diffcolors]
2359 puts $f [list set diffcontext $diffcontext]
2360 puts $f [list set selectbgcolor $selectbgcolor]
2361 puts $f [list set extdifftool $extdifftool]
2362 puts $f [list set perfile_attrs $perfile_attrs]
2363
2364 puts $f "set geometry(main) [wm geometry .]"
2365 puts $f "set geometry(topwidth) [winfo width .tf]"
2366 puts $f "set geometry(topheight) [winfo height .tf]"
2367 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2368 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2369 puts $f "set geometry(botwidth) [winfo width .bleft]"
2370 puts $f "set geometry(botheight) [winfo height .bleft]"
2371
2372 puts -nonewline $f "set permviews {"
2373 for {set v 0} {$v < $nextviewnum} {incr v} {
2374 if {$viewperm($v)} {
2375 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2376 }
2377 }
2378 puts $f "}"
2379 close $f
2380 file rename -force "~/.gitk-new" "~/.gitk"
2381 }
2382 set stuffsaved 1
2383}
2384
2385proc resizeclistpanes {win w} {
2386 global oldwidth
2387 if {[info exists oldwidth($win)]} {
2388 set s0 [$win sash coord 0]
2389 set s1 [$win sash coord 1]
2390 if {$w < 60} {
2391 set sash0 [expr {int($w/2 - 2)}]
2392 set sash1 [expr {int($w*5/6 - 2)}]
2393 } else {
2394 set factor [expr {1.0 * $w / $oldwidth($win)}]
2395 set sash0 [expr {int($factor * [lindex $s0 0])}]
2396 set sash1 [expr {int($factor * [lindex $s1 0])}]
2397 if {$sash0 < 30} {
2398 set sash0 30
2399 }
2400 if {$sash1 < $sash0 + 20} {
2401 set sash1 [expr {$sash0 + 20}]
2402 }
2403 if {$sash1 > $w - 10} {
2404 set sash1 [expr {$w - 10}]
2405 if {$sash0 > $sash1 - 20} {
2406 set sash0 [expr {$sash1 - 20}]
2407 }
2408 }
2409 }
2410 $win sash place 0 $sash0 [lindex $s0 1]
2411 $win sash place 1 $sash1 [lindex $s1 1]
2412 }
2413 set oldwidth($win) $w
2414}
2415
2416proc resizecdetpanes {win w} {
2417 global oldwidth
2418 if {[info exists oldwidth($win)]} {
2419 set s0 [$win sash coord 0]
2420 if {$w < 60} {
2421 set sash0 [expr {int($w*3/4 - 2)}]
2422 } else {
2423 set factor [expr {1.0 * $w / $oldwidth($win)}]
2424 set sash0 [expr {int($factor * [lindex $s0 0])}]
2425 if {$sash0 < 45} {
2426 set sash0 45
2427 }
2428 if {$sash0 > $w - 15} {
2429 set sash0 [expr {$w - 15}]
2430 }
2431 }
2432 $win sash place 0 $sash0 [lindex $s0 1]
2433 }
2434 set oldwidth($win) $w
2435}
2436
2437proc allcanvs args {
2438 global canv canv2 canv3
2439 eval $canv $args
2440 eval $canv2 $args
2441 eval $canv3 $args
2442}
2443
2444proc bindall {event action} {
2445 global canv canv2 canv3
2446 bind $canv $event $action
2447 bind $canv2 $event $action
2448 bind $canv3 $event $action
2449}
2450
2451proc about {} {
2452 global uifont
2453 set w .about
2454 if {[winfo exists $w]} {
2455 raise $w
2456 return
2457 }
2458 toplevel $w
2459 wm title $w [mc "About gitk"]
2460 message $w.m -text [mc "
2461Gitk - a commit viewer for git
2462
2463Copyright © 2005-2008 Paul Mackerras
2464
2465Use and redistribute under the terms of the GNU General Public License"] \
2466 -justify center -aspect 400 -border 2 -bg white -relief groove
2467 pack $w.m -side top -fill x -padx 2 -pady 2
2468 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2469 pack $w.ok -side bottom
2470 bind $w <Visibility> "focus $w.ok"
2471 bind $w <Key-Escape> "destroy $w"
2472 bind $w <Key-Return> "destroy $w"
2473}
2474
2475proc keys {} {
2476 set w .keys
2477 if {[winfo exists $w]} {
2478 raise $w
2479 return
2480 }
2481 if {[tk windowingsystem] eq {aqua}} {
2482 set M1T Cmd
2483 } else {
2484 set M1T Ctrl
2485 }
2486 toplevel $w
2487 wm title $w [mc "Gitk key bindings"]
2488 message $w.m -text "
2489[mc "Gitk key bindings:"]
2490
2491[mc "<%s-Q> Quit" $M1T]
2492[mc "<Home> Move to first commit"]
2493[mc "<End> Move to last commit"]
2494[mc "<Up>, p, i Move up one commit"]
2495[mc "<Down>, n, k Move down one commit"]
2496[mc "<Left>, z, j Go back in history list"]
2497[mc "<Right>, x, l Go forward in history list"]
2498[mc "<PageUp> Move up one page in commit list"]
2499[mc "<PageDown> Move down one page in commit list"]
2500[mc "<%s-Home> Scroll to top of commit list" $M1T]
2501[mc "<%s-End> Scroll to bottom of commit list" $M1T]
2502[mc "<%s-Up> Scroll commit list up one line" $M1T]
2503[mc "<%s-Down> Scroll commit list down one line" $M1T]
2504[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2505[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2506[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2507[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2508[mc "<Delete>, b Scroll diff view up one page"]
2509[mc "<Backspace> Scroll diff view up one page"]
2510[mc "<Space> Scroll diff view down one page"]
2511[mc "u Scroll diff view up 18 lines"]
2512[mc "d Scroll diff view down 18 lines"]
2513[mc "<%s-F> Find" $M1T]
2514[mc "<%s-G> Move to next find hit" $M1T]
2515[mc "<Return> Move to next find hit"]
2516[mc "/ Move to next find hit, or redo find"]
2517[mc "? Move to previous find hit"]
2518[mc "f Scroll diff view to next file"]
2519[mc "<%s-S> Search for next hit in diff view" $M1T]
2520[mc "<%s-R> Search for previous hit in diff view" $M1T]
2521[mc "<%s-KP+> Increase font size" $M1T]
2522[mc "<%s-plus> Increase font size" $M1T]
2523[mc "<%s-KP-> Decrease font size" $M1T]
2524[mc "<%s-minus> Decrease font size" $M1T]
2525[mc "<F5> Update"]
2526" \
2527 -justify left -bg white -border 2 -relief groove
2528 pack $w.m -side top -fill both -padx 2 -pady 2
2529 button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2530 pack $w.ok -side bottom
2531 bind $w <Visibility> "focus $w.ok"
2532 bind $w <Key-Escape> "destroy $w"
2533 bind $w <Key-Return> "destroy $w"
2534}
2535
2536# Procedures for manipulating the file list window at the
2537# bottom right of the overall window.
2538
2539proc treeview {w l openlevs} {
2540 global treecontents treediropen treeheight treeparent treeindex
2541
2542 set ix 0
2543 set treeindex() 0
2544 set lev 0
2545 set prefix {}
2546 set prefixend -1
2547 set prefendstack {}
2548 set htstack {}
2549 set ht 0
2550 set treecontents() {}
2551 $w conf -state normal
2552 foreach f $l {
2553 while {[string range $f 0 $prefixend] ne $prefix} {
2554 if {$lev <= $openlevs} {
2555 $w mark set e:$treeindex($prefix) "end -1c"
2556 $w mark gravity e:$treeindex($prefix) left
2557 }
2558 set treeheight($prefix) $ht
2559 incr ht [lindex $htstack end]
2560 set htstack [lreplace $htstack end end]
2561 set prefixend [lindex $prefendstack end]
2562 set prefendstack [lreplace $prefendstack end end]
2563 set prefix [string range $prefix 0 $prefixend]
2564 incr lev -1
2565 }
2566 set tail [string range $f [expr {$prefixend+1}] end]
2567 while {[set slash [string first "/" $tail]] >= 0} {
2568 lappend htstack $ht
2569 set ht 0
2570 lappend prefendstack $prefixend
2571 incr prefixend [expr {$slash + 1}]
2572 set d [string range $tail 0 $slash]
2573 lappend treecontents($prefix) $d
2574 set oldprefix $prefix
2575 append prefix $d
2576 set treecontents($prefix) {}
2577 set treeindex($prefix) [incr ix]
2578 set treeparent($prefix) $oldprefix
2579 set tail [string range $tail [expr {$slash+1}] end]
2580 if {$lev <= $openlevs} {
2581 set ht 1
2582 set treediropen($prefix) [expr {$lev < $openlevs}]
2583 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2584 $w mark set d:$ix "end -1c"
2585 $w mark gravity d:$ix left
2586 set str "\n"
2587 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2588 $w insert end $str
2589 $w image create end -align center -image $bm -padx 1 \
2590 -name a:$ix
2591 $w insert end $d [highlight_tag $prefix]
2592 $w mark set s:$ix "end -1c"
2593 $w mark gravity s:$ix left
2594 }
2595 incr lev
2596 }
2597 if {$tail ne {}} {
2598 if {$lev <= $openlevs} {
2599 incr ht
2600 set str "\n"
2601 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2602 $w insert end $str
2603 $w insert end $tail [highlight_tag $f]
2604 }
2605 lappend treecontents($prefix) $tail
2606 }
2607 }
2608 while {$htstack ne {}} {
2609 set treeheight($prefix) $ht
2610 incr ht [lindex $htstack end]
2611 set htstack [lreplace $htstack end end]
2612 set prefixend [lindex $prefendstack end]
2613 set prefendstack [lreplace $prefendstack end end]
2614 set prefix [string range $prefix 0 $prefixend]
2615 }
2616 $w conf -state disabled
2617}
2618
2619proc linetoelt {l} {
2620 global treeheight treecontents
2621
2622 set y 2
2623 set prefix {}
2624 while {1} {
2625 foreach e $treecontents($prefix) {
2626 if {$y == $l} {
2627 return "$prefix$e"
2628 }
2629 set n 1
2630 if {[string index $e end] eq "/"} {
2631 set n $treeheight($prefix$e)
2632 if {$y + $n > $l} {
2633 append prefix $e
2634 incr y
2635 break
2636 }
2637 }
2638 incr y $n
2639 }
2640 }
2641}
2642
2643proc highlight_tree {y prefix} {
2644 global treeheight treecontents cflist
2645
2646 foreach e $treecontents($prefix) {
2647 set path $prefix$e
2648 if {[highlight_tag $path] ne {}} {
2649 $cflist tag add bold $y.0 "$y.0 lineend"
2650 }
2651 incr y
2652 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2653 set y [highlight_tree $y $path]
2654 }
2655 }
2656 return $y
2657}
2658
2659proc treeclosedir {w dir} {
2660 global treediropen treeheight treeparent treeindex
2661
2662 set ix $treeindex($dir)
2663 $w conf -state normal
2664 $w delete s:$ix e:$ix
2665 set treediropen($dir) 0
2666 $w image configure a:$ix -image tri-rt
2667 $w conf -state disabled
2668 set n [expr {1 - $treeheight($dir)}]
2669 while {$dir ne {}} {
2670 incr treeheight($dir) $n
2671 set dir $treeparent($dir)
2672 }
2673}
2674
2675proc treeopendir {w dir} {
2676 global treediropen treeheight treeparent treecontents treeindex
2677
2678 set ix $treeindex($dir)
2679 $w conf -state normal
2680 $w image configure a:$ix -image tri-dn
2681 $w mark set e:$ix s:$ix
2682 $w mark gravity e:$ix right
2683 set lev 0
2684 set str "\n"
2685 set n [llength $treecontents($dir)]
2686 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2687 incr lev
2688 append str "\t"
2689 incr treeheight($x) $n
2690 }
2691 foreach e $treecontents($dir) {
2692 set de $dir$e
2693 if {[string index $e end] eq "/"} {
2694 set iy $treeindex($de)
2695 $w mark set d:$iy e:$ix
2696 $w mark gravity d:$iy left
2697 $w insert e:$ix $str
2698 set treediropen($de) 0
2699 $w image create e:$ix -align center -image tri-rt -padx 1 \
2700 -name a:$iy
2701 $w insert e:$ix $e [highlight_tag $de]
2702 $w mark set s:$iy e:$ix
2703 $w mark gravity s:$iy left
2704 set treeheight($de) 1
2705 } else {
2706 $w insert e:$ix $str
2707 $w insert e:$ix $e [highlight_tag $de]
2708 }
2709 }
2710 $w mark gravity e:$ix right
2711 $w conf -state disabled
2712 set treediropen($dir) 1
2713 set top [lindex [split [$w index @0,0] .] 0]
2714 set ht [$w cget -height]
2715 set l [lindex [split [$w index s:$ix] .] 0]
2716 if {$l < $top} {
2717 $w yview $l.0
2718 } elseif {$l + $n + 1 > $top + $ht} {
2719 set top [expr {$l + $n + 2 - $ht}]
2720 if {$l < $top} {
2721 set top $l
2722 }
2723 $w yview $top.0
2724 }
2725}
2726
2727proc treeclick {w x y} {
2728 global treediropen cmitmode ctext cflist cflist_top
2729
2730 if {$cmitmode ne "tree"} return
2731 if {![info exists cflist_top]} return
2732 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2733 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2734 $cflist tag add highlight $l.0 "$l.0 lineend"
2735 set cflist_top $l
2736 if {$l == 1} {
2737 $ctext yview 1.0
2738 return
2739 }
2740 set e [linetoelt $l]
2741 if {[string index $e end] ne "/"} {
2742 showfile $e
2743 } elseif {$treediropen($e)} {
2744 treeclosedir $w $e
2745 } else {
2746 treeopendir $w $e
2747 }
2748}
2749
2750proc setfilelist {id} {
2751 global treefilelist cflist
2752
2753 treeview $cflist $treefilelist($id) 0
2754}
2755
2756image create bitmap tri-rt -background black -foreground blue -data {
2757 #define tri-rt_width 13
2758 #define tri-rt_height 13
2759 static unsigned char tri-rt_bits[] = {
2760 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2761 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2762 0x00, 0x00};
2763} -maskdata {
2764 #define tri-rt-mask_width 13
2765 #define tri-rt-mask_height 13
2766 static unsigned char tri-rt-mask_bits[] = {
2767 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2768 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2769 0x08, 0x00};
2770}
2771image create bitmap tri-dn -background black -foreground blue -data {
2772 #define tri-dn_width 13
2773 #define tri-dn_height 13
2774 static unsigned char tri-dn_bits[] = {
2775 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2776 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2777 0x00, 0x00};
2778} -maskdata {
2779 #define tri-dn-mask_width 13
2780 #define tri-dn-mask_height 13
2781 static unsigned char tri-dn-mask_bits[] = {
2782 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2783 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2784 0x00, 0x00};
2785}
2786
2787image create bitmap reficon-T -background black -foreground yellow -data {
2788 #define tagicon_width 13
2789 #define tagicon_height 9
2790 static unsigned char tagicon_bits[] = {
2791 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2792 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2793} -maskdata {
2794 #define tagicon-mask_width 13
2795 #define tagicon-mask_height 9
2796 static unsigned char tagicon-mask_bits[] = {
2797 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2798 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2799}
2800set rectdata {
2801 #define headicon_width 13
2802 #define headicon_height 9
2803 static unsigned char headicon_bits[] = {
2804 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2805 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2806}
2807set rectmask {
2808 #define headicon-mask_width 13
2809 #define headicon-mask_height 9
2810 static unsigned char headicon-mask_bits[] = {
2811 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2812 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2813}
2814image create bitmap reficon-H -background black -foreground green \
2815 -data $rectdata -maskdata $rectmask
2816image create bitmap reficon-o -background black -foreground "#ddddff" \
2817 -data $rectdata -maskdata $rectmask
2818
2819proc init_flist {first} {
2820 global cflist cflist_top difffilestart
2821
2822 $cflist conf -state normal
2823 $cflist delete 0.0 end
2824 if {$first ne {}} {
2825 $cflist insert end $first
2826 set cflist_top 1
2827 $cflist tag add highlight 1.0 "1.0 lineend"
2828 } else {
2829 catch {unset cflist_top}
2830 }
2831 $cflist conf -state disabled
2832 set difffilestart {}
2833}
2834
2835proc highlight_tag {f} {
2836 global highlight_paths
2837
2838 foreach p $highlight_paths {
2839 if {[string match $p $f]} {
2840 return "bold"
2841 }
2842 }
2843 return {}
2844}
2845
2846proc highlight_filelist {} {
2847 global cmitmode cflist
2848
2849 $cflist conf -state normal
2850 if {$cmitmode ne "tree"} {
2851 set end [lindex [split [$cflist index end] .] 0]
2852 for {set l 2} {$l < $end} {incr l} {
2853 set line [$cflist get $l.0 "$l.0 lineend"]
2854 if {[highlight_tag $line] ne {}} {
2855 $cflist tag add bold $l.0 "$l.0 lineend"
2856 }
2857 }
2858 } else {
2859 highlight_tree 2 {}
2860 }
2861 $cflist conf -state disabled
2862}
2863
2864proc unhighlight_filelist {} {
2865 global cflist
2866
2867 $cflist conf -state normal
2868 $cflist tag remove bold 1.0 end
2869 $cflist conf -state disabled
2870}
2871
2872proc add_flist {fl} {
2873 global cflist
2874
2875 $cflist conf -state normal
2876 foreach f $fl {
2877 $cflist insert end "\n"
2878 $cflist insert end $f [highlight_tag $f]
2879 }
2880 $cflist conf -state disabled
2881}
2882
2883proc sel_flist {w x y} {
2884 global ctext difffilestart cflist cflist_top cmitmode
2885
2886 if {$cmitmode eq "tree"} return
2887 if {![info exists cflist_top]} return
2888 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2889 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2890 $cflist tag add highlight $l.0 "$l.0 lineend"
2891 set cflist_top $l
2892 if {$l == 1} {
2893 $ctext yview 1.0
2894 } else {
2895 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2896 }
2897}
2898
2899proc pop_flist_menu {w X Y x y} {
2900 global ctext cflist cmitmode flist_menu flist_menu_file
2901 global treediffs diffids
2902
2903 stopfinding
2904 set l [lindex [split [$w index "@$x,$y"] "."] 0]
2905 if {$l <= 1} return
2906 if {$cmitmode eq "tree"} {
2907 set e [linetoelt $l]
2908 if {[string index $e end] eq "/"} return
2909 } else {
2910 set e [lindex $treediffs($diffids) [expr {$l-2}]]
2911 }
2912 set flist_menu_file $e
2913 set xdiffstate "normal"
2914 if {$cmitmode eq "tree"} {
2915 set xdiffstate "disabled"
2916 }
2917 # Disable "External diff" item in tree mode
2918 $flist_menu entryconf 2 -state $xdiffstate
2919 tk_popup $flist_menu $X $Y
2920}
2921
2922proc flist_hl {only} {
2923 global flist_menu_file findstring gdttype
2924
2925 set x [shellquote $flist_menu_file]
2926 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
2927 set findstring $x
2928 } else {
2929 append findstring " " $x
2930 }
2931 set gdttype [mc "touching paths:"]
2932}
2933
2934proc save_file_from_commit {filename output what} {
2935 global nullfile
2936
2937 if {[catch {exec git show $filename -- > $output} err]} {
2938 if {[string match "fatal: bad revision *" $err]} {
2939 return $nullfile
2940 }
2941 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
2942 return {}
2943 }
2944 return $output
2945}
2946
2947proc external_diff_get_one_file {diffid filename diffdir} {
2948 global nullid nullid2 nullfile
2949 global gitdir
2950
2951 if {$diffid == $nullid} {
2952 set difffile [file join [file dirname $gitdir] $filename]
2953 if {[file exists $difffile]} {
2954 return $difffile
2955 }
2956 return $nullfile
2957 }
2958 if {$diffid == $nullid2} {
2959 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
2960 return [save_file_from_commit :$filename $difffile index]
2961 }
2962 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
2963 return [save_file_from_commit $diffid:$filename $difffile \
2964 "revision $diffid"]
2965}
2966
2967proc external_diff {} {
2968 global gitktmpdir nullid nullid2
2969 global flist_menu_file
2970 global diffids
2971 global diffnum
2972 global gitdir extdifftool
2973
2974 if {[llength $diffids] == 1} {
2975 # no reference commit given
2976 set diffidto [lindex $diffids 0]
2977 if {$diffidto eq $nullid} {
2978 # diffing working copy with index
2979 set diffidfrom $nullid2
2980 } elseif {$diffidto eq $nullid2} {
2981 # diffing index with HEAD
2982 set diffidfrom "HEAD"
2983 } else {
2984 # use first parent commit
2985 global parentlist selectedline
2986 set diffidfrom [lindex $parentlist $selectedline 0]
2987 }
2988 } else {
2989 set diffidfrom [lindex $diffids 0]
2990 set diffidto [lindex $diffids 1]
2991 }
2992
2993 # make sure that several diffs wont collide
2994 if {![info exists gitktmpdir]} {
2995 set gitktmpdir [file join [file dirname $gitdir] \
2996 [format ".gitk-tmp.%s" [pid]]]
2997 if {[catch {file mkdir $gitktmpdir} err]} {
2998 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
2999 unset gitktmpdir
3000 return
3001 }
3002 set diffnum 0
3003 }
3004 incr diffnum
3005 set diffdir [file join $gitktmpdir $diffnum]
3006 if {[catch {file mkdir $diffdir} err]} {
3007 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3008 return
3009 }
3010
3011 # gather files to diff
3012 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3013 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3014
3015 if {$difffromfile ne {} && $difftofile ne {}} {
3016 set cmd [concat | [shellsplit $extdifftool] \
3017 [list $difffromfile $difftofile]]
3018 if {[catch {set fl [open $cmd r]} err]} {
3019 file delete -force $diffdir
3020 error_popup "$extdifftool: [mc "command failed:"] $err"
3021 } else {
3022 fconfigure $fl -blocking 0
3023 filerun $fl [list delete_at_eof $fl $diffdir]
3024 }
3025 }
3026}
3027
3028proc external_blame {parent_idx} {
3029 global flist_menu_file
3030 global nullid nullid2
3031 global parentlist selectedline currentid
3032
3033 if {$parent_idx > 0} {
3034 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3035 } else {
3036 set base_commit $currentid
3037 }
3038
3039 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3040 error_popup [mc "No such commit"]
3041 return
3042 }
3043
3044 if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
3045 error_popup "[mc "git gui blame: command failed:"] $err"
3046 }
3047}
3048
3049# delete $dir when we see eof on $f (presumably because the child has exited)
3050proc delete_at_eof {f dir} {
3051 while {[gets $f line] >= 0} {}
3052 if {[eof $f]} {
3053 if {[catch {close $f} err]} {
3054 error_popup "[mc "External diff viewer failed:"] $err"
3055 }
3056 file delete -force $dir
3057 return 0
3058 }
3059 return 1
3060}
3061
3062# Functions for adding and removing shell-type quoting
3063
3064proc shellquote {str} {
3065 if {![string match "*\['\"\\ \t]*" $str]} {
3066 return $str
3067 }
3068 if {![string match "*\['\"\\]*" $str]} {
3069 return "\"$str\""
3070 }
3071 if {![string match "*'*" $str]} {
3072 return "'$str'"
3073 }
3074 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3075}
3076
3077proc shellarglist {l} {
3078 set str {}
3079 foreach a $l {
3080 if {$str ne {}} {
3081 append str " "
3082 }
3083 append str [shellquote $a]
3084 }
3085 return $str
3086}
3087
3088proc shelldequote {str} {
3089 set ret {}
3090 set used -1
3091 while {1} {
3092 incr used
3093 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3094 append ret [string range $str $used end]
3095 set used [string length $str]
3096 break
3097 }
3098 set first [lindex $first 0]
3099 set ch [string index $str $first]
3100 if {$first > $used} {
3101 append ret [string range $str $used [expr {$first - 1}]]
3102 set used $first
3103 }
3104 if {$ch eq " " || $ch eq "\t"} break
3105 incr used
3106 if {$ch eq "'"} {
3107 set first [string first "'" $str $used]
3108 if {$first < 0} {
3109 error "unmatched single-quote"
3110 }
3111 append ret [string range $str $used [expr {$first - 1}]]
3112 set used $first
3113 continue
3114 }
3115 if {$ch eq "\\"} {
3116 if {$used >= [string length $str]} {
3117 error "trailing backslash"
3118 }
3119 append ret [string index $str $used]
3120 continue
3121 }
3122 # here ch == "\""
3123 while {1} {
3124 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3125 error "unmatched double-quote"
3126 }
3127 set first [lindex $first 0]
3128 set ch [string index $str $first]
3129 if {$first > $used} {
3130 append ret [string range $str $used [expr {$first - 1}]]
3131 set used $first
3132 }
3133 if {$ch eq "\""} break
3134 incr used
3135 append ret [string index $str $used]
3136 incr used
3137 }
3138 }
3139 return [list $used $ret]
3140}
3141
3142proc shellsplit {str} {
3143 set l {}
3144 while {1} {
3145 set str [string trimleft $str]
3146 if {$str eq {}} break
3147 set dq [shelldequote $str]
3148 set n [lindex $dq 0]
3149 set word [lindex $dq 1]
3150 set str [string range $str $n end]
3151 lappend l $word
3152 }
3153 return $l
3154}
3155
3156# Code to implement multiple views
3157
3158proc newview {ishighlight} {
3159 global nextviewnum newviewname newviewperm newishighlight
3160 global newviewargs revtreeargs viewargscmd newviewargscmd curview
3161
3162 set newishighlight $ishighlight
3163 set top .gitkview
3164 if {[winfo exists $top]} {
3165 raise $top
3166 return
3167 }
3168 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3169 set newviewperm($nextviewnum) 0
3170 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
3171 set newviewargscmd($nextviewnum) $viewargscmd($curview)
3172 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3173}
3174
3175proc editview {} {
3176 global curview
3177 global viewname viewperm newviewname newviewperm
3178 global viewargs newviewargs viewargscmd newviewargscmd
3179
3180 set top .gitkvedit-$curview
3181 if {[winfo exists $top]} {
3182 raise $top
3183 return
3184 }
3185 set newviewname($curview) $viewname($curview)
3186 set newviewperm($curview) $viewperm($curview)
3187 set newviewargs($curview) [shellarglist $viewargs($curview)]
3188 set newviewargscmd($curview) $viewargscmd($curview)
3189 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
3190}
3191
3192proc vieweditor {top n title} {
3193 global newviewname newviewperm viewfiles bgcolor
3194
3195 toplevel $top
3196 wm title $top $title
3197 label $top.nl -text [mc "Name"]
3198 entry $top.name -width 20 -textvariable newviewname($n)
3199 grid $top.nl $top.name -sticky w -pady 5
3200 checkbutton $top.perm -text [mc "Remember this view"] \
3201 -variable newviewperm($n)
3202 grid $top.perm - -pady 5 -sticky w
3203 message $top.al -aspect 1000 \
3204 -text [mc "Commits to include (arguments to git log):"]
3205 grid $top.al - -sticky w -pady 5
3206 entry $top.args -width 50 -textvariable newviewargs($n) \
3207 -background $bgcolor
3208 grid $top.args - -sticky ew -padx 5
3209
3210 message $top.ac -aspect 1000 \
3211 -text [mc "Command to generate more commits to include:"]
3212 grid $top.ac - -sticky w -pady 5
3213 entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
3214 -background white
3215 grid $top.argscmd - -sticky ew -padx 5
3216
3217 message $top.l -aspect 1000 \
3218 -text [mc "Enter files and directories to include, one per line:"]
3219 grid $top.l - -sticky w
3220 text $top.t -width 40 -height 10 -background $bgcolor -font uifont
3221 if {[info exists viewfiles($n)]} {
3222 foreach f $viewfiles($n) {
3223 $top.t insert end $f
3224 $top.t insert end "\n"
3225 }
3226 $top.t delete {end - 1c} end
3227 $top.t mark set insert 0.0
3228 }
3229 grid $top.t - -sticky ew -padx 5
3230 frame $top.buts
3231 button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
3232 button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
3233 grid $top.buts.ok $top.buts.can
3234 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3235 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3236 grid $top.buts - -pady 10 -sticky ew
3237 focus $top.t
3238}
3239
3240proc doviewmenu {m first cmd op argv} {
3241 set nmenu [$m index end]
3242 for {set i $first} {$i <= $nmenu} {incr i} {
3243 if {[$m entrycget $i -command] eq $cmd} {
3244 eval $m $op $i $argv
3245 break
3246 }
3247 }
3248}
3249
3250proc allviewmenus {n op args} {
3251 # global viewhlmenu
3252
3253 doviewmenu .bar.view 5 [list showview $n] $op $args
3254 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
3255}
3256
3257proc newviewok {top n} {
3258 global nextviewnum newviewperm newviewname newishighlight
3259 global viewname viewfiles viewperm selectedview curview
3260 global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
3261
3262 if {[catch {
3263 set newargs [shellsplit $newviewargs($n)]
3264 } err]} {
3265 error_popup "[mc "Error in commit selection arguments:"] $err"
3266 wm raise $top
3267 focus $top
3268 return
3269 }
3270 set files {}
3271 foreach f [split [$top.t get 0.0 end] "\n"] {
3272 set ft [string trim $f]
3273 if {$ft ne {}} {
3274 lappend files $ft
3275 }
3276 }
3277 if {![info exists viewfiles($n)]} {
3278 # creating a new view
3279 incr nextviewnum
3280 set viewname($n) $newviewname($n)
3281 set viewperm($n) $newviewperm($n)
3282 set viewfiles($n) $files
3283 set viewargs($n) $newargs
3284 set viewargscmd($n) $newviewargscmd($n)
3285 addviewmenu $n
3286 if {!$newishighlight} {
3287 run showview $n
3288 } else {
3289 run addvhighlight $n
3290 }
3291 } else {
3292 # editing an existing view
3293 set viewperm($n) $newviewperm($n)
3294 if {$newviewname($n) ne $viewname($n)} {
3295 set viewname($n) $newviewname($n)
3296 doviewmenu .bar.view 5 [list showview $n] \
3297 entryconf [list -label $viewname($n)]
3298 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
3299 # entryconf [list -label $viewname($n) -value $viewname($n)]
3300 }
3301 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
3302 $newviewargscmd($n) ne $viewargscmd($n)} {
3303 set viewfiles($n) $files
3304 set viewargs($n) $newargs
3305 set viewargscmd($n) $newviewargscmd($n)
3306 if {$curview == $n} {
3307 run reloadcommits
3308 }
3309 }
3310 }
3311 catch {destroy $top}
3312}
3313
3314proc delview {} {
3315 global curview viewperm hlview selectedhlview
3316
3317 if {$curview == 0} return
3318 if {[info exists hlview] && $hlview == $curview} {
3319 set selectedhlview [mc "None"]
3320 unset hlview
3321 }
3322 allviewmenus $curview delete
3323 set viewperm($curview) 0
3324 showview 0
3325}
3326
3327proc addviewmenu {n} {
3328 global viewname viewhlmenu
3329
3330 .bar.view add radiobutton -label $viewname($n) \
3331 -command [list showview $n] -variable selectedview -value $n
3332 #$viewhlmenu add radiobutton -label $viewname($n) \
3333 # -command [list addvhighlight $n] -variable selectedhlview
3334}
3335
3336proc showview {n} {
3337 global curview cached_commitrow ordertok
3338 global displayorder parentlist rowidlist rowisopt rowfinal
3339 global colormap rowtextx nextcolor canvxmax
3340 global numcommits viewcomplete
3341 global selectedline currentid canv canvy0
3342 global treediffs
3343 global pending_select mainheadid
3344 global commitidx
3345 global selectedview
3346 global hlview selectedhlview commitinterest
3347
3348 if {$n == $curview} return
3349 set selid {}
3350 set ymax [lindex [$canv cget -scrollregion] 3]
3351 set span [$canv yview]
3352 set ytop [expr {[lindex $span 0] * $ymax}]
3353 set ybot [expr {[lindex $span 1] * $ymax}]
3354 set yscreen [expr {($ybot - $ytop) / 2}]
3355 if {$selectedline ne {}} {
3356 set selid $currentid
3357 set y [yc $selectedline]
3358 if {$ytop < $y && $y < $ybot} {
3359 set yscreen [expr {$y - $ytop}]
3360 }
3361 } elseif {[info exists pending_select]} {
3362 set selid $pending_select
3363 unset pending_select
3364 }
3365 unselectline
3366 normalline
3367 catch {unset treediffs}
3368 clear_display
3369 if {[info exists hlview] && $hlview == $n} {
3370 unset hlview
3371 set selectedhlview [mc "None"]
3372 }
3373 catch {unset commitinterest}
3374 catch {unset cached_commitrow}
3375 catch {unset ordertok}
3376
3377 set curview $n
3378 set selectedview $n
3379 .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
3380 .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
3381
3382 run refill_reflist
3383 if {![info exists viewcomplete($n)]} {
3384 getcommits $selid
3385 return
3386 }
3387
3388 set displayorder {}
3389 set parentlist {}
3390 set rowidlist {}
3391 set rowisopt {}
3392 set rowfinal {}
3393 set numcommits $commitidx($n)
3394
3395 catch {unset colormap}
3396 catch {unset rowtextx}
3397 set nextcolor 0
3398 set canvxmax [$canv cget -width]
3399 set curview $n
3400 set row 0
3401 setcanvscroll
3402 set yf 0
3403 set row {}
3404 if {$selid ne {} && [commitinview $selid $n]} {
3405 set row [rowofcommit $selid]
3406 # try to get the selected row in the same position on the screen
3407 set ymax [lindex [$canv cget -scrollregion] 3]
3408 set ytop [expr {[yc $row] - $yscreen}]
3409 if {$ytop < 0} {
3410 set ytop 0
3411 }
3412 set yf [expr {$ytop * 1.0 / $ymax}]
3413 }
3414 allcanvs yview moveto $yf
3415 drawvisible
3416 if {$row ne {}} {
3417 selectline $row 0
3418 } elseif {!$viewcomplete($n)} {
3419 reset_pending_select $selid
3420 } else {
3421 reset_pending_select {}
3422
3423 if {[commitinview $pending_select $curview]} {
3424 selectline [rowofcommit $pending_select] 1
3425 } else {
3426 set row [first_real_row]
3427 if {$row < $numcommits} {
3428 selectline $row 0
3429 }
3430 }
3431 }
3432 if {!$viewcomplete($n)} {
3433 if {$numcommits == 0} {
3434 show_status [mc "Reading commits..."]
3435 }
3436 } elseif {$numcommits == 0} {
3437 show_status [mc "No commits selected"]
3438 }
3439}
3440
3441# Stuff relating to the highlighting facility
3442
3443proc ishighlighted {id} {
3444 global vhighlights fhighlights nhighlights rhighlights
3445
3446 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
3447 return $nhighlights($id)
3448 }
3449 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
3450 return $vhighlights($id)
3451 }
3452 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
3453 return $fhighlights($id)
3454 }
3455 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
3456 return $rhighlights($id)
3457 }
3458 return 0
3459}
3460
3461proc bolden {row font} {
3462 global canv linehtag selectedline boldrows
3463
3464 lappend boldrows $row
3465 $canv itemconf $linehtag($row) -font $font
3466 if {$row == $selectedline} {
3467 $canv delete secsel
3468 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
3469 -outline {{}} -tags secsel \
3470 -fill [$canv cget -selectbackground]]
3471 $canv lower $t
3472 }
3473}
3474
3475proc bolden_name {row font} {
3476 global canv2 linentag selectedline boldnamerows
3477
3478 lappend boldnamerows $row
3479 $canv2 itemconf $linentag($row) -font $font
3480 if {$row == $selectedline} {
3481 $canv2 delete secsel
3482 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
3483 -outline {{}} -tags secsel \
3484 -fill [$canv2 cget -selectbackground]]
3485 $canv2 lower $t
3486 }
3487}
3488
3489proc unbolden {} {
3490 global boldrows
3491
3492 set stillbold {}
3493 foreach row $boldrows {
3494 if {![ishighlighted [commitonrow $row]]} {
3495 bolden $row mainfont
3496 } else {
3497 lappend stillbold $row
3498 }
3499 }
3500 set boldrows $stillbold
3501}
3502
3503proc addvhighlight {n} {
3504 global hlview viewcomplete curview vhl_done commitidx
3505
3506 if {[info exists hlview]} {
3507 delvhighlight
3508 }
3509 set hlview $n
3510 if {$n != $curview && ![info exists viewcomplete($n)]} {
3511 start_rev_list $n
3512 }
3513 set vhl_done $commitidx($hlview)
3514 if {$vhl_done > 0} {
3515 drawvisible
3516 }
3517}
3518
3519proc delvhighlight {} {
3520 global hlview vhighlights
3521
3522 if {![info exists hlview]} return
3523 unset hlview
3524 catch {unset vhighlights}
3525 unbolden
3526}
3527
3528proc vhighlightmore {} {
3529 global hlview vhl_done commitidx vhighlights curview
3530
3531 set max $commitidx($hlview)
3532 set vr [visiblerows]
3533 set r0 [lindex $vr 0]
3534 set r1 [lindex $vr 1]
3535 for {set i $vhl_done} {$i < $max} {incr i} {
3536 set id [commitonrow $i $hlview]
3537 if {[commitinview $id $curview]} {
3538 set row [rowofcommit $id]
3539 if {$r0 <= $row && $row <= $r1} {
3540 if {![highlighted $row]} {
3541 bolden $row mainfontbold
3542 }
3543 set vhighlights($id) 1
3544 }
3545 }
3546 }
3547 set vhl_done $max
3548 return 0
3549}
3550
3551proc askvhighlight {row id} {
3552 global hlview vhighlights iddrawn
3553
3554 if {[commitinview $id $hlview]} {
3555 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
3556 bolden $row mainfontbold
3557 }
3558 set vhighlights($id) 1
3559 } else {
3560 set vhighlights($id) 0
3561 }
3562}
3563
3564proc hfiles_change {} {
3565 global highlight_files filehighlight fhighlights fh_serial
3566 global highlight_paths gdttype
3567
3568 if {[info exists filehighlight]} {
3569 # delete previous highlights
3570 catch {close $filehighlight}
3571 unset filehighlight
3572 catch {unset fhighlights}
3573 unbolden
3574 unhighlight_filelist
3575 }
3576 set highlight_paths {}
3577 after cancel do_file_hl $fh_serial
3578 incr fh_serial
3579 if {$highlight_files ne {}} {
3580 after 300 do_file_hl $fh_serial
3581 }
3582}
3583
3584proc gdttype_change {name ix op} {
3585 global gdttype highlight_files findstring findpattern
3586
3587 stopfinding
3588 if {$findstring ne {}} {
3589 if {$gdttype eq [mc "containing:"]} {
3590 if {$highlight_files ne {}} {
3591 set highlight_files {}
3592 hfiles_change
3593 }
3594 findcom_change
3595 } else {
3596 if {$findpattern ne {}} {
3597 set findpattern {}
3598 findcom_change
3599 }
3600 set highlight_files $findstring
3601 hfiles_change
3602 }
3603 drawvisible
3604 }
3605 # enable/disable findtype/findloc menus too
3606}
3607
3608proc find_change {name ix op} {
3609 global gdttype findstring highlight_files
3610
3611 stopfinding
3612 if {$gdttype eq [mc "containing:"]} {
3613 findcom_change
3614 } else {
3615 if {$highlight_files ne $findstring} {
3616 set highlight_files $findstring
3617 hfiles_change
3618 }
3619 }
3620 drawvisible
3621}
3622
3623proc findcom_change args {
3624 global nhighlights boldnamerows
3625 global findpattern findtype findstring gdttype
3626
3627 stopfinding
3628 # delete previous highlights, if any
3629 foreach row $boldnamerows {
3630 bolden_name $row mainfont
3631 }
3632 set boldnamerows {}
3633 catch {unset nhighlights}
3634 unbolden
3635 unmarkmatches
3636 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
3637 set findpattern {}
3638 } elseif {$findtype eq [mc "Regexp"]} {
3639 set findpattern $findstring
3640 } else {
3641 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
3642 $findstring]
3643 set findpattern "*$e*"
3644 }
3645}
3646
3647proc makepatterns {l} {
3648 set ret {}
3649 foreach e $l {
3650 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3651 if {[string index $ee end] eq "/"} {
3652 lappend ret "$ee*"
3653 } else {
3654 lappend ret $ee
3655 lappend ret "$ee/*"
3656 }
3657 }
3658 return $ret
3659}
3660
3661proc do_file_hl {serial} {
3662 global highlight_files filehighlight highlight_paths gdttype fhl_list
3663
3664 if {$gdttype eq [mc "touching paths:"]} {
3665 if {[catch {set paths [shellsplit $highlight_files]}]} return
3666 set highlight_paths [makepatterns $paths]
3667 highlight_filelist
3668 set gdtargs [concat -- $paths]
3669 } elseif {$gdttype eq [mc "adding/removing string:"]} {
3670 set gdtargs [list "-S$highlight_files"]
3671 } else {
3672 # must be "containing:", i.e. we're searching commit info
3673 return
3674 }
3675 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3676 set filehighlight [open $cmd r+]
3677 fconfigure $filehighlight -blocking 0
3678 filerun $filehighlight readfhighlight
3679 set fhl_list {}
3680 drawvisible
3681 flushhighlights
3682}
3683
3684proc flushhighlights {} {
3685 global filehighlight fhl_list
3686
3687 if {[info exists filehighlight]} {
3688 lappend fhl_list {}
3689 puts $filehighlight ""
3690 flush $filehighlight
3691 }
3692}
3693
3694proc askfilehighlight {row id} {
3695 global filehighlight fhighlights fhl_list
3696
3697 lappend fhl_list $id
3698 set fhighlights($id) -1
3699 puts $filehighlight $id
3700}
3701
3702proc readfhighlight {} {
3703 global filehighlight fhighlights curview iddrawn
3704 global fhl_list find_dirn
3705
3706 if {![info exists filehighlight]} {
3707 return 0
3708 }
3709 set nr 0
3710 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3711 set line [string trim $line]
3712 set i [lsearch -exact $fhl_list $line]
3713 if {$i < 0} continue
3714 for {set j 0} {$j < $i} {incr j} {
3715 set id [lindex $fhl_list $j]
3716 set fhighlights($id) 0
3717 }
3718 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3719 if {$line eq {}} continue
3720 if {![commitinview $line $curview]} continue
3721 set row [rowofcommit $line]
3722 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
3723 bolden $row mainfontbold
3724 }
3725 set fhighlights($line) 1
3726 }
3727 if {[eof $filehighlight]} {
3728 # strange...
3729 puts "oops, git diff-tree died"
3730 catch {close $filehighlight}
3731 unset filehighlight
3732 return 0
3733 }
3734 if {[info exists find_dirn]} {
3735 run findmore
3736 }
3737 return 1
3738}
3739
3740proc doesmatch {f} {
3741 global findtype findpattern
3742
3743 if {$findtype eq [mc "Regexp"]} {
3744 return [regexp $findpattern $f]
3745 } elseif {$findtype eq [mc "IgnCase"]} {
3746 return [string match -nocase $findpattern $f]
3747 } else {
3748 return [string match $findpattern $f]
3749 }
3750}
3751
3752proc askfindhighlight {row id} {
3753 global nhighlights commitinfo iddrawn
3754 global findloc
3755 global markingmatches
3756
3757 if {![info exists commitinfo($id)]} {
3758 getcommit $id
3759 }
3760 set info $commitinfo($id)
3761 set isbold 0
3762 set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
3763 foreach f $info ty $fldtypes {
3764 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
3765 [doesmatch $f]} {
3766 if {$ty eq [mc "Author"]} {
3767 set isbold 2
3768 break
3769 }
3770 set isbold 1
3771 }
3772 }
3773 if {$isbold && [info exists iddrawn($id)]} {
3774 if {![ishighlighted $id]} {
3775 bolden $row mainfontbold
3776 if {$isbold > 1} {
3777 bolden_name $row mainfontbold
3778 }
3779 }
3780 if {$markingmatches} {
3781 markrowmatches $row $id
3782 }
3783 }
3784 set nhighlights($id) $isbold
3785}
3786
3787proc markrowmatches {row id} {
3788 global canv canv2 linehtag linentag commitinfo findloc
3789
3790 set headline [lindex $commitinfo($id) 0]
3791 set author [lindex $commitinfo($id) 1]
3792 $canv delete match$row
3793 $canv2 delete match$row
3794 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
3795 set m [findmatches $headline]
3796 if {$m ne {}} {
3797 markmatches $canv $row $headline $linehtag($row) $m \
3798 [$canv itemcget $linehtag($row) -font] $row
3799 }
3800 }
3801 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
3802 set m [findmatches $author]
3803 if {$m ne {}} {
3804 markmatches $canv2 $row $author $linentag($row) $m \
3805 [$canv2 itemcget $linentag($row) -font] $row
3806 }
3807 }
3808}
3809
3810proc vrel_change {name ix op} {
3811 global highlight_related
3812
3813 rhighlight_none
3814 if {$highlight_related ne [mc "None"]} {
3815 run drawvisible
3816 }
3817}
3818
3819# prepare for testing whether commits are descendents or ancestors of a
3820proc rhighlight_sel {a} {
3821 global descendent desc_todo ancestor anc_todo
3822 global highlight_related
3823
3824 catch {unset descendent}
3825 set desc_todo [list $a]
3826 catch {unset ancestor}
3827 set anc_todo [list $a]
3828 if {$highlight_related ne [mc "None"]} {
3829 rhighlight_none
3830 run drawvisible
3831 }
3832}
3833
3834proc rhighlight_none {} {
3835 global rhighlights
3836
3837 catch {unset rhighlights}
3838 unbolden
3839}
3840
3841proc is_descendent {a} {
3842 global curview children descendent desc_todo
3843
3844 set v $curview
3845 set la [rowofcommit $a]
3846 set todo $desc_todo
3847 set leftover {}
3848 set done 0
3849 for {set i 0} {$i < [llength $todo]} {incr i} {
3850 set do [lindex $todo $i]
3851 if {[rowofcommit $do] < $la} {
3852 lappend leftover $do
3853 continue
3854 }
3855 foreach nk $children($v,$do) {
3856 if {![info exists descendent($nk)]} {
3857 set descendent($nk) 1
3858 lappend todo $nk
3859 if {$nk eq $a} {
3860 set done 1
3861 }
3862 }
3863 }
3864 if {$done} {
3865 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3866 return
3867 }
3868 }
3869 set descendent($a) 0
3870 set desc_todo $leftover
3871}
3872
3873proc is_ancestor {a} {
3874 global curview parents ancestor anc_todo
3875
3876 set v $curview
3877 set la [rowofcommit $a]
3878 set todo $anc_todo
3879 set leftover {}
3880 set done 0
3881 for {set i 0} {$i < [llength $todo]} {incr i} {
3882 set do [lindex $todo $i]
3883 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3884 lappend leftover $do
3885 continue
3886 }
3887 foreach np $parents($v,$do) {
3888 if {![info exists ancestor($np)]} {
3889 set ancestor($np) 1
3890 lappend todo $np
3891 if {$np eq $a} {
3892 set done 1
3893 }
3894 }
3895 }
3896 if {$done} {
3897 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3898 return
3899 }
3900 }
3901 set ancestor($a) 0
3902 set anc_todo $leftover
3903}
3904
3905proc askrelhighlight {row id} {
3906 global descendent highlight_related iddrawn rhighlights
3907 global selectedline ancestor
3908
3909 if {$selectedline eq {}} return
3910 set isbold 0
3911 if {$highlight_related eq [mc "Descendant"] ||
3912 $highlight_related eq [mc "Not descendant"]} {
3913 if {![info exists descendent($id)]} {
3914 is_descendent $id
3915 }
3916 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
3917 set isbold 1
3918 }
3919 } elseif {$highlight_related eq [mc "Ancestor"] ||
3920 $highlight_related eq [mc "Not ancestor"]} {
3921 if {![info exists ancestor($id)]} {
3922 is_ancestor $id
3923 }
3924 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
3925 set isbold 1
3926 }
3927 }
3928 if {[info exists iddrawn($id)]} {
3929 if {$isbold && ![ishighlighted $id]} {
3930 bolden $row mainfontbold
3931 }
3932 }
3933 set rhighlights($id) $isbold
3934}
3935
3936# Graph layout functions
3937
3938proc shortids {ids} {
3939 set res {}
3940 foreach id $ids {
3941 if {[llength $id] > 1} {
3942 lappend res [shortids $id]
3943 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3944 lappend res [string range $id 0 7]
3945 } else {
3946 lappend res $id
3947 }
3948 }
3949 return $res
3950}
3951
3952proc ntimes {n o} {
3953 set ret {}
3954 set o [list $o]
3955 for {set mask 1} {$mask <= $n} {incr mask $mask} {
3956 if {($n & $mask) != 0} {
3957 set ret [concat $ret $o]
3958 }
3959 set o [concat $o $o]
3960 }
3961 return $ret
3962}
3963
3964proc ordertoken {id} {
3965 global ordertok curview varcid varcstart varctok curview parents children
3966 global nullid nullid2
3967
3968 if {[info exists ordertok($id)]} {
3969 return $ordertok($id)
3970 }
3971 set origid $id
3972 set todo {}
3973 while {1} {
3974 if {[info exists varcid($curview,$id)]} {
3975 set a $varcid($curview,$id)
3976 set p [lindex $varcstart($curview) $a]
3977 } else {
3978 set p [lindex $children($curview,$id) 0]
3979 }
3980 if {[info exists ordertok($p)]} {
3981 set tok $ordertok($p)
3982 break
3983 }
3984 set id [first_real_child $curview,$p]
3985 if {$id eq {}} {
3986 # it's a root
3987 set tok [lindex $varctok($curview) $varcid($curview,$p)]
3988 break
3989 }
3990 if {[llength $parents($curview,$id)] == 1} {
3991 lappend todo [list $p {}]
3992 } else {
3993 set j [lsearch -exact $parents($curview,$id) $p]
3994 if {$j < 0} {
3995 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
3996 }
3997 lappend todo [list $p [strrep $j]]
3998 }
3999 }
4000 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4001 set p [lindex $todo $i 0]
4002 append tok [lindex $todo $i 1]
4003 set ordertok($p) $tok
4004 }
4005 set ordertok($origid) $tok
4006 return $tok
4007}
4008
4009# Work out where id should go in idlist so that order-token
4010# values increase from left to right
4011proc idcol {idlist id {i 0}} {
4012 set t [ordertoken $id]
4013 if {$i < 0} {
4014 set i 0
4015 }
4016 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4017 if {$i > [llength $idlist]} {
4018 set i [llength $idlist]
4019 }
4020 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4021 incr i
4022 } else {
4023 if {$t > [ordertoken [lindex $idlist $i]]} {
4024 while {[incr i] < [llength $idlist] &&
4025 $t >= [ordertoken [lindex $idlist $i]]} {}
4026 }
4027 }
4028 return $i
4029}
4030
4031proc initlayout {} {
4032 global rowidlist rowisopt rowfinal displayorder parentlist
4033 global numcommits canvxmax canv
4034 global nextcolor
4035 global colormap rowtextx
4036
4037 set numcommits 0
4038 set displayorder {}
4039 set parentlist {}
4040 set nextcolor 0
4041 set rowidlist {}
4042 set rowisopt {}
4043 set rowfinal {}
4044 set canvxmax [$canv cget -width]
4045 catch {unset colormap}
4046 catch {unset rowtextx}
4047 setcanvscroll
4048}
4049
4050proc setcanvscroll {} {
4051 global canv canv2 canv3 numcommits linespc canvxmax canvy0
4052 global lastscrollset lastscrollrows
4053
4054 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4055 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4056 $canv2 conf -scrollregion [list 0 0 0 $ymax]
4057 $canv3 conf -scrollregion [list 0 0 0 $ymax]
4058 set lastscrollset [clock clicks -milliseconds]
4059 set lastscrollrows $numcommits
4060}
4061
4062proc visiblerows {} {
4063 global canv numcommits linespc
4064
4065 set ymax [lindex [$canv cget -scrollregion] 3]
4066 if {$ymax eq {} || $ymax == 0} return
4067 set f [$canv yview]
4068 set y0 [expr {int([lindex $f 0] * $ymax)}]
4069 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4070 if {$r0 < 0} {
4071 set r0 0
4072 }
4073 set y1 [expr {int([lindex $f 1] * $ymax)}]
4074 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4075 if {$r1 >= $numcommits} {
4076 set r1 [expr {$numcommits - 1}]
4077 }
4078 return [list $r0 $r1]
4079}
4080
4081proc layoutmore {} {
4082 global commitidx viewcomplete curview
4083 global numcommits pending_select curview
4084 global lastscrollset lastscrollrows commitinterest
4085
4086 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4087 [clock clicks -milliseconds] - $lastscrollset > 500} {
4088 setcanvscroll
4089 }
4090 if {[info exists pending_select] &&
4091 [commitinview $pending_select $curview]} {
4092 update
4093 selectline [rowofcommit $pending_select] 1
4094 }
4095 drawvisible
4096}
4097
4098proc doshowlocalchanges {} {
4099 global curview mainheadid
4100
4101 if {$mainheadid eq {}} return
4102 if {[commitinview $mainheadid $curview]} {
4103 dodiffindex
4104 } else {
4105 lappend commitinterest($mainheadid) {dodiffindex}
4106 }
4107}
4108
4109proc dohidelocalchanges {} {
4110 global nullid nullid2 lserial curview
4111
4112 if {[commitinview $nullid $curview]} {
4113 removefakerow $nullid
4114 }
4115 if {[commitinview $nullid2 $curview]} {
4116 removefakerow $nullid2
4117 }
4118 incr lserial
4119}
4120
4121# spawn off a process to do git diff-index --cached HEAD
4122proc dodiffindex {} {
4123 global lserial showlocalchanges
4124 global isworktree
4125
4126 if {!$showlocalchanges || !$isworktree} return
4127 incr lserial
4128 set fd [open "|git diff-index --cached HEAD" r]
4129 fconfigure $fd -blocking 0
4130 set i [reg_instance $fd]
4131 filerun $fd [list readdiffindex $fd $lserial $i]
4132}
4133
4134proc readdiffindex {fd serial inst} {
4135 global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4136
4137 set isdiff 1
4138 if {[gets $fd line] < 0} {
4139 if {![eof $fd]} {
4140 return 1
4141 }
4142 set isdiff 0
4143 }
4144 # we only need to see one line and we don't really care what it says...
4145 stop_instance $inst
4146
4147 if {$serial != $lserial} {
4148 return 0
4149 }
4150
4151 # now see if there are any local changes not checked in to the index
4152 set fd [open "|git diff-files" r]
4153 fconfigure $fd -blocking 0
4154 set i [reg_instance $fd]
4155 filerun $fd [list readdifffiles $fd $serial $i]
4156
4157 if {$isdiff && ![commitinview $nullid2 $curview]} {
4158 # add the line for the changes in the index to the graph
4159 set hl [mc "Local changes checked in to index but not committed"]
4160 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
4161 set commitdata($nullid2) "\n $hl\n"
4162 if {[commitinview $nullid $curview]} {
4163 removefakerow $nullid
4164 }
4165 insertfakerow $nullid2 $mainheadid
4166 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4167 removefakerow $nullid2
4168 }
4169 return 0
4170}
4171
4172proc readdifffiles {fd serial inst} {
4173 global mainheadid nullid nullid2 curview
4174 global commitinfo commitdata lserial
4175
4176 set isdiff 1
4177 if {[gets $fd line] < 0} {
4178 if {![eof $fd]} {
4179 return 1
4180 }
4181 set isdiff 0
4182 }
4183 # we only need to see one line and we don't really care what it says...
4184 stop_instance $inst
4185
4186 if {$serial != $lserial} {
4187 return 0
4188 }
4189
4190 if {$isdiff && ![commitinview $nullid $curview]} {
4191 # add the line for the local diff to the graph
4192 set hl [mc "Local uncommitted changes, not checked in to index"]
4193 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
4194 set commitdata($nullid) "\n $hl\n"
4195 if {[commitinview $nullid2 $curview]} {
4196 set p $nullid2
4197 } else {
4198 set p $mainheadid
4199 }
4200 insertfakerow $nullid $p
4201 } elseif {!$isdiff && [commitinview $nullid $curview]} {
4202 removefakerow $nullid
4203 }
4204 return 0
4205}
4206
4207proc nextuse {id row} {
4208 global curview children
4209
4210 if {[info exists children($curview,$id)]} {
4211 foreach kid $children($curview,$id) {
4212 if {![commitinview $kid $curview]} {
4213 return -1
4214 }
4215 if {[rowofcommit $kid] > $row} {
4216 return [rowofcommit $kid]
4217 }
4218 }
4219 }
4220 if {[commitinview $id $curview]} {
4221 return [rowofcommit $id]
4222 }
4223 return -1
4224}
4225
4226proc prevuse {id row} {
4227 global curview children
4228
4229 set ret -1
4230 if {[info exists children($curview,$id)]} {
4231 foreach kid $children($curview,$id) {
4232 if {![commitinview $kid $curview]} break
4233 if {[rowofcommit $kid] < $row} {
4234 set ret [rowofcommit $kid]
4235 }
4236 }
4237 }
4238 return $ret
4239}
4240
4241proc make_idlist {row} {
4242 global displayorder parentlist uparrowlen downarrowlen mingaplen
4243 global commitidx curview children
4244
4245 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4246 if {$r < 0} {
4247 set r 0
4248 }
4249 set ra [expr {$row - $downarrowlen}]
4250 if {$ra < 0} {
4251 set ra 0
4252 }
4253 set rb [expr {$row + $uparrowlen}]
4254 if {$rb > $commitidx($curview)} {
4255 set rb $commitidx($curview)
4256 }
4257 make_disporder $r [expr {$rb + 1}]
4258 set ids {}
4259 for {} {$r < $ra} {incr r} {
4260 set nextid [lindex $displayorder [expr {$r + 1}]]
4261 foreach p [lindex $parentlist $r] {
4262 if {$p eq $nextid} continue
4263 set rn [nextuse $p $r]
4264 if {$rn >= $row &&
4265 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4266 lappend ids [list [ordertoken $p] $p]
4267 }
4268 }
4269 }
4270 for {} {$r < $row} {incr r} {
4271 set nextid [lindex $displayorder [expr {$r + 1}]]
4272 foreach p [lindex $parentlist $r] {
4273 if {$p eq $nextid} continue
4274 set rn [nextuse $p $r]
4275 if {$rn < 0 || $rn >= $row} {
4276 lappend ids [list [ordertoken $p] $p]
4277 }
4278 }
4279 }
4280 set id [lindex $displayorder $row]
4281 lappend ids [list [ordertoken $id] $id]
4282 while {$r < $rb} {
4283 foreach p [lindex $parentlist $r] {
4284 set firstkid [lindex $children($curview,$p) 0]
4285 if {[rowofcommit $firstkid] < $row} {
4286 lappend ids [list [ordertoken $p] $p]
4287 }
4288 }
4289 incr r
4290 set id [lindex $displayorder $r]
4291 if {$id ne {}} {
4292 set firstkid [lindex $children($curview,$id) 0]
4293 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4294 lappend ids [list [ordertoken $id] $id]
4295 }
4296 }
4297 }
4298 set idlist {}
4299 foreach idx [lsort -unique $ids] {
4300 lappend idlist [lindex $idx 1]
4301 }
4302 return $idlist
4303}
4304
4305proc rowsequal {a b} {
4306 while {[set i [lsearch -exact $a {}]] >= 0} {
4307 set a [lreplace $a $i $i]
4308 }
4309 while {[set i [lsearch -exact $b {}]] >= 0} {
4310 set b [lreplace $b $i $i]
4311 }
4312 return [expr {$a eq $b}]
4313}
4314
4315proc makeupline {id row rend col} {
4316 global rowidlist uparrowlen downarrowlen mingaplen
4317
4318 for {set r $rend} {1} {set r $rstart} {
4319 set rstart [prevuse $id $r]
4320 if {$rstart < 0} return
4321 if {$rstart < $row} break
4322 }
4323 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4324 set rstart [expr {$rend - $uparrowlen - 1}]
4325 }
4326 for {set r $rstart} {[incr r] <= $row} {} {
4327 set idlist [lindex $rowidlist $r]
4328 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4329 set col [idcol $idlist $id $col]
4330 lset rowidlist $r [linsert $idlist $col $id]
4331 changedrow $r
4332 }
4333 }
4334}
4335
4336proc layoutrows {row endrow} {
4337 global rowidlist rowisopt rowfinal displayorder
4338 global uparrowlen downarrowlen maxwidth mingaplen
4339 global children parentlist
4340 global commitidx viewcomplete curview
4341
4342 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4343 set idlist {}
4344 if {$row > 0} {
4345 set rm1 [expr {$row - 1}]
4346 foreach id [lindex $rowidlist $rm1] {
4347 if {$id ne {}} {
4348 lappend idlist $id
4349 }
4350 }
4351 set final [lindex $rowfinal $rm1]
4352 }
4353 for {} {$row < $endrow} {incr row} {
4354 set rm1 [expr {$row - 1}]
4355 if {$rm1 < 0 || $idlist eq {}} {
4356 set idlist [make_idlist $row]
4357 set final 1
4358 } else {
4359 set id [lindex $displayorder $rm1]
4360 set col [lsearch -exact $idlist $id]
4361 set idlist [lreplace $idlist $col $col]
4362 foreach p [lindex $parentlist $rm1] {
4363 if {[lsearch -exact $idlist $p] < 0} {
4364 set col [idcol $idlist $p $col]
4365 set idlist [linsert $idlist $col $p]
4366 # if not the first child, we have to insert a line going up
4367 if {$id ne [lindex $children($curview,$p) 0]} {
4368 makeupline $p $rm1 $row $col
4369 }
4370 }
4371 }
4372 set id [lindex $displayorder $row]
4373 if {$row > $downarrowlen} {
4374 set termrow [expr {$row - $downarrowlen - 1}]
4375 foreach p [lindex $parentlist $termrow] {
4376 set i [lsearch -exact $idlist $p]
4377 if {$i < 0} continue
4378 set nr [nextuse $p $termrow]
4379 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4380 set idlist [lreplace $idlist $i $i]
4381 }
4382 }
4383 }
4384 set col [lsearch -exact $idlist $id]
4385 if {$col < 0} {
4386 set col [idcol $idlist $id]
4387 set idlist [linsert $idlist $col $id]
4388 if {$children($curview,$id) ne {}} {
4389 makeupline $id $rm1 $row $col
4390 }
4391 }
4392 set r [expr {$row + $uparrowlen - 1}]
4393 if {$r < $commitidx($curview)} {
4394 set x $col
4395 foreach p [lindex $parentlist $r] {
4396 if {[lsearch -exact $idlist $p] >= 0} continue
4397 set fk [lindex $children($curview,$p) 0]
4398 if {[rowofcommit $fk] < $row} {
4399 set x [idcol $idlist $p $x]
4400 set idlist [linsert $idlist $x $p]
4401 }
4402 }
4403 if {[incr r] < $commitidx($curview)} {
4404 set p [lindex $displayorder $r]
4405 if {[lsearch -exact $idlist $p] < 0} {
4406 set fk [lindex $children($curview,$p) 0]
4407 if {$fk ne {} && [rowofcommit $fk] < $row} {
4408 set x [idcol $idlist $p $x]
4409 set idlist [linsert $idlist $x $p]
4410 }
4411 }
4412 }
4413 }
4414 }
4415 if {$final && !$viewcomplete($curview) &&
4416 $row + $uparrowlen + $mingaplen + $downarrowlen
4417 >= $commitidx($curview)} {
4418 set final 0
4419 }
4420 set l [llength $rowidlist]
4421 if {$row == $l} {
4422 lappend rowidlist $idlist
4423 lappend rowisopt 0
4424 lappend rowfinal $final
4425 } elseif {$row < $l} {
4426 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4427 lset rowidlist $row $idlist
4428 changedrow $row
4429 }
4430 lset rowfinal $row $final
4431 } else {
4432 set pad [ntimes [expr {$row - $l}] {}]
4433 set rowidlist [concat $rowidlist $pad]
4434 lappend rowidlist $idlist
4435 set rowfinal [concat $rowfinal $pad]
4436 lappend rowfinal $final
4437 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4438 }
4439 }
4440 return $row
4441}
4442
4443proc changedrow {row} {
4444 global displayorder iddrawn rowisopt need_redisplay
4445
4446 set l [llength $rowisopt]
4447 if {$row < $l} {
4448 lset rowisopt $row 0
4449 if {$row + 1 < $l} {
4450 lset rowisopt [expr {$row + 1}] 0
4451 if {$row + 2 < $l} {
4452 lset rowisopt [expr {$row + 2}] 0
4453 }
4454 }
4455 }
4456 set id [lindex $displayorder $row]
4457 if {[info exists iddrawn($id)]} {
4458 set need_redisplay 1
4459 }
4460}
4461
4462proc insert_pad {row col npad} {
4463 global rowidlist
4464
4465 set pad [ntimes $npad {}]
4466 set idlist [lindex $rowidlist $row]
4467 set bef [lrange $idlist 0 [expr {$col - 1}]]
4468 set aft [lrange $idlist $col end]
4469 set i [lsearch -exact $aft {}]
4470 if {$i > 0} {
4471 set aft [lreplace $aft $i $i]
4472 }
4473 lset rowidlist $row [concat $bef $pad $aft]
4474 changedrow $row
4475}
4476
4477proc optimize_rows {row col endrow} {
4478 global rowidlist rowisopt displayorder curview children
4479
4480 if {$row < 1} {
4481 set row 1
4482 }
4483 for {} {$row < $endrow} {incr row; set col 0} {
4484 if {[lindex $rowisopt $row]} continue
4485 set haspad 0
4486 set y0 [expr {$row - 1}]
4487 set ym [expr {$row - 2}]
4488 set idlist [lindex $rowidlist $row]
4489 set previdlist [lindex $rowidlist $y0]
4490 if {$idlist eq {} || $previdlist eq {}} continue
4491 if {$ym >= 0} {
4492 set pprevidlist [lindex $rowidlist $ym]
4493 if {$pprevidlist eq {}} continue
4494 } else {
4495 set pprevidlist {}
4496 }
4497 set x0 -1
4498 set xm -1
4499 for {} {$col < [llength $idlist]} {incr col} {
4500 set id [lindex $idlist $col]
4501 if {[lindex $previdlist $col] eq $id} continue
4502 if {$id eq {}} {
4503 set haspad 1
4504 continue
4505 }
4506 set x0 [lsearch -exact $previdlist $id]
4507 if {$x0 < 0} continue
4508 set z [expr {$x0 - $col}]
4509 set isarrow 0
4510 set z0 {}
4511 if {$ym >= 0} {
4512 set xm [lsearch -exact $pprevidlist $id]
4513 if {$xm >= 0} {
4514 set z0 [expr {$xm - $x0}]
4515 }
4516 }
4517 if {$z0 eq {}} {
4518 # if row y0 is the first child of $id then it's not an arrow
4519 if {[lindex $children($curview,$id) 0] ne
4520 [lindex $displayorder $y0]} {
4521 set isarrow 1
4522 }
4523 }
4524 if {!$isarrow && $id ne [lindex $displayorder $row] &&
4525 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
4526 set isarrow 1
4527 }
4528 # Looking at lines from this row to the previous row,
4529 # make them go straight up if they end in an arrow on
4530 # the previous row; otherwise make them go straight up
4531 # or at 45 degrees.
4532 if {$z < -1 || ($z < 0 && $isarrow)} {
4533 # Line currently goes left too much;
4534 # insert pads in the previous row, then optimize it
4535 set npad [expr {-1 - $z + $isarrow}]
4536 insert_pad $y0 $x0 $npad
4537 if {$y0 > 0} {
4538 optimize_rows $y0 $x0 $row
4539 }
4540 set previdlist [lindex $rowidlist $y0]
4541 set x0 [lsearch -exact $previdlist $id]
4542 set z [expr {$x0 - $col}]
4543 if {$z0 ne {}} {
4544 set pprevidlist [lindex $rowidlist $ym]
4545 set xm [lsearch -exact $pprevidlist $id]
4546 set z0 [expr {$xm - $x0}]
4547 }
4548 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
4549 # Line currently goes right too much;
4550 # insert pads in this line
4551 set npad [expr {$z - 1 + $isarrow}]
4552 insert_pad $row $col $npad
4553 set idlist [lindex $rowidlist $row]
4554 incr col $npad
4555 set z [expr {$x0 - $col}]
4556 set haspad 1
4557 }
4558 if {$z0 eq {} && !$isarrow && $ym >= 0} {
4559 # this line links to its first child on row $row-2
4560 set id [lindex $displayorder $ym]
4561 set xc [lsearch -exact $pprevidlist $id]
4562 if {$xc >= 0} {
4563 set z0 [expr {$xc - $x0}]
4564 }
4565 }
4566 # avoid lines jigging left then immediately right
4567 if {$z0 ne {} && $z < 0 && $z0 > 0} {
4568 insert_pad $y0 $x0 1
4569 incr x0
4570 optimize_rows $y0 $x0 $row
4571 set previdlist [lindex $rowidlist $y0]
4572 }
4573 }
4574 if {!$haspad} {
4575 # Find the first column that doesn't have a line going right
4576 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
4577 set id [lindex $idlist $col]
4578 if {$id eq {}} break
4579 set x0 [lsearch -exact $previdlist $id]
4580 if {$x0 < 0} {
4581 # check if this is the link to the first child
4582 set kid [lindex $displayorder $y0]
4583 if {[lindex $children($curview,$id) 0] eq $kid} {
4584 # it is, work out offset to child
4585 set x0 [lsearch -exact $previdlist $kid]
4586 }
4587 }
4588 if {$x0 <= $col} break
4589 }
4590 # Insert a pad at that column as long as it has a line and
4591 # isn't the last column
4592 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
4593 set idlist [linsert $idlist $col {}]
4594 lset rowidlist $row $idlist
4595 changedrow $row
4596 }
4597 }
4598 }
4599}
4600
4601proc xc {row col} {
4602 global canvx0 linespc
4603 return [expr {$canvx0 + $col * $linespc}]
4604}
4605
4606proc yc {row} {
4607 global canvy0 linespc
4608 return [expr {$canvy0 + $row * $linespc}]
4609}
4610
4611proc linewidth {id} {
4612 global thickerline lthickness
4613
4614 set wid $lthickness
4615 if {[info exists thickerline] && $id eq $thickerline} {
4616 set wid [expr {2 * $lthickness}]
4617 }
4618 return $wid
4619}
4620
4621proc rowranges {id} {
4622 global curview children uparrowlen downarrowlen
4623 global rowidlist
4624
4625 set kids $children($curview,$id)
4626 if {$kids eq {}} {
4627 return {}
4628 }
4629 set ret {}
4630 lappend kids $id
4631 foreach child $kids {
4632 if {![commitinview $child $curview]} break
4633 set row [rowofcommit $child]
4634 if {![info exists prev]} {
4635 lappend ret [expr {$row + 1}]
4636 } else {
4637 if {$row <= $prevrow} {
4638 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
4639 }
4640 # see if the line extends the whole way from prevrow to row
4641 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
4642 [lsearch -exact [lindex $rowidlist \
4643 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
4644 # it doesn't, see where it ends
4645 set r [expr {$prevrow + $downarrowlen}]
4646 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4647 while {[incr r -1] > $prevrow &&
4648 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4649 } else {
4650 while {[incr r] <= $row &&
4651 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4652 incr r -1
4653 }
4654 lappend ret $r
4655 # see where it starts up again
4656 set r [expr {$row - $uparrowlen}]
4657 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
4658 while {[incr r] < $row &&
4659 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
4660 } else {
4661 while {[incr r -1] >= $prevrow &&
4662 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
4663 incr r
4664 }
4665 lappend ret $r
4666 }
4667 }
4668 if {$child eq $id} {
4669 lappend ret $row
4670 }
4671 set prev $child
4672 set prevrow $row
4673 }
4674 return $ret
4675}
4676
4677proc drawlineseg {id row endrow arrowlow} {
4678 global rowidlist displayorder iddrawn linesegs
4679 global canv colormap linespc curview maxlinelen parentlist
4680
4681 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
4682 set le [expr {$row + 1}]
4683 set arrowhigh 1
4684 while {1} {
4685 set c [lsearch -exact [lindex $rowidlist $le] $id]
4686 if {$c < 0} {
4687 incr le -1
4688 break
4689 }
4690 lappend cols $c
4691 set x [lindex $displayorder $le]
4692 if {$x eq $id} {
4693 set arrowhigh 0
4694 break
4695 }
4696 if {[info exists iddrawn($x)] || $le == $endrow} {
4697 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4698 if {$c >= 0} {
4699 lappend cols $c
4700 set arrowhigh 0
4701 }
4702 break
4703 }
4704 incr le
4705 }
4706 if {$le <= $row} {
4707 return $row
4708 }
4709
4710 set lines {}
4711 set i 0
4712 set joinhigh 0
4713 if {[info exists linesegs($id)]} {
4714 set lines $linesegs($id)
4715 foreach li $lines {
4716 set r0 [lindex $li 0]
4717 if {$r0 > $row} {
4718 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4719 set joinhigh 1
4720 }
4721 break
4722 }
4723 incr i
4724 }
4725 }
4726 set joinlow 0
4727 if {$i > 0} {
4728 set li [lindex $lines [expr {$i-1}]]
4729 set r1 [lindex $li 1]
4730 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4731 set joinlow 1
4732 }
4733 }
4734
4735 set x [lindex $cols [expr {$le - $row}]]
4736 set xp [lindex $cols [expr {$le - 1 - $row}]]
4737 set dir [expr {$xp - $x}]
4738 if {$joinhigh} {
4739 set ith [lindex $lines $i 2]
4740 set coords [$canv coords $ith]
4741 set ah [$canv itemcget $ith -arrow]
4742 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4743 set x2 [lindex $cols [expr {$le + 1 - $row}]]
4744 if {$x2 ne {} && $x - $x2 == $dir} {
4745 set coords [lrange $coords 0 end-2]
4746 }
4747 } else {
4748 set coords [list [xc $le $x] [yc $le]]
4749 }
4750 if {$joinlow} {
4751 set itl [lindex $lines [expr {$i-1}] 2]
4752 set al [$canv itemcget $itl -arrow]
4753 set arrowlow [expr {$al eq "last" || $al eq "both"}]
4754 } elseif {$arrowlow} {
4755 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4756 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4757 set arrowlow 0
4758 }
4759 }
4760 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4761 for {set y $le} {[incr y -1] > $row} {} {
4762 set x $xp
4763 set xp [lindex $cols [expr {$y - 1 - $row}]]
4764 set ndir [expr {$xp - $x}]
4765 if {$dir != $ndir || $xp < 0} {
4766 lappend coords [xc $y $x] [yc $y]
4767 }
4768 set dir $ndir
4769 }
4770 if {!$joinlow} {
4771 if {$xp < 0} {
4772 # join parent line to first child
4773 set ch [lindex $displayorder $row]
4774 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4775 if {$xc < 0} {
4776 puts "oops: drawlineseg: child $ch not on row $row"
4777 } elseif {$xc != $x} {
4778 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4779 set d [expr {int(0.5 * $linespc)}]
4780 set x1 [xc $row $x]
4781 if {$xc < $x} {
4782 set x2 [expr {$x1 - $d}]
4783 } else {
4784 set x2 [expr {$x1 + $d}]
4785 }
4786 set y2 [yc $row]
4787 set y1 [expr {$y2 + $d}]
4788 lappend coords $x1 $y1 $x2 $y2
4789 } elseif {$xc < $x - 1} {
4790 lappend coords [xc $row [expr {$x-1}]] [yc $row]
4791 } elseif {$xc > $x + 1} {
4792 lappend coords [xc $row [expr {$x+1}]] [yc $row]
4793 }
4794 set x $xc
4795 }
4796 lappend coords [xc $row $x] [yc $row]
4797 } else {
4798 set xn [xc $row $xp]
4799 set yn [yc $row]
4800 lappend coords $xn $yn
4801 }
4802 if {!$joinhigh} {
4803 assigncolor $id
4804 set t [$canv create line $coords -width [linewidth $id] \
4805 -fill $colormap($id) -tags lines.$id -arrow $arrow]
4806 $canv lower $t
4807 bindline $t $id
4808 set lines [linsert $lines $i [list $row $le $t]]
4809 } else {
4810 $canv coords $ith $coords
4811 if {$arrow ne $ah} {
4812 $canv itemconf $ith -arrow $arrow
4813 }
4814 lset lines $i 0 $row
4815 }
4816 } else {
4817 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4818 set ndir [expr {$xo - $xp}]
4819 set clow [$canv coords $itl]
4820 if {$dir == $ndir} {
4821 set clow [lrange $clow 2 end]
4822 }
4823 set coords [concat $coords $clow]
4824 if {!$joinhigh} {
4825 lset lines [expr {$i-1}] 1 $le
4826 } else {
4827 # coalesce two pieces
4828 $canv delete $ith
4829 set b [lindex $lines [expr {$i-1}] 0]
4830 set e [lindex $lines $i 1]
4831 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4832 }
4833 $canv coords $itl $coords
4834 if {$arrow ne $al} {
4835 $canv itemconf $itl -arrow $arrow
4836 }
4837 }
4838
4839 set linesegs($id) $lines
4840 return $le
4841}
4842
4843proc drawparentlinks {id row} {
4844 global rowidlist canv colormap curview parentlist
4845 global idpos linespc
4846
4847 set rowids [lindex $rowidlist $row]
4848 set col [lsearch -exact $rowids $id]
4849 if {$col < 0} return
4850 set olds [lindex $parentlist $row]
4851 set row2 [expr {$row + 1}]
4852 set x [xc $row $col]
4853 set y [yc $row]
4854 set y2 [yc $row2]
4855 set d [expr {int(0.5 * $linespc)}]
4856 set ymid [expr {$y + $d}]
4857 set ids [lindex $rowidlist $row2]
4858 # rmx = right-most X coord used
4859 set rmx 0
4860 foreach p $olds {
4861 set i [lsearch -exact $ids $p]
4862 if {$i < 0} {
4863 puts "oops, parent $p of $id not in list"
4864 continue
4865 }
4866 set x2 [xc $row2 $i]
4867 if {$x2 > $rmx} {
4868 set rmx $x2
4869 }
4870 set j [lsearch -exact $rowids $p]
4871 if {$j < 0} {
4872 # drawlineseg will do this one for us
4873 continue
4874 }
4875 assigncolor $p
4876 # should handle duplicated parents here...
4877 set coords [list $x $y]
4878 if {$i != $col} {
4879 # if attaching to a vertical segment, draw a smaller
4880 # slant for visual distinctness
4881 if {$i == $j} {
4882 if {$i < $col} {
4883 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4884 } else {
4885 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4886 }
4887 } elseif {$i < $col && $i < $j} {
4888 # segment slants towards us already
4889 lappend coords [xc $row $j] $y
4890 } else {
4891 if {$i < $col - 1} {
4892 lappend coords [expr {$x2 + $linespc}] $y
4893 } elseif {$i > $col + 1} {
4894 lappend coords [expr {$x2 - $linespc}] $y
4895 }
4896 lappend coords $x2 $y2
4897 }
4898 } else {
4899 lappend coords $x2 $y2
4900 }
4901 set t [$canv create line $coords -width [linewidth $p] \
4902 -fill $colormap($p) -tags lines.$p]
4903 $canv lower $t
4904 bindline $t $p
4905 }
4906 if {$rmx > [lindex $idpos($id) 1]} {
4907 lset idpos($id) 1 $rmx
4908 redrawtags $id
4909 }
4910}
4911
4912proc drawlines {id} {
4913 global canv
4914
4915 $canv itemconf lines.$id -width [linewidth $id]
4916}
4917
4918proc drawcmittext {id row col} {
4919 global linespc canv canv2 canv3 fgcolor curview
4920 global cmitlisted commitinfo rowidlist parentlist
4921 global rowtextx idpos idtags idheads idotherrefs
4922 global linehtag linentag linedtag selectedline
4923 global canvxmax boldrows boldnamerows fgcolor
4924 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
4925
4926 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
4927 set listed $cmitlisted($curview,$id)
4928 if {$id eq $nullid} {
4929 set ofill red
4930 } elseif {$id eq $nullid2} {
4931 set ofill green
4932 } elseif {$id eq $mainheadid} {
4933 set ofill yellow
4934 } else {
4935 set ofill [lindex $circlecolors $listed]
4936 }
4937 set x [xc $row $col]
4938 set y [yc $row]
4939 set orad [expr {$linespc / 3}]
4940 if {$listed <= 2} {
4941 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4942 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4943 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4944 } elseif {$listed == 3} {
4945 # triangle pointing left for left-side commits
4946 set t [$canv create polygon \
4947 [expr {$x - $orad}] $y \
4948 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4949 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4950 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4951 } else {
4952 # triangle pointing right for right-side commits
4953 set t [$canv create polygon \
4954 [expr {$x + $orad - 1}] $y \
4955 [expr {$x - $orad}] [expr {$y - $orad}] \
4956 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4957 -fill $ofill -outline $fgcolor -width 1 -tags circle]
4958 }
4959 set circleitem($row) $t
4960 $canv raise $t
4961 $canv bind $t <1> {selcanvline {} %x %y}
4962 set rmx [llength [lindex $rowidlist $row]]
4963 set olds [lindex $parentlist $row]
4964 if {$olds ne {}} {
4965 set nextids [lindex $rowidlist [expr {$row + 1}]]
4966 foreach p $olds {
4967 set i [lsearch -exact $nextids $p]
4968 if {$i > $rmx} {
4969 set rmx $i
4970 }
4971 }
4972 }
4973 set xt [xc $row $rmx]
4974 set rowtextx($row) $xt
4975 set idpos($id) [list $x $xt $y]
4976 if {[info exists idtags($id)] || [info exists idheads($id)]
4977 || [info exists idotherrefs($id)]} {
4978 set xt [drawtags $id $x $xt $y]
4979 }
4980 set headline [lindex $commitinfo($id) 0]
4981 set name [lindex $commitinfo($id) 1]
4982 set date [lindex $commitinfo($id) 2]
4983 set date [formatdate $date]
4984 set font mainfont
4985 set nfont mainfont
4986 set isbold [ishighlighted $id]
4987 if {$isbold > 0} {
4988 lappend boldrows $row
4989 set font mainfontbold
4990 if {$isbold > 1} {
4991 lappend boldnamerows $row
4992 set nfont mainfontbold
4993 }
4994 }
4995 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4996 -text $headline -font $font -tags text]
4997 $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
4998 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4999 -text $name -font $nfont -tags text]
5000 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5001 -text $date -font mainfont -tags text]
5002 if {$selectedline == $row} {
5003 make_secsel $row
5004 }
5005 set xr [expr {$xt + [font measure $font $headline]}]
5006 if {$xr > $canvxmax} {
5007 set canvxmax $xr
5008 setcanvscroll
5009 }
5010}
5011
5012proc drawcmitrow {row} {
5013 global displayorder rowidlist nrows_drawn
5014 global iddrawn markingmatches
5015 global commitinfo numcommits
5016 global filehighlight fhighlights findpattern nhighlights
5017 global hlview vhighlights
5018 global highlight_related rhighlights
5019
5020 if {$row >= $numcommits} return
5021
5022 set id [lindex $displayorder $row]
5023 if {[info exists hlview] && ![info exists vhighlights($id)]} {
5024 askvhighlight $row $id
5025 }
5026 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5027 askfilehighlight $row $id
5028 }
5029 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5030 askfindhighlight $row $id
5031 }
5032 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5033 askrelhighlight $row $id
5034 }
5035 if {![info exists iddrawn($id)]} {
5036 set col [lsearch -exact [lindex $rowidlist $row] $id]
5037 if {$col < 0} {
5038 puts "oops, row $row id $id not in list"
5039 return
5040 }
5041 if {![info exists commitinfo($id)]} {
5042 getcommit $id
5043 }
5044 assigncolor $id
5045 drawcmittext $id $row $col
5046 set iddrawn($id) 1
5047 incr nrows_drawn
5048 }
5049 if {$markingmatches} {
5050 markrowmatches $row $id
5051 }
5052}
5053
5054proc drawcommits {row {endrow {}}} {
5055 global numcommits iddrawn displayorder curview need_redisplay
5056 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5057
5058 if {$row < 0} {
5059 set row 0
5060 }
5061 if {$endrow eq {}} {
5062 set endrow $row
5063 }
5064 if {$endrow >= $numcommits} {
5065 set endrow [expr {$numcommits - 1}]
5066 }
5067
5068 set rl1 [expr {$row - $downarrowlen - 3}]
5069 if {$rl1 < 0} {
5070 set rl1 0
5071 }
5072 set ro1 [expr {$row - 3}]
5073 if {$ro1 < 0} {
5074 set ro1 0
5075 }
5076 set r2 [expr {$endrow + $uparrowlen + 3}]
5077 if {$r2 > $numcommits} {
5078 set r2 $numcommits
5079 }
5080 for {set r $rl1} {$r < $r2} {incr r} {
5081 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5082 if {$rl1 < $r} {
5083 layoutrows $rl1 $r
5084 }
5085 set rl1 [expr {$r + 1}]
5086 }
5087 }
5088 if {$rl1 < $r} {
5089 layoutrows $rl1 $r
5090 }
5091 optimize_rows $ro1 0 $r2
5092 if {$need_redisplay || $nrows_drawn > 2000} {
5093 clear_display
5094 drawvisible
5095 }
5096
5097 # make the lines join to already-drawn rows either side
5098 set r [expr {$row - 1}]
5099 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5100 set r $row
5101 }
5102 set er [expr {$endrow + 1}]
5103 if {$er >= $numcommits ||
5104 ![info exists iddrawn([lindex $displayorder $er])]} {
5105 set er $endrow
5106 }
5107 for {} {$r <= $er} {incr r} {
5108 set id [lindex $displayorder $r]
5109 set wasdrawn [info exists iddrawn($id)]
5110 drawcmitrow $r
5111 if {$r == $er} break
5112 set nextid [lindex $displayorder [expr {$r + 1}]]
5113 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5114 drawparentlinks $id $r
5115
5116 set rowids [lindex $rowidlist $r]
5117 foreach lid $rowids {
5118 if {$lid eq {}} continue
5119 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5120 if {$lid eq $id} {
5121 # see if this is the first child of any of its parents
5122 foreach p [lindex $parentlist $r] {
5123 if {[lsearch -exact $rowids $p] < 0} {
5124 # make this line extend up to the child
5125 set lineend($p) [drawlineseg $p $r $er 0]
5126 }
5127 }
5128 } else {
5129 set lineend($lid) [drawlineseg $lid $r $er 1]
5130 }
5131 }
5132 }
5133}
5134
5135proc undolayout {row} {
5136 global uparrowlen mingaplen downarrowlen
5137 global rowidlist rowisopt rowfinal need_redisplay
5138
5139 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5140 if {$r < 0} {
5141 set r 0
5142 }
5143 if {[llength $rowidlist] > $r} {
5144 incr r -1
5145 set rowidlist [lrange $rowidlist 0 $r]
5146 set rowfinal [lrange $rowfinal 0 $r]
5147 set rowisopt [lrange $rowisopt 0 $r]
5148 set need_redisplay 1
5149 run drawvisible
5150 }
5151}
5152
5153proc drawvisible {} {
5154 global canv linespc curview vrowmod selectedline targetrow targetid
5155 global need_redisplay cscroll numcommits
5156
5157 set fs [$canv yview]
5158 set ymax [lindex [$canv cget -scrollregion] 3]
5159 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5160 set f0 [lindex $fs 0]
5161 set f1 [lindex $fs 1]
5162 set y0 [expr {int($f0 * $ymax)}]
5163 set y1 [expr {int($f1 * $ymax)}]
5164
5165 if {[info exists targetid]} {
5166 if {[commitinview $targetid $curview]} {
5167 set r [rowofcommit $targetid]
5168 if {$r != $targetrow} {
5169 # Fix up the scrollregion and change the scrolling position
5170 # now that our target row has moved.
5171 set diff [expr {($r - $targetrow) * $linespc}]
5172 set targetrow $r
5173 setcanvscroll
5174 set ymax [lindex [$canv cget -scrollregion] 3]
5175 incr y0 $diff
5176 incr y1 $diff
5177 set f0 [expr {$y0 / $ymax}]
5178 set f1 [expr {$y1 / $ymax}]
5179 allcanvs yview moveto $f0
5180 $cscroll set $f0 $f1
5181 set need_redisplay 1
5182 }
5183 } else {
5184 unset targetid
5185 }
5186 }
5187
5188 set row [expr {int(($y0 - 3) / $linespc) - 1}]
5189 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5190 if {$endrow >= $vrowmod($curview)} {
5191 update_arcrows $curview
5192 }
5193 if {$selectedline ne {} &&
5194 $row <= $selectedline && $selectedline <= $endrow} {
5195 set targetrow $selectedline
5196 } elseif {[info exists targetid]} {
5197 set targetrow [expr {int(($row + $endrow) / 2)}]
5198 }
5199 if {[info exists targetrow]} {
5200 if {$targetrow >= $numcommits} {
5201 set targetrow [expr {$numcommits - 1}]
5202 }
5203 set targetid [commitonrow $targetrow]
5204 }
5205 drawcommits $row $endrow
5206}
5207
5208proc clear_display {} {
5209 global iddrawn linesegs need_redisplay nrows_drawn
5210 global vhighlights fhighlights nhighlights rhighlights
5211 global linehtag linentag linedtag boldrows boldnamerows
5212
5213 allcanvs delete all
5214 catch {unset iddrawn}
5215 catch {unset linesegs}
5216 catch {unset linehtag}
5217 catch {unset linentag}
5218 catch {unset linedtag}
5219 set boldrows {}
5220 set boldnamerows {}
5221 catch {unset vhighlights}
5222 catch {unset fhighlights}
5223 catch {unset nhighlights}
5224 catch {unset rhighlights}
5225 set need_redisplay 0
5226 set nrows_drawn 0
5227}
5228
5229proc findcrossings {id} {
5230 global rowidlist parentlist numcommits displayorder
5231
5232 set cross {}
5233 set ccross {}
5234 foreach {s e} [rowranges $id] {
5235 if {$e >= $numcommits} {
5236 set e [expr {$numcommits - 1}]
5237 }
5238 if {$e <= $s} continue
5239 for {set row $e} {[incr row -1] >= $s} {} {
5240 set x [lsearch -exact [lindex $rowidlist $row] $id]
5241 if {$x < 0} break
5242 set olds [lindex $parentlist $row]
5243 set kid [lindex $displayorder $row]
5244 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5245 if {$kidx < 0} continue
5246 set nextrow [lindex $rowidlist [expr {$row + 1}]]
5247 foreach p $olds {
5248 set px [lsearch -exact $nextrow $p]
5249 if {$px < 0} continue
5250 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5251 if {[lsearch -exact $ccross $p] >= 0} continue
5252 if {$x == $px + ($kidx < $px? -1: 1)} {
5253 lappend ccross $p
5254 } elseif {[lsearch -exact $cross $p] < 0} {
5255 lappend cross $p
5256 }
5257 }
5258 }
5259 }
5260 }
5261 return [concat $ccross {{}} $cross]
5262}
5263
5264proc assigncolor {id} {
5265 global colormap colors nextcolor
5266 global parents children children curview
5267
5268 if {[info exists colormap($id)]} return
5269 set ncolors [llength $colors]
5270 if {[info exists children($curview,$id)]} {
5271 set kids $children($curview,$id)
5272 } else {
5273 set kids {}
5274 }
5275 if {[llength $kids] == 1} {
5276 set child [lindex $kids 0]
5277 if {[info exists colormap($child)]
5278 && [llength $parents($curview,$child)] == 1} {
5279 set colormap($id) $colormap($child)
5280 return
5281 }
5282 }
5283 set badcolors {}
5284 set origbad {}
5285 foreach x [findcrossings $id] {
5286 if {$x eq {}} {
5287 # delimiter between corner crossings and other crossings
5288 if {[llength $badcolors] >= $ncolors - 1} break
5289 set origbad $badcolors
5290 }
5291 if {[info exists colormap($x)]
5292 && [lsearch -exact $badcolors $colormap($x)] < 0} {
5293 lappend badcolors $colormap($x)
5294 }
5295 }
5296 if {[llength $badcolors] >= $ncolors} {
5297 set badcolors $origbad
5298 }
5299 set origbad $badcolors
5300 if {[llength $badcolors] < $ncolors - 1} {
5301 foreach child $kids {
5302 if {[info exists colormap($child)]
5303 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5304 lappend badcolors $colormap($child)
5305 }
5306 foreach p $parents($curview,$child) {
5307 if {[info exists colormap($p)]
5308 && [lsearch -exact $badcolors $colormap($p)] < 0} {
5309 lappend badcolors $colormap($p)
5310 }
5311 }
5312 }
5313 if {[llength $badcolors] >= $ncolors} {
5314 set badcolors $origbad
5315 }
5316 }
5317 for {set i 0} {$i <= $ncolors} {incr i} {
5318 set c [lindex $colors $nextcolor]
5319 if {[incr nextcolor] >= $ncolors} {
5320 set nextcolor 0
5321 }
5322 if {[lsearch -exact $badcolors $c]} break
5323 }
5324 set colormap($id) $c
5325}
5326
5327proc bindline {t id} {
5328 global canv
5329
5330 $canv bind $t <Enter> "lineenter %x %y $id"
5331 $canv bind $t <Motion> "linemotion %x %y $id"
5332 $canv bind $t <Leave> "lineleave $id"
5333 $canv bind $t <Button-1> "lineclick %x %y $id 1"
5334}
5335
5336proc drawtags {id x xt y1} {
5337 global idtags idheads idotherrefs mainhead
5338 global linespc lthickness
5339 global canv rowtextx curview fgcolor bgcolor ctxbut
5340
5341 set marks {}
5342 set ntags 0
5343 set nheads 0
5344 if {[info exists idtags($id)]} {
5345 set marks $idtags($id)
5346 set ntags [llength $marks]
5347 }
5348 if {[info exists idheads($id)]} {
5349 set marks [concat $marks $idheads($id)]
5350 set nheads [llength $idheads($id)]
5351 }
5352 if {[info exists idotherrefs($id)]} {
5353 set marks [concat $marks $idotherrefs($id)]
5354 }
5355 if {$marks eq {}} {
5356 return $xt
5357 }
5358
5359 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5360 set yt [expr {$y1 - 0.5 * $linespc}]
5361 set yb [expr {$yt + $linespc - 1}]
5362 set xvals {}
5363 set wvals {}
5364 set i -1
5365 foreach tag $marks {
5366 incr i
5367 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5368 set wid [font measure mainfontbold $tag]
5369 } else {
5370 set wid [font measure mainfont $tag]
5371 }
5372 lappend xvals $xt
5373 lappend wvals $wid
5374 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5375 }
5376 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5377 -width $lthickness -fill black -tags tag.$id]
5378 $canv lower $t
5379 foreach tag $marks x $xvals wid $wvals {
5380 set xl [expr {$x + $delta}]
5381 set xr [expr {$x + $delta + $wid + $lthickness}]
5382 set font mainfont
5383 if {[incr ntags -1] >= 0} {
5384 # draw a tag
5385 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5386 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5387 -width 1 -outline black -fill yellow -tags tag.$id]
5388 $canv bind $t <1> [list showtag $tag 1]
5389 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5390 } else {
5391 # draw a head or other ref
5392 if {[incr nheads -1] >= 0} {
5393 set col green
5394 if {$tag eq $mainhead} {
5395 set font mainfontbold
5396 }
5397 } else {
5398 set col "#ddddff"
5399 }
5400 set xl [expr {$xl - $delta/2}]
5401 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5402 -width 1 -outline black -fill $col -tags tag.$id
5403 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5404 set rwid [font measure mainfont $remoteprefix]
5405 set xi [expr {$x + 1}]
5406 set yti [expr {$yt + 1}]
5407 set xri [expr {$x + $rwid}]
5408 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5409 -width 0 -fill "#ffddaa" -tags tag.$id
5410 }
5411 }
5412 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5413 -font $font -tags [list tag.$id text]]
5414 if {$ntags >= 0} {
5415 $canv bind $t <1> [list showtag $tag 1]
5416 } elseif {$nheads >= 0} {
5417 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5418 }
5419 }
5420 return $xt
5421}
5422
5423proc xcoord {i level ln} {
5424 global canvx0 xspc1 xspc2
5425
5426 set x [expr {$canvx0 + $i * $xspc1($ln)}]
5427 if {$i > 0 && $i == $level} {
5428 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5429 } elseif {$i > $level} {
5430 set x [expr {$x + $xspc2 - $xspc1($ln)}]
5431 }
5432 return $x
5433}
5434
5435proc show_status {msg} {
5436 global canv fgcolor
5437
5438 clear_display
5439 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5440 -tags text -fill $fgcolor
5441}
5442
5443# Don't change the text pane cursor if it is currently the hand cursor,
5444# showing that we are over a sha1 ID link.
5445proc settextcursor {c} {
5446 global ctext curtextcursor
5447
5448 if {[$ctext cget -cursor] == $curtextcursor} {
5449 $ctext config -cursor $c
5450 }
5451 set curtextcursor $c
5452}
5453
5454proc nowbusy {what {name {}}} {
5455 global isbusy busyname statusw
5456
5457 if {[array names isbusy] eq {}} {
5458 . config -cursor watch
5459 settextcursor watch
5460 }
5461 set isbusy($what) 1
5462 set busyname($what) $name
5463 if {$name ne {}} {
5464 $statusw conf -text $name
5465 }
5466}
5467
5468proc notbusy {what} {
5469 global isbusy maincursor textcursor busyname statusw
5470
5471 catch {
5472 unset isbusy($what)
5473 if {$busyname($what) ne {} &&
5474 [$statusw cget -text] eq $busyname($what)} {
5475 $statusw conf -text {}
5476 }
5477 }
5478 if {[array names isbusy] eq {}} {
5479 . config -cursor $maincursor
5480 settextcursor $textcursor
5481 }
5482}
5483
5484proc findmatches {f} {
5485 global findtype findstring
5486 if {$findtype == [mc "Regexp"]} {
5487 set matches [regexp -indices -all -inline $findstring $f]
5488 } else {
5489 set fs $findstring
5490 if {$findtype == [mc "IgnCase"]} {
5491 set f [string tolower $f]
5492 set fs [string tolower $fs]
5493 }
5494 set matches {}
5495 set i 0
5496 set l [string length $fs]
5497 while {[set j [string first $fs $f $i]] >= 0} {
5498 lappend matches [list $j [expr {$j+$l-1}]]
5499 set i [expr {$j + $l}]
5500 }
5501 }
5502 return $matches
5503}
5504
5505proc dofind {{dirn 1} {wrap 1}} {
5506 global findstring findstartline findcurline selectedline numcommits
5507 global gdttype filehighlight fh_serial find_dirn findallowwrap
5508
5509 if {[info exists find_dirn]} {
5510 if {$find_dirn == $dirn} return
5511 stopfinding
5512 }
5513 focus .
5514 if {$findstring eq {} || $numcommits == 0} return
5515 if {$selectedline eq {}} {
5516 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5517 } else {
5518 set findstartline $selectedline
5519 }
5520 set findcurline $findstartline
5521 nowbusy finding [mc "Searching"]
5522 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5523 after cancel do_file_hl $fh_serial
5524 do_file_hl $fh_serial
5525 }
5526 set find_dirn $dirn
5527 set findallowwrap $wrap
5528 run findmore
5529}
5530
5531proc stopfinding {} {
5532 global find_dirn findcurline fprogcoord
5533
5534 if {[info exists find_dirn]} {
5535 unset find_dirn
5536 unset findcurline
5537 notbusy finding
5538 set fprogcoord 0
5539 adjustprogress
5540 }
5541}
5542
5543proc findmore {} {
5544 global commitdata commitinfo numcommits findpattern findloc
5545 global findstartline findcurline findallowwrap
5546 global find_dirn gdttype fhighlights fprogcoord
5547 global curview varcorder vrownum varccommits vrowmod
5548
5549 if {![info exists find_dirn]} {
5550 return 0
5551 }
5552 set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5553 set l $findcurline
5554 set moretodo 0
5555 if {$find_dirn > 0} {
5556 incr l
5557 if {$l >= $numcommits} {
5558 set l 0
5559 }
5560 if {$l <= $findstartline} {
5561 set lim [expr {$findstartline + 1}]
5562 } else {
5563 set lim $numcommits
5564 set moretodo $findallowwrap
5565 }
5566 } else {
5567 if {$l == 0} {
5568 set l $numcommits
5569 }
5570 incr l -1
5571 if {$l >= $findstartline} {
5572 set lim [expr {$findstartline - 1}]
5573 } else {
5574 set lim -1
5575 set moretodo $findallowwrap
5576 }
5577 }
5578 set n [expr {($lim - $l) * $find_dirn}]
5579 if {$n > 500} {
5580 set n 500
5581 set moretodo 1
5582 }
5583 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5584 update_arcrows $curview
5585 }
5586 set found 0
5587 set domore 1
5588 set ai [bsearch $vrownum($curview) $l]
5589 set a [lindex $varcorder($curview) $ai]
5590 set arow [lindex $vrownum($curview) $ai]
5591 set ids [lindex $varccommits($curview,$a)]
5592 set arowend [expr {$arow + [llength $ids]}]
5593 if {$gdttype eq [mc "containing:"]} {
5594 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5595 if {$l < $arow || $l >= $arowend} {
5596 incr ai $find_dirn
5597 set a [lindex $varcorder($curview) $ai]
5598 set arow [lindex $vrownum($curview) $ai]
5599 set ids [lindex $varccommits($curview,$a)]
5600 set arowend [expr {$arow + [llength $ids]}]
5601 }
5602 set id [lindex $ids [expr {$l - $arow}]]
5603 # shouldn't happen unless git log doesn't give all the commits...
5604 if {![info exists commitdata($id)] ||
5605 ![doesmatch $commitdata($id)]} {
5606 continue
5607 }
5608 if {![info exists commitinfo($id)]} {
5609 getcommit $id
5610 }
5611 set info $commitinfo($id)
5612 foreach f $info ty $fldtypes {
5613 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5614 [doesmatch $f]} {
5615 set found 1
5616 break
5617 }
5618 }
5619 if {$found} break
5620 }
5621 } else {
5622 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5623 if {$l < $arow || $l >= $arowend} {
5624 incr ai $find_dirn
5625 set a [lindex $varcorder($curview) $ai]
5626 set arow [lindex $vrownum($curview) $ai]
5627 set ids [lindex $varccommits($curview,$a)]
5628 set arowend [expr {$arow + [llength $ids]}]
5629 }
5630 set id [lindex $ids [expr {$l - $arow}]]
5631 if {![info exists fhighlights($id)]} {
5632 # this sets fhighlights($id) to -1
5633 askfilehighlight $l $id
5634 }
5635 if {$fhighlights($id) > 0} {
5636 set found $domore
5637 break
5638 }
5639 if {$fhighlights($id) < 0} {
5640 if {$domore} {
5641 set domore 0
5642 set findcurline [expr {$l - $find_dirn}]
5643 }
5644 }
5645 }
5646 }
5647 if {$found || ($domore && !$moretodo)} {
5648 unset findcurline
5649 unset find_dirn
5650 notbusy finding
5651 set fprogcoord 0
5652 adjustprogress
5653 if {$found} {
5654 findselectline $l
5655 } else {
5656 bell
5657 }
5658 return 0
5659 }
5660 if {!$domore} {
5661 flushhighlights
5662 } else {
5663 set findcurline [expr {$l - $find_dirn}]
5664 }
5665 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5666 if {$n < 0} {
5667 incr n $numcommits
5668 }
5669 set fprogcoord [expr {$n * 1.0 / $numcommits}]
5670 adjustprogress
5671 return $domore
5672}
5673
5674proc findselectline {l} {
5675 global findloc commentend ctext findcurline markingmatches gdttype
5676
5677 set markingmatches 1
5678 set findcurline $l
5679 selectline $l 1
5680 if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5681 # highlight the matches in the comments
5682 set f [$ctext get 1.0 $commentend]
5683 set matches [findmatches $f]
5684 foreach match $matches {
5685 set start [lindex $match 0]
5686 set end [expr {[lindex $match 1] + 1}]
5687 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5688 }
5689 }
5690 drawvisible
5691}
5692
5693# mark the bits of a headline or author that match a find string
5694proc markmatches {canv l str tag matches font row} {
5695 global selectedline
5696
5697 set bbox [$canv bbox $tag]
5698 set x0 [lindex $bbox 0]
5699 set y0 [lindex $bbox 1]
5700 set y1 [lindex $bbox 3]
5701 foreach match $matches {
5702 set start [lindex $match 0]
5703 set end [lindex $match 1]
5704 if {$start > $end} continue
5705 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5706 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5707 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5708 [expr {$x0+$xlen+2}] $y1 \
5709 -outline {} -tags [list match$l matches] -fill yellow]
5710 $canv lower $t
5711 if {$row == $selectedline} {
5712 $canv raise $t secsel
5713 }
5714 }
5715}
5716
5717proc unmarkmatches {} {
5718 global markingmatches
5719
5720 allcanvs delete matches
5721 set markingmatches 0
5722 stopfinding
5723}
5724
5725proc selcanvline {w x y} {
5726 global canv canvy0 ctext linespc
5727 global rowtextx
5728 set ymax [lindex [$canv cget -scrollregion] 3]
5729 if {$ymax == {}} return
5730 set yfrac [lindex [$canv yview] 0]
5731 set y [expr {$y + $yfrac * $ymax}]
5732 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5733 if {$l < 0} {
5734 set l 0
5735 }
5736 if {$w eq $canv} {
5737 set xmax [lindex [$canv cget -scrollregion] 2]
5738 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5739 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5740 }
5741 unmarkmatches
5742 selectline $l 1
5743}
5744
5745proc commit_descriptor {p} {
5746 global commitinfo
5747 if {![info exists commitinfo($p)]} {
5748 getcommit $p
5749 }
5750 set l "..."
5751 if {[llength $commitinfo($p)] > 1} {
5752 set l [lindex $commitinfo($p) 0]
5753 }
5754 return "$p ($l)\n"
5755}
5756
5757# append some text to the ctext widget, and make any SHA1 ID
5758# that we know about be a clickable link.
5759proc appendwithlinks {text tags} {
5760 global ctext linknum curview pendinglinks
5761
5762 set start [$ctext index "end - 1c"]
5763 $ctext insert end $text $tags
5764 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5765 foreach l $links {
5766 set s [lindex $l 0]
5767 set e [lindex $l 1]
5768 set linkid [string range $text $s $e]
5769 incr e
5770 $ctext tag delete link$linknum
5771 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5772 setlink $linkid link$linknum
5773 incr linknum
5774 }
5775}
5776
5777proc setlink {id lk} {
5778 global curview ctext pendinglinks commitinterest
5779
5780 if {[commitinview $id $curview]} {
5781 $ctext tag conf $lk -foreground blue -underline 1
5782 $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5783 $ctext tag bind $lk <Enter> {linkcursor %W 1}
5784 $ctext tag bind $lk <Leave> {linkcursor %W -1}
5785 } else {
5786 lappend pendinglinks($id) $lk
5787 lappend commitinterest($id) {makelink %I}
5788 }
5789}
5790
5791proc makelink {id} {
5792 global pendinglinks
5793
5794 if {![info exists pendinglinks($id)]} return
5795 foreach lk $pendinglinks($id) {
5796 setlink $id $lk
5797 }
5798 unset pendinglinks($id)
5799}
5800
5801proc linkcursor {w inc} {
5802 global linkentercount curtextcursor
5803
5804 if {[incr linkentercount $inc] > 0} {
5805 $w configure -cursor hand2
5806 } else {
5807 $w configure -cursor $curtextcursor
5808 if {$linkentercount < 0} {
5809 set linkentercount 0
5810 }
5811 }
5812}
5813
5814proc viewnextline {dir} {
5815 global canv linespc
5816
5817 $canv delete hover
5818 set ymax [lindex [$canv cget -scrollregion] 3]
5819 set wnow [$canv yview]
5820 set wtop [expr {[lindex $wnow 0] * $ymax}]
5821 set newtop [expr {$wtop + $dir * $linespc}]
5822 if {$newtop < 0} {
5823 set newtop 0
5824 } elseif {$newtop > $ymax} {
5825 set newtop $ymax
5826 }
5827 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5828}
5829
5830# add a list of tag or branch names at position pos
5831# returns the number of names inserted
5832proc appendrefs {pos ids var} {
5833 global ctext linknum curview $var maxrefs
5834
5835 if {[catch {$ctext index $pos}]} {
5836 return 0
5837 }
5838 $ctext conf -state normal
5839 $ctext delete $pos "$pos lineend"
5840 set tags {}
5841 foreach id $ids {
5842 foreach tag [set $var\($id\)] {
5843 lappend tags [list $tag $id]
5844 }
5845 }
5846 if {[llength $tags] > $maxrefs} {
5847 $ctext insert $pos "many ([llength $tags])"
5848 } else {
5849 set tags [lsort -index 0 -decreasing $tags]
5850 set sep {}
5851 foreach ti $tags {
5852 set id [lindex $ti 1]
5853 set lk link$linknum
5854 incr linknum
5855 $ctext tag delete $lk
5856 $ctext insert $pos $sep
5857 $ctext insert $pos [lindex $ti 0] $lk
5858 setlink $id $lk
5859 set sep ", "
5860 }
5861 }
5862 $ctext conf -state disabled
5863 return [llength $tags]
5864}
5865
5866# called when we have finished computing the nearby tags
5867proc dispneartags {delay} {
5868 global selectedline currentid showneartags tagphase
5869
5870 if {$selectedline eq {} || !$showneartags} return
5871 after cancel dispnexttag
5872 if {$delay} {
5873 after 200 dispnexttag
5874 set tagphase -1
5875 } else {
5876 after idle dispnexttag
5877 set tagphase 0
5878 }
5879}
5880
5881proc dispnexttag {} {
5882 global selectedline currentid showneartags tagphase ctext
5883
5884 if {$selectedline eq {} || !$showneartags} return
5885 switch -- $tagphase {
5886 0 {
5887 set dtags [desctags $currentid]
5888 if {$dtags ne {}} {
5889 appendrefs precedes $dtags idtags
5890 }
5891 }
5892 1 {
5893 set atags [anctags $currentid]
5894 if {$atags ne {}} {
5895 appendrefs follows $atags idtags
5896 }
5897 }
5898 2 {
5899 set dheads [descheads $currentid]
5900 if {$dheads ne {}} {
5901 if {[appendrefs branch $dheads idheads] > 1
5902 && [$ctext get "branch -3c"] eq "h"} {
5903 # turn "Branch" into "Branches"
5904 $ctext conf -state normal
5905 $ctext insert "branch -2c" "es"
5906 $ctext conf -state disabled
5907 }
5908 }
5909 }
5910 }
5911 if {[incr tagphase] <= 2} {
5912 after idle dispnexttag
5913 }
5914}
5915
5916proc make_secsel {l} {
5917 global linehtag linentag linedtag canv canv2 canv3
5918
5919 if {![info exists linehtag($l)]} return
5920 $canv delete secsel
5921 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5922 -tags secsel -fill [$canv cget -selectbackground]]
5923 $canv lower $t
5924 $canv2 delete secsel
5925 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5926 -tags secsel -fill [$canv2 cget -selectbackground]]
5927 $canv2 lower $t
5928 $canv3 delete secsel
5929 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5930 -tags secsel -fill [$canv3 cget -selectbackground]]
5931 $canv3 lower $t
5932}
5933
5934proc selectline {l isnew} {
5935 global canv ctext commitinfo selectedline
5936 global canvy0 linespc parents children curview
5937 global currentid sha1entry
5938 global commentend idtags linknum
5939 global mergemax numcommits pending_select
5940 global cmitmode showneartags allcommits
5941 global targetrow targetid lastscrollrows
5942 global autoselect
5943
5944 catch {unset pending_select}
5945 $canv delete hover
5946 normalline
5947 unsel_reflist
5948 stopfinding
5949 if {$l < 0 || $l >= $numcommits} return
5950 set id [commitonrow $l]
5951 set targetid $id
5952 set targetrow $l
5953 set selectedline $l
5954 set currentid $id
5955 if {$lastscrollrows < $numcommits} {
5956 setcanvscroll
5957 }
5958
5959 set y [expr {$canvy0 + $l * $linespc}]
5960 set ymax [lindex [$canv cget -scrollregion] 3]
5961 set ytop [expr {$y - $linespc - 1}]
5962 set ybot [expr {$y + $linespc + 1}]
5963 set wnow [$canv yview]
5964 set wtop [expr {[lindex $wnow 0] * $ymax}]
5965 set wbot [expr {[lindex $wnow 1] * $ymax}]
5966 set wh [expr {$wbot - $wtop}]
5967 set newtop $wtop
5968 if {$ytop < $wtop} {
5969 if {$ybot < $wtop} {
5970 set newtop [expr {$y - $wh / 2.0}]
5971 } else {
5972 set newtop $ytop
5973 if {$newtop > $wtop - $linespc} {
5974 set newtop [expr {$wtop - $linespc}]
5975 }
5976 }
5977 } elseif {$ybot > $wbot} {
5978 if {$ytop > $wbot} {
5979 set newtop [expr {$y - $wh / 2.0}]
5980 } else {
5981 set newtop [expr {$ybot - $wh}]
5982 if {$newtop < $wtop + $linespc} {
5983 set newtop [expr {$wtop + $linespc}]
5984 }
5985 }
5986 }
5987 if {$newtop != $wtop} {
5988 if {$newtop < 0} {
5989 set newtop 0
5990 }
5991 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5992 drawvisible
5993 }
5994
5995 make_secsel $l
5996
5997 if {$isnew} {
5998 addtohistory [list selbyid $id]
5999 }
6000
6001 $sha1entry delete 0 end
6002 $sha1entry insert 0 $id
6003 if {$autoselect} {
6004 $sha1entry selection from 0
6005 $sha1entry selection to end
6006 }
6007 rhighlight_sel $id
6008
6009 $ctext conf -state normal
6010 clear_ctext
6011 set linknum 0
6012 if {![info exists commitinfo($id)]} {
6013 getcommit $id
6014 }
6015 set info $commitinfo($id)
6016 set date [formatdate [lindex $info 2]]
6017 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
6018 set date [formatdate [lindex $info 4]]
6019 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
6020 if {[info exists idtags($id)]} {
6021 $ctext insert end [mc "Tags:"]
6022 foreach tag $idtags($id) {
6023 $ctext insert end " $tag"
6024 }
6025 $ctext insert end "\n"
6026 }
6027
6028 set headers {}
6029 set olds $parents($curview,$id)
6030 if {[llength $olds] > 1} {
6031 set np 0
6032 foreach p $olds {
6033 if {$np >= $mergemax} {
6034 set tag mmax
6035 } else {
6036 set tag m$np
6037 }
6038 $ctext insert end "[mc "Parent"]: " $tag
6039 appendwithlinks [commit_descriptor $p] {}
6040 incr np
6041 }
6042 } else {
6043 foreach p $olds {
6044 append headers "[mc "Parent"]: [commit_descriptor $p]"
6045 }
6046 }
6047
6048 foreach c $children($curview,$id) {
6049 append headers "[mc "Child"]: [commit_descriptor $c]"
6050 }
6051
6052 # make anything that looks like a SHA1 ID be a clickable link
6053 appendwithlinks $headers {}
6054 if {$showneartags} {
6055 if {![info exists allcommits]} {
6056 getallcommits
6057 }
6058 $ctext insert end "[mc "Branch"]: "
6059 $ctext mark set branch "end -1c"
6060 $ctext mark gravity branch left
6061 $ctext insert end "\n[mc "Follows"]: "
6062 $ctext mark set follows "end -1c"
6063 $ctext mark gravity follows left
6064 $ctext insert end "\n[mc "Precedes"]: "
6065 $ctext mark set precedes "end -1c"
6066 $ctext mark gravity precedes left
6067 $ctext insert end "\n"
6068 dispneartags 1
6069 }
6070 $ctext insert end "\n"
6071 set comment [lindex $info 5]
6072 if {[string first "\r" $comment] >= 0} {
6073 set comment [string map {"\r" "\n "} $comment]
6074 }
6075 appendwithlinks $comment {comment}
6076
6077 $ctext tag remove found 1.0 end
6078 $ctext conf -state disabled
6079 set commentend [$ctext index "end - 1c"]
6080
6081 init_flist [mc "Comments"]
6082 if {$cmitmode eq "tree"} {
6083 gettree $id
6084 } elseif {[llength $olds] <= 1} {
6085 startdiff $id
6086 } else {
6087 mergediff $id
6088 }
6089}
6090
6091proc selfirstline {} {
6092 unmarkmatches
6093 selectline 0 1
6094}
6095
6096proc sellastline {} {
6097 global numcommits
6098 unmarkmatches
6099 set l [expr {$numcommits - 1}]
6100 selectline $l 1
6101}
6102
6103proc selnextline {dir} {
6104 global selectedline
6105 focus .
6106 if {$selectedline eq {}} return
6107 set l [expr {$selectedline + $dir}]
6108 unmarkmatches
6109 selectline $l 1
6110}
6111
6112proc selnextpage {dir} {
6113 global canv linespc selectedline numcommits
6114
6115 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6116 if {$lpp < 1} {
6117 set lpp 1
6118 }
6119 allcanvs yview scroll [expr {$dir * $lpp}] units
6120 drawvisible
6121 if {$selectedline eq {}} return
6122 set l [expr {$selectedline + $dir * $lpp}]
6123 if {$l < 0} {
6124 set l 0
6125 } elseif {$l >= $numcommits} {
6126 set l [expr $numcommits - 1]
6127 }
6128 unmarkmatches
6129 selectline $l 1
6130}
6131
6132proc unselectline {} {
6133 global selectedline currentid
6134
6135 set selectedline {}
6136 catch {unset currentid}
6137 allcanvs delete secsel
6138 rhighlight_none
6139}
6140
6141proc reselectline {} {
6142 global selectedline
6143
6144 if {$selectedline ne {}} {
6145 selectline $selectedline 0
6146 }
6147}
6148
6149proc addtohistory {cmd} {
6150 global history historyindex curview
6151
6152 set elt [list $curview $cmd]
6153 if {$historyindex > 0
6154 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6155 return
6156 }
6157
6158 if {$historyindex < [llength $history]} {
6159 set history [lreplace $history $historyindex end $elt]
6160 } else {
6161 lappend history $elt
6162 }
6163 incr historyindex
6164 if {$historyindex > 1} {
6165 .tf.bar.leftbut conf -state normal
6166 } else {
6167 .tf.bar.leftbut conf -state disabled
6168 }
6169 .tf.bar.rightbut conf -state disabled
6170}
6171
6172proc godo {elt} {
6173 global curview
6174
6175 set view [lindex $elt 0]
6176 set cmd [lindex $elt 1]
6177 if {$curview != $view} {
6178 showview $view
6179 }
6180 eval $cmd
6181}
6182
6183proc goback {} {
6184 global history historyindex
6185 focus .
6186
6187 if {$historyindex > 1} {
6188 incr historyindex -1
6189 godo [lindex $history [expr {$historyindex - 1}]]
6190 .tf.bar.rightbut conf -state normal
6191 }
6192 if {$historyindex <= 1} {
6193 .tf.bar.leftbut conf -state disabled
6194 }
6195}
6196
6197proc goforw {} {
6198 global history historyindex
6199 focus .
6200
6201 if {$historyindex < [llength $history]} {
6202 set cmd [lindex $history $historyindex]
6203 incr historyindex
6204 godo $cmd
6205 .tf.bar.leftbut conf -state normal
6206 }
6207 if {$historyindex >= [llength $history]} {
6208 .tf.bar.rightbut conf -state disabled
6209 }
6210}
6211
6212proc gettree {id} {
6213 global treefilelist treeidlist diffids diffmergeid treepending
6214 global nullid nullid2
6215
6216 set diffids $id
6217 catch {unset diffmergeid}
6218 if {![info exists treefilelist($id)]} {
6219 if {![info exists treepending]} {
6220 if {$id eq $nullid} {
6221 set cmd [list | git ls-files]
6222 } elseif {$id eq $nullid2} {
6223 set cmd [list | git ls-files --stage -t]
6224 } else {
6225 set cmd [list | git ls-tree -r $id]
6226 }
6227 if {[catch {set gtf [open $cmd r]}]} {
6228 return
6229 }
6230 set treepending $id
6231 set treefilelist($id) {}
6232 set treeidlist($id) {}
6233 fconfigure $gtf -blocking 0 -encoding binary
6234 filerun $gtf [list gettreeline $gtf $id]
6235 }
6236 } else {
6237 setfilelist $id
6238 }
6239}
6240
6241proc gettreeline {gtf id} {
6242 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6243
6244 set nl 0
6245 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6246 if {$diffids eq $nullid} {
6247 set fname $line
6248 } else {
6249 set i [string first "\t" $line]
6250 if {$i < 0} continue
6251 set fname [string range $line [expr {$i+1}] end]
6252 set line [string range $line 0 [expr {$i-1}]]
6253 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6254 set sha1 [lindex $line 2]
6255 lappend treeidlist($id) $sha1
6256 }
6257 if {[string index $fname 0] eq "\""} {
6258 set fname [lindex $fname 0]
6259 }
6260 set fname [encoding convertfrom $fname]
6261 lappend treefilelist($id) $fname
6262 }
6263 if {![eof $gtf]} {
6264 return [expr {$nl >= 1000? 2: 1}]
6265 }
6266 close $gtf
6267 unset treepending
6268 if {$cmitmode ne "tree"} {
6269 if {![info exists diffmergeid]} {
6270 gettreediffs $diffids
6271 }
6272 } elseif {$id ne $diffids} {
6273 gettree $diffids
6274 } else {
6275 setfilelist $id
6276 }
6277 return 0
6278}
6279
6280proc showfile {f} {
6281 global treefilelist treeidlist diffids nullid nullid2
6282 global ctext commentend
6283
6284 set i [lsearch -exact $treefilelist($diffids) $f]
6285 if {$i < 0} {
6286 puts "oops, $f not in list for id $diffids"
6287 return
6288 }
6289 if {$diffids eq $nullid} {
6290 if {[catch {set bf [open $f r]} err]} {
6291 puts "oops, can't read $f: $err"
6292 return
6293 }
6294 } else {
6295 set blob [lindex $treeidlist($diffids) $i]
6296 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6297 puts "oops, error reading blob $blob: $err"
6298 return
6299 }
6300 }
6301 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6302 filerun $bf [list getblobline $bf $diffids]
6303 $ctext config -state normal
6304 clear_ctext $commentend
6305 $ctext insert end "\n"
6306 $ctext insert end "$f\n" filesep
6307 $ctext config -state disabled
6308 $ctext yview $commentend
6309 settabs 0
6310}
6311
6312proc getblobline {bf id} {
6313 global diffids cmitmode ctext
6314
6315 if {$id ne $diffids || $cmitmode ne "tree"} {
6316 catch {close $bf}
6317 return 0
6318 }
6319 $ctext config -state normal
6320 set nl 0
6321 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6322 $ctext insert end "$line\n"
6323 }
6324 if {[eof $bf]} {
6325 # delete last newline
6326 $ctext delete "end - 2c" "end - 1c"
6327 close $bf
6328 return 0
6329 }
6330 $ctext config -state disabled
6331 return [expr {$nl >= 1000? 2: 1}]
6332}
6333
6334proc mergediff {id} {
6335 global diffmergeid mdifffd
6336 global diffids
6337 global parents
6338 global diffcontext
6339 global diffencoding
6340 global limitdiffs vfilelimit curview
6341
6342 set diffmergeid $id
6343 set diffids $id
6344 # this doesn't seem to actually affect anything...
6345 set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
6346 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6347 set cmd [concat $cmd -- $vfilelimit($curview)]
6348 }
6349 if {[catch {set mdf [open $cmd r]} err]} {
6350 error_popup "[mc "Error getting merge diffs:"] $err"
6351 return
6352 }
6353 fconfigure $mdf -blocking 0 -encoding binary
6354 set mdifffd($id) $mdf
6355 set np [llength $parents($curview,$id)]
6356 set diffencoding [get_path_encoding {}]
6357 settabs $np
6358 filerun $mdf [list getmergediffline $mdf $id $np]
6359}
6360
6361proc getmergediffline {mdf id np} {
6362 global diffmergeid ctext cflist mergemax
6363 global difffilestart mdifffd
6364 global diffencoding
6365
6366 $ctext conf -state normal
6367 set nr 0
6368 while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
6369 if {![info exists diffmergeid] || $id != $diffmergeid
6370 || $mdf != $mdifffd($id)} {
6371 close $mdf
6372 return 0
6373 }
6374 if {[regexp {^diff --cc (.*)} $line match fname]} {
6375 # start of a new file
6376 set fname [encoding convertfrom $fname]
6377 $ctext insert end "\n"
6378 set here [$ctext index "end - 1c"]
6379 lappend difffilestart $here
6380 add_flist [list $fname]
6381 set diffencoding [get_path_encoding $fname]
6382 set l [expr {(78 - [string length $fname]) / 2}]
6383 set pad [string range "----------------------------------------" 1 $l]
6384 $ctext insert end "$pad $fname $pad\n" filesep
6385 } elseif {[regexp {^@@} $line]} {
6386 set line [encoding convertfrom $diffencoding $line]
6387 $ctext insert end "$line\n" hunksep
6388 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
6389 # do nothing
6390 } else {
6391 set line [encoding convertfrom $diffencoding $line]
6392 # parse the prefix - one ' ', '-' or '+' for each parent
6393 set spaces {}
6394 set minuses {}
6395 set pluses {}
6396 set isbad 0
6397 for {set j 0} {$j < $np} {incr j} {
6398 set c [string range $line $j $j]
6399 if {$c == " "} {
6400 lappend spaces $j
6401 } elseif {$c == "-"} {
6402 lappend minuses $j
6403 } elseif {$c == "+"} {
6404 lappend pluses $j
6405 } else {
6406 set isbad 1
6407 break
6408 }
6409 }
6410 set tags {}
6411 set num {}
6412 if {!$isbad && $minuses ne {} && $pluses eq {}} {
6413 # line doesn't appear in result, parents in $minuses have the line
6414 set num [lindex $minuses 0]
6415 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6416 # line appears in result, parents in $pluses don't have the line
6417 lappend tags mresult
6418 set num [lindex $spaces 0]
6419 }
6420 if {$num ne {}} {
6421 if {$num >= $mergemax} {
6422 set num "max"
6423 }
6424 lappend tags m$num
6425 }
6426 $ctext insert end "$line\n" $tags
6427 }
6428 }
6429 $ctext conf -state disabled
6430 if {[eof $mdf]} {
6431 close $mdf
6432 return 0
6433 }
6434 return [expr {$nr >= 1000? 2: 1}]
6435}
6436
6437proc startdiff {ids} {
6438 global treediffs diffids treepending diffmergeid nullid nullid2
6439
6440 settabs 1
6441 set diffids $ids
6442 catch {unset diffmergeid}
6443 if {![info exists treediffs($ids)] ||
6444 [lsearch -exact $ids $nullid] >= 0 ||
6445 [lsearch -exact $ids $nullid2] >= 0} {
6446 if {![info exists treepending]} {
6447 gettreediffs $ids
6448 }
6449 } else {
6450 addtocflist $ids
6451 }
6452}
6453
6454proc path_filter {filter name} {
6455 foreach p $filter {
6456 set l [string length $p]
6457 if {[string index $p end] eq "/"} {
6458 if {[string compare -length $l $p $name] == 0} {
6459 return 1
6460 }
6461 } else {
6462 if {[string compare -length $l $p $name] == 0 &&
6463 ([string length $name] == $l ||
6464 [string index $name $l] eq "/")} {
6465 return 1
6466 }
6467 }
6468 }
6469 return 0
6470}
6471
6472proc addtocflist {ids} {
6473 global treediffs
6474
6475 add_flist $treediffs($ids)
6476 getblobdiffs $ids
6477}
6478
6479proc diffcmd {ids flags} {
6480 global nullid nullid2
6481
6482 set i [lsearch -exact $ids $nullid]
6483 set j [lsearch -exact $ids $nullid2]
6484 if {$i >= 0} {
6485 if {[llength $ids] > 1 && $j < 0} {
6486 # comparing working directory with some specific revision
6487 set cmd [concat | git diff-index $flags]
6488 if {$i == 0} {
6489 lappend cmd -R [lindex $ids 1]
6490 } else {
6491 lappend cmd [lindex $ids 0]
6492 }
6493 } else {
6494 # comparing working directory with index
6495 set cmd [concat | git diff-files $flags]
6496 if {$j == 1} {
6497 lappend cmd -R
6498 }
6499 }
6500 } elseif {$j >= 0} {
6501 set cmd [concat | git diff-index --cached $flags]
6502 if {[llength $ids] > 1} {
6503 # comparing index with specific revision
6504 if {$i == 0} {
6505 lappend cmd -R [lindex $ids 1]
6506 } else {
6507 lappend cmd [lindex $ids 0]
6508 }
6509 } else {
6510 # comparing index with HEAD
6511 lappend cmd HEAD
6512 }
6513 } else {
6514 set cmd [concat | git diff-tree -r $flags $ids]
6515 }
6516 return $cmd
6517}
6518
6519proc gettreediffs {ids} {
6520 global treediff treepending
6521
6522 if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6523
6524 set treepending $ids
6525 set treediff {}
6526 fconfigure $gdtf -blocking 0 -encoding binary
6527 filerun $gdtf [list gettreediffline $gdtf $ids]
6528}
6529
6530proc gettreediffline {gdtf ids} {
6531 global treediff treediffs treepending diffids diffmergeid
6532 global cmitmode vfilelimit curview limitdiffs perfile_attrs
6533
6534 set nr 0
6535 set sublist {}
6536 set max 1000
6537 if {$perfile_attrs} {
6538 # cache_gitattr is slow, and even slower on win32 where we
6539 # have to invoke it for only about 30 paths at a time
6540 set max 500
6541 if {[tk windowingsystem] == "win32"} {
6542 set max 120
6543 }
6544 }
6545 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
6546 set i [string first "\t" $line]
6547 if {$i >= 0} {
6548 set file [string range $line [expr {$i+1}] end]
6549 if {[string index $file 0] eq "\""} {
6550 set file [lindex $file 0]
6551 }
6552 set file [encoding convertfrom $file]
6553 lappend treediff $file
6554 lappend sublist $file
6555 }
6556 }
6557 if {$perfile_attrs} {
6558 cache_gitattr encoding $sublist
6559 }
6560 if {![eof $gdtf]} {
6561 return [expr {$nr >= $max? 2: 1}]
6562 }
6563 close $gdtf
6564 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6565 set flist {}
6566 foreach f $treediff {
6567 if {[path_filter $vfilelimit($curview) $f]} {
6568 lappend flist $f
6569 }
6570 }
6571 set treediffs($ids) $flist
6572 } else {
6573 set treediffs($ids) $treediff
6574 }
6575 unset treepending
6576 if {$cmitmode eq "tree"} {
6577 gettree $diffids
6578 } elseif {$ids != $diffids} {
6579 if {![info exists diffmergeid]} {
6580 gettreediffs $diffids
6581 }
6582 } else {
6583 addtocflist $ids
6584 }
6585 return 0
6586}
6587
6588# empty string or positive integer
6589proc diffcontextvalidate {v} {
6590 return [regexp {^(|[1-9][0-9]*)$} $v]
6591}
6592
6593proc diffcontextchange {n1 n2 op} {
6594 global diffcontextstring diffcontext
6595
6596 if {[string is integer -strict $diffcontextstring]} {
6597 if {$diffcontextstring > 0} {
6598 set diffcontext $diffcontextstring
6599 reselectline
6600 }
6601 }
6602}
6603
6604proc changeignorespace {} {
6605 reselectline
6606}
6607
6608proc getblobdiffs {ids} {
6609 global blobdifffd diffids env
6610 global diffinhdr treediffs
6611 global diffcontext
6612 global ignorespace
6613 global limitdiffs vfilelimit curview
6614 global diffencoding
6615
6616 set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6617 if {$ignorespace} {
6618 append cmd " -w"
6619 }
6620 if {$limitdiffs && $vfilelimit($curview) ne {}} {
6621 set cmd [concat $cmd -- $vfilelimit($curview)]
6622 }
6623 if {[catch {set bdf [open $cmd r]} err]} {
6624 puts "error getting diffs: $err"
6625 return
6626 }
6627 set diffinhdr 0
6628 set diffencoding [get_path_encoding {}]
6629 fconfigure $bdf -blocking 0 -encoding binary
6630 set blobdifffd($ids) $bdf
6631 filerun $bdf [list getblobdiffline $bdf $diffids]
6632}
6633
6634proc setinlist {var i val} {
6635 global $var
6636
6637 while {[llength [set $var]] < $i} {
6638 lappend $var {}
6639 }
6640 if {[llength [set $var]] == $i} {
6641 lappend $var $val
6642 } else {
6643 lset $var $i $val
6644 }
6645}
6646
6647proc makediffhdr {fname ids} {
6648 global ctext curdiffstart treediffs
6649
6650 set i [lsearch -exact $treediffs($ids) $fname]
6651 if {$i >= 0} {
6652 setinlist difffilestart $i $curdiffstart
6653 }
6654 set l [expr {(78 - [string length $fname]) / 2}]
6655 set pad [string range "----------------------------------------" 1 $l]
6656 $ctext insert $curdiffstart "$pad $fname $pad" filesep
6657}
6658
6659proc getblobdiffline {bdf ids} {
6660 global diffids blobdifffd ctext curdiffstart
6661 global diffnexthead diffnextnote difffilestart
6662 global diffinhdr treediffs
6663 global diffencoding
6664
6665 set nr 0
6666 $ctext conf -state normal
6667 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6668 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6669 close $bdf
6670 return 0
6671 }
6672 if {![string compare -length 11 "diff --git " $line]} {
6673 # trim off "diff --git "
6674 set line [string range $line 11 end]
6675 set diffinhdr 1
6676 # start of a new file
6677 $ctext insert end "\n"
6678 set curdiffstart [$ctext index "end - 1c"]
6679 $ctext insert end "\n" filesep
6680 # If the name hasn't changed the length will be odd,
6681 # the middle char will be a space, and the two bits either
6682 # side will be a/name and b/name, or "a/name" and "b/name".
6683 # If the name has changed we'll get "rename from" and
6684 # "rename to" or "copy from" and "copy to" lines following this,
6685 # and we'll use them to get the filenames.
6686 # This complexity is necessary because spaces in the filename(s)
6687 # don't get escaped.
6688 set l [string length $line]
6689 set i [expr {$l / 2}]
6690 if {!(($l & 1) && [string index $line $i] eq " " &&
6691 [string range $line 2 [expr {$i - 1}]] eq \
6692 [string range $line [expr {$i + 3}] end])} {
6693 continue
6694 }
6695 # unescape if quoted and chop off the a/ from the front
6696 if {[string index $line 0] eq "\""} {
6697 set fname [string range [lindex $line 0] 2 end]
6698 } else {
6699 set fname [string range $line 2 [expr {$i - 1}]]
6700 }
6701 set fname [encoding convertfrom $fname]
6702 set diffencoding [get_path_encoding $fname]
6703 makediffhdr $fname $ids
6704
6705 } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6706 $line match f1l f1c f2l f2c rest]} {
6707 set line [encoding convertfrom $diffencoding $line]
6708 $ctext insert end "$line\n" hunksep
6709 set diffinhdr 0
6710
6711 } elseif {$diffinhdr} {
6712 if {![string compare -length 12 "rename from " $line]} {
6713 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6714 if {[string index $fname 0] eq "\""} {
6715 set fname [lindex $fname 0]
6716 }
6717 set fname [encoding convertfrom $fname]
6718 set i [lsearch -exact $treediffs($ids) $fname]
6719 if {$i >= 0} {
6720 setinlist difffilestart $i $curdiffstart
6721 }
6722 } elseif {![string compare -length 10 $line "rename to "] ||
6723 ![string compare -length 8 $line "copy to "]} {
6724 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6725 if {[string index $fname 0] eq "\""} {
6726 set fname [lindex $fname 0]
6727 }
6728 set fname [encoding convertfrom $fname]
6729 set diffencoding [get_path_encoding $fname]
6730 makediffhdr $fname $ids
6731 } elseif {[string compare -length 3 $line "---"] == 0} {
6732 # do nothing
6733 continue
6734 } elseif {[string compare -length 3 $line "+++"] == 0} {
6735 set diffinhdr 0
6736 continue
6737 }
6738 $ctext insert end "$line\n" filesep
6739
6740 } else {
6741 set line [encoding convertfrom $diffencoding $line]
6742 set x [string range $line 0 0]
6743 if {$x == "-" || $x == "+"} {
6744 set tag [expr {$x == "+"}]
6745 $ctext insert end "$line\n" d$tag
6746 } elseif {$x == " "} {
6747 $ctext insert end "$line\n"
6748 } else {
6749 # "\ No newline at end of file",
6750 # or something else we don't recognize
6751 $ctext insert end "$line\n" hunksep
6752 }
6753 }
6754 }
6755 $ctext conf -state disabled
6756 if {[eof $bdf]} {
6757 close $bdf
6758 return 0
6759 }
6760 return [expr {$nr >= 1000? 2: 1}]
6761}
6762
6763proc changediffdisp {} {
6764 global ctext diffelide
6765
6766 $ctext tag conf d0 -elide [lindex $diffelide 0]
6767 $ctext tag conf d1 -elide [lindex $diffelide 1]
6768}
6769
6770proc highlightfile {loc cline} {
6771 global ctext cflist cflist_top
6772
6773 $ctext yview $loc
6774 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6775 $cflist tag add highlight $cline.0 "$cline.0 lineend"
6776 $cflist see $cline.0
6777 set cflist_top $cline
6778}
6779
6780proc prevfile {} {
6781 global difffilestart ctext cmitmode
6782
6783 if {$cmitmode eq "tree"} return
6784 set prev 0.0
6785 set prevline 1
6786 set here [$ctext index @0,0]
6787 foreach loc $difffilestart {
6788 if {[$ctext compare $loc >= $here]} {
6789 highlightfile $prev $prevline
6790 return
6791 }
6792 set prev $loc
6793 incr prevline
6794 }
6795 highlightfile $prev $prevline
6796}
6797
6798proc nextfile {} {
6799 global difffilestart ctext cmitmode
6800
6801 if {$cmitmode eq "tree"} return
6802 set here [$ctext index @0,0]
6803 set line 1
6804 foreach loc $difffilestart {
6805 incr line
6806 if {[$ctext compare $loc > $here]} {
6807 highlightfile $loc $line
6808 return
6809 }
6810 }
6811}
6812
6813proc clear_ctext {{first 1.0}} {
6814 global ctext smarktop smarkbot
6815 global pendinglinks
6816
6817 set l [lindex [split $first .] 0]
6818 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6819 set smarktop $l
6820 }
6821 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6822 set smarkbot $l
6823 }
6824 $ctext delete $first end
6825 if {$first eq "1.0"} {
6826 catch {unset pendinglinks}
6827 }
6828}
6829
6830proc settabs {{firstab {}}} {
6831 global firsttabstop tabstop ctext have_tk85
6832
6833 if {$firstab ne {} && $have_tk85} {
6834 set firsttabstop $firstab
6835 }
6836 set w [font measure textfont "0"]
6837 if {$firsttabstop != 0} {
6838 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6839 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6840 } elseif {$have_tk85 || $tabstop != 8} {
6841 $ctext conf -tabs [expr {$tabstop * $w}]
6842 } else {
6843 $ctext conf -tabs {}
6844 }
6845}
6846
6847proc incrsearch {name ix op} {
6848 global ctext searchstring searchdirn
6849
6850 $ctext tag remove found 1.0 end
6851 if {[catch {$ctext index anchor}]} {
6852 # no anchor set, use start of selection, or of visible area
6853 set sel [$ctext tag ranges sel]
6854 if {$sel ne {}} {
6855 $ctext mark set anchor [lindex $sel 0]
6856 } elseif {$searchdirn eq "-forwards"} {
6857 $ctext mark set anchor @0,0
6858 } else {
6859 $ctext mark set anchor @0,[winfo height $ctext]
6860 }
6861 }
6862 if {$searchstring ne {}} {
6863 set here [$ctext search $searchdirn -- $searchstring anchor]
6864 if {$here ne {}} {
6865 $ctext see $here
6866 }
6867 searchmarkvisible 1
6868 }
6869}
6870
6871proc dosearch {} {
6872 global sstring ctext searchstring searchdirn
6873
6874 focus $sstring
6875 $sstring icursor end
6876 set searchdirn -forwards
6877 if {$searchstring ne {}} {
6878 set sel [$ctext tag ranges sel]
6879 if {$sel ne {}} {
6880 set start "[lindex $sel 0] + 1c"
6881 } elseif {[catch {set start [$ctext index anchor]}]} {
6882 set start "@0,0"
6883 }
6884 set match [$ctext search -count mlen -- $searchstring $start]
6885 $ctext tag remove sel 1.0 end
6886 if {$match eq {}} {
6887 bell
6888 return
6889 }
6890 $ctext see $match
6891 set mend "$match + $mlen c"
6892 $ctext tag add sel $match $mend
6893 $ctext mark unset anchor
6894 }
6895}
6896
6897proc dosearchback {} {
6898 global sstring ctext searchstring searchdirn
6899
6900 focus $sstring
6901 $sstring icursor end
6902 set searchdirn -backwards
6903 if {$searchstring ne {}} {
6904 set sel [$ctext tag ranges sel]
6905 if {$sel ne {}} {
6906 set start [lindex $sel 0]
6907 } elseif {[catch {set start [$ctext index anchor]}]} {
6908 set start @0,[winfo height $ctext]
6909 }
6910 set match [$ctext search -backwards -count ml -- $searchstring $start]
6911 $ctext tag remove sel 1.0 end
6912 if {$match eq {}} {
6913 bell
6914 return
6915 }
6916 $ctext see $match
6917 set mend "$match + $ml c"
6918 $ctext tag add sel $match $mend
6919 $ctext mark unset anchor
6920 }
6921}
6922
6923proc searchmark {first last} {
6924 global ctext searchstring
6925
6926 set mend $first.0
6927 while {1} {
6928 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6929 if {$match eq {}} break
6930 set mend "$match + $mlen c"
6931 $ctext tag add found $match $mend
6932 }
6933}
6934
6935proc searchmarkvisible {doall} {
6936 global ctext smarktop smarkbot
6937
6938 set topline [lindex [split [$ctext index @0,0] .] 0]
6939 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6940 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6941 # no overlap with previous
6942 searchmark $topline $botline
6943 set smarktop $topline
6944 set smarkbot $botline
6945 } else {
6946 if {$topline < $smarktop} {
6947 searchmark $topline [expr {$smarktop-1}]
6948 set smarktop $topline
6949 }
6950 if {$botline > $smarkbot} {
6951 searchmark [expr {$smarkbot+1}] $botline
6952 set smarkbot $botline
6953 }
6954 }
6955}
6956
6957proc scrolltext {f0 f1} {
6958 global searchstring
6959
6960 .bleft.bottom.sb set $f0 $f1
6961 if {$searchstring ne {}} {
6962 searchmarkvisible 0
6963 }
6964}
6965
6966proc setcoords {} {
6967 global linespc charspc canvx0 canvy0
6968 global xspc1 xspc2 lthickness
6969
6970 set linespc [font metrics mainfont -linespace]
6971 set charspc [font measure mainfont "m"]
6972 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6973 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6974 set lthickness [expr {int($linespc / 9) + 1}]
6975 set xspc1(0) $linespc
6976 set xspc2 $linespc
6977}
6978
6979proc redisplay {} {
6980 global canv
6981 global selectedline
6982
6983 set ymax [lindex [$canv cget -scrollregion] 3]
6984 if {$ymax eq {} || $ymax == 0} return
6985 set span [$canv yview]
6986 clear_display
6987 setcanvscroll
6988 allcanvs yview moveto [lindex $span 0]
6989 drawvisible
6990 if {$selectedline ne {}} {
6991 selectline $selectedline 0
6992 allcanvs yview moveto [lindex $span 0]
6993 }
6994}
6995
6996proc parsefont {f n} {
6997 global fontattr
6998
6999 set fontattr($f,family) [lindex $n 0]
7000 set s [lindex $n 1]
7001 if {$s eq {} || $s == 0} {
7002 set s 10
7003 } elseif {$s < 0} {
7004 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7005 }
7006 set fontattr($f,size) $s
7007 set fontattr($f,weight) normal
7008 set fontattr($f,slant) roman
7009 foreach style [lrange $n 2 end] {
7010 switch -- $style {
7011 "normal" -
7012 "bold" {set fontattr($f,weight) $style}
7013 "roman" -
7014 "italic" {set fontattr($f,slant) $style}
7015 }
7016 }
7017}
7018
7019proc fontflags {f {isbold 0}} {
7020 global fontattr
7021
7022 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7023 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7024 -slant $fontattr($f,slant)]
7025}
7026
7027proc fontname {f} {
7028 global fontattr
7029
7030 set n [list $fontattr($f,family) $fontattr($f,size)]
7031 if {$fontattr($f,weight) eq "bold"} {
7032 lappend n "bold"
7033 }
7034 if {$fontattr($f,slant) eq "italic"} {
7035 lappend n "italic"
7036 }
7037 return $n
7038}
7039
7040proc incrfont {inc} {
7041 global mainfont textfont ctext canv cflist showrefstop
7042 global stopped entries fontattr
7043
7044 unmarkmatches
7045 set s $fontattr(mainfont,size)
7046 incr s $inc
7047 if {$s < 1} {
7048 set s 1
7049 }
7050 set fontattr(mainfont,size) $s
7051 font config mainfont -size $s
7052 font config mainfontbold -size $s
7053 set mainfont [fontname mainfont]
7054 set s $fontattr(textfont,size)
7055 incr s $inc
7056 if {$s < 1} {
7057 set s 1
7058 }
7059 set fontattr(textfont,size) $s
7060 font config textfont -size $s
7061 font config textfontbold -size $s
7062 set textfont [fontname textfont]
7063 setcoords
7064 settabs
7065 redisplay
7066}
7067
7068proc clearsha1 {} {
7069 global sha1entry sha1string
7070 if {[string length $sha1string] == 40} {
7071 $sha1entry delete 0 end
7072 }
7073}
7074
7075proc sha1change {n1 n2 op} {
7076 global sha1string currentid sha1but
7077 if {$sha1string == {}
7078 || ([info exists currentid] && $sha1string == $currentid)} {
7079 set state disabled
7080 } else {
7081 set state normal
7082 }
7083 if {[$sha1but cget -state] == $state} return
7084 if {$state == "normal"} {
7085 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7086 } else {
7087 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7088 }
7089}
7090
7091proc gotocommit {} {
7092 global sha1string tagids headids curview varcid
7093
7094 if {$sha1string == {}
7095 || ([info exists currentid] && $sha1string == $currentid)} return
7096 if {[info exists tagids($sha1string)]} {
7097 set id $tagids($sha1string)
7098 } elseif {[info exists headids($sha1string)]} {
7099 set id $headids($sha1string)
7100 } else {
7101 set id [string tolower $sha1string]
7102 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7103 set matches [array names varcid "$curview,$id*"]
7104 if {$matches ne {}} {
7105 if {[llength $matches] > 1} {
7106 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7107 return
7108 }
7109 set id [lindex [split [lindex $matches 0] ","] 1]
7110 }
7111 }
7112 }
7113 if {[commitinview $id $curview]} {
7114 selectline [rowofcommit $id] 1
7115 return
7116 }
7117 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7118 set msg [mc "SHA1 id %s is not known" $sha1string]
7119 } else {
7120 set msg [mc "Tag/Head %s is not known" $sha1string]
7121 }
7122 error_popup $msg
7123}
7124
7125proc lineenter {x y id} {
7126 global hoverx hovery hoverid hovertimer
7127 global commitinfo canv
7128
7129 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7130 set hoverx $x
7131 set hovery $y
7132 set hoverid $id
7133 if {[info exists hovertimer]} {
7134 after cancel $hovertimer
7135 }
7136 set hovertimer [after 500 linehover]
7137 $canv delete hover
7138}
7139
7140proc linemotion {x y id} {
7141 global hoverx hovery hoverid hovertimer
7142
7143 if {[info exists hoverid] && $id == $hoverid} {
7144 set hoverx $x
7145 set hovery $y
7146 if {[info exists hovertimer]} {
7147 after cancel $hovertimer
7148 }
7149 set hovertimer [after 500 linehover]
7150 }
7151}
7152
7153proc lineleave {id} {
7154 global hoverid hovertimer canv
7155
7156 if {[info exists hoverid] && $id == $hoverid} {
7157 $canv delete hover
7158 if {[info exists hovertimer]} {
7159 after cancel $hovertimer
7160 unset hovertimer
7161 }
7162 unset hoverid
7163 }
7164}
7165
7166proc linehover {} {
7167 global hoverx hovery hoverid hovertimer
7168 global canv linespc lthickness
7169 global commitinfo
7170
7171 set text [lindex $commitinfo($hoverid) 0]
7172 set ymax [lindex [$canv cget -scrollregion] 3]
7173 if {$ymax == {}} return
7174 set yfrac [lindex [$canv yview] 0]
7175 set x [expr {$hoverx + 2 * $linespc}]
7176 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7177 set x0 [expr {$x - 2 * $lthickness}]
7178 set y0 [expr {$y - 2 * $lthickness}]
7179 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7180 set y1 [expr {$y + $linespc + 2 * $lthickness}]
7181 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7182 -fill \#ffff80 -outline black -width 1 -tags hover]
7183 $canv raise $t
7184 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7185 -font mainfont]
7186 $canv raise $t
7187}
7188
7189proc clickisonarrow {id y} {
7190 global lthickness
7191
7192 set ranges [rowranges $id]
7193 set thresh [expr {2 * $lthickness + 6}]
7194 set n [expr {[llength $ranges] - 1}]
7195 for {set i 1} {$i < $n} {incr i} {
7196 set row [lindex $ranges $i]
7197 if {abs([yc $row] - $y) < $thresh} {
7198 return $i
7199 }
7200 }
7201 return {}
7202}
7203
7204proc arrowjump {id n y} {
7205 global canv
7206
7207 # 1 <-> 2, 3 <-> 4, etc...
7208 set n [expr {(($n - 1) ^ 1) + 1}]
7209 set row [lindex [rowranges $id] $n]
7210 set yt [yc $row]
7211 set ymax [lindex [$canv cget -scrollregion] 3]
7212 if {$ymax eq {} || $ymax <= 0} return
7213 set view [$canv yview]
7214 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7215 set yfrac [expr {$yt / $ymax - $yspan / 2}]
7216 if {$yfrac < 0} {
7217 set yfrac 0
7218 }
7219 allcanvs yview moveto $yfrac
7220}
7221
7222proc lineclick {x y id isnew} {
7223 global ctext commitinfo children canv thickerline curview
7224
7225 if {![info exists commitinfo($id)] && ![getcommit $id]} return
7226 unmarkmatches
7227 unselectline
7228 normalline
7229 $canv delete hover
7230 # draw this line thicker than normal
7231 set thickerline $id
7232 drawlines $id
7233 if {$isnew} {
7234 set ymax [lindex [$canv cget -scrollregion] 3]
7235 if {$ymax eq {}} return
7236 set yfrac [lindex [$canv yview] 0]
7237 set y [expr {$y + $yfrac * $ymax}]
7238 }
7239 set dirn [clickisonarrow $id $y]
7240 if {$dirn ne {}} {
7241 arrowjump $id $dirn $y
7242 return
7243 }
7244
7245 if {$isnew} {
7246 addtohistory [list lineclick $x $y $id 0]
7247 }
7248 # fill the details pane with info about this line
7249 $ctext conf -state normal
7250 clear_ctext
7251 settabs 0
7252 $ctext insert end "[mc "Parent"]:\t"
7253 $ctext insert end $id link0
7254 setlink $id link0
7255 set info $commitinfo($id)
7256 $ctext insert end "\n\t[lindex $info 0]\n"
7257 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7258 set date [formatdate [lindex $info 2]]
7259 $ctext insert end "\t[mc "Date"]:\t$date\n"
7260 set kids $children($curview,$id)
7261 if {$kids ne {}} {
7262 $ctext insert end "\n[mc "Children"]:"
7263 set i 0
7264 foreach child $kids {
7265 incr i
7266 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7267 set info $commitinfo($child)
7268 $ctext insert end "\n\t"
7269 $ctext insert end $child link$i
7270 setlink $child link$i
7271 $ctext insert end "\n\t[lindex $info 0]"
7272 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7273 set date [formatdate [lindex $info 2]]
7274 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7275 }
7276 }
7277 $ctext conf -state disabled
7278 init_flist {}
7279}
7280
7281proc normalline {} {
7282 global thickerline
7283 if {[info exists thickerline]} {
7284 set id $thickerline
7285 unset thickerline
7286 drawlines $id
7287 }
7288}
7289
7290proc selbyid {id} {
7291 global curview
7292 if {[commitinview $id $curview]} {
7293 selectline [rowofcommit $id] 1
7294 }
7295}
7296
7297proc mstime {} {
7298 global startmstime
7299 if {![info exists startmstime]} {
7300 set startmstime [clock clicks -milliseconds]
7301 }
7302 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7303}
7304
7305proc rowmenu {x y id} {
7306 global rowctxmenu selectedline rowmenuid curview
7307 global nullid nullid2 fakerowmenu mainhead
7308
7309 stopfinding
7310 set rowmenuid $id
7311 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7312 set state disabled
7313 } else {
7314 set state normal
7315 }
7316 if {$id ne $nullid && $id ne $nullid2} {
7317 set menu $rowctxmenu
7318 if {$mainhead ne {}} {
7319 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7320 } else {
7321 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7322 }
7323 } else {
7324 set menu $fakerowmenu
7325 }
7326 $menu entryconfigure [mc "Diff this -> selected"] -state $state
7327 $menu entryconfigure [mc "Diff selected -> this"] -state $state
7328 $menu entryconfigure [mc "Make patch"] -state $state
7329 tk_popup $menu $x $y
7330}
7331
7332proc diffvssel {dirn} {
7333 global rowmenuid selectedline
7334
7335 if {$selectedline eq {}} return
7336 if {$dirn} {
7337 set oldid [commitonrow $selectedline]
7338 set newid $rowmenuid
7339 } else {
7340 set oldid $rowmenuid
7341 set newid [commitonrow $selectedline]
7342 }
7343 addtohistory [list doseldiff $oldid $newid]
7344 doseldiff $oldid $newid
7345}
7346
7347proc doseldiff {oldid newid} {
7348 global ctext
7349 global commitinfo
7350
7351 $ctext conf -state normal
7352 clear_ctext
7353 init_flist [mc "Top"]
7354 $ctext insert end "[mc "From"] "
7355 $ctext insert end $oldid link0
7356 setlink $oldid link0
7357 $ctext insert end "\n "
7358 $ctext insert end [lindex $commitinfo($oldid) 0]
7359 $ctext insert end "\n\n[mc "To"] "
7360 $ctext insert end $newid link1
7361 setlink $newid link1
7362 $ctext insert end "\n "
7363 $ctext insert end [lindex $commitinfo($newid) 0]
7364 $ctext insert end "\n"
7365 $ctext conf -state disabled
7366 $ctext tag remove found 1.0 end
7367 startdiff [list $oldid $newid]
7368}
7369
7370proc mkpatch {} {
7371 global rowmenuid currentid commitinfo patchtop patchnum
7372
7373 if {![info exists currentid]} return
7374 set oldid $currentid
7375 set oldhead [lindex $commitinfo($oldid) 0]
7376 set newid $rowmenuid
7377 set newhead [lindex $commitinfo($newid) 0]
7378 set top .patch
7379 set patchtop $top
7380 catch {destroy $top}
7381 toplevel $top
7382 label $top.title -text [mc "Generate patch"]
7383 grid $top.title - -pady 10
7384 label $top.from -text [mc "From:"]
7385 entry $top.fromsha1 -width 40 -relief flat
7386 $top.fromsha1 insert 0 $oldid
7387 $top.fromsha1 conf -state readonly
7388 grid $top.from $top.fromsha1 -sticky w
7389 entry $top.fromhead -width 60 -relief flat
7390 $top.fromhead insert 0 $oldhead
7391 $top.fromhead conf -state readonly
7392 grid x $top.fromhead -sticky w
7393 label $top.to -text [mc "To:"]
7394 entry $top.tosha1 -width 40 -relief flat
7395 $top.tosha1 insert 0 $newid
7396 $top.tosha1 conf -state readonly
7397 grid $top.to $top.tosha1 -sticky w
7398 entry $top.tohead -width 60 -relief flat
7399 $top.tohead insert 0 $newhead
7400 $top.tohead conf -state readonly
7401 grid x $top.tohead -sticky w
7402 button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7403 grid $top.rev x -pady 10
7404 label $top.flab -text [mc "Output file:"]
7405 entry $top.fname -width 60
7406 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7407 incr patchnum
7408 grid $top.flab $top.fname -sticky w
7409 frame $top.buts
7410 button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7411 button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7412 grid $top.buts.gen $top.buts.can
7413 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7414 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7415 grid $top.buts - -pady 10 -sticky ew
7416 focus $top.fname
7417}
7418
7419proc mkpatchrev {} {
7420 global patchtop
7421
7422 set oldid [$patchtop.fromsha1 get]
7423 set oldhead [$patchtop.fromhead get]
7424 set newid [$patchtop.tosha1 get]
7425 set newhead [$patchtop.tohead get]
7426 foreach e [list fromsha1 fromhead tosha1 tohead] \
7427 v [list $newid $newhead $oldid $oldhead] {
7428 $patchtop.$e conf -state normal
7429 $patchtop.$e delete 0 end
7430 $patchtop.$e insert 0 $v
7431 $patchtop.$e conf -state readonly
7432 }
7433}
7434
7435proc mkpatchgo {} {
7436 global patchtop nullid nullid2
7437
7438 set oldid [$patchtop.fromsha1 get]
7439 set newid [$patchtop.tosha1 get]
7440 set fname [$patchtop.fname get]
7441 set cmd [diffcmd [list $oldid $newid] -p]
7442 # trim off the initial "|"
7443 set cmd [lrange $cmd 1 end]
7444 lappend cmd >$fname &
7445 if {[catch {eval exec $cmd} err]} {
7446 error_popup "[mc "Error creating patch:"] $err"
7447 }
7448 catch {destroy $patchtop}
7449 unset patchtop
7450}
7451
7452proc mkpatchcan {} {
7453 global patchtop
7454
7455 catch {destroy $patchtop}
7456 unset patchtop
7457}
7458
7459proc mktag {} {
7460 global rowmenuid mktagtop commitinfo
7461
7462 set top .maketag
7463 set mktagtop $top
7464 catch {destroy $top}
7465 toplevel $top
7466 label $top.title -text [mc "Create tag"]
7467 grid $top.title - -pady 10
7468 label $top.id -text [mc "ID:"]
7469 entry $top.sha1 -width 40 -relief flat
7470 $top.sha1 insert 0 $rowmenuid
7471 $top.sha1 conf -state readonly
7472 grid $top.id $top.sha1 -sticky w
7473 entry $top.head -width 60 -relief flat
7474 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7475 $top.head conf -state readonly
7476 grid x $top.head -sticky w
7477 label $top.tlab -text [mc "Tag name:"]
7478 entry $top.tag -width 60
7479 grid $top.tlab $top.tag -sticky w
7480 frame $top.buts
7481 button $top.buts.gen -text [mc "Create"] -command mktaggo
7482 button $top.buts.can -text [mc "Cancel"] -command mktagcan
7483 grid $top.buts.gen $top.buts.can
7484 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7485 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7486 grid $top.buts - -pady 10 -sticky ew
7487 focus $top.tag
7488}
7489
7490proc domktag {} {
7491 global mktagtop env tagids idtags
7492
7493 set id [$mktagtop.sha1 get]
7494 set tag [$mktagtop.tag get]
7495 if {$tag == {}} {
7496 error_popup [mc "No tag name specified"]
7497 return
7498 }
7499 if {[info exists tagids($tag)]} {
7500 error_popup [mc "Tag \"%s\" already exists" $tag]
7501 return
7502 }
7503 if {[catch {
7504 exec git tag $tag $id
7505 } err]} {
7506 error_popup "[mc "Error creating tag:"] $err"
7507 return
7508 }
7509
7510 set tagids($tag) $id
7511 lappend idtags($id) $tag
7512 redrawtags $id
7513 addedtag $id
7514 dispneartags 0
7515 run refill_reflist
7516}
7517
7518proc redrawtags {id} {
7519 global canv linehtag idpos currentid curview cmitlisted
7520 global canvxmax iddrawn circleitem mainheadid circlecolors
7521
7522 if {![commitinview $id $curview]} return
7523 if {![info exists iddrawn($id)]} return
7524 set row [rowofcommit $id]
7525 if {$id eq $mainheadid} {
7526 set ofill yellow
7527 } else {
7528 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7529 }
7530 $canv itemconf $circleitem($row) -fill $ofill
7531 $canv delete tag.$id
7532 set xt [eval drawtags $id $idpos($id)]
7533 $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7534 set text [$canv itemcget $linehtag($row) -text]
7535 set font [$canv itemcget $linehtag($row) -font]
7536 set xr [expr {$xt + [font measure $font $text]}]
7537 if {$xr > $canvxmax} {
7538 set canvxmax $xr
7539 setcanvscroll
7540 }
7541 if {[info exists currentid] && $currentid == $id} {
7542 make_secsel $row
7543 }
7544}
7545
7546proc mktagcan {} {
7547 global mktagtop
7548
7549 catch {destroy $mktagtop}
7550 unset mktagtop
7551}
7552
7553proc mktaggo {} {
7554 domktag
7555 mktagcan
7556}
7557
7558proc writecommit {} {
7559 global rowmenuid wrcomtop commitinfo wrcomcmd
7560
7561 set top .writecommit
7562 set wrcomtop $top
7563 catch {destroy $top}
7564 toplevel $top
7565 label $top.title -text [mc "Write commit to file"]
7566 grid $top.title - -pady 10
7567 label $top.id -text [mc "ID:"]
7568 entry $top.sha1 -width 40 -relief flat
7569 $top.sha1 insert 0 $rowmenuid
7570 $top.sha1 conf -state readonly
7571 grid $top.id $top.sha1 -sticky w
7572 entry $top.head -width 60 -relief flat
7573 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7574 $top.head conf -state readonly
7575 grid x $top.head -sticky w
7576 label $top.clab -text [mc "Command:"]
7577 entry $top.cmd -width 60 -textvariable wrcomcmd
7578 grid $top.clab $top.cmd -sticky w -pady 10
7579 label $top.flab -text [mc "Output file:"]
7580 entry $top.fname -width 60
7581 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7582 grid $top.flab $top.fname -sticky w
7583 frame $top.buts
7584 button $top.buts.gen -text [mc "Write"] -command wrcomgo
7585 button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7586 grid $top.buts.gen $top.buts.can
7587 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7588 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7589 grid $top.buts - -pady 10 -sticky ew
7590 focus $top.fname
7591}
7592
7593proc wrcomgo {} {
7594 global wrcomtop
7595
7596 set id [$wrcomtop.sha1 get]
7597 set cmd "echo $id | [$wrcomtop.cmd get]"
7598 set fname [$wrcomtop.fname get]
7599 if {[catch {exec sh -c $cmd >$fname &} err]} {
7600 error_popup "[mc "Error writing commit:"] $err"
7601 }
7602 catch {destroy $wrcomtop}
7603 unset wrcomtop
7604}
7605
7606proc wrcomcan {} {
7607 global wrcomtop
7608
7609 catch {destroy $wrcomtop}
7610 unset wrcomtop
7611}
7612
7613proc mkbranch {} {
7614 global rowmenuid mkbrtop
7615
7616 set top .makebranch
7617 catch {destroy $top}
7618 toplevel $top
7619 label $top.title -text [mc "Create new branch"]
7620 grid $top.title - -pady 10
7621 label $top.id -text [mc "ID:"]
7622 entry $top.sha1 -width 40 -relief flat
7623 $top.sha1 insert 0 $rowmenuid
7624 $top.sha1 conf -state readonly
7625 grid $top.id $top.sha1 -sticky w
7626 label $top.nlab -text [mc "Name:"]
7627 entry $top.name -width 40
7628 grid $top.nlab $top.name -sticky w
7629 frame $top.buts
7630 button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7631 button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7632 grid $top.buts.go $top.buts.can
7633 grid columnconfigure $top.buts 0 -weight 1 -uniform a
7634 grid columnconfigure $top.buts 1 -weight 1 -uniform a
7635 grid $top.buts - -pady 10 -sticky ew
7636 focus $top.name
7637}
7638
7639proc mkbrgo {top} {
7640 global headids idheads
7641
7642 set name [$top.name get]
7643 set id [$top.sha1 get]
7644 if {$name eq {}} {
7645 error_popup [mc "Please specify a name for the new branch"]
7646 return
7647 }
7648 catch {destroy $top}
7649 nowbusy newbranch
7650 update
7651 if {[catch {
7652 exec git branch $name $id
7653 } err]} {
7654 notbusy newbranch
7655 error_popup $err
7656 } else {
7657 set headids($name) $id
7658 lappend idheads($id) $name
7659 addedhead $id $name
7660 notbusy newbranch
7661 redrawtags $id
7662 dispneartags 0
7663 run refill_reflist
7664 }
7665}
7666
7667proc cherrypick {} {
7668 global rowmenuid curview
7669 global mainhead mainheadid
7670
7671 set oldhead [exec git rev-parse HEAD]
7672 set dheads [descheads $rowmenuid]
7673 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7674 set ok [confirm_popup [mc "Commit %s is already\
7675 included in branch %s -- really re-apply it?" \
7676 [string range $rowmenuid 0 7] $mainhead]]
7677 if {!$ok} return
7678 }
7679 nowbusy cherrypick [mc "Cherry-picking"]
7680 update
7681 # Unfortunately git-cherry-pick writes stuff to stderr even when
7682 # no error occurs, and exec takes that as an indication of error...
7683 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7684 notbusy cherrypick
7685 error_popup $err
7686 return
7687 }
7688 set newhead [exec git rev-parse HEAD]
7689 if {$newhead eq $oldhead} {
7690 notbusy cherrypick
7691 error_popup [mc "No changes committed"]
7692 return
7693 }
7694 addnewchild $newhead $oldhead
7695 if {[commitinview $oldhead $curview]} {
7696 insertrow $newhead $oldhead $curview
7697 if {$mainhead ne {}} {
7698 movehead $newhead $mainhead
7699 movedhead $newhead $mainhead
7700 }
7701 set mainheadid $newhead
7702 redrawtags $oldhead
7703 redrawtags $newhead
7704 selbyid $newhead
7705 }
7706 notbusy cherrypick
7707}
7708
7709proc resethead {} {
7710 global mainhead rowmenuid confirm_ok resettype
7711
7712 set confirm_ok 0
7713 set w ".confirmreset"
7714 toplevel $w
7715 wm transient $w .
7716 wm title $w [mc "Confirm reset"]
7717 message $w.m -text \
7718 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7719 -justify center -aspect 1000
7720 pack $w.m -side top -fill x -padx 20 -pady 20
7721 frame $w.f -relief sunken -border 2
7722 message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7723 grid $w.f.rt -sticky w
7724 set resettype mixed
7725 radiobutton $w.f.soft -value soft -variable resettype -justify left \
7726 -text [mc "Soft: Leave working tree and index untouched"]
7727 grid $w.f.soft -sticky w
7728 radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7729 -text [mc "Mixed: Leave working tree untouched, reset index"]
7730 grid $w.f.mixed -sticky w
7731 radiobutton $w.f.hard -value hard -variable resettype -justify left \
7732 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7733 grid $w.f.hard -sticky w
7734 pack $w.f -side top -fill x
7735 button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7736 pack $w.ok -side left -fill x -padx 20 -pady 20
7737 button $w.cancel -text [mc Cancel] -command "destroy $w"
7738 pack $w.cancel -side right -fill x -padx 20 -pady 20
7739 bind $w <Visibility> "grab $w; focus $w"
7740 tkwait window $w
7741 if {!$confirm_ok} return
7742 if {[catch {set fd [open \
7743 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7744 error_popup $err
7745 } else {
7746 dohidelocalchanges
7747 filerun $fd [list readresetstat $fd]
7748 nowbusy reset [mc "Resetting"]
7749 selbyid $rowmenuid
7750 }
7751}
7752
7753proc readresetstat {fd} {
7754 global mainhead mainheadid showlocalchanges rprogcoord
7755
7756 if {[gets $fd line] >= 0} {
7757 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7758 set rprogcoord [expr {1.0 * $m / $n}]
7759 adjustprogress
7760 }
7761 return 1
7762 }
7763 set rprogcoord 0
7764 adjustprogress
7765 notbusy reset
7766 if {[catch {close $fd} err]} {
7767 error_popup $err
7768 }
7769 set oldhead $mainheadid
7770 set newhead [exec git rev-parse HEAD]
7771 if {$newhead ne $oldhead} {
7772 movehead $newhead $mainhead
7773 movedhead $newhead $mainhead
7774 set mainheadid $newhead
7775 redrawtags $oldhead
7776 redrawtags $newhead
7777 }
7778 if {$showlocalchanges} {
7779 doshowlocalchanges
7780 }
7781 return 0
7782}
7783
7784# context menu for a head
7785proc headmenu {x y id head} {
7786 global headmenuid headmenuhead headctxmenu mainhead
7787
7788 stopfinding
7789 set headmenuid $id
7790 set headmenuhead $head
7791 set state normal
7792 if {$head eq $mainhead} {
7793 set state disabled
7794 }
7795 $headctxmenu entryconfigure 0 -state $state
7796 $headctxmenu entryconfigure 1 -state $state
7797 tk_popup $headctxmenu $x $y
7798}
7799
7800proc cobranch {} {
7801 global headmenuid headmenuhead headids
7802 global showlocalchanges mainheadid
7803
7804 # check the tree is clean first??
7805 nowbusy checkout [mc "Checking out"]
7806 update
7807 dohidelocalchanges
7808 if {[catch {
7809 set fd [open [list | git checkout $headmenuhead 2>@1] r]
7810 } err]} {
7811 notbusy checkout
7812 error_popup $err
7813 if {$showlocalchanges} {
7814 dodiffindex
7815 }
7816 } else {
7817 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7818 }
7819}
7820
7821proc readcheckoutstat {fd newhead newheadid} {
7822 global mainhead mainheadid headids showlocalchanges progresscoords
7823
7824 if {[gets $fd line] >= 0} {
7825 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7826 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7827 adjustprogress
7828 }
7829 return 1
7830 }
7831 set progresscoords {0 0}
7832 adjustprogress
7833 notbusy checkout
7834 if {[catch {close $fd} err]} {
7835 error_popup $err
7836 }
7837 set oldmainid $mainheadid
7838 set mainhead $newhead
7839 set mainheadid $newheadid
7840 redrawtags $oldmainid
7841 redrawtags $newheadid
7842 selbyid $newheadid
7843 if {$showlocalchanges} {
7844 dodiffindex
7845 }
7846}
7847
7848proc rmbranch {} {
7849 global headmenuid headmenuhead mainhead
7850 global idheads
7851
7852 set head $headmenuhead
7853 set id $headmenuid
7854 # this check shouldn't be needed any more...
7855 if {$head eq $mainhead} {
7856 error_popup [mc "Cannot delete the currently checked-out branch"]
7857 return
7858 }
7859 set dheads [descheads $id]
7860 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7861 # the stuff on this branch isn't on any other branch
7862 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7863 branch.\nReally delete branch %s?" $head $head]]} return
7864 }
7865 nowbusy rmbranch
7866 update
7867 if {[catch {exec git branch -D $head} err]} {
7868 notbusy rmbranch
7869 error_popup $err
7870 return
7871 }
7872 removehead $id $head
7873 removedhead $id $head
7874 redrawtags $id
7875 notbusy rmbranch
7876 dispneartags 0
7877 run refill_reflist
7878}
7879
7880# Display a list of tags and heads
7881proc showrefs {} {
7882 global showrefstop bgcolor fgcolor selectbgcolor
7883 global bglist fglist reflistfilter reflist maincursor
7884
7885 set top .showrefs
7886 set showrefstop $top
7887 if {[winfo exists $top]} {
7888 raise $top
7889 refill_reflist
7890 return
7891 }
7892 toplevel $top
7893 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7894 text $top.list -background $bgcolor -foreground $fgcolor \
7895 -selectbackground $selectbgcolor -font mainfont \
7896 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7897 -width 30 -height 20 -cursor $maincursor \
7898 -spacing1 1 -spacing3 1 -state disabled
7899 $top.list tag configure highlight -background $selectbgcolor
7900 lappend bglist $top.list
7901 lappend fglist $top.list
7902 scrollbar $top.ysb -command "$top.list yview" -orient vertical
7903 scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7904 grid $top.list $top.ysb -sticky nsew
7905 grid $top.xsb x -sticky ew
7906 frame $top.f
7907 label $top.f.l -text "[mc "Filter"]: "
7908 entry $top.f.e -width 20 -textvariable reflistfilter
7909 set reflistfilter "*"
7910 trace add variable reflistfilter write reflistfilter_change
7911 pack $top.f.e -side right -fill x -expand 1
7912 pack $top.f.l -side left
7913 grid $top.f - -sticky ew -pady 2
7914 button $top.close -command [list destroy $top] -text [mc "Close"]
7915 grid $top.close -
7916 grid columnconfigure $top 0 -weight 1
7917 grid rowconfigure $top 0 -weight 1
7918 bind $top.list <1> {break}
7919 bind $top.list <B1-Motion> {break}
7920 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7921 set reflist {}
7922 refill_reflist
7923}
7924
7925proc sel_reflist {w x y} {
7926 global showrefstop reflist headids tagids otherrefids
7927
7928 if {![winfo exists $showrefstop]} return
7929 set l [lindex [split [$w index "@$x,$y"] "."] 0]
7930 set ref [lindex $reflist [expr {$l-1}]]
7931 set n [lindex $ref 0]
7932 switch -- [lindex $ref 1] {
7933 "H" {selbyid $headids($n)}
7934 "T" {selbyid $tagids($n)}
7935 "o" {selbyid $otherrefids($n)}
7936 }
7937 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7938}
7939
7940proc unsel_reflist {} {
7941 global showrefstop
7942
7943 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7944 $showrefstop.list tag remove highlight 0.0 end
7945}
7946
7947proc reflistfilter_change {n1 n2 op} {
7948 global reflistfilter
7949
7950 after cancel refill_reflist
7951 after 200 refill_reflist
7952}
7953
7954proc refill_reflist {} {
7955 global reflist reflistfilter showrefstop headids tagids otherrefids
7956 global curview commitinterest
7957
7958 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7959 set refs {}
7960 foreach n [array names headids] {
7961 if {[string match $reflistfilter $n]} {
7962 if {[commitinview $headids($n) $curview]} {
7963 lappend refs [list $n H]
7964 } else {
7965 set commitinterest($headids($n)) {run refill_reflist}
7966 }
7967 }
7968 }
7969 foreach n [array names tagids] {
7970 if {[string match $reflistfilter $n]} {
7971 if {[commitinview $tagids($n) $curview]} {
7972 lappend refs [list $n T]
7973 } else {
7974 set commitinterest($tagids($n)) {run refill_reflist}
7975 }
7976 }
7977 }
7978 foreach n [array names otherrefids] {
7979 if {[string match $reflistfilter $n]} {
7980 if {[commitinview $otherrefids($n) $curview]} {
7981 lappend refs [list $n o]
7982 } else {
7983 set commitinterest($otherrefids($n)) {run refill_reflist}
7984 }
7985 }
7986 }
7987 set refs [lsort -index 0 $refs]
7988 if {$refs eq $reflist} return
7989
7990 # Update the contents of $showrefstop.list according to the
7991 # differences between $reflist (old) and $refs (new)
7992 $showrefstop.list conf -state normal
7993 $showrefstop.list insert end "\n"
7994 set i 0
7995 set j 0
7996 while {$i < [llength $reflist] || $j < [llength $refs]} {
7997 if {$i < [llength $reflist]} {
7998 if {$j < [llength $refs]} {
7999 set cmp [string compare [lindex $reflist $i 0] \
8000 [lindex $refs $j 0]]
8001 if {$cmp == 0} {
8002 set cmp [string compare [lindex $reflist $i 1] \
8003 [lindex $refs $j 1]]
8004 }
8005 } else {
8006 set cmp -1
8007 }
8008 } else {
8009 set cmp 1
8010 }
8011 switch -- $cmp {
8012 -1 {
8013 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8014 incr i
8015 }
8016 0 {
8017 incr i
8018 incr j
8019 }
8020 1 {
8021 set l [expr {$j + 1}]
8022 $showrefstop.list image create $l.0 -align baseline \
8023 -image reficon-[lindex $refs $j 1] -padx 2
8024 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8025 incr j
8026 }
8027 }
8028 }
8029 set reflist $refs
8030 # delete last newline
8031 $showrefstop.list delete end-2c end-1c
8032 $showrefstop.list conf -state disabled
8033}
8034
8035# Stuff for finding nearby tags
8036proc getallcommits {} {
8037 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8038 global idheads idtags idotherrefs allparents tagobjid
8039
8040 if {![info exists allcommits]} {
8041 set nextarc 0
8042 set allcommits 0
8043 set seeds {}
8044 set allcwait 0
8045 set cachedarcs 0
8046 set allccache [file join [gitdir] "gitk.cache"]
8047 if {![catch {
8048 set f [open $allccache r]
8049 set allcwait 1
8050 getcache $f
8051 }]} return
8052 }
8053
8054 if {$allcwait} {
8055 return
8056 }
8057 set cmd [list | git rev-list --parents]
8058 set allcupdate [expr {$seeds ne {}}]
8059 if {!$allcupdate} {
8060 set ids "--all"
8061 } else {
8062 set refs [concat [array names idheads] [array names idtags] \
8063 [array names idotherrefs]]
8064 set ids {}
8065 set tagobjs {}
8066 foreach name [array names tagobjid] {
8067 lappend tagobjs $tagobjid($name)
8068 }
8069 foreach id [lsort -unique $refs] {
8070 if {![info exists allparents($id)] &&
8071 [lsearch -exact $tagobjs $id] < 0} {
8072 lappend ids $id
8073 }
8074 }
8075 if {$ids ne {}} {
8076 foreach id $seeds {
8077 lappend ids "^$id"
8078 }
8079 }
8080 }
8081 if {$ids ne {}} {
8082 set fd [open [concat $cmd $ids] r]
8083 fconfigure $fd -blocking 0
8084 incr allcommits
8085 nowbusy allcommits
8086 filerun $fd [list getallclines $fd]
8087 } else {
8088 dispneartags 0
8089 }
8090}
8091
8092# Since most commits have 1 parent and 1 child, we group strings of
8093# such commits into "arcs" joining branch/merge points (BMPs), which
8094# are commits that either don't have 1 parent or don't have 1 child.
8095#
8096# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8097# arcout(id) - outgoing arcs for BMP
8098# arcids(a) - list of IDs on arc including end but not start
8099# arcstart(a) - BMP ID at start of arc
8100# arcend(a) - BMP ID at end of arc
8101# growing(a) - arc a is still growing
8102# arctags(a) - IDs out of arcids (excluding end) that have tags
8103# archeads(a) - IDs out of arcids (excluding end) that have heads
8104# The start of an arc is at the descendent end, so "incoming" means
8105# coming from descendents, and "outgoing" means going towards ancestors.
8106
8107proc getallclines {fd} {
8108 global allparents allchildren idtags idheads nextarc
8109 global arcnos arcids arctags arcout arcend arcstart archeads growing
8110 global seeds allcommits cachedarcs allcupdate
8111
8112 set nid 0
8113 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8114 set id [lindex $line 0]
8115 if {[info exists allparents($id)]} {
8116 # seen it already
8117 continue
8118 }
8119 set cachedarcs 0
8120 set olds [lrange $line 1 end]
8121 set allparents($id) $olds
8122 if {![info exists allchildren($id)]} {
8123 set allchildren($id) {}
8124 set arcnos($id) {}
8125 lappend seeds $id
8126 } else {
8127 set a $arcnos($id)
8128 if {[llength $olds] == 1 && [llength $a] == 1} {
8129 lappend arcids($a) $id
8130 if {[info exists idtags($id)]} {
8131 lappend arctags($a) $id
8132 }
8133 if {[info exists idheads($id)]} {
8134 lappend archeads($a) $id
8135 }
8136 if {[info exists allparents($olds)]} {
8137 # seen parent already
8138 if {![info exists arcout($olds)]} {
8139 splitarc $olds
8140 }
8141 lappend arcids($a) $olds
8142 set arcend($a) $olds
8143 unset growing($a)
8144 }
8145 lappend allchildren($olds) $id
8146 lappend arcnos($olds) $a
8147 continue
8148 }
8149 }
8150 foreach a $arcnos($id) {
8151 lappend arcids($a) $id
8152 set arcend($a) $id
8153 unset growing($a)
8154 }
8155
8156 set ao {}
8157 foreach p $olds {
8158 lappend allchildren($p) $id
8159 set a [incr nextarc]
8160 set arcstart($a) $id
8161 set archeads($a) {}
8162 set arctags($a) {}
8163 set archeads($a) {}
8164 set arcids($a) {}
8165 lappend ao $a
8166 set growing($a) 1
8167 if {[info exists allparents($p)]} {
8168 # seen it already, may need to make a new branch
8169 if {![info exists arcout($p)]} {
8170 splitarc $p
8171 }
8172 lappend arcids($a) $p
8173 set arcend($a) $p
8174 unset growing($a)
8175 }
8176 lappend arcnos($p) $a
8177 }
8178 set arcout($id) $ao
8179 }
8180 if {$nid > 0} {
8181 global cached_dheads cached_dtags cached_atags
8182 catch {unset cached_dheads}
8183 catch {unset cached_dtags}
8184 catch {unset cached_atags}
8185 }
8186 if {![eof $fd]} {
8187 return [expr {$nid >= 1000? 2: 1}]
8188 }
8189 set cacheok 1
8190 if {[catch {
8191 fconfigure $fd -blocking 1
8192 close $fd
8193 } err]} {
8194 # got an error reading the list of commits
8195 # if we were updating, try rereading the whole thing again
8196 if {$allcupdate} {
8197 incr allcommits -1
8198 dropcache $err
8199 return
8200 }
8201 error_popup "[mc "Error reading commit topology information;\
8202 branch and preceding/following tag information\
8203 will be incomplete."]\n($err)"
8204 set cacheok 0
8205 }
8206 if {[incr allcommits -1] == 0} {
8207 notbusy allcommits
8208 if {$cacheok} {
8209 run savecache
8210 }
8211 }
8212 dispneartags 0
8213 return 0
8214}
8215
8216proc recalcarc {a} {
8217 global arctags archeads arcids idtags idheads
8218
8219 set at {}
8220 set ah {}
8221 foreach id [lrange $arcids($a) 0 end-1] {
8222 if {[info exists idtags($id)]} {
8223 lappend at $id
8224 }
8225 if {[info exists idheads($id)]} {
8226 lappend ah $id
8227 }
8228 }
8229 set arctags($a) $at
8230 set archeads($a) $ah
8231}
8232
8233proc splitarc {p} {
8234 global arcnos arcids nextarc arctags archeads idtags idheads
8235 global arcstart arcend arcout allparents growing
8236
8237 set a $arcnos($p)
8238 if {[llength $a] != 1} {
8239 puts "oops splitarc called but [llength $a] arcs already"
8240 return
8241 }
8242 set a [lindex $a 0]
8243 set i [lsearch -exact $arcids($a) $p]
8244 if {$i < 0} {
8245 puts "oops splitarc $p not in arc $a"
8246 return
8247 }
8248 set na [incr nextarc]
8249 if {[info exists arcend($a)]} {
8250 set arcend($na) $arcend($a)
8251 } else {
8252 set l [lindex $allparents([lindex $arcids($a) end]) 0]
8253 set j [lsearch -exact $arcnos($l) $a]
8254 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8255 }
8256 set tail [lrange $arcids($a) [expr {$i+1}] end]
8257 set arcids($a) [lrange $arcids($a) 0 $i]
8258 set arcend($a) $p
8259 set arcstart($na) $p
8260 set arcout($p) $na
8261 set arcids($na) $tail
8262 if {[info exists growing($a)]} {
8263 set growing($na) 1
8264 unset growing($a)
8265 }
8266
8267 foreach id $tail {
8268 if {[llength $arcnos($id)] == 1} {
8269 set arcnos($id) $na
8270 } else {
8271 set j [lsearch -exact $arcnos($id) $a]
8272 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8273 }
8274 }
8275
8276 # reconstruct tags and heads lists
8277 if {$arctags($a) ne {} || $archeads($a) ne {}} {
8278 recalcarc $a
8279 recalcarc $na
8280 } else {
8281 set arctags($na) {}
8282 set archeads($na) {}
8283 }
8284}
8285
8286# Update things for a new commit added that is a child of one
8287# existing commit. Used when cherry-picking.
8288proc addnewchild {id p} {
8289 global allparents allchildren idtags nextarc
8290 global arcnos arcids arctags arcout arcend arcstart archeads growing
8291 global seeds allcommits
8292
8293 if {![info exists allcommits] || ![info exists arcnos($p)]} return
8294 set allparents($id) [list $p]
8295 set allchildren($id) {}
8296 set arcnos($id) {}
8297 lappend seeds $id
8298 lappend allchildren($p) $id
8299 set a [incr nextarc]
8300 set arcstart($a) $id
8301 set archeads($a) {}
8302 set arctags($a) {}
8303 set arcids($a) [list $p]
8304 set arcend($a) $p
8305 if {![info exists arcout($p)]} {
8306 splitarc $p
8307 }
8308 lappend arcnos($p) $a
8309 set arcout($id) [list $a]
8310}
8311
8312# This implements a cache for the topology information.
8313# The cache saves, for each arc, the start and end of the arc,
8314# the ids on the arc, and the outgoing arcs from the end.
8315proc readcache {f} {
8316 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8317 global idtags idheads allparents cachedarcs possible_seeds seeds growing
8318 global allcwait
8319
8320 set a $nextarc
8321 set lim $cachedarcs
8322 if {$lim - $a > 500} {
8323 set lim [expr {$a + 500}]
8324 }
8325 if {[catch {
8326 if {$a == $lim} {
8327 # finish reading the cache and setting up arctags, etc.
8328 set line [gets $f]
8329 if {$line ne "1"} {error "bad final version"}
8330 close $f
8331 foreach id [array names idtags] {
8332 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8333 [llength $allparents($id)] == 1} {
8334 set a [lindex $arcnos($id) 0]
8335 if {$arctags($a) eq {}} {
8336 recalcarc $a
8337 }
8338 }
8339 }
8340 foreach id [array names idheads] {
8341 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8342 [llength $allparents($id)] == 1} {
8343 set a [lindex $arcnos($id) 0]
8344 if {$archeads($a) eq {}} {
8345 recalcarc $a
8346 }
8347 }
8348 }
8349 foreach id [lsort -unique $possible_seeds] {
8350 if {$arcnos($id) eq {}} {
8351 lappend seeds $id
8352 }
8353 }
8354 set allcwait 0
8355 } else {
8356 while {[incr a] <= $lim} {
8357 set line [gets $f]
8358 if {[llength $line] != 3} {error "bad line"}
8359 set s [lindex $line 0]
8360 set arcstart($a) $s
8361 lappend arcout($s) $a
8362 if {![info exists arcnos($s)]} {
8363 lappend possible_seeds $s
8364 set arcnos($s) {}
8365 }
8366 set e [lindex $line 1]
8367 if {$e eq {}} {
8368 set growing($a) 1
8369 } else {
8370 set arcend($a) $e
8371 if {![info exists arcout($e)]} {
8372 set arcout($e) {}
8373 }
8374 }
8375 set arcids($a) [lindex $line 2]
8376 foreach id $arcids($a) {
8377 lappend allparents($s) $id
8378 set s $id
8379 lappend arcnos($id) $a
8380 }
8381 if {![info exists allparents($s)]} {
8382 set allparents($s) {}
8383 }
8384 set arctags($a) {}
8385 set archeads($a) {}
8386 }
8387 set nextarc [expr {$a - 1}]
8388 }
8389 } err]} {
8390 dropcache $err
8391 return 0
8392 }
8393 if {!$allcwait} {
8394 getallcommits
8395 }
8396 return $allcwait
8397}
8398
8399proc getcache {f} {
8400 global nextarc cachedarcs possible_seeds
8401
8402 if {[catch {
8403 set line [gets $f]
8404 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8405 # make sure it's an integer
8406 set cachedarcs [expr {int([lindex $line 1])}]
8407 if {$cachedarcs < 0} {error "bad number of arcs"}
8408 set nextarc 0
8409 set possible_seeds {}
8410 run readcache $f
8411 } err]} {
8412 dropcache $err
8413 }
8414 return 0
8415}
8416
8417proc dropcache {err} {
8418 global allcwait nextarc cachedarcs seeds
8419
8420 #puts "dropping cache ($err)"
8421 foreach v {arcnos arcout arcids arcstart arcend growing \
8422 arctags archeads allparents allchildren} {
8423 global $v
8424 catch {unset $v}
8425 }
8426 set allcwait 0
8427 set nextarc 0
8428 set cachedarcs 0
8429 set seeds {}
8430 getallcommits
8431}
8432
8433proc writecache {f} {
8434 global cachearc cachedarcs allccache
8435 global arcstart arcend arcnos arcids arcout
8436
8437 set a $cachearc
8438 set lim $cachedarcs
8439 if {$lim - $a > 1000} {
8440 set lim [expr {$a + 1000}]
8441 }
8442 if {[catch {
8443 while {[incr a] <= $lim} {
8444 if {[info exists arcend($a)]} {
8445 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8446 } else {
8447 puts $f [list $arcstart($a) {} $arcids($a)]
8448 }
8449 }
8450 } err]} {
8451 catch {close $f}
8452 catch {file delete $allccache}
8453 #puts "writing cache failed ($err)"
8454 return 0
8455 }
8456 set cachearc [expr {$a - 1}]
8457 if {$a > $cachedarcs} {
8458 puts $f "1"
8459 close $f
8460 return 0
8461 }
8462 return 1
8463}
8464
8465proc savecache {} {
8466 global nextarc cachedarcs cachearc allccache
8467
8468 if {$nextarc == $cachedarcs} return
8469 set cachearc 0
8470 set cachedarcs $nextarc
8471 catch {
8472 set f [open $allccache w]
8473 puts $f [list 1 $cachedarcs]
8474 run writecache $f
8475 }
8476}
8477
8478# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8479# or 0 if neither is true.
8480proc anc_or_desc {a b} {
8481 global arcout arcstart arcend arcnos cached_isanc
8482
8483 if {$arcnos($a) eq $arcnos($b)} {
8484 # Both are on the same arc(s); either both are the same BMP,
8485 # or if one is not a BMP, the other is also not a BMP or is
8486 # the BMP at end of the arc (and it only has 1 incoming arc).
8487 # Or both can be BMPs with no incoming arcs.
8488 if {$a eq $b || $arcnos($a) eq {}} {
8489 return 0
8490 }
8491 # assert {[llength $arcnos($a)] == 1}
8492 set arc [lindex $arcnos($a) 0]
8493 set i [lsearch -exact $arcids($arc) $a]
8494 set j [lsearch -exact $arcids($arc) $b]
8495 if {$i < 0 || $i > $j} {
8496 return 1
8497 } else {
8498 return -1
8499 }
8500 }
8501
8502 if {![info exists arcout($a)]} {
8503 set arc [lindex $arcnos($a) 0]
8504 if {[info exists arcend($arc)]} {
8505 set aend $arcend($arc)
8506 } else {
8507 set aend {}
8508 }
8509 set a $arcstart($arc)
8510 } else {
8511 set aend $a
8512 }
8513 if {![info exists arcout($b)]} {
8514 set arc [lindex $arcnos($b) 0]
8515 if {[info exists arcend($arc)]} {
8516 set bend $arcend($arc)
8517 } else {
8518 set bend {}
8519 }
8520 set b $arcstart($arc)
8521 } else {
8522 set bend $b
8523 }
8524 if {$a eq $bend} {
8525 return 1
8526 }
8527 if {$b eq $aend} {
8528 return -1
8529 }
8530 if {[info exists cached_isanc($a,$bend)]} {
8531 if {$cached_isanc($a,$bend)} {
8532 return 1
8533 }
8534 }
8535 if {[info exists cached_isanc($b,$aend)]} {
8536 if {$cached_isanc($b,$aend)} {
8537 return -1
8538 }
8539 if {[info exists cached_isanc($a,$bend)]} {
8540 return 0
8541 }
8542 }
8543
8544 set todo [list $a $b]
8545 set anc($a) a
8546 set anc($b) b
8547 for {set i 0} {$i < [llength $todo]} {incr i} {
8548 set x [lindex $todo $i]
8549 if {$anc($x) eq {}} {
8550 continue
8551 }
8552 foreach arc $arcnos($x) {
8553 set xd $arcstart($arc)
8554 if {$xd eq $bend} {
8555 set cached_isanc($a,$bend) 1
8556 set cached_isanc($b,$aend) 0
8557 return 1
8558 } elseif {$xd eq $aend} {
8559 set cached_isanc($b,$aend) 1
8560 set cached_isanc($a,$bend) 0
8561 return -1
8562 }
8563 if {![info exists anc($xd)]} {
8564 set anc($xd) $anc($x)
8565 lappend todo $xd
8566 } elseif {$anc($xd) ne $anc($x)} {
8567 set anc($xd) {}
8568 }
8569 }
8570 }
8571 set cached_isanc($a,$bend) 0
8572 set cached_isanc($b,$aend) 0
8573 return 0
8574}
8575
8576# This identifies whether $desc has an ancestor that is
8577# a growing tip of the graph and which is not an ancestor of $anc
8578# and returns 0 if so and 1 if not.
8579# If we subsequently discover a tag on such a growing tip, and that
8580# turns out to be a descendent of $anc (which it could, since we
8581# don't necessarily see children before parents), then $desc
8582# isn't a good choice to display as a descendent tag of
8583# $anc (since it is the descendent of another tag which is
8584# a descendent of $anc). Similarly, $anc isn't a good choice to
8585# display as a ancestor tag of $desc.
8586#
8587proc is_certain {desc anc} {
8588 global arcnos arcout arcstart arcend growing problems
8589
8590 set certain {}
8591 if {[llength $arcnos($anc)] == 1} {
8592 # tags on the same arc are certain
8593 if {$arcnos($desc) eq $arcnos($anc)} {
8594 return 1
8595 }
8596 if {![info exists arcout($anc)]} {
8597 # if $anc is partway along an arc, use the start of the arc instead
8598 set a [lindex $arcnos($anc) 0]
8599 set anc $arcstart($a)
8600 }
8601 }
8602 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8603 set x $desc
8604 } else {
8605 set a [lindex $arcnos($desc) 0]
8606 set x $arcend($a)
8607 }
8608 if {$x == $anc} {
8609 return 1
8610 }
8611 set anclist [list $x]
8612 set dl($x) 1
8613 set nnh 1
8614 set ngrowanc 0
8615 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8616 set x [lindex $anclist $i]
8617 if {$dl($x)} {
8618 incr nnh -1
8619 }
8620 set done($x) 1
8621 foreach a $arcout($x) {
8622 if {[info exists growing($a)]} {
8623 if {![info exists growanc($x)] && $dl($x)} {
8624 set growanc($x) 1
8625 incr ngrowanc
8626 }
8627 } else {
8628 set y $arcend($a)
8629 if {[info exists dl($y)]} {
8630 if {$dl($y)} {
8631 if {!$dl($x)} {
8632 set dl($y) 0
8633 if {![info exists done($y)]} {
8634 incr nnh -1
8635 }
8636 if {[info exists growanc($x)]} {
8637 incr ngrowanc -1
8638 }
8639 set xl [list $y]
8640 for {set k 0} {$k < [llength $xl]} {incr k} {
8641 set z [lindex $xl $k]
8642 foreach c $arcout($z) {
8643 if {[info exists arcend($c)]} {
8644 set v $arcend($c)
8645 if {[info exists dl($v)] && $dl($v)} {
8646 set dl($v) 0
8647 if {![info exists done($v)]} {
8648 incr nnh -1
8649 }
8650 if {[info exists growanc($v)]} {
8651 incr ngrowanc -1
8652 }
8653 lappend xl $v
8654 }
8655 }
8656 }
8657 }
8658 }
8659 }
8660 } elseif {$y eq $anc || !$dl($x)} {
8661 set dl($y) 0
8662 lappend anclist $y
8663 } else {
8664 set dl($y) 1
8665 lappend anclist $y
8666 incr nnh
8667 }
8668 }
8669 }
8670 }
8671 foreach x [array names growanc] {
8672 if {$dl($x)} {
8673 return 0
8674 }
8675 return 0
8676 }
8677 return 1
8678}
8679
8680proc validate_arctags {a} {
8681 global arctags idtags
8682
8683 set i -1
8684 set na $arctags($a)
8685 foreach id $arctags($a) {
8686 incr i
8687 if {![info exists idtags($id)]} {
8688 set na [lreplace $na $i $i]
8689 incr i -1
8690 }
8691 }
8692 set arctags($a) $na
8693}
8694
8695proc validate_archeads {a} {
8696 global archeads idheads
8697
8698 set i -1
8699 set na $archeads($a)
8700 foreach id $archeads($a) {
8701 incr i
8702 if {![info exists idheads($id)]} {
8703 set na [lreplace $na $i $i]
8704 incr i -1
8705 }
8706 }
8707 set archeads($a) $na
8708}
8709
8710# Return the list of IDs that have tags that are descendents of id,
8711# ignoring IDs that are descendents of IDs already reported.
8712proc desctags {id} {
8713 global arcnos arcstart arcids arctags idtags allparents
8714 global growing cached_dtags
8715
8716 if {![info exists allparents($id)]} {
8717 return {}
8718 }
8719 set t1 [clock clicks -milliseconds]
8720 set argid $id
8721 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8722 # part-way along an arc; check that arc first
8723 set a [lindex $arcnos($id) 0]
8724 if {$arctags($a) ne {}} {
8725 validate_arctags $a
8726 set i [lsearch -exact $arcids($a) $id]
8727 set tid {}
8728 foreach t $arctags($a) {
8729 set j [lsearch -exact $arcids($a) $t]
8730 if {$j >= $i} break
8731 set tid $t
8732 }
8733 if {$tid ne {}} {
8734 return $tid
8735 }
8736 }
8737 set id $arcstart($a)
8738 if {[info exists idtags($id)]} {
8739 return $id
8740 }
8741 }
8742 if {[info exists cached_dtags($id)]} {
8743 return $cached_dtags($id)
8744 }
8745
8746 set origid $id
8747 set todo [list $id]
8748 set queued($id) 1
8749 set nc 1
8750 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8751 set id [lindex $todo $i]
8752 set done($id) 1
8753 set ta [info exists hastaggedancestor($id)]
8754 if {!$ta} {
8755 incr nc -1
8756 }
8757 # ignore tags on starting node
8758 if {!$ta && $i > 0} {
8759 if {[info exists idtags($id)]} {
8760 set tagloc($id) $id
8761 set ta 1
8762 } elseif {[info exists cached_dtags($id)]} {
8763 set tagloc($id) $cached_dtags($id)
8764 set ta 1
8765 }
8766 }
8767 foreach a $arcnos($id) {
8768 set d $arcstart($a)
8769 if {!$ta && $arctags($a) ne {}} {
8770 validate_arctags $a
8771 if {$arctags($a) ne {}} {
8772 lappend tagloc($id) [lindex $arctags($a) end]
8773 }
8774 }
8775 if {$ta || $arctags($a) ne {}} {
8776 set tomark [list $d]
8777 for {set j 0} {$j < [llength $tomark]} {incr j} {
8778 set dd [lindex $tomark $j]
8779 if {![info exists hastaggedancestor($dd)]} {
8780 if {[info exists done($dd)]} {
8781 foreach b $arcnos($dd) {
8782 lappend tomark $arcstart($b)
8783 }
8784 if {[info exists tagloc($dd)]} {
8785 unset tagloc($dd)
8786 }
8787 } elseif {[info exists queued($dd)]} {
8788 incr nc -1
8789 }
8790 set hastaggedancestor($dd) 1
8791 }
8792 }
8793 }
8794 if {![info exists queued($d)]} {
8795 lappend todo $d
8796 set queued($d) 1
8797 if {![info exists hastaggedancestor($d)]} {
8798 incr nc
8799 }
8800 }
8801 }
8802 }
8803 set tags {}
8804 foreach id [array names tagloc] {
8805 if {![info exists hastaggedancestor($id)]} {
8806 foreach t $tagloc($id) {
8807 if {[lsearch -exact $tags $t] < 0} {
8808 lappend tags $t
8809 }
8810 }
8811 }
8812 }
8813 set t2 [clock clicks -milliseconds]
8814 set loopix $i
8815
8816 # remove tags that are descendents of other tags
8817 for {set i 0} {$i < [llength $tags]} {incr i} {
8818 set a [lindex $tags $i]
8819 for {set j 0} {$j < $i} {incr j} {
8820 set b [lindex $tags $j]
8821 set r [anc_or_desc $a $b]
8822 if {$r == 1} {
8823 set tags [lreplace $tags $j $j]
8824 incr j -1
8825 incr i -1
8826 } elseif {$r == -1} {
8827 set tags [lreplace $tags $i $i]
8828 incr i -1
8829 break
8830 }
8831 }
8832 }
8833
8834 if {[array names growing] ne {}} {
8835 # graph isn't finished, need to check if any tag could get
8836 # eclipsed by another tag coming later. Simply ignore any
8837 # tags that could later get eclipsed.
8838 set ctags {}
8839 foreach t $tags {
8840 if {[is_certain $t $origid]} {
8841 lappend ctags $t
8842 }
8843 }
8844 if {$tags eq $ctags} {
8845 set cached_dtags($origid) $tags
8846 } else {
8847 set tags $ctags
8848 }
8849 } else {
8850 set cached_dtags($origid) $tags
8851 }
8852 set t3 [clock clicks -milliseconds]
8853 if {0 && $t3 - $t1 >= 100} {
8854 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8855 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8856 }
8857 return $tags
8858}
8859
8860proc anctags {id} {
8861 global arcnos arcids arcout arcend arctags idtags allparents
8862 global growing cached_atags
8863
8864 if {![info exists allparents($id)]} {
8865 return {}
8866 }
8867 set t1 [clock clicks -milliseconds]
8868 set argid $id
8869 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8870 # part-way along an arc; check that arc first
8871 set a [lindex $arcnos($id) 0]
8872 if {$arctags($a) ne {}} {
8873 validate_arctags $a
8874 set i [lsearch -exact $arcids($a) $id]
8875 foreach t $arctags($a) {
8876 set j [lsearch -exact $arcids($a) $t]
8877 if {$j > $i} {
8878 return $t
8879 }
8880 }
8881 }
8882 if {![info exists arcend($a)]} {
8883 return {}
8884 }
8885 set id $arcend($a)
8886 if {[info exists idtags($id)]} {
8887 return $id
8888 }
8889 }
8890 if {[info exists cached_atags($id)]} {
8891 return $cached_atags($id)
8892 }
8893
8894 set origid $id
8895 set todo [list $id]
8896 set queued($id) 1
8897 set taglist {}
8898 set nc 1
8899 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8900 set id [lindex $todo $i]
8901 set done($id) 1
8902 set td [info exists hastaggeddescendent($id)]
8903 if {!$td} {
8904 incr nc -1
8905 }
8906 # ignore tags on starting node
8907 if {!$td && $i > 0} {
8908 if {[info exists idtags($id)]} {
8909 set tagloc($id) $id
8910 set td 1
8911 } elseif {[info exists cached_atags($id)]} {
8912 set tagloc($id) $cached_atags($id)
8913 set td 1
8914 }
8915 }
8916 foreach a $arcout($id) {
8917 if {!$td && $arctags($a) ne {}} {
8918 validate_arctags $a
8919 if {$arctags($a) ne {}} {
8920 lappend tagloc($id) [lindex $arctags($a) 0]
8921 }
8922 }
8923 if {![info exists arcend($a)]} continue
8924 set d $arcend($a)
8925 if {$td || $arctags($a) ne {}} {
8926 set tomark [list $d]
8927 for {set j 0} {$j < [llength $tomark]} {incr j} {
8928 set dd [lindex $tomark $j]
8929 if {![info exists hastaggeddescendent($dd)]} {
8930 if {[info exists done($dd)]} {
8931 foreach b $arcout($dd) {
8932 if {[info exists arcend($b)]} {
8933 lappend tomark $arcend($b)
8934 }
8935 }
8936 if {[info exists tagloc($dd)]} {
8937 unset tagloc($dd)
8938 }
8939 } elseif {[info exists queued($dd)]} {
8940 incr nc -1
8941 }
8942 set hastaggeddescendent($dd) 1
8943 }
8944 }
8945 }
8946 if {![info exists queued($d)]} {
8947 lappend todo $d
8948 set queued($d) 1
8949 if {![info exists hastaggeddescendent($d)]} {
8950 incr nc
8951 }
8952 }
8953 }
8954 }
8955 set t2 [clock clicks -milliseconds]
8956 set loopix $i
8957 set tags {}
8958 foreach id [array names tagloc] {
8959 if {![info exists hastaggeddescendent($id)]} {
8960 foreach t $tagloc($id) {
8961 if {[lsearch -exact $tags $t] < 0} {
8962 lappend tags $t
8963 }
8964 }
8965 }
8966 }
8967
8968 # remove tags that are ancestors of other tags
8969 for {set i 0} {$i < [llength $tags]} {incr i} {
8970 set a [lindex $tags $i]
8971 for {set j 0} {$j < $i} {incr j} {
8972 set b [lindex $tags $j]
8973 set r [anc_or_desc $a $b]
8974 if {$r == -1} {
8975 set tags [lreplace $tags $j $j]
8976 incr j -1
8977 incr i -1
8978 } elseif {$r == 1} {
8979 set tags [lreplace $tags $i $i]
8980 incr i -1
8981 break
8982 }
8983 }
8984 }
8985
8986 if {[array names growing] ne {}} {
8987 # graph isn't finished, need to check if any tag could get
8988 # eclipsed by another tag coming later. Simply ignore any
8989 # tags that could later get eclipsed.
8990 set ctags {}
8991 foreach t $tags {
8992 if {[is_certain $origid $t]} {
8993 lappend ctags $t
8994 }
8995 }
8996 if {$tags eq $ctags} {
8997 set cached_atags($origid) $tags
8998 } else {
8999 set tags $ctags
9000 }
9001 } else {
9002 set cached_atags($origid) $tags
9003 }
9004 set t3 [clock clicks -milliseconds]
9005 if {0 && $t3 - $t1 >= 100} {
9006 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9007 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9008 }
9009 return $tags
9010}
9011
9012# Return the list of IDs that have heads that are descendents of id,
9013# including id itself if it has a head.
9014proc descheads {id} {
9015 global arcnos arcstart arcids archeads idheads cached_dheads
9016 global allparents
9017
9018 if {![info exists allparents($id)]} {
9019 return {}
9020 }
9021 set aret {}
9022 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9023 # part-way along an arc; check it first
9024 set a [lindex $arcnos($id) 0]
9025 if {$archeads($a) ne {}} {
9026 validate_archeads $a
9027 set i [lsearch -exact $arcids($a) $id]
9028 foreach t $archeads($a) {
9029 set j [lsearch -exact $arcids($a) $t]
9030 if {$j > $i} break
9031 lappend aret $t
9032 }
9033 }
9034 set id $arcstart($a)
9035 }
9036 set origid $id
9037 set todo [list $id]
9038 set seen($id) 1
9039 set ret {}
9040 for {set i 0} {$i < [llength $todo]} {incr i} {
9041 set id [lindex $todo $i]
9042 if {[info exists cached_dheads($id)]} {
9043 set ret [concat $ret $cached_dheads($id)]
9044 } else {
9045 if {[info exists idheads($id)]} {
9046 lappend ret $id
9047 }
9048 foreach a $arcnos($id) {
9049 if {$archeads($a) ne {}} {
9050 validate_archeads $a
9051 if {$archeads($a) ne {}} {
9052 set ret [concat $ret $archeads($a)]
9053 }
9054 }
9055 set d $arcstart($a)
9056 if {![info exists seen($d)]} {
9057 lappend todo $d
9058 set seen($d) 1
9059 }
9060 }
9061 }
9062 }
9063 set ret [lsort -unique $ret]
9064 set cached_dheads($origid) $ret
9065 return [concat $ret $aret]
9066}
9067
9068proc addedtag {id} {
9069 global arcnos arcout cached_dtags cached_atags
9070
9071 if {![info exists arcnos($id)]} return
9072 if {![info exists arcout($id)]} {
9073 recalcarc [lindex $arcnos($id) 0]
9074 }
9075 catch {unset cached_dtags}
9076 catch {unset cached_atags}
9077}
9078
9079proc addedhead {hid head} {
9080 global arcnos arcout cached_dheads
9081
9082 if {![info exists arcnos($hid)]} return
9083 if {![info exists arcout($hid)]} {
9084 recalcarc [lindex $arcnos($hid) 0]
9085 }
9086 catch {unset cached_dheads}
9087}
9088
9089proc removedhead {hid head} {
9090 global cached_dheads
9091
9092 catch {unset cached_dheads}
9093}
9094
9095proc movedhead {hid head} {
9096 global arcnos arcout cached_dheads
9097
9098 if {![info exists arcnos($hid)]} return
9099 if {![info exists arcout($hid)]} {
9100 recalcarc [lindex $arcnos($hid) 0]
9101 }
9102 catch {unset cached_dheads}
9103}
9104
9105proc changedrefs {} {
9106 global cached_dheads cached_dtags cached_atags
9107 global arctags archeads arcnos arcout idheads idtags
9108
9109 foreach id [concat [array names idheads] [array names idtags]] {
9110 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9111 set a [lindex $arcnos($id) 0]
9112 if {![info exists donearc($a)]} {
9113 recalcarc $a
9114 set donearc($a) 1
9115 }
9116 }
9117 }
9118 catch {unset cached_dtags}
9119 catch {unset cached_atags}
9120 catch {unset cached_dheads}
9121}
9122
9123proc rereadrefs {} {
9124 global idtags idheads idotherrefs mainheadid
9125
9126 set refids [concat [array names idtags] \
9127 [array names idheads] [array names idotherrefs]]
9128 foreach id $refids {
9129 if {![info exists ref($id)]} {
9130 set ref($id) [listrefs $id]
9131 }
9132 }
9133 set oldmainhead $mainheadid
9134 readrefs
9135 changedrefs
9136 set refids [lsort -unique [concat $refids [array names idtags] \
9137 [array names idheads] [array names idotherrefs]]]
9138 foreach id $refids {
9139 set v [listrefs $id]
9140 if {![info exists ref($id)] || $ref($id) != $v} {
9141 redrawtags $id
9142 }
9143 }
9144 if {$oldmainhead ne $mainheadid} {
9145 redrawtags $oldmainhead
9146 redrawtags $mainheadid
9147 }
9148 run refill_reflist
9149}
9150
9151proc listrefs {id} {
9152 global idtags idheads idotherrefs
9153
9154 set x {}
9155 if {[info exists idtags($id)]} {
9156 set x $idtags($id)
9157 }
9158 set y {}
9159 if {[info exists idheads($id)]} {
9160 set y $idheads($id)
9161 }
9162 set z {}
9163 if {[info exists idotherrefs($id)]} {
9164 set z $idotherrefs($id)
9165 }
9166 return [list $x $y $z]
9167}
9168
9169proc showtag {tag isnew} {
9170 global ctext tagcontents tagids linknum tagobjid
9171
9172 if {$isnew} {
9173 addtohistory [list showtag $tag 0]
9174 }
9175 $ctext conf -state normal
9176 clear_ctext
9177 settabs 0
9178 set linknum 0
9179 if {![info exists tagcontents($tag)]} {
9180 catch {
9181 set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9182 }
9183 }
9184 if {[info exists tagcontents($tag)]} {
9185 set text $tagcontents($tag)
9186 } else {
9187 set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
9188 }
9189 appendwithlinks $text {}
9190 $ctext conf -state disabled
9191 init_flist {}
9192}
9193
9194proc doquit {} {
9195 global stopped
9196 global gitktmpdir
9197
9198 set stopped 100
9199 savestuff .
9200 destroy .
9201
9202 if {[info exists gitktmpdir]} {
9203 catch {file delete -force $gitktmpdir}
9204 }
9205}
9206
9207proc mkfontdisp {font top which} {
9208 global fontattr fontpref $font
9209
9210 set fontpref($font) [set $font]
9211 button $top.${font}but -text $which -font optionfont \
9212 -command [list choosefont $font $which]
9213 label $top.$font -relief flat -font $font \
9214 -text $fontattr($font,family) -justify left
9215 grid x $top.${font}but $top.$font -sticky w
9216}
9217
9218proc choosefont {font which} {
9219 global fontparam fontlist fonttop fontattr
9220
9221 set fontparam(which) $which
9222 set fontparam(font) $font
9223 set fontparam(family) [font actual $font -family]
9224 set fontparam(size) $fontattr($font,size)
9225 set fontparam(weight) $fontattr($font,weight)
9226 set fontparam(slant) $fontattr($font,slant)
9227 set top .gitkfont
9228 set fonttop $top
9229 if {![winfo exists $top]} {
9230 font create sample
9231 eval font config sample [font actual $font]
9232 toplevel $top
9233 wm title $top [mc "Gitk font chooser"]
9234 label $top.l -textvariable fontparam(which)
9235 pack $top.l -side top
9236 set fontlist [lsort [font families]]
9237 frame $top.f
9238 listbox $top.f.fam -listvariable fontlist \
9239 -yscrollcommand [list $top.f.sb set]
9240 bind $top.f.fam <<ListboxSelect>> selfontfam
9241 scrollbar $top.f.sb -command [list $top.f.fam yview]
9242 pack $top.f.sb -side right -fill y
9243 pack $top.f.fam -side left -fill both -expand 1
9244 pack $top.f -side top -fill both -expand 1
9245 frame $top.g
9246 spinbox $top.g.size -from 4 -to 40 -width 4 \
9247 -textvariable fontparam(size) \
9248 -validatecommand {string is integer -strict %s}
9249 checkbutton $top.g.bold -padx 5 \
9250 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9251 -variable fontparam(weight) -onvalue bold -offvalue normal
9252 checkbutton $top.g.ital -padx 5 \
9253 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
9254 -variable fontparam(slant) -onvalue italic -offvalue roman
9255 pack $top.g.size $top.g.bold $top.g.ital -side left
9256 pack $top.g -side top
9257 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9258 -background white
9259 $top.c create text 100 25 -anchor center -text $which -font sample \
9260 -fill black -tags text
9261 bind $top.c <Configure> [list centertext $top.c]
9262 pack $top.c -side top -fill x
9263 frame $top.buts
9264 button $top.buts.ok -text [mc "OK"] -command fontok -default active
9265 button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9266 grid $top.buts.ok $top.buts.can
9267 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9268 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9269 pack $top.buts -side bottom -fill x
9270 trace add variable fontparam write chg_fontparam
9271 } else {
9272 raise $top
9273 $top.c itemconf text -text $which
9274 }
9275 set i [lsearch -exact $fontlist $fontparam(family)]
9276 if {$i >= 0} {
9277 $top.f.fam selection set $i
9278 $top.f.fam see $i
9279 }
9280}
9281
9282proc centertext {w} {
9283 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9284}
9285
9286proc fontok {} {
9287 global fontparam fontpref prefstop
9288
9289 set f $fontparam(font)
9290 set fontpref($f) [list $fontparam(family) $fontparam(size)]
9291 if {$fontparam(weight) eq "bold"} {
9292 lappend fontpref($f) "bold"
9293 }
9294 if {$fontparam(slant) eq "italic"} {
9295 lappend fontpref($f) "italic"
9296 }
9297 set w $prefstop.$f
9298 $w conf -text $fontparam(family) -font $fontpref($f)
9299
9300 fontcan
9301}
9302
9303proc fontcan {} {
9304 global fonttop fontparam
9305
9306 if {[info exists fonttop]} {
9307 catch {destroy $fonttop}
9308 catch {font delete sample}
9309 unset fonttop
9310 unset fontparam
9311 }
9312}
9313
9314proc selfontfam {} {
9315 global fonttop fontparam
9316
9317 set i [$fonttop.f.fam curselection]
9318 if {$i ne {}} {
9319 set fontparam(family) [$fonttop.f.fam get $i]
9320 }
9321}
9322
9323proc chg_fontparam {v sub op} {
9324 global fontparam
9325
9326 font config sample -$sub $fontparam($sub)
9327}
9328
9329proc doprefs {} {
9330 global maxwidth maxgraphpct
9331 global oldprefs prefstop showneartags showlocalchanges
9332 global bgcolor fgcolor ctext diffcolors selectbgcolor
9333 global tabstop limitdiffs autoselect extdifftool perfile_attrs
9334
9335 set top .gitkprefs
9336 set prefstop $top
9337 if {[winfo exists $top]} {
9338 raise $top
9339 return
9340 }
9341 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9342 limitdiffs tabstop perfile_attrs} {
9343 set oldprefs($v) [set $v]
9344 }
9345 toplevel $top
9346 wm title $top [mc "Gitk preferences"]
9347 label $top.ldisp -text [mc "Commit list display options"]
9348 grid $top.ldisp - -sticky w -pady 10
9349 label $top.spacer -text " "
9350 label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9351 -font optionfont
9352 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9353 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9354 label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9355 -font optionfont
9356 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9357 grid x $top.maxpctl $top.maxpct -sticky w
9358 frame $top.showlocal
9359 label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9360 checkbutton $top.showlocal.b -variable showlocalchanges
9361 pack $top.showlocal.b $top.showlocal.l -side left
9362 grid x $top.showlocal -sticky w
9363 frame $top.autoselect
9364 label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9365 checkbutton $top.autoselect.b -variable autoselect
9366 pack $top.autoselect.b $top.autoselect.l -side left
9367 grid x $top.autoselect -sticky w
9368
9369 label $top.ddisp -text [mc "Diff display options"]
9370 grid $top.ddisp - -sticky w -pady 10
9371 label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9372 spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9373 grid x $top.tabstopl $top.tabstop -sticky w
9374 frame $top.ntag
9375 label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9376 checkbutton $top.ntag.b -variable showneartags
9377 pack $top.ntag.b $top.ntag.l -side left
9378 grid x $top.ntag -sticky w
9379 frame $top.ldiff
9380 label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9381 checkbutton $top.ldiff.b -variable limitdiffs
9382 pack $top.ldiff.b $top.ldiff.l -side left
9383 grid x $top.ldiff -sticky w
9384 frame $top.lattr
9385 label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
9386 checkbutton $top.lattr.b -variable perfile_attrs
9387 pack $top.lattr.b $top.lattr.l -side left
9388 grid x $top.lattr -sticky w
9389
9390 entry $top.extdifft -textvariable extdifftool
9391 frame $top.extdifff
9392 label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9393 -padx 10
9394 button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9395 -command choose_extdiff
9396 pack $top.extdifff.l $top.extdifff.b -side left
9397 grid x $top.extdifff $top.extdifft -sticky w
9398
9399 label $top.cdisp -text [mc "Colors: press to choose"]
9400 grid $top.cdisp - -sticky w -pady 10
9401 label $top.bg -padx 40 -relief sunk -background $bgcolor
9402 button $top.bgbut -text [mc "Background"] -font optionfont \
9403 -command [list choosecolor bgcolor {} $top.bg background setbg]
9404 grid x $top.bgbut $top.bg -sticky w
9405 label $top.fg -padx 40 -relief sunk -background $fgcolor
9406 button $top.fgbut -text [mc "Foreground"] -font optionfont \
9407 -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9408 grid x $top.fgbut $top.fg -sticky w
9409 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9410 button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9411 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9412 [list $ctext tag conf d0 -foreground]]
9413 grid x $top.diffoldbut $top.diffold -sticky w
9414 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9415 button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9416 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9417 [list $ctext tag conf d1 -foreground]]
9418 grid x $top.diffnewbut $top.diffnew -sticky w
9419 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9420 button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9421 -command [list choosecolor diffcolors 2 $top.hunksep \
9422 "diff hunk header" \
9423 [list $ctext tag conf hunksep -foreground]]
9424 grid x $top.hunksepbut $top.hunksep -sticky w
9425 label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9426 button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9427 -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9428 grid x $top.selbgbut $top.selbgsep -sticky w
9429
9430 label $top.cfont -text [mc "Fonts: press to choose"]
9431 grid $top.cfont - -sticky w -pady 10
9432 mkfontdisp mainfont $top [mc "Main font"]
9433 mkfontdisp textfont $top [mc "Diff display font"]
9434 mkfontdisp uifont $top [mc "User interface font"]
9435
9436 frame $top.buts
9437 button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9438 button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9439 grid $top.buts.ok $top.buts.can
9440 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9441 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9442 grid $top.buts - - -pady 10 -sticky ew
9443 bind $top <Visibility> "focus $top.buts.ok"
9444}
9445
9446proc choose_extdiff {} {
9447 global extdifftool
9448
9449 set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9450 if {$prog ne {}} {
9451 set extdifftool $prog
9452 }
9453}
9454
9455proc choosecolor {v vi w x cmd} {
9456 global $v
9457
9458 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9459 -title [mc "Gitk: choose color for %s" $x]]
9460 if {$c eq {}} return
9461 $w conf -background $c
9462 lset $v $vi $c
9463 eval $cmd $c
9464}
9465
9466proc setselbg {c} {
9467 global bglist cflist
9468 foreach w $bglist {
9469 $w configure -selectbackground $c
9470 }
9471 $cflist tag configure highlight \
9472 -background [$cflist cget -selectbackground]
9473 allcanvs itemconf secsel -fill $c
9474}
9475
9476proc setbg {c} {
9477 global bglist
9478
9479 foreach w $bglist {
9480 $w conf -background $c
9481 }
9482}
9483
9484proc setfg {c} {
9485 global fglist canv
9486
9487 foreach w $fglist {
9488 $w conf -foreground $c
9489 }
9490 allcanvs itemconf text -fill $c
9491 $canv itemconf circle -outline $c
9492}
9493
9494proc prefscan {} {
9495 global oldprefs prefstop
9496
9497 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9498 limitdiffs tabstop perfile_attrs} {
9499 global $v
9500 set $v $oldprefs($v)
9501 }
9502 catch {destroy $prefstop}
9503 unset prefstop
9504 fontcan
9505}
9506
9507proc prefsok {} {
9508 global maxwidth maxgraphpct
9509 global oldprefs prefstop showneartags showlocalchanges
9510 global fontpref mainfont textfont uifont
9511 global limitdiffs treediffs perfile_attrs
9512
9513 catch {destroy $prefstop}
9514 unset prefstop
9515 fontcan
9516 set fontchanged 0
9517 if {$mainfont ne $fontpref(mainfont)} {
9518 set mainfont $fontpref(mainfont)
9519 parsefont mainfont $mainfont
9520 eval font configure mainfont [fontflags mainfont]
9521 eval font configure mainfontbold [fontflags mainfont 1]
9522 setcoords
9523 set fontchanged 1
9524 }
9525 if {$textfont ne $fontpref(textfont)} {
9526 set textfont $fontpref(textfont)
9527 parsefont textfont $textfont
9528 eval font configure textfont [fontflags textfont]
9529 eval font configure textfontbold [fontflags textfont 1]
9530 }
9531 if {$uifont ne $fontpref(uifont)} {
9532 set uifont $fontpref(uifont)
9533 parsefont uifont $uifont
9534 eval font configure uifont [fontflags uifont]
9535 }
9536 settabs
9537 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9538 if {$showlocalchanges} {
9539 doshowlocalchanges
9540 } else {
9541 dohidelocalchanges
9542 }
9543 }
9544 if {$limitdiffs != $oldprefs(limitdiffs) ||
9545 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
9546 # treediffs elements are limited by path;
9547 # won't have encodings cached if perfile_attrs was just turned on
9548 catch {unset treediffs}
9549 }
9550 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9551 || $maxgraphpct != $oldprefs(maxgraphpct)} {
9552 redisplay
9553 } elseif {$showneartags != $oldprefs(showneartags) ||
9554 $limitdiffs != $oldprefs(limitdiffs)} {
9555 reselectline
9556 }
9557}
9558
9559proc formatdate {d} {
9560 global datetimeformat
9561 if {$d ne {}} {
9562 set d [clock format $d -format $datetimeformat]
9563 }
9564 return $d
9565}
9566
9567# This list of encoding names and aliases is distilled from
9568# http://www.iana.org/assignments/character-sets.
9569# Not all of them are supported by Tcl.
9570set encoding_aliases {
9571 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9572 ISO646-US US-ASCII us IBM367 cp367 csASCII }
9573 { ISO-10646-UTF-1 csISO10646UTF1 }
9574 { ISO_646.basic:1983 ref csISO646basic1983 }
9575 { INVARIANT csINVARIANT }
9576 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9577 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9578 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9579 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9580 { NATS-DANO iso-ir-9-1 csNATSDANO }
9581 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9582 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9583 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9584 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9585 { ISO-2022-KR csISO2022KR }
9586 { EUC-KR csEUCKR }
9587 { ISO-2022-JP csISO2022JP }
9588 { ISO-2022-JP-2 csISO2022JP2 }
9589 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9590 csISO13JISC6220jp }
9591 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9592 { IT iso-ir-15 ISO646-IT csISO15Italian }
9593 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9594 { ES iso-ir-17 ISO646-ES csISO17Spanish }
9595 { greek7-old iso-ir-18 csISO18Greek7Old }
9596 { latin-greek iso-ir-19 csISO19LatinGreek }
9597 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9598 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9599 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9600 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9601 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9602 { BS_viewdata iso-ir-47 csISO47BSViewdata }
9603 { INIS iso-ir-49 csISO49INIS }
9604 { INIS-8 iso-ir-50 csISO50INIS8 }
9605 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9606 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9607 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9608 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9609 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9610 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9611 csISO60Norwegian1 }
9612 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9613 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9614 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9615 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9616 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9617 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9618 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9619 { greek7 iso-ir-88 csISO88Greek7 }
9620 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9621 { iso-ir-90 csISO90 }
9622 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9623 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9624 csISO92JISC62991984b }
9625 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9626 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9627 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9628 csISO95JIS62291984handadd }
9629 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9630 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9631 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9632 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9633 CP819 csISOLatin1 }
9634 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9635 { T.61-7bit iso-ir-102 csISO102T617bit }
9636 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9637 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9638 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9639 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9640 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9641 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9642 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9643 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9644 arabic csISOLatinArabic }
9645 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9646 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9647 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9648 greek greek8 csISOLatinGreek }
9649 { T.101-G2 iso-ir-128 csISO128T101G2 }
9650 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9651 csISOLatinHebrew }
9652 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9653 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9654 { CSN_369103 iso-ir-139 csISO139CSN369103 }
9655 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9656 { ISO_6937-2-add iso-ir-142 csISOTextComm }
9657 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9658 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9659 csISOLatinCyrillic }
9660 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9661 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9662 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9663 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9664 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9665 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9666 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9667 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9668 { ISO_10367-box iso-ir-155 csISO10367Box }
9669 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9670 { latin-lap lap iso-ir-158 csISO158Lap }
9671 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9672 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9673 { us-dk csUSDK }
9674 { dk-us csDKUS }
9675 { JIS_X0201 X0201 csHalfWidthKatakana }
9676 { KSC5636 ISO646-KR csKSC5636 }
9677 { ISO-10646-UCS-2 csUnicode }
9678 { ISO-10646-UCS-4 csUCS4 }
9679 { DEC-MCS dec csDECMCS }
9680 { hp-roman8 roman8 r8 csHPRoman8 }
9681 { macintosh mac csMacintosh }
9682 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9683 csIBM037 }
9684 { IBM038 EBCDIC-INT cp038 csIBM038 }
9685 { IBM273 CP273 csIBM273 }
9686 { IBM274 EBCDIC-BE CP274 csIBM274 }
9687 { IBM275 EBCDIC-BR cp275 csIBM275 }
9688 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9689 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9690 { IBM280 CP280 ebcdic-cp-it csIBM280 }
9691 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9692 { IBM284 CP284 ebcdic-cp-es csIBM284 }
9693 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9694 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9695 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9696 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9697 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9698 { IBM424 cp424 ebcdic-cp-he csIBM424 }
9699 { IBM437 cp437 437 csPC8CodePage437 }
9700 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9701 { IBM775 cp775 csPC775Baltic }
9702 { IBM850 cp850 850 csPC850Multilingual }
9703 { IBM851 cp851 851 csIBM851 }
9704 { IBM852 cp852 852 csPCp852 }
9705 { IBM855 cp855 855 csIBM855 }
9706 { IBM857 cp857 857 csIBM857 }
9707 { IBM860 cp860 860 csIBM860 }
9708 { IBM861 cp861 861 cp-is csIBM861 }
9709 { IBM862 cp862 862 csPC862LatinHebrew }
9710 { IBM863 cp863 863 csIBM863 }
9711 { IBM864 cp864 csIBM864 }
9712 { IBM865 cp865 865 csIBM865 }
9713 { IBM866 cp866 866 csIBM866 }
9714 { IBM868 CP868 cp-ar csIBM868 }
9715 { IBM869 cp869 869 cp-gr csIBM869 }
9716 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9717 { IBM871 CP871 ebcdic-cp-is csIBM871 }
9718 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9719 { IBM891 cp891 csIBM891 }
9720 { IBM903 cp903 csIBM903 }
9721 { IBM904 cp904 904 csIBBM904 }
9722 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9723 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9724 { IBM1026 CP1026 csIBM1026 }
9725 { EBCDIC-AT-DE csIBMEBCDICATDE }
9726 { EBCDIC-AT-DE-A csEBCDICATDEA }
9727 { EBCDIC-CA-FR csEBCDICCAFR }
9728 { EBCDIC-DK-NO csEBCDICDKNO }
9729 { EBCDIC-DK-NO-A csEBCDICDKNOA }
9730 { EBCDIC-FI-SE csEBCDICFISE }
9731 { EBCDIC-FI-SE-A csEBCDICFISEA }
9732 { EBCDIC-FR csEBCDICFR }
9733 { EBCDIC-IT csEBCDICIT }
9734 { EBCDIC-PT csEBCDICPT }
9735 { EBCDIC-ES csEBCDICES }
9736 { EBCDIC-ES-A csEBCDICESA }
9737 { EBCDIC-ES-S csEBCDICESS }
9738 { EBCDIC-UK csEBCDICUK }
9739 { EBCDIC-US csEBCDICUS }
9740 { UNKNOWN-8BIT csUnknown8BiT }
9741 { MNEMONIC csMnemonic }
9742 { MNEM csMnem }
9743 { VISCII csVISCII }
9744 { VIQR csVIQR }
9745 { KOI8-R csKOI8R }
9746 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9747 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9748 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9749 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9750 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9751 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9752 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9753 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9754 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9755 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9756 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9757 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9758 { IBM1047 IBM-1047 }
9759 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9760 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9761 { UNICODE-1-1 csUnicode11 }
9762 { CESU-8 csCESU-8 }
9763 { BOCU-1 csBOCU-1 }
9764 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9765 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9766 l8 }
9767 { ISO-8859-15 ISO_8859-15 Latin-9 }
9768 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9769 { GBK CP936 MS936 windows-936 }
9770 { JIS_Encoding csJISEncoding }
9771 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
9772 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9773 EUC-JP }
9774 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9775 { ISO-10646-UCS-Basic csUnicodeASCII }
9776 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9777 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9778 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9779 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9780 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9781 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9782 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9783 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9784 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9785 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9786 { Adobe-Standard-Encoding csAdobeStandardEncoding }
9787 { Ventura-US csVenturaUS }
9788 { Ventura-International csVenturaInternational }
9789 { PC8-Danish-Norwegian csPC8DanishNorwegian }
9790 { PC8-Turkish csPC8Turkish }
9791 { IBM-Symbols csIBMSymbols }
9792 { IBM-Thai csIBMThai }
9793 { HP-Legal csHPLegal }
9794 { HP-Pi-font csHPPiFont }
9795 { HP-Math8 csHPMath8 }
9796 { Adobe-Symbol-Encoding csHPPSMath }
9797 { HP-DeskTop csHPDesktop }
9798 { Ventura-Math csVenturaMath }
9799 { Microsoft-Publishing csMicrosoftPublishing }
9800 { Windows-31J csWindows31J }
9801 { GB2312 csGB2312 }
9802 { Big5 csBig5 }
9803}
9804
9805proc tcl_encoding {enc} {
9806 global encoding_aliases tcl_encoding_cache
9807 if {[info exists tcl_encoding_cache($enc)]} {
9808 return $tcl_encoding_cache($enc)
9809 }
9810 set names [encoding names]
9811 set lcnames [string tolower $names]
9812 set enc [string tolower $enc]
9813 set i [lsearch -exact $lcnames $enc]
9814 if {$i < 0} {
9815 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9816 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
9817 set i [lsearch -exact $lcnames $encx]
9818 }
9819 }
9820 if {$i < 0} {
9821 foreach l $encoding_aliases {
9822 set ll [string tolower $l]
9823 if {[lsearch -exact $ll $enc] < 0} continue
9824 # look through the aliases for one that tcl knows about
9825 foreach e $ll {
9826 set i [lsearch -exact $lcnames $e]
9827 if {$i < 0} {
9828 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
9829 set i [lsearch -exact $lcnames $ex]
9830 }
9831 }
9832 if {$i >= 0} break
9833 }
9834 break
9835 }
9836 }
9837 set tclenc {}
9838 if {$i >= 0} {
9839 set tclenc [lindex $names $i]
9840 }
9841 set tcl_encoding_cache($enc) $tclenc
9842 return $tclenc
9843}
9844
9845proc gitattr {path attr default} {
9846 global path_attr_cache
9847 if {[info exists path_attr_cache($attr,$path)]} {
9848 set r $path_attr_cache($attr,$path)
9849 } else {
9850 set r "unspecified"
9851 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
9852 regexp "(.*): encoding: (.*)" $line m f r
9853 }
9854 set path_attr_cache($attr,$path) $r
9855 }
9856 if {$r eq "unspecified"} {
9857 return $default
9858 }
9859 return $r
9860}
9861
9862proc cache_gitattr {attr pathlist} {
9863 global path_attr_cache
9864 set newlist {}
9865 foreach path $pathlist {
9866 if {![info exists path_attr_cache($attr,$path)]} {
9867 lappend newlist $path
9868 }
9869 }
9870 set lim 1000
9871 if {[tk windowingsystem] == "win32"} {
9872 # windows has a 32k limit on the arguments to a command...
9873 set lim 30
9874 }
9875 while {$newlist ne {}} {
9876 set head [lrange $newlist 0 [expr {$lim - 1}]]
9877 set newlist [lrange $newlist $lim end]
9878 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
9879 foreach row [split $rlist "\n"] {
9880 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
9881 if {[string index $path 0] eq "\""} {
9882 set path [encoding convertfrom [lindex $path 0]]
9883 }
9884 set path_attr_cache($attr,$path) $value
9885 }
9886 }
9887 }
9888 }
9889}
9890
9891proc get_path_encoding {path} {
9892 global gui_encoding perfile_attrs
9893 set tcl_enc $gui_encoding
9894 if {$path ne {} && $perfile_attrs} {
9895 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
9896 if {$enc2 ne {}} {
9897 set tcl_enc $enc2
9898 }
9899 }
9900 return $tcl_enc
9901}
9902
9903# First check that Tcl/Tk is recent enough
9904if {[catch {package require Tk 8.4} err]} {
9905 show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9906 Gitk requires at least Tcl/Tk 8.4."]
9907 exit 1
9908}
9909
9910# defaults...
9911set wrcomcmd "git diff-tree --stdin -p --pretty"
9912
9913set gitencoding {}
9914catch {
9915 set gitencoding [exec git config --get i18n.commitencoding]
9916}
9917if {$gitencoding == ""} {
9918 set gitencoding "utf-8"
9919}
9920set tclencoding [tcl_encoding $gitencoding]
9921if {$tclencoding == {}} {
9922 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9923}
9924
9925set gui_encoding [encoding system]
9926catch {
9927 set enc [exec git config --get gui.encoding]
9928 if {$enc ne {}} {
9929 set tclenc [tcl_encoding $enc]
9930 if {$tclenc ne {}} {
9931 set gui_encoding $tclenc
9932 } else {
9933 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
9934 }
9935 }
9936}
9937
9938set mainfont {Helvetica 9}
9939set textfont {Courier 9}
9940set uifont {Helvetica 9 bold}
9941set tabstop 8
9942set findmergefiles 0
9943set maxgraphpct 50
9944set maxwidth 16
9945set revlistorder 0
9946set fastdate 0
9947set uparrowlen 5
9948set downarrowlen 5
9949set mingaplen 100
9950set cmitmode "patch"
9951set wrapcomment "none"
9952set showneartags 1
9953set maxrefs 20
9954set maxlinelen 200
9955set showlocalchanges 1
9956set limitdiffs 1
9957set datetimeformat "%Y-%m-%d %H:%M:%S"
9958set autoselect 1
9959set perfile_attrs 0
9960
9961set extdifftool "meld"
9962
9963set colors {green red blue magenta darkgrey brown orange}
9964set bgcolor white
9965set fgcolor black
9966set diffcolors {red "#00a000" blue}
9967set diffcontext 3
9968set ignorespace 0
9969set selectbgcolor gray85
9970
9971set circlecolors {white blue gray blue blue}
9972
9973# button for popping up context menus
9974if {[tk windowingsystem] eq "aqua"} {
9975 set ctxbut <Button-2>
9976} else {
9977 set ctxbut <Button-3>
9978}
9979
9980## For msgcat loading, first locate the installation location.
9981if { [info exists ::env(GITK_MSGSDIR)] } {
9982 ## Msgsdir was manually set in the environment.
9983 set gitk_msgsdir $::env(GITK_MSGSDIR)
9984} else {
9985 ## Let's guess the prefix from argv0.
9986 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9987 set gitk_libdir [file join $gitk_prefix share gitk lib]
9988 set gitk_msgsdir [file join $gitk_libdir msgs]
9989 unset gitk_prefix
9990}
9991
9992## Internationalization (i18n) through msgcat and gettext. See
9993## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9994package require msgcat
9995namespace import ::msgcat::mc
9996## And eventually load the actual message catalog
9997::msgcat::mcload $gitk_msgsdir
9998
9999catch {source ~/.gitk}
10000
10001font create optionfont -family sans-serif -size -12
10002
10003parsefont mainfont $mainfont
10004eval font create mainfont [fontflags mainfont]
10005eval font create mainfontbold [fontflags mainfont 1]
10006
10007parsefont textfont $textfont
10008eval font create textfont [fontflags textfont]
10009eval font create textfontbold [fontflags textfont 1]
10010
10011parsefont uifont $uifont
10012eval font create uifont [fontflags uifont]
10013
10014setoptions
10015
10016# check that we can find a .git directory somewhere...
10017if {[catch {set gitdir [gitdir]}]} {
10018 show_error {} . [mc "Cannot find a git repository here."]
10019 exit 1
10020}
10021if {![file isdirectory $gitdir]} {
10022 show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10023 exit 1
10024}
10025
10026set selecthead {}
10027set selectheadid {}
10028
10029set revtreeargs {}
10030set cmdline_files {}
10031set i 0
10032set revtreeargscmd {}
10033foreach arg $argv {
10034 switch -glob -- $arg {
10035 "" { }
10036 "--" {
10037 set cmdline_files [lrange $argv [expr {$i + 1}] end]
10038 break
10039 }
10040 "--select-commit=*" {
10041 set selecthead [string range $arg 16 end]
10042 }
10043 "--argscmd=*" {
10044 set revtreeargscmd [string range $arg 10 end]
10045 }
10046 default {
10047 lappend revtreeargs $arg
10048 }
10049 }
10050 incr i
10051}
10052
10053if {$selecthead eq "HEAD"} {
10054 set selecthead {}
10055}
10056
10057if {$i >= [llength $argv] && $revtreeargs ne {}} {
10058 # no -- on command line, but some arguments (other than --argscmd)
10059 if {[catch {
10060 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10061 set cmdline_files [split $f "\n"]
10062 set n [llength $cmdline_files]
10063 set revtreeargs [lrange $revtreeargs 0 end-$n]
10064 # Unfortunately git rev-parse doesn't produce an error when
10065 # something is both a revision and a filename. To be consistent
10066 # with git log and git rev-list, check revtreeargs for filenames.
10067 foreach arg $revtreeargs {
10068 if {[file exists $arg]} {
10069 show_error {} . [mc "Ambiguous argument '%s': both revision\
10070 and filename" $arg]
10071 exit 1
10072 }
10073 }
10074 } err]} {
10075 # unfortunately we get both stdout and stderr in $err,
10076 # so look for "fatal:".
10077 set i [string first "fatal:" $err]
10078 if {$i > 0} {
10079 set err [string range $err [expr {$i + 6}] end]
10080 }
10081 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10082 exit 1
10083 }
10084}
10085
10086set nullid "0000000000000000000000000000000000000000"
10087set nullid2 "0000000000000000000000000000000000000001"
10088set nullfile "/dev/null"
10089
10090set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10091
10092set runq {}
10093set history {}
10094set historyindex 0
10095set fh_serial 0
10096set nhl_names {}
10097set highlight_paths {}
10098set findpattern {}
10099set searchdirn -forwards
10100set boldrows {}
10101set boldnamerows {}
10102set diffelide {0 0}
10103set markingmatches 0
10104set linkentercount 0
10105set need_redisplay 0
10106set nrows_drawn 0
10107set firsttabstop 0
10108
10109set nextviewnum 1
10110set curview 0
10111set selectedview 0
10112set selectedhlview [mc "None"]
10113set highlight_related [mc "None"]
10114set highlight_files {}
10115set viewfiles(0) {}
10116set viewperm(0) 0
10117set viewargs(0) {}
10118set viewargscmd(0) {}
10119
10120set selectedline {}
10121set numcommits 0
10122set loginstance 0
10123set cmdlineok 0
10124set stopped 0
10125set stuffsaved 0
10126set patchnum 0
10127set lserial 0
10128set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10129setcoords
10130makewindow
10131# wait for the window to become visible
10132tkwait visibility .
10133wm title . "[file tail $argv0]: [file tail [pwd]]"
10134readrefs
10135
10136if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10137 # create a view for the files/dirs specified on the command line
10138 set curview 1
10139 set selectedview 1
10140 set nextviewnum 2
10141 set viewname(1) [mc "Command line"]
10142 set viewfiles(1) $cmdline_files
10143 set viewargs(1) $revtreeargs
10144 set viewargscmd(1) $revtreeargscmd
10145 set viewperm(1) 0
10146 set vdatemode(1) 0
10147 addviewmenu 1
10148 .bar.view entryconf [mc "Edit view..."] -state normal
10149 .bar.view entryconf [mc "Delete view"] -state normal
10150}
10151
10152if {[info exists permviews]} {
10153 foreach v $permviews {
10154 set n $nextviewnum
10155 incr nextviewnum
10156 set viewname($n) [lindex $v 0]
10157 set viewfiles($n) [lindex $v 1]
10158 set viewargs($n) [lindex $v 2]
10159 set viewargscmd($n) [lindex $v 3]
10160 set viewperm($n) 1
10161 addviewmenu $n
10162 }
10163}
10164getcommits {}