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