2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish
"$0" -- "${1+$@}"
5 # Copyright (C) 2005 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.
10 proc getcommits
{rargs
} {
11 global commits commfd phase canv mainfont
12 global startmsecs nextupdate
13 global ctext maincursor textcursor leftover
17 set startmsecs
[clock clicks
-milliseconds]
18 set nextupdate
[expr $startmsecs + 100]
20 set parse_args
[concat
--default HEAD
$rargs]
21 set parsed_args
[split [eval exec git-rev-parse
$parse_args] "\n"]
23 # if git-rev-parse failed for some reason...
27 set parsed_args
$rargs
30 set commfd
[open
"|git-rev-list --header --merge-order $parsed_args" r
]
32 puts stderr
"Error executing git-rev-list: $err"
36 fconfigure
$commfd -blocking 0 -translation binary
37 fileevent
$commfd readable
"getcommitlines $commfd"
39 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
40 -font $mainfont -tags textitems
41 . config
-cursor watch
42 $ctext config
-cursor watch
45 proc getcommitlines
{commfd
} {
46 global commits parents cdate children nchildren
47 global commitlisted phase commitinfo nextupdate
48 global stopped redisplaying leftover
50 set stuff
[read $commfd]
52 if {![eof
$commfd]} return
53 # this works around what is apparently a bug in Tcl...
54 fconfigure
$commfd -blocking 1
55 if {![catch
{close
$commfd} err
]} {
56 after idle finishcommits
59 if {[string range
$err 0 4] == "usage"} {
61 {Gitk
: error reading commits
: bad arguments to git-rev-list.
62 (Note
: arguments to gitk are passed to git-rev-list
63 to allow selection of commits to be displayed.
)}
65 set err
"Error reading commits: $err"
72 set i
[string first
"\0" $stuff $start]
74 set leftover
[string range
$stuff $start end
]
77 set cmit
[string range
$stuff $start [expr {$i - 1}]]
79 set cmit
"$leftover$cmit"
81 set start
[expr {$i + 1}]
82 if {![regexp
{^
([0-9a-f]{40})\n} $cmit match id
]} {
83 error_popup
"Can't parse git-rev-list output: {$cmit}"
86 set cmit
[string range
$cmit 41 end
]
88 set commitlisted
($id) 1
89 parsecommit
$id $cmit 1
91 if {[clock clicks
-milliseconds] >= $nextupdate} {
94 while {$redisplaying} {
98 set phase
"getcommits"
102 if {[clock clicks
-milliseconds] >= $nextupdate} {
112 global commfd nextupdate
115 fileevent
$commfd readable
{}
117 fileevent
$commfd readable
"getcommitlines $commfd"
120 proc readcommit
{id
} {
121 if [catch
{set contents
[exec git-cat-file commit
$id]}] return
122 parsecommit
$id $contents 0
125 proc parsecommit
{id contents listed
} {
126 global commitinfo children nchildren parents nparents cdate ncleft
135 if {![info exists nchildren
($id)]} {
142 foreach line
[split $contents "\n"] {
147 set tag
[lindex
$line 0]
148 if {$tag == "parent"} {
149 set p
[lindex
$line 1]
150 if {![info exists nchildren
($p)]} {
155 lappend parents
($id) $p
157 # sometimes we get a commit that lists a parent twice...
158 if {$listed && [lsearch
-exact $children($p) $id] < 0} {
159 lappend children
($p) $id
163 } elseif
{$tag == "author"} {
164 set x
[expr {[llength
$line] - 2}]
165 set audate
[lindex
$line $x]
166 set auname
[lrange
$line 1 [expr {$x - 1}]]
167 } elseif
{$tag == "committer"} {
168 set x
[expr {[llength
$line] - 2}]
169 set comdate
[lindex
$line $x]
170 set comname
[lrange
$line 1 [expr {$x - 1}]]
174 if {$comment == {}} {
175 set headline
[string trim
$line]
180 # git-rev-list indents the comment by 4 spaces;
181 # if we got this via git-cat-file, add the indentation
188 set audate
[clock format
$audate -format "%Y-%m-%d %H:%M:%S"]
190 if {$comdate != {}} {
191 set cdate
($id) $comdate
192 set comdate
[clock format
$comdate -format "%Y-%m-%d %H:%M:%S"]
194 set commitinfo
($id) [list
$headline $auname $audate \
195 $comname $comdate $comment]
199 global tagids idtags headids idheads
200 set tags
[glob
-nocomplain -types f .git
/refs
/tags
/*]
205 if {[regexp
{^
[0-9a-f]{40}} $line id
]} {
206 set direct
[file tail $f]
207 set tagids
($direct) $id
208 lappend idtags
($id) $direct
209 set contents
[split [exec git-cat-file tag
$id] "\n"]
213 foreach l
$contents {
215 switch
-- [lindex
$l 0] {
216 "object" {set obj
[lindex
$l 1]}
217 "type" {set type [lindex
$l 1]}
218 "tag" {set tag
[string range
$l 4 end
]}
221 if {$obj != {} && $type == "commit" && $tag != {}} {
222 set tagids
($tag) $obj
223 lappend idtags
($obj) $tag
229 set heads
[glob
-nocomplain -types f .git
/refs
/heads
/*]
233 set line
[read $fd 40]
234 if {[regexp
{^
[0-9a-f]{40}} $line id
]} {
235 set head [file tail $f]
236 set headids
($head) $line
237 lappend idheads
($line) $head
244 proc error_popup msg
{
248 message
$w.m
-text $msg -justify center
-aspect 400
249 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
250 button
$w.ok
-text OK
-command "destroy $w"
251 pack
$w.ok
-side bottom
-fill x
252 bind $w <Visibility
> "grab $w; focus $w"
257 global canv canv2 canv3 linespc charspc ctext cflist textfont
258 global findtype findloc findstring fstring geometry
259 global entries sha1entry sha1string sha1but
260 global maincursor textcursor
264 .bar add cascade
-label "File" -menu .bar.
file
266 .bar.
file add
command -label "Quit" -command doquit
268 .bar add cascade
-label "Help" -menu .bar.
help
269 .bar.
help add
command -label "About gitk" -command about
270 . configure
-menu .bar
272 if {![info exists geometry
(canv1
)]} {
273 set geometry
(canv1
) [expr 45 * $charspc]
274 set geometry
(canv2
) [expr 30 * $charspc]
275 set geometry
(canv3
) [expr 15 * $charspc]
276 set geometry
(canvh
) [expr 25 * $linespc + 4]
277 set geometry
(ctextw
) 80
278 set geometry
(ctexth
) 30
279 set geometry
(cflistw
) 30
281 panedwindow .ctop
-orient vertical
282 if {[info exists geometry
(width
)]} {
283 .ctop conf
-width $geometry(width
) -height $geometry(height
)
284 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
285 set geometry
(ctexth
) [expr {($texth - 8) /
286 [font metrics
$textfont -linespace]}]
290 pack .ctop.top.bar
-side bottom
-fill x
291 set cscroll .ctop.top.csb
292 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
293 pack
$cscroll -side right
-fill y
294 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
295 pack .ctop.top.clist
-side top
-fill both
-expand 1
297 set canv .ctop.top.clist.canv
298 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
300 -yscrollincr $linespc -yscrollcommand "$cscroll set"
301 .ctop.top.clist add
$canv
302 set canv2 .ctop.top.clist.canv2
303 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
304 -bg white
-bd 0 -yscrollincr $linespc
305 .ctop.top.clist add
$canv2
306 set canv3 .ctop.top.clist.canv3
307 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
308 -bg white
-bd 0 -yscrollincr $linespc
309 .ctop.top.clist add
$canv3
310 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
312 set sha1entry .ctop.top.bar.sha1
313 set entries
$sha1entry
314 set sha1but .ctop.top.bar.sha1label
315 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
316 -command gotocommit
-width 8
317 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
318 pack .ctop.top.bar.sha1label
-side left
319 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
320 trace add variable sha1string
write sha1change
321 pack
$sha1entry -side left
-pady 2
322 button .ctop.top.bar.findbut
-text "Find" -command dofind
323 pack .ctop.top.bar.findbut
-side left
325 set fstring .ctop.top.bar.findstring
326 lappend entries
$fstring
327 entry
$fstring -width 30 -font $textfont -textvariable findstring
328 pack
$fstring -side left
-expand 1 -fill x
330 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
331 set findloc
"All fields"
332 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
333 Comments Author Committer
334 pack .ctop.top.bar.findloc
-side right
335 pack .ctop.top.bar.findtype
-side right
337 panedwindow .ctop.cdet
-orient horizontal
339 frame .ctop.cdet.left
340 set ctext .ctop.cdet.left.ctext
341 text
$ctext -bg white
-state disabled
-font $textfont \
342 -width $geometry(ctextw
) -height $geometry(ctexth
) \
343 -yscrollcommand ".ctop.cdet.left.sb set"
344 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
345 pack .ctop.cdet.left.sb
-side right
-fill y
346 pack
$ctext -side left
-fill both
-expand 1
347 .ctop.cdet add .ctop.cdet.left
349 $ctext tag conf filesep
-font [concat
$textfont bold
]
350 $ctext tag conf hunksep
-back blue
-fore white
351 $ctext tag conf d0
-back "#ff8080"
352 $ctext tag conf d1
-back green
353 $ctext tag conf found
-back yellow
355 frame .ctop.cdet.right
356 set cflist .ctop.cdet.right.cfiles
357 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
358 -yscrollcommand ".ctop.cdet.right.sb set"
359 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
360 pack .ctop.cdet.right.sb
-side right
-fill y
361 pack
$cflist -side left
-fill both
-expand 1
362 .ctop.cdet add .ctop.cdet.right
363 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
365 pack .ctop
-side top
-fill both
-expand 1
367 bindall
<1> {selcanvline
%W
%x
%y
}
368 #bindall <B1-Motion> {selcanvline %W %x %y}
369 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
370 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
371 bindall
<2> "allcanvs scan mark 0 %y"
372 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
373 bind .
<Key-Up
> "selnextline -1"
374 bind .
<Key-Down
> "selnextline 1"
375 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
376 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
377 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
378 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
379 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
380 bindkey p
"selnextline -1"
381 bindkey n
"selnextline 1"
382 bindkey b
"$ctext yview scroll -1 pages"
383 bindkey d
"$ctext yview scroll 18 units"
384 bindkey u
"$ctext yview scroll -18 units"
388 bind .
<Control-q
> doquit
389 bind .
<Control-f
> dofind
390 bind .
<Control-g
> findnext
391 bind .
<Control-r
> findprev
392 bind .
<Control-equal
> {incrfont
1}
393 bind .
<Control-KP_Add
> {incrfont
1}
394 bind .
<Control-minus
> {incrfont
-1}
395 bind .
<Control-KP_Subtract
> {incrfont
-1}
396 bind $cflist <<ListboxSelect>> listboxsel
397 bind . <Destroy> {savestuff %W}
398 bind . <Button-1> "click %W"
399 bind $fstring <Key-Return> dofind
400 bind $sha1entry <Key-Return> gotocommit
402 set maincursor [. cget -cursor]
403 set textcursor [$ctext cget -cursor]
405 set rowctxmenu .rowctxmenu
406 menu $rowctxmenu -tearoff 0
407 $rowctxmenu add command -label "Diff this -> selected" \
408 -command {diffvssel 0}
409 $rowctxmenu add command -label "Diff selected -> this" \
410 -command {diffvssel 1}
413 # when we make a key binding for the toplevel, make sure
414 # it doesn't get triggered when that key is pressed in the
415 # find string entry widget.
416 proc bindkey {ev script} {
419 set escript [bind Entry $ev]
420 if {$escript == {}} {
421 set escript [bind Entry <Key>]
424 bind $e $ev "$escript; break"
428 # set the focus back to the toplevel for any click outside
439 global canv canv2 canv3 ctext cflist mainfont textfont
441 if {$stuffsaved} return
442 if {![winfo viewable .]} return
444 set f [open "~/.gitk-new" w]
445 puts $f "set mainfont {$mainfont}"
446 puts $f "set textfont {$textfont}"
447 puts $f "set geometry(width) [winfo width .ctop]"
448 puts $f "set geometry(height) [winfo height .ctop]"
449 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
450 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
451 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
452 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
453 set wid [expr {([winfo width $ctext] - 8) \
454 / [font measure $textfont "0"]}]
455 puts $f "set geometry(ctextw) $wid"
456 set wid [expr {([winfo width $cflist] - 11) \
457 / [font measure [$cflist cget -font] "0"]}]
458 puts $f "set geometry(cflistw) $wid"
460 file rename -force "~/.gitk-new" "~/.gitk"
465 proc resizeclistpanes {win w} {
467 if [info exists oldwidth($win)] {
468 set s0 [$win sash coord 0]
469 set s1 [$win sash coord 1]
471 set sash0 [expr {int($w/2 - 2)}]
472 set sash1 [expr {int($w*5/6 - 2)}]
474 set factor [expr {1.0 * $w / $oldwidth($win)}]
475 set sash0 [expr {int($factor * [lindex $s0 0])}]
476 set sash1 [expr {int($factor * [lindex $s1 0])}]
480 if {$sash1 < $sash0 + 20} {
481 set sash1 [expr $sash0 + 20]
483 if {$sash1 > $w - 10} {
484 set sash1 [expr $w - 10]
485 if {$sash0 > $sash1 - 20} {
486 set sash0 [expr $sash1 - 20]
490 $win sash place 0 $sash0 [lindex $s0 1]
491 $win sash place 1 $sash1 [lindex $s1 1]
493 set oldwidth($win) $w
496 proc resizecdetpanes {win w} {
498 if [info exists oldwidth($win)] {
499 set s0 [$win sash coord 0]
501 set sash0 [expr {int($w*3/4 - 2)}]
503 set factor [expr {1.0 * $w / $oldwidth($win)}]
504 set sash0 [expr {int($factor * [lindex $s0 0])}]
508 if {$sash0 > $w - 15} {
509 set sash0 [expr $w - 15]
512 $win sash place 0 $sash0 [lindex $s0 1]
514 set oldwidth($win) $w
518 global canv canv2 canv3
524 proc bindall {event action} {
525 global canv canv2 canv3
526 bind $canv $event $action
527 bind $canv2 $event $action
528 bind $canv3 $event $action
533 if {[winfo exists $w]} {
538 wm title $w "About gitk"
542 Copyright © 2005 Paul Mackerras
544 Use and redistribute under the terms of the GNU General Public License} \
545 -justify center -aspect 400
546 pack $w.m -side top -fill x -padx 20 -pady 20
547 button $w.ok -text Close -command "destroy $w"
548 pack $w.ok -side bottom
551 proc assigncolor {id} {
552 global commitinfo colormap commcolors colors nextcolor
553 global parents nparents children nchildren
554 global cornercrossings crossings
556 if [info exists colormap($id)] return
557 set ncolors [llength $colors]
558 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
559 set child [lindex $children($id) 0]
560 if {[info exists colormap($child)]
561 && $nparents($child) == 1} {
562 set colormap($id) $colormap($child)
567 if {[info exists cornercrossings($id)]} {
568 foreach x $cornercrossings($id) {
569 if {[info exists colormap($x)]
570 && [lsearch -exact $badcolors $colormap($x)] < 0} {
571 lappend badcolors $colormap($x)
574 if {[llength $badcolors] >= $ncolors} {
578 set origbad $badcolors
579 if {[llength $badcolors] < $ncolors - 1} {
580 if {[info exists crossings($id)]} {
581 foreach x $crossings($id) {
582 if {[info exists colormap($x)]
583 && [lsearch -exact $badcolors $colormap($x)] < 0} {
584 lappend badcolors $colormap($x)
587 if {[llength $badcolors] >= $ncolors} {
588 set badcolors $origbad
591 set origbad $badcolors
593 if {[llength $badcolors] < $ncolors - 1} {
594 foreach child $children($id) {
595 if {[info exists colormap($child)]
596 && [lsearch -exact $badcolors $colormap($child)] < 0} {
597 lappend badcolors $colormap($child)
599 if {[info exists parents($child)]} {
600 foreach p $parents($child) {
601 if {[info exists colormap($p)]
602 && [lsearch -exact $badcolors $colormap($p)] < 0} {
603 lappend badcolors $colormap($p)
608 if {[llength $badcolors] >= $ncolors} {
609 set badcolors $origbad
612 for {set i 0} {$i <= $ncolors} {incr i} {
613 set c [lindex $colors $nextcolor]
614 if {[incr nextcolor] >= $ncolors} {
617 if {[lsearch -exact $badcolors $c]} break
623 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
624 global mainline sidelines
625 global nchildren ncleft
632 set lthickness [expr {int($linespc / 9) + 1}]
633 catch {unset mainline}
634 catch {unset sidelines}
635 foreach id [array names nchildren] {
636 set ncleft($id) $nchildren($id)
640 proc bindline {t id} {
643 $canv bind $t <Enter> "lineenter %x %y $id"
644 $canv bind $t <Motion> "linemotion %x %y $id"
645 $canv bind $t <Leave> "lineleave $id"
646 $canv bind $t <Button-1> "lineclick %x %y $id"
649 proc drawcommitline {level} {
650 global parents children nparents nchildren todo
651 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
652 global lineid linehtag linentag linedtag commitinfo
653 global colormap numcommits currentparents dupparents
654 global oldlevel oldnlines oldtodo
655 global idtags idline idheads
656 global lineno lthickness mainline sidelines
657 global commitlisted rowtextx
661 set id [lindex $todo $level]
662 set lineid($lineno) $id
663 set idline($id) $lineno
664 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
665 if {![info exists commitinfo($id)]} {
667 if {![info exists commitinfo($id)]} {
668 set commitinfo($id) {"No commit information available"}
673 set currentparents {}
675 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
676 foreach p $parents($id) {
677 if {[lsearch -exact $currentparents $p] < 0} {
678 lappend currentparents $p
680 # remember that this parent was listed twice
681 lappend dupparents $p
685 set x [expr $canvx0 + $level * $linespc]
687 set canvy [expr $canvy + $linespc]
688 allcanvs conf -scrollregion \
689 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
690 if {[info exists mainline($id)]} {
691 lappend mainline($id) $x $y1
692 set t [$canv create line $mainline($id) \
693 -width $lthickness -fill $colormap($id)]
697 if {[info exists sidelines($id)]} {
698 foreach ls $sidelines($id) {
699 set coords [lindex $ls 0]
700 set thick [lindex $ls 1]
701 set t [$canv create line $coords -fill $colormap($id) \
702 -width [expr {$thick * $lthickness}]]
707 set orad [expr {$linespc / 3}]
708 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
709 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
710 -fill $ofill -outline black -width 1]
712 $canv bind $t <1> {selcanvline {} %x %y}
713 set xt [expr $canvx0 + [llength $todo] * $linespc]
714 if {[llength $currentparents] > 2} {
715 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
717 set rowtextx($lineno) $xt
720 if {[info exists idtags($id)]} {
721 set marks $idtags($id)
722 set ntags [llength $marks]
724 if {[info exists idheads($id)]} {
725 set marks [concat $marks $idheads($id)]
728 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
729 set yt [expr $y1 - 0.5 * $linespc]
730 set yb [expr $yt + $linespc - 1]
734 set wid [font measure $mainfont $tag]
737 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
739 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
740 -width $lthickness -fill black]
742 foreach tag $marks x $xvals wid $wvals {
743 set xl [expr $x + $delta]
744 set xr [expr $x + $delta + $wid + $lthickness]
745 if {[incr ntags -1] >= 0} {
747 $canv create polygon $x [expr $yt + $delta] $xl $yt\
748 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
749 -width 1 -outline black -fill yellow
752 set xl [expr $xl - $delta/2]
753 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
754 -width 1 -outline black -fill green
756 $canv create text $xl $y1 -anchor w -text $tag \
760 set headline [lindex $commitinfo($id) 0]
761 set name [lindex $commitinfo($id) 1]
762 set date [lindex $commitinfo($id) 2]
763 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
764 -text $headline -font $mainfont ]
765 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
766 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
767 -text $name -font $namefont]
768 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
769 -text $date -font $mainfont]
772 proc updatetodo {level noshortcut} {
773 global currentparents ncleft todo
774 global mainline oldlevel oldtodo oldnlines
775 global canvx0 canvy linespc mainline
780 set oldnlines [llength $todo]
781 if {!$noshortcut && [llength $currentparents] == 1} {
782 set p [lindex $currentparents 0]
783 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
785 set x [expr $canvx0 + $level * $linespc]
786 set y [expr $canvy - $linespc]
787 set mainline($p) [list $x $y]
788 set todo [lreplace $todo $level $level $p]
793 set todo [lreplace $todo $level $level]
795 foreach p $currentparents {
797 set k [lsearch -exact $todo $p]
799 set todo [linsert $todo $i $p]
806 proc notecrossings {id lo hi corner} {
807 global oldtodo crossings cornercrossings
809 for {set i $lo} {[incr i] < $hi} {} {
810 set p [lindex $oldtodo $i]
811 if {$p == {}} continue
813 if {![info exists cornercrossings($id)]
814 || [lsearch -exact $cornercrossings($id) $p] < 0} {
815 lappend cornercrossings($id) $p
817 if {![info exists cornercrossings($p)]
818 || [lsearch -exact $cornercrossings($p) $id] < 0} {
819 lappend cornercrossings($p) $id
822 if {![info exists crossings($id)]
823 || [lsearch -exact $crossings($id) $p] < 0} {
824 lappend crossings($id) $p
826 if {![info exists crossings($p)]
827 || [lsearch -exact $crossings($p) $id] < 0} {
828 lappend crossings($p) $id
835 global canv mainline sidelines canvx0 canvy linespc
836 global oldlevel oldtodo todo currentparents dupparents
837 global lthickness linespc canvy colormap
839 set y1 [expr $canvy - $linespc]
842 foreach id $oldtodo {
844 if {$id == {}} continue
845 set xi [expr {$canvx0 + $i * $linespc}]
846 if {$i == $oldlevel} {
847 foreach p $currentparents {
848 set j [lsearch -exact $todo $p]
849 set coords [list $xi $y1]
850 set xj [expr {$canvx0 + $j * $linespc}]
852 lappend coords [expr $xj + $linespc] $y1
853 notecrossings $p $j $i [expr {$j + 1}]
854 } elseif {$j > $i + 1} {
855 lappend coords [expr $xj - $linespc] $y1
856 notecrossings $p $i $j [expr {$j - 1}]
858 if {[lsearch -exact $dupparents $p] >= 0} {
859 # draw a double-width line to indicate the doubled parent
860 lappend coords $xj $y2
861 lappend sidelines($p) [list $coords 2]
862 if {![info exists mainline($p)]} {
863 set mainline($p) [list $xj $y2]
866 # normal case, no parent duplicated
867 if {![info exists mainline($p)]} {
869 lappend coords $xj $y2
871 set mainline($p) $coords
873 lappend coords $xj $y2
874 lappend sidelines($p) [list $coords 1]
878 } elseif {[lindex $todo $i] != $id} {
879 set j [lsearch -exact $todo $id]
880 set xj [expr {$canvx0 + $j * $linespc}]
881 lappend mainline($id) $xi $y1 $xj $y2
887 global parents children nchildren ncleft todo
888 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
889 global datemode cdate
890 global lineid linehtag linentag linedtag commitinfo
891 global currentparents oldlevel oldnlines oldtodo
892 global lineno lthickness
894 # remove the null entry if present
895 set nullentry [lsearch -exact $todo {}]
896 if {$nullentry >= 0} {
897 set todo [lreplace $todo $nullentry $nullentry]
900 # choose which one to do next time around
901 set todol [llength $todo]
904 for {set k $todol} {[incr k -1] >= 0} {} {
905 set p [lindex $todo $k]
906 if {$ncleft($p) == 0} {
908 if {$latest == {} || $cdate($p) > $latest} {
910 set latest $cdate($p)
920 puts "ERROR: none of the pending commits can be done yet:"
922 puts " $p ($ncleft($p))"
928 # If we are reducing, put in a null entry
929 if {$todol < $oldnlines} {
930 if {$nullentry >= 0} {
933 && [lindex $oldtodo $i] == [lindex $todo $i]} {
943 set todo [linsert $todo $i {}]
952 proc drawcommit {id} {
953 global phase todo nchildren datemode nextupdate
956 if {$phase != "incrdraw"} {
962 updatetodo 0 $datemode
964 if {$nchildren($id) == 0} {
966 lappend startcommits $id
968 set level [decidenext]
969 if {$id != [lindex $todo $level]} {
974 drawcommitline $level
975 if {[updatetodo $level $datemode]} {
976 set level [decidenext]
978 set id [lindex $todo $level]
979 if {![info exists commitlisted($id)]} {
982 if {[clock clicks -milliseconds] >= $nextupdate} {
990 proc finishcommits {} {
993 global ctext maincursor textcursor
995 if {$phase != "incrdraw"} {
997 $canv create text 3 3 -anchor nw -text "No commits selected" \
998 -font $mainfont -tags textitems
1003 set level [decidenext]
1004 drawrest $level [llength $startcommits]
1005 . config -cursor $maincursor
1006 $ctext config -cursor $textcursor
1010 global nextupdate startmsecs startcommits todo
1012 if {$startcommits == {}} return
1013 set startmsecs [clock clicks -milliseconds]
1014 set nextupdate [expr $startmsecs + 100]
1016 set todo [lindex $startcommits 0]
1020 proc drawrest {level startix} {
1021 global phase stopped redisplaying selectedline
1022 global datemode currentparents todo
1024 global nextupdate startmsecs startcommits idline
1028 set startid [lindex $startcommits $startix]
1030 if {$startid != {}} {
1031 set startline $idline($startid)
1035 drawcommitline $level
1036 set hard [updatetodo $level $datemode]
1037 if {$numcommits == $startline} {
1038 lappend todo $startid
1041 set startid [lindex $startcommits $startix]
1043 if {$startid != {}} {
1044 set startline $idline($startid)
1048 set level [decidenext]
1049 if {$level < 0} break
1052 if {[clock clicks -milliseconds] >= $nextupdate} {
1059 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1060 #puts "overall $drawmsecs ms for $numcommits commits"
1061 if {$redisplaying} {
1062 if {$stopped == 0 && [info exists selectedline]} {
1063 selectline $selectedline
1065 if {$stopped == 1} {
1067 after idle drawgraph
1074 proc findmatches {f} {
1075 global findtype foundstring foundstrlen
1076 if {$findtype == "Regexp"} {
1077 set matches [regexp -indices -all -inline $foundstring $f]
1079 if {$findtype == "IgnCase"} {
1080 set str [string tolower $f]
1086 while {[set j [string first $foundstring $str $i]] >= 0} {
1087 lappend matches [list $j [expr $j+$foundstrlen-1]]
1088 set i [expr $j + $foundstrlen]
1095 global findtype findloc findstring markedmatches commitinfo
1096 global numcommits lineid linehtag linentag linedtag
1097 global mainfont namefont canv canv2 canv3 selectedline
1098 global matchinglines foundstring foundstrlen
1101 set matchinglines {}
1102 set fldtypes {Headline Author Date Committer CDate Comment}
1103 if {$findtype == "IgnCase"} {
1104 set foundstring [string tolower $findstring]
1106 set foundstring $findstring
1108 set foundstrlen [string length $findstring]
1109 if {$foundstrlen == 0} return
1110 if {![info exists selectedline]} {
1113 set oldsel $selectedline
1116 for {set l 0} {$l < $numcommits} {incr l} {
1118 set info $commitinfo($id)
1120 foreach f $info ty $fldtypes {
1121 if {$findloc != "All fields" && $findloc != $ty} {
1124 set matches [findmatches $f]
1125 if {$matches == {}} continue
1127 if {$ty == "Headline"} {
1128 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1129 } elseif {$ty == "Author"} {
1130 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1131 } elseif {$ty == "Date"} {
1132 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1136 lappend matchinglines $l
1137 if {!$didsel && $l > $oldsel} {
1143 if {$matchinglines == {}} {
1145 } elseif {!$didsel} {
1146 findselectline [lindex $matchinglines 0]
1150 proc findselectline {l} {
1151 global findloc commentend ctext
1153 if {$findloc == "All fields" || $findloc == "Comments"} {
1154 # highlight the matches in the comments
1155 set f [$ctext get 1.0 $commentend]
1156 set matches [findmatches $f]
1157 foreach match $matches {
1158 set start [lindex $match 0]
1159 set end [expr [lindex $match 1] + 1]
1160 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1166 global matchinglines selectedline
1167 if {![info exists matchinglines]} {
1171 if {![info exists selectedline]} return
1172 foreach l $matchinglines {
1173 if {$l > $selectedline} {
1182 global matchinglines selectedline
1183 if {![info exists matchinglines]} {
1187 if {![info exists selectedline]} return
1189 foreach l $matchinglines {
1190 if {$l >= $selectedline} break
1194 findselectline $prev
1200 proc markmatches {canv l str tag matches font} {
1201 set bbox [$canv bbox $tag]
1202 set x0 [lindex $bbox 0]
1203 set y0 [lindex $bbox 1]
1204 set y1 [lindex $bbox 3]
1205 foreach match $matches {
1206 set start [lindex $match 0]
1207 set end [lindex $match 1]
1208 if {$start > $end} continue
1209 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1210 set xlen [font measure $font [string range $str 0 [expr $end]]]
1211 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1212 -outline {} -tags matches -fill yellow]
1217 proc unmarkmatches {} {
1218 global matchinglines
1219 allcanvs delete matches
1220 catch {unset matchinglines}
1223 proc selcanvline {w x y} {
1224 global canv canvy0 ctext linespc selectedline
1225 global lineid linehtag linentag linedtag rowtextx
1226 set ymax [lindex [$canv cget -scrollregion] 3]
1227 if {$ymax == {}} return
1228 set yfrac [lindex [$canv yview] 0]
1229 set y [expr {$y + $yfrac * $ymax}]
1230 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1235 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1241 proc selectline {l} {
1242 global canv canv2 canv3 ctext commitinfo selectedline
1243 global lineid linehtag linentag linedtag
1244 global canvy0 linespc parents nparents
1245 global cflist currentid sha1entry diffids
1246 global commentend seenfile idtags
1248 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1250 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1251 -tags secsel -fill [$canv cget -selectbackground]]
1253 $canv2 delete secsel
1254 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1255 -tags secsel -fill [$canv2 cget -selectbackground]]
1257 $canv3 delete secsel
1258 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1259 -tags secsel -fill [$canv3 cget -selectbackground]]
1261 set y [expr {$canvy0 + $l * $linespc}]
1262 set ymax [lindex [$canv cget -scrollregion] 3]
1263 set ytop [expr {$y - $linespc - 1}]
1264 set ybot [expr {$y + $linespc + 1}]
1265 set wnow [$canv yview]
1266 set wtop [expr [lindex $wnow 0] * $ymax]
1267 set wbot [expr [lindex $wnow 1] * $ymax]
1268 set wh [expr {$wbot - $wtop}]
1270 if {$ytop < $wtop} {
1271 if {$ybot < $wtop} {
1272 set newtop [expr {$y - $wh / 2.0}]
1275 if {$newtop > $wtop - $linespc} {
1276 set newtop [expr {$wtop - $linespc}]
1279 } elseif {$ybot > $wbot} {
1280 if {$ytop > $wbot} {
1281 set newtop [expr {$y - $wh / 2.0}]
1283 set newtop [expr {$ybot - $wh}]
1284 if {$newtop < $wtop + $linespc} {
1285 set newtop [expr {$wtop + $linespc}]
1289 if {$newtop != $wtop} {
1293 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1299 set diffids [concat $id $parents($id)]
1300 $sha1entry delete 0 end
1301 $sha1entry insert 0 $id
1302 $sha1entry selection from 0
1303 $sha1entry selection to end
1305 $ctext conf -state normal
1306 $ctext delete 0.0 end
1307 $ctext mark set fmark.0 0.0
1308 $ctext mark gravity fmark.0 left
1309 set info $commitinfo($id)
1310 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1311 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1312 if {[info exists idtags($id)]} {
1313 $ctext insert end "Tags:"
1314 foreach tag $idtags($id) {
1315 $ctext insert end " $tag"
1317 $ctext insert end "\n"
1319 $ctext insert end "\n"
1320 $ctext insert end [lindex $info 5]
1321 $ctext insert end "\n"
1322 $ctext tag delete Comments
1323 $ctext tag remove found 1.0 end
1324 $ctext conf -state disabled
1325 set commentend [$ctext index "end - 1c"]
1327 $cflist delete 0 end
1328 $cflist insert end "Comments"
1329 if {$nparents($id) == 1} {
1332 catch {unset seenfile}
1336 global treediffs diffids treepending
1338 if {![info exists treediffs($diffids)]} {
1339 if {![info exists treepending]} {
1340 gettreediffs $diffids
1343 addtocflist $diffids
1347 proc selnextline {dir} {
1349 if {![info exists selectedline]} return
1350 set l [expr $selectedline + $dir]
1355 proc addtocflist {ids} {
1356 global diffids treediffs cflist
1357 if {$ids != $diffids} {
1358 gettreediffs $diffids
1361 foreach f $treediffs($ids) {
1362 $cflist insert end $f
1367 proc gettreediffs {ids} {
1368 global treediffs parents treepending
1369 set treepending $ids
1370 set treediffs($ids) {}
1371 set id [lindex $ids 0]
1372 set p [lindex $ids 1]
1373 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1374 fconfigure $gdtf -blocking 0
1375 fileevent $gdtf readable "gettreediffline $gdtf {$ids}"
1378 proc gettreediffline {gdtf ids} {
1379 global treediffs treepending
1380 set n [gets $gdtf line]
1382 if {![eof $gdtf]} return
1388 set file [lindex $line 5]
1389 lappend treediffs($ids) $file
1392 proc getblobdiffs {ids} {
1393 global diffopts blobdifffd env curdifftag curtagstart
1394 global diffindex difffilestart nextupdate
1396 set id [lindex $ids 0]
1397 set p [lindex $ids 1]
1398 set env(GIT_DIFF_OPTS) $diffopts
1399 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1400 puts "error getting diffs: $err"
1403 fconfigure $bdf -blocking 0
1404 set blobdifffd($ids) $bdf
1405 set curdifftag Comments
1408 catch {unset difffilestart}
1409 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1410 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1413 proc getblobdiffline {bdf ids} {
1414 global diffids blobdifffd ctext curdifftag curtagstart seenfile
1415 global diffnexthead diffnextnote diffindex difffilestart
1418 set n [gets $bdf line]
1422 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
1423 $ctext tag add $curdifftag $curtagstart end
1424 set seenfile($curdifftag) 1
1429 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
1432 $ctext conf -state normal
1433 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1434 # start of a new file
1435 $ctext insert end "\n"
1436 $ctext tag add $curdifftag $curtagstart end
1437 set seenfile($curdifftag) 1
1438 set curtagstart [$ctext index "end - 1c"]
1440 if {[info exists diffnexthead]} {
1441 set fname $diffnexthead
1442 set header "$diffnexthead ($diffnextnote)"
1445 set here [$ctext index "end - 1c"]
1446 set difffilestart($diffindex) $here
1448 # start mark names at fmark.1 for first file
1449 $ctext mark set fmark.$diffindex $here
1450 $ctext mark gravity fmark.$diffindex left
1451 set curdifftag "f:$fname"
1452 $ctext tag delete $curdifftag
1453 set l [expr {(78 - [string length $header]) / 2}]
1454 set pad [string range "----------------------------------------" 1 $l]
1455 $ctext insert end "$pad $header $pad\n" filesep
1456 } elseif {[string range $line 0 2] == "+++"} {
1457 # no need to do anything with this
1458 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1459 set diffnexthead $fn
1460 set diffnextnote "created, mode $m"
1461 } elseif {[string range $line 0 8] == "Deleted: "} {
1462 set diffnexthead [string range $line 9 end]
1463 set diffnextnote "deleted"
1464 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1465 # save the filename in case the next thing is "new file mode ..."
1466 set diffnexthead $fn
1467 set diffnextnote "modified"
1468 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1469 set diffnextnote "new file, mode $m"
1470 } elseif {[string range $line 0 11] == "deleted file"} {
1471 set diffnextnote "deleted"
1472 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1473 $line match f1l f1c f2l f2c rest]} {
1474 $ctext insert end "\t" hunksep
1475 $ctext insert end " $f1l " d0 " $f2l " d1
1476 $ctext insert end " $rest \n" hunksep
1478 set x [string range $line 0 0]
1479 if {$x == "-" || $x == "+"} {
1480 set tag [expr {$x == "+"}]
1481 set line [string range $line 1 end]
1482 $ctext insert end "$line\n" d$tag
1483 } elseif {$x == " "} {
1484 set line [string range $line 1 end]
1485 $ctext insert end "$line\n"
1486 } elseif {$x == "\\"} {
1487 # e.g. "\ No newline at end of file"
1488 $ctext insert end "$line\n" filesep
1490 # Something else we don't recognize
1491 if {$curdifftag != "Comments"} {
1492 $ctext insert end "\n"
1493 $ctext tag add $curdifftag $curtagstart end
1494 set seenfile($curdifftag) 1
1495 set curtagstart [$ctext index "end - 1c"]
1496 set curdifftag Comments
1498 $ctext insert end "$line\n" filesep
1501 $ctext conf -state disabled
1502 if {[clock clicks -milliseconds] >= $nextupdate} {
1504 fileevent $bdf readable {}
1506 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
1511 global difffilestart ctext
1512 set here [$ctext index @0,0]
1513 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1514 if {[$ctext compare $difffilestart($i) > $here]} {
1515 $ctext yview $difffilestart($i)
1521 proc listboxsel {} {
1522 global ctext cflist currentid treediffs seenfile
1523 if {![info exists currentid]} return
1524 set sel [lsort [$cflist curselection]]
1525 if {$sel eq {}} return
1526 set first [lindex $sel 0]
1527 catch {$ctext yview fmark.$first}
1531 global linespc charspc canvx0 canvy0 mainfont
1532 set linespc [font metrics $mainfont -linespace]
1533 set charspc [font measure $mainfont "m"]
1534 set canvy0 [expr 3 + 0.5 * $linespc]
1535 set canvx0 [expr 3 + 0.5 * $linespc]
1539 global selectedline stopped redisplaying phase
1540 if {$stopped > 1} return
1541 if {$phase == "getcommits"} return
1543 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1550 proc incrfont {inc} {
1551 global mainfont namefont textfont selectedline ctext canv phase
1552 global stopped entries
1554 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1555 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1556 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1558 $ctext conf -font $textfont
1559 $ctext tag conf filesep -font [concat $textfont bold]
1560 foreach e $entries {
1561 $e conf -font $mainfont
1563 if {$phase == "getcommits"} {
1564 $canv itemconf textitems -font $mainfont
1569 proc sha1change {n1 n2 op} {
1570 global sha1string currentid sha1but
1571 if {$sha1string == {}
1572 || ([info exists currentid] && $sha1string == $currentid)} {
1577 if {[$sha1but cget -state] == $state} return
1578 if {$state == "normal"} {
1579 $sha1but conf -state normal -relief raised -text "Goto: "
1581 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1585 proc gotocommit {} {
1586 global sha1string currentid idline tagids
1587 if {$sha1string == {}
1588 || ([info exists currentid] && $sha1string == $currentid)} return
1589 if {[info exists tagids($sha1string)]} {
1590 set id $tagids($sha1string)
1592 set id [string tolower $sha1string]
1594 if {[info exists idline($id)]} {
1595 selectline $idline($id)
1598 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1603 error_popup "$type $sha1string is not known"
1606 proc lineenter {x y id} {
1607 global hoverx hovery hoverid hovertimer
1608 global commitinfo canv
1610 if {![info exists commitinfo($id)]} return
1614 if {[info exists hovertimer]} {
1615 after cancel $hovertimer
1617 set hovertimer [after 500 linehover]
1621 proc linemotion {x y id} {
1622 global hoverx hovery hoverid hovertimer
1624 if {[info exists hoverid] && $id == $hoverid} {
1627 if {[info exists hovertimer]} {
1628 after cancel $hovertimer
1630 set hovertimer [after 500 linehover]
1634 proc lineleave {id} {
1635 global hoverid hovertimer canv
1637 if {[info exists hoverid] && $id == $hoverid} {
1639 if {[info exists hovertimer]} {
1640 after cancel $hovertimer
1648 global hoverx hovery hoverid hovertimer
1649 global canv linespc lthickness
1650 global commitinfo mainfont
1652 set text [lindex $commitinfo($hoverid) 0]
1653 set ymax [lindex [$canv cget -scrollregion] 3]
1654 if {$ymax == {}} return
1655 set yfrac [lindex [$canv yview] 0]
1656 set x [expr {$hoverx + 2 * $linespc}]
1657 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1658 set x0 [expr {$x - 2 * $lthickness}]
1659 set y0 [expr {$y - 2 * $lthickness}]
1660 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1661 set y1 [expr {$y + $linespc + 2 * $lthickness}]
1662 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1663 -fill \#ffff80 -outline black -width 1 -tags hover]
1665 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1669 proc lineclick {x y id} {
1670 global ctext commitinfo children cflist canv
1674 # fill the details pane with info about this line
1675 $ctext conf -state normal
1676 $ctext delete 0.0 end
1677 $ctext insert end "Parent:\n "
1678 catch {destroy $ctext.$id}
1679 button $ctext.$id -text "Go:" -command "selbyid $id" \
1681 $ctext window create end -window $ctext.$id -align center
1682 set info $commitinfo($id)
1683 $ctext insert end "\t[lindex $info 0]\n"
1684 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
1685 $ctext insert end "\tDate:\t[lindex $info 2]\n"
1686 $ctext insert end "\tID:\t$id\n"
1687 if {[info exists children($id)]} {
1688 $ctext insert end "\nChildren:"
1689 foreach child $children($id) {
1690 $ctext insert end "\n "
1691 catch {destroy $ctext.$child}
1692 button $ctext.$child -text "Go:" -command "selbyid $child" \
1694 $ctext window create end -window $ctext.$child -align center
1695 set info $commitinfo($child)
1696 $ctext insert end "\t[lindex $info 0]"
1699 $ctext conf -state disabled
1701 $cflist delete 0 end
1706 if {[info exists idline($id)]} {
1707 selectline $idline($id)
1713 if {![info exists startmstime]} {
1714 set startmstime [clock clicks -milliseconds]
1716 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
1719 proc rowmenu {x y id} {
1720 global rowctxmenu idline selectedline rowmenuid
1722 if {![info exists selectedline] || $idline($id) eq $selectedline} {
1727 $rowctxmenu entryconfigure 0 -state $state
1728 $rowctxmenu entryconfigure 1 -state $state
1730 tk_popup $rowctxmenu $x $y
1733 proc diffvssel {dirn} {
1734 global rowmenuid selectedline lineid
1736 global diffids commitinfo
1738 if {![info exists selectedline]} return
1740 set oldid $lineid($selectedline)
1741 set newid $rowmenuid
1743 set oldid $rowmenuid
1744 set newid $lineid($selectedline)
1746 $ctext conf -state normal
1747 $ctext delete 0.0 end
1748 $ctext mark set fmark.0 0.0
1749 $ctext mark gravity fmark.0 left
1750 $cflist delete 0 end
1751 $cflist insert end "Top"
1752 $ctext insert end "From $oldid\n "
1753 $ctext insert end [lindex $commitinfo($oldid) 0]
1754 $ctext insert end "\n\nTo $newid\n "
1755 $ctext insert end [lindex $commitinfo($newid) 0]
1756 $ctext insert end "\n"
1757 $ctext conf -state disabled
1758 $ctext tag delete Comments
1759 $ctext tag remove found 1.0 end
1760 set diffids [list $newid $oldid]
1773 set diffopts "-U 5 -p"
1775 set mainfont {Helvetica 9}
1776 set textfont {Courier 9}
1778 set colors {green red blue magenta darkgrey brown orange}
1780 catch {source ~/.gitk}
1782 set namefont $mainfont
1784 lappend namefont bold
1789 switch -regexp -- $arg {
1791 "^-b" { set boldnames 1 }
1792 "^-d" { set datemode 1 }
1794 lappend revtreeargs $arg
1805 getcommits $revtreeargs