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