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