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