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