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