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 # CVS $Revision: 1.23 $
12 proc getcommits
{rargs
} {
13 global commits commfd phase canv mainfont
14 global startmsecs nextupdate
15 global ctext maincursor textcursor
22 set startmsecs
[clock clicks
-milliseconds]
23 set nextupdate
[expr $startmsecs + 100]
24 if [catch
{set commfd
[open
"|git-rev-list --merge-order $rargs" r
]} err
] {
25 puts stderr
"Error executing git-rev-list: $err"
28 fconfigure
$commfd -blocking 0
29 fileevent
$commfd readable
"getcommitline $commfd"
31 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
32 -font $mainfont -tags textitems
33 . config
-cursor watch
34 $ctext config
-cursor watch
37 proc getcommitline
{commfd
} {
38 global commits parents cdate children nchildren ncleft
39 global commitlisted phase commitinfo nextupdate
40 global stopped redisplaying
42 set n
[gets
$commfd line
]
44 if {![eof
$commfd]} return
45 # this works around what is apparently a bug in Tcl...
46 fconfigure
$commfd -blocking 1
47 if {![catch
{close
$commfd} err
]} {
48 after idle finishcommits
51 if {[string range
$err 0 4] == "usage"} {
53 {Gitk
: error reading commits
: bad arguments to git-rev-list.
54 (Note
: arguments to gitk are passed to git-rev-list
55 to allow selection of commits to be displayed.
)}
57 set err
"Error reading commits: $err"
62 if {![regexp
{^
[0-9a-f]{40}$
} $line id
]} {
63 error_popup
"Can't parse git-rev-list output: {$line}"
67 set commitlisted
($id) 1
68 if {![info exists commitinfo
($id)]} {
71 foreach p
$parents($id) {
72 if {[info exists commitlisted
($p)]} {
73 puts
"oops, parent $p before child $id"
77 if {[clock clicks
-milliseconds] >= $nextupdate} {
80 while {$redisplaying} {
84 set phase
"getcommits"
88 if {[clock clicks
-milliseconds] >= $nextupdate} {
97 global commfd nextupdate
100 fileevent
$commfd readable
{}
102 fileevent
$commfd readable
"getcommitline $commfd"
105 proc readcommit
{id
} {
106 global commitinfo children nchildren parents nparents cdate ncleft
116 if {![info exists nchildren
($id)]} {
124 if [catch
{set contents
[exec git-cat-file commit
$id]}] return
126 if [catch
{set x
[readobj
$id]}] return
127 if {[lindex
$x 0] != "commit"} return
128 set contents
[lindex
$x 1]
130 foreach line
[split $contents "\n"] {
135 set tag
[lindex
$line 0]
136 if {$tag == "parent"} {
137 set p
[lindex
$line 1]
138 if {![info exists nchildren
($p)]} {
143 lappend parents
($id) $p
145 if {[lsearch
-exact $children($p) $id] < 0} {
146 lappend children
($p) $id
150 puts
"child $id already in $p's list??"
152 } elseif
{$tag == "author"} {
153 set x
[expr {[llength
$line] - 2}]
154 set audate
[lindex
$line $x]
155 set auname
[lrange
$line 1 [expr {$x - 1}]]
156 } elseif
{$tag == "committer"} {
157 set x
[expr {[llength
$line] - 2}]
158 set comdate
[lindex
$line $x]
159 set comname
[lrange
$line 1 [expr {$x - 1}]]
163 if {$comment == {}} {
172 set audate
[clock format
$audate -format "%Y-%m-%d %H:%M:%S"]
174 if {$comdate != {}} {
175 set cdate
($id) $comdate
176 set comdate
[clock format
$comdate -format "%Y-%m-%d %H:%M:%S"]
178 set commitinfo
($id) [list
$headline $auname $audate \
179 $comname $comdate $comment]
183 global tagids idtags headids idheads
184 set tags
[glob
-nocomplain -types f .git
/refs
/tags
/*]
189 if {[regexp
{^
[0-9a-f]{40}} $line id
]} {
190 set direct
[file tail $f]
191 set tagids
($direct) $id
192 lappend idtags
($id) $direct
193 set contents
[split [exec git-cat-file tag
$id] "\n"]
197 foreach l
$contents {
199 switch
-- [lindex
$l 0] {
200 "object" {set obj
[lindex
$l 1]}
201 "type" {set type [lindex
$l 1]}
202 "tag" {set tag
[string range
$l 4 end
]}
205 if {$obj != {} && $type == "commit" && $tag != {}} {
206 set tagids
($tag) $obj
207 lappend idtags
($obj) $tag
213 set heads
[glob
-nocomplain -types f .git
/refs
/heads
/*]
217 set line
[read $fd 40]
218 if {[regexp
{^
[0-9a-f]{40}} $line id
]} {
219 set head [file tail $f]
220 set headids
($head) $line
221 lappend idheads
($line) $head
228 proc error_popup msg
{
232 message
$w.m
-text $msg -justify center
-aspect 400
233 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
234 button
$w.ok
-text OK
-command "destroy $w"
235 pack
$w.ok
-side bottom
-fill x
236 bind $w <Visibility
> "grab $w; focus $w"
241 global canv canv2 canv3 linespc charspc ctext cflist textfont
242 global findtype findloc findstring fstring geometry
243 global entries sha1entry sha1string sha1but
244 global maincursor textcursor
247 .bar add cascade
-label "File" -menu .bar.
file
249 .bar.
file add
command -label "Quit" -command doquit
251 .bar add cascade
-label "Help" -menu .bar.
help
252 .bar.
help add
command -label "About gitk" -command about
253 . configure
-menu .bar
255 if {![info exists geometry
(canv1
)]} {
256 set geometry
(canv1
) [expr 45 * $charspc]
257 set geometry
(canv2
) [expr 30 * $charspc]
258 set geometry
(canv3
) [expr 15 * $charspc]
259 set geometry
(canvh
) [expr 25 * $linespc + 4]
260 set geometry
(ctextw
) 80
261 set geometry
(ctexth
) 30
262 set geometry
(cflistw
) 30
264 panedwindow .ctop
-orient vertical
265 if {[info exists geometry
(width
)]} {
266 .ctop conf
-width $geometry(width
) -height $geometry(height
)
267 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
268 set geometry
(ctexth
) [expr {($texth - 8) /
269 [font metrics
$textfont -linespace]}]
273 pack .ctop.top.bar
-side bottom
-fill x
274 set cscroll .ctop.top.csb
275 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
276 pack
$cscroll -side right
-fill y
277 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
278 pack .ctop.top.clist
-side top
-fill both
-expand 1
280 set canv .ctop.top.clist.canv
281 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
283 -yscrollincr $linespc -yscrollcommand "$cscroll set"
284 .ctop.top.clist add
$canv
285 set canv2 .ctop.top.clist.canv2
286 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
287 -bg white
-bd 0 -yscrollincr $linespc
288 .ctop.top.clist add
$canv2
289 set canv3 .ctop.top.clist.canv3
290 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
291 -bg white
-bd 0 -yscrollincr $linespc
292 .ctop.top.clist add
$canv3
293 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
295 set sha1entry .ctop.top.bar.sha1
296 set entries
$sha1entry
297 set sha1but .ctop.top.bar.sha1label
298 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
299 -command gotocommit
-width 8
300 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
301 pack .ctop.top.bar.sha1label
-side left
302 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
303 trace add variable sha1string
write sha1change
304 pack
$sha1entry -side left
-pady 2
305 button .ctop.top.bar.findbut
-text "Find" -command dofind
306 pack .ctop.top.bar.findbut
-side left
308 set fstring .ctop.top.bar.findstring
309 lappend entries
$fstring
310 entry
$fstring -width 30 -font $textfont -textvariable findstring
311 pack
$fstring -side left
-expand 1 -fill x
313 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
314 set findloc
"All fields"
315 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
316 Comments Author Committer
317 pack .ctop.top.bar.findloc
-side right
318 pack .ctop.top.bar.findtype
-side right
320 panedwindow .ctop.cdet
-orient horizontal
322 frame .ctop.cdet.left
323 set ctext .ctop.cdet.left.ctext
324 text
$ctext -bg white
-state disabled
-font $textfont \
325 -width $geometry(ctextw
) -height $geometry(ctexth
) \
326 -yscrollcommand ".ctop.cdet.left.sb set"
327 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
328 pack .ctop.cdet.left.sb
-side right
-fill y
329 pack
$ctext -side left
-fill both
-expand 1
330 .ctop.cdet add .ctop.cdet.left
332 $ctext tag conf filesep
-font [concat
$textfont bold
]
333 $ctext tag conf hunksep
-back blue
-fore white
334 $ctext tag conf d0
-back "#ff8080"
335 $ctext tag conf d1
-back green
336 $ctext tag conf found
-back yellow
338 frame .ctop.cdet.right
339 set cflist .ctop.cdet.right.cfiles
340 listbox
$cflist -bg white
-selectmode extended
-width $geometry(cflistw
) \
341 -yscrollcommand ".ctop.cdet.right.sb set"
342 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
343 pack .ctop.cdet.right.sb
-side right
-fill y
344 pack
$cflist -side left
-fill both
-expand 1
345 .ctop.cdet add .ctop.cdet.right
346 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
348 pack .ctop
-side top
-fill both
-expand 1
350 bindall
<1> {selcanvline
%x
%y
}
351 bindall
<B1-Motion
> {selcanvline
%x
%y
}
352 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
353 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
354 bindall
<2> "allcanvs scan mark 0 %y"
355 bindall
<B2-Motion
> "allcanvs scan dragto 0 %y"
356 bind .
<Key-Up
> "selnextline -1"
357 bind .
<Key-Down
> "selnextline 1"
358 bind .
<Key-Prior
> "allcanvs yview scroll -1 pages"
359 bind .
<Key-Next
> "allcanvs yview scroll 1 pages"
360 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
361 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
362 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
363 bindkey p
"selnextline -1"
364 bindkey n
"selnextline 1"
365 bindkey b
"$ctext yview scroll -1 pages"
366 bindkey d
"$ctext yview scroll 18 units"
367 bindkey u
"$ctext yview scroll -18 units"
371 bind .
<Control-q
> doquit
372 bind .
<Control-f
> dofind
373 bind .
<Control-g
> findnext
374 bind .
<Control-r
> findprev
375 bind .
<Control-equal
> {incrfont
1}
376 bind .
<Control-KP_Add
> {incrfont
1}
377 bind .
<Control-minus
> {incrfont
-1}
378 bind .
<Control-KP_Subtract
> {incrfont
-1}
379 bind $cflist <<ListboxSelect>> listboxsel
380 bind . <Destroy> {savestuff %W}
381 bind . <Button-1> "click %W"
382 bind $fstring <Key-Return> dofind
383 bind $sha1entry <Key-Return> gotocommit
385 set maincursor [. cget -cursor]
386 set textcursor [$ctext cget -cursor]
389 # when we make a key binding for the toplevel, make sure
390 # it doesn't get triggered when that key is pressed in the
391 # find string entry widget.
392 proc bindkey {ev script} {
395 set escript [bind Entry $ev]
396 if {$escript == {}} {
397 set escript [bind Entry <Key>]
400 bind $e $ev "$escript; break"
404 # set the focus back to the toplevel for any click outside
415 global canv canv2 canv3 ctext cflist mainfont textfont
417 if {$stuffsaved} return
418 if {![winfo viewable .]} return
420 set f [open "~/.gitk-new" w]
421 puts $f "set mainfont {$mainfont}"
422 puts $f "set textfont {$textfont}"
423 puts $f "set geometry(width) [winfo width .ctop]"
424 puts $f "set geometry(height) [winfo height .ctop]"
425 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
426 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
427 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
428 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
429 set wid [expr {([winfo width $ctext] - 8) \
430 / [font measure $textfont "0"]}]
431 puts $f "set geometry(ctextw) $wid"
432 set wid [expr {([winfo width $cflist] - 11) \
433 / [font measure [$cflist cget -font] "0"]}]
434 puts $f "set geometry(cflistw) $wid"
436 file rename -force "~/.gitk-new" "~/.gitk"
441 proc resizeclistpanes {win w} {
443 if [info exists oldwidth($win)] {
444 set s0 [$win sash coord 0]
445 set s1 [$win sash coord 1]
447 set sash0 [expr {int($w/2 - 2)}]
448 set sash1 [expr {int($w*5/6 - 2)}]
450 set factor [expr {1.0 * $w / $oldwidth($win)}]
451 set sash0 [expr {int($factor * [lindex $s0 0])}]
452 set sash1 [expr {int($factor * [lindex $s1 0])}]
456 if {$sash1 < $sash0 + 20} {
457 set sash1 [expr $sash0 + 20]
459 if {$sash1 > $w - 10} {
460 set sash1 [expr $w - 10]
461 if {$sash0 > $sash1 - 20} {
462 set sash0 [expr $sash1 - 20]
466 $win sash place 0 $sash0 [lindex $s0 1]
467 $win sash place 1 $sash1 [lindex $s1 1]
469 set oldwidth($win) $w
472 proc resizecdetpanes {win w} {
474 if [info exists oldwidth($win)] {
475 set s0 [$win sash coord 0]
477 set sash0 [expr {int($w*3/4 - 2)}]
479 set factor [expr {1.0 * $w / $oldwidth($win)}]
480 set sash0 [expr {int($factor * [lindex $s0 0])}]
484 if {$sash0 > $w - 15} {
485 set sash0 [expr $w - 15]
488 $win sash place 0 $sash0 [lindex $s0 1]
490 set oldwidth($win) $w
494 global canv canv2 canv3
500 proc bindall {event action} {
501 global canv canv2 canv3
502 bind $canv $event $action
503 bind $canv2 $event $action
504 bind $canv3 $event $action
509 if {[winfo exists $w]} {
514 wm title $w "About gitk"
518 Copyright © 2005 Paul Mackerras
520 Use and redistribute under the terms of the GNU General Public License
522 (CVS $Revision: 1.23 $)} \
523 -justify center -aspect 400
524 pack $w.m -side top -fill x -padx 20 -pady 20
525 button $w.ok -text Close -command "destroy $w"
526 pack $w.ok -side bottom
529 proc assigncolor {id} {
530 global commitinfo colormap commcolors colors nextcolor
531 global parents nparents children nchildren
532 if [info exists colormap($id)] return
533 set ncolors [llength $colors]
534 if {$nparents($id) == 1 && $nchildren($id) == 1} {
535 set child [lindex $children($id) 0]
536 if {[info exists colormap($child)]
537 && $nparents($child) == 1} {
538 set colormap($id) $colormap($child)
543 foreach child $children($id) {
544 if {[info exists colormap($child)]
545 && [lsearch -exact $badcolors $colormap($child)] < 0} {
546 lappend badcolors $colormap($child)
548 if {[info exists parents($child)]} {
549 foreach p $parents($child) {
550 if {[info exists colormap($p)]
551 && [lsearch -exact $badcolors $colormap($p)] < 0} {
552 lappend badcolors $colormap($p)
557 if {[llength $badcolors] >= $ncolors} {
560 for {set i 0} {$i <= $ncolors} {incr i} {
561 set c [lindex $colors $nextcolor]
562 if {[incr nextcolor] >= $ncolors} {
565 if {[lsearch -exact $badcolors $c]} break
571 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
573 global nchildren ncleft
580 set lthickness [expr {int($linespc / 9) + 1}]
581 catch {unset linestarty}
582 foreach id [array names nchildren] {
583 set ncleft($id) $nchildren($id)
587 proc drawcommitline {level} {
588 global parents children nparents nchildren ncleft todo
589 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
590 global datemode cdate
591 global lineid linehtag linentag linedtag commitinfo
592 global colormap numcommits currentparents
593 global oldlevel oldnlines oldtodo
594 global idtags idline idheads
595 global lineno lthickness linestarty
600 set id [lindex $todo $level]
601 set lineid($lineno) $id
602 set idline($id) $lineno
603 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
604 if {![info exists commitinfo($id)]} {
606 if {![info exists commitinfo($id)]} {
607 set commitinfo($id) {"No commit information available"}
611 set currentparents {}
612 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
613 set currentparents $parents($id)
615 set x [expr $canvx0 + $level * $linespc]
617 set canvy [expr $canvy + $linespc]
618 allcanvs conf -scrollregion \
619 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
620 if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
621 set t [$canv create line $x $linestarty($id) $x $y1 \
622 -width $lthickness -fill $colormap($id)]
625 set orad [expr {$linespc / 3}]
626 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
627 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
628 -fill $ofill -outline black -width 1]
630 set xt [expr $canvx0 + [llength $todo] * $linespc]
631 if {$nparents($id) > 2} {
632 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
636 if {[info exists idtags($id)]} {
637 set marks $idtags($id)
638 set ntags [llength $marks]
640 if {[info exists idheads($id)]} {
641 set marks [concat $marks $idheads($id)]
644 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
645 set yt [expr $y1 - 0.5 * $linespc]
646 set yb [expr $yt + $linespc - 1]
650 set wid [font measure $mainfont $tag]
653 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
655 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
656 -width $lthickness -fill black]
658 foreach tag $marks x $xvals wid $wvals {
659 set xl [expr $x + $delta]
660 set xr [expr $x + $delta + $wid + $lthickness]
661 if {[incr ntags -1] >= 0} {
663 $canv create polygon $x [expr $yt + $delta] $xl $yt\
664 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
665 -width 1 -outline black -fill yellow
668 set xl [expr $xl - $delta/2]
669 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
670 -width 1 -outline black -fill green
672 $canv create text $xl $y1 -anchor w -text $tag \
676 set headline [lindex $commitinfo($id) 0]
677 set name [lindex $commitinfo($id) 1]
678 set date [lindex $commitinfo($id) 2]
679 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
680 -text $headline -font $mainfont ]
681 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
682 -text $name -font $namefont]
683 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
684 -text $date -font $mainfont]
687 proc updatetodo {level noshortcut} {
688 global datemode currentparents ncleft todo
689 global linestarty oldlevel oldtodo oldnlines
693 foreach p $currentparents {
694 if {![info exists commitinfo($p)]} {
698 if {!$noshortcut && [llength $currentparents] == 1} {
699 set p [lindex $currentparents 0]
700 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
702 set linestarty($p) [expr $canvy - $linespc]
703 set todo [lreplace $todo $level $level $p]
710 set oldnlines [llength $todo]
711 set todo [lreplace $todo $level $level]
713 foreach p $currentparents {
715 set k [lsearch -exact $todo $p]
718 set todo [linsert $todo $i $p]
726 global canv linestarty canvx0 canvy linespc
727 global oldlevel oldtodo todo currentparents
728 global lthickness linespc canvy colormap
730 set y1 [expr $canvy - $linespc]
733 foreach id $oldtodo {
735 if {$id == {}} continue
736 set xi [expr {$canvx0 + $i * $linespc}]
737 if {$i == $oldlevel} {
738 foreach p $currentparents {
739 set j [lsearch -exact $todo $p]
740 if {$i == $j && ![info exists linestarty($p)]} {
741 set linestarty($p) $y1
743 set xj [expr {$canvx0 + $j * $linespc}]
744 set coords [list $xi $y1]
746 lappend coords [expr $xj + $linespc] $y1
747 } elseif {$j > $i + 1} {
748 lappend coords [expr $xj - $linespc] $y1
750 lappend coords $xj $y2
751 set t [$canv create line $coords -width $lthickness \
754 if {![info exists linestarty($p)]} {
755 set linestarty($p) $y2
759 } elseif {[lindex $todo $i] != $id} {
760 set j [lsearch -exact $todo $id]
761 set xj [expr {$canvx0 + $j * $linespc}]
763 if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
764 lappend coords $xi $linestarty($id)
766 lappend coords $xi $y1 $xj $y2
767 set t [$canv create line $coords -width $lthickness \
768 -fill $colormap($id)]
770 set linestarty($id) $y2
776 global parents children nchildren ncleft todo
777 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
778 global datemode cdate
779 global lineid linehtag linentag linedtag commitinfo
780 global currentparents oldlevel oldnlines oldtodo
781 global lineno lthickness
783 # remove the null entry if present
784 set nullentry [lsearch -exact $todo {}]
785 if {$nullentry >= 0} {
786 set todo [lreplace $todo $nullentry $nullentry]
789 # choose which one to do next time around
790 set todol [llength $todo]
793 for {set k $todol} {[incr k -1] >= 0} {} {
794 set p [lindex $todo $k]
795 if {$ncleft($p) == 0} {
797 if {$latest == {} || $cdate($p) > $latest} {
799 set latest $cdate($p)
809 puts "ERROR: none of the pending commits can be done yet:"
817 # If we are reducing, put in a null entry
818 if {$todol < $oldnlines} {
819 if {$nullentry >= 0} {
822 && [lindex $oldtodo $i] == [lindex $todo $i]} {
832 set todo [linsert $todo $i {}]
841 proc drawcommit {id} {
842 global phase todo nchildren datemode nextupdate
845 if {$phase != "incrdraw"} {
852 updatetodo 0 $datemode
854 if {$nchildren($id) == 0} {
856 lappend startcommits $id
859 set level [decidenext]
860 if {$id != [lindex $todo $level]} {
865 drawcommitline $level
866 if {[updatetodo $level $datemode]} {
867 set level [decidenext]
869 set id [lindex $todo $level]
870 if {![info exists commitlisted($id)]} {
873 if {[clock clicks -milliseconds] >= $nextupdate} {
881 proc finishcommits {} {
884 global ctext maincursor textcursor
886 if {$phase != "incrdraw"} {
888 $canv create text 3 3 -anchor nw -text "No commits selected" \
889 -font $mainfont -tags textitems
894 set level [decidenext]
895 drawrest $level [llength $startcommits]
896 . config -cursor $maincursor
897 $ctext config -cursor $textcursor
901 global nextupdate startmsecs startcommits todo
903 if {$startcommits == {}} return
904 set startmsecs [clock clicks -milliseconds]
905 set nextupdate [expr $startmsecs + 100]
907 set todo [lindex $startcommits 0]
911 proc drawrest {level startix} {
912 global phase stopped redisplaying selectedline
913 global datemode currentparents todo
915 global nextupdate startmsecs startcommits idline
918 set startid [lindex $startcommits $startix]
920 if {$startid != {}} {
921 set startline $idline($startid)
925 drawcommitline $level
926 set hard [updatetodo $level $datemode]
927 if {$numcommits == $startline} {
928 lappend todo $startid
931 set startid [lindex $startcommits $startix]
933 if {$startid != {}} {
934 set startline $idline($startid)
938 set level [decidenext]
939 if {$level < 0} break
942 if {[clock clicks -milliseconds] >= $nextupdate} {
948 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
949 puts "overall $drawmsecs ms for $numcommits commits"
951 if {$stopped == 0 && [info exists selectedline]} {
952 selectline $selectedline
963 proc findmatches {f} {
964 global findtype foundstring foundstrlen
965 if {$findtype == "Regexp"} {
966 set matches [regexp -indices -all -inline $foundstring $f]
968 if {$findtype == "IgnCase"} {
969 set str [string tolower $f]
975 while {[set j [string first $foundstring $str $i]] >= 0} {
976 lappend matches [list $j [expr $j+$foundstrlen-1]]
977 set i [expr $j + $foundstrlen]
984 global findtype findloc findstring markedmatches commitinfo
985 global numcommits lineid linehtag linentag linedtag
986 global mainfont namefont canv canv2 canv3 selectedline
987 global matchinglines foundstring foundstrlen
991 set fldtypes {Headline Author Date Committer CDate Comment}
992 if {$findtype == "IgnCase"} {
993 set foundstring [string tolower $findstring]
995 set foundstring $findstring
997 set foundstrlen [string length $findstring]
998 if {$foundstrlen == 0} return
999 if {![info exists selectedline]} {
1002 set oldsel $selectedline
1005 for {set l 0} {$l < $numcommits} {incr l} {
1007 set info $commitinfo($id)
1009 foreach f $info ty $fldtypes {
1010 if {$findloc != "All fields" && $findloc != $ty} {
1013 set matches [findmatches $f]
1014 if {$matches == {}} continue
1016 if {$ty == "Headline"} {
1017 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1018 } elseif {$ty == "Author"} {
1019 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1020 } elseif {$ty == "Date"} {
1021 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1025 lappend matchinglines $l
1026 if {!$didsel && $l > $oldsel} {
1032 if {$matchinglines == {}} {
1034 } elseif {!$didsel} {
1035 findselectline [lindex $matchinglines 0]
1039 proc findselectline {l} {
1040 global findloc commentend ctext
1042 if {$findloc == "All fields" || $findloc == "Comments"} {
1043 # highlight the matches in the comments
1044 set f [$ctext get 1.0 $commentend]
1045 set matches [findmatches $f]
1046 foreach match $matches {
1047 set start [lindex $match 0]
1048 set end [expr [lindex $match 1] + 1]
1049 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1055 global matchinglines selectedline
1056 if {![info exists matchinglines]} {
1060 if {![info exists selectedline]} return
1061 foreach l $matchinglines {
1062 if {$l > $selectedline} {
1071 global matchinglines selectedline
1072 if {![info exists matchinglines]} {
1076 if {![info exists selectedline]} return
1078 foreach l $matchinglines {
1079 if {$l >= $selectedline} break
1083 findselectline $prev
1089 proc markmatches {canv l str tag matches font} {
1090 set bbox [$canv bbox $tag]
1091 set x0 [lindex $bbox 0]
1092 set y0 [lindex $bbox 1]
1093 set y1 [lindex $bbox 3]
1094 foreach match $matches {
1095 set start [lindex $match 0]
1096 set end [lindex $match 1]
1097 if {$start > $end} continue
1098 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1099 set xlen [font measure $font [string range $str 0 [expr $end]]]
1100 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1101 -outline {} -tags matches -fill yellow]
1106 proc unmarkmatches {} {
1107 global matchinglines
1108 allcanvs delete matches
1109 catch {unset matchinglines}
1112 proc selcanvline {x y} {
1113 global canv canvy0 ctext linespc selectedline
1114 global lineid linehtag linentag linedtag
1115 set ymax [lindex [$canv cget -scrollregion] 3]
1116 if {$ymax == {}} return
1117 set yfrac [lindex [$canv yview] 0]
1118 set y [expr {$y + $yfrac * $ymax}]
1119 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1123 if {[info exists selectedline] && $selectedline == $l} return
1128 proc selectline {l} {
1129 global canv canv2 canv3 ctext commitinfo selectedline
1130 global lineid linehtag linentag linedtag
1131 global canvy0 linespc nparents treepending
1132 global cflist treediffs currentid sha1entry
1133 global commentend seenfile idtags
1134 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1136 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1137 -tags secsel -fill [$canv cget -selectbackground]]
1139 $canv2 delete secsel
1140 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1141 -tags secsel -fill [$canv2 cget -selectbackground]]
1143 $canv3 delete secsel
1144 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1145 -tags secsel -fill [$canv3 cget -selectbackground]]
1147 set y [expr {$canvy0 + $l * $linespc}]
1148 set ymax [lindex [$canv cget -scrollregion] 3]
1149 set ytop [expr {$y - $linespc - 1}]
1150 set ybot [expr {$y + $linespc + 1}]
1151 set wnow [$canv yview]
1152 set wtop [expr [lindex $wnow 0] * $ymax]
1153 set wbot [expr [lindex $wnow 1] * $ymax]
1154 set wh [expr {$wbot - $wtop}]
1156 if {$ytop < $wtop} {
1157 if {$ybot < $wtop} {
1158 set newtop [expr {$y - $wh / 2.0}]
1161 if {$newtop > $wtop - $linespc} {
1162 set newtop [expr {$wtop - $linespc}]
1165 } elseif {$ybot > $wbot} {
1166 if {$ytop > $wbot} {
1167 set newtop [expr {$y - $wh / 2.0}]
1169 set newtop [expr {$ybot - $wh}]
1170 if {$newtop < $wtop + $linespc} {
1171 set newtop [expr {$wtop + $linespc}]
1175 if {$newtop != $wtop} {
1179 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1185 $sha1entry delete 0 end
1186 $sha1entry insert 0 $id
1187 $sha1entry selection from 0
1188 $sha1entry selection to end
1190 $ctext conf -state normal
1191 $ctext delete 0.0 end
1192 set info $commitinfo($id)
1193 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1194 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1195 if {[info exists idtags($id)]} {
1196 $ctext insert end "Tags:"
1197 foreach tag $idtags($id) {
1198 $ctext insert end " $tag"
1200 $ctext insert end "\n"
1202 $ctext insert end "\n"
1203 $ctext insert end [lindex $info 5]
1204 $ctext insert end "\n"
1205 $ctext tag delete Comments
1206 $ctext tag remove found 1.0 end
1207 $ctext conf -state disabled
1208 set commentend [$ctext index "end - 1c"]
1210 $cflist delete 0 end
1211 if {$nparents($id) == 1} {
1212 if {![info exists treediffs($id)]} {
1213 if {![info exists treepending]} {
1220 catch {unset seenfile}
1223 proc selnextline {dir} {
1225 if {![info exists selectedline]} return
1226 set l [expr $selectedline + $dir]
1231 proc addtocflist {id} {
1232 global currentid treediffs cflist treepending
1233 if {$id != $currentid} {
1234 gettreediffs $currentid
1237 $cflist insert end "All files"
1238 foreach f $treediffs($currentid) {
1239 $cflist insert end $f
1244 proc gettreediffs {id} {
1245 global treediffs parents treepending
1247 set treediffs($id) {}
1248 set p [lindex $parents($id) 0]
1249 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1250 fconfigure $gdtf -blocking 0
1251 fileevent $gdtf readable "gettreediffline $gdtf $id"
1254 proc gettreediffline {gdtf id} {
1255 global treediffs treepending
1256 set n [gets $gdtf line]
1258 if {![eof $gdtf]} return
1264 set file [lindex $line 5]
1265 lappend treediffs($id) $file
1268 proc getblobdiffs {id} {
1269 global parents diffopts blobdifffd env curdifftag curtagstart
1270 global diffindex difffilestart
1271 set p [lindex $parents($id) 0]
1272 set env(GIT_DIFF_OPTS) $diffopts
1273 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1274 puts "error getting diffs: $err"
1277 fconfigure $bdf -blocking 0
1278 set blobdifffd($id) $bdf
1279 set curdifftag Comments
1282 catch {unset difffilestart}
1283 fileevent $bdf readable "getblobdiffline $bdf $id"
1286 proc getblobdiffline {bdf id} {
1287 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1288 global diffnexthead diffnextnote diffindex difffilestart
1289 set n [gets $bdf line]
1293 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1294 $ctext tag add $curdifftag $curtagstart end
1295 set seenfile($curdifftag) 1
1300 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1303 $ctext conf -state normal
1304 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1305 # start of a new file
1306 $ctext insert end "\n"
1307 $ctext tag add $curdifftag $curtagstart end
1308 set seenfile($curdifftag) 1
1309 set curtagstart [$ctext index "end - 1c"]
1311 if {[info exists diffnexthead]} {
1312 set fname $diffnexthead
1313 set header "$diffnexthead ($diffnextnote)"
1316 set difffilestart($diffindex) [$ctext index "end - 1c"]
1318 set curdifftag "f:$fname"
1319 $ctext tag delete $curdifftag
1320 set l [expr {(78 - [string length $header]) / 2}]
1321 set pad [string range "----------------------------------------" 1 $l]
1322 $ctext insert end "$pad $header $pad\n" filesep
1323 } elseif {[string range $line 0 2] == "+++"} {
1324 # no need to do anything with this
1325 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1326 set diffnexthead $fn
1327 set diffnextnote "created, mode $m"
1328 } elseif {[string range $line 0 8] == "Deleted: "} {
1329 set diffnexthead [string range $line 9 end]
1330 set diffnextnote "deleted"
1331 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1332 # save the filename in case the next thing is "new file mode ..."
1333 set diffnexthead $fn
1334 set diffnextnote "modified"
1335 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1336 set diffnextnote "new file, mode $m"
1337 } elseif {[string range $line 0 11] == "deleted file"} {
1338 set diffnextnote "deleted"
1339 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1340 $line match f1l f1c f2l f2c rest]} {
1341 $ctext insert end "\t" hunksep
1342 $ctext insert end " $f1l " d0 " $f2l " d1
1343 $ctext insert end " $rest \n" hunksep
1345 set x [string range $line 0 0]
1346 if {$x == "-" || $x == "+"} {
1347 set tag [expr {$x == "+"}]
1348 set line [string range $line 1 end]
1349 $ctext insert end "$line\n" d$tag
1350 } elseif {$x == " "} {
1351 set line [string range $line 1 end]
1352 $ctext insert end "$line\n"
1353 } elseif {$x == "\\"} {
1354 # e.g. "\ No newline at end of file"
1355 $ctext insert end "$line\n" filesep
1357 # Something else we don't recognize
1358 if {$curdifftag != "Comments"} {
1359 $ctext insert end "\n"
1360 $ctext tag add $curdifftag $curtagstart end
1361 set seenfile($curdifftag) 1
1362 set curtagstart [$ctext index "end - 1c"]
1363 set curdifftag Comments
1365 $ctext insert end "$line\n" filesep
1368 $ctext conf -state disabled
1372 global difffilestart ctext
1373 set here [$ctext index @0,0]
1374 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1375 if {[$ctext compare $difffilestart($i) > $here]} {
1376 $ctext yview $difffilestart($i)
1382 proc listboxsel {} {
1383 global ctext cflist currentid treediffs seenfile
1384 if {![info exists currentid]} return
1385 set sel [$cflist curselection]
1386 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1388 $ctext tag conf Comments -elide 0
1389 foreach f $treediffs($currentid) {
1390 if [info exists seenfile(f:$f)] {
1391 $ctext tag conf "f:$f" -elide 0
1395 # just show selected files
1396 $ctext tag conf Comments -elide 1
1398 foreach f $treediffs($currentid) {
1399 set elide [expr {[lsearch -exact $sel $i] < 0}]
1400 if [info exists seenfile(f:$f)] {
1401 $ctext tag conf "f:$f" -elide $elide
1409 global linespc charspc canvx0 canvy0 mainfont
1410 set linespc [font metrics $mainfont -linespace]
1411 set charspc [font measure $mainfont "m"]
1412 set canvy0 [expr 3 + 0.5 * $linespc]
1413 set canvx0 [expr 3 + 0.5 * $linespc]
1417 global selectedline stopped redisplaying phase
1418 if {$stopped > 1} return
1419 if {$phase == "getcommits"} return
1421 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1428 proc incrfont {inc} {
1429 global mainfont namefont textfont selectedline ctext canv phase
1430 global stopped entries
1432 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1433 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1434 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1436 $ctext conf -font $textfont
1437 $ctext tag conf filesep -font [concat $textfont bold]
1438 foreach e $entries {
1439 $e conf -font $mainfont
1441 if {$phase == "getcommits"} {
1442 $canv itemconf textitems -font $mainfont
1447 proc sha1change {n1 n2 op} {
1448 global sha1string currentid sha1but
1449 if {$sha1string == {}
1450 || ([info exists currentid] && $sha1string == $currentid)} {
1455 if {[$sha1but cget -state] == $state} return
1456 if {$state == "normal"} {
1457 $sha1but conf -state normal -relief raised -text "Goto: "
1459 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1463 proc gotocommit {} {
1464 global sha1string currentid idline tagids
1465 if {$sha1string == {}
1466 || ([info exists currentid] && $sha1string == $currentid)} return
1467 if {[info exists tagids($sha1string)]} {
1468 set id $tagids($sha1string)
1470 set id [string tolower $sha1string]
1472 if {[info exists idline($id)]} {
1473 selectline $idline($id)
1476 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1481 error_popup "$type $sha1string is not known"
1493 set diffopts "-U 5 -p"
1495 set mainfont {Helvetica 9}
1496 set textfont {Courier 9}
1498 set colors {green red blue magenta darkgrey brown orange}
1500 catch {source ~/.gitk}
1502 set namefont $mainfont
1504 lappend namefont bold
1509 switch -regexp -- $arg {
1511 "^-b" { set boldnames 1 }
1512 "^-d" { set datemode 1 }
1514 lappend revtreeargs $arg
1519 set noreadobj [catch {load libreadobj.so.0.0}]
1526 getcommits $revtreeargs