1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
5# Copyright © 2005-2014 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
10package require Tk
11
12proc hasworktree {} {
13 return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
14 [exec git rev-parse --is-inside-git-dir] == "false"}]
15}
16
17proc reponame {} {
18 global gitdir
19 set n [file normalize $gitdir]
20 if {[string match "*/.git" $n]} {
21 set n [string range $n 0 end-5]
22 }
23 return [file tail $n]
24}
25
26proc gitworktree {} {
27 variable _gitworktree
28 if {[info exists _gitworktree]} {
29 return $_gitworktree
30 }
31 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
32 if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
33 # try to set work tree from environment, core.worktree or use
34 # cdup to obtain a relative path to the top of the worktree. If
35 # run from the top, the ./ prefix ensures normalize expands pwd.
36 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
37 catch {set _gitworktree [exec git config --get core.worktree]}
38 if {$_gitworktree eq ""} {
39 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
40 }
41 }
42 }
43 return $_gitworktree
44}
45
46# A simple scheduler for compute-intensive stuff.
47# The aim is to make sure that event handlers for GUI actions can
48# run at least every 50-100 ms. Unfortunately fileevent handlers are
49# run before X event handlers, so reading from a fast source can
50# make the GUI completely unresponsive.
51proc run args {
52 global isonrunq runq currunq
53
54 set script $args
55 if {[info exists isonrunq($script)]} return
56 if {$runq eq {} && ![info exists currunq]} {
57 after idle dorunq
58 }
59 lappend runq [list {} $script]
60 set isonrunq($script) 1
61}
62
63proc filerun {fd script} {
64 fileevent $fd readable [list filereadable $fd $script]
65}
66
67proc filereadable {fd script} {
68 global runq currunq
69
70 fileevent $fd readable {}
71 if {$runq eq {} && ![info exists currunq]} {
72 after idle dorunq
73 }
74 lappend runq [list $fd $script]
75}
76
77proc nukefile {fd} {
78 global runq
79
80 for {set i 0} {$i < [llength $runq]} {} {
81 if {[lindex $runq $i 0] eq $fd} {
82 set runq [lreplace $runq $i $i]
83 } else {
84 incr i
85 }
86 }
87}
88
89proc dorunq {} {
90 global isonrunq runq currunq
91
92 set tstart [clock clicks -milliseconds]
93 set t0 $tstart
94 while {[llength $runq] > 0} {
95 set fd [lindex $runq 0 0]
96 set script [lindex $runq 0 1]
97 set currunq [lindex $runq 0]
98 set runq [lrange $runq 1 end]
99 set repeat [eval $script]
100 unset currunq
101 set t1 [clock clicks -milliseconds]
102 set t [expr {$t1 - $t0}]
103 if {$repeat ne {} && $repeat} {
104 if {$fd eq {} || $repeat == 2} {
105 # script returns 1 if it wants to be readded
106 # file readers return 2 if they could do more straight away
107 lappend runq [list $fd $script]
108 } else {
109 fileevent $fd readable [list filereadable $fd $script]
110 }
111 } elseif {$fd eq {}} {
112 unset isonrunq($script)
113 }
114 set t0 $t1
115 if {$t1 - $tstart >= 80} break
116 }
117 if {$runq ne {}} {
118 after idle dorunq
119 }
120}
121
122proc reg_instance {fd} {
123 global commfd leftover loginstance
124
125 set i [incr loginstance]
126 set commfd($i) $fd
127 set leftover($i) {}
128 return $i
129}
130
131proc unmerged_files {files} {
132 global nr_unmerged
133
134 # find the list of unmerged files
135 set mlist {}
136 set nr_unmerged 0
137 if {[catch {
138 set fd [open "| git ls-files -u" r]
139 } err]} {
140 show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
141 exit 1
142 }
143 while {[gets $fd line] >= 0} {
144 set i [string first "\t" $line]
145 if {$i < 0} continue
146 set fname [string range $line [expr {$i+1}] end]
147 if {[lsearch -exact $mlist $fname] >= 0} continue
148 incr nr_unmerged
149 if {$files eq {} || [path_filter $files $fname]} {
150 lappend mlist $fname
151 }
152 }
153 catch {close $fd}
154 return $mlist
155}
156
157proc parseviewargs {n arglist} {
158 global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
159 global vinlinediff
160 global worddiff git_version
161
162 set vdatemode($n) 0
163 set vmergeonly($n) 0
164 set vinlinediff($n) 0
165 set glflags {}
166 set diffargs {}
167 set nextisval 0
168 set revargs {}
169 set origargs $arglist
170 set allknown 1
171 set filtered 0
172 set i -1
173 foreach arg $arglist {
174 incr i
175 if {$nextisval} {
176 lappend glflags $arg
177 set nextisval 0
178 continue
179 }
180 switch -glob -- $arg {
181 "-d" -
182 "--date-order" {
183 set vdatemode($n) 1
184 # remove from origargs in case we hit an unknown option
185 set origargs [lreplace $origargs $i $i]
186 incr i -1
187 }
188 "-[puabwcrRBMC]" -
189 "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
190 "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
191 "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
192 "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
193 "--ignore-space-change" - "-U*" - "--unified=*" {
194 # These request or affect diff output, which we don't want.
195 # Some could be used to set our defaults for diff display.
196 lappend diffargs $arg
197 }
198 "--raw" - "--patch-with-raw" - "--patch-with-stat" -
199 "--name-only" - "--name-status" - "--color" -
200 "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
201 "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
202 "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
203 "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
204 "--objects" - "--objects-edge" - "--reverse" {
205 # These cause our parsing of git log's output to fail, or else
206 # they're options we want to set ourselves, so ignore them.
207 }
208 "--color-words*" - "--word-diff=color" {
209 # These trigger a word diff in the console interface,
210 # so help the user by enabling our own support
211 if {[package vcompare $git_version "1.7.2"] >= 0} {
212 set worddiff [mc "Color words"]
213 }
214 }
215 "--word-diff*" {
216 if {[package vcompare $git_version "1.7.2"] >= 0} {
217 set worddiff [mc "Markup words"]
218 }
219 }
220 "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
221 "--check" - "--exit-code" - "--quiet" - "--topo-order" -
222 "--full-history" - "--dense" - "--sparse" -
223 "--follow" - "--left-right" - "--encoding=*" {
224 # These are harmless, and some are even useful
225 lappend glflags $arg
226 }
227 "--diff-filter=*" - "--no-merges" - "--unpacked" -
228 "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
229 "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
230 "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
231 "--remove-empty" - "--first-parent" - "--cherry-pick" -
232 "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
233 "--simplify-by-decoration" {
234 # These mean that we get a subset of the commits
235 set filtered 1
236 lappend glflags $arg
237 }
238 "-L*" {
239 # Line-log with 'stuck' argument (unstuck form is
240 # not supported)
241 set filtered 1
242 set vinlinediff($n) 1
243 set allknown 0
244 lappend glflags $arg
245 }
246 "-n" {
247 # This appears to be the only one that has a value as a
248 # separate word following it
249 set filtered 1
250 set nextisval 1
251 lappend glflags $arg
252 }
253 "--not" - "--all" {
254 lappend revargs $arg
255 }
256 "--merge" {
257 set vmergeonly($n) 1
258 # git rev-parse doesn't understand --merge
259 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
260 }
261 "--no-replace-objects" {
262 set env(GIT_NO_REPLACE_OBJECTS) "1"
263 }
264 "-*" {
265 # Other flag arguments including -<n>
266 if {[string is digit -strict [string range $arg 1 end]]} {
267 set filtered 1
268 } else {
269 # a flag argument that we don't recognize;
270 # that means we can't optimize
271 set allknown 0
272 }
273 lappend glflags $arg
274 }
275 default {
276 # Non-flag arguments specify commits or ranges of commits
277 if {[string match "*...*" $arg]} {
278 lappend revargs --gitk-symmetric-diff-marker
279 }
280 lappend revargs $arg
281 }
282 }
283 }
284 set vdflags($n) $diffargs
285 set vflags($n) $glflags
286 set vrevs($n) $revargs
287 set vfiltered($n) $filtered
288 set vorigargs($n) $origargs
289 return $allknown
290}
291
292proc parseviewrevs {view revs} {
293 global vposids vnegids
294
295 if {$revs eq {}} {
296 set revs HEAD
297 } elseif {[lsearch -exact $revs --all] >= 0} {
298 lappend revs HEAD
299 }
300 if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
301 # we get stdout followed by stderr in $err
302 # for an unknown rev, git rev-parse echoes it and then errors out
303 set errlines [split $err "\n"]
304 set badrev {}
305 for {set l 0} {$l < [llength $errlines]} {incr l} {
306 set line [lindex $errlines $l]
307 if {!([string length $line] == 40 && [string is xdigit $line])} {
308 if {[string match "fatal:*" $line]} {
309 if {[string match "fatal: ambiguous argument*" $line]
310 && $badrev ne {}} {
311 if {[llength $badrev] == 1} {
312 set err "unknown revision $badrev"
313 } else {
314 set err "unknown revisions: [join $badrev ", "]"
315 }
316 } else {
317 set err [join [lrange $errlines $l end] "\n"]
318 }
319 break
320 }
321 lappend badrev $line
322 }
323 }
324 error_popup "[mc "Error parsing revisions:"] $err"
325 return {}
326 }
327 set ret {}
328 set pos {}
329 set neg {}
330 set sdm 0
331 foreach id [split $ids "\n"] {
332 if {$id eq "--gitk-symmetric-diff-marker"} {
333 set sdm 4
334 } elseif {[string match "^*" $id]} {
335 if {$sdm != 1} {
336 lappend ret $id
337 if {$sdm == 3} {
338 set sdm 0
339 }
340 }
341 lappend neg [string range $id 1 end]
342 } else {
343 if {$sdm != 2} {
344 lappend ret $id
345 } else {
346 lset ret end $id...[lindex $ret end]
347 }
348 lappend pos $id
349 }
350 incr sdm -1
351 }
352 set vposids($view) $pos
353 set vnegids($view) $neg
354 return $ret
355}
356
357# Start off a git log process and arrange to read its output
358proc start_rev_list {view} {
359 global startmsecs commitidx viewcomplete curview
360 global tclencoding
361 global viewargs viewargscmd viewfiles vfilelimit
362 global showlocalchanges
363 global viewactive viewinstances vmergeonly
364 global mainheadid viewmainheadid viewmainheadid_orig
365 global vcanopt vflags vrevs vorigargs
366 global show_notes
367
368 set startmsecs [clock clicks -milliseconds]
369 set commitidx($view) 0
370 # these are set this way for the error exits
371 set viewcomplete($view) 1
372 set viewactive($view) 0
373 varcinit $view
374
375 set args $viewargs($view)
376 if {$viewargscmd($view) ne {}} {
377 if {[catch {
378 set str [exec sh -c $viewargscmd($view)]
379 } err]} {
380 error_popup "[mc "Error executing --argscmd command:"] $err"
381 return 0
382 }
383 set args [concat $args [split $str "\n"]]
384 }
385 set vcanopt($view) [parseviewargs $view $args]
386
387 set files $viewfiles($view)
388 if {$vmergeonly($view)} {
389 set files [unmerged_files $files]
390 if {$files eq {}} {
391 global nr_unmerged
392 if {$nr_unmerged == 0} {
393 error_popup [mc "No files selected: --merge specified but\
394 no files are unmerged."]
395 } else {
396 error_popup [mc "No files selected: --merge specified but\
397 no unmerged files are within file limit."]
398 }
399 return 0
400 }
401 }
402 set vfilelimit($view) $files
403
404 if {$vcanopt($view)} {
405 set revs [parseviewrevs $view $vrevs($view)]
406 if {$revs eq {}} {
407 return 0
408 }
409 set args [concat $vflags($view) $revs]
410 } else {
411 set args $vorigargs($view)
412 }
413
414 if {[catch {
415 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
416 --parents --boundary $args "--" $files] r]
417 } err]} {
418 error_popup "[mc "Error executing git log:"] $err"
419 return 0
420 }
421 set i [reg_instance $fd]
422 set viewinstances($view) [list $i]
423 set viewmainheadid($view) $mainheadid
424 set viewmainheadid_orig($view) $mainheadid
425 if {$files ne {} && $mainheadid ne {}} {
426 get_viewmainhead $view
427 }
428 if {$showlocalchanges && $viewmainheadid($view) ne {}} {
429 interestedin $viewmainheadid($view) dodiffindex
430 }
431 fconfigure $fd -blocking 0 -translation lf -eofchar {}
432 if {$tclencoding != {}} {
433 fconfigure $fd -encoding $tclencoding
434 }
435 filerun $fd [list getcommitlines $fd $i $view 0]
436 nowbusy $view [mc "Reading"]
437 set viewcomplete($view) 0
438 set viewactive($view) 1
439 return 1
440}
441
442proc stop_instance {inst} {
443 global commfd leftover
444
445 set fd $commfd($inst)
446 catch {
447 set pid [pid $fd]
448
449 if {$::tcl_platform(platform) eq {windows}} {
450 exec taskkill /pid $pid
451 } else {
452 exec kill $pid
453 }
454 }
455 catch {close $fd}
456 nukefile $fd
457 unset commfd($inst)
458 unset leftover($inst)
459}
460
461proc stop_backends {} {
462 global commfd
463
464 foreach inst [array names commfd] {
465 stop_instance $inst
466 }
467}
468
469proc stop_rev_list {view} {
470 global viewinstances
471
472 foreach inst $viewinstances($view) {
473 stop_instance $inst
474 }
475 set viewinstances($view) {}
476}
477
478proc reset_pending_select {selid} {
479 global pending_select mainheadid selectheadid
480
481 if {$selid ne {}} {
482 set pending_select $selid
483 } elseif {$selectheadid ne {}} {
484 set pending_select $selectheadid
485 } else {
486 set pending_select $mainheadid
487 }
488}
489
490proc getcommits {selid} {
491 global canv curview need_redisplay viewactive
492
493 initlayout
494 if {[start_rev_list $curview]} {
495 reset_pending_select $selid
496 show_status [mc "Reading commits..."]
497 set need_redisplay 1
498 } else {
499 show_status [mc "No commits selected"]
500 }
501}
502
503proc updatecommits {} {
504 global curview vcanopt vorigargs vfilelimit viewinstances
505 global viewactive viewcomplete tclencoding
506 global startmsecs showneartags showlocalchanges
507 global mainheadid viewmainheadid viewmainheadid_orig pending_select
508 global hasworktree
509 global varcid vposids vnegids vflags vrevs
510 global show_notes
511
512 set hasworktree [hasworktree]
513 rereadrefs
514 set view $curview
515 if {$mainheadid ne $viewmainheadid_orig($view)} {
516 if {$showlocalchanges} {
517 dohidelocalchanges
518 }
519 set viewmainheadid($view) $mainheadid
520 set viewmainheadid_orig($view) $mainheadid
521 if {$vfilelimit($view) ne {}} {
522 get_viewmainhead $view
523 }
524 }
525 if {$showlocalchanges} {
526 doshowlocalchanges
527 }
528 if {$vcanopt($view)} {
529 set oldpos $vposids($view)
530 set oldneg $vnegids($view)
531 set revs [parseviewrevs $view $vrevs($view)]
532 if {$revs eq {}} {
533 return
534 }
535 # note: getting the delta when negative refs change is hard,
536 # and could require multiple git log invocations, so in that
537 # case we ask git log for all the commits (not just the delta)
538 if {$oldneg eq $vnegids($view)} {
539 set newrevs {}
540 set npos 0
541 # take out positive refs that we asked for before or
542 # that we have already seen
543 foreach rev $revs {
544 if {[string length $rev] == 40} {
545 if {[lsearch -exact $oldpos $rev] < 0
546 && ![info exists varcid($view,$rev)]} {
547 lappend newrevs $rev
548 incr npos
549 }
550 } else {
551 lappend $newrevs $rev
552 }
553 }
554 if {$npos == 0} return
555 set revs $newrevs
556 set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
557 }
558 set args [concat $vflags($view) $revs --not $oldpos]
559 } else {
560 set args $vorigargs($view)
561 }
562 if {[catch {
563 set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
564 --parents --boundary $args "--" $vfilelimit($view)] r]
565 } err]} {
566 error_popup "[mc "Error executing git log:"] $err"
567 return
568 }
569 if {$viewactive($view) == 0} {
570 set startmsecs [clock clicks -milliseconds]
571 }
572 set i [reg_instance $fd]
573 lappend viewinstances($view) $i
574 fconfigure $fd -blocking 0 -translation lf -eofchar {}
575 if {$tclencoding != {}} {
576 fconfigure $fd -encoding $tclencoding
577 }
578 filerun $fd [list getcommitlines $fd $i $view 1]
579 incr viewactive($view)
580 set viewcomplete($view) 0
581 reset_pending_select {}
582 nowbusy $view [mc "Reading"]
583 if {$showneartags} {
584 getallcommits
585 }
586}
587
588proc reloadcommits {} {
589 global curview viewcomplete selectedline currentid thickerline
590 global showneartags treediffs commitinterest cached_commitrow
591 global targetid
592
593 set selid {}
594 if {$selectedline ne {}} {
595 set selid $currentid
596 }
597
598 if {!$viewcomplete($curview)} {
599 stop_rev_list $curview
600 }
601 resetvarcs $curview
602 set selectedline {}
603 catch {unset currentid}
604 catch {unset thickerline}
605 catch {unset treediffs}
606 readrefs
607 changedrefs
608 if {$showneartags} {
609 getallcommits
610 }
611 clear_display
612 catch {unset commitinterest}
613 catch {unset cached_commitrow}
614 catch {unset targetid}
615 setcanvscroll
616 getcommits $selid
617 return 0
618}
619
620# This makes a string representation of a positive integer which
621# sorts as a string in numerical order
622proc strrep {n} {
623 if {$n < 16} {
624 return [format "%x" $n]
625 } elseif {$n < 256} {
626 return [format "x%.2x" $n]
627 } elseif {$n < 65536} {
628 return [format "y%.4x" $n]
629 }
630 return [format "z%.8x" $n]
631}
632
633# Procedures used in reordering commits from git log (without
634# --topo-order) into the order for display.
635
636proc varcinit {view} {
637 global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
638 global vtokmod varcmod vrowmod varcix vlastins
639
640 set varcstart($view) {{}}
641 set vupptr($view) {0}
642 set vdownptr($view) {0}
643 set vleftptr($view) {0}
644 set vbackptr($view) {0}
645 set varctok($view) {{}}
646 set varcrow($view) {{}}
647 set vtokmod($view) {}
648 set varcmod($view) 0
649 set vrowmod($view) 0
650 set varcix($view) {{}}
651 set vlastins($view) {0}
652}
653
654proc resetvarcs {view} {
655 global varcid varccommits parents children vseedcount ordertok
656 global vshortids
657
658 foreach vid [array names varcid $view,*] {
659 unset varcid($vid)
660 unset children($vid)
661 unset parents($vid)
662 }
663 foreach vid [array names vshortids $view,*] {
664 unset vshortids($vid)
665 }
666 # some commits might have children but haven't been seen yet
667 foreach vid [array names children $view,*] {
668 unset children($vid)
669 }
670 foreach va [array names varccommits $view,*] {
671 unset varccommits($va)
672 }
673 foreach vd [array names vseedcount $view,*] {
674 unset vseedcount($vd)
675 }
676 catch {unset ordertok}
677}
678
679# returns a list of the commits with no children
680proc seeds {v} {
681 global vdownptr vleftptr varcstart
682
683 set ret {}
684 set a [lindex $vdownptr($v) 0]
685 while {$a != 0} {
686 lappend ret [lindex $varcstart($v) $a]
687 set a [lindex $vleftptr($v) $a]
688 }
689 return $ret
690}
691
692proc newvarc {view id} {
693 global varcid varctok parents children vdatemode
694 global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
695 global commitdata commitinfo vseedcount varccommits vlastins
696
697 set a [llength $varctok($view)]
698 set vid $view,$id
699 if {[llength $children($vid)] == 0 || $vdatemode($view)} {
700 if {![info exists commitinfo($id)]} {
701 parsecommit $id $commitdata($id) 1
702 }
703 set cdate [lindex [lindex $commitinfo($id) 4] 0]
704 if {![string is integer -strict $cdate]} {
705 set cdate 0
706 }
707 if {![info exists vseedcount($view,$cdate)]} {
708 set vseedcount($view,$cdate) -1
709 }
710 set c [incr vseedcount($view,$cdate)]
711 set cdate [expr {$cdate ^ 0xffffffff}]
712 set tok "s[strrep $cdate][strrep $c]"
713 } else {
714 set tok {}
715 }
716 set ka 0
717 if {[llength $children($vid)] > 0} {
718 set kid [lindex $children($vid) end]
719 set k $varcid($view,$kid)
720 if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
721 set ki $kid
722 set ka $k
723 set tok [lindex $varctok($view) $k]
724 }
725 }
726 if {$ka != 0} {
727 set i [lsearch -exact $parents($view,$ki) $id]
728 set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
729 append tok [strrep $j]
730 }
731 set c [lindex $vlastins($view) $ka]
732 if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
733 set c $ka
734 set b [lindex $vdownptr($view) $ka]
735 } else {
736 set b [lindex $vleftptr($view) $c]
737 }
738 while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
739 set c $b
740 set b [lindex $vleftptr($view) $c]
741 }
742 if {$c == $ka} {
743 lset vdownptr($view) $ka $a
744 lappend vbackptr($view) 0
745 } else {
746 lset vleftptr($view) $c $a
747 lappend vbackptr($view) $c
748 }
749 lset vlastins($view) $ka $a
750 lappend vupptr($view) $ka
751 lappend vleftptr($view) $b
752 if {$b != 0} {
753 lset vbackptr($view) $b $a
754 }
755 lappend varctok($view) $tok
756 lappend varcstart($view) $id
757 lappend vdownptr($view) 0
758 lappend varcrow($view) {}
759 lappend varcix($view) {}
760 set varccommits($view,$a) {}
761 lappend vlastins($view) 0
762 return $a
763}
764
765proc splitvarc {p v} {
766 global varcid varcstart varccommits varctok vtokmod
767 global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
768
769 set oa $varcid($v,$p)
770 set otok [lindex $varctok($v) $oa]
771 set ac $varccommits($v,$oa)
772 set i [lsearch -exact $varccommits($v,$oa) $p]
773 if {$i <= 0} return
774 set na [llength $varctok($v)]
775 # "%" sorts before "0"...
776 set tok "$otok%[strrep $i]"
777 lappend varctok($v) $tok
778 lappend varcrow($v) {}
779 lappend varcix($v) {}
780 set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
781 set varccommits($v,$na) [lrange $ac $i end]
782 lappend varcstart($v) $p
783 foreach id $varccommits($v,$na) {
784 set varcid($v,$id) $na
785 }
786 lappend vdownptr($v) [lindex $vdownptr($v) $oa]
787 lappend vlastins($v) [lindex $vlastins($v) $oa]
788 lset vdownptr($v) $oa $na
789 lset vlastins($v) $oa 0
790 lappend vupptr($v) $oa
791 lappend vleftptr($v) 0
792 lappend vbackptr($v) 0
793 for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
794 lset vupptr($v) $b $na
795 }
796 if {[string compare $otok $vtokmod($v)] <= 0} {
797 modify_arc $v $oa
798 }
799}
800
801proc renumbervarc {a v} {
802 global parents children varctok varcstart varccommits
803 global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
804
805 set t1 [clock clicks -milliseconds]
806 set todo {}
807 set isrelated($a) 1
808 set kidchanged($a) 1
809 set ntot 0
810 while {$a != 0} {
811 if {[info exists isrelated($a)]} {
812 lappend todo $a
813 set id [lindex $varccommits($v,$a) end]
814 foreach p $parents($v,$id) {
815 if {[info exists varcid($v,$p)]} {
816 set isrelated($varcid($v,$p)) 1
817 }
818 }
819 }
820 incr ntot
821 set b [lindex $vdownptr($v) $a]
822 if {$b == 0} {
823 while {$a != 0} {
824 set b [lindex $vleftptr($v) $a]
825 if {$b != 0} break
826 set a [lindex $vupptr($v) $a]
827 }
828 }
829 set a $b
830 }
831 foreach a $todo {
832 if {![info exists kidchanged($a)]} continue
833 set id [lindex $varcstart($v) $a]
834 if {[llength $children($v,$id)] > 1} {
835 set children($v,$id) [lsort -command [list vtokcmp $v] \
836 $children($v,$id)]
837 }
838 set oldtok [lindex $varctok($v) $a]
839 if {!$vdatemode($v)} {
840 set tok {}
841 } else {
842 set tok $oldtok
843 }
844 set ka 0
845 set kid [last_real_child $v,$id]
846 if {$kid ne {}} {
847 set k $varcid($v,$kid)
848 if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
849 set ki $kid
850 set ka $k
851 set tok [lindex $varctok($v) $k]
852 }
853 }
854 if {$ka != 0} {
855 set i [lsearch -exact $parents($v,$ki) $id]
856 set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
857 append tok [strrep $j]
858 }
859 if {$tok eq $oldtok} {
860 continue
861 }
862 set id [lindex $varccommits($v,$a) end]
863 foreach p $parents($v,$id) {
864 if {[info exists varcid($v,$p)]} {
865 set kidchanged($varcid($v,$p)) 1
866 } else {
867 set sortkids($p) 1
868 }
869 }
870 lset varctok($v) $a $tok
871 set b [lindex $vupptr($v) $a]
872 if {$b != $ka} {
873 if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
874 modify_arc $v $ka
875 }
876 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
877 modify_arc $v $b
878 }
879 set c [lindex $vbackptr($v) $a]
880 set d [lindex $vleftptr($v) $a]
881 if {$c == 0} {
882 lset vdownptr($v) $b $d
883 } else {
884 lset vleftptr($v) $c $d
885 }
886 if {$d != 0} {
887 lset vbackptr($v) $d $c
888 }
889 if {[lindex $vlastins($v) $b] == $a} {
890 lset vlastins($v) $b $c
891 }
892 lset vupptr($v) $a $ka
893 set c [lindex $vlastins($v) $ka]
894 if {$c == 0 || \
895 [string compare $tok [lindex $varctok($v) $c]] < 0} {
896 set c $ka
897 set b [lindex $vdownptr($v) $ka]
898 } else {
899 set b [lindex $vleftptr($v) $c]
900 }
901 while {$b != 0 && \
902 [string compare $tok [lindex $varctok($v) $b]] >= 0} {
903 set c $b
904 set b [lindex $vleftptr($v) $c]
905 }
906 if {$c == $ka} {
907 lset vdownptr($v) $ka $a
908 lset vbackptr($v) $a 0
909 } else {
910 lset vleftptr($v) $c $a
911 lset vbackptr($v) $a $c
912 }
913 lset vleftptr($v) $a $b
914 if {$b != 0} {
915 lset vbackptr($v) $b $a
916 }
917 lset vlastins($v) $ka $a
918 }
919 }
920 foreach id [array names sortkids] {
921 if {[llength $children($v,$id)] > 1} {
922 set children($v,$id) [lsort -command [list vtokcmp $v] \
923 $children($v,$id)]
924 }
925 }
926 set t2 [clock clicks -milliseconds]
927 #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
928}
929
930# Fix up the graph after we have found out that in view $v,
931# $p (a commit that we have already seen) is actually the parent
932# of the last commit in arc $a.
933proc fix_reversal {p a v} {
934 global varcid varcstart varctok vupptr
935
936 set pa $varcid($v,$p)
937 if {$p ne [lindex $varcstart($v) $pa]} {
938 splitvarc $p $v
939 set pa $varcid($v,$p)
940 }
941 # seeds always need to be renumbered
942 if {[lindex $vupptr($v) $pa] == 0 ||
943 [string compare [lindex $varctok($v) $a] \
944 [lindex $varctok($v) $pa]] > 0} {
945 renumbervarc $pa $v
946 }
947}
948
949proc insertrow {id p v} {
950 global cmitlisted children parents varcid varctok vtokmod
951 global varccommits ordertok commitidx numcommits curview
952 global targetid targetrow vshortids
953
954 readcommit $id
955 set vid $v,$id
956 set cmitlisted($vid) 1
957 set children($vid) {}
958 set parents($vid) [list $p]
959 set a [newvarc $v $id]
960 set varcid($vid) $a
961 lappend vshortids($v,[string range $id 0 3]) $id
962 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
963 modify_arc $v $a
964 }
965 lappend varccommits($v,$a) $id
966 set vp $v,$p
967 if {[llength [lappend children($vp) $id]] > 1} {
968 set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
969 catch {unset ordertok}
970 }
971 fix_reversal $p $a $v
972 incr commitidx($v)
973 if {$v == $curview} {
974 set numcommits $commitidx($v)
975 setcanvscroll
976 if {[info exists targetid]} {
977 if {![comes_before $targetid $p]} {
978 incr targetrow
979 }
980 }
981 }
982}
983
984proc insertfakerow {id p} {
985 global varcid varccommits parents children cmitlisted
986 global commitidx varctok vtokmod targetid targetrow curview numcommits
987
988 set v $curview
989 set a $varcid($v,$p)
990 set i [lsearch -exact $varccommits($v,$a) $p]
991 if {$i < 0} {
992 puts "oops: insertfakerow can't find [shortids $p] on arc $a"
993 return
994 }
995 set children($v,$id) {}
996 set parents($v,$id) [list $p]
997 set varcid($v,$id) $a
998 lappend children($v,$p) $id
999 set cmitlisted($v,$id) 1
1000 set numcommits [incr commitidx($v)]
1001 # note we deliberately don't update varcstart($v) even if $i == 0
1002 set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003 modify_arc $v $a $i
1004 if {[info exists targetid]} {
1005 if {![comes_before $targetid $p]} {
1006 incr targetrow
1007 }
1008 }
1009 setcanvscroll
1010 drawvisible
1011}
1012
1013proc removefakerow {id} {
1014 global varcid varccommits parents children commitidx
1015 global varctok vtokmod cmitlisted currentid selectedline
1016 global targetid curview numcommits
1017
1018 set v $curview
1019 if {[llength $parents($v,$id)] != 1} {
1020 puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021 return
1022 }
1023 set p [lindex $parents($v,$id) 0]
1024 set a $varcid($v,$id)
1025 set i [lsearch -exact $varccommits($v,$a) $id]
1026 if {$i < 0} {
1027 puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028 return
1029 }
1030 unset varcid($v,$id)
1031 set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032 unset parents($v,$id)
1033 unset children($v,$id)
1034 unset cmitlisted($v,$id)
1035 set numcommits [incr commitidx($v) -1]
1036 set j [lsearch -exact $children($v,$p) $id]
1037 if {$j >= 0} {
1038 set children($v,$p) [lreplace $children($v,$p) $j $j]
1039 }
1040 modify_arc $v $a $i
1041 if {[info exist currentid] && $id eq $currentid} {
1042 unset currentid
1043 set selectedline {}
1044 }
1045 if {[info exists targetid] && $targetid eq $id} {
1046 set targetid $p
1047 }
1048 setcanvscroll
1049 drawvisible
1050}
1051
1052proc real_children {vp} {
1053 global children nullid nullid2
1054
1055 set kids {}
1056 foreach id $children($vp) {
1057 if {$id ne $nullid && $id ne $nullid2} {
1058 lappend kids $id
1059 }
1060 }
1061 return $kids
1062}
1063
1064proc first_real_child {vp} {
1065 global children nullid nullid2
1066
1067 foreach id $children($vp) {
1068 if {$id ne $nullid && $id ne $nullid2} {
1069 return $id
1070 }
1071 }
1072 return {}
1073}
1074
1075proc last_real_child {vp} {
1076 global children nullid nullid2
1077
1078 set kids $children($vp)
1079 for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080 set id [lindex $kids $i]
1081 if {$id ne $nullid && $id ne $nullid2} {
1082 return $id
1083 }
1084 }
1085 return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089 global varctok varcid
1090
1091 return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092 [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098 global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100 if {$lim ne {}} {
1101 set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102 if {$c > 0} return
1103 if {$c == 0} {
1104 set r [lindex $varcrow($v) $a]
1105 if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106 }
1107 }
1108 set vtokmod($v) [lindex $varctok($v) $a]
1109 set varcmod($v) $a
1110 if {$v == $curview} {
1111 while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112 set a [lindex $vupptr($v) $a]
1113 set lim {}
1114 }
1115 set r 0
1116 if {$a != 0} {
1117 if {$lim eq {}} {
1118 set lim [llength $varccommits($v,$a)]
1119 }
1120 set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121 }
1122 set vrowmod($v) $r
1123 undolayout $r
1124 }
1125}
1126
1127proc update_arcrows {v} {
1128 global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129 global varcid vrownum varcorder varcix varccommits
1130 global vupptr vdownptr vleftptr varctok
1131 global displayorder parentlist curview cached_commitrow
1132
1133 if {$vrowmod($v) == $commitidx($v)} return
1134 if {$v == $curview} {
1135 if {[llength $displayorder] > $vrowmod($v)} {
1136 set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137 set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138 }
1139 catch {unset cached_commitrow}
1140 }
1141 set narctot [expr {[llength $varctok($v)] - 1}]
1142 set a $varcmod($v)
1143 while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144 # go up the tree until we find something that has a row number,
1145 # or we get to a seed
1146 set a [lindex $vupptr($v) $a]
1147 }
1148 if {$a == 0} {
1149 set a [lindex $vdownptr($v) 0]
1150 if {$a == 0} return
1151 set vrownum($v) {0}
1152 set varcorder($v) [list $a]
1153 lset varcix($v) $a 0
1154 lset varcrow($v) $a 0
1155 set arcn 0
1156 set row 0
1157 } else {
1158 set arcn [lindex $varcix($v) $a]
1159 if {[llength $vrownum($v)] > $arcn + 1} {
1160 set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161 set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162 }
1163 set row [lindex $varcrow($v) $a]
1164 }
1165 while {1} {
1166 set p $a
1167 incr row [llength $varccommits($v,$a)]
1168 # go down if possible
1169 set b [lindex $vdownptr($v) $a]
1170 if {$b == 0} {
1171 # if not, go left, or go up until we can go left
1172 while {$a != 0} {
1173 set b [lindex $vleftptr($v) $a]
1174 if {$b != 0} break
1175 set a [lindex $vupptr($v) $a]
1176 }
1177 if {$a == 0} break
1178 }
1179 set a $b
1180 incr arcn
1181 lappend vrownum($v) $row
1182 lappend varcorder($v) $a
1183 lset varcix($v) $a $arcn
1184 lset varcrow($v) $a $row
1185 }
1186 set vtokmod($v) [lindex $varctok($v) $p]
1187 set varcmod($v) $p
1188 set vrowmod($v) $row
1189 if {[info exists currentid]} {
1190 set selectedline [rowofcommit $currentid]
1191 }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196 global varcid
1197
1198 return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203 global varcid varccommits varcrow curview cached_commitrow
1204 global varctok vtokmod
1205
1206 set v $curview
1207 if {![info exists varcid($v,$id)]} {
1208 puts "oops rowofcommit no arc for [shortids $id]"
1209 return {}
1210 }
1211 set a $varcid($v,$id)
1212 if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213 update_arcrows $v
1214 }
1215 if {[info exists cached_commitrow($id)]} {
1216 return $cached_commitrow($id)
1217 }
1218 set i [lsearch -exact $varccommits($v,$a) $id]
1219 if {$i < 0} {
1220 puts "oops didn't find commit [shortids $id] in arc $a"
1221 return {}
1222 }
1223 incr i [lindex $varcrow($v) $a]
1224 set cached_commitrow($id) $i
1225 return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230 global varcid varctok curview
1231
1232 set v $curview
1233 if {$a eq $b || ![info exists varcid($v,$a)] || \
1234 ![info exists varcid($v,$b)]} {
1235 return 0
1236 }
1237 if {$varcid($v,$a) != $varcid($v,$b)} {
1238 return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239 [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240 }
1241 return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245 if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246 return 0
1247 }
1248 set lo 0
1249 set hi [llength $l]
1250 while {$hi - $lo > 1} {
1251 set mid [expr {int(($lo + $hi) / 2)}]
1252 set t [lindex $l $mid]
1253 if {$elt < $t} {
1254 set hi $mid
1255 } elseif {$elt > $t} {
1256 set lo $mid
1257 } else {
1258 return $mid
1259 }
1260 }
1261 return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266 global vrownum curview commitidx displayorder parentlist
1267 global varccommits varcorder parents vrowmod varcrow
1268 global d_valid_start d_valid_end
1269
1270 if {$end > $vrowmod($curview)} {
1271 update_arcrows $curview
1272 }
1273 set ai [bsearch $vrownum($curview) $start]
1274 set start [lindex $vrownum($curview) $ai]
1275 set narc [llength $vrownum($curview)]
1276 for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277 set a [lindex $varcorder($curview) $ai]
1278 set l [llength $displayorder]
1279 set al [llength $varccommits($curview,$a)]
1280 if {$l < $r + $al} {
1281 if {$l < $r} {
1282 set pad [ntimes [expr {$r - $l}] {}]
1283 set displayorder [concat $displayorder $pad]
1284 set parentlist [concat $parentlist $pad]
1285 } elseif {$l > $r} {
1286 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288 }
1289 foreach id $varccommits($curview,$a) {
1290 lappend displayorder $id
1291 lappend parentlist $parents($curview,$id)
1292 }
1293 } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294 set i $r
1295 foreach id $varccommits($curview,$a) {
1296 lset displayorder $i $id
1297 lset parentlist $i $parents($curview,$id)
1298 incr i
1299 }
1300 }
1301 incr r $al
1302 }
1303}
1304
1305proc commitonrow {row} {
1306 global displayorder
1307
1308 set id [lindex $displayorder $row]
1309 if {$id eq {}} {
1310 make_disporder $row [expr {$row + 1}]
1311 set id [lindex $displayorder $row]
1312 }
1313 return $id
1314}
1315
1316proc closevarcs {v} {
1317 global varctok varccommits varcid parents children
1318 global cmitlisted commitidx vtokmod
1319
1320 set missing_parents 0
1321 set scripts {}
1322 set narcs [llength $varctok($v)]
1323 for {set a 1} {$a < $narcs} {incr a} {
1324 set id [lindex $varccommits($v,$a) end]
1325 foreach p $parents($v,$id) {
1326 if {[info exists varcid($v,$p)]} continue
1327 # add p as a new commit
1328 incr missing_parents
1329 set cmitlisted($v,$p) 0
1330 set parents($v,$p) {}
1331 if {[llength $children($v,$p)] == 1 &&
1332 [llength $parents($v,$id)] == 1} {
1333 set b $a
1334 } else {
1335 set b [newvarc $v $p]
1336 }
1337 set varcid($v,$p) $b
1338 if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339 modify_arc $v $b
1340 }
1341 lappend varccommits($v,$b) $p
1342 incr commitidx($v)
1343 set scripts [check_interest $p $scripts]
1344 }
1345 }
1346 if {$missing_parents > 0} {
1347 foreach s $scripts {
1348 eval $s
1349 }
1350 }
1351}
1352
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356 global children parents varcid varctok vtokmod varccommits
1357
1358 foreach ch $children($v,$id) {
1359 # make $rwid be $ch's parent in place of $id
1360 set i [lsearch -exact $parents($v,$ch) $id]
1361 if {$i < 0} {
1362 puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363 }
1364 set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365 # add $ch to $rwid's children and sort the list if necessary
1366 if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367 set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368 $children($v,$rwid)]
1369 }
1370 # fix the graph after joining $id to $rwid
1371 set a $varcid($v,$ch)
1372 fix_reversal $rwid $a $v
1373 # parentlist is wrong for the last element of arc $a
1374 # even if displayorder is right, hence the 3rd arg here
1375 modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376 }
1377}
1378
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit. To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID. Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385 global commitinterest
1386
1387 lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391 global commitinterest
1392
1393 set prefix [string range $id 0 3]
1394 if {[info exists commitinterest($prefix)]} {
1395 set newlist {}
1396 foreach {i script} $commitinterest($prefix) {
1397 if {[string match "$i*" $id]} {
1398 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399 } else {
1400 lappend newlist $i $script
1401 }
1402 }
1403 if {$newlist ne {}} {
1404 set commitinterest($prefix) $newlist
1405 } else {
1406 unset commitinterest($prefix)
1407 }
1408 }
1409 return $scripts
1410}
1411
1412proc getcommitlines {fd inst view updating} {
1413 global cmitlisted leftover
1414 global commitidx commitdata vdatemode
1415 global parents children curview hlview
1416 global idpending ordertok
1417 global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419 set stuff [read $fd 500000]
1420 # git log doesn't terminate the last commit with a null...
1421 if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422 set stuff "\0"
1423 }
1424 if {$stuff == {}} {
1425 if {![eof $fd]} {
1426 return 1
1427 }
1428 global commfd viewcomplete viewactive viewname
1429 global viewinstances
1430 unset commfd($inst)
1431 set i [lsearch -exact $viewinstances($view) $inst]
1432 if {$i >= 0} {
1433 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434 }
1435 # set it blocking so we wait for the process to terminate
1436 fconfigure $fd -blocking 1
1437 if {[catch {close $fd} err]} {
1438 set fv {}
1439 if {$view != $curview} {
1440 set fv " for the \"$viewname($view)\" view"
1441 }
1442 if {[string range $err 0 4] == "usage"} {
1443 set err "Gitk: error reading commits$fv:\
1444 bad arguments to git log."
1445 if {$viewname($view) eq "Command line"} {
1446 append err \
1447 " (Note: arguments to gitk are passed to git log\
1448 to allow selection of commits to be displayed.)"
1449 }
1450 } else {
1451 set err "Error reading commits$fv: $err"
1452 }
1453 error_popup $err
1454 }
1455 if {[incr viewactive($view) -1] <= 0} {
1456 set viewcomplete($view) 1
1457 # Check if we have seen any ids listed as parents that haven't
1458 # appeared in the list
1459 closevarcs $view
1460 notbusy $view
1461 }
1462 if {$view == $curview} {
1463 run chewcommits
1464 }
1465 return 0
1466 }
1467 set start 0
1468 set gotsome 0
1469 set scripts {}
1470 while 1 {
1471 set i [string first "\0" $stuff $start]
1472 if {$i < 0} {
1473 append leftover($inst) [string range $stuff $start end]
1474 break
1475 }
1476 if {$start == 0} {
1477 set cmit $leftover($inst)
1478 append cmit [string range $stuff 0 [expr {$i - 1}]]
1479 set leftover($inst) {}
1480 } else {
1481 set cmit [string range $stuff $start [expr {$i - 1}]]
1482 }
1483 set start [expr {$i + 1}]
1484 set j [string first "\n" $cmit]
1485 set ok 0
1486 set listed 1
1487 if {$j >= 0 && [string match "commit *" $cmit]} {
1488 set ids [string range $cmit 7 [expr {$j - 1}]]
1489 if {[string match {[-^<>]*} $ids]} {
1490 switch -- [string index $ids 0] {
1491 "-" {set listed 0}
1492 "^" {set listed 2}
1493 "<" {set listed 3}
1494 ">" {set listed 4}
1495 }
1496 set ids [string range $ids 1 end]
1497 }
1498 set ok 1
1499 foreach id $ids {
1500 if {[string length $id] != 40} {
1501 set ok 0
1502 break
1503 }
1504 }
1505 }
1506 if {!$ok} {
1507 set shortcmit $cmit
1508 if {[string length $shortcmit] > 80} {
1509 set shortcmit "[string range $shortcmit 0 80]..."
1510 }
1511 error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512 exit 1
1513 }
1514 set id [lindex $ids 0]
1515 set vid $view,$id
1516
1517 lappend vshortids($view,[string range $id 0 3]) $id
1518
1519 if {!$listed && $updating && ![info exists varcid($vid)] &&
1520 $vfilelimit($view) ne {}} {
1521 # git log doesn't rewrite parents for unlisted commits
1522 # when doing path limiting, so work around that here
1523 # by working out the rewritten parent with git rev-list
1524 # and if we already know about it, using the rewritten
1525 # parent as a substitute parent for $id's children.
1526 if {![catch {
1527 set rwid [exec git rev-list --first-parent --max-count=1 \
1528 $id -- $vfilelimit($view)]
1529 }]} {
1530 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531 # use $rwid in place of $id
1532 rewrite_commit $view $id $rwid
1533 continue
1534 }
1535 }
1536 }
1537
1538 set a 0
1539 if {[info exists varcid($vid)]} {
1540 if {$cmitlisted($vid) || !$listed} continue
1541 set a $varcid($vid)
1542 }
1543 if {$listed} {
1544 set olds [lrange $ids 1 end]
1545 } else {
1546 set olds {}
1547 }
1548 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549 set cmitlisted($vid) $listed
1550 set parents($vid) $olds
1551 if {![info exists children($vid)]} {
1552 set children($vid) {}
1553 } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554 set k [lindex $children($vid) 0]
1555 if {[llength $parents($view,$k)] == 1 &&
1556 (!$vdatemode($view) ||
1557 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558 set a $varcid($view,$k)
1559 }
1560 }
1561 if {$a == 0} {
1562 # new arc
1563 set a [newvarc $view $id]
1564 }
1565 if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566 modify_arc $view $a
1567 }
1568 if {![info exists varcid($vid)]} {
1569 set varcid($vid) $a
1570 lappend varccommits($view,$a) $id
1571 incr commitidx($view)
1572 }
1573
1574 set i 0
1575 foreach p $olds {
1576 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577 set vp $view,$p
1578 if {[llength [lappend children($vp) $id]] > 1 &&
1579 [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580 set children($vp) [lsort -command [list vtokcmp $view] \
1581 $children($vp)]
1582 catch {unset ordertok}
1583 }
1584 if {[info exists varcid($view,$p)]} {
1585 fix_reversal $p $a $view
1586 }
1587 }
1588 incr i
1589 }
1590
1591 set scripts [check_interest $id $scripts]
1592 set gotsome 1
1593 }
1594 if {$gotsome} {
1595 global numcommits hlview
1596
1597 if {$view == $curview} {
1598 set numcommits $commitidx($view)
1599 run chewcommits
1600 }
1601 if {[info exists hlview] && $view == $hlview} {
1602 # we never actually get here...
1603 run vhighlightmore
1604 }
1605 foreach s $scripts {
1606 eval $s
1607 }
1608 }
1609 return 2
1610}
1611
1612proc chewcommits {} {
1613 global curview hlview viewcomplete
1614 global pending_select
1615
1616 layoutmore
1617 if {$viewcomplete($curview)} {
1618 global commitidx varctok
1619 global numcommits startmsecs
1620
1621 if {[info exists pending_select]} {
1622 update
1623 reset_pending_select {}
1624
1625 if {[commitinview $pending_select $curview]} {
1626 selectline [rowofcommit $pending_select] 1
1627 } else {
1628 set row [first_real_row]
1629 selectline $row 1
1630 }
1631 }
1632 if {$commitidx($curview) > 0} {
1633 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634 #puts "overall $ms ms for $numcommits commits"
1635 #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636 } else {
1637 show_status [mc "No commits selected"]
1638 }
1639 notbusy layout
1640 }
1641 return 0
1642}
1643
1644proc do_readcommit {id} {
1645 global tclencoding
1646
1647 # Invoke git-log to handle automatic encoding conversion
1648 set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649 # Read the results using i18n.logoutputencoding
1650 fconfigure $fd -translation lf -eofchar {}
1651 if {$tclencoding != {}} {
1652 fconfigure $fd -encoding $tclencoding
1653 }
1654 set contents [read $fd]
1655 close $fd
1656 # Remove the heading line
1657 regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659 return $contents
1660}
1661
1662proc readcommit {id} {
1663 if {[catch {set contents [do_readcommit $id]}]} return
1664 parsecommit $id $contents 1
1665}
1666
1667proc parsecommit {id contents listed} {
1668 global commitinfo
1669
1670 set inhdr 1
1671 set comment {}
1672 set headline {}
1673 set auname {}
1674 set audate {}
1675 set comname {}
1676 set comdate {}
1677 set hdrend [string first "\n\n" $contents]
1678 if {$hdrend < 0} {
1679 # should never happen...
1680 set hdrend [string length $contents]
1681 }
1682 set header [string range $contents 0 [expr {$hdrend - 1}]]
1683 set comment [string range $contents [expr {$hdrend + 2}] end]
1684 foreach line [split $header "\n"] {
1685 set line [split $line " "]
1686 set tag [lindex $line 0]
1687 if {$tag == "author"} {
1688 set audate [lrange $line end-1 end]
1689 set auname [join [lrange $line 1 end-2] " "]
1690 } elseif {$tag == "committer"} {
1691 set comdate [lrange $line end-1 end]
1692 set comname [join [lrange $line 1 end-2] " "]
1693 }
1694 }
1695 set headline {}
1696 # take the first non-blank line of the comment as the headline
1697 set headline [string trimleft $comment]
1698 set i [string first "\n" $headline]
1699 if {$i >= 0} {
1700 set headline [string range $headline 0 $i]
1701 }
1702 set headline [string trimright $headline]
1703 set i [string first "\r" $headline]
1704 if {$i >= 0} {
1705 set headline [string trimright [string range $headline 0 $i]]
1706 }
1707 if {!$listed} {
1708 # git log indents the comment by 4 spaces;
1709 # if we got this via git cat-file, add the indentation
1710 set newcomment {}
1711 foreach line [split $comment "\n"] {
1712 append newcomment " "
1713 append newcomment $line
1714 append newcomment "\n"
1715 }
1716 set comment $newcomment
1717 }
1718 set hasnote [string first "\nNotes:\n" $contents]
1719 set diff ""
1720 # If there is diff output shown in the git-log stream, split it
1721 # out. But get rid of the empty line that always precedes the
1722 # diff.
1723 set i [string first "\n\ndiff" $comment]
1724 if {$i >= 0} {
1725 set diff [string range $comment $i+1 end]
1726 set comment [string range $comment 0 $i-1]
1727 }
1728 set commitinfo($id) [list $headline $auname $audate \
1729 $comname $comdate $comment $hasnote $diff]
1730}
1731
1732proc getcommit {id} {
1733 global commitdata commitinfo
1734
1735 if {[info exists commitdata($id)]} {
1736 parsecommit $id $commitdata($id) 1
1737 } else {
1738 readcommit $id
1739 if {![info exists commitinfo($id)]} {
1740 set commitinfo($id) [list [mc "No commit information available"]]
1741 }
1742 }
1743 return 1
1744}
1745
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
1750 global varcid curview vshortids
1751
1752 set ids {}
1753 if {[string length $prefix] >= 4} {
1754 set vshortid $curview,[string range $prefix 0 3]
1755 if {[info exists vshortids($vshortid)]} {
1756 foreach id $vshortids($vshortid) {
1757 if {[string match "$prefix*" $id]} {
1758 if {[lsearch -exact $ids $id] < 0} {
1759 lappend ids $id
1760 if {[llength $ids] >= 2} break
1761 }
1762 }
1763 }
1764 }
1765 } else {
1766 foreach match [array names varcid "$curview,$prefix*"] {
1767 lappend ids [lindex [split $match ","] 1]
1768 if {[llength $ids] >= 2} break
1769 }
1770 }
1771 return $ids
1772}
1773
1774proc readrefs {} {
1775 global tagids idtags headids idheads tagobjid
1776 global otherrefids idotherrefs mainhead mainheadid
1777 global selecthead selectheadid
1778 global hideremotes
1779
1780 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781 catch {unset $v}
1782 }
1783 set refd [open [list | git show-ref -d] r]
1784 while {[gets $refd line] >= 0} {
1785 if {[string index $line 40] ne " "} continue
1786 set id [string range $line 0 39]
1787 set ref [string range $line 41 end]
1788 if {![string match "refs/*" $ref]} continue
1789 set name [string range $ref 5 end]
1790 if {[string match "remotes/*" $name]} {
1791 if {![string match "*/HEAD" $name] && !$hideremotes} {
1792 set headids($name) $id
1793 lappend idheads($id) $name
1794 }
1795 } elseif {[string match "heads/*" $name]} {
1796 set name [string range $name 6 end]
1797 set headids($name) $id
1798 lappend idheads($id) $name
1799 } elseif {[string match "tags/*" $name]} {
1800 # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801 # which is what we want since the former is the commit ID
1802 set name [string range $name 5 end]
1803 if {[string match "*^{}" $name]} {
1804 set name [string range $name 0 end-3]
1805 } else {
1806 set tagobjid($name) $id
1807 }
1808 set tagids($name) $id
1809 lappend idtags($id) $name
1810 } else {
1811 set otherrefids($name) $id
1812 lappend idotherrefs($id) $name
1813 }
1814 }
1815 catch {close $refd}
1816 set mainhead {}
1817 set mainheadid {}
1818 catch {
1819 set mainheadid [exec git rev-parse HEAD]
1820 set thehead [exec git symbolic-ref HEAD]
1821 if {[string match "refs/heads/*" $thehead]} {
1822 set mainhead [string range $thehead 11 end]
1823 }
1824 }
1825 set selectheadid {}
1826 if {$selecthead ne {}} {
1827 catch {
1828 set selectheadid [exec git rev-parse --verify $selecthead]
1829 }
1830 }
1831}
1832
1833# skip over fake commits
1834proc first_real_row {} {
1835 global nullid nullid2 numcommits
1836
1837 for {set row 0} {$row < $numcommits} {incr row} {
1838 set id [commitonrow $row]
1839 if {$id ne $nullid && $id ne $nullid2} {
1840 break
1841 }
1842 }
1843 return $row
1844}
1845
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848 global headids idheads
1849
1850 removehead $headids($name) $name
1851 set headids($name) $id
1852 lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857 global headids idheads
1858
1859 if {$idheads($id) eq $name} {
1860 unset idheads($id)
1861 } else {
1862 set i [lsearch -exact $idheads($id) $name]
1863 if {$i >= 0} {
1864 set idheads($id) [lreplace $idheads($id) $i $i]
1865 }
1866 }
1867 unset headids($name)
1868}
1869
1870proc ttk_toplevel {w args} {
1871 global use_ttk
1872 eval [linsert $args 0 ::toplevel $w]
1873 if {$use_ttk} {
1874 place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875 }
1876 return $w
1877}
1878
1879proc make_transient {window origin} {
1880 global have_tk85
1881
1882 # In MacOS Tk 8.4 transient appears to work by setting
1883 # overrideredirect, which is utterly useless, since the
1884 # windows get no border, and are not even kept above
1885 # the parent.
1886 if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888 wm transient $window $origin
1889
1890 # Windows fails to place transient windows normally, so
1891 # schedule a callback to center them on the parent.
1892 if {[tk windowingsystem] eq {win32}} {
1893 after idle [list tk::PlaceWindow $window widget $origin]
1894 }
1895}
1896
1897proc show_error {w top msg {mc mc}} {
1898 global NS
1899 if {![info exists NS]} {set NS ""}
1900 if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901 message $w.m -text $msg -justify center -aspect 400
1902 pack $w.m -side top -fill x -padx 20 -pady 20
1903 ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1904 pack $w.ok -side bottom -fill x
1905 bind $top <Visibility> "grab $top; focus $top"
1906 bind $top <Key-Return> "destroy $top"
1907 bind $top <Key-space> "destroy $top"
1908 bind $top <Key-Escape> "destroy $top"
1909 tkwait window $top
1910}
1911
1912proc error_popup {msg {owner .}} {
1913 if {[tk windowingsystem] eq "win32"} {
1914 tk_messageBox -icon error -type ok -title [wm title .] \
1915 -parent $owner -message $msg
1916 } else {
1917 set w .error
1918 ttk_toplevel $w
1919 make_transient $w $owner
1920 show_error $w $w $msg
1921 }
1922}
1923
1924proc confirm_popup {msg {owner .}} {
1925 global confirm_ok NS
1926 set confirm_ok 0
1927 set w .confirm
1928 ttk_toplevel $w
1929 make_transient $w $owner
1930 message $w.m -text $msg -justify center -aspect 400
1931 pack $w.m -side top -fill x -padx 20 -pady 20
1932 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933 pack $w.ok -side left -fill x
1934 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935 pack $w.cancel -side right -fill x
1936 bind $w <Visibility> "grab $w; focus $w"
1937 bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938 bind $w <Key-space> "set confirm_ok 1; destroy $w"
1939 bind $w <Key-Escape> "destroy $w"
1940 tk::PlaceWindow $w widget $owner
1941 tkwait window $w
1942 return $confirm_ok
1943}
1944
1945proc setoptions {} {
1946 if {[tk windowingsystem] ne "win32"} {
1947 option add *Panedwindow.showHandle 1 startupFile
1948 option add *Panedwindow.sashRelief raised startupFile
1949 if {[tk windowingsystem] ne "aqua"} {
1950 option add *Menu.font uifont startupFile
1951 }
1952 } else {
1953 option add *Menu.TearOff 0 startupFile
1954 }
1955 option add *Button.font uifont startupFile
1956 option add *Checkbutton.font uifont startupFile
1957 option add *Radiobutton.font uifont startupFile
1958 option add *Menubutton.font uifont startupFile
1959 option add *Label.font uifont startupFile
1960 option add *Message.font uifont startupFile
1961 option add *Entry.font textfont startupFile
1962 option add *Text.font textfont startupFile
1963 option add *Labelframe.font uifont startupFile
1964 option add *Spinbox.font textfont startupFile
1965 option add *Listbox.font mainfont startupFile
1966}
1967
1968# Make a menu and submenus.
1969# m is the window name for the menu, items is the list of menu items to add.
1970# Each item is a list {mc label type description options...}
1971# mc is ignored; it's so we can put mc there to alert xgettext
1972# label is the string that appears in the menu
1973# type is cascade, command or radiobutton (should add checkbutton)
1974# description depends on type; it's the sublist for cascade, the
1975# command to invoke for command, or {variable value} for radiobutton
1976proc makemenu {m items} {
1977 menu $m
1978 if {[tk windowingsystem] eq {aqua}} {
1979 set Meta1 Cmd
1980 } else {
1981 set Meta1 Ctrl
1982 }
1983 foreach i $items {
1984 set name [mc [lindex $i 1]]
1985 set type [lindex $i 2]
1986 set thing [lindex $i 3]
1987 set params [list $type]
1988 if {$name ne {}} {
1989 set u [string first "&" [string map {&& x} $name]]
1990 lappend params -label [string map {&& & & {}} $name]
1991 if {$u >= 0} {
1992 lappend params -underline $u
1993 }
1994 }
1995 switch -- $type {
1996 "cascade" {
1997 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1998 lappend params -menu $m.$submenu
1999 }
2000 "command" {
2001 lappend params -command $thing
2002 }
2003 "radiobutton" {
2004 lappend params -variable [lindex $thing 0] \
2005 -value [lindex $thing 1]
2006 }
2007 }
2008 set tail [lrange $i 4 end]
2009 regsub -all {\yMeta1\y} $tail $Meta1 tail
2010 eval $m add $params $tail
2011 if {$type eq "cascade"} {
2012 makemenu $m.$submenu $thing
2013 }
2014 }
2015}
2016
2017# translate string and remove ampersands
2018proc mca {str} {
2019 return [string map {&& & & {}} [mc $str]]
2020}
2021
2022proc cleardropsel {w} {
2023 $w selection clear
2024}
2025proc makedroplist {w varname args} {
2026 global use_ttk
2027 if {$use_ttk} {
2028 set width 0
2029 foreach label $args {
2030 set cx [string length $label]
2031 if {$cx > $width} {set width $cx}
2032 }
2033 set gm [ttk::combobox $w -width $width -state readonly\
2034 -textvariable $varname -values $args \
2035 -exportselection false]
2036 bind $gm <<ComboboxSelected>> [list $gm selection clear]
2037 } else {
2038 set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039 }
2040 return $gm
2041}
2042
2043proc makewindow {} {
2044 global canv canv2 canv3 linespc charspc ctext cflist cscroll
2045 global tabstop
2046 global findtype findtypemenu findloc findstring fstring geometry
2047 global entries sha1entry sha1string sha1but
2048 global diffcontextstring diffcontext
2049 global ignorespace
2050 global maincursor textcursor curtextcursor
2051 global rowctxmenu fakerowmenu mergemax wrapcomment
2052 global highlight_files gdttype
2053 global searchstring sstring
2054 global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2055 global uifgcolor uifgdisabledcolor
2056 global filesepbgcolor filesepfgcolor
2057 global mergecolors foundbgcolor currentsearchhitbgcolor
2058 global headctxmenu progresscanv progressitem progresscoords statusw
2059 global fprogitem fprogcoord lastprogupdate progupdatepending
2060 global rprogitem rprogcoord rownumsel numcommits
2061 global have_tk85 use_ttk NS
2062 global git_version
2063 global worddiff
2064
2065 # The "mc" arguments here are purely so that xgettext
2066 # sees the following string as needing to be translated
2067 set file {
2068 mc "File" cascade {
2069 {mc "Update" command updatecommits -accelerator F5}
2070 {mc "Reload" command reloadcommits -accelerator Shift-F5}
2071 {mc "Reread references" command rereadrefs}
2072 {mc "List references" command showrefs -accelerator F2}
2073 {xx "" separator}
2074 {mc "Start git gui" command {exec git gui &}}
2075 {xx "" separator}
2076 {mc "Quit" command doquit -accelerator Meta1-Q}
2077 }}
2078 set edit {
2079 mc "Edit" cascade {
2080 {mc "Preferences" command doprefs}
2081 }}
2082 set view {
2083 mc "View" cascade {
2084 {mc "New view..." command {newview 0} -accelerator Shift-F4}
2085 {mc "Edit view..." command editview -state disabled -accelerator F4}
2086 {mc "Delete view" command delview -state disabled}
2087 {xx "" separator}
2088 {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2089 }}
2090 if {[tk windowingsystem] ne "aqua"} {
2091 set help {
2092 mc "Help" cascade {
2093 {mc "About gitk" command about}
2094 {mc "Key bindings" command keys}
2095 }}
2096 set bar [list $file $edit $view $help]
2097 } else {
2098 proc ::tk::mac::ShowPreferences {} {doprefs}
2099 proc ::tk::mac::Quit {} {doquit}
2100 lset file end [lreplace [lindex $file end] end-1 end]
2101 set apple {
2102 xx "Apple" cascade {
2103 {mc "About gitk" command about}
2104 {xx "" separator}
2105 }}
2106 set help {
2107 mc "Help" cascade {
2108 {mc "Key bindings" command keys}
2109 }}
2110 set bar [list $apple $file $view $help]
2111 }
2112 makemenu .bar $bar
2113 . configure -menu .bar
2114
2115 if {$use_ttk} {
2116 # cover the non-themed toplevel with a themed frame.
2117 place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118 }
2119
2120 # the gui has upper and lower half, parts of a paned window.
2121 ${NS}::panedwindow .ctop -orient vertical
2122
2123 # possibly use assumed geometry
2124 if {![info exists geometry(pwsash0)]} {
2125 set geometry(topheight) [expr {15 * $linespc}]
2126 set geometry(topwidth) [expr {80 * $charspc}]
2127 set geometry(botheight) [expr {15 * $linespc}]
2128 set geometry(botwidth) [expr {50 * $charspc}]
2129 set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130 set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2131 }
2132
2133 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2134 ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135 ${NS}::frame .tf.histframe
2136 ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137 if {!$use_ttk} {
2138 .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139 }
2140
2141 # create three canvases
2142 set cscroll .tf.histframe.csb
2143 set canv .tf.histframe.pwclist.canv
2144 canvas $canv \
2145 -selectbackground $selectbgcolor \
2146 -background $bgcolor -bd 0 \
2147 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2148 .tf.histframe.pwclist add $canv
2149 set canv2 .tf.histframe.pwclist.canv2
2150 canvas $canv2 \
2151 -selectbackground $selectbgcolor \
2152 -background $bgcolor -bd 0 -yscrollincr $linespc
2153 .tf.histframe.pwclist add $canv2
2154 set canv3 .tf.histframe.pwclist.canv3
2155 canvas $canv3 \
2156 -selectbackground $selectbgcolor \
2157 -background $bgcolor -bd 0 -yscrollincr $linespc
2158 .tf.histframe.pwclist add $canv3
2159 if {$use_ttk} {
2160 bind .tf.histframe.pwclist <Map> {
2161 bind %W <Map> {}
2162 .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163 .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164 }
2165 } else {
2166 eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167 eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168 }
2169
2170 # a scroll bar to rule them
2171 ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172 if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2173 pack $cscroll -side right -fill y
2174 bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2175 lappend bglist $canv $canv2 $canv3
2176 pack .tf.histframe.pwclist -fill both -expand 1 -side left
2177
2178 # we have two button bars at bottom of top frame. Bar 1
2179 ${NS}::frame .tf.bar
2180 ${NS}::frame .tf.lbar -height 15
2181
2182 set sha1entry .tf.bar.sha1
2183 set entries $sha1entry
2184 set sha1but .tf.bar.sha1label
2185 button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2186 -command gotocommit -width 8
2187 $sha1but conf -disabledforeground [$sha1but cget -foreground]
2188 pack .tf.bar.sha1label -side left
2189 ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2190 trace add variable sha1string write sha1change
2191 pack $sha1entry -side left -pady 2
2192
2193 set bm_left_data {
2194 #define left_width 16
2195 #define left_height 16
2196 static unsigned char left_bits[] = {
2197 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200 }
2201 set bm_right_data {
2202 #define right_width 16
2203 #define right_height 16
2204 static unsigned char right_bits[] = {
2205 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208 }
2209 image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210 image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211 image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212 image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2213
2214 ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215 if {$use_ttk} {
2216 .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217 } else {
2218 .tf.bar.leftbut configure -image bm-left
2219 }
2220 pack .tf.bar.leftbut -side left -fill y
2221 ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222 if {$use_ttk} {
2223 .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224 } else {
2225 .tf.bar.rightbut configure -image bm-right
2226 }
2227 pack .tf.bar.rightbut -side left -fill y
2228
2229 ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2230 set rownumsel {}
2231 ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2232 -relief sunken -anchor e
2233 ${NS}::label .tf.bar.rowlabel2 -text "/"
2234 ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2235 -relief sunken -anchor e
2236 pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237 -side left
2238 if {!$use_ttk} {
2239 foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240 }
2241 global selectedline
2242 trace add variable selectedline write selectedline_change
2243
2244 # Status label and progress bar
2245 set statusw .tf.bar.status
2246 ${NS}::label $statusw -width 15 -relief sunken
2247 pack $statusw -side left -padx 5
2248 if {$use_ttk} {
2249 set progresscanv [ttk::progressbar .tf.bar.progress]
2250 } else {
2251 set h [expr {[font metrics uifont -linespace] + 2}]
2252 set progresscanv .tf.bar.progress
2253 canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254 set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255 set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256 set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257 }
2258 pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2259 set progresscoords {0 0}
2260 set fprogcoord 0
2261 set rprogcoord 0
2262 bind $progresscanv <Configure> adjustprogress
2263 set lastprogupdate [clock clicks -milliseconds]
2264 set progupdatepending 0
2265
2266 # build up the bottom bar of upper window
2267 ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2268
2269 set bm_down_data {
2270 #define down_width 16
2271 #define down_height 16
2272 static unsigned char down_bits[] = {
2273 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277 }
2278 image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279 ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280 .tf.lbar.fnext configure -image bm-down
2281
2282 set bm_up_data {
2283 #define up_width 16
2284 #define up_height 16
2285 static unsigned char up_bits[] = {
2286 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290 }
2291 image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292 ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293 .tf.lbar.fprev configure -image bm-up
2294
2295 ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2296
2297 pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298 -side left -fill y
2299 set gdttype [mc "containing:"]
2300 set gm [makedroplist .tf.lbar.gdttype gdttype \
2301 [mc "containing:"] \
2302 [mc "touching paths:"] \
2303 [mc "adding/removing string:"] \
2304 [mc "changing lines matching:"]]
2305 trace add variable gdttype write gdttype_change
2306 pack .tf.lbar.gdttype -side left -fill y
2307
2308 set findstring {}
2309 set fstring .tf.lbar.findstring
2310 lappend entries $fstring
2311 ${NS}::entry $fstring -width 30 -textvariable findstring
2312 trace add variable findstring write find_change
2313 set findtype [mc "Exact"]
2314 set findtypemenu [makedroplist .tf.lbar.findtype \
2315 findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2316 trace add variable findtype write findcom_change
2317 set findloc [mc "All fields"]
2318 makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2319 [mc "Comments"] [mc "Author"] [mc "Committer"]
2320 trace add variable findloc write find_change
2321 pack .tf.lbar.findloc -side right
2322 pack .tf.lbar.findtype -side right
2323 pack $fstring -side left -expand 1 -fill x
2324
2325 # Finish putting the upper half of the viewer together
2326 pack .tf.lbar -in .tf -side bottom -fill x
2327 pack .tf.bar -in .tf -side bottom -fill x
2328 pack .tf.histframe -fill both -side top -expand 1
2329 .ctop add .tf
2330 if {!$use_ttk} {
2331 .ctop paneconfigure .tf -height $geometry(topheight)
2332 .ctop paneconfigure .tf -width $geometry(topwidth)
2333 }
2334
2335 # now build up the bottom
2336 ${NS}::panedwindow .pwbottom -orient horizontal
2337
2338 # lower left, a text box over search bar, scroll bar to the right
2339 # if we know window height, then that will set the lower text height, otherwise
2340 # we set lower text height which will drive window height
2341 if {[info exists geometry(main)]} {
2342 ${NS}::frame .bleft -width $geometry(botwidth)
2343 } else {
2344 ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2345 }
2346 ${NS}::frame .bleft.top
2347 ${NS}::frame .bleft.mid
2348 ${NS}::frame .bleft.bottom
2349
2350 ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2351 pack .bleft.top.search -side left -padx 5
2352 set sstring .bleft.top.sstring
2353 set searchstring ""
2354 ${NS}::entry $sstring -width 20 -textvariable searchstring
2355 lappend entries $sstring
2356 trace add variable searchstring write incrsearch
2357 pack $sstring -side left -expand 1 -fill x
2358 ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2359 -command changediffdisp -variable diffelide -value {0 0}
2360 ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2361 -command changediffdisp -variable diffelide -value {0 1}
2362 ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2363 -command changediffdisp -variable diffelide -value {1 0}
2364 ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
2365 pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2366 spinbox .bleft.mid.diffcontext -width 5 \
2367 -from 0 -increment 1 -to 10000000 \
2368 -validate all -validatecommand "diffcontextvalidate %P" \
2369 -textvariable diffcontextstring
2370 .bleft.mid.diffcontext set $diffcontext
2371 trace add variable diffcontextstring write diffcontextchange
2372 lappend entries .bleft.mid.diffcontext
2373 pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2374 ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2375 -command changeignorespace -variable ignorespace
2376 pack .bleft.mid.ignspace -side left -padx 5
2377
2378 set worddiff [mc "Line diff"]
2379 if {[package vcompare $git_version "1.7.2"] >= 0} {
2380 makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381 [mc "Markup words"] [mc "Color words"]
2382 trace add variable worddiff write changeworddiff
2383 pack .bleft.mid.worddiff -side left -padx 5
2384 }
2385
2386 set ctext .bleft.bottom.ctext
2387 text $ctext -background $bgcolor -foreground $fgcolor \
2388 -state disabled -font textfont \
2389 -yscrollcommand scrolltext -wrap none \
2390 -xscrollcommand ".bleft.bottom.sbhorizontal set"
2391 if {$have_tk85} {
2392 $ctext conf -tabstyle wordprocessor
2393 }
2394 ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395 ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2396 pack .bleft.top -side top -fill x
2397 pack .bleft.mid -side top -fill x
2398 grid $ctext .bleft.bottom.sb -sticky nsew
2399 grid .bleft.bottom.sbhorizontal -sticky ew
2400 grid columnconfigure .bleft.bottom 0 -weight 1
2401 grid rowconfigure .bleft.bottom 0 -weight 1
2402 grid rowconfigure .bleft.bottom 1 -weight 0
2403 pack .bleft.bottom -side top -fill both -expand 1
2404 lappend bglist $ctext
2405 lappend fglist $ctext
2406
2407 $ctext tag conf comment -wrap $wrapcomment
2408 $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2409 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410 $ctext tag conf d0 -fore [lindex $diffcolors 0]
2411 $ctext tag conf dresult -fore [lindex $diffcolors 1]
2412 $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413 $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414 $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415 $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416 $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417 $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418 $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419 $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420 $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421 $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422 $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423 $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424 $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425 $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426 $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427 $ctext tag conf m15 -fore [lindex $mergecolors 15]
2428 $ctext tag conf mmax -fore darkgrey
2429 set mergemax 16
2430 $ctext tag conf mresult -font textfontbold
2431 $ctext tag conf msep -font textfontbold
2432 $ctext tag conf found -back $foundbgcolor
2433 $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2434 $ctext tag conf wwrap -wrap word -lmargin2 1c
2435 $ctext tag conf bold -font textfontbold
2436
2437 .pwbottom add .bleft
2438 if {!$use_ttk} {
2439 .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440 }
2441
2442 # lower right
2443 ${NS}::frame .bright
2444 ${NS}::frame .bright.mode
2445 ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2446 -command reselectline -variable cmitmode -value "patch"
2447 ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2448 -command reselectline -variable cmitmode -value "tree"
2449 grid .bright.mode.patch .bright.mode.tree -sticky ew
2450 pack .bright.mode -side top -fill x
2451 set cflist .bright.cfiles
2452 set indent [font measure mainfont "nn"]
2453 text $cflist \
2454 -selectbackground $selectbgcolor \
2455 -background $bgcolor -foreground $fgcolor \
2456 -font mainfont \
2457 -tabs [list $indent [expr {2 * $indent}]] \
2458 -yscrollcommand ".bright.sb set" \
2459 -cursor [. cget -cursor] \
2460 -spacing1 1 -spacing3 1
2461 lappend bglist $cflist
2462 lappend fglist $cflist
2463 ${NS}::scrollbar .bright.sb -command "$cflist yview"
2464 pack .bright.sb -side right -fill y
2465 pack $cflist -side left -fill both -expand 1
2466 $cflist tag configure highlight \
2467 -background [$cflist cget -selectbackground]
2468 $cflist tag configure bold -font mainfontbold
2469
2470 .pwbottom add .bright
2471 .ctop add .pwbottom
2472
2473 # restore window width & height if known
2474 if {[info exists geometry(main)]} {
2475 if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476 if {$w > [winfo screenwidth .]} {
2477 set w [winfo screenwidth .]
2478 }
2479 if {$h > [winfo screenheight .]} {
2480 set h [winfo screenheight .]
2481 }
2482 wm geometry . "${w}x$h"
2483 }
2484 }
2485
2486 if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487 wm state . $geometry(state)
2488 }
2489
2490 if {[tk windowingsystem] eq {aqua}} {
2491 set M1B M1
2492 set ::BM "3"
2493 } else {
2494 set M1B Control
2495 set ::BM "2"
2496 }
2497
2498 if {$use_ttk} {
2499 bind .ctop <Map> {
2500 bind %W <Map> {}
2501 %W sashpos 0 $::geometry(topheight)
2502 }
2503 bind .pwbottom <Map> {
2504 bind %W <Map> {}
2505 %W sashpos 0 $::geometry(botwidth)
2506 }
2507 }
2508
2509 bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510 pack .ctop -fill both -expand 1
2511 bindall <1> {selcanvline %W %x %y}
2512 #bindall <B1-Motion> {selcanvline %W %x %y}
2513 if {[tk windowingsystem] == "win32"} {
2514 bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515 bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516 } else {
2517 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2519 bind $ctext <Button> {
2520 if {"%b" eq 6} {
2521 $ctext xview scroll -5 units
2522 } elseif {"%b" eq 7} {
2523 $ctext xview scroll 5 units
2524 }
2525 }
2526 if {[tk windowingsystem] eq "aqua"} {
2527 bindall <MouseWheel> {
2528 set delta [expr {- (%D)}]
2529 allcanvs yview scroll $delta units
2530 }
2531 bindall <Shift-MouseWheel> {
2532 set delta [expr {- (%D)}]
2533 $canv xview scroll $delta units
2534 }
2535 }
2536 }
2537 bindall <$::BM> "canvscan mark %W %x %y"
2538 bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2539 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2540 bind . <$M1B-Key-w> doquit
2541 bindkey <Home> selfirstline
2542 bindkey <End> sellastline
2543 bind . <Key-Up> "selnextline -1"
2544 bind . <Key-Down> "selnextline 1"
2545 bind . <Shift-Key-Up> "dofind -1 0"
2546 bind . <Shift-Key-Down> "dofind 1 0"
2547 bindkey <Key-Right> "goforw"
2548 bindkey <Key-Left> "goback"
2549 bind . <Key-Prior> "selnextpage -1"
2550 bind . <Key-Next> "selnextpage 1"
2551 bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2552 bind . <$M1B-End> "allcanvs yview moveto 1.0"
2553 bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2554 bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2555 bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2556 bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2557 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2558 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2559 bindkey <Key-space> "$ctext yview scroll 1 pages"
2560 bindkey p "selnextline -1"
2561 bindkey n "selnextline 1"
2562 bindkey z "goback"
2563 bindkey x "goforw"
2564 bindkey k "selnextline -1"
2565 bindkey j "selnextline 1"
2566 bindkey h "goback"
2567 bindkey l "goforw"
2568 bindkey b prevfile
2569 bindkey d "$ctext yview scroll 18 units"
2570 bindkey u "$ctext yview scroll -18 units"
2571 bindkey / {focus $fstring}
2572 bindkey <Key-KP_Divide> {focus $fstring}
2573 bindkey <Key-Return> {dofind 1 1}
2574 bindkey ? {dofind -1 1}
2575 bindkey f nextfile
2576 bind . <F5> updatecommits
2577 bindmodfunctionkey Shift 5 reloadcommits
2578 bind . <F2> showrefs
2579 bindmodfunctionkey Shift 4 {newview 0}
2580 bind . <F4> edit_or_newview
2581 bind . <$M1B-q> doquit
2582 bind . <$M1B-f> {dofind 1 1}
2583 bind . <$M1B-g> {dofind 1 0}
2584 bind . <$M1B-r> dosearchback
2585 bind . <$M1B-s> dosearch
2586 bind . <$M1B-equal> {incrfont 1}
2587 bind . <$M1B-plus> {incrfont 1}
2588 bind . <$M1B-KP_Add> {incrfont 1}
2589 bind . <$M1B-minus> {incrfont -1}
2590 bind . <$M1B-KP_Subtract> {incrfont -1}
2591 wm protocol . WM_DELETE_WINDOW doquit
2592 bind . <Destroy> {stop_backends}
2593 bind . <Button-1> "click %W"
2594 bind $fstring <Key-Return> {dofind 1 1}
2595 bind $sha1entry <Key-Return> {gotocommit; break}
2596 bind $sha1entry <<PasteSelection>> clearsha1
2597 bind $sha1entry <<Paste>> clearsha1
2598 bind $cflist <1> {sel_flist %W %x %y; break}
2599 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2600 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2601 global ctxbut
2602 bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2603 bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2604 bind $ctext <Button-1> {focus %W}
2605 bind $ctext <<Selection>> rehighlight_search_results
2606 for {set i 1} {$i < 10} {incr i} {
2607 bind . <$M1B-Key-$i> [list go_to_parent $i]
2608 }
2609
2610 set maincursor [. cget -cursor]
2611 set textcursor [$ctext cget -cursor]
2612 set curtextcursor $textcursor
2613
2614 set rowctxmenu .rowctxmenu
2615 makemenu $rowctxmenu {
2616 {mc "Diff this -> selected" command {diffvssel 0}}
2617 {mc "Diff selected -> this" command {diffvssel 1}}
2618 {mc "Make patch" command mkpatch}
2619 {mc "Create tag" command mktag}
2620 {mc "Write commit to file" command writecommit}
2621 {mc "Create new branch" command mkbranch}
2622 {mc "Cherry-pick this commit" command cherrypick}
2623 {mc "Reset HEAD branch to here" command resethead}
2624 {mc "Mark this commit" command markhere}
2625 {mc "Return to mark" command gotomark}
2626 {mc "Find descendant of this and mark" command find_common_desc}
2627 {mc "Compare with marked commit" command compare_commits}
2628 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2629 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2630 {mc "Revert this commit" command revert}
2631 }
2632 $rowctxmenu configure -tearoff 0
2633
2634 set fakerowmenu .fakerowmenu
2635 makemenu $fakerowmenu {
2636 {mc "Diff this -> selected" command {diffvssel 0}}
2637 {mc "Diff selected -> this" command {diffvssel 1}}
2638 {mc "Make patch" command mkpatch}
2639 {mc "Diff this -> marked commit" command {diffvsmark 0}}
2640 {mc "Diff marked commit -> this" command {diffvsmark 1}}
2641 }
2642 $fakerowmenu configure -tearoff 0
2643
2644 set headctxmenu .headctxmenu
2645 makemenu $headctxmenu {
2646 {mc "Check out this branch" command cobranch}
2647 {mc "Remove this branch" command rmbranch}
2648 }
2649 $headctxmenu configure -tearoff 0
2650
2651 global flist_menu
2652 set flist_menu .flistctxmenu
2653 makemenu $flist_menu {
2654 {mc "Highlight this too" command {flist_hl 0}}
2655 {mc "Highlight this only" command {flist_hl 1}}
2656 {mc "External diff" command {external_diff}}
2657 {mc "Blame parent commit" command {external_blame 1}}
2658 }
2659 $flist_menu configure -tearoff 0
2660
2661 global diff_menu
2662 set diff_menu .diffctxmenu
2663 makemenu $diff_menu {
2664 {mc "Show origin of this line" command show_line_source}
2665 {mc "Run git gui blame on this line" command {external_blame_diff}}
2666 }
2667 $diff_menu configure -tearoff 0
2668}
2669
2670# Windows sends all mouse wheel events to the current focused window, not
2671# the one where the mouse hovers, so bind those events here and redirect
2672# to the correct window
2673proc windows_mousewheel_redirector {W X Y D} {
2674 global canv canv2 canv3
2675 set w [winfo containing -displayof $W $X $Y]
2676 if {$w ne ""} {
2677 set u [expr {$D < 0 ? 5 : -5}]
2678 if {$w == $canv || $w == $canv2 || $w == $canv3} {
2679 allcanvs yview scroll $u units
2680 } else {
2681 catch {
2682 $w yview scroll $u units
2683 }
2684 }
2685 }
2686}
2687
2688# Update row number label when selectedline changes
2689proc selectedline_change {n1 n2 op} {
2690 global selectedline rownumsel
2691
2692 if {$selectedline eq {}} {
2693 set rownumsel {}
2694 } else {
2695 set rownumsel [expr {$selectedline + 1}]
2696 }
2697}
2698
2699# mouse-2 makes all windows scan vertically, but only the one
2700# the cursor is in scans horizontally
2701proc canvscan {op w x y} {
2702 global canv canv2 canv3
2703 foreach c [list $canv $canv2 $canv3] {
2704 if {$c == $w} {
2705 $c scan $op $x $y
2706 } else {
2707 $c scan $op 0 $y
2708 }
2709 }
2710}
2711
2712proc scrollcanv {cscroll f0 f1} {
2713 $cscroll set $f0 $f1
2714 drawvisible
2715 flushhighlights
2716}
2717
2718# when we make a key binding for the toplevel, make sure
2719# it doesn't get triggered when that key is pressed in the
2720# find string entry widget.
2721proc bindkey {ev script} {
2722 global entries
2723 bind . $ev $script
2724 set escript [bind Entry $ev]
2725 if {$escript == {}} {
2726 set escript [bind Entry <Key>]
2727 }
2728 foreach e $entries {
2729 bind $e $ev "$escript; break"
2730 }
2731}
2732
2733proc bindmodfunctionkey {mod n script} {
2734 bind . <$mod-F$n> $script
2735 catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2736}
2737
2738# set the focus back to the toplevel for any click outside
2739# the entry widgets
2740proc click {w} {
2741 global ctext entries
2742 foreach e [concat $entries $ctext] {
2743 if {$w == $e} return
2744 }
2745 focus .
2746}
2747
2748# Adjust the progress bar for a change in requested extent or canvas size
2749proc adjustprogress {} {
2750 global progresscanv progressitem progresscoords
2751 global fprogitem fprogcoord lastprogupdate progupdatepending
2752 global rprogitem rprogcoord use_ttk
2753
2754 if {$use_ttk} {
2755 $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2756 return
2757 }
2758
2759 set w [expr {[winfo width $progresscanv] - 4}]
2760 set x0 [expr {$w * [lindex $progresscoords 0]}]
2761 set x1 [expr {$w * [lindex $progresscoords 1]}]
2762 set h [winfo height $progresscanv]
2763 $progresscanv coords $progressitem $x0 0 $x1 $h
2764 $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2765 $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2766 set now [clock clicks -milliseconds]
2767 if {$now >= $lastprogupdate + 100} {
2768 set progupdatepending 0
2769 update
2770 } elseif {!$progupdatepending} {
2771 set progupdatepending 1
2772 after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2773 }
2774}
2775
2776proc doprogupdate {} {
2777 global lastprogupdate progupdatepending
2778
2779 if {$progupdatepending} {
2780 set progupdatepending 0
2781 set lastprogupdate [clock clicks -milliseconds]
2782 update
2783 }
2784}
2785
2786proc savestuff {w} {
2787 global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2788 global use_ttk
2789 global stuffsaved
2790 global config_file config_file_tmp
2791 global config_variables
2792
2793 if {$stuffsaved} return
2794 if {![winfo viewable .]} return
2795 catch {
2796 if {[file exists $config_file_tmp]} {
2797 file delete -force $config_file_tmp
2798 }
2799 set f [open $config_file_tmp w]
2800 if {$::tcl_platform(platform) eq {windows}} {
2801 file attributes $config_file_tmp -hidden true
2802 }
2803 foreach var_name $config_variables {
2804 upvar #0 $var_name var
2805 puts $f [list set $var_name $var]
2806 }
2807
2808 puts $f "set geometry(main) [wm geometry .]"
2809 puts $f "set geometry(state) [wm state .]"
2810 puts $f "set geometry(topwidth) [winfo width .tf]"
2811 puts $f "set geometry(topheight) [winfo height .tf]"
2812 if {$use_ttk} {
2813 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2814 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2815 } else {
2816 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2817 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2818 }
2819 puts $f "set geometry(botwidth) [winfo width .bleft]"
2820 puts $f "set geometry(botheight) [winfo height .bleft]"
2821
2822 puts -nonewline $f "set permviews {"
2823 for {set v 0} {$v < $nextviewnum} {incr v} {
2824 if {$viewperm($v)} {
2825 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2826 }
2827 }
2828 puts $f "}"
2829 close $f
2830 file rename -force $config_file_tmp $config_file
2831 }
2832 set stuffsaved 1
2833}
2834
2835proc resizeclistpanes {win w} {
2836 global oldwidth use_ttk
2837 if {[info exists oldwidth($win)]} {
2838 if {$use_ttk} {
2839 set s0 [$win sashpos 0]
2840 set s1 [$win sashpos 1]
2841 } else {
2842 set s0 [$win sash coord 0]
2843 set s1 [$win sash coord 1]
2844 }
2845 if {$w < 60} {
2846 set sash0 [expr {int($w/2 - 2)}]
2847 set sash1 [expr {int($w*5/6 - 2)}]
2848 } else {
2849 set factor [expr {1.0 * $w / $oldwidth($win)}]
2850 set sash0 [expr {int($factor * [lindex $s0 0])}]
2851 set sash1 [expr {int($factor * [lindex $s1 0])}]
2852 if {$sash0 < 30} {
2853 set sash0 30
2854 }
2855 if {$sash1 < $sash0 + 20} {
2856 set sash1 [expr {$sash0 + 20}]
2857 }
2858 if {$sash1 > $w - 10} {
2859 set sash1 [expr {$w - 10}]
2860 if {$sash0 > $sash1 - 20} {
2861 set sash0 [expr {$sash1 - 20}]
2862 }
2863 }
2864 }
2865 if {$use_ttk} {
2866 $win sashpos 0 $sash0
2867 $win sashpos 1 $sash1
2868 } else {
2869 $win sash place 0 $sash0 [lindex $s0 1]
2870 $win sash place 1 $sash1 [lindex $s1 1]
2871 }
2872 }
2873 set oldwidth($win) $w
2874}
2875
2876proc resizecdetpanes {win w} {
2877 global oldwidth use_ttk
2878 if {[info exists oldwidth($win)]} {
2879 if {$use_ttk} {
2880 set s0 [$win sashpos 0]
2881 } else {
2882 set s0 [$win sash coord 0]
2883 }
2884 if {$w < 60} {
2885 set sash0 [expr {int($w*3/4 - 2)}]
2886 } else {
2887 set factor [expr {1.0 * $w / $oldwidth($win)}]
2888 set sash0 [expr {int($factor * [lindex $s0 0])}]
2889 if {$sash0 < 45} {
2890 set sash0 45
2891 }
2892 if {$sash0 > $w - 15} {
2893 set sash0 [expr {$w - 15}]
2894 }
2895 }
2896 if {$use_ttk} {
2897 $win sashpos 0 $sash0
2898 } else {
2899 $win sash place 0 $sash0 [lindex $s0 1]
2900 }
2901 }
2902 set oldwidth($win) $w
2903}
2904
2905proc allcanvs args {
2906 global canv canv2 canv3
2907 eval $canv $args
2908 eval $canv2 $args
2909 eval $canv3 $args
2910}
2911
2912proc bindall {event action} {
2913 global canv canv2 canv3
2914 bind $canv $event $action
2915 bind $canv2 $event $action
2916 bind $canv3 $event $action
2917}
2918
2919proc about {} {
2920 global uifont NS
2921 set w .about
2922 if {[winfo exists $w]} {
2923 raise $w
2924 return
2925 }
2926 ttk_toplevel $w
2927 wm title $w [mc "About gitk"]
2928 make_transient $w .
2929 message $w.m -text [mc "
2930Gitk - a commit viewer for git
2931
2932Copyright \u00a9 2005-2014 Paul Mackerras
2933
2934Use and redistribute under the terms of the GNU General Public License"] \
2935 -justify center -aspect 400 -border 2 -bg white -relief groove
2936 pack $w.m -side top -fill x -padx 2 -pady 2
2937 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2938 pack $w.ok -side bottom
2939 bind $w <Visibility> "focus $w.ok"
2940 bind $w <Key-Escape> "destroy $w"
2941 bind $w <Key-Return> "destroy $w"
2942 tk::PlaceWindow $w widget .
2943}
2944
2945proc keys {} {
2946 global NS
2947 set w .keys
2948 if {[winfo exists $w]} {
2949 raise $w
2950 return
2951 }
2952 if {[tk windowingsystem] eq {aqua}} {
2953 set M1T Cmd
2954 } else {
2955 set M1T Ctrl
2956 }
2957 ttk_toplevel $w
2958 wm title $w [mc "Gitk key bindings"]
2959 make_transient $w .
2960 message $w.m -text "
2961[mc "Gitk key bindings:"]
2962
2963[mc "<%s-Q> Quit" $M1T]
2964[mc "<%s-W> Close window" $M1T]
2965[mc "<Home> Move to first commit"]
2966[mc "<End> Move to last commit"]
2967[mc "<Up>, p, k Move up one commit"]
2968[mc "<Down>, n, j Move down one commit"]
2969[mc "<Left>, z, h Go back in history list"]
2970[mc "<Right>, x, l Go forward in history list"]
2971[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
2972[mc "<PageUp> Move up one page in commit list"]
2973[mc "<PageDown> Move down one page in commit list"]
2974[mc "<%s-Home> Scroll to top of commit list" $M1T]
2975[mc "<%s-End> Scroll to bottom of commit list" $M1T]
2976[mc "<%s-Up> Scroll commit list up one line" $M1T]
2977[mc "<%s-Down> Scroll commit list down one line" $M1T]
2978[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
2979[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
2980[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2981[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
2982[mc "<Delete>, b Scroll diff view up one page"]
2983[mc "<Backspace> Scroll diff view up one page"]
2984[mc "<Space> Scroll diff view down one page"]
2985[mc "u Scroll diff view up 18 lines"]
2986[mc "d Scroll diff view down 18 lines"]
2987[mc "<%s-F> Find" $M1T]
2988[mc "<%s-G> Move to next find hit" $M1T]
2989[mc "<Return> Move to next find hit"]
2990[mc "/ Focus the search box"]
2991[mc "? Move to previous find hit"]
2992[mc "f Scroll diff view to next file"]
2993[mc "<%s-S> Search for next hit in diff view" $M1T]
2994[mc "<%s-R> Search for previous hit in diff view" $M1T]
2995[mc "<%s-KP+> Increase font size" $M1T]
2996[mc "<%s-plus> Increase font size" $M1T]
2997[mc "<%s-KP-> Decrease font size" $M1T]
2998[mc "<%s-minus> Decrease font size" $M1T]
2999[mc "<F5> Update"]
3000" \
3001 -justify left -bg white -border 2 -relief groove
3002 pack $w.m -side top -fill both -padx 2 -pady 2
3003 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3004 bind $w <Key-Escape> [list destroy $w]
3005 pack $w.ok -side bottom
3006 bind $w <Visibility> "focus $w.ok"
3007 bind $w <Key-Escape> "destroy $w"
3008 bind $w <Key-Return> "destroy $w"
3009}
3010
3011# Procedures for manipulating the file list window at the
3012# bottom right of the overall window.
3013
3014proc treeview {w l openlevs} {
3015 global treecontents treediropen treeheight treeparent treeindex
3016
3017 set ix 0
3018 set treeindex() 0
3019 set lev 0
3020 set prefix {}
3021 set prefixend -1
3022 set prefendstack {}
3023 set htstack {}
3024 set ht 0
3025 set treecontents() {}
3026 $w conf -state normal
3027 foreach f $l {
3028 while {[string range $f 0 $prefixend] ne $prefix} {
3029 if {$lev <= $openlevs} {
3030 $w mark set e:$treeindex($prefix) "end -1c"
3031 $w mark gravity e:$treeindex($prefix) left
3032 }
3033 set treeheight($prefix) $ht
3034 incr ht [lindex $htstack end]
3035 set htstack [lreplace $htstack end end]
3036 set prefixend [lindex $prefendstack end]
3037 set prefendstack [lreplace $prefendstack end end]
3038 set prefix [string range $prefix 0 $prefixend]
3039 incr lev -1
3040 }
3041 set tail [string range $f [expr {$prefixend+1}] end]
3042 while {[set slash [string first "/" $tail]] >= 0} {
3043 lappend htstack $ht
3044 set ht 0
3045 lappend prefendstack $prefixend
3046 incr prefixend [expr {$slash + 1}]
3047 set d [string range $tail 0 $slash]
3048 lappend treecontents($prefix) $d
3049 set oldprefix $prefix
3050 append prefix $d
3051 set treecontents($prefix) {}
3052 set treeindex($prefix) [incr ix]
3053 set treeparent($prefix) $oldprefix
3054 set tail [string range $tail [expr {$slash+1}] end]
3055 if {$lev <= $openlevs} {
3056 set ht 1
3057 set treediropen($prefix) [expr {$lev < $openlevs}]
3058 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3059 $w mark set d:$ix "end -1c"
3060 $w mark gravity d:$ix left
3061 set str "\n"
3062 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3063 $w insert end $str
3064 $w image create end -align center -image $bm -padx 1 \
3065 -name a:$ix
3066 $w insert end $d [highlight_tag $prefix]
3067 $w mark set s:$ix "end -1c"
3068 $w mark gravity s:$ix left
3069 }
3070 incr lev
3071 }
3072 if {$tail ne {}} {
3073 if {$lev <= $openlevs} {
3074 incr ht
3075 set str "\n"
3076 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3077 $w insert end $str
3078 $w insert end $tail [highlight_tag $f]
3079 }
3080 lappend treecontents($prefix) $tail
3081 }
3082 }
3083 while {$htstack ne {}} {
3084 set treeheight($prefix) $ht
3085 incr ht [lindex $htstack end]
3086 set htstack [lreplace $htstack end end]
3087 set prefixend [lindex $prefendstack end]
3088 set prefendstack [lreplace $prefendstack end end]
3089 set prefix [string range $prefix 0 $prefixend]
3090 }
3091 $w conf -state disabled
3092}
3093
3094proc linetoelt {l} {
3095 global treeheight treecontents
3096
3097 set y 2
3098 set prefix {}
3099 while {1} {
3100 foreach e $treecontents($prefix) {
3101 if {$y == $l} {
3102 return "$prefix$e"
3103 }
3104 set n 1
3105 if {[string index $e end] eq "/"} {
3106 set n $treeheight($prefix$e)
3107 if {$y + $n > $l} {
3108 append prefix $e
3109 incr y
3110 break
3111 }
3112 }
3113 incr y $n
3114 }
3115 }
3116}
3117
3118proc highlight_tree {y prefix} {
3119 global treeheight treecontents cflist
3120
3121 foreach e $treecontents($prefix) {
3122 set path $prefix$e
3123 if {[highlight_tag $path] ne {}} {
3124 $cflist tag add bold $y.0 "$y.0 lineend"
3125 }
3126 incr y
3127 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3128 set y [highlight_tree $y $path]
3129 }
3130 }
3131 return $y
3132}
3133
3134proc treeclosedir {w dir} {
3135 global treediropen treeheight treeparent treeindex
3136
3137 set ix $treeindex($dir)
3138 $w conf -state normal
3139 $w delete s:$ix e:$ix
3140 set treediropen($dir) 0
3141 $w image configure a:$ix -image tri-rt
3142 $w conf -state disabled
3143 set n [expr {1 - $treeheight($dir)}]
3144 while {$dir ne {}} {
3145 incr treeheight($dir) $n
3146 set dir $treeparent($dir)
3147 }
3148}
3149
3150proc treeopendir {w dir} {
3151 global treediropen treeheight treeparent treecontents treeindex
3152
3153 set ix $treeindex($dir)
3154 $w conf -state normal
3155 $w image configure a:$ix -image tri-dn
3156 $w mark set e:$ix s:$ix
3157 $w mark gravity e:$ix right
3158 set lev 0
3159 set str "\n"
3160 set n [llength $treecontents($dir)]
3161 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3162 incr lev
3163 append str "\t"
3164 incr treeheight($x) $n
3165 }
3166 foreach e $treecontents($dir) {
3167 set de $dir$e
3168 if {[string index $e end] eq "/"} {
3169 set iy $treeindex($de)
3170 $w mark set d:$iy e:$ix
3171 $w mark gravity d:$iy left
3172 $w insert e:$ix $str
3173 set treediropen($de) 0
3174 $w image create e:$ix -align center -image tri-rt -padx 1 \
3175 -name a:$iy
3176 $w insert e:$ix $e [highlight_tag $de]
3177 $w mark set s:$iy e:$ix
3178 $w mark gravity s:$iy left
3179 set treeheight($de) 1
3180 } else {
3181 $w insert e:$ix $str
3182 $w insert e:$ix $e [highlight_tag $de]
3183 }
3184 }
3185 $w mark gravity e:$ix right
3186 $w conf -state disabled
3187 set treediropen($dir) 1
3188 set top [lindex [split [$w index @0,0] .] 0]
3189 set ht [$w cget -height]
3190 set l [lindex [split [$w index s:$ix] .] 0]
3191 if {$l < $top} {
3192 $w yview $l.0
3193 } elseif {$l + $n + 1 > $top + $ht} {
3194 set top [expr {$l + $n + 2 - $ht}]
3195 if {$l < $top} {
3196 set top $l
3197 }
3198 $w yview $top.0
3199 }
3200}
3201
3202proc treeclick {w x y} {
3203 global treediropen cmitmode ctext cflist cflist_top
3204
3205 if {$cmitmode ne "tree"} return
3206 if {![info exists cflist_top]} return
3207 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3208 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3209 $cflist tag add highlight $l.0 "$l.0 lineend"
3210 set cflist_top $l
3211 if {$l == 1} {
3212 $ctext yview 1.0
3213 return
3214 }
3215 set e [linetoelt $l]
3216 if {[string index $e end] ne "/"} {
3217 showfile $e
3218 } elseif {$treediropen($e)} {
3219 treeclosedir $w $e
3220 } else {
3221 treeopendir $w $e
3222 }
3223}
3224
3225proc setfilelist {id} {
3226 global treefilelist cflist jump_to_here
3227
3228 treeview $cflist $treefilelist($id) 0
3229 if {$jump_to_here ne {}} {
3230 set f [lindex $jump_to_here 0]
3231 if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3232 showfile $f
3233 }
3234 }
3235}
3236
3237image create bitmap tri-rt -background black -foreground blue -data {
3238 #define tri-rt_width 13
3239 #define tri-rt_height 13
3240 static unsigned char tri-rt_bits[] = {
3241 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3242 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3243 0x00, 0x00};
3244} -maskdata {
3245 #define tri-rt-mask_width 13
3246 #define tri-rt-mask_height 13
3247 static unsigned char tri-rt-mask_bits[] = {
3248 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3249 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3250 0x08, 0x00};
3251}
3252image create bitmap tri-dn -background black -foreground blue -data {
3253 #define tri-dn_width 13
3254 #define tri-dn_height 13
3255 static unsigned char tri-dn_bits[] = {
3256 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3257 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3258 0x00, 0x00};
3259} -maskdata {
3260 #define tri-dn-mask_width 13
3261 #define tri-dn-mask_height 13
3262 static unsigned char tri-dn-mask_bits[] = {
3263 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3264 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3265 0x00, 0x00};
3266}
3267
3268image create bitmap reficon-T -background black -foreground yellow -data {
3269 #define tagicon_width 13
3270 #define tagicon_height 9
3271 static unsigned char tagicon_bits[] = {
3272 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3273 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3274} -maskdata {
3275 #define tagicon-mask_width 13
3276 #define tagicon-mask_height 9
3277 static unsigned char tagicon-mask_bits[] = {
3278 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3279 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3280}
3281set rectdata {
3282 #define headicon_width 13
3283 #define headicon_height 9
3284 static unsigned char headicon_bits[] = {
3285 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3286 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3287}
3288set rectmask {
3289 #define headicon-mask_width 13
3290 #define headicon-mask_height 9
3291 static unsigned char headicon-mask_bits[] = {
3292 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3293 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3294}
3295image create bitmap reficon-H -background black -foreground green \
3296 -data $rectdata -maskdata $rectmask
3297image create bitmap reficon-o -background black -foreground "#ddddff" \
3298 -data $rectdata -maskdata $rectmask
3299
3300proc init_flist {first} {
3301 global cflist cflist_top difffilestart
3302
3303 $cflist conf -state normal
3304 $cflist delete 0.0 end
3305 if {$first ne {}} {
3306 $cflist insert end $first
3307 set cflist_top 1
3308 $cflist tag add highlight 1.0 "1.0 lineend"
3309 } else {
3310 catch {unset cflist_top}
3311 }
3312 $cflist conf -state disabled
3313 set difffilestart {}
3314}
3315
3316proc highlight_tag {f} {
3317 global highlight_paths
3318
3319 foreach p $highlight_paths {
3320 if {[string match $p $f]} {
3321 return "bold"
3322 }
3323 }
3324 return {}
3325}
3326
3327proc highlight_filelist {} {
3328 global cmitmode cflist
3329
3330 $cflist conf -state normal
3331 if {$cmitmode ne "tree"} {
3332 set end [lindex [split [$cflist index end] .] 0]
3333 for {set l 2} {$l < $end} {incr l} {
3334 set line [$cflist get $l.0 "$l.0 lineend"]
3335 if {[highlight_tag $line] ne {}} {
3336 $cflist tag add bold $l.0 "$l.0 lineend"
3337 }
3338 }
3339 } else {
3340 highlight_tree 2 {}
3341 }
3342 $cflist conf -state disabled
3343}
3344
3345proc unhighlight_filelist {} {
3346 global cflist
3347
3348 $cflist conf -state normal
3349 $cflist tag remove bold 1.0 end
3350 $cflist conf -state disabled
3351}
3352
3353proc add_flist {fl} {
3354 global cflist
3355
3356 $cflist conf -state normal
3357 foreach f $fl {
3358 $cflist insert end "\n"
3359 $cflist insert end $f [highlight_tag $f]
3360 }
3361 $cflist conf -state disabled
3362}
3363
3364proc sel_flist {w x y} {
3365 global ctext difffilestart cflist cflist_top cmitmode
3366
3367 if {$cmitmode eq "tree"} return
3368 if {![info exists cflist_top]} return
3369 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3370 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3371 $cflist tag add highlight $l.0 "$l.0 lineend"
3372 set cflist_top $l
3373 if {$l == 1} {
3374 $ctext yview 1.0
3375 } else {
3376 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3377 }
3378 suppress_highlighting_file_for_current_scrollpos
3379}
3380
3381proc pop_flist_menu {w X Y x y} {
3382 global ctext cflist cmitmode flist_menu flist_menu_file
3383 global treediffs diffids
3384
3385 stopfinding
3386 set l [lindex [split [$w index "@$x,$y"] "."] 0]
3387 if {$l <= 1} return
3388 if {$cmitmode eq "tree"} {
3389 set e [linetoelt $l]
3390 if {[string index $e end] eq "/"} return
3391 } else {
3392 set e [lindex $treediffs($diffids) [expr {$l-2}]]
3393 }
3394 set flist_menu_file $e
3395 set xdiffstate "normal"
3396 if {$cmitmode eq "tree"} {
3397 set xdiffstate "disabled"
3398 }
3399 # Disable "External diff" item in tree mode
3400 $flist_menu entryconf 2 -state $xdiffstate
3401 tk_popup $flist_menu $X $Y
3402}
3403
3404proc find_ctext_fileinfo {line} {
3405 global ctext_file_names ctext_file_lines
3406
3407 set ok [bsearch $ctext_file_lines $line]
3408 set tline [lindex $ctext_file_lines $ok]
3409
3410 if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3411 return {}
3412 } else {
3413 return [list [lindex $ctext_file_names $ok] $tline]
3414 }
3415}
3416
3417proc pop_diff_menu {w X Y x y} {
3418 global ctext diff_menu flist_menu_file
3419 global diff_menu_txtpos diff_menu_line
3420 global diff_menu_filebase
3421
3422 set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3423 set diff_menu_line [lindex $diff_menu_txtpos 0]
3424 # don't pop up the menu on hunk-separator or file-separator lines
3425 if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3426 return
3427 }
3428 stopfinding
3429 set f [find_ctext_fileinfo $diff_menu_line]
3430 if {$f eq {}} return
3431 set flist_menu_file [lindex $f 0]
3432 set diff_menu_filebase [lindex $f 1]
3433 tk_popup $diff_menu $X $Y
3434}
3435
3436proc flist_hl {only} {
3437 global flist_menu_file findstring gdttype
3438
3439 set x [shellquote $flist_menu_file]
3440 if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3441 set findstring $x
3442 } else {
3443 append findstring " " $x
3444 }
3445 set gdttype [mc "touching paths:"]
3446}
3447
3448proc gitknewtmpdir {} {
3449 global diffnum gitktmpdir gitdir env
3450
3451 if {![info exists gitktmpdir]} {
3452 if {[info exists env(GITK_TMPDIR)]} {
3453 set tmpdir $env(GITK_TMPDIR)
3454 } elseif {[info exists env(TMPDIR)]} {
3455 set tmpdir $env(TMPDIR)
3456 } else {
3457 set tmpdir $gitdir
3458 }
3459 set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3460 if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3461 set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3462 }
3463 if {[catch {file mkdir $gitktmpdir} err]} {
3464 error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3465 unset gitktmpdir
3466 return {}
3467 }
3468 set diffnum 0
3469 }
3470 incr diffnum
3471 set diffdir [file join $gitktmpdir $diffnum]
3472 if {[catch {file mkdir $diffdir} err]} {
3473 error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3474 return {}
3475 }
3476 return $diffdir
3477}
3478
3479proc save_file_from_commit {filename output what} {
3480 global nullfile
3481
3482 if {[catch {exec git show $filename -- > $output} err]} {
3483 if {[string match "fatal: bad revision *" $err]} {
3484 return $nullfile
3485 }
3486 error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3487 return {}
3488 }
3489 return $output
3490}
3491
3492proc external_diff_get_one_file {diffid filename diffdir} {
3493 global nullid nullid2 nullfile
3494 global worktree
3495
3496 if {$diffid == $nullid} {
3497 set difffile [file join $worktree $filename]
3498 if {[file exists $difffile]} {
3499 return $difffile
3500 }
3501 return $nullfile
3502 }
3503 if {$diffid == $nullid2} {
3504 set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3505 return [save_file_from_commit :$filename $difffile index]
3506 }
3507 set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3508 return [save_file_from_commit $diffid:$filename $difffile \
3509 "revision $diffid"]
3510}
3511
3512proc external_diff {} {
3513 global nullid nullid2
3514 global flist_menu_file
3515 global diffids
3516 global extdifftool
3517
3518 if {[llength $diffids] == 1} {
3519 # no reference commit given
3520 set diffidto [lindex $diffids 0]
3521 if {$diffidto eq $nullid} {
3522 # diffing working copy with index
3523 set diffidfrom $nullid2
3524 } elseif {$diffidto eq $nullid2} {
3525 # diffing index with HEAD
3526 set diffidfrom "HEAD"
3527 } else {
3528 # use first parent commit
3529 global parentlist selectedline
3530 set diffidfrom [lindex $parentlist $selectedline 0]
3531 }
3532 } else {
3533 set diffidfrom [lindex $diffids 0]
3534 set diffidto [lindex $diffids 1]
3535 }
3536
3537 # make sure that several diffs wont collide
3538 set diffdir [gitknewtmpdir]
3539 if {$diffdir eq {}} return
3540
3541 # gather files to diff
3542 set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3543 set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3544
3545 if {$difffromfile ne {} && $difftofile ne {}} {
3546 set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3547 if {[catch {set fl [open |$cmd r]} err]} {
3548 file delete -force $diffdir
3549 error_popup "$extdifftool: [mc "command failed:"] $err"
3550 } else {
3551 fconfigure $fl -blocking 0
3552 filerun $fl [list delete_at_eof $fl $diffdir]
3553 }
3554 }
3555}
3556
3557proc find_hunk_blamespec {base line} {
3558 global ctext
3559
3560 # Find and parse the hunk header
3561 set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3562 if {$s_lix eq {}} return
3563
3564 set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3565 if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3566 s_line old_specs osz osz1 new_line nsz]} {
3567 return
3568 }
3569
3570 # base lines for the parents
3571 set base_lines [list $new_line]
3572 foreach old_spec [lrange [split $old_specs " "] 1 end] {
3573 if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3574 old_spec old_line osz]} {
3575 return
3576 }
3577 lappend base_lines $old_line
3578 }
3579
3580 # Now scan the lines to determine offset within the hunk
3581 set max_parent [expr {[llength $base_lines]-2}]
3582 set dline 0
3583 set s_lno [lindex [split $s_lix "."] 0]
3584
3585 # Determine if the line is removed
3586 set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3587 if {[string match {[-+ ]*} $chunk]} {
3588 set removed_idx [string first "-" $chunk]
3589 # Choose a parent index
3590 if {$removed_idx >= 0} {
3591 set parent $removed_idx
3592 } else {
3593 set unchanged_idx [string first " " $chunk]
3594 if {$unchanged_idx >= 0} {
3595 set parent $unchanged_idx
3596 } else {
3597 # blame the current commit
3598 set parent -1
3599 }
3600 }
3601 # then count other lines that belong to it
3602 for {set i $line} {[incr i -1] > $s_lno} {} {
3603 set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3604 # Determine if the line is removed
3605 set removed_idx [string first "-" $chunk]
3606 if {$parent >= 0} {
3607 set code [string index $chunk $parent]
3608 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3609 incr dline
3610 }
3611 } else {
3612 if {$removed_idx < 0} {
3613 incr dline
3614 }
3615 }
3616 }
3617 incr parent
3618 } else {
3619 set parent 0
3620 }
3621
3622 incr dline [lindex $base_lines $parent]
3623 return [list $parent $dline]
3624}
3625
3626proc external_blame_diff {} {
3627 global currentid cmitmode
3628 global diff_menu_txtpos diff_menu_line
3629 global diff_menu_filebase flist_menu_file
3630
3631 if {$cmitmode eq "tree"} {
3632 set parent_idx 0
3633 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3634 } else {
3635 set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3636 if {$hinfo ne {}} {
3637 set parent_idx [lindex $hinfo 0]
3638 set line [lindex $hinfo 1]
3639 } else {
3640 set parent_idx 0
3641 set line 0
3642 }
3643 }
3644
3645 external_blame $parent_idx $line
3646}
3647
3648# Find the SHA1 ID of the blob for file $fname in the index
3649# at stage 0 or 2
3650proc index_sha1 {fname} {
3651 set f [open [list | git ls-files -s $fname] r]
3652 while {[gets $f line] >= 0} {
3653 set info [lindex [split $line "\t"] 0]
3654 set stage [lindex $info 2]
3655 if {$stage eq "0" || $stage eq "2"} {
3656 close $f
3657 return [lindex $info 1]
3658 }
3659 }
3660 close $f
3661 return {}
3662}
3663
3664# Turn an absolute path into one relative to the current directory
3665proc make_relative {f} {
3666 if {[file pathtype $f] eq "relative"} {
3667 return $f
3668 }
3669 set elts [file split $f]
3670 set here [file split [pwd]]
3671 set ei 0
3672 set hi 0
3673 set res {}
3674 foreach d $here {
3675 if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3676 lappend res ".."
3677 } else {
3678 incr ei
3679 }
3680 incr hi
3681 }
3682 set elts [concat $res [lrange $elts $ei end]]
3683 return [eval file join $elts]
3684}
3685
3686proc external_blame {parent_idx {line {}}} {
3687 global flist_menu_file cdup
3688 global nullid nullid2
3689 global parentlist selectedline currentid
3690
3691 if {$parent_idx > 0} {
3692 set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3693 } else {
3694 set base_commit $currentid
3695 }
3696
3697 if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3698 error_popup [mc "No such commit"]
3699 return
3700 }
3701
3702 set cmdline [list git gui blame]
3703 if {$line ne {} && $line > 1} {
3704 lappend cmdline "--line=$line"
3705 }
3706 set f [file join $cdup $flist_menu_file]
3707 # Unfortunately it seems git gui blame doesn't like
3708 # being given an absolute path...
3709 set f [make_relative $f]
3710 lappend cmdline $base_commit $f
3711 if {[catch {eval exec $cmdline &} err]} {
3712 error_popup "[mc "git gui blame: command failed:"] $err"
3713 }
3714}
3715
3716proc show_line_source {} {
3717 global cmitmode currentid parents curview blamestuff blameinst
3718 global diff_menu_line diff_menu_filebase flist_menu_file
3719 global nullid nullid2 gitdir cdup
3720
3721 set from_index {}
3722 if {$cmitmode eq "tree"} {
3723 set id $currentid
3724 set line [expr {$diff_menu_line - $diff_menu_filebase}]
3725 } else {
3726 set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3727 if {$h eq {}} return
3728 set pi [lindex $h 0]
3729 if {$pi == 0} {
3730 mark_ctext_line $diff_menu_line
3731 return
3732 }
3733 incr pi -1
3734 if {$currentid eq $nullid} {
3735 if {$pi > 0} {
3736 # must be a merge in progress...
3737 if {[catch {
3738 # get the last line from .git/MERGE_HEAD
3739 set f [open [file join $gitdir MERGE_HEAD] r]
3740 set id [lindex [split [read $f] "\n"] end-1]
3741 close $f
3742 } err]} {
3743 error_popup [mc "Couldn't read merge head: %s" $err]
3744 return
3745 }
3746 } elseif {$parents($curview,$currentid) eq $nullid2} {
3747 # need to do the blame from the index
3748 if {[catch {
3749 set from_index [index_sha1 $flist_menu_file]
3750 } err]} {
3751 error_popup [mc "Error reading index: %s" $err]
3752 return
3753 }
3754 } else {
3755 set id $parents($curview,$currentid)
3756 }
3757 } else {
3758 set id [lindex $parents($curview,$currentid) $pi]
3759 }
3760 set line [lindex $h 1]
3761 }
3762 set blameargs {}
3763 if {$from_index ne {}} {
3764 lappend blameargs | git cat-file blob $from_index
3765 }
3766 lappend blameargs | git blame -p -L$line,+1
3767 if {$from_index ne {}} {
3768 lappend blameargs --contents -
3769 } else {
3770 lappend blameargs $id
3771 }
3772 lappend blameargs -- [file join $cdup $flist_menu_file]
3773 if {[catch {
3774 set f [open $blameargs r]
3775 } err]} {
3776 error_popup [mc "Couldn't start git blame: %s" $err]
3777 return
3778 }
3779 nowbusy blaming [mc "Searching"]
3780 fconfigure $f -blocking 0
3781 set i [reg_instance $f]
3782 set blamestuff($i) {}
3783 set blameinst $i
3784 filerun $f [list read_line_source $f $i]
3785}
3786
3787proc stopblaming {} {
3788 global blameinst
3789
3790 if {[info exists blameinst]} {
3791 stop_instance $blameinst
3792 unset blameinst
3793 notbusy blaming
3794 }
3795}
3796
3797proc read_line_source {fd inst} {
3798 global blamestuff curview commfd blameinst nullid nullid2
3799
3800 while {[gets $fd line] >= 0} {
3801 lappend blamestuff($inst) $line
3802 }
3803 if {![eof $fd]} {
3804 return 1
3805 }
3806 unset commfd($inst)
3807 unset blameinst
3808 notbusy blaming
3809 fconfigure $fd -blocking 1
3810 if {[catch {close $fd} err]} {
3811 error_popup [mc "Error running git blame: %s" $err]
3812 return 0
3813 }
3814
3815 set fname {}
3816 set line [split [lindex $blamestuff($inst) 0] " "]
3817 set id [lindex $line 0]
3818 set lnum [lindex $line 1]
3819 if {[string length $id] == 40 && [string is xdigit $id] &&
3820 [string is digit -strict $lnum]} {
3821 # look for "filename" line
3822 foreach l $blamestuff($inst) {
3823 if {[string match "filename *" $l]} {
3824 set fname [string range $l 9 end]
3825 break
3826 }
3827 }
3828 }
3829 if {$fname ne {}} {
3830 # all looks good, select it
3831 if {$id eq $nullid} {
3832 # blame uses all-zeroes to mean not committed,
3833 # which would mean a change in the index
3834 set id $nullid2
3835 }
3836 if {[commitinview $id $curview]} {
3837 selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3838 } else {
3839 error_popup [mc "That line comes from commit %s, \
3840 which is not in this view" [shortids $id]]
3841 }
3842 } else {
3843 puts "oops couldn't parse git blame output"
3844 }
3845 return 0
3846}
3847
3848# delete $dir when we see eof on $f (presumably because the child has exited)
3849proc delete_at_eof {f dir} {
3850 while {[gets $f line] >= 0} {}
3851 if {[eof $f]} {
3852 if {[catch {close $f} err]} {
3853 error_popup "[mc "External diff viewer failed:"] $err"
3854 }
3855 file delete -force $dir
3856 return 0
3857 }
3858 return 1
3859}
3860
3861# Functions for adding and removing shell-type quoting
3862
3863proc shellquote {str} {
3864 if {![string match "*\['\"\\ \t]*" $str]} {
3865 return $str
3866 }
3867 if {![string match "*\['\"\\]*" $str]} {
3868 return "\"$str\""
3869 }
3870 if {![string match "*'*" $str]} {
3871 return "'$str'"
3872 }
3873 return "\"[string map {\" \\\" \\ \\\\} $str]\""
3874}
3875
3876proc shellarglist {l} {
3877 set str {}
3878 foreach a $l {
3879 if {$str ne {}} {
3880 append str " "
3881 }
3882 append str [shellquote $a]
3883 }
3884 return $str
3885}
3886
3887proc shelldequote {str} {
3888 set ret {}
3889 set used -1
3890 while {1} {
3891 incr used
3892 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3893 append ret [string range $str $used end]
3894 set used [string length $str]
3895 break
3896 }
3897 set first [lindex $first 0]
3898 set ch [string index $str $first]
3899 if {$first > $used} {
3900 append ret [string range $str $used [expr {$first - 1}]]
3901 set used $first
3902 }
3903 if {$ch eq " " || $ch eq "\t"} break
3904 incr used
3905 if {$ch eq "'"} {
3906 set first [string first "'" $str $used]
3907 if {$first < 0} {
3908 error "unmatched single-quote"
3909 }
3910 append ret [string range $str $used [expr {$first - 1}]]
3911 set used $first
3912 continue
3913 }
3914 if {$ch eq "\\"} {
3915 if {$used >= [string length $str]} {
3916 error "trailing backslash"
3917 }
3918 append ret [string index $str $used]
3919 continue
3920 }
3921 # here ch == "\""
3922 while {1} {
3923 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3924 error "unmatched double-quote"
3925 }
3926 set first [lindex $first 0]
3927 set ch [string index $str $first]
3928 if {$first > $used} {
3929 append ret [string range $str $used [expr {$first - 1}]]
3930 set used $first
3931 }
3932 if {$ch eq "\""} break
3933 incr used
3934 append ret [string index $str $used]
3935 incr used
3936 }
3937 }
3938 return [list $used $ret]
3939}
3940
3941proc shellsplit {str} {
3942 set l {}
3943 while {1} {
3944 set str [string trimleft $str]
3945 if {$str eq {}} break
3946 set dq [shelldequote $str]
3947 set n [lindex $dq 0]
3948 set word [lindex $dq 1]
3949 set str [string range $str $n end]
3950 lappend l $word
3951 }
3952 return $l
3953}
3954
3955# Code to implement multiple views
3956
3957proc newview {ishighlight} {
3958 global nextviewnum newviewname newishighlight
3959 global revtreeargs viewargscmd newviewopts curview
3960
3961 set newishighlight $ishighlight
3962 set top .gitkview
3963 if {[winfo exists $top]} {
3964 raise $top
3965 return
3966 }
3967 decode_view_opts $nextviewnum $revtreeargs
3968 set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3969 set newviewopts($nextviewnum,perm) 0
3970 set newviewopts($nextviewnum,cmd) $viewargscmd($curview)
3971 vieweditor $top $nextviewnum [mc "Gitk view definition"]
3972}
3973
3974set known_view_options {
3975 {perm b . {} {mc "Remember this view"}}
3976 {reflabel l + {} {mc "References (space separated list):"}}
3977 {refs t15 .. {} {mc "Branches & tags:"}}
3978 {allrefs b *. "--all" {mc "All refs"}}
3979 {branches b . "--branches" {mc "All (local) branches"}}
3980 {tags b . "--tags" {mc "All tags"}}
3981 {remotes b . "--remotes" {mc "All remote-tracking branches"}}
3982 {commitlbl l + {} {mc "Commit Info (regular expressions):"}}
3983 {author t15 .. "--author=*" {mc "Author:"}}
3984 {committer t15 . "--committer=*" {mc "Committer:"}}
3985 {loginfo t15 .. "--grep=*" {mc "Commit Message:"}}
3986 {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}}
3987 {changes_l l + {} {mc "Changes to Files:"}}
3988 {pickaxe_s r0 . {} {mc "Fixed String"}}
3989 {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}}
3990 {pickaxe t15 .. "-S*" {mc "Search string:"}}
3991 {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3992 {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}}
3993 {until t15 . {"--until=*" "--before=*"} {mc "Until:"}}
3994 {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}}
3995 {limit t10 *. "--max-count=*" {mc "Number to show:"}}
3996 {skip t10 . "--skip=*" {mc "Number to skip:"}}
3997 {misc_lbl l + {} {mc "Miscellaneous options:"}}
3998 {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}}
3999 {lright b . "--left-right" {mc "Mark branch sides"}}
4000 {first b . "--first-parent" {mc "Limit to first parent"}}
4001 {smplhst b . "--simplify-by-decoration" {mc "Simple history"}}
4002 {args t50 *. {} {mc "Additional arguments to git log:"}}
4003 {allpaths path + {} {mc "Enter files and directories to include, one per line:"}}
4004 {cmd t50= + {} {mc "Command to generate more commits to include:"}}
4005 }
4006
4007# Convert $newviewopts($n, ...) into args for git log.
4008proc encode_view_opts {n} {
4009 global known_view_options newviewopts
4010
4011 set rargs [list]
4012 foreach opt $known_view_options {
4013 set patterns [lindex $opt 3]
4014 if {$patterns eq {}} continue
4015 set pattern [lindex $patterns 0]
4016
4017 if {[lindex $opt 1] eq "b"} {
4018 set val $newviewopts($n,[lindex $opt 0])
4019 if {$val} {
4020 lappend rargs $pattern
4021 }
4022 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4023 regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4024 set val $newviewopts($n,$button_id)
4025 if {$val eq $value} {
4026 lappend rargs $pattern
4027 }
4028 } else {
4029 set val $newviewopts($n,[lindex $opt 0])
4030 set val [string trim $val]
4031 if {$val ne {}} {
4032 set pfix [string range $pattern 0 end-1]
4033 lappend rargs $pfix$val
4034 }
4035 }
4036 }
4037 set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4038 return [concat $rargs [shellsplit $newviewopts($n,args)]]
4039}
4040
4041# Fill $newviewopts($n, ...) based on args for git log.
4042proc decode_view_opts {n view_args} {
4043 global known_view_options newviewopts
4044
4045 foreach opt $known_view_options {
4046 set id [lindex $opt 0]
4047 if {[lindex $opt 1] eq "b"} {
4048 # Checkboxes
4049 set val 0
4050 } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4051 # Radiobuttons
4052 regexp {^(.*_)} $id uselessvar id
4053 set val 0
4054 } else {
4055 # Text fields
4056 set val {}
4057 }
4058 set newviewopts($n,$id) $val
4059 }
4060 set oargs [list]
4061 set refargs [list]
4062 foreach arg $view_args {
4063 if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4064 && ![info exists found(limit)]} {
4065 set newviewopts($n,limit) $cnt
4066 set found(limit) 1
4067 continue
4068 }
4069 catch { unset val }
4070 foreach opt $known_view_options {
4071 set id [lindex $opt 0]
4072 if {[info exists found($id)]} continue
4073 foreach pattern [lindex $opt 3] {
4074 if {![string match $pattern $arg]} continue
4075 if {[lindex $opt 1] eq "b"} {
4076 # Check buttons
4077 set val 1
4078 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4079 # Radio buttons
4080 regexp {^(.*_)} $id uselessvar id
4081 set val $num
4082 } else {
4083 # Text input fields
4084 set size [string length $pattern]
4085 set val [string range $arg [expr {$size-1}] end]
4086 }
4087 set newviewopts($n,$id) $val
4088 set found($id) 1
4089 break
4090 }
4091 if {[info exists val]} break
4092 }
4093 if {[info exists val]} continue
4094 if {[regexp {^-} $arg]} {
4095 lappend oargs $arg
4096 } else {
4097 lappend refargs $arg
4098 }
4099 }
4100 set newviewopts($n,refs) [shellarglist $refargs]
4101 set newviewopts($n,args) [shellarglist $oargs]
4102}
4103
4104proc edit_or_newview {} {
4105 global curview
4106
4107 if {$curview > 0} {
4108 editview
4109 } else {
4110 newview 0
4111 }
4112}
4113
4114proc editview {} {
4115 global curview
4116 global viewname viewperm newviewname newviewopts
4117 global viewargs viewargscmd
4118
4119 set top .gitkvedit-$curview
4120 if {[winfo exists $top]} {
4121 raise $top
4122 return
4123 }
4124 decode_view_opts $curview $viewargs($curview)
4125 set newviewname($curview) $viewname($curview)
4126 set newviewopts($curview,perm) $viewperm($curview)
4127 set newviewopts($curview,cmd) $viewargscmd($curview)
4128 vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4129}
4130
4131proc vieweditor {top n title} {
4132 global newviewname newviewopts viewfiles bgcolor
4133 global known_view_options NS
4134
4135 ttk_toplevel $top
4136 wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4137 make_transient $top .
4138
4139 # View name
4140 ${NS}::frame $top.nfr
4141 ${NS}::label $top.nl -text [mc "View Name"]
4142 ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4143 pack $top.nfr -in $top -fill x -pady 5 -padx 3
4144 pack $top.nl -in $top.nfr -side left -padx {0 5}
4145 pack $top.name -in $top.nfr -side left -padx {0 25}
4146
4147 # View options
4148 set cframe $top.nfr
4149 set cexpand 0
4150 set cnt 0
4151 foreach opt $known_view_options {
4152 set id [lindex $opt 0]
4153 set type [lindex $opt 1]
4154 set flags [lindex $opt 2]
4155 set title [eval [lindex $opt 4]]
4156 set lxpad 0
4157
4158 if {$flags eq "+" || $flags eq "*"} {
4159 set cframe $top.fr$cnt
4160 incr cnt
4161 ${NS}::frame $cframe
4162 pack $cframe -in $top -fill x -pady 3 -padx 3
4163 set cexpand [expr {$flags eq "*"}]
4164 } elseif {$flags eq ".." || $flags eq "*."} {
4165 set cframe $top.fr$cnt
4166 incr cnt
4167 ${NS}::frame $cframe
4168 pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4169 set cexpand [expr {$flags eq "*."}]
4170 } else {
4171 set lxpad 5
4172 }
4173
4174 if {$type eq "l"} {
4175 ${NS}::label $cframe.l_$id -text $title
4176 pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4177 } elseif {$type eq "b"} {
4178 ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4179 pack $cframe.c_$id -in $cframe -side left \
4180 -padx [list $lxpad 0] -expand $cexpand -anchor w
4181 } elseif {[regexp {^r(\d+)$} $type type sz]} {
4182 regexp {^(.*_)} $id uselessvar button_id
4183 ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4184 pack $cframe.c_$id -in $cframe -side left \
4185 -padx [list $lxpad 0] -expand $cexpand -anchor w
4186 } elseif {[regexp {^t(\d+)$} $type type sz]} {
4187 ${NS}::label $cframe.l_$id -text $title
4188 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4189 -textvariable newviewopts($n,$id)
4190 pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4191 pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4192 } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4193 ${NS}::label $cframe.l_$id -text $title
4194 ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4195 -textvariable newviewopts($n,$id)
4196 pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4197 pack $cframe.e_$id -in $cframe -side top -fill x
4198 } elseif {$type eq "path"} {
4199 ${NS}::label $top.l -text $title
4200 pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4201 text $top.t -width 40 -height 5 -background $bgcolor
4202 if {[info exists viewfiles($n)]} {
4203 foreach f $viewfiles($n) {
4204 $top.t insert end $f
4205 $top.t insert end "\n"
4206 }
4207 $top.t delete {end - 1c} end
4208 $top.t mark set insert 0.0
4209 }
4210 pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4211 }
4212 }
4213
4214 ${NS}::frame $top.buts
4215 ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4216 ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4217 ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4218 bind $top <Control-Return> [list newviewok $top $n]
4219 bind $top <F5> [list newviewok $top $n 1]
4220 bind $top <Escape> [list destroy $top]
4221 grid $top.buts.ok $top.buts.apply $top.buts.can
4222 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4223 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4224 grid columnconfigure $top.buts 2 -weight 1 -uniform a
4225 pack $top.buts -in $top -side top -fill x
4226 focus $top.t
4227}
4228
4229proc doviewmenu {m first cmd op argv} {
4230 set nmenu [$m index end]
4231 for {set i $first} {$i <= $nmenu} {incr i} {
4232 if {[$m entrycget $i -command] eq $cmd} {
4233 eval $m $op $i $argv
4234 break
4235 }
4236 }
4237}
4238
4239proc allviewmenus {n op args} {
4240 # global viewhlmenu
4241
4242 doviewmenu .bar.view 5 [list showview $n] $op $args
4243 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4244}
4245
4246proc newviewok {top n {apply 0}} {
4247 global nextviewnum newviewperm newviewname newishighlight
4248 global viewname viewfiles viewperm selectedview curview
4249 global viewargs viewargscmd newviewopts viewhlmenu
4250
4251 if {[catch {
4252 set newargs [encode_view_opts $n]
4253 } err]} {
4254 error_popup "[mc "Error in commit selection arguments:"] $err" $top
4255 return
4256 }
4257 set files {}
4258 foreach f [split [$top.t get 0.0 end] "\n"] {
4259 set ft [string trim $f]
4260 if {$ft ne {}} {
4261 lappend files $ft
4262 }
4263 }
4264 if {![info exists viewfiles($n)]} {
4265 # creating a new view
4266 incr nextviewnum
4267 set viewname($n) $newviewname($n)
4268 set viewperm($n) $newviewopts($n,perm)
4269 set viewfiles($n) $files
4270 set viewargs($n) $newargs
4271 set viewargscmd($n) $newviewopts($n,cmd)
4272 addviewmenu $n
4273 if {!$newishighlight} {
4274 run showview $n
4275 } else {
4276 run addvhighlight $n
4277 }
4278 } else {
4279 # editing an existing view
4280 set viewperm($n) $newviewopts($n,perm)
4281 if {$newviewname($n) ne $viewname($n)} {
4282 set viewname($n) $newviewname($n)
4283 doviewmenu .bar.view 5 [list showview $n] \
4284 entryconf [list -label $viewname($n)]
4285 # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4286 # entryconf [list -label $viewname($n) -value $viewname($n)]
4287 }
4288 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4289 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4290 set viewfiles($n) $files
4291 set viewargs($n) $newargs
4292 set viewargscmd($n) $newviewopts($n,cmd)
4293 if {$curview == $n} {
4294 run reloadcommits
4295 }
4296 }
4297 }
4298 if {$apply} return
4299 catch {destroy $top}
4300}
4301
4302proc delview {} {
4303 global curview viewperm hlview selectedhlview
4304
4305 if {$curview == 0} return
4306 if {[info exists hlview] && $hlview == $curview} {
4307 set selectedhlview [mc "None"]
4308 unset hlview
4309 }
4310 allviewmenus $curview delete
4311 set viewperm($curview) 0
4312 showview 0
4313}
4314
4315proc addviewmenu {n} {
4316 global viewname viewhlmenu
4317
4318 .bar.view add radiobutton -label $viewname($n) \
4319 -command [list showview $n] -variable selectedview -value $n
4320 #$viewhlmenu add radiobutton -label $viewname($n) \
4321 # -command [list addvhighlight $n] -variable selectedhlview
4322}
4323
4324proc showview {n} {
4325 global curview cached_commitrow ordertok
4326 global displayorder parentlist rowidlist rowisopt rowfinal
4327 global colormap rowtextx nextcolor canvxmax
4328 global numcommits viewcomplete
4329 global selectedline currentid canv canvy0
4330 global treediffs
4331 global pending_select mainheadid
4332 global commitidx
4333 global selectedview
4334 global hlview selectedhlview commitinterest
4335
4336 if {$n == $curview} return
4337 set selid {}
4338 set ymax [lindex [$canv cget -scrollregion] 3]
4339 set span [$canv yview]
4340 set ytop [expr {[lindex $span 0] * $ymax}]
4341 set ybot [expr {[lindex $span 1] * $ymax}]
4342 set yscreen [expr {($ybot - $ytop) / 2}]
4343 if {$selectedline ne {}} {
4344 set selid $currentid
4345 set y [yc $selectedline]
4346 if {$ytop < $y && $y < $ybot} {
4347 set yscreen [expr {$y - $ytop}]
4348 }
4349 } elseif {[info exists pending_select]} {
4350 set selid $pending_select
4351 unset pending_select
4352 }
4353 unselectline
4354 normalline
4355 catch {unset treediffs}
4356 clear_display
4357 if {[info exists hlview] && $hlview == $n} {
4358 unset hlview
4359 set selectedhlview [mc "None"]
4360 }
4361 catch {unset commitinterest}
4362 catch {unset cached_commitrow}
4363 catch {unset ordertok}
4364
4365 set curview $n
4366 set selectedview $n
4367 .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4368 .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4369
4370 run refill_reflist
4371 if {![info exists viewcomplete($n)]} {
4372 getcommits $selid
4373 return
4374 }
4375
4376 set displayorder {}
4377 set parentlist {}
4378 set rowidlist {}
4379 set rowisopt {}
4380 set rowfinal {}
4381 set numcommits $commitidx($n)
4382
4383 catch {unset colormap}
4384 catch {unset rowtextx}
4385 set nextcolor 0
4386 set canvxmax [$canv cget -width]
4387 set curview $n
4388 set row 0
4389 setcanvscroll
4390 set yf 0
4391 set row {}
4392 if {$selid ne {} && [commitinview $selid $n]} {
4393 set row [rowofcommit $selid]
4394 # try to get the selected row in the same position on the screen
4395 set ymax [lindex [$canv cget -scrollregion] 3]
4396 set ytop [expr {[yc $row] - $yscreen}]
4397 if {$ytop < 0} {
4398 set ytop 0
4399 }
4400 set yf [expr {$ytop * 1.0 / $ymax}]
4401 }
4402 allcanvs yview moveto $yf
4403 drawvisible
4404 if {$row ne {}} {
4405 selectline $row 0
4406 } elseif {!$viewcomplete($n)} {
4407 reset_pending_select $selid
4408 } else {
4409 reset_pending_select {}
4410
4411 if {[commitinview $pending_select $curview]} {
4412 selectline [rowofcommit $pending_select] 1
4413 } else {
4414 set row [first_real_row]
4415 if {$row < $numcommits} {
4416 selectline $row 0
4417 }
4418 }
4419 }
4420 if {!$viewcomplete($n)} {
4421 if {$numcommits == 0} {
4422 show_status [mc "Reading commits..."]
4423 }
4424 } elseif {$numcommits == 0} {
4425 show_status [mc "No commits selected"]
4426 }
4427}
4428
4429# Stuff relating to the highlighting facility
4430
4431proc ishighlighted {id} {
4432 global vhighlights fhighlights nhighlights rhighlights
4433
4434 if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4435 return $nhighlights($id)
4436 }
4437 if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4438 return $vhighlights($id)
4439 }
4440 if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4441 return $fhighlights($id)
4442 }
4443 if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4444 return $rhighlights($id)
4445 }
4446 return 0
4447}
4448
4449proc bolden {id font} {
4450 global canv linehtag currentid boldids need_redisplay markedid
4451
4452 # need_redisplay = 1 means the display is stale and about to be redrawn
4453 if {$need_redisplay} return
4454 lappend boldids $id
4455 $canv itemconf $linehtag($id) -font $font
4456 if {[info exists currentid] && $id eq $currentid} {
4457 $canv delete secsel
4458 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4459 -outline {{}} -tags secsel \
4460 -fill [$canv cget -selectbackground]]
4461 $canv lower $t
4462 }
4463 if {[info exists markedid] && $id eq $markedid} {
4464 make_idmark $id
4465 }
4466}
4467
4468proc bolden_name {id font} {
4469 global canv2 linentag currentid boldnameids need_redisplay
4470
4471 if {$need_redisplay} return
4472 lappend boldnameids $id
4473 $canv2 itemconf $linentag($id) -font $font
4474 if {[info exists currentid] && $id eq $currentid} {
4475 $canv2 delete secsel
4476 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4477 -outline {{}} -tags secsel \
4478 -fill [$canv2 cget -selectbackground]]
4479 $canv2 lower $t
4480 }
4481}
4482
4483proc unbolden {} {
4484 global boldids
4485
4486 set stillbold {}
4487 foreach id $boldids {
4488 if {![ishighlighted $id]} {
4489 bolden $id mainfont
4490 } else {
4491 lappend stillbold $id
4492 }
4493 }
4494 set boldids $stillbold
4495}
4496
4497proc addvhighlight {n} {
4498 global hlview viewcomplete curview vhl_done commitidx
4499
4500 if {[info exists hlview]} {
4501 delvhighlight
4502 }
4503 set hlview $n
4504 if {$n != $curview && ![info exists viewcomplete($n)]} {
4505 start_rev_list $n
4506 }
4507 set vhl_done $commitidx($hlview)
4508 if {$vhl_done > 0} {
4509 drawvisible
4510 }
4511}
4512
4513proc delvhighlight {} {
4514 global hlview vhighlights
4515
4516 if {![info exists hlview]} return
4517 unset hlview
4518 catch {unset vhighlights}
4519 unbolden
4520}
4521
4522proc vhighlightmore {} {
4523 global hlview vhl_done commitidx vhighlights curview
4524
4525 set max $commitidx($hlview)
4526 set vr [visiblerows]
4527 set r0 [lindex $vr 0]
4528 set r1 [lindex $vr 1]
4529 for {set i $vhl_done} {$i < $max} {incr i} {
4530 set id [commitonrow $i $hlview]
4531 if {[commitinview $id $curview]} {
4532 set row [rowofcommit $id]
4533 if {$r0 <= $row && $row <= $r1} {
4534 if {![highlighted $row]} {
4535 bolden $id mainfontbold
4536 }
4537 set vhighlights($id) 1
4538 }
4539 }
4540 }
4541 set vhl_done $max
4542 return 0
4543}
4544
4545proc askvhighlight {row id} {
4546 global hlview vhighlights iddrawn
4547
4548 if {[commitinview $id $hlview]} {
4549 if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4550 bolden $id mainfontbold
4551 }
4552 set vhighlights($id) 1
4553 } else {
4554 set vhighlights($id) 0
4555 }
4556}
4557
4558proc hfiles_change {} {
4559 global highlight_files filehighlight fhighlights fh_serial
4560 global highlight_paths
4561
4562 if {[info exists filehighlight]} {
4563 # delete previous highlights
4564 catch {close $filehighlight}
4565 unset filehighlight
4566 catch {unset fhighlights}
4567 unbolden
4568 unhighlight_filelist
4569 }
4570 set highlight_paths {}
4571 after cancel do_file_hl $fh_serial
4572 incr fh_serial
4573 if {$highlight_files ne {}} {
4574 after 300 do_file_hl $fh_serial
4575 }
4576}
4577
4578proc gdttype_change {name ix op} {
4579 global gdttype highlight_files findstring findpattern
4580
4581 stopfinding
4582 if {$findstring ne {}} {
4583 if {$gdttype eq [mc "containing:"]} {
4584 if {$highlight_files ne {}} {
4585 set highlight_files {}
4586 hfiles_change
4587 }
4588 findcom_change
4589 } else {
4590 if {$findpattern ne {}} {
4591 set findpattern {}
4592 findcom_change
4593 }
4594 set highlight_files $findstring
4595 hfiles_change
4596 }
4597 drawvisible
4598 }
4599 # enable/disable findtype/findloc menus too
4600}
4601
4602proc find_change {name ix op} {
4603 global gdttype findstring highlight_files
4604
4605 stopfinding
4606 if {$gdttype eq [mc "containing:"]} {
4607 findcom_change
4608 } else {
4609 if {$highlight_files ne $findstring} {
4610 set highlight_files $findstring
4611 hfiles_change
4612 }
4613 }
4614 drawvisible
4615}
4616
4617proc findcom_change args {
4618 global nhighlights boldnameids
4619 global findpattern findtype findstring gdttype
4620
4621 stopfinding
4622 # delete previous highlights, if any
4623 foreach id $boldnameids {
4624 bolden_name $id mainfont
4625 }
4626 set boldnameids {}
4627 catch {unset nhighlights}
4628 unbolden
4629 unmarkmatches
4630 if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4631 set findpattern {}
4632 } elseif {$findtype eq [mc "Regexp"]} {
4633 set findpattern $findstring
4634 } else {
4635 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4636 $findstring]
4637 set findpattern "*$e*"
4638 }
4639}
4640
4641proc makepatterns {l} {
4642 set ret {}
4643 foreach e $l {
4644 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4645 if {[string index $ee end] eq "/"} {
4646 lappend ret "$ee*"
4647 } else {
4648 lappend ret $ee
4649 lappend ret "$ee/*"
4650 }
4651 }
4652 return $ret
4653}
4654
4655proc do_file_hl {serial} {
4656 global highlight_files filehighlight highlight_paths gdttype fhl_list
4657 global cdup findtype
4658
4659 if {$gdttype eq [mc "touching paths:"]} {
4660 # If "exact" match then convert backslashes to forward slashes.
4661 # Most useful to support Windows-flavoured file paths.
4662 if {$findtype eq [mc "Exact"]} {
4663 set highlight_files [string map {"\\" "/"} $highlight_files]
4664 }
4665 if {[catch {set paths [shellsplit $highlight_files]}]} return
4666 set highlight_paths [makepatterns $paths]
4667 highlight_filelist
4668 set relative_paths {}
4669 foreach path $paths {
4670 lappend relative_paths [file join $cdup $path]
4671 }
4672 set gdtargs [concat -- $relative_paths]
4673 } elseif {$gdttype eq [mc "adding/removing string:"]} {
4674 set gdtargs [list "-S$highlight_files"]
4675 } elseif {$gdttype eq [mc "changing lines matching:"]} {
4676 set gdtargs [list "-G$highlight_files"]
4677 } else {
4678 # must be "containing:", i.e. we're searching commit info
4679 return
4680 }
4681 set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4682 set filehighlight [open $cmd r+]
4683 fconfigure $filehighlight -blocking 0
4684 filerun $filehighlight readfhighlight
4685 set fhl_list {}
4686 drawvisible
4687 flushhighlights
4688}
4689
4690proc flushhighlights {} {
4691 global filehighlight fhl_list
4692
4693 if {[info exists filehighlight]} {
4694 lappend fhl_list {}
4695 puts $filehighlight ""
4696 flush $filehighlight
4697 }
4698}
4699
4700proc askfilehighlight {row id} {
4701 global filehighlight fhighlights fhl_list
4702
4703 lappend fhl_list $id
4704 set fhighlights($id) -1
4705 puts $filehighlight $id
4706}
4707
4708proc readfhighlight {} {
4709 global filehighlight fhighlights curview iddrawn
4710 global fhl_list find_dirn
4711
4712 if {![info exists filehighlight]} {
4713 return 0
4714 }
4715 set nr 0
4716 while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4717 set line [string trim $line]
4718 set i [lsearch -exact $fhl_list $line]
4719 if {$i < 0} continue
4720 for {set j 0} {$j < $i} {incr j} {
4721 set id [lindex $fhl_list $j]
4722 set fhighlights($id) 0
4723 }
4724 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4725 if {$line eq {}} continue
4726 if {![commitinview $line $curview]} continue
4727 if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4728 bolden $line mainfontbold
4729 }
4730 set fhighlights($line) 1
4731 }
4732 if {[eof $filehighlight]} {
4733 # strange...
4734 puts "oops, git diff-tree died"
4735 catch {close $filehighlight}
4736 unset filehighlight
4737 return 0
4738 }
4739 if {[info exists find_dirn]} {
4740 run findmore
4741 }
4742 return 1
4743}
4744
4745proc doesmatch {f} {
4746 global findtype findpattern
4747
4748 if {$findtype eq [mc "Regexp"]} {
4749 return [regexp $findpattern $f]
4750 } elseif {$findtype eq [mc "IgnCase"]} {
4751 return [string match -nocase $findpattern $f]
4752 } else {
4753 return [string match $findpattern $f]
4754 }
4755}
4756
4757proc askfindhighlight {row id} {
4758 global nhighlights commitinfo iddrawn
4759 global findloc
4760 global markingmatches
4761
4762 if {![info exists commitinfo($id)]} {
4763 getcommit $id
4764 }
4765 set info $commitinfo($id)
4766 set isbold 0
4767 set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4768 foreach f $info ty $fldtypes {
4769 if {$ty eq ""} continue
4770 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4771 [doesmatch $f]} {
4772 if {$ty eq [mc "Author"]} {
4773 set isbold 2
4774 break
4775 }
4776 set isbold 1
4777 }
4778 }
4779 if {$isbold && [info exists iddrawn($id)]} {
4780 if {![ishighlighted $id]} {
4781 bolden $id mainfontbold
4782 if {$isbold > 1} {
4783 bolden_name $id mainfontbold
4784 }
4785 }
4786 if {$markingmatches} {
4787 markrowmatches $row $id
4788 }
4789 }
4790 set nhighlights($id) $isbold
4791}
4792
4793proc markrowmatches {row id} {
4794 global canv canv2 linehtag linentag commitinfo findloc
4795
4796 set headline [lindex $commitinfo($id) 0]
4797 set author [lindex $commitinfo($id) 1]
4798 $canv delete match$row
4799 $canv2 delete match$row
4800 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4801 set m [findmatches $headline]
4802 if {$m ne {}} {
4803 markmatches $canv $row $headline $linehtag($id) $m \
4804 [$canv itemcget $linehtag($id) -font] $row
4805 }
4806 }
4807 if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4808 set m [findmatches $author]
4809 if {$m ne {}} {
4810 markmatches $canv2 $row $author $linentag($id) $m \
4811 [$canv2 itemcget $linentag($id) -font] $row
4812 }
4813 }
4814}
4815
4816proc vrel_change {name ix op} {
4817 global highlight_related
4818
4819 rhighlight_none
4820 if {$highlight_related ne [mc "None"]} {
4821 run drawvisible
4822 }
4823}
4824
4825# prepare for testing whether commits are descendents or ancestors of a
4826proc rhighlight_sel {a} {
4827 global descendent desc_todo ancestor anc_todo
4828 global highlight_related
4829
4830 catch {unset descendent}
4831 set desc_todo [list $a]
4832 catch {unset ancestor}
4833 set anc_todo [list $a]
4834 if {$highlight_related ne [mc "None"]} {
4835 rhighlight_none
4836 run drawvisible
4837 }
4838}
4839
4840proc rhighlight_none {} {
4841 global rhighlights
4842
4843 catch {unset rhighlights}
4844 unbolden
4845}
4846
4847proc is_descendent {a} {
4848 global curview children descendent desc_todo
4849
4850 set v $curview
4851 set la [rowofcommit $a]
4852 set todo $desc_todo
4853 set leftover {}
4854 set done 0
4855 for {set i 0} {$i < [llength $todo]} {incr i} {
4856 set do [lindex $todo $i]
4857 if {[rowofcommit $do] < $la} {
4858 lappend leftover $do
4859 continue
4860 }
4861 foreach nk $children($v,$do) {
4862 if {![info exists descendent($nk)]} {
4863 set descendent($nk) 1
4864 lappend todo $nk
4865 if {$nk eq $a} {
4866 set done 1
4867 }
4868 }
4869 }
4870 if {$done} {
4871 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4872 return
4873 }
4874 }
4875 set descendent($a) 0
4876 set desc_todo $leftover
4877}
4878
4879proc is_ancestor {a} {
4880 global curview parents ancestor anc_todo
4881
4882 set v $curview
4883 set la [rowofcommit $a]
4884 set todo $anc_todo
4885 set leftover {}
4886 set done 0
4887 for {set i 0} {$i < [llength $todo]} {incr i} {
4888 set do [lindex $todo $i]
4889 if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4890 lappend leftover $do
4891 continue
4892 }
4893 foreach np $parents($v,$do) {
4894 if {![info exists ancestor($np)]} {
4895 set ancestor($np) 1
4896 lappend todo $np
4897 if {$np eq $a} {
4898 set done 1
4899 }
4900 }
4901 }
4902 if {$done} {
4903 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4904 return
4905 }
4906 }
4907 set ancestor($a) 0
4908 set anc_todo $leftover
4909}
4910
4911proc askrelhighlight {row id} {
4912 global descendent highlight_related iddrawn rhighlights
4913 global selectedline ancestor
4914
4915 if {$selectedline eq {}} return
4916 set isbold 0
4917 if {$highlight_related eq [mc "Descendant"] ||
4918 $highlight_related eq [mc "Not descendant"]} {
4919 if {![info exists descendent($id)]} {
4920 is_descendent $id
4921 }
4922 if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4923 set isbold 1
4924 }
4925 } elseif {$highlight_related eq [mc "Ancestor"] ||
4926 $highlight_related eq [mc "Not ancestor"]} {
4927 if {![info exists ancestor($id)]} {
4928 is_ancestor $id
4929 }
4930 if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4931 set isbold 1
4932 }
4933 }
4934 if {[info exists iddrawn($id)]} {
4935 if {$isbold && ![ishighlighted $id]} {
4936 bolden $id mainfontbold
4937 }
4938 }
4939 set rhighlights($id) $isbold
4940}
4941
4942# Graph layout functions
4943
4944proc shortids {ids} {
4945 set res {}
4946 foreach id $ids {
4947 if {[llength $id] > 1} {
4948 lappend res [shortids $id]
4949 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4950 lappend res [string range $id 0 7]
4951 } else {
4952 lappend res $id
4953 }
4954 }
4955 return $res
4956}
4957
4958proc ntimes {n o} {
4959 set ret {}
4960 set o [list $o]
4961 for {set mask 1} {$mask <= $n} {incr mask $mask} {
4962 if {($n & $mask) != 0} {
4963 set ret [concat $ret $o]
4964 }
4965 set o [concat $o $o]
4966 }
4967 return $ret
4968}
4969
4970proc ordertoken {id} {
4971 global ordertok curview varcid varcstart varctok curview parents children
4972 global nullid nullid2
4973
4974 if {[info exists ordertok($id)]} {
4975 return $ordertok($id)
4976 }
4977 set origid $id
4978 set todo {}
4979 while {1} {
4980 if {[info exists varcid($curview,$id)]} {
4981 set a $varcid($curview,$id)
4982 set p [lindex $varcstart($curview) $a]
4983 } else {
4984 set p [lindex $children($curview,$id) 0]
4985 }
4986 if {[info exists ordertok($p)]} {
4987 set tok $ordertok($p)
4988 break
4989 }
4990 set id [first_real_child $curview,$p]
4991 if {$id eq {}} {
4992 # it's a root
4993 set tok [lindex $varctok($curview) $varcid($curview,$p)]
4994 break
4995 }
4996 if {[llength $parents($curview,$id)] == 1} {
4997 lappend todo [list $p {}]
4998 } else {
4999 set j [lsearch -exact $parents($curview,$id) $p]
5000 if {$j < 0} {
5001 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5002 }
5003 lappend todo [list $p [strrep $j]]
5004 }
5005 }
5006 for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5007 set p [lindex $todo $i 0]
5008 append tok [lindex $todo $i 1]
5009 set ordertok($p) $tok
5010 }
5011 set ordertok($origid) $tok
5012 return $tok
5013}
5014
5015# Work out where id should go in idlist so that order-token
5016# values increase from left to right
5017proc idcol {idlist id {i 0}} {
5018 set t [ordertoken $id]
5019 if {$i < 0} {
5020 set i 0
5021 }
5022 if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5023 if {$i > [llength $idlist]} {
5024 set i [llength $idlist]
5025 }
5026 while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5027 incr i
5028 } else {
5029 if {$t > [ordertoken [lindex $idlist $i]]} {
5030 while {[incr i] < [llength $idlist] &&
5031 $t >= [ordertoken [lindex $idlist $i]]} {}
5032 }
5033 }
5034 return $i
5035}
5036
5037proc initlayout {} {
5038 global rowidlist rowisopt rowfinal displayorder parentlist
5039 global numcommits canvxmax canv
5040 global nextcolor
5041 global colormap rowtextx
5042
5043 set numcommits 0
5044 set displayorder {}
5045 set parentlist {}
5046 set nextcolor 0
5047 set rowidlist {}
5048 set rowisopt {}
5049 set rowfinal {}
5050 set canvxmax [$canv cget -width]
5051 catch {unset colormap}
5052 catch {unset rowtextx}
5053 setcanvscroll
5054}
5055
5056proc setcanvscroll {} {
5057 global canv canv2 canv3 numcommits linespc canvxmax canvy0
5058 global lastscrollset lastscrollrows
5059
5060 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5061 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5062 $canv2 conf -scrollregion [list 0 0 0 $ymax]
5063 $canv3 conf -scrollregion [list 0 0 0 $ymax]
5064 set lastscrollset [clock clicks -milliseconds]
5065 set lastscrollrows $numcommits
5066}
5067
5068proc visiblerows {} {
5069 global canv numcommits linespc
5070
5071 set ymax [lindex [$canv cget -scrollregion] 3]
5072 if {$ymax eq {} || $ymax == 0} return
5073 set f [$canv yview]
5074 set y0 [expr {int([lindex $f 0] * $ymax)}]
5075 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5076 if {$r0 < 0} {
5077 set r0 0
5078 }
5079 set y1 [expr {int([lindex $f 1] * $ymax)}]
5080 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5081 if {$r1 >= $numcommits} {
5082 set r1 [expr {$numcommits - 1}]
5083 }
5084 return [list $r0 $r1]
5085}
5086
5087proc layoutmore {} {
5088 global commitidx viewcomplete curview
5089 global numcommits pending_select curview
5090 global lastscrollset lastscrollrows
5091
5092 if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5093 [clock clicks -milliseconds] - $lastscrollset > 500} {
5094 setcanvscroll
5095 }
5096 if {[info exists pending_select] &&
5097 [commitinview $pending_select $curview]} {
5098 update
5099 selectline [rowofcommit $pending_select] 1
5100 }
5101 drawvisible
5102}
5103
5104# With path limiting, we mightn't get the actual HEAD commit,
5105# so ask git rev-list what is the first ancestor of HEAD that
5106# touches a file in the path limit.
5107proc get_viewmainhead {view} {
5108 global viewmainheadid vfilelimit viewinstances mainheadid
5109
5110 catch {
5111 set rfd [open [concat | git rev-list -1 $mainheadid \
5112 -- $vfilelimit($view)] r]
5113 set j [reg_instance $rfd]
5114 lappend viewinstances($view) $j
5115 fconfigure $rfd -blocking 0
5116 filerun $rfd [list getviewhead $rfd $j $view]
5117 set viewmainheadid($curview) {}
5118 }
5119}
5120
5121# git rev-list should give us just 1 line to use as viewmainheadid($view)
5122proc getviewhead {fd inst view} {
5123 global viewmainheadid commfd curview viewinstances showlocalchanges
5124
5125 set id {}
5126 if {[gets $fd line] < 0} {
5127 if {![eof $fd]} {
5128 return 1
5129 }
5130 } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5131 set id $line
5132 }
5133 set viewmainheadid($view) $id
5134 close $fd
5135 unset commfd($inst)
5136 set i [lsearch -exact $viewinstances($view) $inst]
5137 if {$i >= 0} {
5138 set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5139 }
5140 if {$showlocalchanges && $id ne {} && $view == $curview} {
5141 doshowlocalchanges
5142 }
5143 return 0
5144}
5145
5146proc doshowlocalchanges {} {
5147 global curview viewmainheadid
5148
5149 if {$viewmainheadid($curview) eq {}} return
5150 if {[commitinview $viewmainheadid($curview) $curview]} {
5151 dodiffindex
5152 } else {
5153 interestedin $viewmainheadid($curview) dodiffindex
5154 }
5155}
5156
5157proc dohidelocalchanges {} {
5158 global nullid nullid2 lserial curview
5159
5160 if {[commitinview $nullid $curview]} {
5161 removefakerow $nullid
5162 }
5163 if {[commitinview $nullid2 $curview]} {
5164 removefakerow $nullid2
5165 }
5166 incr lserial
5167}
5168
5169# spawn off a process to do git diff-index --cached HEAD
5170proc dodiffindex {} {
5171 global lserial showlocalchanges vfilelimit curview
5172 global hasworktree git_version
5173
5174 if {!$showlocalchanges || !$hasworktree} return
5175 incr lserial
5176 if {[package vcompare $git_version "1.7.2"] >= 0} {
5177 set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5178 } else {
5179 set cmd "|git diff-index --cached HEAD"
5180 }
5181 if {$vfilelimit($curview) ne {}} {
5182 set cmd [concat $cmd -- $vfilelimit($curview)]
5183 }
5184 set fd [open $cmd r]
5185 fconfigure $fd -blocking 0
5186 set i [reg_instance $fd]
5187 filerun $fd [list readdiffindex $fd $lserial $i]
5188}
5189
5190proc readdiffindex {fd serial inst} {
5191 global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5192 global vfilelimit
5193
5194 set isdiff 1
5195 if {[gets $fd line] < 0} {
5196 if {![eof $fd]} {
5197 return 1
5198 }
5199 set isdiff 0
5200 }
5201 # we only need to see one line and we don't really care what it says...
5202 stop_instance $inst
5203
5204 if {$serial != $lserial} {
5205 return 0
5206 }
5207
5208 # now see if there are any local changes not checked in to the index
5209 set cmd "|git diff-files"
5210 if {$vfilelimit($curview) ne {}} {
5211 set cmd [concat $cmd -- $vfilelimit($curview)]
5212 }
5213 set fd [open $cmd r]
5214 fconfigure $fd -blocking 0
5215 set i [reg_instance $fd]
5216 filerun $fd [list readdifffiles $fd $serial $i]
5217
5218 if {$isdiff && ![commitinview $nullid2 $curview]} {
5219 # add the line for the changes in the index to the graph
5220 set hl [mc "Local changes checked in to index but not committed"]
5221 set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
5222 set commitdata($nullid2) "\n $hl\n"
5223 if {[commitinview $nullid $curview]} {
5224 removefakerow $nullid
5225 }
5226 insertfakerow $nullid2 $viewmainheadid($curview)
5227 } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5228 if {[commitinview $nullid $curview]} {
5229 removefakerow $nullid
5230 }
5231 removefakerow $nullid2
5232 }
5233 return 0
5234}
5235
5236proc readdifffiles {fd serial inst} {
5237 global viewmainheadid nullid nullid2 curview
5238 global commitinfo commitdata lserial
5239
5240 set isdiff 1
5241 if {[gets $fd line] < 0} {
5242 if {![eof $fd]} {
5243 return 1
5244 }
5245 set isdiff 0
5246 }
5247 # we only need to see one line and we don't really care what it says...
5248 stop_instance $inst
5249
5250 if {$serial != $lserial} {
5251 return 0
5252 }
5253
5254 if {$isdiff && ![commitinview $nullid $curview]} {
5255 # add the line for the local diff to the graph
5256 set hl [mc "Local uncommitted changes, not checked in to index"]
5257 set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
5258 set commitdata($nullid) "\n $hl\n"
5259 if {[commitinview $nullid2 $curview]} {
5260 set p $nullid2
5261 } else {
5262 set p $viewmainheadid($curview)
5263 }
5264 insertfakerow $nullid $p
5265 } elseif {!$isdiff && [commitinview $nullid $curview]} {
5266 removefakerow $nullid
5267 }
5268 return 0
5269}
5270
5271proc nextuse {id row} {
5272 global curview children
5273
5274 if {[info exists children($curview,$id)]} {
5275 foreach kid $children($curview,$id) {
5276 if {![commitinview $kid $curview]} {
5277 return -1
5278 }
5279 if {[rowofcommit $kid] > $row} {
5280 return [rowofcommit $kid]
5281 }
5282 }
5283 }
5284 if {[commitinview $id $curview]} {
5285 return [rowofcommit $id]
5286 }
5287 return -1
5288}
5289
5290proc prevuse {id row} {
5291 global curview children
5292
5293 set ret -1
5294 if {[info exists children($curview,$id)]} {
5295 foreach kid $children($curview,$id) {
5296 if {![commitinview $kid $curview]} break
5297 if {[rowofcommit $kid] < $row} {
5298 set ret [rowofcommit $kid]
5299 }
5300 }
5301 }
5302 return $ret
5303}
5304
5305proc make_idlist {row} {
5306 global displayorder parentlist uparrowlen downarrowlen mingaplen
5307 global commitidx curview children
5308
5309 set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5310 if {$r < 0} {
5311 set r 0
5312 }
5313 set ra [expr {$row - $downarrowlen}]
5314 if {$ra < 0} {
5315 set ra 0
5316 }
5317 set rb [expr {$row + $uparrowlen}]
5318 if {$rb > $commitidx($curview)} {
5319 set rb $commitidx($curview)
5320 }
5321 make_disporder $r [expr {$rb + 1}]
5322 set ids {}
5323 for {} {$r < $ra} {incr r} {
5324 set nextid [lindex $displayorder [expr {$r + 1}]]
5325 foreach p [lindex $parentlist $r] {
5326 if {$p eq $nextid} continue
5327 set rn [nextuse $p $r]
5328 if {$rn >= $row &&
5329 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5330 lappend ids [list [ordertoken $p] $p]
5331 }
5332 }
5333 }
5334 for {} {$r < $row} {incr r} {
5335 set nextid [lindex $displayorder [expr {$r + 1}]]
5336 foreach p [lindex $parentlist $r] {
5337 if {$p eq $nextid} continue
5338 set rn [nextuse $p $r]
5339 if {$rn < 0 || $rn >= $row} {
5340 lappend ids [list [ordertoken $p] $p]
5341 }
5342 }
5343 }
5344 set id [lindex $displayorder $row]
5345 lappend ids [list [ordertoken $id] $id]
5346 while {$r < $rb} {
5347 foreach p [lindex $parentlist $r] {
5348 set firstkid [lindex $children($curview,$p) 0]
5349 if {[rowofcommit $firstkid] < $row} {
5350 lappend ids [list [ordertoken $p] $p]
5351 }
5352 }
5353 incr r
5354 set id [lindex $displayorder $r]
5355 if {$id ne {}} {
5356 set firstkid [lindex $children($curview,$id) 0]
5357 if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5358 lappend ids [list [ordertoken $id] $id]
5359 }
5360 }
5361 }
5362 set idlist {}
5363 foreach idx [lsort -unique $ids] {
5364 lappend idlist [lindex $idx 1]
5365 }
5366 return $idlist
5367}
5368
5369proc rowsequal {a b} {
5370 while {[set i [lsearch -exact $a {}]] >= 0} {
5371 set a [lreplace $a $i $i]
5372 }
5373 while {[set i [lsearch -exact $b {}]] >= 0} {
5374 set b [lreplace $b $i $i]
5375 }
5376 return [expr {$a eq $b}]
5377}
5378
5379proc makeupline {id row rend col} {
5380 global rowidlist uparrowlen downarrowlen mingaplen
5381
5382 for {set r $rend} {1} {set r $rstart} {
5383 set rstart [prevuse $id $r]
5384 if {$rstart < 0} return
5385 if {$rstart < $row} break
5386 }
5387 if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5388 set rstart [expr {$rend - $uparrowlen - 1}]
5389 }
5390 for {set r $rstart} {[incr r] <= $row} {} {
5391 set idlist [lindex $rowidlist $r]
5392 if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5393 set col [idcol $idlist $id $col]
5394 lset rowidlist $r [linsert $idlist $col $id]
5395 changedrow $r
5396 }
5397 }
5398}
5399
5400proc layoutrows {row endrow} {
5401 global rowidlist rowisopt rowfinal displayorder
5402 global uparrowlen downarrowlen maxwidth mingaplen
5403 global children parentlist
5404 global commitidx viewcomplete curview
5405
5406 make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5407 set idlist {}
5408 if {$row > 0} {
5409 set rm1 [expr {$row - 1}]
5410 foreach id [lindex $rowidlist $rm1] {
5411 if {$id ne {}} {
5412 lappend idlist $id
5413 }
5414 }
5415 set final [lindex $rowfinal $rm1]
5416 }
5417 for {} {$row < $endrow} {incr row} {
5418 set rm1 [expr {$row - 1}]
5419 if {$rm1 < 0 || $idlist eq {}} {
5420 set idlist [make_idlist $row]
5421 set final 1
5422 } else {
5423 set id [lindex $displayorder $rm1]
5424 set col [lsearch -exact $idlist $id]
5425 set idlist [lreplace $idlist $col $col]
5426 foreach p [lindex $parentlist $rm1] {
5427 if {[lsearch -exact $idlist $p] < 0} {
5428 set col [idcol $idlist $p $col]
5429 set idlist [linsert $idlist $col $p]
5430 # if not the first child, we have to insert a line going up
5431 if {$id ne [lindex $children($curview,$p) 0]} {
5432 makeupline $p $rm1 $row $col
5433 }
5434 }
5435 }
5436 set id [lindex $displayorder $row]
5437 if {$row > $downarrowlen} {
5438 set termrow [expr {$row - $downarrowlen - 1}]
5439 foreach p [lindex $parentlist $termrow] {
5440 set i [lsearch -exact $idlist $p]
5441 if {$i < 0} continue
5442 set nr [nextuse $p $termrow]
5443 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5444 set idlist [lreplace $idlist $i $i]
5445 }
5446 }
5447 }
5448 set col [lsearch -exact $idlist $id]
5449 if {$col < 0} {
5450 set col [idcol $idlist $id]
5451 set idlist [linsert $idlist $col $id]
5452 if {$children($curview,$id) ne {}} {
5453 makeupline $id $rm1 $row $col
5454 }
5455 }
5456 set r [expr {$row + $uparrowlen - 1}]
5457 if {$r < $commitidx($curview)} {
5458 set x $col
5459 foreach p [lindex $parentlist $r] {
5460 if {[lsearch -exact $idlist $p] >= 0} continue
5461 set fk [lindex $children($curview,$p) 0]
5462 if {[rowofcommit $fk] < $row} {
5463 set x [idcol $idlist $p $x]
5464 set idlist [linsert $idlist $x $p]
5465 }
5466 }
5467 if {[incr r] < $commitidx($curview)} {
5468 set p [lindex $displayorder $r]
5469 if {[lsearch -exact $idlist $p] < 0} {
5470 set fk [lindex $children($curview,$p) 0]
5471 if {$fk ne {} && [rowofcommit $fk] < $row} {
5472 set x [idcol $idlist $p $x]
5473 set idlist [linsert $idlist $x $p]
5474 }
5475 }
5476 }
5477 }
5478 }
5479 if {$final && !$viewcomplete($curview) &&
5480 $row + $uparrowlen + $mingaplen + $downarrowlen
5481 >= $commitidx($curview)} {
5482 set final 0
5483 }
5484 set l [llength $rowidlist]
5485 if {$row == $l} {
5486 lappend rowidlist $idlist
5487 lappend rowisopt 0
5488 lappend rowfinal $final
5489 } elseif {$row < $l} {
5490 if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5491 lset rowidlist $row $idlist
5492 changedrow $row
5493 }
5494 lset rowfinal $row $final
5495 } else {
5496 set pad [ntimes [expr {$row - $l}] {}]
5497 set rowidlist [concat $rowidlist $pad]
5498 lappend rowidlist $idlist
5499 set rowfinal [concat $rowfinal $pad]
5500 lappend rowfinal $final
5501 set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5502 }
5503 }
5504 return $row
5505}
5506
5507proc changedrow {row} {
5508 global displayorder iddrawn rowisopt need_redisplay
5509
5510 set l [llength $rowisopt]
5511 if {$row < $l} {
5512 lset rowisopt $row 0
5513 if {$row + 1 < $l} {
5514 lset rowisopt [expr {$row + 1}] 0
5515 if {$row + 2 < $l} {
5516 lset rowisopt [expr {$row + 2}] 0
5517 }
5518 }
5519 }
5520 set id [lindex $displayorder $row]
5521 if {[info exists iddrawn($id)]} {
5522 set need_redisplay 1
5523 }
5524}
5525
5526proc insert_pad {row col npad} {
5527 global rowidlist
5528
5529 set pad [ntimes $npad {}]
5530 set idlist [lindex $rowidlist $row]
5531 set bef [lrange $idlist 0 [expr {$col - 1}]]
5532 set aft [lrange $idlist $col end]
5533 set i [lsearch -exact $aft {}]
5534 if {$i > 0} {
5535 set aft [lreplace $aft $i $i]
5536 }
5537 lset rowidlist $row [concat $bef $pad $aft]
5538 changedrow $row
5539}
5540
5541proc optimize_rows {row col endrow} {
5542 global rowidlist rowisopt displayorder curview children
5543
5544 if {$row < 1} {
5545 set row 1
5546 }
5547 for {} {$row < $endrow} {incr row; set col 0} {
5548 if {[lindex $rowisopt $row]} continue
5549 set haspad 0
5550 set y0 [expr {$row - 1}]
5551 set ym [expr {$row - 2}]
5552 set idlist [lindex $rowidlist $row]
5553 set previdlist [lindex $rowidlist $y0]
5554 if {$idlist eq {} || $previdlist eq {}} continue
5555 if {$ym >= 0} {
5556 set pprevidlist [lindex $rowidlist $ym]
5557 if {$pprevidlist eq {}} continue
5558 } else {
5559 set pprevidlist {}
5560 }
5561 set x0 -1
5562 set xm -1
5563 for {} {$col < [llength $idlist]} {incr col} {
5564 set id [lindex $idlist $col]
5565 if {[lindex $previdlist $col] eq $id} continue
5566 if {$id eq {}} {
5567 set haspad 1
5568 continue
5569 }
5570 set x0 [lsearch -exact $previdlist $id]
5571 if {$x0 < 0} continue
5572 set z [expr {$x0 - $col}]
5573 set isarrow 0
5574 set z0 {}
5575 if {$ym >= 0} {
5576 set xm [lsearch -exact $pprevidlist $id]
5577 if {$xm >= 0} {
5578 set z0 [expr {$xm - $x0}]
5579 }
5580 }
5581 if {$z0 eq {}} {
5582 # if row y0 is the first child of $id then it's not an arrow
5583 if {[lindex $children($curview,$id) 0] ne
5584 [lindex $displayorder $y0]} {
5585 set isarrow 1
5586 }
5587 }
5588 if {!$isarrow && $id ne [lindex $displayorder $row] &&
5589 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5590 set isarrow 1
5591 }
5592 # Looking at lines from this row to the previous row,
5593 # make them go straight up if they end in an arrow on
5594 # the previous row; otherwise make them go straight up
5595 # or at 45 degrees.
5596 if {$z < -1 || ($z < 0 && $isarrow)} {
5597 # Line currently goes left too much;
5598 # insert pads in the previous row, then optimize it
5599 set npad [expr {-1 - $z + $isarrow}]
5600 insert_pad $y0 $x0 $npad
5601 if {$y0 > 0} {
5602 optimize_rows $y0 $x0 $row
5603 }
5604 set previdlist [lindex $rowidlist $y0]
5605 set x0 [lsearch -exact $previdlist $id]
5606 set z [expr {$x0 - $col}]
5607 if {$z0 ne {}} {
5608 set pprevidlist [lindex $rowidlist $ym]
5609 set xm [lsearch -exact $pprevidlist $id]
5610 set z0 [expr {$xm - $x0}]
5611 }
5612 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5613 # Line currently goes right too much;
5614 # insert pads in this line
5615 set npad [expr {$z - 1 + $isarrow}]
5616 insert_pad $row $col $npad
5617 set idlist [lindex $rowidlist $row]
5618 incr col $npad
5619 set z [expr {$x0 - $col}]
5620 set haspad 1
5621 }
5622 if {$z0 eq {} && !$isarrow && $ym >= 0} {
5623 # this line links to its first child on row $row-2
5624 set id [lindex $displayorder $ym]
5625 set xc [lsearch -exact $pprevidlist $id]
5626 if {$xc >= 0} {
5627 set z0 [expr {$xc - $x0}]
5628 }
5629 }
5630 # avoid lines jigging left then immediately right
5631 if {$z0 ne {} && $z < 0 && $z0 > 0} {
5632 insert_pad $y0 $x0 1
5633 incr x0
5634 optimize_rows $y0 $x0 $row
5635 set previdlist [lindex $rowidlist $y0]
5636 }
5637 }
5638 if {!$haspad} {
5639 # Find the first column that doesn't have a line going right
5640 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5641 set id [lindex $idlist $col]
5642 if {$id eq {}} break
5643 set x0 [lsearch -exact $previdlist $id]
5644 if {$x0 < 0} {
5645 # check if this is the link to the first child
5646 set kid [lindex $displayorder $y0]
5647 if {[lindex $children($curview,$id) 0] eq $kid} {
5648 # it is, work out offset to child
5649 set x0 [lsearch -exact $previdlist $kid]
5650 }
5651 }
5652 if {$x0 <= $col} break
5653 }
5654 # Insert a pad at that column as long as it has a line and
5655 # isn't the last column
5656 if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5657 set idlist [linsert $idlist $col {}]
5658 lset rowidlist $row $idlist
5659 changedrow $row
5660 }
5661 }
5662 }
5663}
5664
5665proc xc {row col} {
5666 global canvx0 linespc
5667 return [expr {$canvx0 + $col * $linespc}]
5668}
5669
5670proc yc {row} {
5671 global canvy0 linespc
5672 return [expr {$canvy0 + $row * $linespc}]
5673}
5674
5675proc linewidth {id} {
5676 global thickerline lthickness
5677
5678 set wid $lthickness
5679 if {[info exists thickerline] && $id eq $thickerline} {
5680 set wid [expr {2 * $lthickness}]
5681 }
5682 return $wid
5683}
5684
5685proc rowranges {id} {
5686 global curview children uparrowlen downarrowlen
5687 global rowidlist
5688
5689 set kids $children($curview,$id)
5690 if {$kids eq {}} {
5691 return {}
5692 }
5693 set ret {}
5694 lappend kids $id
5695 foreach child $kids {
5696 if {![commitinview $child $curview]} break
5697 set row [rowofcommit $child]
5698 if {![info exists prev]} {
5699 lappend ret [expr {$row + 1}]
5700 } else {
5701 if {$row <= $prevrow} {
5702 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5703 }
5704 # see if the line extends the whole way from prevrow to row
5705 if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5706 [lsearch -exact [lindex $rowidlist \
5707 [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5708 # it doesn't, see where it ends
5709 set r [expr {$prevrow + $downarrowlen}]
5710 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5711 while {[incr r -1] > $prevrow &&
5712 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5713 } else {
5714 while {[incr r] <= $row &&
5715 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5716 incr r -1
5717 }
5718 lappend ret $r
5719 # see where it starts up again
5720 set r [expr {$row - $uparrowlen}]
5721 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5722 while {[incr r] < $row &&
5723 [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5724 } else {
5725 while {[incr r -1] >= $prevrow &&
5726 [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5727 incr r
5728 }
5729 lappend ret $r
5730 }
5731 }
5732 if {$child eq $id} {
5733 lappend ret $row
5734 }
5735 set prev $child
5736 set prevrow $row
5737 }
5738 return $ret
5739}
5740
5741proc drawlineseg {id row endrow arrowlow} {
5742 global rowidlist displayorder iddrawn linesegs
5743 global canv colormap linespc curview maxlinelen parentlist
5744
5745 set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5746 set le [expr {$row + 1}]
5747 set arrowhigh 1
5748 while {1} {
5749 set c [lsearch -exact [lindex $rowidlist $le] $id]
5750 if {$c < 0} {
5751 incr le -1
5752 break
5753 }
5754 lappend cols $c
5755 set x [lindex $displayorder $le]
5756 if {$x eq $id} {
5757 set arrowhigh 0
5758 break
5759 }
5760 if {[info exists iddrawn($x)] || $le == $endrow} {
5761 set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5762 if {$c >= 0} {
5763 lappend cols $c
5764 set arrowhigh 0
5765 }
5766 break
5767 }
5768 incr le
5769 }
5770 if {$le <= $row} {
5771 return $row
5772 }
5773
5774 set lines {}
5775 set i 0
5776 set joinhigh 0
5777 if {[info exists linesegs($id)]} {
5778 set lines $linesegs($id)
5779 foreach li $lines {
5780 set r0 [lindex $li 0]
5781 if {$r0 > $row} {
5782 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5783 set joinhigh 1
5784 }
5785 break
5786 }
5787 incr i
5788 }
5789 }
5790 set joinlow 0
5791 if {$i > 0} {
5792 set li [lindex $lines [expr {$i-1}]]
5793 set r1 [lindex $li 1]
5794 if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5795 set joinlow 1
5796 }
5797 }
5798
5799 set x [lindex $cols [expr {$le - $row}]]
5800 set xp [lindex $cols [expr {$le - 1 - $row}]]
5801 set dir [expr {$xp - $x}]
5802 if {$joinhigh} {
5803 set ith [lindex $lines $i 2]
5804 set coords [$canv coords $ith]
5805 set ah [$canv itemcget $ith -arrow]
5806 set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5807 set x2 [lindex $cols [expr {$le + 1 - $row}]]
5808 if {$x2 ne {} && $x - $x2 == $dir} {
5809 set coords [lrange $coords 0 end-2]
5810 }
5811 } else {
5812 set coords [list [xc $le $x] [yc $le]]
5813 }
5814 if {$joinlow} {
5815 set itl [lindex $lines [expr {$i-1}] 2]
5816 set al [$canv itemcget $itl -arrow]
5817 set arrowlow [expr {$al eq "last" || $al eq "both"}]
5818 } elseif {$arrowlow} {
5819 if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5820 [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5821 set arrowlow 0
5822 }
5823 }
5824 set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5825 for {set y $le} {[incr y -1] > $row} {} {
5826 set x $xp
5827 set xp [lindex $cols [expr {$y - 1 - $row}]]
5828 set ndir [expr {$xp - $x}]
5829 if {$dir != $ndir || $xp < 0} {
5830 lappend coords [xc $y $x] [yc $y]
5831 }
5832 set dir $ndir
5833 }
5834 if {!$joinlow} {
5835 if {$xp < 0} {
5836 # join parent line to first child
5837 set ch [lindex $displayorder $row]
5838 set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5839 if {$xc < 0} {
5840 puts "oops: drawlineseg: child $ch not on row $row"
5841 } elseif {$xc != $x} {
5842 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5843 set d [expr {int(0.5 * $linespc)}]
5844 set x1 [xc $row $x]
5845 if {$xc < $x} {
5846 set x2 [expr {$x1 - $d}]
5847 } else {
5848 set x2 [expr {$x1 + $d}]
5849 }
5850 set y2 [yc $row]
5851 set y1 [expr {$y2 + $d}]
5852 lappend coords $x1 $y1 $x2 $y2
5853 } elseif {$xc < $x - 1} {
5854 lappend coords [xc $row [expr {$x-1}]] [yc $row]
5855 } elseif {$xc > $x + 1} {
5856 lappend coords [xc $row [expr {$x+1}]] [yc $row]
5857 }
5858 set x $xc
5859 }
5860 lappend coords [xc $row $x] [yc $row]
5861 } else {
5862 set xn [xc $row $xp]
5863 set yn [yc $row]
5864 lappend coords $xn $yn
5865 }
5866 if {!$joinhigh} {
5867 assigncolor $id
5868 set t [$canv create line $coords -width [linewidth $id] \
5869 -fill $colormap($id) -tags lines.$id -arrow $arrow]
5870 $canv lower $t
5871 bindline $t $id
5872 set lines [linsert $lines $i [list $row $le $t]]
5873 } else {
5874 $canv coords $ith $coords
5875 if {$arrow ne $ah} {
5876 $canv itemconf $ith -arrow $arrow
5877 }
5878 lset lines $i 0 $row
5879 }
5880 } else {
5881 set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5882 set ndir [expr {$xo - $xp}]
5883 set clow [$canv coords $itl]
5884 if {$dir == $ndir} {
5885 set clow [lrange $clow 2 end]
5886 }
5887 set coords [concat $coords $clow]
5888 if {!$joinhigh} {
5889 lset lines [expr {$i-1}] 1 $le
5890 } else {
5891 # coalesce two pieces
5892 $canv delete $ith
5893 set b [lindex $lines [expr {$i-1}] 0]
5894 set e [lindex $lines $i 1]
5895 set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5896 }
5897 $canv coords $itl $coords
5898 if {$arrow ne $al} {
5899 $canv itemconf $itl -arrow $arrow
5900 }
5901 }
5902
5903 set linesegs($id) $lines
5904 return $le
5905}
5906
5907proc drawparentlinks {id row} {
5908 global rowidlist canv colormap curview parentlist
5909 global idpos linespc
5910
5911 set rowids [lindex $rowidlist $row]
5912 set col [lsearch -exact $rowids $id]
5913 if {$col < 0} return
5914 set olds [lindex $parentlist $row]
5915 set row2 [expr {$row + 1}]
5916 set x [xc $row $col]
5917 set y [yc $row]
5918 set y2 [yc $row2]
5919 set d [expr {int(0.5 * $linespc)}]
5920 set ymid [expr {$y + $d}]
5921 set ids [lindex $rowidlist $row2]
5922 # rmx = right-most X coord used
5923 set rmx 0
5924 foreach p $olds {
5925 set i [lsearch -exact $ids $p]
5926 if {$i < 0} {
5927 puts "oops, parent $p of $id not in list"
5928 continue
5929 }
5930 set x2 [xc $row2 $i]
5931 if {$x2 > $rmx} {
5932 set rmx $x2
5933 }
5934 set j [lsearch -exact $rowids $p]
5935 if {$j < 0} {
5936 # drawlineseg will do this one for us
5937 continue
5938 }
5939 assigncolor $p
5940 # should handle duplicated parents here...
5941 set coords [list $x $y]
5942 if {$i != $col} {
5943 # if attaching to a vertical segment, draw a smaller
5944 # slant for visual distinctness
5945 if {$i == $j} {
5946 if {$i < $col} {
5947 lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5948 } else {
5949 lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5950 }
5951 } elseif {$i < $col && $i < $j} {
5952 # segment slants towards us already
5953 lappend coords [xc $row $j] $y
5954 } else {
5955 if {$i < $col - 1} {
5956 lappend coords [expr {$x2 + $linespc}] $y
5957 } elseif {$i > $col + 1} {
5958 lappend coords [expr {$x2 - $linespc}] $y
5959 }
5960 lappend coords $x2 $y2
5961 }
5962 } else {
5963 lappend coords $x2 $y2
5964 }
5965 set t [$canv create line $coords -width [linewidth $p] \
5966 -fill $colormap($p) -tags lines.$p]
5967 $canv lower $t
5968 bindline $t $p
5969 }
5970 if {$rmx > [lindex $idpos($id) 1]} {
5971 lset idpos($id) 1 $rmx
5972 redrawtags $id
5973 }
5974}
5975
5976proc drawlines {id} {
5977 global canv
5978
5979 $canv itemconf lines.$id -width [linewidth $id]
5980}
5981
5982proc drawcmittext {id row col} {
5983 global linespc canv canv2 canv3 fgcolor curview
5984 global cmitlisted commitinfo rowidlist parentlist
5985 global rowtextx idpos idtags idheads idotherrefs
5986 global linehtag linentag linedtag selectedline
5987 global canvxmax boldids boldnameids fgcolor markedid
5988 global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5989 global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5990 global circleoutlinecolor
5991
5992 # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5993 set listed $cmitlisted($curview,$id)
5994 if {$id eq $nullid} {
5995 set ofill $workingfilescirclecolor
5996 } elseif {$id eq $nullid2} {
5997 set ofill $indexcirclecolor
5998 } elseif {$id eq $mainheadid} {
5999 set ofill $mainheadcirclecolor
6000 } else {
6001 set ofill [lindex $circlecolors $listed]
6002 }
6003 set x [xc $row $col]
6004 set y [yc $row]
6005 set orad [expr {$linespc / 3}]
6006 if {$listed <= 2} {
6007 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6008 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6009 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6010 } elseif {$listed == 3} {
6011 # triangle pointing left for left-side commits
6012 set t [$canv create polygon \
6013 [expr {$x - $orad}] $y \
6014 [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6015 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6016 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6017 } else {
6018 # triangle pointing right for right-side commits
6019 set t [$canv create polygon \
6020 [expr {$x + $orad - 1}] $y \
6021 [expr {$x - $orad}] [expr {$y - $orad}] \
6022 [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6023 -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6024 }
6025 set circleitem($row) $t
6026 $canv raise $t
6027 $canv bind $t <1> {selcanvline {} %x %y}
6028 set rmx [llength [lindex $rowidlist $row]]
6029 set olds [lindex $parentlist $row]
6030 if {$olds ne {}} {
6031 set nextids [lindex $rowidlist [expr {$row + 1}]]
6032 foreach p $olds {
6033 set i [lsearch -exact $nextids $p]
6034 if {$i > $rmx} {
6035 set rmx $i
6036 }
6037 }
6038 }
6039 set xt [xc $row $rmx]
6040 set rowtextx($row) $xt
6041 set idpos($id) [list $x $xt $y]
6042 if {[info exists idtags($id)] || [info exists idheads($id)]
6043 || [info exists idotherrefs($id)]} {
6044 set xt [drawtags $id $x $xt $y]
6045 }
6046 if {[lindex $commitinfo($id) 6] > 0} {
6047 set xt [drawnotesign $xt $y]
6048 }
6049 set headline [lindex $commitinfo($id) 0]
6050 set name [lindex $commitinfo($id) 1]
6051 set date [lindex $commitinfo($id) 2]
6052 set date [formatdate $date]
6053 set font mainfont
6054 set nfont mainfont
6055 set isbold [ishighlighted $id]
6056 if {$isbold > 0} {
6057 lappend boldids $id
6058 set font mainfontbold
6059 if {$isbold > 1} {
6060 lappend boldnameids $id
6061 set nfont mainfontbold
6062 }
6063 }
6064 set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6065 -text $headline -font $font -tags text]
6066 $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6067 set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6068 -text $name -font $nfont -tags text]
6069 set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6070 -text $date -font mainfont -tags text]
6071 if {$selectedline == $row} {
6072 make_secsel $id
6073 }
6074 if {[info exists markedid] && $markedid eq $id} {
6075 make_idmark $id
6076 }
6077 set xr [expr {$xt + [font measure $font $headline]}]
6078 if {$xr > $canvxmax} {
6079 set canvxmax $xr
6080 setcanvscroll
6081 }
6082}
6083
6084proc drawcmitrow {row} {
6085 global displayorder rowidlist nrows_drawn
6086 global iddrawn markingmatches
6087 global commitinfo numcommits
6088 global filehighlight fhighlights findpattern nhighlights
6089 global hlview vhighlights
6090 global highlight_related rhighlights
6091
6092 if {$row >= $numcommits} return
6093
6094 set id [lindex $displayorder $row]
6095 if {[info exists hlview] && ![info exists vhighlights($id)]} {
6096 askvhighlight $row $id
6097 }
6098 if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6099 askfilehighlight $row $id
6100 }
6101 if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6102 askfindhighlight $row $id
6103 }
6104 if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6105 askrelhighlight $row $id
6106 }
6107 if {![info exists iddrawn($id)]} {
6108 set col [lsearch -exact [lindex $rowidlist $row] $id]
6109 if {$col < 0} {
6110 puts "oops, row $row id $id not in list"
6111 return
6112 }
6113 if {![info exists commitinfo($id)]} {
6114 getcommit $id
6115 }
6116 assigncolor $id
6117 drawcmittext $id $row $col
6118 set iddrawn($id) 1
6119 incr nrows_drawn
6120 }
6121 if {$markingmatches} {
6122 markrowmatches $row $id
6123 }
6124}
6125
6126proc drawcommits {row {endrow {}}} {
6127 global numcommits iddrawn displayorder curview need_redisplay
6128 global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6129
6130 if {$row < 0} {
6131 set row 0
6132 }
6133 if {$endrow eq {}} {
6134 set endrow $row
6135 }
6136 if {$endrow >= $numcommits} {
6137 set endrow [expr {$numcommits - 1}]
6138 }
6139
6140 set rl1 [expr {$row - $downarrowlen - 3}]
6141 if {$rl1 < 0} {
6142 set rl1 0
6143 }
6144 set ro1 [expr {$row - 3}]
6145 if {$ro1 < 0} {
6146 set ro1 0
6147 }
6148 set r2 [expr {$endrow + $uparrowlen + 3}]
6149 if {$r2 > $numcommits} {
6150 set r2 $numcommits
6151 }
6152 for {set r $rl1} {$r < $r2} {incr r} {
6153 if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6154 if {$rl1 < $r} {
6155 layoutrows $rl1 $r
6156 }
6157 set rl1 [expr {$r + 1}]
6158 }
6159 }
6160 if {$rl1 < $r} {
6161 layoutrows $rl1 $r
6162 }
6163 optimize_rows $ro1 0 $r2
6164 if {$need_redisplay || $nrows_drawn > 2000} {
6165 clear_display
6166 }
6167
6168 # make the lines join to already-drawn rows either side
6169 set r [expr {$row - 1}]
6170 if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6171 set r $row
6172 }
6173 set er [expr {$endrow + 1}]
6174 if {$er >= $numcommits ||
6175 ![info exists iddrawn([lindex $displayorder $er])]} {
6176 set er $endrow
6177 }
6178 for {} {$r <= $er} {incr r} {
6179 set id [lindex $displayorder $r]
6180 set wasdrawn [info exists iddrawn($id)]
6181 drawcmitrow $r
6182 if {$r == $er} break
6183 set nextid [lindex $displayorder [expr {$r + 1}]]
6184 if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6185 drawparentlinks $id $r
6186
6187 set rowids [lindex $rowidlist $r]
6188 foreach lid $rowids {
6189 if {$lid eq {}} continue
6190 if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6191 if {$lid eq $id} {
6192 # see if this is the first child of any of its parents
6193 foreach p [lindex $parentlist $r] {
6194 if {[lsearch -exact $rowids $p] < 0} {
6195 # make this line extend up to the child
6196 set lineend($p) [drawlineseg $p $r $er 0]
6197 }
6198 }
6199 } else {
6200 set lineend($lid) [drawlineseg $lid $r $er 1]
6201 }
6202 }
6203 }
6204}
6205
6206proc undolayout {row} {
6207 global uparrowlen mingaplen downarrowlen
6208 global rowidlist rowisopt rowfinal need_redisplay
6209
6210 set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6211 if {$r < 0} {
6212 set r 0
6213 }
6214 if {[llength $rowidlist] > $r} {
6215 incr r -1
6216 set rowidlist [lrange $rowidlist 0 $r]
6217 set rowfinal [lrange $rowfinal 0 $r]
6218 set rowisopt [lrange $rowisopt 0 $r]
6219 set need_redisplay 1
6220 run drawvisible
6221 }
6222}
6223
6224proc drawvisible {} {
6225 global canv linespc curview vrowmod selectedline targetrow targetid
6226 global need_redisplay cscroll numcommits
6227
6228 set fs [$canv yview]
6229 set ymax [lindex [$canv cget -scrollregion] 3]
6230 if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6231 set f0 [lindex $fs 0]
6232 set f1 [lindex $fs 1]
6233 set y0 [expr {int($f0 * $ymax)}]
6234 set y1 [expr {int($f1 * $ymax)}]
6235
6236 if {[info exists targetid]} {
6237 if {[commitinview $targetid $curview]} {
6238 set r [rowofcommit $targetid]
6239 if {$r != $targetrow} {
6240 # Fix up the scrollregion and change the scrolling position
6241 # now that our target row has moved.
6242 set diff [expr {($r - $targetrow) * $linespc}]
6243 set targetrow $r
6244 setcanvscroll
6245 set ymax [lindex [$canv cget -scrollregion] 3]
6246 incr y0 $diff
6247 incr y1 $diff
6248 set f0 [expr {$y0 / $ymax}]
6249 set f1 [expr {$y1 / $ymax}]
6250 allcanvs yview moveto $f0
6251 $cscroll set $f0 $f1
6252 set need_redisplay 1
6253 }
6254 } else {
6255 unset targetid
6256 }
6257 }
6258
6259 set row [expr {int(($y0 - 3) / $linespc) - 1}]
6260 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6261 if {$endrow >= $vrowmod($curview)} {
6262 update_arcrows $curview
6263 }
6264 if {$selectedline ne {} &&
6265 $row <= $selectedline && $selectedline <= $endrow} {
6266 set targetrow $selectedline
6267 } elseif {[info exists targetid]} {
6268 set targetrow [expr {int(($row + $endrow) / 2)}]
6269 }
6270 if {[info exists targetrow]} {
6271 if {$targetrow >= $numcommits} {
6272 set targetrow [expr {$numcommits - 1}]
6273 }
6274 set targetid [commitonrow $targetrow]
6275 }
6276 drawcommits $row $endrow
6277}
6278
6279proc clear_display {} {
6280 global iddrawn linesegs need_redisplay nrows_drawn
6281 global vhighlights fhighlights nhighlights rhighlights
6282 global linehtag linentag linedtag boldids boldnameids
6283
6284 allcanvs delete all
6285 catch {unset iddrawn}
6286 catch {unset linesegs}
6287 catch {unset linehtag}
6288 catch {unset linentag}
6289 catch {unset linedtag}
6290 set boldids {}
6291 set boldnameids {}
6292 catch {unset vhighlights}
6293 catch {unset fhighlights}
6294 catch {unset nhighlights}
6295 catch {unset rhighlights}
6296 set need_redisplay 0
6297 set nrows_drawn 0
6298}
6299
6300proc findcrossings {id} {
6301 global rowidlist parentlist numcommits displayorder
6302
6303 set cross {}
6304 set ccross {}
6305 foreach {s e} [rowranges $id] {
6306 if {$e >= $numcommits} {
6307 set e [expr {$numcommits - 1}]
6308 }
6309 if {$e <= $s} continue
6310 for {set row $e} {[incr row -1] >= $s} {} {
6311 set x [lsearch -exact [lindex $rowidlist $row] $id]
6312 if {$x < 0} break
6313 set olds [lindex $parentlist $row]
6314 set kid [lindex $displayorder $row]
6315 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6316 if {$kidx < 0} continue
6317 set nextrow [lindex $rowidlist [expr {$row + 1}]]
6318 foreach p $olds {
6319 set px [lsearch -exact $nextrow $p]
6320 if {$px < 0} continue
6321 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6322 if {[lsearch -exact $ccross $p] >= 0} continue
6323 if {$x == $px + ($kidx < $px? -1: 1)} {
6324 lappend ccross $p
6325 } elseif {[lsearch -exact $cross $p] < 0} {
6326 lappend cross $p
6327 }
6328 }
6329 }
6330 }
6331 }
6332 return [concat $ccross {{}} $cross]
6333}
6334
6335proc assigncolor {id} {
6336 global colormap colors nextcolor
6337 global parents children children curview
6338
6339 if {[info exists colormap($id)]} return
6340 set ncolors [llength $colors]
6341 if {[info exists children($curview,$id)]} {
6342 set kids $children($curview,$id)
6343 } else {
6344 set kids {}
6345 }
6346 if {[llength $kids] == 1} {
6347 set child [lindex $kids 0]
6348 if {[info exists colormap($child)]
6349 && [llength $parents($curview,$child)] == 1} {
6350 set colormap($id) $colormap($child)
6351 return
6352 }
6353 }
6354 set badcolors {}
6355 set origbad {}
6356 foreach x [findcrossings $id] {
6357 if {$x eq {}} {
6358 # delimiter between corner crossings and other crossings
6359 if {[llength $badcolors] >= $ncolors - 1} break
6360 set origbad $badcolors
6361 }
6362 if {[info exists colormap($x)]
6363 && [lsearch -exact $badcolors $colormap($x)] < 0} {
6364 lappend badcolors $colormap($x)
6365 }
6366 }
6367 if {[llength $badcolors] >= $ncolors} {
6368 set badcolors $origbad
6369 }
6370 set origbad $badcolors
6371 if {[llength $badcolors] < $ncolors - 1} {
6372 foreach child $kids {
6373 if {[info exists colormap($child)]
6374 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6375 lappend badcolors $colormap($child)
6376 }
6377 foreach p $parents($curview,$child) {
6378 if {[info exists colormap($p)]
6379 && [lsearch -exact $badcolors $colormap($p)] < 0} {
6380 lappend badcolors $colormap($p)
6381 }
6382 }
6383 }
6384 if {[llength $badcolors] >= $ncolors} {
6385 set badcolors $origbad
6386 }
6387 }
6388 for {set i 0} {$i <= $ncolors} {incr i} {
6389 set c [lindex $colors $nextcolor]
6390 if {[incr nextcolor] >= $ncolors} {
6391 set nextcolor 0
6392 }
6393 if {[lsearch -exact $badcolors $c]} break
6394 }
6395 set colormap($id) $c
6396}
6397
6398proc bindline {t id} {
6399 global canv
6400
6401 $canv bind $t <Enter> "lineenter %x %y $id"
6402 $canv bind $t <Motion> "linemotion %x %y $id"
6403 $canv bind $t <Leave> "lineleave $id"
6404 $canv bind $t <Button-1> "lineclick %x %y $id 1"
6405}
6406
6407proc graph_pane_width {} {
6408 global use_ttk
6409
6410 if {$use_ttk} {
6411 set g [.tf.histframe.pwclist sashpos 0]
6412 } else {
6413 set g [.tf.histframe.pwclist sash coord 0]
6414 }
6415 return [lindex $g 0]
6416}
6417
6418proc totalwidth {l font extra} {
6419 set tot 0
6420 foreach str $l {
6421 set tot [expr {$tot + [font measure $font $str] + $extra}]
6422 }
6423 return $tot
6424}
6425
6426proc drawtags {id x xt y1} {
6427 global idtags idheads idotherrefs mainhead
6428 global linespc lthickness
6429 global canv rowtextx curview fgcolor bgcolor ctxbut
6430 global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6431 global tagbgcolor tagfgcolor tagoutlinecolor
6432 global reflinecolor
6433
6434 set marks {}
6435 set ntags 0
6436 set nheads 0
6437 set singletag 0
6438 set maxtags 3
6439 set maxtagpct 25
6440 set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6441 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6442 set extra [expr {$delta + $lthickness + $linespc}]
6443
6444 if {[info exists idtags($id)]} {
6445 set marks $idtags($id)
6446 set ntags [llength $marks]
6447 if {$ntags > $maxtags ||
6448 [totalwidth $marks mainfont $extra] > $maxwidth} {
6449 # show just a single "n tags..." tag
6450 set singletag 1
6451 if {$ntags == 1} {
6452 set marks [list "tag..."]
6453 } else {
6454 set marks [list [format "%d tags..." $ntags]]
6455 }
6456 set ntags 1
6457 }
6458 }
6459 if {[info exists idheads($id)]} {
6460 set marks [concat $marks $idheads($id)]
6461 set nheads [llength $idheads($id)]
6462 }
6463 if {[info exists idotherrefs($id)]} {
6464 set marks [concat $marks $idotherrefs($id)]
6465 }
6466 if {$marks eq {}} {
6467 return $xt
6468 }
6469
6470 set yt [expr {$y1 - 0.5 * $linespc}]
6471 set yb [expr {$yt + $linespc - 1}]
6472 set xvals {}
6473 set wvals {}
6474 set i -1
6475 foreach tag $marks {
6476 incr i
6477 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6478 set wid [font measure mainfontbold $tag]
6479 } else {
6480 set wid [font measure mainfont $tag]
6481 }
6482 lappend xvals $xt
6483 lappend wvals $wid
6484 set xt [expr {$xt + $wid + $extra}]
6485 }
6486 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6487 -width $lthickness -fill $reflinecolor -tags tag.$id]
6488 $canv lower $t
6489 foreach tag $marks x $xvals wid $wvals {
6490 set tag_quoted [string map {% %%} $tag]
6491 set xl [expr {$x + $delta}]
6492 set xr [expr {$x + $delta + $wid + $lthickness}]
6493 set font mainfont
6494 if {[incr ntags -1] >= 0} {
6495 # draw a tag
6496 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6497 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6498 -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6499 -tags tag.$id]
6500 if {$singletag} {
6501 set tagclick [list showtags $id 1]
6502 } else {
6503 set tagclick [list showtag $tag_quoted 1]
6504 }
6505 $canv bind $t <1> $tagclick
6506 set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6507 } else {
6508 # draw a head or other ref
6509 if {[incr nheads -1] >= 0} {
6510 set col $headbgcolor
6511 if {$tag eq $mainhead} {
6512 set font mainfontbold
6513 }
6514 } else {
6515 set col "#ddddff"
6516 }
6517 set xl [expr {$xl - $delta/2}]
6518 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6519 -width 1 -outline black -fill $col -tags tag.$id
6520 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6521 set rwid [font measure mainfont $remoteprefix]
6522 set xi [expr {$x + 1}]
6523 set yti [expr {$yt + 1}]
6524 set xri [expr {$x + $rwid}]
6525 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6526 -width 0 -fill $remotebgcolor -tags tag.$id
6527 }
6528 }
6529 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6530 -font $font -tags [list tag.$id text]]
6531 if {$ntags >= 0} {
6532 $canv bind $t <1> $tagclick
6533 } elseif {$nheads >= 0} {
6534 $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6535 }
6536 }
6537 return $xt
6538}
6539
6540proc drawnotesign {xt y} {
6541 global linespc canv fgcolor
6542
6543 set orad [expr {$linespc / 3}]
6544 set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6545 [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6546 -fill yellow -outline $fgcolor -width 1 -tags circle]
6547 set xt [expr {$xt + $orad * 3}]
6548 return $xt
6549}
6550
6551proc xcoord {i level ln} {
6552 global canvx0 xspc1 xspc2
6553
6554 set x [expr {$canvx0 + $i * $xspc1($ln)}]
6555 if {$i > 0 && $i == $level} {
6556 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6557 } elseif {$i > $level} {
6558 set x [expr {$x + $xspc2 - $xspc1($ln)}]
6559 }
6560 return $x
6561}
6562
6563proc show_status {msg} {
6564 global canv fgcolor
6565
6566 clear_display
6567 $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6568 -tags text -fill $fgcolor
6569}
6570
6571# Don't change the text pane cursor if it is currently the hand cursor,
6572# showing that we are over a sha1 ID link.
6573proc settextcursor {c} {
6574 global ctext curtextcursor
6575
6576 if {[$ctext cget -cursor] == $curtextcursor} {
6577 $ctext config -cursor $c
6578 }
6579 set curtextcursor $c
6580}
6581
6582proc nowbusy {what {name {}}} {
6583 global isbusy busyname statusw
6584
6585 if {[array names isbusy] eq {}} {
6586 . config -cursor watch
6587 settextcursor watch
6588 }
6589 set isbusy($what) 1
6590 set busyname($what) $name
6591 if {$name ne {}} {
6592 $statusw conf -text $name
6593 }
6594}
6595
6596proc notbusy {what} {
6597 global isbusy maincursor textcursor busyname statusw
6598
6599 catch {
6600 unset isbusy($what)
6601 if {$busyname($what) ne {} &&
6602 [$statusw cget -text] eq $busyname($what)} {
6603 $statusw conf -text {}
6604 }
6605 }
6606 if {[array names isbusy] eq {}} {
6607 . config -cursor $maincursor
6608 settextcursor $textcursor
6609 }
6610}
6611
6612proc findmatches {f} {
6613 global findtype findstring
6614 if {$findtype == [mc "Regexp"]} {
6615 set matches [regexp -indices -all -inline $findstring $f]
6616 } else {
6617 set fs $findstring
6618 if {$findtype == [mc "IgnCase"]} {
6619 set f [string tolower $f]
6620 set fs [string tolower $fs]
6621 }
6622 set matches {}
6623 set i 0
6624 set l [string length $fs]
6625 while {[set j [string first $fs $f $i]] >= 0} {
6626 lappend matches [list $j [expr {$j+$l-1}]]
6627 set i [expr {$j + $l}]
6628 }
6629 }
6630 return $matches
6631}
6632
6633proc dofind {{dirn 1} {wrap 1}} {
6634 global findstring findstartline findcurline selectedline numcommits
6635 global gdttype filehighlight fh_serial find_dirn findallowwrap
6636
6637 if {[info exists find_dirn]} {
6638 if {$find_dirn == $dirn} return
6639 stopfinding
6640 }
6641 focus .
6642 if {$findstring eq {} || $numcommits == 0} return
6643 if {$selectedline eq {}} {
6644 set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6645 } else {
6646 set findstartline $selectedline
6647 }
6648 set findcurline $findstartline
6649 nowbusy finding [mc "Searching"]
6650 if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6651 after cancel do_file_hl $fh_serial
6652 do_file_hl $fh_serial
6653 }
6654 set find_dirn $dirn
6655 set findallowwrap $wrap
6656 run findmore
6657}
6658
6659proc stopfinding {} {
6660 global find_dirn findcurline fprogcoord
6661
6662 if {[info exists find_dirn]} {
6663 unset find_dirn
6664 unset findcurline
6665 notbusy finding
6666 set fprogcoord 0
6667 adjustprogress
6668 }
6669 stopblaming
6670}
6671
6672proc findmore {} {
6673 global commitdata commitinfo numcommits findpattern findloc
6674 global findstartline findcurline findallowwrap
6675 global find_dirn gdttype fhighlights fprogcoord
6676 global curview varcorder vrownum varccommits vrowmod
6677
6678 if {![info exists find_dirn]} {
6679 return 0
6680 }
6681 set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6682 set l $findcurline
6683 set moretodo 0
6684 if {$find_dirn > 0} {
6685 incr l
6686 if {$l >= $numcommits} {
6687 set l 0
6688 }
6689 if {$l <= $findstartline} {
6690 set lim [expr {$findstartline + 1}]
6691 } else {
6692 set lim $numcommits
6693 set moretodo $findallowwrap
6694 }
6695 } else {
6696 if {$l == 0} {
6697 set l $numcommits
6698 }
6699 incr l -1
6700 if {$l >= $findstartline} {
6701 set lim [expr {$findstartline - 1}]
6702 } else {
6703 set lim -1
6704 set moretodo $findallowwrap
6705 }
6706 }
6707 set n [expr {($lim - $l) * $find_dirn}]
6708 if {$n > 500} {
6709 set n 500
6710 set moretodo 1
6711 }
6712 if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6713 update_arcrows $curview
6714 }
6715 set found 0
6716 set domore 1
6717 set ai [bsearch $vrownum($curview) $l]
6718 set a [lindex $varcorder($curview) $ai]
6719 set arow [lindex $vrownum($curview) $ai]
6720 set ids [lindex $varccommits($curview,$a)]
6721 set arowend [expr {$arow + [llength $ids]}]
6722 if {$gdttype eq [mc "containing:"]} {
6723 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6724 if {$l < $arow || $l >= $arowend} {
6725 incr ai $find_dirn
6726 set a [lindex $varcorder($curview) $ai]
6727 set arow [lindex $vrownum($curview) $ai]
6728 set ids [lindex $varccommits($curview,$a)]
6729 set arowend [expr {$arow + [llength $ids]}]
6730 }
6731 set id [lindex $ids [expr {$l - $arow}]]
6732 # shouldn't happen unless git log doesn't give all the commits...
6733 if {![info exists commitdata($id)] ||
6734 ![doesmatch $commitdata($id)]} {
6735 continue
6736 }
6737 if {![info exists commitinfo($id)]} {
6738 getcommit $id
6739 }
6740 set info $commitinfo($id)
6741 foreach f $info ty $fldtypes {
6742 if {$ty eq ""} continue
6743 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6744 [doesmatch $f]} {
6745 set found 1
6746 break
6747 }
6748 }
6749 if {$found} break
6750 }
6751 } else {
6752 for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6753 if {$l < $arow || $l >= $arowend} {
6754 incr ai $find_dirn
6755 set a [lindex $varcorder($curview) $ai]
6756 set arow [lindex $vrownum($curview) $ai]
6757 set ids [lindex $varccommits($curview,$a)]
6758 set arowend [expr {$arow + [llength $ids]}]
6759 }
6760 set id [lindex $ids [expr {$l - $arow}]]
6761 if {![info exists fhighlights($id)]} {
6762 # this sets fhighlights($id) to -1
6763 askfilehighlight $l $id
6764 }
6765 if {$fhighlights($id) > 0} {
6766 set found $domore
6767 break
6768 }
6769 if {$fhighlights($id) < 0} {
6770 if {$domore} {
6771 set domore 0
6772 set findcurline [expr {$l - $find_dirn}]
6773 }
6774 }
6775 }
6776 }
6777 if {$found || ($domore && !$moretodo)} {
6778 unset findcurline
6779 unset find_dirn
6780 notbusy finding
6781 set fprogcoord 0
6782 adjustprogress
6783 if {$found} {
6784 findselectline $l
6785 } else {
6786 bell
6787 }
6788 return 0
6789 }
6790 if {!$domore} {
6791 flushhighlights
6792 } else {
6793 set findcurline [expr {$l - $find_dirn}]
6794 }
6795 set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6796 if {$n < 0} {
6797 incr n $numcommits
6798 }
6799 set fprogcoord [expr {$n * 1.0 / $numcommits}]
6800 adjustprogress
6801 return $domore
6802}
6803
6804proc findselectline {l} {
6805 global findloc commentend ctext findcurline markingmatches gdttype
6806
6807 set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6808 set findcurline $l
6809 selectline $l 1
6810 if {$markingmatches &&
6811 ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6812 # highlight the matches in the comments
6813 set f [$ctext get 1.0 $commentend]
6814 set matches [findmatches $f]
6815 foreach match $matches {
6816 set start [lindex $match 0]
6817 set end [expr {[lindex $match 1] + 1}]
6818 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6819 }
6820 }
6821 drawvisible
6822}
6823
6824# mark the bits of a headline or author that match a find string
6825proc markmatches {canv l str tag matches font row} {
6826 global selectedline
6827
6828 set bbox [$canv bbox $tag]
6829 set x0 [lindex $bbox 0]
6830 set y0 [lindex $bbox 1]
6831 set y1 [lindex $bbox 3]
6832 foreach match $matches {
6833 set start [lindex $match 0]
6834 set end [lindex $match 1]
6835 if {$start > $end} continue
6836 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6837 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6838 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6839 [expr {$x0+$xlen+2}] $y1 \
6840 -outline {} -tags [list match$l matches] -fill yellow]
6841 $canv lower $t
6842 if {$row == $selectedline} {
6843 $canv raise $t secsel
6844 }
6845 }
6846}
6847
6848proc unmarkmatches {} {
6849 global markingmatches
6850
6851 allcanvs delete matches
6852 set markingmatches 0
6853 stopfinding
6854}
6855
6856proc selcanvline {w x y} {
6857 global canv canvy0 ctext linespc
6858 global rowtextx
6859 set ymax [lindex [$canv cget -scrollregion] 3]
6860 if {$ymax == {}} return
6861 set yfrac [lindex [$canv yview] 0]
6862 set y [expr {$y + $yfrac * $ymax}]
6863 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6864 if {$l < 0} {
6865 set l 0
6866 }
6867 if {$w eq $canv} {
6868 set xmax [lindex [$canv cget -scrollregion] 2]
6869 set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6870 if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6871 }
6872 unmarkmatches
6873 selectline $l 1
6874}
6875
6876proc commit_descriptor {p} {
6877 global commitinfo
6878 if {![info exists commitinfo($p)]} {
6879 getcommit $p
6880 }
6881 set l "..."
6882 if {[llength $commitinfo($p)] > 1} {
6883 set l [lindex $commitinfo($p) 0]
6884 }
6885 return "$p ($l)\n"
6886}
6887
6888# append some text to the ctext widget, and make any SHA1 ID
6889# that we know about be a clickable link.
6890proc appendwithlinks {text tags} {
6891 global ctext linknum curview
6892
6893 set start [$ctext index "end - 1c"]
6894 $ctext insert end $text $tags
6895 set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6896 foreach l $links {
6897 set s [lindex $l 0]
6898 set e [lindex $l 1]
6899 set linkid [string range $text $s $e]
6900 incr e
6901 $ctext tag delete link$linknum
6902 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6903 setlink $linkid link$linknum
6904 incr linknum
6905 }
6906}
6907
6908proc setlink {id lk} {
6909 global curview ctext pendinglinks
6910 global linkfgcolor
6911
6912 if {[string range $id 0 1] eq "-g"} {
6913 set id [string range $id 2 end]
6914 }
6915
6916 set known 0
6917 if {[string length $id] < 40} {
6918 set matches [longid $id]
6919 if {[llength $matches] > 0} {
6920 if {[llength $matches] > 1} return
6921 set known 1
6922 set id [lindex $matches 0]
6923 }
6924 } else {
6925 set known [commitinview $id $curview]
6926 }
6927 if {$known} {
6928 $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6929 $ctext tag bind $lk <1> [list selbyid $id]
6930 $ctext tag bind $lk <Enter> {linkcursor %W 1}
6931 $ctext tag bind $lk <Leave> {linkcursor %W -1}
6932 } else {
6933 lappend pendinglinks($id) $lk
6934 interestedin $id {makelink %P}
6935 }
6936}
6937
6938proc appendshortlink {id {pre {}} {post {}}} {
6939 global ctext linknum
6940
6941 $ctext insert end $pre
6942 $ctext tag delete link$linknum
6943 $ctext insert end [string range $id 0 7] link$linknum
6944 $ctext insert end $post
6945 setlink $id link$linknum
6946 incr linknum
6947}
6948
6949proc makelink {id} {
6950 global pendinglinks
6951
6952 if {![info exists pendinglinks($id)]} return
6953 foreach lk $pendinglinks($id) {
6954 setlink $id $lk
6955 }
6956 unset pendinglinks($id)
6957}
6958
6959proc linkcursor {w inc} {
6960 global linkentercount curtextcursor
6961
6962 if {[incr linkentercount $inc] > 0} {
6963 $w configure -cursor hand2
6964 } else {
6965 $w configure -cursor $curtextcursor
6966 if {$linkentercount < 0} {
6967 set linkentercount 0
6968 }
6969 }
6970}
6971
6972proc viewnextline {dir} {
6973 global canv linespc
6974
6975 $canv delete hover
6976 set ymax [lindex [$canv cget -scrollregion] 3]
6977 set wnow [$canv yview]
6978 set wtop [expr {[lindex $wnow 0] * $ymax}]
6979 set newtop [expr {$wtop + $dir * $linespc}]
6980 if {$newtop < 0} {
6981 set newtop 0
6982 } elseif {$newtop > $ymax} {
6983 set newtop $ymax
6984 }
6985 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6986}
6987
6988# add a list of tag or branch names at position pos
6989# returns the number of names inserted
6990proc appendrefs {pos ids var} {
6991 global ctext linknum curview $var maxrefs visiblerefs mainheadid
6992
6993 if {[catch {$ctext index $pos}]} {
6994 return 0
6995 }
6996 $ctext conf -state normal
6997 $ctext delete $pos "$pos lineend"
6998 set tags {}
6999 foreach id $ids {
7000 foreach tag [set $var\($id\)] {
7001 lappend tags [list $tag $id]
7002 }
7003 }
7004
7005 set sep {}
7006 set tags [lsort -index 0 -decreasing $tags]
7007 set nutags 0
7008
7009 if {[llength $tags] > $maxrefs} {
7010 # If we are displaying heads, and there are too many,
7011 # see if there are some important heads to display.
7012 # Currently that are the current head and heads listed in $visiblerefs option
7013 set itags {}
7014 if {$var eq "idheads"} {
7015 set utags {}
7016 foreach ti $tags {
7017 set hname [lindex $ti 0]
7018 set id [lindex $ti 1]
7019 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7020 [llength $itags] < $maxrefs} {
7021 lappend itags $ti
7022 } else {
7023 lappend utags $ti
7024 }
7025 }
7026 set tags $utags
7027 }
7028 if {$itags ne {}} {
7029 set str [mc "and many more"]
7030 set sep " "
7031 } else {
7032 set str [mc "many"]
7033 }
7034 $ctext insert $pos "$str ([llength $tags])"
7035 set nutags [llength $tags]
7036 set tags $itags
7037 }
7038
7039 foreach ti $tags {
7040 set id [lindex $ti 1]
7041 set lk link$linknum
7042 incr linknum
7043 $ctext tag delete $lk
7044 $ctext insert $pos $sep
7045 $ctext insert $pos [lindex $ti 0] $lk
7046 setlink $id $lk
7047 set sep ", "
7048 }
7049 $ctext tag add wwrap "$pos linestart" "$pos lineend"
7050 $ctext conf -state disabled
7051 return [expr {[llength $tags] + $nutags}]
7052}
7053
7054# called when we have finished computing the nearby tags
7055proc dispneartags {delay} {
7056 global selectedline currentid showneartags tagphase
7057
7058 if {$selectedline eq {} || !$showneartags} return
7059 after cancel dispnexttag
7060 if {$delay} {
7061 after 200 dispnexttag
7062 set tagphase -1
7063 } else {
7064 after idle dispnexttag
7065 set tagphase 0
7066 }
7067}
7068
7069proc dispnexttag {} {
7070 global selectedline currentid showneartags tagphase ctext
7071
7072 if {$selectedline eq {} || !$showneartags} return
7073 switch -- $tagphase {
7074 0 {
7075 set dtags [desctags $currentid]
7076 if {$dtags ne {}} {
7077 appendrefs precedes $dtags idtags
7078 }
7079 }
7080 1 {
7081 set atags [anctags $currentid]
7082 if {$atags ne {}} {
7083 appendrefs follows $atags idtags
7084 }
7085 }
7086 2 {
7087 set dheads [descheads $currentid]
7088 if {$dheads ne {}} {
7089 if {[appendrefs branch $dheads idheads] > 1
7090 && [$ctext get "branch -3c"] eq "h"} {
7091 # turn "Branch" into "Branches"
7092 $ctext conf -state normal
7093 $ctext insert "branch -2c" "es"
7094 $ctext conf -state disabled
7095 }
7096 }
7097 }
7098 }
7099 if {[incr tagphase] <= 2} {
7100 after idle dispnexttag
7101 }
7102}
7103
7104proc make_secsel {id} {
7105 global linehtag linentag linedtag canv canv2 canv3
7106
7107 if {![info exists linehtag($id)]} return
7108 $canv delete secsel
7109 set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7110 -tags secsel -fill [$canv cget -selectbackground]]
7111 $canv lower $t
7112 $canv2 delete secsel
7113 set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7114 -tags secsel -fill [$canv2 cget -selectbackground]]
7115 $canv2 lower $t
7116 $canv3 delete secsel
7117 set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7118 -tags secsel -fill [$canv3 cget -selectbackground]]
7119 $canv3 lower $t
7120}
7121
7122proc make_idmark {id} {
7123 global linehtag canv fgcolor
7124
7125 if {![info exists linehtag($id)]} return
7126 $canv delete markid
7127 set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7128 -tags markid -outline $fgcolor]
7129 $canv raise $t
7130}
7131
7132proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7133 global canv ctext commitinfo selectedline
7134 global canvy0 linespc parents children curview
7135 global currentid sha1entry
7136 global commentend idtags linknum
7137 global mergemax numcommits pending_select
7138 global cmitmode showneartags allcommits
7139 global targetrow targetid lastscrollrows
7140 global autoselect autosellen jump_to_here
7141 global vinlinediff
7142
7143 catch {unset pending_select}
7144 $canv delete hover
7145 normalline
7146 unsel_reflist
7147 stopfinding
7148 if {$l < 0 || $l >= $numcommits} return
7149 set id [commitonrow $l]
7150 set targetid $id
7151 set targetrow $l
7152 set selectedline $l
7153 set currentid $id
7154 if {$lastscrollrows < $numcommits} {
7155 setcanvscroll
7156 }
7157
7158 if {$cmitmode ne "patch" && $switch_to_patch} {
7159 set cmitmode "patch"
7160 }
7161
7162 set y [expr {$canvy0 + $l * $linespc}]
7163 set ymax [lindex [$canv cget -scrollregion] 3]
7164 set ytop [expr {$y - $linespc - 1}]
7165 set ybot [expr {$y + $linespc + 1}]
7166 set wnow [$canv yview]
7167 set wtop [expr {[lindex $wnow 0] * $ymax}]
7168 set wbot [expr {[lindex $wnow 1] * $ymax}]
7169 set wh [expr {$wbot - $wtop}]
7170 set newtop $wtop
7171 if {$ytop < $wtop} {
7172 if {$ybot < $wtop} {
7173 set newtop [expr {$y - $wh / 2.0}]
7174 } else {
7175 set newtop $ytop
7176 if {$newtop > $wtop - $linespc} {
7177 set newtop [expr {$wtop - $linespc}]
7178 }
7179 }
7180 } elseif {$ybot > $wbot} {
7181 if {$ytop > $wbot} {
7182 set newtop [expr {$y - $wh / 2.0}]
7183 } else {
7184 set newtop [expr {$ybot - $wh}]
7185 if {$newtop < $wtop + $linespc} {
7186 set newtop [expr {$wtop + $linespc}]
7187 }
7188 }
7189 }
7190 if {$newtop != $wtop} {
7191 if {$newtop < 0} {
7192 set newtop 0
7193 }
7194 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7195 drawvisible
7196 }
7197
7198 make_secsel $id
7199
7200 if {$isnew} {
7201 addtohistory [list selbyid $id 0] savecmitpos
7202 }
7203
7204 $sha1entry delete 0 end
7205 $sha1entry insert 0 $id
7206 if {$autoselect} {
7207 $sha1entry selection range 0 $autosellen
7208 }
7209 rhighlight_sel $id
7210
7211 $ctext conf -state normal
7212 clear_ctext
7213 set linknum 0
7214 if {![info exists commitinfo($id)]} {
7215 getcommit $id
7216 }
7217 set info $commitinfo($id)
7218 set date [formatdate [lindex $info 2]]
7219 $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
7220 set date [formatdate [lindex $info 4]]
7221 $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
7222 if {[info exists idtags($id)]} {
7223 $ctext insert end [mc "Tags:"]
7224 foreach tag $idtags($id) {
7225 $ctext insert end " $tag"
7226 }
7227 $ctext insert end "\n"
7228 }
7229
7230 set headers {}
7231 set olds $parents($curview,$id)
7232 if {[llength $olds] > 1} {
7233 set np 0
7234 foreach p $olds {
7235 if {$np >= $mergemax} {
7236 set tag mmax
7237 } else {
7238 set tag m$np
7239 }
7240 $ctext insert end "[mc "Parent"]: " $tag
7241 appendwithlinks [commit_descriptor $p] {}
7242 incr np
7243 }
7244 } else {
7245 foreach p $olds {
7246 append headers "[mc "Parent"]: [commit_descriptor $p]"
7247 }
7248 }
7249
7250 foreach c $children($curview,$id) {
7251 append headers "[mc "Child"]: [commit_descriptor $c]"
7252 }
7253
7254 # make anything that looks like a SHA1 ID be a clickable link
7255 appendwithlinks $headers {}
7256 if {$showneartags} {
7257 if {![info exists allcommits]} {
7258 getallcommits
7259 }
7260 $ctext insert end "[mc "Branch"]: "
7261 $ctext mark set branch "end -1c"
7262 $ctext mark gravity branch left
7263 $ctext insert end "\n[mc "Follows"]: "
7264 $ctext mark set follows "end -1c"
7265 $ctext mark gravity follows left
7266 $ctext insert end "\n[mc "Precedes"]: "
7267 $ctext mark set precedes "end -1c"
7268 $ctext mark gravity precedes left
7269 $ctext insert end "\n"
7270 dispneartags 1
7271 }
7272 $ctext insert end "\n"
7273 set comment [lindex $info 5]
7274 if {[string first "\r" $comment] >= 0} {
7275 set comment [string map {"\r" "\n "} $comment]
7276 }
7277 appendwithlinks $comment {comment}
7278
7279 $ctext tag remove found 1.0 end
7280 $ctext conf -state disabled
7281 set commentend [$ctext index "end - 1c"]
7282
7283 set jump_to_here $desired_loc
7284 init_flist [mc "Comments"]
7285 if {$cmitmode eq "tree"} {
7286 gettree $id
7287 } elseif {$vinlinediff($curview) == 1} {
7288 showinlinediff $id
7289 } elseif {[llength $olds] <= 1} {
7290 startdiff $id
7291 } else {
7292 mergediff $id
7293 }
7294}
7295
7296proc selfirstline {} {
7297 unmarkmatches
7298 selectline 0 1
7299}
7300
7301proc sellastline {} {
7302 global numcommits
7303 unmarkmatches
7304 set l [expr {$numcommits - 1}]
7305 selectline $l 1
7306}
7307
7308proc selnextline {dir} {
7309 global selectedline
7310 focus .
7311 if {$selectedline eq {}} return
7312 set l [expr {$selectedline + $dir}]
7313 unmarkmatches
7314 selectline $l 1
7315}
7316
7317proc selnextpage {dir} {
7318 global canv linespc selectedline numcommits
7319
7320 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7321 if {$lpp < 1} {
7322 set lpp 1
7323 }
7324 allcanvs yview scroll [expr {$dir * $lpp}] units
7325 drawvisible
7326 if {$selectedline eq {}} return
7327 set l [expr {$selectedline + $dir * $lpp}]
7328 if {$l < 0} {
7329 set l 0
7330 } elseif {$l >= $numcommits} {
7331 set l [expr $numcommits - 1]
7332 }
7333 unmarkmatches
7334 selectline $l 1
7335}
7336
7337proc unselectline {} {
7338 global selectedline currentid
7339
7340 set selectedline {}
7341 catch {unset currentid}
7342 allcanvs delete secsel
7343 rhighlight_none
7344}
7345
7346proc reselectline {} {
7347 global selectedline
7348
7349 if {$selectedline ne {}} {
7350 selectline $selectedline 0
7351 }
7352}
7353
7354proc addtohistory {cmd {saveproc {}}} {
7355 global history historyindex curview
7356
7357 unset_posvars
7358 save_position
7359 set elt [list $curview $cmd $saveproc {}]
7360 if {$historyindex > 0
7361 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7362 return
7363 }
7364
7365 if {$historyindex < [llength $history]} {
7366 set history [lreplace $history $historyindex end $elt]
7367 } else {
7368 lappend history $elt
7369 }
7370 incr historyindex
7371 if {$historyindex > 1} {
7372 .tf.bar.leftbut conf -state normal
7373 } else {
7374 .tf.bar.leftbut conf -state disabled
7375 }
7376 .tf.bar.rightbut conf -state disabled
7377}
7378
7379# save the scrolling position of the diff display pane
7380proc save_position {} {
7381 global historyindex history
7382
7383 if {$historyindex < 1} return
7384 set hi [expr {$historyindex - 1}]
7385 set fn [lindex $history $hi 2]
7386 if {$fn ne {}} {
7387 lset history $hi 3 [eval $fn]
7388 }
7389}
7390
7391proc unset_posvars {} {
7392 global last_posvars
7393
7394 if {[info exists last_posvars]} {
7395 foreach {var val} $last_posvars {
7396 global $var
7397 catch {unset $var}
7398 }
7399 unset last_posvars
7400 }
7401}
7402
7403proc godo {elt} {
7404 global curview last_posvars
7405
7406 set view [lindex $elt 0]
7407 set cmd [lindex $elt 1]
7408 set pv [lindex $elt 3]
7409 if {$curview != $view} {
7410 showview $view
7411 }
7412 unset_posvars
7413 foreach {var val} $pv {
7414 global $var
7415 set $var $val
7416 }
7417 set last_posvars $pv
7418 eval $cmd
7419}
7420
7421proc goback {} {
7422 global history historyindex
7423 focus .
7424
7425 if {$historyindex > 1} {
7426 save_position
7427 incr historyindex -1
7428 godo [lindex $history [expr {$historyindex - 1}]]
7429 .tf.bar.rightbut conf -state normal
7430 }
7431 if {$historyindex <= 1} {
7432 .tf.bar.leftbut conf -state disabled
7433 }
7434}
7435
7436proc goforw {} {
7437 global history historyindex
7438 focus .
7439
7440 if {$historyindex < [llength $history]} {
7441 save_position
7442 set cmd [lindex $history $historyindex]
7443 incr historyindex
7444 godo $cmd
7445 .tf.bar.leftbut conf -state normal
7446 }
7447 if {$historyindex >= [llength $history]} {
7448 .tf.bar.rightbut conf -state disabled
7449 }
7450}
7451
7452proc go_to_parent {i} {
7453 global parents curview targetid
7454 set ps $parents($curview,$targetid)
7455 if {[llength $ps] >= $i} {
7456 selbyid [lindex $ps [expr $i - 1]]
7457 }
7458}
7459
7460proc gettree {id} {
7461 global treefilelist treeidlist diffids diffmergeid treepending
7462 global nullid nullid2
7463
7464 set diffids $id
7465 catch {unset diffmergeid}
7466 if {![info exists treefilelist($id)]} {
7467 if {![info exists treepending]} {
7468 if {$id eq $nullid} {
7469 set cmd [list | git ls-files]
7470 } elseif {$id eq $nullid2} {
7471 set cmd [list | git ls-files --stage -t]
7472 } else {
7473 set cmd [list | git ls-tree -r $id]
7474 }
7475 if {[catch {set gtf [open $cmd r]}]} {
7476 return
7477 }
7478 set treepending $id
7479 set treefilelist($id) {}
7480 set treeidlist($id) {}
7481 fconfigure $gtf -blocking 0 -encoding binary
7482 filerun $gtf [list gettreeline $gtf $id]
7483 }
7484 } else {
7485 setfilelist $id
7486 }
7487}
7488
7489proc gettreeline {gtf id} {
7490 global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7491
7492 set nl 0
7493 while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7494 if {$diffids eq $nullid} {
7495 set fname $line
7496 } else {
7497 set i [string first "\t" $line]
7498 if {$i < 0} continue
7499 set fname [string range $line [expr {$i+1}] end]
7500 set line [string range $line 0 [expr {$i-1}]]
7501 if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7502 set sha1 [lindex $line 2]
7503 lappend treeidlist($id) $sha1
7504 }
7505 if {[string index $fname 0] eq "\""} {
7506 set fname [lindex $fname 0]
7507 }
7508 set fname [encoding convertfrom $fname]
7509 lappend treefilelist($id) $fname
7510 }
7511 if {![eof $gtf]} {
7512 return [expr {$nl >= 1000? 2: 1}]
7513 }
7514 close $gtf
7515 unset treepending
7516 if {$cmitmode ne "tree"} {
7517 if {![info exists diffmergeid]} {
7518 gettreediffs $diffids
7519 }
7520 } elseif {$id ne $diffids} {
7521 gettree $diffids
7522 } else {
7523 setfilelist $id
7524 }
7525 return 0
7526}
7527
7528proc showfile {f} {
7529 global treefilelist treeidlist diffids nullid nullid2
7530 global ctext_file_names ctext_file_lines
7531 global ctext commentend
7532
7533 set i [lsearch -exact $treefilelist($diffids) $f]
7534 if {$i < 0} {
7535 puts "oops, $f not in list for id $diffids"
7536 return
7537 }
7538 if {$diffids eq $nullid} {
7539 if {[catch {set bf [open $f r]} err]} {
7540 puts "oops, can't read $f: $err"
7541 return
7542 }
7543 } else {
7544 set blob [lindex $treeidlist($diffids) $i]
7545 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7546 puts "oops, error reading blob $blob: $err"
7547 return
7548 }
7549 }
7550 fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7551 filerun $bf [list getblobline $bf $diffids]
7552 $ctext config -state normal
7553 clear_ctext $commentend
7554 lappend ctext_file_names $f
7555 lappend ctext_file_lines [lindex [split $commentend "."] 0]
7556 $ctext insert end "\n"
7557 $ctext insert end "$f\n" filesep
7558 $ctext config -state disabled
7559 $ctext yview $commentend
7560 settabs 0
7561}
7562
7563proc getblobline {bf id} {
7564 global diffids cmitmode ctext
7565
7566 if {$id ne $diffids || $cmitmode ne "tree"} {
7567 catch {close $bf}
7568 return 0
7569 }
7570 $ctext config -state normal
7571 set nl 0
7572 while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7573 $ctext insert end "$line\n"
7574 }
7575 if {[eof $bf]} {
7576 global jump_to_here ctext_file_names commentend
7577
7578 # delete last newline
7579 $ctext delete "end - 2c" "end - 1c"
7580 close $bf
7581 if {$jump_to_here ne {} &&
7582 [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7583 set lnum [expr {[lindex $jump_to_here 1] +
7584 [lindex [split $commentend .] 0]}]
7585 mark_ctext_line $lnum
7586 }
7587 $ctext config -state disabled
7588 return 0
7589 }
7590 $ctext config -state disabled
7591 return [expr {$nl >= 1000? 2: 1}]
7592}
7593
7594proc mark_ctext_line {lnum} {
7595 global ctext markbgcolor
7596
7597 $ctext tag delete omark
7598 $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7599 $ctext tag conf omark -background $markbgcolor
7600 $ctext see $lnum.0
7601}
7602
7603proc mergediff {id} {
7604 global diffmergeid
7605 global diffids treediffs
7606 global parents curview
7607
7608 set diffmergeid $id
7609 set diffids $id
7610 set treediffs($id) {}
7611 set np [llength $parents($curview,$id)]
7612 settabs $np
7613 getblobdiffs $id
7614}
7615
7616proc startdiff {ids} {
7617 global treediffs diffids treepending diffmergeid nullid nullid2
7618
7619 settabs 1
7620 set diffids $ids
7621 catch {unset diffmergeid}
7622 if {![info exists treediffs($ids)] ||
7623 [lsearch -exact $ids $nullid] >= 0 ||
7624 [lsearch -exact $ids $nullid2] >= 0} {
7625 if {![info exists treepending]} {
7626 gettreediffs $ids
7627 }
7628 } else {
7629 addtocflist $ids
7630 }
7631}
7632
7633proc showinlinediff {ids} {
7634 global commitinfo commitdata ctext
7635 global treediffs
7636
7637 set info $commitinfo($ids)
7638 set diff [lindex $info 7]
7639 set difflines [split $diff "\n"]
7640
7641 initblobdiffvars
7642 set treediff {}
7643
7644 set inhdr 0
7645 foreach line $difflines {
7646 if {![string compare -length 5 "diff " $line]} {
7647 set inhdr 1
7648 } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7649 # offset also accounts for the b/ prefix
7650 lappend treediff [string range $line 6 end]
7651 set inhdr 0
7652 }
7653 }
7654
7655 set treediffs($ids) $treediff
7656 add_flist $treediff
7657
7658 $ctext conf -state normal
7659 foreach line $difflines {
7660 parseblobdiffline $ids $line
7661 }
7662 maybe_scroll_ctext 1
7663 $ctext conf -state disabled
7664}
7665
7666# If the filename (name) is under any of the passed filter paths
7667# then return true to include the file in the listing.
7668proc path_filter {filter name} {
7669 set worktree [gitworktree]
7670 foreach p $filter {
7671 set fq_p [file normalize $p]
7672 set fq_n [file normalize [file join $worktree $name]]
7673 if {[string match [file normalize $fq_p]* $fq_n]} {
7674 return 1
7675 }
7676 }
7677 return 0
7678}
7679
7680proc addtocflist {ids} {
7681 global treediffs
7682
7683 add_flist $treediffs($ids)
7684 getblobdiffs $ids
7685}
7686
7687proc diffcmd {ids flags} {
7688 global log_showroot nullid nullid2 git_version
7689
7690 set i [lsearch -exact $ids $nullid]
7691 set j [lsearch -exact $ids $nullid2]
7692 if {$i >= 0} {
7693 if {[llength $ids] > 1 && $j < 0} {
7694 # comparing working directory with some specific revision
7695 set cmd [concat | git diff-index $flags]
7696 if {$i == 0} {
7697 lappend cmd -R [lindex $ids 1]
7698 } else {
7699 lappend cmd [lindex $ids 0]
7700 }
7701 } else {
7702 # comparing working directory with index
7703 set cmd [concat | git diff-files $flags]
7704 if {$j == 1} {
7705 lappend cmd -R
7706 }
7707 }
7708 } elseif {$j >= 0} {
7709 if {[package vcompare $git_version "1.7.2"] >= 0} {
7710 set flags "$flags --ignore-submodules=dirty"
7711 }
7712 set cmd [concat | git diff-index --cached $flags]
7713 if {[llength $ids] > 1} {
7714 # comparing index with specific revision
7715 if {$j == 0} {
7716 lappend cmd -R [lindex $ids 1]
7717 } else {
7718 lappend cmd [lindex $ids 0]
7719 }
7720 } else {
7721 # comparing index with HEAD
7722 lappend cmd HEAD
7723 }
7724 } else {
7725 if {$log_showroot} {
7726 lappend flags --root
7727 }
7728 set cmd [concat | git diff-tree -r $flags $ids]
7729 }
7730 return $cmd
7731}
7732
7733proc gettreediffs {ids} {
7734 global treediff treepending limitdiffs vfilelimit curview
7735
7736 set cmd [diffcmd $ids {--no-commit-id}]
7737 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7738 set cmd [concat $cmd -- $vfilelimit($curview)]
7739 }
7740 if {[catch {set gdtf [open $cmd r]}]} return
7741
7742 set treepending $ids
7743 set treediff {}
7744 fconfigure $gdtf -blocking 0 -encoding binary
7745 filerun $gdtf [list gettreediffline $gdtf $ids]
7746}
7747
7748proc gettreediffline {gdtf ids} {
7749 global treediff treediffs treepending diffids diffmergeid
7750 global cmitmode vfilelimit curview limitdiffs perfile_attrs
7751
7752 set nr 0
7753 set sublist {}
7754 set max 1000
7755 if {$perfile_attrs} {
7756 # cache_gitattr is slow, and even slower on win32 where we
7757 # have to invoke it for only about 30 paths at a time
7758 set max 500
7759 if {[tk windowingsystem] == "win32"} {
7760 set max 120
7761 }
7762 }
7763 while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7764 set i [string first "\t" $line]
7765 if {$i >= 0} {
7766 set file [string range $line [expr {$i+1}] end]
7767 if {[string index $file 0] eq "\""} {
7768 set file [lindex $file 0]
7769 }
7770 set file [encoding convertfrom $file]
7771 if {$file ne [lindex $treediff end]} {
7772 lappend treediff $file
7773 lappend sublist $file
7774 }
7775 }
7776 }
7777 if {$perfile_attrs} {
7778 cache_gitattr encoding $sublist
7779 }
7780 if {![eof $gdtf]} {
7781 return [expr {$nr >= $max? 2: 1}]
7782 }
7783 close $gdtf
7784 set treediffs($ids) $treediff
7785 unset treepending
7786 if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7787 gettree $diffids
7788 } elseif {$ids != $diffids} {
7789 if {![info exists diffmergeid]} {
7790 gettreediffs $diffids
7791 }
7792 } else {
7793 addtocflist $ids
7794 }
7795 return 0
7796}
7797
7798# empty string or positive integer
7799proc diffcontextvalidate {v} {
7800 return [regexp {^(|[1-9][0-9]*)$} $v]
7801}
7802
7803proc diffcontextchange {n1 n2 op} {
7804 global diffcontextstring diffcontext
7805
7806 if {[string is integer -strict $diffcontextstring]} {
7807 if {$diffcontextstring >= 0} {
7808 set diffcontext $diffcontextstring
7809 reselectline
7810 }
7811 }
7812}
7813
7814proc changeignorespace {} {
7815 reselectline
7816}
7817
7818proc changeworddiff {name ix op} {
7819 reselectline
7820}
7821
7822proc initblobdiffvars {} {
7823 global diffencoding targetline diffnparents
7824 global diffinhdr currdiffsubmod diffseehere
7825 set targetline {}
7826 set diffnparents 0
7827 set diffinhdr 0
7828 set diffencoding [get_path_encoding {}]
7829 set currdiffsubmod ""
7830 set diffseehere -1
7831}
7832
7833proc getblobdiffs {ids} {
7834 global blobdifffd diffids env
7835 global treediffs
7836 global diffcontext
7837 global ignorespace
7838 global worddiff
7839 global limitdiffs vfilelimit curview
7840 global git_version
7841
7842 set textconv {}
7843 if {[package vcompare $git_version "1.6.1"] >= 0} {
7844 set textconv "--textconv"
7845 }
7846 set submodule {}
7847 if {[package vcompare $git_version "1.6.6"] >= 0} {
7848 set submodule "--submodule"
7849 }
7850 set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
7851 if {$ignorespace} {
7852 append cmd " -w"
7853 }
7854 if {$worddiff ne [mc "Line diff"]} {
7855 append cmd " --word-diff=porcelain"
7856 }
7857 if {$limitdiffs && $vfilelimit($curview) ne {}} {
7858 set cmd [concat $cmd -- $vfilelimit($curview)]
7859 }
7860 if {[catch {set bdf [open $cmd r]} err]} {
7861 error_popup [mc "Error getting diffs: %s" $err]
7862 return
7863 }
7864 fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7865 set blobdifffd($ids) $bdf
7866 initblobdiffvars
7867 filerun $bdf [list getblobdiffline $bdf $diffids]
7868}
7869
7870proc savecmitpos {} {
7871 global ctext cmitmode
7872
7873 if {$cmitmode eq "tree"} {
7874 return {}
7875 }
7876 return [list target_scrollpos [$ctext index @0,0]]
7877}
7878
7879proc savectextpos {} {
7880 global ctext
7881
7882 return [list target_scrollpos [$ctext index @0,0]]
7883}
7884
7885proc maybe_scroll_ctext {ateof} {
7886 global ctext target_scrollpos
7887
7888 if {![info exists target_scrollpos]} return
7889 if {!$ateof} {
7890 set nlines [expr {[winfo height $ctext]
7891 / [font metrics textfont -linespace]}]
7892 if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7893 }
7894 $ctext yview $target_scrollpos
7895 unset target_scrollpos
7896}
7897
7898proc setinlist {var i val} {
7899 global $var
7900
7901 while {[llength [set $var]] < $i} {
7902 lappend $var {}
7903 }
7904 if {[llength [set $var]] == $i} {
7905 lappend $var $val
7906 } else {
7907 lset $var $i $val
7908 }
7909}
7910
7911proc makediffhdr {fname ids} {
7912 global ctext curdiffstart treediffs diffencoding
7913 global ctext_file_names jump_to_here targetline diffline
7914
7915 set fname [encoding convertfrom $fname]
7916 set diffencoding [get_path_encoding $fname]
7917 set i [lsearch -exact $treediffs($ids) $fname]
7918 if {$i >= 0} {
7919 setinlist difffilestart $i $curdiffstart
7920 }
7921 lset ctext_file_names end $fname
7922 set l [expr {(78 - [string length $fname]) / 2}]
7923 set pad [string range "----------------------------------------" 1 $l]
7924 $ctext insert $curdiffstart "$pad $fname $pad" filesep
7925 set targetline {}
7926 if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7927 set targetline [lindex $jump_to_here 1]
7928 }
7929 set diffline 0
7930}
7931
7932proc blobdiffmaybeseehere {ateof} {
7933 global diffseehere
7934 if {$diffseehere >= 0} {
7935 mark_ctext_line [lindex [split $diffseehere .] 0]
7936 }
7937 maybe_scroll_ctext $ateof
7938}
7939
7940proc getblobdiffline {bdf ids} {
7941 global diffids blobdifffd
7942 global ctext
7943
7944 set nr 0
7945 $ctext conf -state normal
7946 while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7947 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7948 catch {close $bdf}
7949 return 0
7950 }
7951 parseblobdiffline $ids $line
7952 }
7953 $ctext conf -state disabled
7954 blobdiffmaybeseehere [eof $bdf]
7955 if {[eof $bdf]} {
7956 catch {close $bdf}
7957 return 0
7958 }
7959 return [expr {$nr >= 1000? 2: 1}]
7960}
7961
7962proc parseblobdiffline {ids line} {
7963 global ctext curdiffstart
7964 global diffnexthead diffnextnote difffilestart
7965 global ctext_file_names ctext_file_lines
7966 global diffinhdr treediffs mergemax diffnparents
7967 global diffencoding jump_to_here targetline diffline currdiffsubmod
7968 global worddiff diffseehere
7969
7970 if {![string compare -length 5 "diff " $line]} {
7971 if {![regexp {^diff (--cc|--git) } $line m type]} {
7972 set line [encoding convertfrom $line]
7973 $ctext insert end "$line\n" hunksep
7974 continue
7975 }
7976 # start of a new file
7977 set diffinhdr 1
7978 $ctext insert end "\n"
7979 set curdiffstart [$ctext index "end - 1c"]
7980 lappend ctext_file_names ""
7981 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7982 $ctext insert end "\n" filesep
7983
7984 if {$type eq "--cc"} {
7985 # start of a new file in a merge diff
7986 set fname [string range $line 10 end]
7987 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7988 lappend treediffs($ids) $fname
7989 add_flist [list $fname]
7990 }
7991
7992 } else {
7993 set line [string range $line 11 end]
7994 # If the name hasn't changed the length will be odd,
7995 # the middle char will be a space, and the two bits either
7996 # side will be a/name and b/name, or "a/name" and "b/name".
7997 # If the name has changed we'll get "rename from" and
7998 # "rename to" or "copy from" and "copy to" lines following
7999 # this, and we'll use them to get the filenames.
8000 # This complexity is necessary because spaces in the
8001 # filename(s) don't get escaped.
8002 set l [string length $line]
8003 set i [expr {$l / 2}]
8004 if {!(($l & 1) && [string index $line $i] eq " " &&
8005 [string range $line 2 [expr {$i - 1}]] eq \
8006 [string range $line [expr {$i + 3}] end])} {
8007 return
8008 }
8009 # unescape if quoted and chop off the a/ from the front
8010 if {[string index $line 0] eq "\""} {
8011 set fname [string range [lindex $line 0] 2 end]
8012 } else {
8013 set fname [string range $line 2 [expr {$i - 1}]]
8014 }
8015 }
8016 makediffhdr $fname $ids
8017
8018 } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8019 set fname [encoding convertfrom [string range $line 16 end]]
8020 $ctext insert end "\n"
8021 set curdiffstart [$ctext index "end - 1c"]
8022 lappend ctext_file_names $fname
8023 lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8024 $ctext insert end "$line\n" filesep
8025 set i [lsearch -exact $treediffs($ids) $fname]
8026 if {$i >= 0} {
8027 setinlist difffilestart $i $curdiffstart
8028 }
8029
8030 } elseif {![string compare -length 2 "@@" $line]} {
8031 regexp {^@@+} $line ats
8032 set line [encoding convertfrom $diffencoding $line]
8033 $ctext insert end "$line\n" hunksep
8034 if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8035 set diffline $nl
8036 }
8037 set diffnparents [expr {[string length $ats] - 1}]
8038 set diffinhdr 0
8039
8040 } elseif {![string compare -length 10 "Submodule " $line]} {
8041 # start of a new submodule
8042 if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8043 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8044 } else {
8045 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8046 }
8047 if {$currdiffsubmod != $fname} {
8048 $ctext insert end "\n"; # Add newline after commit message
8049 }
8050 set curdiffstart [$ctext index "end - 1c"]
8051 lappend ctext_file_names ""
8052 if {$currdiffsubmod != $fname} {
8053 lappend ctext_file_lines $fname
8054 makediffhdr $fname $ids
8055 set currdiffsubmod $fname
8056 $ctext insert end "\n$line\n" filesep
8057 } else {
8058 $ctext insert end "$line\n" filesep
8059 }
8060 } elseif {![string compare -length 3 " >" $line]} {
8061 set $currdiffsubmod ""
8062 set line [encoding convertfrom $diffencoding $line]
8063 $ctext insert end "$line\n" dresult
8064 } elseif {![string compare -length 3 " <" $line]} {
8065 set $currdiffsubmod ""
8066 set line [encoding convertfrom $diffencoding $line]
8067 $ctext insert end "$line\n" d0
8068 } elseif {$diffinhdr} {
8069 if {![string compare -length 12 "rename from " $line]} {
8070 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8071 if {[string index $fname 0] eq "\""} {
8072 set fname [lindex $fname 0]
8073 }
8074 set fname [encoding convertfrom $fname]
8075 set i [lsearch -exact $treediffs($ids) $fname]
8076 if {$i >= 0} {
8077 setinlist difffilestart $i $curdiffstart
8078 }
8079 } elseif {![string compare -length 10 $line "rename to "] ||
8080 ![string compare -length 8 $line "copy to "]} {
8081 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8082 if {[string index $fname 0] eq "\""} {
8083 set fname [lindex $fname 0]
8084 }
8085 makediffhdr $fname $ids
8086 } elseif {[string compare -length 3 $line "---"] == 0} {
8087 # do nothing
8088 return
8089 } elseif {[string compare -length 3 $line "+++"] == 0} {
8090 set diffinhdr 0
8091 return
8092 }
8093 $ctext insert end "$line\n" filesep
8094
8095 } else {
8096 set line [string map {\x1A ^Z} \
8097 [encoding convertfrom $diffencoding $line]]
8098 # parse the prefix - one ' ', '-' or '+' for each parent
8099 set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8100 set tag [expr {$diffnparents > 1? "m": "d"}]
8101 set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8102 set words_pre_markup ""
8103 set words_post_markup ""
8104 if {[string trim $prefix " -+"] eq {}} {
8105 # prefix only has " ", "-" and "+" in it: normal diff line
8106 set num [string first "-" $prefix]
8107 if {$dowords} {
8108 set line [string range $line 1 end]
8109 }
8110 if {$num >= 0} {
8111 # removed line, first parent with line is $num
8112 if {$num >= $mergemax} {
8113 set num "max"
8114 }
8115 if {$dowords && $worddiff eq [mc "Markup words"]} {
8116 $ctext insert end "\[-$line-\]" $tag$num
8117 } else {
8118 $ctext insert end "$line" $tag$num
8119 }
8120 if {!$dowords} {
8121 $ctext insert end "\n" $tag$num
8122 }
8123 } else {
8124 set tags {}
8125 if {[string first "+" $prefix] >= 0} {
8126 # added line
8127 lappend tags ${tag}result
8128 if {$diffnparents > 1} {
8129 set num [string first " " $prefix]
8130 if {$num >= 0} {
8131 if {$num >= $mergemax} {
8132 set num "max"
8133 }
8134 lappend tags m$num
8135 }
8136 }
8137 set words_pre_markup "{+"
8138 set words_post_markup "+}"
8139 }
8140 if {$targetline ne {}} {
8141 if {$diffline == $targetline} {
8142 set diffseehere [$ctext index "end - 1 chars"]
8143 set targetline {}
8144 } else {
8145 incr diffline
8146 }
8147 }
8148 if {$dowords && $worddiff eq [mc "Markup words"]} {
8149 $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8150 } else {
8151 $ctext insert end "$line" $tags
8152 }
8153 if {!$dowords} {
8154 $ctext insert end "\n" $tags
8155 }
8156 }
8157 } elseif {$dowords && $prefix eq "~"} {
8158 $ctext insert end "\n" {}
8159 } else {
8160 # "\ No newline at end of file",
8161 # or something else we don't recognize
8162 $ctext insert end "$line\n" hunksep
8163 }
8164 }
8165}
8166
8167proc changediffdisp {} {
8168 global ctext diffelide
8169
8170 $ctext tag conf d0 -elide [lindex $diffelide 0]
8171 $ctext tag conf dresult -elide [lindex $diffelide 1]
8172}
8173
8174proc highlightfile {cline} {
8175 global cflist cflist_top
8176
8177 if {![info exists cflist_top]} return
8178
8179 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8180 $cflist tag add highlight $cline.0 "$cline.0 lineend"
8181 $cflist see $cline.0
8182 set cflist_top $cline
8183}
8184
8185proc highlightfile_for_scrollpos {topidx} {
8186 global cmitmode difffilestart
8187
8188 if {$cmitmode eq "tree"} return
8189 if {![info exists difffilestart]} return
8190
8191 set top [lindex [split $topidx .] 0]
8192 if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8193 highlightfile 0
8194 } else {
8195 highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8196 }
8197}
8198
8199proc prevfile {} {
8200 global difffilestart ctext cmitmode
8201
8202 if {$cmitmode eq "tree"} return
8203 set prev 0.0
8204 set here [$ctext index @0,0]
8205 foreach loc $difffilestart {
8206 if {[$ctext compare $loc >= $here]} {
8207 $ctext yview $prev
8208 return
8209 }
8210 set prev $loc
8211 }
8212 $ctext yview $prev
8213}
8214
8215proc nextfile {} {
8216 global difffilestart ctext cmitmode
8217
8218 if {$cmitmode eq "tree"} return
8219 set here [$ctext index @0,0]
8220 foreach loc $difffilestart {
8221 if {[$ctext compare $loc > $here]} {
8222 $ctext yview $loc
8223 return
8224 }
8225 }
8226}
8227
8228proc clear_ctext {{first 1.0}} {
8229 global ctext smarktop smarkbot
8230 global ctext_file_names ctext_file_lines
8231 global pendinglinks
8232
8233 set l [lindex [split $first .] 0]
8234 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8235 set smarktop $l
8236 }
8237 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8238 set smarkbot $l
8239 }
8240 $ctext delete $first end
8241 if {$first eq "1.0"} {
8242 catch {unset pendinglinks}
8243 }
8244 set ctext_file_names {}
8245 set ctext_file_lines {}
8246}
8247
8248proc settabs {{firstab {}}} {
8249 global firsttabstop tabstop ctext have_tk85
8250
8251 if {$firstab ne {} && $have_tk85} {
8252 set firsttabstop $firstab
8253 }
8254 set w [font measure textfont "0"]
8255 if {$firsttabstop != 0} {
8256 $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8257 [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8258 } elseif {$have_tk85 || $tabstop != 8} {
8259 $ctext conf -tabs [expr {$tabstop * $w}]
8260 } else {
8261 $ctext conf -tabs {}
8262 }
8263}
8264
8265proc incrsearch {name ix op} {
8266 global ctext searchstring searchdirn
8267
8268 if {[catch {$ctext index anchor}]} {
8269 # no anchor set, use start of selection, or of visible area
8270 set sel [$ctext tag ranges sel]
8271 if {$sel ne {}} {
8272 $ctext mark set anchor [lindex $sel 0]
8273 } elseif {$searchdirn eq "-forwards"} {
8274 $ctext mark set anchor @0,0
8275 } else {
8276 $ctext mark set anchor @0,[winfo height $ctext]
8277 }
8278 }
8279 if {$searchstring ne {}} {
8280 set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8281 if {$here ne {}} {
8282 $ctext see $here
8283 set mend "$here + $mlen c"
8284 $ctext tag remove sel 1.0 end
8285 $ctext tag add sel $here $mend
8286 suppress_highlighting_file_for_current_scrollpos
8287 highlightfile_for_scrollpos $here
8288 }
8289 }
8290 rehighlight_search_results
8291}
8292
8293proc dosearch {} {
8294 global sstring ctext searchstring searchdirn
8295
8296 focus $sstring
8297 $sstring icursor end
8298 set searchdirn -forwards
8299 if {$searchstring ne {}} {
8300 set sel [$ctext tag ranges sel]
8301 if {$sel ne {}} {
8302 set start "[lindex $sel 0] + 1c"
8303 } elseif {[catch {set start [$ctext index anchor]}]} {
8304 set start "@0,0"
8305 }
8306 set match [$ctext search -count mlen -- $searchstring $start]
8307 $ctext tag remove sel 1.0 end
8308 if {$match eq {}} {
8309 bell
8310 return
8311 }
8312 $ctext see $match
8313 suppress_highlighting_file_for_current_scrollpos
8314 highlightfile_for_scrollpos $match
8315 set mend "$match + $mlen c"
8316 $ctext tag add sel $match $mend
8317 $ctext mark unset anchor
8318 rehighlight_search_results
8319 }
8320}
8321
8322proc dosearchback {} {
8323 global sstring ctext searchstring searchdirn
8324
8325 focus $sstring
8326 $sstring icursor end
8327 set searchdirn -backwards
8328 if {$searchstring ne {}} {
8329 set sel [$ctext tag ranges sel]
8330 if {$sel ne {}} {
8331 set start [lindex $sel 0]
8332 } elseif {[catch {set start [$ctext index anchor]}]} {
8333 set start @0,[winfo height $ctext]
8334 }
8335 set match [$ctext search -backwards -count ml -- $searchstring $start]
8336 $ctext tag remove sel 1.0 end
8337 if {$match eq {}} {
8338 bell
8339 return
8340 }
8341 $ctext see $match
8342 suppress_highlighting_file_for_current_scrollpos
8343 highlightfile_for_scrollpos $match
8344 set mend "$match + $ml c"
8345 $ctext tag add sel $match $mend
8346 $ctext mark unset anchor
8347 rehighlight_search_results
8348 }
8349}
8350
8351proc rehighlight_search_results {} {
8352 global ctext searchstring
8353
8354 $ctext tag remove found 1.0 end
8355 $ctext tag remove currentsearchhit 1.0 end
8356
8357 if {$searchstring ne {}} {
8358 searchmarkvisible 1
8359 }
8360}
8361
8362proc searchmark {first last} {
8363 global ctext searchstring
8364
8365 set sel [$ctext tag ranges sel]
8366
8367 set mend $first.0
8368 while {1} {
8369 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8370 if {$match eq {}} break
8371 set mend "$match + $mlen c"
8372 if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8373 $ctext tag add currentsearchhit $match $mend
8374 } else {
8375 $ctext tag add found $match $mend
8376 }
8377 }
8378}
8379
8380proc searchmarkvisible {doall} {
8381 global ctext smarktop smarkbot
8382
8383 set topline [lindex [split [$ctext index @0,0] .] 0]
8384 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8385 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8386 # no overlap with previous
8387 searchmark $topline $botline
8388 set smarktop $topline
8389 set smarkbot $botline
8390 } else {
8391 if {$topline < $smarktop} {
8392 searchmark $topline [expr {$smarktop-1}]
8393 set smarktop $topline
8394 }
8395 if {$botline > $smarkbot} {
8396 searchmark [expr {$smarkbot+1}] $botline
8397 set smarkbot $botline
8398 }
8399 }
8400}
8401
8402proc suppress_highlighting_file_for_current_scrollpos {} {
8403 global ctext suppress_highlighting_file_for_this_scrollpos
8404
8405 set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8406}
8407
8408proc scrolltext {f0 f1} {
8409 global searchstring cmitmode ctext
8410 global suppress_highlighting_file_for_this_scrollpos
8411
8412 set topidx [$ctext index @0,0]
8413 if {![info exists suppress_highlighting_file_for_this_scrollpos]
8414 || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8415 highlightfile_for_scrollpos $topidx
8416 }
8417
8418 catch {unset suppress_highlighting_file_for_this_scrollpos}
8419
8420 .bleft.bottom.sb set $f0 $f1
8421 if {$searchstring ne {}} {
8422 searchmarkvisible 0
8423 }
8424}
8425
8426proc setcoords {} {
8427 global linespc charspc canvx0 canvy0
8428 global xspc1 xspc2 lthickness
8429
8430 set linespc [font metrics mainfont -linespace]
8431 set charspc [font measure mainfont "m"]
8432 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8433 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8434 set lthickness [expr {int($linespc / 9) + 1}]
8435 set xspc1(0) $linespc
8436 set xspc2 $linespc
8437}
8438
8439proc redisplay {} {
8440 global canv
8441 global selectedline
8442
8443 set ymax [lindex [$canv cget -scrollregion] 3]
8444 if {$ymax eq {} || $ymax == 0} return
8445 set span [$canv yview]
8446 clear_display
8447 setcanvscroll
8448 allcanvs yview moveto [lindex $span 0]
8449 drawvisible
8450 if {$selectedline ne {}} {
8451 selectline $selectedline 0
8452 allcanvs yview moveto [lindex $span 0]
8453 }
8454}
8455
8456proc parsefont {f n} {
8457 global fontattr
8458
8459 set fontattr($f,family) [lindex $n 0]
8460 set s [lindex $n 1]
8461 if {$s eq {} || $s == 0} {
8462 set s 10
8463 } elseif {$s < 0} {
8464 set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8465 }
8466 set fontattr($f,size) $s
8467 set fontattr($f,weight) normal
8468 set fontattr($f,slant) roman
8469 foreach style [lrange $n 2 end] {
8470 switch -- $style {
8471 "normal" -
8472 "bold" {set fontattr($f,weight) $style}
8473 "roman" -
8474 "italic" {set fontattr($f,slant) $style}
8475 }
8476 }
8477}
8478
8479proc fontflags {f {isbold 0}} {
8480 global fontattr
8481
8482 return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8483 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8484 -slant $fontattr($f,slant)]
8485}
8486
8487proc fontname {f} {
8488 global fontattr
8489
8490 set n [list $fontattr($f,family) $fontattr($f,size)]
8491 if {$fontattr($f,weight) eq "bold"} {
8492 lappend n "bold"
8493 }
8494 if {$fontattr($f,slant) eq "italic"} {
8495 lappend n "italic"
8496 }
8497 return $n
8498}
8499
8500proc incrfont {inc} {
8501 global mainfont textfont ctext canv cflist showrefstop
8502 global stopped entries fontattr
8503
8504 unmarkmatches
8505 set s $fontattr(mainfont,size)
8506 incr s $inc
8507 if {$s < 1} {
8508 set s 1
8509 }
8510 set fontattr(mainfont,size) $s
8511 font config mainfont -size $s
8512 font config mainfontbold -size $s
8513 set mainfont [fontname mainfont]
8514 set s $fontattr(textfont,size)
8515 incr s $inc
8516 if {$s < 1} {
8517 set s 1
8518 }
8519 set fontattr(textfont,size) $s
8520 font config textfont -size $s
8521 font config textfontbold -size $s
8522 set textfont [fontname textfont]
8523 setcoords
8524 settabs
8525 redisplay
8526}
8527
8528proc clearsha1 {} {
8529 global sha1entry sha1string
8530 if {[string length $sha1string] == 40} {
8531 $sha1entry delete 0 end
8532 }
8533}
8534
8535proc sha1change {n1 n2 op} {
8536 global sha1string currentid sha1but
8537 if {$sha1string == {}
8538 || ([info exists currentid] && $sha1string == $currentid)} {
8539 set state disabled
8540 } else {
8541 set state normal
8542 }
8543 if {[$sha1but cget -state] == $state} return
8544 if {$state == "normal"} {
8545 $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8546 } else {
8547 $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8548 }
8549}
8550
8551proc gotocommit {} {
8552 global sha1string tagids headids curview varcid
8553
8554 if {$sha1string == {}
8555 || ([info exists currentid] && $sha1string == $currentid)} return
8556 if {[info exists tagids($sha1string)]} {
8557 set id $tagids($sha1string)
8558 } elseif {[info exists headids($sha1string)]} {
8559 set id $headids($sha1string)
8560 } else {
8561 set id [string tolower $sha1string]
8562 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8563 set matches [longid $id]
8564 if {$matches ne {}} {
8565 if {[llength $matches] > 1} {
8566 error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8567 return
8568 }
8569 set id [lindex $matches 0]
8570 }
8571 } else {
8572 if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8573 error_popup [mc "Revision %s is not known" $sha1string]
8574 return
8575 }
8576 }
8577 }
8578 if {[commitinview $id $curview]} {
8579 selectline [rowofcommit $id] 1
8580 return
8581 }
8582 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8583 set msg [mc "SHA1 id %s is not known" $sha1string]
8584 } else {
8585 set msg [mc "Revision %s is not in the current view" $sha1string]
8586 }
8587 error_popup $msg
8588}
8589
8590proc lineenter {x y id} {
8591 global hoverx hovery hoverid hovertimer
8592 global commitinfo canv
8593
8594 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8595 set hoverx $x
8596 set hovery $y
8597 set hoverid $id
8598 if {[info exists hovertimer]} {
8599 after cancel $hovertimer
8600 }
8601 set hovertimer [after 500 linehover]
8602 $canv delete hover
8603}
8604
8605proc linemotion {x y id} {
8606 global hoverx hovery hoverid hovertimer
8607
8608 if {[info exists hoverid] && $id == $hoverid} {
8609 set hoverx $x
8610 set hovery $y
8611 if {[info exists hovertimer]} {
8612 after cancel $hovertimer
8613 }
8614 set hovertimer [after 500 linehover]
8615 }
8616}
8617
8618proc lineleave {id} {
8619 global hoverid hovertimer canv
8620
8621 if {[info exists hoverid] && $id == $hoverid} {
8622 $canv delete hover
8623 if {[info exists hovertimer]} {
8624 after cancel $hovertimer
8625 unset hovertimer
8626 }
8627 unset hoverid
8628 }
8629}
8630
8631proc linehover {} {
8632 global hoverx hovery hoverid hovertimer
8633 global canv linespc lthickness
8634 global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8635
8636 global commitinfo
8637
8638 set text [lindex $commitinfo($hoverid) 0]
8639 set ymax [lindex [$canv cget -scrollregion] 3]
8640 if {$ymax == {}} return
8641 set yfrac [lindex [$canv yview] 0]
8642 set x [expr {$hoverx + 2 * $linespc}]
8643 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8644 set x0 [expr {$x - 2 * $lthickness}]
8645 set y0 [expr {$y - 2 * $lthickness}]
8646 set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8647 set y1 [expr {$y + $linespc + 2 * $lthickness}]
8648 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8649 -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8650 -width 1 -tags hover]
8651 $canv raise $t
8652 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8653 -font mainfont -fill $linehoverfgcolor]
8654 $canv raise $t
8655}
8656
8657proc clickisonarrow {id y} {
8658 global lthickness
8659
8660 set ranges [rowranges $id]
8661 set thresh [expr {2 * $lthickness + 6}]
8662 set n [expr {[llength $ranges] - 1}]
8663 for {set i 1} {$i < $n} {incr i} {
8664 set row [lindex $ranges $i]
8665 if {abs([yc $row] - $y) < $thresh} {
8666 return $i
8667 }
8668 }
8669 return {}
8670}
8671
8672proc arrowjump {id n y} {
8673 global canv
8674
8675 # 1 <-> 2, 3 <-> 4, etc...
8676 set n [expr {(($n - 1) ^ 1) + 1}]
8677 set row [lindex [rowranges $id] $n]
8678 set yt [yc $row]
8679 set ymax [lindex [$canv cget -scrollregion] 3]
8680 if {$ymax eq {} || $ymax <= 0} return
8681 set view [$canv yview]
8682 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8683 set yfrac [expr {$yt / $ymax - $yspan / 2}]
8684 if {$yfrac < 0} {
8685 set yfrac 0
8686 }
8687 allcanvs yview moveto $yfrac
8688}
8689
8690proc lineclick {x y id isnew} {
8691 global ctext commitinfo children canv thickerline curview
8692
8693 if {![info exists commitinfo($id)] && ![getcommit $id]} return
8694 unmarkmatches
8695 unselectline
8696 normalline
8697 $canv delete hover
8698 # draw this line thicker than normal
8699 set thickerline $id
8700 drawlines $id
8701 if {$isnew} {
8702 set ymax [lindex [$canv cget -scrollregion] 3]
8703 if {$ymax eq {}} return
8704 set yfrac [lindex [$canv yview] 0]
8705 set y [expr {$y + $yfrac * $ymax}]
8706 }
8707 set dirn [clickisonarrow $id $y]
8708 if {$dirn ne {}} {
8709 arrowjump $id $dirn $y
8710 return
8711 }
8712
8713 if {$isnew} {
8714 addtohistory [list lineclick $x $y $id 0] savectextpos
8715 }
8716 # fill the details pane with info about this line
8717 $ctext conf -state normal
8718 clear_ctext
8719 settabs 0
8720 $ctext insert end "[mc "Parent"]:\t"
8721 $ctext insert end $id link0
8722 setlink $id link0
8723 set info $commitinfo($id)
8724 $ctext insert end "\n\t[lindex $info 0]\n"
8725 $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8726 set date [formatdate [lindex $info 2]]
8727 $ctext insert end "\t[mc "Date"]:\t$date\n"
8728 set kids $children($curview,$id)
8729 if {$kids ne {}} {
8730 $ctext insert end "\n[mc "Children"]:"
8731 set i 0
8732 foreach child $kids {
8733 incr i
8734 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8735 set info $commitinfo($child)
8736 $ctext insert end "\n\t"
8737 $ctext insert end $child link$i
8738 setlink $child link$i
8739 $ctext insert end "\n\t[lindex $info 0]"
8740 $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8741 set date [formatdate [lindex $info 2]]
8742 $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8743 }
8744 }
8745 maybe_scroll_ctext 1
8746 $ctext conf -state disabled
8747 init_flist {}
8748}
8749
8750proc normalline {} {
8751 global thickerline
8752 if {[info exists thickerline]} {
8753 set id $thickerline
8754 unset thickerline
8755 drawlines $id
8756 }
8757}
8758
8759proc selbyid {id {isnew 1}} {
8760 global curview
8761 if {[commitinview $id $curview]} {
8762 selectline [rowofcommit $id] $isnew
8763 }
8764}
8765
8766proc mstime {} {
8767 global startmstime
8768 if {![info exists startmstime]} {
8769 set startmstime [clock clicks -milliseconds]
8770 }
8771 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8772}
8773
8774proc rowmenu {x y id} {
8775 global rowctxmenu selectedline rowmenuid curview
8776 global nullid nullid2 fakerowmenu mainhead markedid
8777
8778 stopfinding
8779 set rowmenuid $id
8780 if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8781 set state disabled
8782 } else {
8783 set state normal
8784 }
8785 if {[info exists markedid] && $markedid ne $id} {
8786 set mstate normal
8787 } else {
8788 set mstate disabled
8789 }
8790 if {$id ne $nullid && $id ne $nullid2} {
8791 set menu $rowctxmenu
8792 if {$mainhead ne {}} {
8793 $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8794 } else {
8795 $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8796 }
8797 $menu entryconfigure 9 -state $mstate
8798 $menu entryconfigure 10 -state $mstate
8799 $menu entryconfigure 11 -state $mstate
8800 } else {
8801 set menu $fakerowmenu
8802 }
8803 $menu entryconfigure [mca "Diff this -> selected"] -state $state
8804 $menu entryconfigure [mca "Diff selected -> this"] -state $state
8805 $menu entryconfigure [mca "Make patch"] -state $state
8806 $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8807 $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8808 tk_popup $menu $x $y
8809}
8810
8811proc markhere {} {
8812 global rowmenuid markedid canv
8813
8814 set markedid $rowmenuid
8815 make_idmark $markedid
8816}
8817
8818proc gotomark {} {
8819 global markedid
8820
8821 if {[info exists markedid]} {
8822 selbyid $markedid
8823 }
8824}
8825
8826proc replace_by_kids {l r} {
8827 global curview children
8828
8829 set id [commitonrow $r]
8830 set l [lreplace $l 0 0]
8831 foreach kid $children($curview,$id) {
8832 lappend l [rowofcommit $kid]
8833 }
8834 return [lsort -integer -decreasing -unique $l]
8835}
8836
8837proc find_common_desc {} {
8838 global markedid rowmenuid curview children
8839
8840 if {![info exists markedid]} return
8841 if {![commitinview $markedid $curview] ||
8842 ![commitinview $rowmenuid $curview]} return
8843 #set t1 [clock clicks -milliseconds]
8844 set l1 [list [rowofcommit $markedid]]
8845 set l2 [list [rowofcommit $rowmenuid]]
8846 while 1 {
8847 set r1 [lindex $l1 0]
8848 set r2 [lindex $l2 0]
8849 if {$r1 eq {} || $r2 eq {}} break
8850 if {$r1 == $r2} {
8851 selectline $r1 1
8852 break
8853 }
8854 if {$r1 > $r2} {
8855 set l1 [replace_by_kids $l1 $r1]
8856 } else {
8857 set l2 [replace_by_kids $l2 $r2]
8858 }
8859 }
8860 #set t2 [clock clicks -milliseconds]
8861 #puts "took [expr {$t2-$t1}]ms"
8862}
8863
8864proc compare_commits {} {
8865 global markedid rowmenuid curview children
8866
8867 if {![info exists markedid]} return
8868 if {![commitinview $markedid $curview]} return
8869 addtohistory [list do_cmp_commits $markedid $rowmenuid]
8870 do_cmp_commits $markedid $rowmenuid
8871}
8872
8873proc getpatchid {id} {
8874 global patchids
8875
8876 if {![info exists patchids($id)]} {
8877 set cmd [diffcmd [list $id] {-p --root}]
8878 # trim off the initial "|"
8879 set cmd [lrange $cmd 1 end]
8880 if {[catch {
8881 set x [eval exec $cmd | git patch-id]
8882 set patchids($id) [lindex $x 0]
8883 }]} {
8884 set patchids($id) "error"
8885 }
8886 }
8887 return $patchids($id)
8888}
8889
8890proc do_cmp_commits {a b} {
8891 global ctext curview parents children patchids commitinfo
8892
8893 $ctext conf -state normal
8894 clear_ctext
8895 init_flist {}
8896 for {set i 0} {$i < 100} {incr i} {
8897 set skipa 0
8898 set skipb 0
8899 if {[llength $parents($curview,$a)] > 1} {
8900 appendshortlink $a [mc "Skipping merge commit "] "\n"
8901 set skipa 1
8902 } else {
8903 set patcha [getpatchid $a]
8904 }
8905 if {[llength $parents($curview,$b)] > 1} {
8906 appendshortlink $b [mc "Skipping merge commit "] "\n"
8907 set skipb 1
8908 } else {
8909 set patchb [getpatchid $b]
8910 }
8911 if {!$skipa && !$skipb} {
8912 set heada [lindex $commitinfo($a) 0]
8913 set headb [lindex $commitinfo($b) 0]
8914 if {$patcha eq "error"} {
8915 appendshortlink $a [mc "Error getting patch ID for "] \
8916 [mc " - stopping\n"]
8917 break
8918 }
8919 if {$patchb eq "error"} {
8920 appendshortlink $b [mc "Error getting patch ID for "] \
8921 [mc " - stopping\n"]
8922 break
8923 }
8924 if {$patcha eq $patchb} {
8925 if {$heada eq $headb} {
8926 appendshortlink $a [mc "Commit "]
8927 appendshortlink $b " == " " $heada\n"
8928 } else {
8929 appendshortlink $a [mc "Commit "] " $heada\n"
8930 appendshortlink $b [mc " is the same patch as\n "] \
8931 " $headb\n"
8932 }
8933 set skipa 1
8934 set skipb 1
8935 } else {
8936 $ctext insert end "\n"
8937 appendshortlink $a [mc "Commit "] " $heada\n"
8938 appendshortlink $b [mc " differs from\n "] \
8939 " $headb\n"
8940 $ctext insert end [mc "Diff of commits:\n\n"]
8941 $ctext conf -state disabled
8942 update
8943 diffcommits $a $b
8944 return
8945 }
8946 }
8947 if {$skipa} {
8948 set kids [real_children $curview,$a]
8949 if {[llength $kids] != 1} {
8950 $ctext insert end "\n"
8951 appendshortlink $a [mc "Commit "] \
8952 [mc " has %s children - stopping\n" [llength $kids]]
8953 break
8954 }
8955 set a [lindex $kids 0]
8956 }
8957 if {$skipb} {
8958 set kids [real_children $curview,$b]
8959 if {[llength $kids] != 1} {
8960 appendshortlink $b [mc "Commit "] \
8961 [mc " has %s children - stopping\n" [llength $kids]]
8962 break
8963 }
8964 set b [lindex $kids 0]
8965 }
8966 }
8967 $ctext conf -state disabled
8968}
8969
8970proc diffcommits {a b} {
8971 global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8972
8973 set tmpdir [gitknewtmpdir]
8974 set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8975 set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8976 if {[catch {
8977 exec git diff-tree -p --pretty $a >$fna
8978 exec git diff-tree -p --pretty $b >$fnb
8979 } err]} {
8980 error_popup [mc "Error writing commit to file: %s" $err]
8981 return
8982 }
8983 if {[catch {
8984 set fd [open "| diff -U$diffcontext $fna $fnb" r]
8985 } err]} {
8986 error_popup [mc "Error diffing commits: %s" $err]
8987 return
8988 }
8989 set diffids [list commits $a $b]
8990 set blobdifffd($diffids) $fd
8991 set diffinhdr 0
8992 set currdiffsubmod ""
8993 filerun $fd [list getblobdiffline $fd $diffids]
8994}
8995
8996proc diffvssel {dirn} {
8997 global rowmenuid selectedline
8998
8999 if {$selectedline eq {}} return
9000 if {$dirn} {
9001 set oldid [commitonrow $selectedline]
9002 set newid $rowmenuid
9003 } else {
9004 set oldid $rowmenuid
9005 set newid [commitonrow $selectedline]
9006 }
9007 addtohistory [list doseldiff $oldid $newid] savectextpos
9008 doseldiff $oldid $newid
9009}
9010
9011proc diffvsmark {dirn} {
9012 global rowmenuid markedid
9013
9014 if {![info exists markedid]} return
9015 if {$dirn} {
9016 set oldid $markedid
9017 set newid $rowmenuid
9018 } else {
9019 set oldid $rowmenuid
9020 set newid $markedid
9021 }
9022 addtohistory [list doseldiff $oldid $newid] savectextpos
9023 doseldiff $oldid $newid
9024}
9025
9026proc doseldiff {oldid newid} {
9027 global ctext
9028 global commitinfo
9029
9030 $ctext conf -state normal
9031 clear_ctext
9032 init_flist [mc "Top"]
9033 $ctext insert end "[mc "From"] "
9034 $ctext insert end $oldid link0
9035 setlink $oldid link0
9036 $ctext insert end "\n "
9037 $ctext insert end [lindex $commitinfo($oldid) 0]
9038 $ctext insert end "\n\n[mc "To"] "
9039 $ctext insert end $newid link1
9040 setlink $newid link1
9041 $ctext insert end "\n "
9042 $ctext insert end [lindex $commitinfo($newid) 0]
9043 $ctext insert end "\n"
9044 $ctext conf -state disabled
9045 $ctext tag remove found 1.0 end
9046 startdiff [list $oldid $newid]
9047}
9048
9049proc mkpatch {} {
9050 global rowmenuid currentid commitinfo patchtop patchnum NS
9051
9052 if {![info exists currentid]} return
9053 set oldid $currentid
9054 set oldhead [lindex $commitinfo($oldid) 0]
9055 set newid $rowmenuid
9056 set newhead [lindex $commitinfo($newid) 0]
9057 set top .patch
9058 set patchtop $top
9059 catch {destroy $top}
9060 ttk_toplevel $top
9061 make_transient $top .
9062 ${NS}::label $top.title -text [mc "Generate patch"]
9063 grid $top.title - -pady 10
9064 ${NS}::label $top.from -text [mc "From:"]
9065 ${NS}::entry $top.fromsha1 -width 40
9066 $top.fromsha1 insert 0 $oldid
9067 $top.fromsha1 conf -state readonly
9068 grid $top.from $top.fromsha1 -sticky w
9069 ${NS}::entry $top.fromhead -width 60
9070 $top.fromhead insert 0 $oldhead
9071 $top.fromhead conf -state readonly
9072 grid x $top.fromhead -sticky w
9073 ${NS}::label $top.to -text [mc "To:"]
9074 ${NS}::entry $top.tosha1 -width 40
9075 $top.tosha1 insert 0 $newid
9076 $top.tosha1 conf -state readonly
9077 grid $top.to $top.tosha1 -sticky w
9078 ${NS}::entry $top.tohead -width 60
9079 $top.tohead insert 0 $newhead
9080 $top.tohead conf -state readonly
9081 grid x $top.tohead -sticky w
9082 ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9083 grid $top.rev x -pady 10 -padx 5
9084 ${NS}::label $top.flab -text [mc "Output file:"]
9085 ${NS}::entry $top.fname -width 60
9086 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9087 incr patchnum
9088 grid $top.flab $top.fname -sticky w
9089 ${NS}::frame $top.buts
9090 ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9091 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9092 bind $top <Key-Return> mkpatchgo
9093 bind $top <Key-Escape> mkpatchcan
9094 grid $top.buts.gen $top.buts.can
9095 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9096 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9097 grid $top.buts - -pady 10 -sticky ew
9098 focus $top.fname
9099}
9100
9101proc mkpatchrev {} {
9102 global patchtop
9103
9104 set oldid [$patchtop.fromsha1 get]
9105 set oldhead [$patchtop.fromhead get]
9106 set newid [$patchtop.tosha1 get]
9107 set newhead [$patchtop.tohead get]
9108 foreach e [list fromsha1 fromhead tosha1 tohead] \
9109 v [list $newid $newhead $oldid $oldhead] {
9110 $patchtop.$e conf -state normal
9111 $patchtop.$e delete 0 end
9112 $patchtop.$e insert 0 $v
9113 $patchtop.$e conf -state readonly
9114 }
9115}
9116
9117proc mkpatchgo {} {
9118 global patchtop nullid nullid2
9119
9120 set oldid [$patchtop.fromsha1 get]
9121 set newid [$patchtop.tosha1 get]
9122 set fname [$patchtop.fname get]
9123 set cmd [diffcmd [list $oldid $newid] -p]
9124 # trim off the initial "|"
9125 set cmd [lrange $cmd 1 end]
9126 lappend cmd >$fname &
9127 if {[catch {eval exec $cmd} err]} {
9128 error_popup "[mc "Error creating patch:"] $err" $patchtop
9129 }
9130 catch {destroy $patchtop}
9131 unset patchtop
9132}
9133
9134proc mkpatchcan {} {
9135 global patchtop
9136
9137 catch {destroy $patchtop}
9138 unset patchtop
9139}
9140
9141proc mktag {} {
9142 global rowmenuid mktagtop commitinfo NS
9143
9144 set top .maketag
9145 set mktagtop $top
9146 catch {destroy $top}
9147 ttk_toplevel $top
9148 make_transient $top .
9149 ${NS}::label $top.title -text [mc "Create tag"]
9150 grid $top.title - -pady 10
9151 ${NS}::label $top.id -text [mc "ID:"]
9152 ${NS}::entry $top.sha1 -width 40
9153 $top.sha1 insert 0 $rowmenuid
9154 $top.sha1 conf -state readonly
9155 grid $top.id $top.sha1 -sticky w
9156 ${NS}::entry $top.head -width 60
9157 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9158 $top.head conf -state readonly
9159 grid x $top.head -sticky w
9160 ${NS}::label $top.tlab -text [mc "Tag name:"]
9161 ${NS}::entry $top.tag -width 60
9162 grid $top.tlab $top.tag -sticky w
9163 ${NS}::label $top.op -text [mc "Tag message is optional"]
9164 grid $top.op -columnspan 2 -sticky we
9165 ${NS}::label $top.mlab -text [mc "Tag message:"]
9166 ${NS}::entry $top.msg -width 60
9167 grid $top.mlab $top.msg -sticky w
9168 ${NS}::frame $top.buts
9169 ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9170 ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9171 bind $top <Key-Return> mktaggo
9172 bind $top <Key-Escape> mktagcan
9173 grid $top.buts.gen $top.buts.can
9174 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9175 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9176 grid $top.buts - -pady 10 -sticky ew
9177 focus $top.tag
9178}
9179
9180proc domktag {} {
9181 global mktagtop env tagids idtags
9182
9183 set id [$mktagtop.sha1 get]
9184 set tag [$mktagtop.tag get]
9185 set msg [$mktagtop.msg get]
9186 if {$tag == {}} {
9187 error_popup [mc "No tag name specified"] $mktagtop
9188 return 0
9189 }
9190 if {[info exists tagids($tag)]} {
9191 error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9192 return 0
9193 }
9194 if {[catch {
9195 if {$msg != {}} {
9196 exec git tag -a -m $msg $tag $id
9197 } else {
9198 exec git tag $tag $id
9199 }
9200 } err]} {
9201 error_popup "[mc "Error creating tag:"] $err" $mktagtop
9202 return 0
9203 }
9204
9205 set tagids($tag) $id
9206 lappend idtags($id) $tag
9207 redrawtags $id
9208 addedtag $id
9209 dispneartags 0
9210 run refill_reflist
9211 return 1
9212}
9213
9214proc redrawtags {id} {
9215 global canv linehtag idpos currentid curview cmitlisted markedid
9216 global canvxmax iddrawn circleitem mainheadid circlecolors
9217 global mainheadcirclecolor
9218
9219 if {![commitinview $id $curview]} return
9220 if {![info exists iddrawn($id)]} return
9221 set row [rowofcommit $id]
9222 if {$id eq $mainheadid} {
9223 set ofill $mainheadcirclecolor
9224 } else {
9225 set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9226 }
9227 $canv itemconf $circleitem($row) -fill $ofill
9228 $canv delete tag.$id
9229 set xt [eval drawtags $id $idpos($id)]
9230 $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9231 set text [$canv itemcget $linehtag($id) -text]
9232 set font [$canv itemcget $linehtag($id) -font]
9233 set xr [expr {$xt + [font measure $font $text]}]
9234 if {$xr > $canvxmax} {
9235 set canvxmax $xr
9236 setcanvscroll
9237 }
9238 if {[info exists currentid] && $currentid == $id} {
9239 make_secsel $id
9240 }
9241 if {[info exists markedid] && $markedid eq $id} {
9242 make_idmark $id
9243 }
9244}
9245
9246proc mktagcan {} {
9247 global mktagtop
9248
9249 catch {destroy $mktagtop}
9250 unset mktagtop
9251}
9252
9253proc mktaggo {} {
9254 if {![domktag]} return
9255 mktagcan
9256}
9257
9258proc writecommit {} {
9259 global rowmenuid wrcomtop commitinfo wrcomcmd NS
9260
9261 set top .writecommit
9262 set wrcomtop $top
9263 catch {destroy $top}
9264 ttk_toplevel $top
9265 make_transient $top .
9266 ${NS}::label $top.title -text [mc "Write commit to file"]
9267 grid $top.title - -pady 10
9268 ${NS}::label $top.id -text [mc "ID:"]
9269 ${NS}::entry $top.sha1 -width 40
9270 $top.sha1 insert 0 $rowmenuid
9271 $top.sha1 conf -state readonly
9272 grid $top.id $top.sha1 -sticky w
9273 ${NS}::entry $top.head -width 60
9274 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9275 $top.head conf -state readonly
9276 grid x $top.head -sticky w
9277 ${NS}::label $top.clab -text [mc "Command:"]
9278 ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9279 grid $top.clab $top.cmd -sticky w -pady 10
9280 ${NS}::label $top.flab -text [mc "Output file:"]
9281 ${NS}::entry $top.fname -width 60
9282 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9283 grid $top.flab $top.fname -sticky w
9284 ${NS}::frame $top.buts
9285 ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9286 ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9287 bind $top <Key-Return> wrcomgo
9288 bind $top <Key-Escape> wrcomcan
9289 grid $top.buts.gen $top.buts.can
9290 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9291 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9292 grid $top.buts - -pady 10 -sticky ew
9293 focus $top.fname
9294}
9295
9296proc wrcomgo {} {
9297 global wrcomtop
9298
9299 set id [$wrcomtop.sha1 get]
9300 set cmd "echo $id | [$wrcomtop.cmd get]"
9301 set fname [$wrcomtop.fname get]
9302 if {[catch {exec sh -c $cmd >$fname &} err]} {
9303 error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9304 }
9305 catch {destroy $wrcomtop}
9306 unset wrcomtop
9307}
9308
9309proc wrcomcan {} {
9310 global wrcomtop
9311
9312 catch {destroy $wrcomtop}
9313 unset wrcomtop
9314}
9315
9316proc mkbranch {} {
9317 global rowmenuid mkbrtop NS
9318
9319 set top .makebranch
9320 catch {destroy $top}
9321 ttk_toplevel $top
9322 make_transient $top .
9323 ${NS}::label $top.title -text [mc "Create new branch"]
9324 grid $top.title - -pady 10
9325 ${NS}::label $top.id -text [mc "ID:"]
9326 ${NS}::entry $top.sha1 -width 40
9327 $top.sha1 insert 0 $rowmenuid
9328 $top.sha1 conf -state readonly
9329 grid $top.id $top.sha1 -sticky w
9330 ${NS}::label $top.nlab -text [mc "Name:"]
9331 ${NS}::entry $top.name -width 40
9332 grid $top.nlab $top.name -sticky w
9333 ${NS}::frame $top.buts
9334 ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9335 ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9336 bind $top <Key-Return> [list mkbrgo $top]
9337 bind $top <Key-Escape> "catch {destroy $top}"
9338 grid $top.buts.go $top.buts.can
9339 grid columnconfigure $top.buts 0 -weight 1 -uniform a
9340 grid columnconfigure $top.buts 1 -weight 1 -uniform a
9341 grid $top.buts - -pady 10 -sticky ew
9342 focus $top.name
9343}
9344
9345proc mkbrgo {top} {
9346 global headids idheads
9347
9348 set name [$top.name get]
9349 set id [$top.sha1 get]
9350 set cmdargs {}
9351 set old_id {}
9352 if {$name eq {}} {
9353 error_popup [mc "Please specify a name for the new branch"] $top
9354 return
9355 }
9356 if {[info exists headids($name)]} {
9357 if {![confirm_popup [mc \
9358 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9359 return
9360 }
9361 set old_id $headids($name)
9362 lappend cmdargs -f
9363 }
9364 catch {destroy $top}
9365 lappend cmdargs $name $id
9366 nowbusy newbranch
9367 update
9368 if {[catch {
9369 eval exec git branch $cmdargs
9370 } err]} {
9371 notbusy newbranch
9372 error_popup $err
9373 } else {
9374 notbusy newbranch
9375 if {$old_id ne {}} {
9376 movehead $id $name
9377 movedhead $id $name
9378 redrawtags $old_id
9379 redrawtags $id
9380 } else {
9381 set headids($name) $id
9382 lappend idheads($id) $name
9383 addedhead $id $name
9384 redrawtags $id
9385 }
9386 dispneartags 0
9387 run refill_reflist
9388 }
9389}
9390
9391proc exec_citool {tool_args {baseid {}}} {
9392 global commitinfo env
9393
9394 set save_env [array get env GIT_AUTHOR_*]
9395
9396 if {$baseid ne {}} {
9397 if {![info exists commitinfo($baseid)]} {
9398 getcommit $baseid
9399 }
9400 set author [lindex $commitinfo($baseid) 1]
9401 set date [lindex $commitinfo($baseid) 2]
9402 if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9403 $author author name email]
9404 && $date ne {}} {
9405 set env(GIT_AUTHOR_NAME) $name
9406 set env(GIT_AUTHOR_EMAIL) $email
9407 set env(GIT_AUTHOR_DATE) $date
9408 }
9409 }
9410
9411 eval exec git citool $tool_args &
9412
9413 array unset env GIT_AUTHOR_*
9414 array set env $save_env
9415}
9416
9417proc cherrypick {} {
9418 global rowmenuid curview
9419 global mainhead mainheadid
9420 global gitdir
9421
9422 set oldhead [exec git rev-parse HEAD]
9423 set dheads [descheads $rowmenuid]
9424 if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9425 set ok [confirm_popup [mc "Commit %s is already\
9426 included in branch %s -- really re-apply it?" \
9427 [string range $rowmenuid 0 7] $mainhead]]
9428 if {!$ok} return
9429 }
9430 nowbusy cherrypick [mc "Cherry-picking"]
9431 update
9432 # Unfortunately git-cherry-pick writes stuff to stderr even when
9433 # no error occurs, and exec takes that as an indication of error...
9434 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9435 notbusy cherrypick
9436 if {[regexp -line \
9437 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9438 $err msg fname]} {
9439 error_popup [mc "Cherry-pick failed because of local changes\
9440 to file '%s'.\nPlease commit, reset or stash\
9441 your changes and try again." $fname]
9442 } elseif {[regexp -line \
9443 {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9444 $err]} {
9445 if {[confirm_popup [mc "Cherry-pick failed because of merge\
9446 conflict.\nDo you wish to run git citool to\
9447 resolve it?"]]} {
9448 # Force citool to read MERGE_MSG
9449 file delete [file join $gitdir "GITGUI_MSG"]
9450 exec_citool {} $rowmenuid
9451 }
9452 } else {
9453 error_popup $err
9454 }
9455 run updatecommits
9456 return
9457 }
9458 set newhead [exec git rev-parse HEAD]
9459 if {$newhead eq $oldhead} {
9460 notbusy cherrypick
9461 error_popup [mc "No changes committed"]
9462 return
9463 }
9464 addnewchild $newhead $oldhead
9465 if {[commitinview $oldhead $curview]} {
9466 # XXX this isn't right if we have a path limit...
9467 insertrow $newhead $oldhead $curview
9468 if {$mainhead ne {}} {
9469 movehead $newhead $mainhead
9470 movedhead $newhead $mainhead
9471 }
9472 set mainheadid $newhead
9473 redrawtags $oldhead
9474 redrawtags $newhead
9475 selbyid $newhead
9476 }
9477 notbusy cherrypick
9478}
9479
9480proc revert {} {
9481 global rowmenuid curview
9482 global mainhead mainheadid
9483 global gitdir
9484
9485 set oldhead [exec git rev-parse HEAD]
9486 set dheads [descheads $rowmenuid]
9487 if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9488 set ok [confirm_popup [mc "Commit %s is not\
9489 included in branch %s -- really revert it?" \
9490 [string range $rowmenuid 0 7] $mainhead]]
9491 if {!$ok} return
9492 }
9493 nowbusy revert [mc "Reverting"]
9494 update
9495
9496 if [catch {exec git revert --no-edit $rowmenuid} err] {
9497 notbusy revert
9498 if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9499 $err match files] {
9500 regsub {\n( |\t)+} $files "\n" files
9501 error_popup [mc "Revert failed because of local changes to\
9502 the following files:%s Please commit, reset or stash \
9503 your changes and try again." $files]
9504 } elseif [regexp {error: could not revert} $err] {
9505 if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9506 Do you wish to run git citool to resolve it?"]] {
9507 # Force citool to read MERGE_MSG
9508 file delete [file join $gitdir "GITGUI_MSG"]
9509 exec_citool {} $rowmenuid
9510 }
9511 } else { error_popup $err }
9512 run updatecommits
9513 return
9514 }
9515
9516 set newhead [exec git rev-parse HEAD]
9517 if { $newhead eq $oldhead } {
9518 notbusy revert
9519 error_popup [mc "No changes committed"]
9520 return
9521 }
9522
9523 addnewchild $newhead $oldhead
9524
9525 if [commitinview $oldhead $curview] {
9526 # XXX this isn't right if we have a path limit...
9527 insertrow $newhead $oldhead $curview
9528 if {$mainhead ne {}} {
9529 movehead $newhead $mainhead
9530 movedhead $newhead $mainhead
9531 }
9532 set mainheadid $newhead
9533 redrawtags $oldhead
9534 redrawtags $newhead
9535 selbyid $newhead
9536 }
9537
9538 notbusy revert
9539}
9540
9541proc resethead {} {
9542 global mainhead rowmenuid confirm_ok resettype NS
9543
9544 set confirm_ok 0
9545 set w ".confirmreset"
9546 ttk_toplevel $w
9547 make_transient $w .
9548 wm title $w [mc "Confirm reset"]
9549 ${NS}::label $w.m -text \
9550 [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9551 pack $w.m -side top -fill x -padx 20 -pady 20
9552 ${NS}::labelframe $w.f -text [mc "Reset type:"]
9553 set resettype mixed
9554 ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9555 -text [mc "Soft: Leave working tree and index untouched"]
9556 grid $w.f.soft -sticky w
9557 ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9558 -text [mc "Mixed: Leave working tree untouched, reset index"]
9559 grid $w.f.mixed -sticky w
9560 ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9561 -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9562 grid $w.f.hard -sticky w
9563 pack $w.f -side top -fill x -padx 4
9564 ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9565 pack $w.ok -side left -fill x -padx 20 -pady 20
9566 ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9567 bind $w <Key-Escape> [list destroy $w]
9568 pack $w.cancel -side right -fill x -padx 20 -pady 20
9569 bind $w <Visibility> "grab $w; focus $w"
9570 tkwait window $w
9571 if {!$confirm_ok} return
9572 if {[catch {set fd [open \
9573 [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9574 error_popup $err
9575 } else {
9576 dohidelocalchanges
9577 filerun $fd [list readresetstat $fd]
9578 nowbusy reset [mc "Resetting"]
9579 selbyid $rowmenuid
9580 }
9581}
9582
9583proc readresetstat {fd} {
9584 global mainhead mainheadid showlocalchanges rprogcoord
9585
9586 if {[gets $fd line] >= 0} {
9587 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9588 set rprogcoord [expr {1.0 * $m / $n}]
9589 adjustprogress
9590 }
9591 return 1
9592 }
9593 set rprogcoord 0
9594 adjustprogress
9595 notbusy reset
9596 if {[catch {close $fd} err]} {
9597 error_popup $err
9598 }
9599 set oldhead $mainheadid
9600 set newhead [exec git rev-parse HEAD]
9601 if {$newhead ne $oldhead} {
9602 movehead $newhead $mainhead
9603 movedhead $newhead $mainhead
9604 set mainheadid $newhead
9605 redrawtags $oldhead
9606 redrawtags $newhead
9607 }
9608 if {$showlocalchanges} {
9609 doshowlocalchanges
9610 }
9611 return 0
9612}
9613
9614# context menu for a head
9615proc headmenu {x y id head} {
9616 global headmenuid headmenuhead headctxmenu mainhead
9617
9618 stopfinding
9619 set headmenuid $id
9620 set headmenuhead $head
9621 set state normal
9622 if {[string match "remotes/*" $head]} {
9623 set state disabled
9624 }
9625 if {$head eq $mainhead} {
9626 set state disabled
9627 }
9628 $headctxmenu entryconfigure 0 -state $state
9629 $headctxmenu entryconfigure 1 -state $state
9630 tk_popup $headctxmenu $x $y
9631}
9632
9633proc cobranch {} {
9634 global headmenuid headmenuhead headids
9635 global showlocalchanges
9636
9637 # check the tree is clean first??
9638 nowbusy checkout [mc "Checking out"]
9639 update
9640 dohidelocalchanges
9641 if {[catch {
9642 set fd [open [list | git checkout $headmenuhead 2>@1] r]
9643 } err]} {
9644 notbusy checkout
9645 error_popup $err
9646 if {$showlocalchanges} {
9647 dodiffindex
9648 }
9649 } else {
9650 filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9651 }
9652}
9653
9654proc readcheckoutstat {fd newhead newheadid} {
9655 global mainhead mainheadid headids showlocalchanges progresscoords
9656 global viewmainheadid curview
9657
9658 if {[gets $fd line] >= 0} {
9659 if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9660 set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9661 adjustprogress
9662 }
9663 return 1
9664 }
9665 set progresscoords {0 0}
9666 adjustprogress
9667 notbusy checkout
9668 if {[catch {close $fd} err]} {
9669 error_popup $err
9670 }
9671 set oldmainid $mainheadid
9672 set mainhead $newhead
9673 set mainheadid $newheadid
9674 set viewmainheadid($curview) $newheadid
9675 redrawtags $oldmainid
9676 redrawtags $newheadid
9677 selbyid $newheadid
9678 if {$showlocalchanges} {
9679 dodiffindex
9680 }
9681}
9682
9683proc rmbranch {} {
9684 global headmenuid headmenuhead mainhead
9685 global idheads
9686
9687 set head $headmenuhead
9688 set id $headmenuid
9689 # this check shouldn't be needed any more...
9690 if {$head eq $mainhead} {
9691 error_popup [mc "Cannot delete the currently checked-out branch"]
9692 return
9693 }
9694 set dheads [descheads $id]
9695 if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9696 # the stuff on this branch isn't on any other branch
9697 if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9698 branch.\nReally delete branch %s?" $head $head]]} return
9699 }
9700 nowbusy rmbranch
9701 update
9702 if {[catch {exec git branch -D $head} err]} {
9703 notbusy rmbranch
9704 error_popup $err
9705 return
9706 }
9707 removehead $id $head
9708 removedhead $id $head
9709 redrawtags $id
9710 notbusy rmbranch
9711 dispneartags 0
9712 run refill_reflist
9713}
9714
9715# Display a list of tags and heads
9716proc showrefs {} {
9717 global showrefstop bgcolor fgcolor selectbgcolor NS
9718 global bglist fglist reflistfilter reflist maincursor
9719
9720 set top .showrefs
9721 set showrefstop $top
9722 if {[winfo exists $top]} {
9723 raise $top
9724 refill_reflist
9725 return
9726 }
9727 ttk_toplevel $top
9728 wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9729 make_transient $top .
9730 text $top.list -background $bgcolor -foreground $fgcolor \
9731 -selectbackground $selectbgcolor -font mainfont \
9732 -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9733 -width 30 -height 20 -cursor $maincursor \
9734 -spacing1 1 -spacing3 1 -state disabled
9735 $top.list tag configure highlight -background $selectbgcolor
9736 lappend bglist $top.list
9737 lappend fglist $top.list
9738 ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9739 ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9740 grid $top.list $top.ysb -sticky nsew
9741 grid $top.xsb x -sticky ew
9742 ${NS}::frame $top.f
9743 ${NS}::label $top.f.l -text "[mc "Filter"]: "
9744 ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9745 set reflistfilter "*"
9746 trace add variable reflistfilter write reflistfilter_change
9747 pack $top.f.e -side right -fill x -expand 1
9748 pack $top.f.l -side left
9749 grid $top.f - -sticky ew -pady 2
9750 ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9751 bind $top <Key-Escape> [list destroy $top]
9752 grid $top.close -
9753 grid columnconfigure $top 0 -weight 1
9754 grid rowconfigure $top 0 -weight 1
9755 bind $top.list <1> {break}
9756 bind $top.list <B1-Motion> {break}
9757 bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9758 set reflist {}
9759 refill_reflist
9760}
9761
9762proc sel_reflist {w x y} {
9763 global showrefstop reflist headids tagids otherrefids
9764
9765 if {![winfo exists $showrefstop]} return
9766 set l [lindex [split [$w index "@$x,$y"] "."] 0]
9767 set ref [lindex $reflist [expr {$l-1}]]
9768 set n [lindex $ref 0]
9769 switch -- [lindex $ref 1] {
9770 "H" {selbyid $headids($n)}
9771 "T" {selbyid $tagids($n)}
9772 "o" {selbyid $otherrefids($n)}
9773 }
9774 $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9775}
9776
9777proc unsel_reflist {} {
9778 global showrefstop
9779
9780 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9781 $showrefstop.list tag remove highlight 0.0 end
9782}
9783
9784proc reflistfilter_change {n1 n2 op} {
9785 global reflistfilter
9786
9787 after cancel refill_reflist
9788 after 200 refill_reflist
9789}
9790
9791proc refill_reflist {} {
9792 global reflist reflistfilter showrefstop headids tagids otherrefids
9793 global curview
9794
9795 if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9796 set refs {}
9797 foreach n [array names headids] {
9798 if {[string match $reflistfilter $n]} {
9799 if {[commitinview $headids($n) $curview]} {
9800 lappend refs [list $n H]
9801 } else {
9802 interestedin $headids($n) {run refill_reflist}
9803 }
9804 }
9805 }
9806 foreach n [array names tagids] {
9807 if {[string match $reflistfilter $n]} {
9808 if {[commitinview $tagids($n) $curview]} {
9809 lappend refs [list $n T]
9810 } else {
9811 interestedin $tagids($n) {run refill_reflist}
9812 }
9813 }
9814 }
9815 foreach n [array names otherrefids] {
9816 if {[string match $reflistfilter $n]} {
9817 if {[commitinview $otherrefids($n) $curview]} {
9818 lappend refs [list $n o]
9819 } else {
9820 interestedin $otherrefids($n) {run refill_reflist}
9821 }
9822 }
9823 }
9824 set refs [lsort -index 0 $refs]
9825 if {$refs eq $reflist} return
9826
9827 # Update the contents of $showrefstop.list according to the
9828 # differences between $reflist (old) and $refs (new)
9829 $showrefstop.list conf -state normal
9830 $showrefstop.list insert end "\n"
9831 set i 0
9832 set j 0
9833 while {$i < [llength $reflist] || $j < [llength $refs]} {
9834 if {$i < [llength $reflist]} {
9835 if {$j < [llength $refs]} {
9836 set cmp [string compare [lindex $reflist $i 0] \
9837 [lindex $refs $j 0]]
9838 if {$cmp == 0} {
9839 set cmp [string compare [lindex $reflist $i 1] \
9840 [lindex $refs $j 1]]
9841 }
9842 } else {
9843 set cmp -1
9844 }
9845 } else {
9846 set cmp 1
9847 }
9848 switch -- $cmp {
9849 -1 {
9850 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9851 incr i
9852 }
9853 0 {
9854 incr i
9855 incr j
9856 }
9857 1 {
9858 set l [expr {$j + 1}]
9859 $showrefstop.list image create $l.0 -align baseline \
9860 -image reficon-[lindex $refs $j 1] -padx 2
9861 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9862 incr j
9863 }
9864 }
9865 }
9866 set reflist $refs
9867 # delete last newline
9868 $showrefstop.list delete end-2c end-1c
9869 $showrefstop.list conf -state disabled
9870}
9871
9872# Stuff for finding nearby tags
9873proc getallcommits {} {
9874 global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9875 global idheads idtags idotherrefs allparents tagobjid
9876 global gitdir
9877
9878 if {![info exists allcommits]} {
9879 set nextarc 0
9880 set allcommits 0
9881 set seeds {}
9882 set allcwait 0
9883 set cachedarcs 0
9884 set allccache [file join $gitdir "gitk.cache"]
9885 if {![catch {
9886 set f [open $allccache r]
9887 set allcwait 1
9888 getcache $f
9889 }]} return
9890 }
9891
9892 if {$allcwait} {
9893 return
9894 }
9895 set cmd [list | git rev-list --parents]
9896 set allcupdate [expr {$seeds ne {}}]
9897 if {!$allcupdate} {
9898 set ids "--all"
9899 } else {
9900 set refs [concat [array names idheads] [array names idtags] \
9901 [array names idotherrefs]]
9902 set ids {}
9903 set tagobjs {}
9904 foreach name [array names tagobjid] {
9905 lappend tagobjs $tagobjid($name)
9906 }
9907 foreach id [lsort -unique $refs] {
9908 if {![info exists allparents($id)] &&
9909 [lsearch -exact $tagobjs $id] < 0} {
9910 lappend ids $id
9911 }
9912 }
9913 if {$ids ne {}} {
9914 foreach id $seeds {
9915 lappend ids "^$id"
9916 }
9917 }
9918 }
9919 if {$ids ne {}} {
9920 set fd [open [concat $cmd $ids] r]
9921 fconfigure $fd -blocking 0
9922 incr allcommits
9923 nowbusy allcommits
9924 filerun $fd [list getallclines $fd]
9925 } else {
9926 dispneartags 0
9927 }
9928}
9929
9930# Since most commits have 1 parent and 1 child, we group strings of
9931# such commits into "arcs" joining branch/merge points (BMPs), which
9932# are commits that either don't have 1 parent or don't have 1 child.
9933#
9934# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9935# arcout(id) - outgoing arcs for BMP
9936# arcids(a) - list of IDs on arc including end but not start
9937# arcstart(a) - BMP ID at start of arc
9938# arcend(a) - BMP ID at end of arc
9939# growing(a) - arc a is still growing
9940# arctags(a) - IDs out of arcids (excluding end) that have tags
9941# archeads(a) - IDs out of arcids (excluding end) that have heads
9942# The start of an arc is at the descendent end, so "incoming" means
9943# coming from descendents, and "outgoing" means going towards ancestors.
9944
9945proc getallclines {fd} {
9946 global allparents allchildren idtags idheads nextarc
9947 global arcnos arcids arctags arcout arcend arcstart archeads growing
9948 global seeds allcommits cachedarcs allcupdate
9949
9950 set nid 0
9951 while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9952 set id [lindex $line 0]
9953 if {[info exists allparents($id)]} {
9954 # seen it already
9955 continue
9956 }
9957 set cachedarcs 0
9958 set olds [lrange $line 1 end]
9959 set allparents($id) $olds
9960 if {![info exists allchildren($id)]} {
9961 set allchildren($id) {}
9962 set arcnos($id) {}
9963 lappend seeds $id
9964 } else {
9965 set a $arcnos($id)
9966 if {[llength $olds] == 1 && [llength $a] == 1} {
9967 lappend arcids($a) $id
9968 if {[info exists idtags($id)]} {
9969 lappend arctags($a) $id
9970 }
9971 if {[info exists idheads($id)]} {
9972 lappend archeads($a) $id
9973 }
9974 if {[info exists allparents($olds)]} {
9975 # seen parent already
9976 if {![info exists arcout($olds)]} {
9977 splitarc $olds
9978 }
9979 lappend arcids($a) $olds
9980 set arcend($a) $olds
9981 unset growing($a)
9982 }
9983 lappend allchildren($olds) $id
9984 lappend arcnos($olds) $a
9985 continue
9986 }
9987 }
9988 foreach a $arcnos($id) {
9989 lappend arcids($a) $id
9990 set arcend($a) $id
9991 unset growing($a)
9992 }
9993
9994 set ao {}
9995 foreach p $olds {
9996 lappend allchildren($p) $id
9997 set a [incr nextarc]
9998 set arcstart($a) $id
9999 set archeads($a) {}
10000 set arctags($a) {}
10001 set archeads($a) {}
10002 set arcids($a) {}
10003 lappend ao $a
10004 set growing($a) 1
10005 if {[info exists allparents($p)]} {
10006 # seen it already, may need to make a new branch
10007 if {![info exists arcout($p)]} {
10008 splitarc $p
10009 }
10010 lappend arcids($a) $p
10011 set arcend($a) $p
10012 unset growing($a)
10013 }
10014 lappend arcnos($p) $a
10015 }
10016 set arcout($id) $ao
10017 }
10018 if {$nid > 0} {
10019 global cached_dheads cached_dtags cached_atags
10020 catch {unset cached_dheads}
10021 catch {unset cached_dtags}
10022 catch {unset cached_atags}
10023 }
10024 if {![eof $fd]} {
10025 return [expr {$nid >= 1000? 2: 1}]
10026 }
10027 set cacheok 1
10028 if {[catch {
10029 fconfigure $fd -blocking 1
10030 close $fd
10031 } err]} {
10032 # got an error reading the list of commits
10033 # if we were updating, try rereading the whole thing again
10034 if {$allcupdate} {
10035 incr allcommits -1
10036 dropcache $err
10037 return
10038 }
10039 error_popup "[mc "Error reading commit topology information;\
10040 branch and preceding/following tag information\
10041 will be incomplete."]\n($err)"
10042 set cacheok 0
10043 }
10044 if {[incr allcommits -1] == 0} {
10045 notbusy allcommits
10046 if {$cacheok} {
10047 run savecache
10048 }
10049 }
10050 dispneartags 0
10051 return 0
10052}
10053
10054proc recalcarc {a} {
10055 global arctags archeads arcids idtags idheads
10056
10057 set at {}
10058 set ah {}
10059 foreach id [lrange $arcids($a) 0 end-1] {
10060 if {[info exists idtags($id)]} {
10061 lappend at $id
10062 }
10063 if {[info exists idheads($id)]} {
10064 lappend ah $id
10065 }
10066 }
10067 set arctags($a) $at
10068 set archeads($a) $ah
10069}
10070
10071proc splitarc {p} {
10072 global arcnos arcids nextarc arctags archeads idtags idheads
10073 global arcstart arcend arcout allparents growing
10074
10075 set a $arcnos($p)
10076 if {[llength $a] != 1} {
10077 puts "oops splitarc called but [llength $a] arcs already"
10078 return
10079 }
10080 set a [lindex $a 0]
10081 set i [lsearch -exact $arcids($a) $p]
10082 if {$i < 0} {
10083 puts "oops splitarc $p not in arc $a"
10084 return
10085 }
10086 set na [incr nextarc]
10087 if {[info exists arcend($a)]} {
10088 set arcend($na) $arcend($a)
10089 } else {
10090 set l [lindex $allparents([lindex $arcids($a) end]) 0]
10091 set j [lsearch -exact $arcnos($l) $a]
10092 set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10093 }
10094 set tail [lrange $arcids($a) [expr {$i+1}] end]
10095 set arcids($a) [lrange $arcids($a) 0 $i]
10096 set arcend($a) $p
10097 set arcstart($na) $p
10098 set arcout($p) $na
10099 set arcids($na) $tail
10100 if {[info exists growing($a)]} {
10101 set growing($na) 1
10102 unset growing($a)
10103 }
10104
10105 foreach id $tail {
10106 if {[llength $arcnos($id)] == 1} {
10107 set arcnos($id) $na
10108 } else {
10109 set j [lsearch -exact $arcnos($id) $a]
10110 set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10111 }
10112 }
10113
10114 # reconstruct tags and heads lists
10115 if {$arctags($a) ne {} || $archeads($a) ne {}} {
10116 recalcarc $a
10117 recalcarc $na
10118 } else {
10119 set arctags($na) {}
10120 set archeads($na) {}
10121 }
10122}
10123
10124# Update things for a new commit added that is a child of one
10125# existing commit. Used when cherry-picking.
10126proc addnewchild {id p} {
10127 global allparents allchildren idtags nextarc
10128 global arcnos arcids arctags arcout arcend arcstart archeads growing
10129 global seeds allcommits
10130
10131 if {![info exists allcommits] || ![info exists arcnos($p)]} return
10132 set allparents($id) [list $p]
10133 set allchildren($id) {}
10134 set arcnos($id) {}
10135 lappend seeds $id
10136 lappend allchildren($p) $id
10137 set a [incr nextarc]
10138 set arcstart($a) $id
10139 set archeads($a) {}
10140 set arctags($a) {}
10141 set arcids($a) [list $p]
10142 set arcend($a) $p
10143 if {![info exists arcout($p)]} {
10144 splitarc $p
10145 }
10146 lappend arcnos($p) $a
10147 set arcout($id) [list $a]
10148}
10149
10150# This implements a cache for the topology information.
10151# The cache saves, for each arc, the start and end of the arc,
10152# the ids on the arc, and the outgoing arcs from the end.
10153proc readcache {f} {
10154 global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10155 global idtags idheads allparents cachedarcs possible_seeds seeds growing
10156 global allcwait
10157
10158 set a $nextarc
10159 set lim $cachedarcs
10160 if {$lim - $a > 500} {
10161 set lim [expr {$a + 500}]
10162 }
10163 if {[catch {
10164 if {$a == $lim} {
10165 # finish reading the cache and setting up arctags, etc.
10166 set line [gets $f]
10167 if {$line ne "1"} {error "bad final version"}
10168 close $f
10169 foreach id [array names idtags] {
10170 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10171 [llength $allparents($id)] == 1} {
10172 set a [lindex $arcnos($id) 0]
10173 if {$arctags($a) eq {}} {
10174 recalcarc $a
10175 }
10176 }
10177 }
10178 foreach id [array names idheads] {
10179 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10180 [llength $allparents($id)] == 1} {
10181 set a [lindex $arcnos($id) 0]
10182 if {$archeads($a) eq {}} {
10183 recalcarc $a
10184 }
10185 }
10186 }
10187 foreach id [lsort -unique $possible_seeds] {
10188 if {$arcnos($id) eq {}} {
10189 lappend seeds $id
10190 }
10191 }
10192 set allcwait 0
10193 } else {
10194 while {[incr a] <= $lim} {
10195 set line [gets $f]
10196 if {[llength $line] != 3} {error "bad line"}
10197 set s [lindex $line 0]
10198 set arcstart($a) $s
10199 lappend arcout($s) $a
10200 if {![info exists arcnos($s)]} {
10201 lappend possible_seeds $s
10202 set arcnos($s) {}
10203 }
10204 set e [lindex $line 1]
10205 if {$e eq {}} {
10206 set growing($a) 1
10207 } else {
10208 set arcend($a) $e
10209 if {![info exists arcout($e)]} {
10210 set arcout($e) {}
10211 }
10212 }
10213 set arcids($a) [lindex $line 2]
10214 foreach id $arcids($a) {
10215 lappend allparents($s) $id
10216 set s $id
10217 lappend arcnos($id) $a
10218 }
10219 if {![info exists allparents($s)]} {
10220 set allparents($s) {}
10221 }
10222 set arctags($a) {}
10223 set archeads($a) {}
10224 }
10225 set nextarc [expr {$a - 1}]
10226 }
10227 } err]} {
10228 dropcache $err
10229 return 0
10230 }
10231 if {!$allcwait} {
10232 getallcommits
10233 }
10234 return $allcwait
10235}
10236
10237proc getcache {f} {
10238 global nextarc cachedarcs possible_seeds
10239
10240 if {[catch {
10241 set line [gets $f]
10242 if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10243 # make sure it's an integer
10244 set cachedarcs [expr {int([lindex $line 1])}]
10245 if {$cachedarcs < 0} {error "bad number of arcs"}
10246 set nextarc 0
10247 set possible_seeds {}
10248 run readcache $f
10249 } err]} {
10250 dropcache $err
10251 }
10252 return 0
10253}
10254
10255proc dropcache {err} {
10256 global allcwait nextarc cachedarcs seeds
10257
10258 #puts "dropping cache ($err)"
10259 foreach v {arcnos arcout arcids arcstart arcend growing \
10260 arctags archeads allparents allchildren} {
10261 global $v
10262 catch {unset $v}
10263 }
10264 set allcwait 0
10265 set nextarc 0
10266 set cachedarcs 0
10267 set seeds {}
10268 getallcommits
10269}
10270
10271proc writecache {f} {
10272 global cachearc cachedarcs allccache
10273 global arcstart arcend arcnos arcids arcout
10274
10275 set a $cachearc
10276 set lim $cachedarcs
10277 if {$lim - $a > 1000} {
10278 set lim [expr {$a + 1000}]
10279 }
10280 if {[catch {
10281 while {[incr a] <= $lim} {
10282 if {[info exists arcend($a)]} {
10283 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10284 } else {
10285 puts $f [list $arcstart($a) {} $arcids($a)]
10286 }
10287 }
10288 } err]} {
10289 catch {close $f}
10290 catch {file delete $allccache}
10291 #puts "writing cache failed ($err)"
10292 return 0
10293 }
10294 set cachearc [expr {$a - 1}]
10295 if {$a > $cachedarcs} {
10296 puts $f "1"
10297 close $f
10298 return 0
10299 }
10300 return 1
10301}
10302
10303proc savecache {} {
10304 global nextarc cachedarcs cachearc allccache
10305
10306 if {$nextarc == $cachedarcs} return
10307 set cachearc 0
10308 set cachedarcs $nextarc
10309 catch {
10310 set f [open $allccache w]
10311 puts $f [list 1 $cachedarcs]
10312 run writecache $f
10313 }
10314}
10315
10316# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10317# or 0 if neither is true.
10318proc anc_or_desc {a b} {
10319 global arcout arcstart arcend arcnos cached_isanc
10320
10321 if {$arcnos($a) eq $arcnos($b)} {
10322 # Both are on the same arc(s); either both are the same BMP,
10323 # or if one is not a BMP, the other is also not a BMP or is
10324 # the BMP at end of the arc (and it only has 1 incoming arc).
10325 # Or both can be BMPs with no incoming arcs.
10326 if {$a eq $b || $arcnos($a) eq {}} {
10327 return 0
10328 }
10329 # assert {[llength $arcnos($a)] == 1}
10330 set arc [lindex $arcnos($a) 0]
10331 set i [lsearch -exact $arcids($arc) $a]
10332 set j [lsearch -exact $arcids($arc) $b]
10333 if {$i < 0 || $i > $j} {
10334 return 1
10335 } else {
10336 return -1
10337 }
10338 }
10339
10340 if {![info exists arcout($a)]} {
10341 set arc [lindex $arcnos($a) 0]
10342 if {[info exists arcend($arc)]} {
10343 set aend $arcend($arc)
10344 } else {
10345 set aend {}
10346 }
10347 set a $arcstart($arc)
10348 } else {
10349 set aend $a
10350 }
10351 if {![info exists arcout($b)]} {
10352 set arc [lindex $arcnos($b) 0]
10353 if {[info exists arcend($arc)]} {
10354 set bend $arcend($arc)
10355 } else {
10356 set bend {}
10357 }
10358 set b $arcstart($arc)
10359 } else {
10360 set bend $b
10361 }
10362 if {$a eq $bend} {
10363 return 1
10364 }
10365 if {$b eq $aend} {
10366 return -1
10367 }
10368 if {[info exists cached_isanc($a,$bend)]} {
10369 if {$cached_isanc($a,$bend)} {
10370 return 1
10371 }
10372 }
10373 if {[info exists cached_isanc($b,$aend)]} {
10374 if {$cached_isanc($b,$aend)} {
10375 return -1
10376 }
10377 if {[info exists cached_isanc($a,$bend)]} {
10378 return 0
10379 }
10380 }
10381
10382 set todo [list $a $b]
10383 set anc($a) a
10384 set anc($b) b
10385 for {set i 0} {$i < [llength $todo]} {incr i} {
10386 set x [lindex $todo $i]
10387 if {$anc($x) eq {}} {
10388 continue
10389 }
10390 foreach arc $arcnos($x) {
10391 set xd $arcstart($arc)
10392 if {$xd eq $bend} {
10393 set cached_isanc($a,$bend) 1
10394 set cached_isanc($b,$aend) 0
10395 return 1
10396 } elseif {$xd eq $aend} {
10397 set cached_isanc($b,$aend) 1
10398 set cached_isanc($a,$bend) 0
10399 return -1
10400 }
10401 if {![info exists anc($xd)]} {
10402 set anc($xd) $anc($x)
10403 lappend todo $xd
10404 } elseif {$anc($xd) ne $anc($x)} {
10405 set anc($xd) {}
10406 }
10407 }
10408 }
10409 set cached_isanc($a,$bend) 0
10410 set cached_isanc($b,$aend) 0
10411 return 0
10412}
10413
10414# This identifies whether $desc has an ancestor that is
10415# a growing tip of the graph and which is not an ancestor of $anc
10416# and returns 0 if so and 1 if not.
10417# If we subsequently discover a tag on such a growing tip, and that
10418# turns out to be a descendent of $anc (which it could, since we
10419# don't necessarily see children before parents), then $desc
10420# isn't a good choice to display as a descendent tag of
10421# $anc (since it is the descendent of another tag which is
10422# a descendent of $anc). Similarly, $anc isn't a good choice to
10423# display as a ancestor tag of $desc.
10424#
10425proc is_certain {desc anc} {
10426 global arcnos arcout arcstart arcend growing problems
10427
10428 set certain {}
10429 if {[llength $arcnos($anc)] == 1} {
10430 # tags on the same arc are certain
10431 if {$arcnos($desc) eq $arcnos($anc)} {
10432 return 1
10433 }
10434 if {![info exists arcout($anc)]} {
10435 # if $anc is partway along an arc, use the start of the arc instead
10436 set a [lindex $arcnos($anc) 0]
10437 set anc $arcstart($a)
10438 }
10439 }
10440 if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10441 set x $desc
10442 } else {
10443 set a [lindex $arcnos($desc) 0]
10444 set x $arcend($a)
10445 }
10446 if {$x == $anc} {
10447 return 1
10448 }
10449 set anclist [list $x]
10450 set dl($x) 1
10451 set nnh 1
10452 set ngrowanc 0
10453 for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10454 set x [lindex $anclist $i]
10455 if {$dl($x)} {
10456 incr nnh -1
10457 }
10458 set done($x) 1
10459 foreach a $arcout($x) {
10460 if {[info exists growing($a)]} {
10461 if {![info exists growanc($x)] && $dl($x)} {
10462 set growanc($x) 1
10463 incr ngrowanc
10464 }
10465 } else {
10466 set y $arcend($a)
10467 if {[info exists dl($y)]} {
10468 if {$dl($y)} {
10469 if {!$dl($x)} {
10470 set dl($y) 0
10471 if {![info exists done($y)]} {
10472 incr nnh -1
10473 }
10474 if {[info exists growanc($x)]} {
10475 incr ngrowanc -1
10476 }
10477 set xl [list $y]
10478 for {set k 0} {$k < [llength $xl]} {incr k} {
10479 set z [lindex $xl $k]
10480 foreach c $arcout($z) {
10481 if {[info exists arcend($c)]} {
10482 set v $arcend($c)
10483 if {[info exists dl($v)] && $dl($v)} {
10484 set dl($v) 0
10485 if {![info exists done($v)]} {
10486 incr nnh -1
10487 }
10488 if {[info exists growanc($v)]} {
10489 incr ngrowanc -1
10490 }
10491 lappend xl $v
10492 }
10493 }
10494 }
10495 }
10496 }
10497 }
10498 } elseif {$y eq $anc || !$dl($x)} {
10499 set dl($y) 0
10500 lappend anclist $y
10501 } else {
10502 set dl($y) 1
10503 lappend anclist $y
10504 incr nnh
10505 }
10506 }
10507 }
10508 }
10509 foreach x [array names growanc] {
10510 if {$dl($x)} {
10511 return 0
10512 }
10513 return 0
10514 }
10515 return 1
10516}
10517
10518proc validate_arctags {a} {
10519 global arctags idtags
10520
10521 set i -1
10522 set na $arctags($a)
10523 foreach id $arctags($a) {
10524 incr i
10525 if {![info exists idtags($id)]} {
10526 set na [lreplace $na $i $i]
10527 incr i -1
10528 }
10529 }
10530 set arctags($a) $na
10531}
10532
10533proc validate_archeads {a} {
10534 global archeads idheads
10535
10536 set i -1
10537 set na $archeads($a)
10538 foreach id $archeads($a) {
10539 incr i
10540 if {![info exists idheads($id)]} {
10541 set na [lreplace $na $i $i]
10542 incr i -1
10543 }
10544 }
10545 set archeads($a) $na
10546}
10547
10548# Return the list of IDs that have tags that are descendents of id,
10549# ignoring IDs that are descendents of IDs already reported.
10550proc desctags {id} {
10551 global arcnos arcstart arcids arctags idtags allparents
10552 global growing cached_dtags
10553
10554 if {![info exists allparents($id)]} {
10555 return {}
10556 }
10557 set t1 [clock clicks -milliseconds]
10558 set argid $id
10559 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10560 # part-way along an arc; check that arc first
10561 set a [lindex $arcnos($id) 0]
10562 if {$arctags($a) ne {}} {
10563 validate_arctags $a
10564 set i [lsearch -exact $arcids($a) $id]
10565 set tid {}
10566 foreach t $arctags($a) {
10567 set j [lsearch -exact $arcids($a) $t]
10568 if {$j >= $i} break
10569 set tid $t
10570 }
10571 if {$tid ne {}} {
10572 return $tid
10573 }
10574 }
10575 set id $arcstart($a)
10576 if {[info exists idtags($id)]} {
10577 return $id
10578 }
10579 }
10580 if {[info exists cached_dtags($id)]} {
10581 return $cached_dtags($id)
10582 }
10583
10584 set origid $id
10585 set todo [list $id]
10586 set queued($id) 1
10587 set nc 1
10588 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10589 set id [lindex $todo $i]
10590 set done($id) 1
10591 set ta [info exists hastaggedancestor($id)]
10592 if {!$ta} {
10593 incr nc -1
10594 }
10595 # ignore tags on starting node
10596 if {!$ta && $i > 0} {
10597 if {[info exists idtags($id)]} {
10598 set tagloc($id) $id
10599 set ta 1
10600 } elseif {[info exists cached_dtags($id)]} {
10601 set tagloc($id) $cached_dtags($id)
10602 set ta 1
10603 }
10604 }
10605 foreach a $arcnos($id) {
10606 set d $arcstart($a)
10607 if {!$ta && $arctags($a) ne {}} {
10608 validate_arctags $a
10609 if {$arctags($a) ne {}} {
10610 lappend tagloc($id) [lindex $arctags($a) end]
10611 }
10612 }
10613 if {$ta || $arctags($a) ne {}} {
10614 set tomark [list $d]
10615 for {set j 0} {$j < [llength $tomark]} {incr j} {
10616 set dd [lindex $tomark $j]
10617 if {![info exists hastaggedancestor($dd)]} {
10618 if {[info exists done($dd)]} {
10619 foreach b $arcnos($dd) {
10620 lappend tomark $arcstart($b)
10621 }
10622 if {[info exists tagloc($dd)]} {
10623 unset tagloc($dd)
10624 }
10625 } elseif {[info exists queued($dd)]} {
10626 incr nc -1
10627 }
10628 set hastaggedancestor($dd) 1
10629 }
10630 }
10631 }
10632 if {![info exists queued($d)]} {
10633 lappend todo $d
10634 set queued($d) 1
10635 if {![info exists hastaggedancestor($d)]} {
10636 incr nc
10637 }
10638 }
10639 }
10640 }
10641 set tags {}
10642 foreach id [array names tagloc] {
10643 if {![info exists hastaggedancestor($id)]} {
10644 foreach t $tagloc($id) {
10645 if {[lsearch -exact $tags $t] < 0} {
10646 lappend tags $t
10647 }
10648 }
10649 }
10650 }
10651 set t2 [clock clicks -milliseconds]
10652 set loopix $i
10653
10654 # remove tags that are descendents of other tags
10655 for {set i 0} {$i < [llength $tags]} {incr i} {
10656 set a [lindex $tags $i]
10657 for {set j 0} {$j < $i} {incr j} {
10658 set b [lindex $tags $j]
10659 set r [anc_or_desc $a $b]
10660 if {$r == 1} {
10661 set tags [lreplace $tags $j $j]
10662 incr j -1
10663 incr i -1
10664 } elseif {$r == -1} {
10665 set tags [lreplace $tags $i $i]
10666 incr i -1
10667 break
10668 }
10669 }
10670 }
10671
10672 if {[array names growing] ne {}} {
10673 # graph isn't finished, need to check if any tag could get
10674 # eclipsed by another tag coming later. Simply ignore any
10675 # tags that could later get eclipsed.
10676 set ctags {}
10677 foreach t $tags {
10678 if {[is_certain $t $origid]} {
10679 lappend ctags $t
10680 }
10681 }
10682 if {$tags eq $ctags} {
10683 set cached_dtags($origid) $tags
10684 } else {
10685 set tags $ctags
10686 }
10687 } else {
10688 set cached_dtags($origid) $tags
10689 }
10690 set t3 [clock clicks -milliseconds]
10691 if {0 && $t3 - $t1 >= 100} {
10692 puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10693 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10694 }
10695 return $tags
10696}
10697
10698proc anctags {id} {
10699 global arcnos arcids arcout arcend arctags idtags allparents
10700 global growing cached_atags
10701
10702 if {![info exists allparents($id)]} {
10703 return {}
10704 }
10705 set t1 [clock clicks -milliseconds]
10706 set argid $id
10707 if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10708 # part-way along an arc; check that arc first
10709 set a [lindex $arcnos($id) 0]
10710 if {$arctags($a) ne {}} {
10711 validate_arctags $a
10712 set i [lsearch -exact $arcids($a) $id]
10713 foreach t $arctags($a) {
10714 set j [lsearch -exact $arcids($a) $t]
10715 if {$j > $i} {
10716 return $t
10717 }
10718 }
10719 }
10720 if {![info exists arcend($a)]} {
10721 return {}
10722 }
10723 set id $arcend($a)
10724 if {[info exists idtags($id)]} {
10725 return $id
10726 }
10727 }
10728 if {[info exists cached_atags($id)]} {
10729 return $cached_atags($id)
10730 }
10731
10732 set origid $id
10733 set todo [list $id]
10734 set queued($id) 1
10735 set taglist {}
10736 set nc 1
10737 for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10738 set id [lindex $todo $i]
10739 set done($id) 1
10740 set td [info exists hastaggeddescendent($id)]
10741 if {!$td} {
10742 incr nc -1
10743 }
10744 # ignore tags on starting node
10745 if {!$td && $i > 0} {
10746 if {[info exists idtags($id)]} {
10747 set tagloc($id) $id
10748 set td 1
10749 } elseif {[info exists cached_atags($id)]} {
10750 set tagloc($id) $cached_atags($id)
10751 set td 1
10752 }
10753 }
10754 foreach a $arcout($id) {
10755 if {!$td && $arctags($a) ne {}} {
10756 validate_arctags $a
10757 if {$arctags($a) ne {}} {
10758 lappend tagloc($id) [lindex $arctags($a) 0]
10759 }
10760 }
10761 if {![info exists arcend($a)]} continue
10762 set d $arcend($a)
10763 if {$td || $arctags($a) ne {}} {
10764 set tomark [list $d]
10765 for {set j 0} {$j < [llength $tomark]} {incr j} {
10766 set dd [lindex $tomark $j]
10767 if {![info exists hastaggeddescendent($dd)]} {
10768 if {[info exists done($dd)]} {
10769 foreach b $arcout($dd) {
10770 if {[info exists arcend($b)]} {
10771 lappend tomark $arcend($b)
10772 }
10773 }
10774 if {[info exists tagloc($dd)]} {
10775 unset tagloc($dd)
10776 }
10777 } elseif {[info exists queued($dd)]} {
10778 incr nc -1
10779 }
10780 set hastaggeddescendent($dd) 1
10781 }
10782 }
10783 }
10784 if {![info exists queued($d)]} {
10785 lappend todo $d
10786 set queued($d) 1
10787 if {![info exists hastaggeddescendent($d)]} {
10788 incr nc
10789 }
10790 }
10791 }
10792 }
10793 set t2 [clock clicks -milliseconds]
10794 set loopix $i
10795 set tags {}
10796 foreach id [array names tagloc] {
10797 if {![info exists hastaggeddescendent($id)]} {
10798 foreach t $tagloc($id) {
10799 if {[lsearch -exact $tags $t] < 0} {
10800 lappend tags $t
10801 }
10802 }
10803 }
10804 }
10805
10806 # remove tags that are ancestors of other tags
10807 for {set i 0} {$i < [llength $tags]} {incr i} {
10808 set a [lindex $tags $i]
10809 for {set j 0} {$j < $i} {incr j} {
10810 set b [lindex $tags $j]
10811 set r [anc_or_desc $a $b]
10812 if {$r == -1} {
10813 set tags [lreplace $tags $j $j]
10814 incr j -1
10815 incr i -1
10816 } elseif {$r == 1} {
10817 set tags [lreplace $tags $i $i]
10818 incr i -1
10819 break
10820 }
10821 }
10822 }
10823
10824 if {[array names growing] ne {}} {
10825 # graph isn't finished, need to check if any tag could get
10826 # eclipsed by another tag coming later. Simply ignore any
10827 # tags that could later get eclipsed.
10828 set ctags {}
10829 foreach t $tags {
10830 if {[is_certain $origid $t]} {
10831 lappend ctags $t
10832 }
10833 }
10834 if {$tags eq $ctags} {
10835 set cached_atags($origid) $tags
10836 } else {
10837 set tags $ctags
10838 }
10839 } else {
10840 set cached_atags($origid) $tags
10841 }
10842 set t3 [clock clicks -milliseconds]
10843 if {0 && $t3 - $t1 >= 100} {
10844 puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10845 [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10846 }
10847 return $tags
10848}
10849
10850# Return the list of IDs that have heads that are descendents of id,
10851# including id itself if it has a head.
10852proc descheads {id} {
10853 global arcnos arcstart arcids archeads idheads cached_dheads
10854 global allparents arcout
10855
10856 if {![info exists allparents($id)]} {
10857 return {}
10858 }
10859 set aret {}
10860 if {![info exists arcout($id)]} {
10861 # part-way along an arc; check it first
10862 set a [lindex $arcnos($id) 0]
10863 if {$archeads($a) ne {}} {
10864 validate_archeads $a
10865 set i [lsearch -exact $arcids($a) $id]
10866 foreach t $archeads($a) {
10867 set j [lsearch -exact $arcids($a) $t]
10868 if {$j > $i} break
10869 lappend aret $t
10870 }
10871 }
10872 set id $arcstart($a)
10873 }
10874 set origid $id
10875 set todo [list $id]
10876 set seen($id) 1
10877 set ret {}
10878 for {set i 0} {$i < [llength $todo]} {incr i} {
10879 set id [lindex $todo $i]
10880 if {[info exists cached_dheads($id)]} {
10881 set ret [concat $ret $cached_dheads($id)]
10882 } else {
10883 if {[info exists idheads($id)]} {
10884 lappend ret $id
10885 }
10886 foreach a $arcnos($id) {
10887 if {$archeads($a) ne {}} {
10888 validate_archeads $a
10889 if {$archeads($a) ne {}} {
10890 set ret [concat $ret $archeads($a)]
10891 }
10892 }
10893 set d $arcstart($a)
10894 if {![info exists seen($d)]} {
10895 lappend todo $d
10896 set seen($d) 1
10897 }
10898 }
10899 }
10900 }
10901 set ret [lsort -unique $ret]
10902 set cached_dheads($origid) $ret
10903 return [concat $ret $aret]
10904}
10905
10906proc addedtag {id} {
10907 global arcnos arcout cached_dtags cached_atags
10908
10909 if {![info exists arcnos($id)]} return
10910 if {![info exists arcout($id)]} {
10911 recalcarc [lindex $arcnos($id) 0]
10912 }
10913 catch {unset cached_dtags}
10914 catch {unset cached_atags}
10915}
10916
10917proc addedhead {hid head} {
10918 global arcnos arcout cached_dheads
10919
10920 if {![info exists arcnos($hid)]} return
10921 if {![info exists arcout($hid)]} {
10922 recalcarc [lindex $arcnos($hid) 0]
10923 }
10924 catch {unset cached_dheads}
10925}
10926
10927proc removedhead {hid head} {
10928 global cached_dheads
10929
10930 catch {unset cached_dheads}
10931}
10932
10933proc movedhead {hid head} {
10934 global arcnos arcout cached_dheads
10935
10936 if {![info exists arcnos($hid)]} return
10937 if {![info exists arcout($hid)]} {
10938 recalcarc [lindex $arcnos($hid) 0]
10939 }
10940 catch {unset cached_dheads}
10941}
10942
10943proc changedrefs {} {
10944 global cached_dheads cached_dtags cached_atags cached_tagcontent
10945 global arctags archeads arcnos arcout idheads idtags
10946
10947 foreach id [concat [array names idheads] [array names idtags]] {
10948 if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10949 set a [lindex $arcnos($id) 0]
10950 if {![info exists donearc($a)]} {
10951 recalcarc $a
10952 set donearc($a) 1
10953 }
10954 }
10955 }
10956 catch {unset cached_tagcontent}
10957 catch {unset cached_dtags}
10958 catch {unset cached_atags}
10959 catch {unset cached_dheads}
10960}
10961
10962proc rereadrefs {} {
10963 global idtags idheads idotherrefs mainheadid
10964
10965 set refids [concat [array names idtags] \
10966 [array names idheads] [array names idotherrefs]]
10967 foreach id $refids {
10968 if {![info exists ref($id)]} {
10969 set ref($id) [listrefs $id]
10970 }
10971 }
10972 set oldmainhead $mainheadid
10973 readrefs
10974 changedrefs
10975 set refids [lsort -unique [concat $refids [array names idtags] \
10976 [array names idheads] [array names idotherrefs]]]
10977 foreach id $refids {
10978 set v [listrefs $id]
10979 if {![info exists ref($id)] || $ref($id) != $v} {
10980 redrawtags $id
10981 }
10982 }
10983 if {$oldmainhead ne $mainheadid} {
10984 redrawtags $oldmainhead
10985 redrawtags $mainheadid
10986 }
10987 run refill_reflist
10988}
10989
10990proc listrefs {id} {
10991 global idtags idheads idotherrefs
10992
10993 set x {}
10994 if {[info exists idtags($id)]} {
10995 set x $idtags($id)
10996 }
10997 set y {}
10998 if {[info exists idheads($id)]} {
10999 set y $idheads($id)
11000 }
11001 set z {}
11002 if {[info exists idotherrefs($id)]} {
11003 set z $idotherrefs($id)
11004 }
11005 return [list $x $y $z]
11006}
11007
11008proc add_tag_ctext {tag} {
11009 global ctext cached_tagcontent tagids
11010
11011 if {![info exists cached_tagcontent($tag)]} {
11012 catch {
11013 set cached_tagcontent($tag) [exec git cat-file -p $tag]
11014 }
11015 }
11016 $ctext insert end "[mc "Tag"]: $tag\n" bold
11017 if {[info exists cached_tagcontent($tag)]} {
11018 set text $cached_tagcontent($tag)
11019 } else {
11020 set text "[mc "Id"]: $tagids($tag)"
11021 }
11022 appendwithlinks $text {}
11023}
11024
11025proc showtag {tag isnew} {
11026 global ctext cached_tagcontent tagids linknum tagobjid
11027
11028 if {$isnew} {
11029 addtohistory [list showtag $tag 0] savectextpos
11030 }
11031 $ctext conf -state normal
11032 clear_ctext
11033 settabs 0
11034 set linknum 0
11035 add_tag_ctext $tag
11036 maybe_scroll_ctext 1
11037 $ctext conf -state disabled
11038 init_flist {}
11039}
11040
11041proc showtags {id isnew} {
11042 global idtags ctext linknum
11043
11044 if {$isnew} {
11045 addtohistory [list showtags $id 0] savectextpos
11046 }
11047 $ctext conf -state normal
11048 clear_ctext
11049 settabs 0
11050 set linknum 0
11051 set sep {}
11052 foreach tag $idtags($id) {
11053 $ctext insert end $sep
11054 add_tag_ctext $tag
11055 set sep "\n\n"
11056 }
11057 maybe_scroll_ctext 1
11058 $ctext conf -state disabled
11059 init_flist {}
11060}
11061
11062proc doquit {} {
11063 global stopped
11064 global gitktmpdir
11065
11066 set stopped 100
11067 savestuff .
11068 destroy .
11069
11070 if {[info exists gitktmpdir]} {
11071 catch {file delete -force $gitktmpdir}
11072 }
11073}
11074
11075proc mkfontdisp {font top which} {
11076 global fontattr fontpref $font NS use_ttk
11077
11078 set fontpref($font) [set $font]
11079 ${NS}::button $top.${font}but -text $which \
11080 -command [list choosefont $font $which]
11081 ${NS}::label $top.$font -relief flat -font $font \
11082 -text $fontattr($font,family) -justify left
11083 grid x $top.${font}but $top.$font -sticky w
11084}
11085
11086proc choosefont {font which} {
11087 global fontparam fontlist fonttop fontattr
11088 global prefstop NS
11089
11090 set fontparam(which) $which
11091 set fontparam(font) $font
11092 set fontparam(family) [font actual $font -family]
11093 set fontparam(size) $fontattr($font,size)
11094 set fontparam(weight) $fontattr($font,weight)
11095 set fontparam(slant) $fontattr($font,slant)
11096 set top .gitkfont
11097 set fonttop $top
11098 if {![winfo exists $top]} {
11099 font create sample
11100 eval font config sample [font actual $font]
11101 ttk_toplevel $top
11102 make_transient $top $prefstop
11103 wm title $top [mc "Gitk font chooser"]
11104 ${NS}::label $top.l -textvariable fontparam(which)
11105 pack $top.l -side top
11106 set fontlist [lsort [font families]]
11107 ${NS}::frame $top.f
11108 listbox $top.f.fam -listvariable fontlist \
11109 -yscrollcommand [list $top.f.sb set]
11110 bind $top.f.fam <<ListboxSelect>> selfontfam
11111 ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11112 pack $top.f.sb -side right -fill y
11113 pack $top.f.fam -side left -fill both -expand 1
11114 pack $top.f -side top -fill both -expand 1
11115 ${NS}::frame $top.g
11116 spinbox $top.g.size -from 4 -to 40 -width 4 \
11117 -textvariable fontparam(size) \
11118 -validatecommand {string is integer -strict %s}
11119 checkbutton $top.g.bold -padx 5 \
11120 -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11121 -variable fontparam(weight) -onvalue bold -offvalue normal
11122 checkbutton $top.g.ital -padx 5 \
11123 -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
11124 -variable fontparam(slant) -onvalue italic -offvalue roman
11125 pack $top.g.size $top.g.bold $top.g.ital -side left
11126 pack $top.g -side top
11127 canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11128 -background white
11129 $top.c create text 100 25 -anchor center -text $which -font sample \
11130 -fill black -tags text
11131 bind $top.c <Configure> [list centertext $top.c]
11132 pack $top.c -side top -fill x
11133 ${NS}::frame $top.buts
11134 ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11135 ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11136 bind $top <Key-Return> fontok
11137 bind $top <Key-Escape> fontcan
11138 grid $top.buts.ok $top.buts.can
11139 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11140 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11141 pack $top.buts -side bottom -fill x
11142 trace add variable fontparam write chg_fontparam
11143 } else {
11144 raise $top
11145 $top.c itemconf text -text $which
11146 }
11147 set i [lsearch -exact $fontlist $fontparam(family)]
11148 if {$i >= 0} {
11149 $top.f.fam selection set $i
11150 $top.f.fam see $i
11151 }
11152}
11153
11154proc centertext {w} {
11155 $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11156}
11157
11158proc fontok {} {
11159 global fontparam fontpref prefstop
11160
11161 set f $fontparam(font)
11162 set fontpref($f) [list $fontparam(family) $fontparam(size)]
11163 if {$fontparam(weight) eq "bold"} {
11164 lappend fontpref($f) "bold"
11165 }
11166 if {$fontparam(slant) eq "italic"} {
11167 lappend fontpref($f) "italic"
11168 }
11169 set w $prefstop.notebook.fonts.$f
11170 $w conf -text $fontparam(family) -font $fontpref($f)
11171
11172 fontcan
11173}
11174
11175proc fontcan {} {
11176 global fonttop fontparam
11177
11178 if {[info exists fonttop]} {
11179 catch {destroy $fonttop}
11180 catch {font delete sample}
11181 unset fonttop
11182 unset fontparam
11183 }
11184}
11185
11186if {[package vsatisfies [package provide Tk] 8.6]} {
11187 # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11188 # function to make use of it.
11189 proc choosefont {font which} {
11190 tk fontchooser configure -title $which -font $font \
11191 -command [list on_choosefont $font $which]
11192 tk fontchooser show
11193 }
11194 proc on_choosefont {font which newfont} {
11195 global fontparam
11196 puts stderr "$font $newfont"
11197 array set f [font actual $newfont]
11198 set fontparam(which) $which
11199 set fontparam(font) $font
11200 set fontparam(family) $f(-family)
11201 set fontparam(size) $f(-size)
11202 set fontparam(weight) $f(-weight)
11203 set fontparam(slant) $f(-slant)
11204 fontok
11205 }
11206}
11207
11208proc selfontfam {} {
11209 global fonttop fontparam
11210
11211 set i [$fonttop.f.fam curselection]
11212 if {$i ne {}} {
11213 set fontparam(family) [$fonttop.f.fam get $i]
11214 }
11215}
11216
11217proc chg_fontparam {v sub op} {
11218 global fontparam
11219
11220 font config sample -$sub $fontparam($sub)
11221}
11222
11223# Create a property sheet tab page
11224proc create_prefs_page {w} {
11225 global NS
11226 set parent [join [lrange [split $w .] 0 end-1] .]
11227 if {[winfo class $parent] eq "TNotebook"} {
11228 ${NS}::frame $w
11229 } else {
11230 ${NS}::labelframe $w
11231 }
11232}
11233
11234proc prefspage_general {notebook} {
11235 global NS maxwidth maxgraphpct showneartags showlocalchanges
11236 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11237 global hideremotes want_ttk have_ttk maxrefs
11238
11239 set page [create_prefs_page $notebook.general]
11240
11241 ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11242 grid $page.ldisp - -sticky w -pady 10
11243 ${NS}::label $page.spacer -text " "
11244 ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11245 spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11246 grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11247 ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11248 spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11249 grid x $page.maxpctl $page.maxpct -sticky w
11250 ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11251 -variable showlocalchanges
11252 grid x $page.showlocal -sticky w
11253 ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11254 -variable autoselect
11255 spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11256 grid x $page.autoselect $page.autosellen -sticky w
11257 ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11258 -variable hideremotes
11259 grid x $page.hideremotes -sticky w
11260
11261 ${NS}::label $page.ddisp -text [mc "Diff display options"]
11262 grid $page.ddisp - -sticky w -pady 10
11263 ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11264 spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11265 grid x $page.tabstopl $page.tabstop -sticky w
11266 ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11267 -variable showneartags
11268 grid x $page.ntag -sticky w
11269 ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11270 spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11271 grid x $page.maxrefsl $page.maxrefs -sticky w
11272 ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11273 -variable limitdiffs
11274 grid x $page.ldiff -sticky w
11275 ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11276 -variable perfile_attrs
11277 grid x $page.lattr -sticky w
11278
11279 ${NS}::entry $page.extdifft -textvariable extdifftool
11280 ${NS}::frame $page.extdifff
11281 ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11282 ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11283 pack $page.extdifff.l $page.extdifff.b -side left
11284 pack configure $page.extdifff.l -padx 10
11285 grid x $page.extdifff $page.extdifft -sticky ew
11286
11287 ${NS}::label $page.lgen -text [mc "General options"]
11288 grid $page.lgen - -sticky w -pady 10
11289 ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11290 -text [mc "Use themed widgets"]
11291 if {$have_ttk} {
11292 ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11293 } else {
11294 ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11295 }
11296 grid x $page.want_ttk $page.ttk_note -sticky w
11297 return $page
11298}
11299
11300proc prefspage_colors {notebook} {
11301 global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11302
11303 set page [create_prefs_page $notebook.colors]
11304
11305 ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11306 grid $page.cdisp - -sticky w -pady 10
11307 label $page.ui -padx 40 -relief sunk -background $uicolor
11308 ${NS}::button $page.uibut -text [mc "Interface"] \
11309 -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11310 grid x $page.uibut $page.ui -sticky w
11311 label $page.bg -padx 40 -relief sunk -background $bgcolor
11312 ${NS}::button $page.bgbut -text [mc "Background"] \
11313 -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11314 grid x $page.bgbut $page.bg -sticky w
11315 label $page.fg -padx 40 -relief sunk -background $fgcolor
11316 ${NS}::button $page.fgbut -text [mc "Foreground"] \
11317 -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11318 grid x $page.fgbut $page.fg -sticky w
11319 label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11320 ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11321 -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11322 [list $ctext tag conf d0 -foreground]]
11323 grid x $page.diffoldbut $page.diffold -sticky w
11324 label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11325 ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11326 -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11327 [list $ctext tag conf dresult -foreground]]
11328 grid x $page.diffnewbut $page.diffnew -sticky w
11329 label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11330 ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11331 -command [list choosecolor diffcolors 2 $page.hunksep \
11332 [mc "diff hunk header"] \
11333 [list $ctext tag conf hunksep -foreground]]
11334 grid x $page.hunksepbut $page.hunksep -sticky w
11335 label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11336 ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11337 -command [list choosecolor markbgcolor {} $page.markbgsep \
11338 [mc "marked line background"] \
11339 [list $ctext tag conf omark -background]]
11340 grid x $page.markbgbut $page.markbgsep -sticky w
11341 label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11342 ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11343 -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11344 grid x $page.selbgbut $page.selbgsep -sticky w
11345 return $page
11346}
11347
11348proc prefspage_fonts {notebook} {
11349 global NS
11350 set page [create_prefs_page $notebook.fonts]
11351 ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11352 grid $page.cfont - -sticky w -pady 10
11353 mkfontdisp mainfont $page [mc "Main font"]
11354 mkfontdisp textfont $page [mc "Diff display font"]
11355 mkfontdisp uifont $page [mc "User interface font"]
11356 return $page
11357}
11358
11359proc doprefs {} {
11360 global maxwidth maxgraphpct use_ttk NS
11361 global oldprefs prefstop showneartags showlocalchanges
11362 global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11363 global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11364 global hideremotes want_ttk have_ttk
11365
11366 set top .gitkprefs
11367 set prefstop $top
11368 if {[winfo exists $top]} {
11369 raise $top
11370 return
11371 }
11372 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11373 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11374 set oldprefs($v) [set $v]
11375 }
11376 ttk_toplevel $top
11377 wm title $top [mc "Gitk preferences"]
11378 make_transient $top .
11379
11380 if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11381 set notebook [ttk::notebook $top.notebook]
11382 } else {
11383 set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11384 }
11385
11386 lappend pages [prefspage_general $notebook] [mc "General"]
11387 lappend pages [prefspage_colors $notebook] [mc "Colors"]
11388 lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11389 set col 0
11390 foreach {page title} $pages {
11391 if {$use_notebook} {
11392 $notebook add $page -text $title
11393 } else {
11394 set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11395 -text $title -command [list raise $page]]
11396 $page configure -text $title
11397 grid $btn -row 0 -column [incr col] -sticky w
11398 grid $page -row 1 -column 0 -sticky news -columnspan 100
11399 }
11400 }
11401
11402 if {!$use_notebook} {
11403 grid columnconfigure $notebook 0 -weight 1
11404 grid rowconfigure $notebook 1 -weight 1
11405 raise [lindex $pages 0]
11406 }
11407
11408 grid $notebook -sticky news -padx 2 -pady 2
11409 grid rowconfigure $top 0 -weight 1
11410 grid columnconfigure $top 0 -weight 1
11411
11412 ${NS}::frame $top.buts
11413 ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11414 ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11415 bind $top <Key-Return> prefsok
11416 bind $top <Key-Escape> prefscan
11417 grid $top.buts.ok $top.buts.can
11418 grid columnconfigure $top.buts 0 -weight 1 -uniform a
11419 grid columnconfigure $top.buts 1 -weight 1 -uniform a
11420 grid $top.buts - - -pady 10 -sticky ew
11421 grid columnconfigure $top 2 -weight 1
11422 bind $top <Visibility> [list focus $top.buts.ok]
11423}
11424
11425proc choose_extdiff {} {
11426 global extdifftool
11427
11428 set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11429 if {$prog ne {}} {
11430 set extdifftool $prog
11431 }
11432}
11433
11434proc choosecolor {v vi w x cmd} {
11435 global $v
11436
11437 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11438 -title [mc "Gitk: choose color for %s" $x]]
11439 if {$c eq {}} return
11440 $w conf -background $c
11441 lset $v $vi $c
11442 eval $cmd $c
11443}
11444
11445proc setselbg {c} {
11446 global bglist cflist
11447 foreach w $bglist {
11448 $w configure -selectbackground $c
11449 }
11450 $cflist tag configure highlight \
11451 -background [$cflist cget -selectbackground]
11452 allcanvs itemconf secsel -fill $c
11453}
11454
11455# This sets the background color and the color scheme for the whole UI.
11456# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11457# if we don't specify one ourselves, which makes the checkbuttons and
11458# radiobuttons look bad. This chooses white for selectColor if the
11459# background color is light, or black if it is dark.
11460proc setui {c} {
11461 if {[tk windowingsystem] eq "win32"} { return }
11462 set bg [winfo rgb . $c]
11463 set selc black
11464 if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11465 set selc white
11466 }
11467 tk_setPalette background $c selectColor $selc
11468}
11469
11470proc setbg {c} {
11471 global bglist
11472
11473 foreach w $bglist {
11474 $w conf -background $c
11475 }
11476}
11477
11478proc setfg {c} {
11479 global fglist canv
11480
11481 foreach w $fglist {
11482 $w conf -foreground $c
11483 }
11484 allcanvs itemconf text -fill $c
11485 $canv itemconf circle -outline $c
11486 $canv itemconf markid -outline $c
11487}
11488
11489proc prefscan {} {
11490 global oldprefs prefstop
11491
11492 foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11493 limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11494 global $v
11495 set $v $oldprefs($v)
11496 }
11497 catch {destroy $prefstop}
11498 unset prefstop
11499 fontcan
11500}
11501
11502proc prefsok {} {
11503 global maxwidth maxgraphpct
11504 global oldprefs prefstop showneartags showlocalchanges
11505 global fontpref mainfont textfont uifont
11506 global limitdiffs treediffs perfile_attrs
11507 global hideremotes
11508
11509 catch {destroy $prefstop}
11510 unset prefstop
11511 fontcan
11512 set fontchanged 0
11513 if {$mainfont ne $fontpref(mainfont)} {
11514 set mainfont $fontpref(mainfont)
11515 parsefont mainfont $mainfont
11516 eval font configure mainfont [fontflags mainfont]
11517 eval font configure mainfontbold [fontflags mainfont 1]
11518 setcoords
11519 set fontchanged 1
11520 }
11521 if {$textfont ne $fontpref(textfont)} {
11522 set textfont $fontpref(textfont)
11523 parsefont textfont $textfont
11524 eval font configure textfont [fontflags textfont]
11525 eval font configure textfontbold [fontflags textfont 1]
11526 }
11527 if {$uifont ne $fontpref(uifont)} {
11528 set uifont $fontpref(uifont)
11529 parsefont uifont $uifont
11530 eval font configure uifont [fontflags uifont]
11531 }
11532 settabs
11533 if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11534 if {$showlocalchanges} {
11535 doshowlocalchanges
11536 } else {
11537 dohidelocalchanges
11538 }
11539 }
11540 if {$limitdiffs != $oldprefs(limitdiffs) ||
11541 ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11542 # treediffs elements are limited by path;
11543 # won't have encodings cached if perfile_attrs was just turned on
11544 catch {unset treediffs}
11545 }
11546 if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11547 || $maxgraphpct != $oldprefs(maxgraphpct)} {
11548 redisplay
11549 } elseif {$showneartags != $oldprefs(showneartags) ||
11550 $limitdiffs != $oldprefs(limitdiffs)} {
11551 reselectline
11552 }
11553 if {$hideremotes != $oldprefs(hideremotes)} {
11554 rereadrefs
11555 }
11556}
11557
11558proc formatdate {d} {
11559 global datetimeformat
11560 if {$d ne {}} {
11561 # If $datetimeformat includes a timezone, display in the
11562 # timezone of the argument. Otherwise, display in local time.
11563 if {[string match {*%[zZ]*} $datetimeformat]} {
11564 if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11565 # Tcl < 8.5 does not support -timezone. Emulate it by
11566 # setting TZ (e.g. TZ=<-0430>+04:30).
11567 global env
11568 if {[info exists env(TZ)]} {
11569 set savedTZ $env(TZ)
11570 }
11571 set zone [lindex $d 1]
11572 set sign [string map {+ - - +} [string index $zone 0]]
11573 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11574 set d [clock format [lindex $d 0] -format $datetimeformat]
11575 if {[info exists savedTZ]} {
11576 set env(TZ) $savedTZ
11577 } else {
11578 unset env(TZ)
11579 }
11580 }
11581 } else {
11582 set d [clock format [lindex $d 0] -format $datetimeformat]
11583 }
11584 }
11585 return $d
11586}
11587
11588# This list of encoding names and aliases is distilled from
11589# http://www.iana.org/assignments/character-sets.
11590# Not all of them are supported by Tcl.
11591set encoding_aliases {
11592 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11593 ISO646-US US-ASCII us IBM367 cp367 csASCII }
11594 { ISO-10646-UTF-1 csISO10646UTF1 }
11595 { ISO_646.basic:1983 ref csISO646basic1983 }
11596 { INVARIANT csINVARIANT }
11597 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11598 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11599 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11600 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11601 { NATS-DANO iso-ir-9-1 csNATSDANO }
11602 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11603 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11604 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11605 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11606 { ISO-2022-KR csISO2022KR }
11607 { EUC-KR csEUCKR }
11608 { ISO-2022-JP csISO2022JP }
11609 { ISO-2022-JP-2 csISO2022JP2 }
11610 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11611 csISO13JISC6220jp }
11612 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11613 { IT iso-ir-15 ISO646-IT csISO15Italian }
11614 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11615 { ES iso-ir-17 ISO646-ES csISO17Spanish }
11616 { greek7-old iso-ir-18 csISO18Greek7Old }
11617 { latin-greek iso-ir-19 csISO19LatinGreek }
11618 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11619 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11620 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11621 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11622 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11623 { BS_viewdata iso-ir-47 csISO47BSViewdata }
11624 { INIS iso-ir-49 csISO49INIS }
11625 { INIS-8 iso-ir-50 csISO50INIS8 }
11626 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11627 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11628 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11629 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11630 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11631 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11632 csISO60Norwegian1 }
11633 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11634 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11635 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11636 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11637 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11638 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11639 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11640 { greek7 iso-ir-88 csISO88Greek7 }
11641 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11642 { iso-ir-90 csISO90 }
11643 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11644 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11645 csISO92JISC62991984b }
11646 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11647 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11648 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11649 csISO95JIS62291984handadd }
11650 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11651 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11652 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11653 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11654 CP819 csISOLatin1 }
11655 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11656 { T.61-7bit iso-ir-102 csISO102T617bit }
11657 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11658 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11659 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11660 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11661 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11662 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11663 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11664 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11665 arabic csISOLatinArabic }
11666 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11667 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11668 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11669 greek greek8 csISOLatinGreek }
11670 { T.101-G2 iso-ir-128 csISO128T101G2 }
11671 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11672 csISOLatinHebrew }
11673 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11674 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11675 { CSN_369103 iso-ir-139 csISO139CSN369103 }
11676 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11677 { ISO_6937-2-add iso-ir-142 csISOTextComm }
11678 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11679 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11680 csISOLatinCyrillic }
11681 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11682 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11683 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11684 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11685 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11686 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11687 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11688 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11689 { ISO_10367-box iso-ir-155 csISO10367Box }
11690 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11691 { latin-lap lap iso-ir-158 csISO158Lap }
11692 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11693 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11694 { us-dk csUSDK }
11695 { dk-us csDKUS }
11696 { JIS_X0201 X0201 csHalfWidthKatakana }
11697 { KSC5636 ISO646-KR csKSC5636 }
11698 { ISO-10646-UCS-2 csUnicode }
11699 { ISO-10646-UCS-4 csUCS4 }
11700 { DEC-MCS dec csDECMCS }
11701 { hp-roman8 roman8 r8 csHPRoman8 }
11702 { macintosh mac csMacintosh }
11703 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11704 csIBM037 }
11705 { IBM038 EBCDIC-INT cp038 csIBM038 }
11706 { IBM273 CP273 csIBM273 }
11707 { IBM274 EBCDIC-BE CP274 csIBM274 }
11708 { IBM275 EBCDIC-BR cp275 csIBM275 }
11709 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11710 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11711 { IBM280 CP280 ebcdic-cp-it csIBM280 }
11712 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11713 { IBM284 CP284 ebcdic-cp-es csIBM284 }
11714 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11715 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11716 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11717 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11718 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11719 { IBM424 cp424 ebcdic-cp-he csIBM424 }
11720 { IBM437 cp437 437 csPC8CodePage437 }
11721 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11722 { IBM775 cp775 csPC775Baltic }
11723 { IBM850 cp850 850 csPC850Multilingual }
11724 { IBM851 cp851 851 csIBM851 }
11725 { IBM852 cp852 852 csPCp852 }
11726 { IBM855 cp855 855 csIBM855 }
11727 { IBM857 cp857 857 csIBM857 }
11728 { IBM860 cp860 860 csIBM860 }
11729 { IBM861 cp861 861 cp-is csIBM861 }
11730 { IBM862 cp862 862 csPC862LatinHebrew }
11731 { IBM863 cp863 863 csIBM863 }
11732 { IBM864 cp864 csIBM864 }
11733 { IBM865 cp865 865 csIBM865 }
11734 { IBM866 cp866 866 csIBM866 }
11735 { IBM868 CP868 cp-ar csIBM868 }
11736 { IBM869 cp869 869 cp-gr csIBM869 }
11737 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11738 { IBM871 CP871 ebcdic-cp-is csIBM871 }
11739 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11740 { IBM891 cp891 csIBM891 }
11741 { IBM903 cp903 csIBM903 }
11742 { IBM904 cp904 904 csIBBM904 }
11743 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11744 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11745 { IBM1026 CP1026 csIBM1026 }
11746 { EBCDIC-AT-DE csIBMEBCDICATDE }
11747 { EBCDIC-AT-DE-A csEBCDICATDEA }
11748 { EBCDIC-CA-FR csEBCDICCAFR }
11749 { EBCDIC-DK-NO csEBCDICDKNO }
11750 { EBCDIC-DK-NO-A csEBCDICDKNOA }
11751 { EBCDIC-FI-SE csEBCDICFISE }
11752 { EBCDIC-FI-SE-A csEBCDICFISEA }
11753 { EBCDIC-FR csEBCDICFR }
11754 { EBCDIC-IT csEBCDICIT }
11755 { EBCDIC-PT csEBCDICPT }
11756 { EBCDIC-ES csEBCDICES }
11757 { EBCDIC-ES-A csEBCDICESA }
11758 { EBCDIC-ES-S csEBCDICESS }
11759 { EBCDIC-UK csEBCDICUK }
11760 { EBCDIC-US csEBCDICUS }
11761 { UNKNOWN-8BIT csUnknown8BiT }
11762 { MNEMONIC csMnemonic }
11763 { MNEM csMnem }
11764 { VISCII csVISCII }
11765 { VIQR csVIQR }
11766 { KOI8-R csKOI8R }
11767 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11768 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11769 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11770 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11771 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11772 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11773 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11774 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11775 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11776 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11777 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11778 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11779 { IBM1047 IBM-1047 }
11780 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11781 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11782 { UNICODE-1-1 csUnicode11 }
11783 { CESU-8 csCESU-8 }
11784 { BOCU-1 csBOCU-1 }
11785 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11786 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11787 l8 }
11788 { ISO-8859-15 ISO_8859-15 Latin-9 }
11789 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11790 { GBK CP936 MS936 windows-936 }
11791 { JIS_Encoding csJISEncoding }
11792 { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11793 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11794 EUC-JP }
11795 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11796 { ISO-10646-UCS-Basic csUnicodeASCII }
11797 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11798 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11799 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11800 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11801 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11802 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11803 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11804 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11805 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11806 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11807 { Adobe-Standard-Encoding csAdobeStandardEncoding }
11808 { Ventura-US csVenturaUS }
11809 { Ventura-International csVenturaInternational }
11810 { PC8-Danish-Norwegian csPC8DanishNorwegian }
11811 { PC8-Turkish csPC8Turkish }
11812 { IBM-Symbols csIBMSymbols }
11813 { IBM-Thai csIBMThai }
11814 { HP-Legal csHPLegal }
11815 { HP-Pi-font csHPPiFont }
11816 { HP-Math8 csHPMath8 }
11817 { Adobe-Symbol-Encoding csHPPSMath }
11818 { HP-DeskTop csHPDesktop }
11819 { Ventura-Math csVenturaMath }
11820 { Microsoft-Publishing csMicrosoftPublishing }
11821 { Windows-31J csWindows31J }
11822 { GB2312 csGB2312 }
11823 { Big5 csBig5 }
11824}
11825
11826proc tcl_encoding {enc} {
11827 global encoding_aliases tcl_encoding_cache
11828 if {[info exists tcl_encoding_cache($enc)]} {
11829 return $tcl_encoding_cache($enc)
11830 }
11831 set names [encoding names]
11832 set lcnames [string tolower $names]
11833 set enc [string tolower $enc]
11834 set i [lsearch -exact $lcnames $enc]
11835 if {$i < 0} {
11836 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11837 if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11838 set i [lsearch -exact $lcnames $encx]
11839 }
11840 }
11841 if {$i < 0} {
11842 foreach l $encoding_aliases {
11843 set ll [string tolower $l]
11844 if {[lsearch -exact $ll $enc] < 0} continue
11845 # look through the aliases for one that tcl knows about
11846 foreach e $ll {
11847 set i [lsearch -exact $lcnames $e]
11848 if {$i < 0} {
11849 if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11850 set i [lsearch -exact $lcnames $ex]
11851 }
11852 }
11853 if {$i >= 0} break
11854 }
11855 break
11856 }
11857 }
11858 set tclenc {}
11859 if {$i >= 0} {
11860 set tclenc [lindex $names $i]
11861 }
11862 set tcl_encoding_cache($enc) $tclenc
11863 return $tclenc
11864}
11865
11866proc gitattr {path attr default} {
11867 global path_attr_cache
11868 if {[info exists path_attr_cache($attr,$path)]} {
11869 set r $path_attr_cache($attr,$path)
11870 } else {
11871 set r "unspecified"
11872 if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11873 regexp "(.*): $attr: (.*)" $line m f r
11874 }
11875 set path_attr_cache($attr,$path) $r
11876 }
11877 if {$r eq "unspecified"} {
11878 return $default
11879 }
11880 return $r
11881}
11882
11883proc cache_gitattr {attr pathlist} {
11884 global path_attr_cache
11885 set newlist {}
11886 foreach path $pathlist {
11887 if {![info exists path_attr_cache($attr,$path)]} {
11888 lappend newlist $path
11889 }
11890 }
11891 set lim 1000
11892 if {[tk windowingsystem] == "win32"} {
11893 # windows has a 32k limit on the arguments to a command...
11894 set lim 30
11895 }
11896 while {$newlist ne {}} {
11897 set head [lrange $newlist 0 [expr {$lim - 1}]]
11898 set newlist [lrange $newlist $lim end]
11899 if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11900 foreach row [split $rlist "\n"] {
11901 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11902 if {[string index $path 0] eq "\""} {
11903 set path [encoding convertfrom [lindex $path 0]]
11904 }
11905 set path_attr_cache($attr,$path) $value
11906 }
11907 }
11908 }
11909 }
11910}
11911
11912proc get_path_encoding {path} {
11913 global gui_encoding perfile_attrs
11914 set tcl_enc $gui_encoding
11915 if {$path ne {} && $perfile_attrs} {
11916 set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11917 if {$enc2 ne {}} {
11918 set tcl_enc $enc2
11919 }
11920 }
11921 return $tcl_enc
11922}
11923
11924# First check that Tcl/Tk is recent enough
11925if {[catch {package require Tk 8.4} err]} {
11926 show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11927 Gitk requires at least Tcl/Tk 8.4." list
11928 exit 1
11929}
11930
11931# on OSX bring the current Wish process window to front
11932if {[tk windowingsystem] eq "aqua"} {
11933 exec osascript -e [format {
11934 tell application "System Events"
11935 set frontmost of processes whose unix id is %d to true
11936 end tell
11937 } [pid] ]
11938}
11939
11940# Unset GIT_TRACE var if set
11941if { [info exists ::env(GIT_TRACE)] } {
11942 unset ::env(GIT_TRACE)
11943}
11944
11945# defaults...
11946set wrcomcmd "git diff-tree --stdin -p --pretty=email"
11947
11948set gitencoding {}
11949catch {
11950 set gitencoding [exec git config --get i18n.commitencoding]
11951}
11952catch {
11953 set gitencoding [exec git config --get i18n.logoutputencoding]
11954}
11955if {$gitencoding == ""} {
11956 set gitencoding "utf-8"
11957}
11958set tclencoding [tcl_encoding $gitencoding]
11959if {$tclencoding == {}} {
11960 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11961}
11962
11963set gui_encoding [encoding system]
11964catch {
11965 set enc [exec git config --get gui.encoding]
11966 if {$enc ne {}} {
11967 set tclenc [tcl_encoding $enc]
11968 if {$tclenc ne {}} {
11969 set gui_encoding $tclenc
11970 } else {
11971 puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11972 }
11973 }
11974}
11975
11976set log_showroot true
11977catch {
11978 set log_showroot [exec git config --bool --get log.showroot]
11979}
11980
11981if {[tk windowingsystem] eq "aqua"} {
11982 set mainfont {{Lucida Grande} 9}
11983 set textfont {Monaco 9}
11984 set uifont {{Lucida Grande} 9 bold}
11985} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11986 # fontconfig!
11987 set mainfont {sans 9}
11988 set textfont {monospace 9}
11989 set uifont {sans 9 bold}
11990} else {
11991 set mainfont {Helvetica 9}
11992 set textfont {Courier 9}
11993 set uifont {Helvetica 9 bold}
11994}
11995set tabstop 8
11996set findmergefiles 0
11997set maxgraphpct 50
11998set maxwidth 16
11999set revlistorder 0
12000set fastdate 0
12001set uparrowlen 5
12002set downarrowlen 5
12003set mingaplen 100
12004set cmitmode "patch"
12005set wrapcomment "none"
12006set showneartags 1
12007set hideremotes 0
12008set maxrefs 20
12009set visiblerefs {"master"}
12010set maxlinelen 200
12011set showlocalchanges 1
12012set limitdiffs 1
12013set datetimeformat "%Y-%m-%d %H:%M:%S"
12014set autoselect 1
12015set autosellen 40
12016set perfile_attrs 0
12017set want_ttk 1
12018
12019if {[tk windowingsystem] eq "aqua"} {
12020 set extdifftool "opendiff"
12021} else {
12022 set extdifftool "meld"
12023}
12024
12025set colors {green red blue magenta darkgrey brown orange}
12026if {[tk windowingsystem] eq "win32"} {
12027 set uicolor SystemButtonFace
12028 set uifgcolor SystemButtonText
12029 set uifgdisabledcolor SystemDisabledText
12030 set bgcolor SystemWindow
12031 set fgcolor SystemWindowText
12032 set selectbgcolor SystemHighlight
12033} else {
12034 set uicolor grey85
12035 set uifgcolor black
12036 set uifgdisabledcolor "#999"
12037 set bgcolor white
12038 set fgcolor black
12039 set selectbgcolor gray85
12040}
12041set diffcolors {red "#00a000" blue}
12042set diffcontext 3
12043set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12044set ignorespace 0
12045set worddiff ""
12046set markbgcolor "#e0e0ff"
12047
12048set headbgcolor green
12049set headfgcolor black
12050set headoutlinecolor black
12051set remotebgcolor #ffddaa
12052set tagbgcolor yellow
12053set tagfgcolor black
12054set tagoutlinecolor black
12055set reflinecolor black
12056set filesepbgcolor #aaaaaa
12057set filesepfgcolor black
12058set linehoverbgcolor #ffff80
12059set linehoverfgcolor black
12060set linehoveroutlinecolor black
12061set mainheadcirclecolor yellow
12062set workingfilescirclecolor red
12063set indexcirclecolor green
12064set circlecolors {white blue gray blue blue}
12065set linkfgcolor blue
12066set circleoutlinecolor $fgcolor
12067set foundbgcolor yellow
12068set currentsearchhitbgcolor orange
12069
12070# button for popping up context menus
12071if {[tk windowingsystem] eq "aqua"} {
12072 set ctxbut <Button-2>
12073} else {
12074 set ctxbut <Button-3>
12075}
12076
12077## For msgcat loading, first locate the installation location.
12078if { [info exists ::env(GITK_MSGSDIR)] } {
12079 ## Msgsdir was manually set in the environment.
12080 set gitk_msgsdir $::env(GITK_MSGSDIR)
12081} else {
12082 ## Let's guess the prefix from argv0.
12083 set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12084 set gitk_libdir [file join $gitk_prefix share gitk lib]
12085 set gitk_msgsdir [file join $gitk_libdir msgs]
12086 unset gitk_prefix
12087}
12088
12089## Internationalization (i18n) through msgcat and gettext. See
12090## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12091package require msgcat
12092namespace import ::msgcat::mc
12093## And eventually load the actual message catalog
12094::msgcat::mcload $gitk_msgsdir
12095
12096catch {
12097 # follow the XDG base directory specification by default. See
12098 # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12099 if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12100 # XDG_CONFIG_HOME environment variable is set
12101 set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12102 set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12103 } else {
12104 # default XDG_CONFIG_HOME
12105 set config_file "~/.config/git/gitk"
12106 set config_file_tmp "~/.config/git/gitk-tmp"
12107 }
12108 if {![file exists $config_file]} {
12109 # for backward compatibility use the old config file if it exists
12110 if {[file exists "~/.gitk"]} {
12111 set config_file "~/.gitk"
12112 set config_file_tmp "~/.gitk-tmp"
12113 } elseif {![file exists [file dirname $config_file]]} {
12114 file mkdir [file dirname $config_file]
12115 }
12116 }
12117 source $config_file
12118}
12119
12120set config_variables {
12121 mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12122 cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12123 hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12124 bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12125 markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12126 extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12127 remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12128 filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12129 linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12130 indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12131}
12132
12133parsefont mainfont $mainfont
12134eval font create mainfont [fontflags mainfont]
12135eval font create mainfontbold [fontflags mainfont 1]
12136
12137parsefont textfont $textfont
12138eval font create textfont [fontflags textfont]
12139eval font create textfontbold [fontflags textfont 1]
12140
12141parsefont uifont $uifont
12142eval font create uifont [fontflags uifont]
12143
12144setui $uicolor
12145
12146setoptions
12147
12148# check that we can find a .git directory somewhere...
12149if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12150 show_error {} . [mc "Cannot find a git repository here."]
12151 exit 1
12152}
12153
12154set selecthead {}
12155set selectheadid {}
12156
12157set revtreeargs {}
12158set cmdline_files {}
12159set i 0
12160set revtreeargscmd {}
12161foreach arg $argv {
12162 switch -glob -- $arg {
12163 "" { }
12164 "--" {
12165 set cmdline_files [lrange $argv [expr {$i + 1}] end]
12166 break
12167 }
12168 "--select-commit=*" {
12169 set selecthead [string range $arg 16 end]
12170 }
12171 "--argscmd=*" {
12172 set revtreeargscmd [string range $arg 10 end]
12173 }
12174 default {
12175 lappend revtreeargs $arg
12176 }
12177 }
12178 incr i
12179}
12180
12181if {$selecthead eq "HEAD"} {
12182 set selecthead {}
12183}
12184
12185if {$i >= [llength $argv] && $revtreeargs ne {}} {
12186 # no -- on command line, but some arguments (other than --argscmd)
12187 if {[catch {
12188 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12189 set cmdline_files [split $f "\n"]
12190 set n [llength $cmdline_files]
12191 set revtreeargs [lrange $revtreeargs 0 end-$n]
12192 # Unfortunately git rev-parse doesn't produce an error when
12193 # something is both a revision and a filename. To be consistent
12194 # with git log and git rev-list, check revtreeargs for filenames.
12195 foreach arg $revtreeargs {
12196 if {[file exists $arg]} {
12197 show_error {} . [mc "Ambiguous argument '%s': both revision\
12198 and filename" $arg]
12199 exit 1
12200 }
12201 }
12202 } err]} {
12203 # unfortunately we get both stdout and stderr in $err,
12204 # so look for "fatal:".
12205 set i [string first "fatal:" $err]
12206 if {$i > 0} {
12207 set err [string range $err [expr {$i + 6}] end]
12208 }
12209 show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12210 exit 1
12211 }
12212}
12213
12214set nullid "0000000000000000000000000000000000000000"
12215set nullid2 "0000000000000000000000000000000000000001"
12216set nullfile "/dev/null"
12217
12218set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12219if {![info exists have_ttk]} {
12220 set have_ttk [llength [info commands ::ttk::style]]
12221}
12222set use_ttk [expr {$have_ttk && $want_ttk}]
12223set NS [expr {$use_ttk ? "ttk" : ""}]
12224
12225regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12226
12227set show_notes {}
12228if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12229 set show_notes "--show-notes"
12230}
12231
12232set appname "gitk"
12233
12234set runq {}
12235set history {}
12236set historyindex 0
12237set fh_serial 0
12238set nhl_names {}
12239set highlight_paths {}
12240set findpattern {}
12241set searchdirn -forwards
12242set boldids {}
12243set boldnameids {}
12244set diffelide {0 0}
12245set markingmatches 0
12246set linkentercount 0
12247set need_redisplay 0
12248set nrows_drawn 0
12249set firsttabstop 0
12250
12251set nextviewnum 1
12252set curview 0
12253set selectedview 0
12254set selectedhlview [mc "None"]
12255set highlight_related [mc "None"]
12256set highlight_files {}
12257set viewfiles(0) {}
12258set viewperm(0) 0
12259set viewargs(0) {}
12260set viewargscmd(0) {}
12261
12262set selectedline {}
12263set numcommits 0
12264set loginstance 0
12265set cmdlineok 0
12266set stopped 0
12267set stuffsaved 0
12268set patchnum 0
12269set lserial 0
12270set hasworktree [hasworktree]
12271set cdup {}
12272if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12273 set cdup [exec git rev-parse --show-cdup]
12274}
12275set worktree [exec git rev-parse --show-toplevel]
12276setcoords
12277makewindow
12278catch {
12279 image create photo gitlogo -width 16 -height 16
12280
12281 image create photo gitlogominus -width 4 -height 2
12282 gitlogominus put #C00000 -to 0 0 4 2
12283 gitlogo copy gitlogominus -to 1 5
12284 gitlogo copy gitlogominus -to 6 5
12285 gitlogo copy gitlogominus -to 11 5
12286 image delete gitlogominus
12287
12288 image create photo gitlogoplus -width 4 -height 4
12289 gitlogoplus put #008000 -to 1 0 3 4
12290 gitlogoplus put #008000 -to 0 1 4 3
12291 gitlogo copy gitlogoplus -to 1 9
12292 gitlogo copy gitlogoplus -to 6 9
12293 gitlogo copy gitlogoplus -to 11 9
12294 image delete gitlogoplus
12295
12296 image create photo gitlogo32 -width 32 -height 32
12297 gitlogo32 copy gitlogo -zoom 2 2
12298
12299 wm iconphoto . -default gitlogo gitlogo32
12300}
12301# wait for the window to become visible
12302tkwait visibility .
12303wm title . "$appname: [reponame]"
12304update
12305readrefs
12306
12307if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12308 # create a view for the files/dirs specified on the command line
12309 set curview 1
12310 set selectedview 1
12311 set nextviewnum 2
12312 set viewname(1) [mc "Command line"]
12313 set viewfiles(1) $cmdline_files
12314 set viewargs(1) $revtreeargs
12315 set viewargscmd(1) $revtreeargscmd
12316 set viewperm(1) 0
12317 set vdatemode(1) 0
12318 addviewmenu 1
12319 .bar.view entryconf [mca "Edit view..."] -state normal
12320 .bar.view entryconf [mca "Delete view"] -state normal
12321}
12322
12323if {[info exists permviews]} {
12324 foreach v $permviews {
12325 set n $nextviewnum
12326 incr nextviewnum
12327 set viewname($n) [lindex $v 0]
12328 set viewfiles($n) [lindex $v 1]
12329 set viewargs($n) [lindex $v 2]
12330 set viewargscmd($n) [lindex $v 3]
12331 set viewperm($n) 1
12332 addviewmenu $n
12333 }
12334}
12335
12336if {[tk windowingsystem] eq "win32"} {
12337 focus -force .
12338}
12339
12340getcommits {}
12341
12342# Local variables:
12343# mode: tcl
12344# indent-tabs-mode: t
12345# tab-width: 8
12346# End: