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.24 $
12 proc getcommits {rargs} {
13 global commits commfd phase canv mainfont
14 global startmsecs nextupdate
15 global ctext maincursor textcursor leftover
19 set startmsecs [clock clicks -milliseconds]
20 set nextupdate [expr $startmsecs + 100]
22 set parse_args [concat --default HEAD $rargs]
23 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
25 # if git-rev-parse failed for some reason...
29 set parsed_args $rargs
32 set commfd [open "|git-rev-list --header --merge-order $parsed_args" r]
34 puts stderr "Error executing git-rev-list: $err"
38 fconfigure $commfd -blocking 0 -translation binary
39 fileevent $commfd readable "getcommitlines $commfd"
41 $canv create text 3 3 -anchor nw -text "Reading commits..." \
42 -font $mainfont -tags textitems
43 . config -cursor watch
44 $ctext config -cursor watch
47 proc getcommitlines {commfd} {
48 global commits parents cdate children nchildren
49 global commitlisted phase commitinfo nextupdate
50 global stopped redisplaying leftover
52 set stuff [read $commfd]
54 if {![eof $commfd]} return
55 # this works around what is apparently a bug in Tcl...
56 fconfigure $commfd -blocking 1
57 if {![catch {close $commfd} err]} {
58 after idle finishcommits
61 if {[string range $err 0 4] == "usage"} {
63 {Gitk: error reading commits: bad arguments to git-rev-list.
64 (Note: arguments to gitk are passed to git-rev-list
65 to allow selection of commits to be displayed.)}
67 set err "Error reading commits: $err"
74 set i [string first "\0" $stuff $start]
76 set leftover [string range $stuff $start end]
79 set cmit [string range $stuff $start [expr {$i - 1}]]
81 set cmit "$leftover$cmit"
83 set start [expr {$i + 1}]
84 if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
85 error_popup "Can't parse git-rev-list output: {$cmit}"
88 set cmit [string range $cmit 41 end]
90 set commitlisted($id) 1
91 parsecommit $id $cmit 1
93 if {[clock clicks -milliseconds] >= $nextupdate} {
96 while {$redisplaying} {
100 set phase "getcommits"
101 foreach id $commits {
104 if {[clock clicks -milliseconds] >= $nextupdate} {
114 global commfd nextupdate
117 fileevent $commfd readable {}
119 fileevent $commfd readable "getcommitlines $commfd"
122 proc readcommit {id} {
123 if [catch {set contents [exec git-cat-file commit $id]}] return
124 parsecommit $id $contents 0
127 proc parsecommit {id contents listed} {
128 global commitinfo children nchildren parents nparents cdate ncleft
137 if {![info exists nchildren($id)]} {
144 foreach line [split $contents "\n"] {
149 set tag [lindex $line 0]
150 if {$tag == "parent"} {
151 set p [lindex $line 1]
152 if {![info exists nchildren($p)]} {
157 lappend parents($id) $p
159 # sometimes we get a commit that lists a parent twice...
160 if {$listed && [lsearch -exact $children($p) $id] < 0} {
161 lappend children($p) $id
165 } elseif {$tag == "author"} {
166 set x [expr {[llength $line] - 2}]
167 set audate [lindex $line $x]
168 set auname [lrange $line 1 [expr {$x - 1}]]
169 } elseif {$tag == "committer"} {
170 set x [expr {[llength $line] - 2}]
171 set comdate [lindex $line $x]
172 set comname [lrange $line 1 [expr {$x - 1}]]
176 if {$comment == {}} {
185 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
187 if {$comdate != {}} {
188 set cdate($id) $comdate
189 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
191 set commitinfo($id) [list $headline $auname $audate \
192 $comname $comdate $comment]
196 global tagids idtags headids idheads
197 set tags [glob -nocomplain -types f .git/refs/tags/*]
202 if {[regexp {^[0-9a-f]{40}} $line id]} {
203 set direct [file tail $f]
204 set tagids($direct) $id
205 lappend idtags($id) $direct
206 set contents [split [exec git-cat-file tag $id] "\n"]
210 foreach l $contents {
212 switch -- [lindex $l 0] {
213 "object" {set obj [lindex $l 1]}
214 "type" {set type [lindex $l 1]}
215 "tag" {set tag [string range $l 4 end]}
218 if {$obj != {} && $type == "commit" && $tag != {}} {
219 set tagids($tag) $obj
220 lappend idtags($obj) $tag
226 set heads [glob -nocomplain -types f .git/refs/heads/*]
230 set line [read $fd 40]
231 if {[regexp {^[0-9a-f]{40}} $line id]} {
232 set head [file tail $f]
233 set headids($head) $line
234 lappend idheads($line) $head
241 proc error_popup msg {
245 message $w.m -text $msg -justify center -aspect 400
246 pack $w.m -side top -fill x -padx 20 -pady 20
247 button $w.ok -text OK -command "destroy $w"
248 pack $w.ok -side bottom -fill x
249 bind $w <Visibility> "grab $w; focus $w"
254 global canv canv2 canv3 linespc charspc ctext cflist textfont
255 global findtype findloc findstring fstring geometry
256 global entries sha1entry sha1string sha1but
257 global maincursor textcursor
261 .bar add cascade -label "File" -menu .bar.file
263 .bar.file add command -label "Quit" -command doquit
265 .bar add cascade -label "Help" -menu .bar.help
266 .bar.help add command -label "About gitk" -command about
267 . configure -menu .bar
269 if {![info exists geometry(canv1)]} {
270 set geometry(canv1) [expr 45 * $charspc]
271 set geometry(canv2) [expr 30 * $charspc]
272 set geometry(canv3) [expr 15 * $charspc]
273 set geometry(canvh) [expr 25 * $linespc + 4]
274 set geometry(ctextw) 80
275 set geometry(ctexth) 30
276 set geometry(cflistw) 30
278 panedwindow .ctop -orient vertical
279 if {[info exists geometry(width)]} {
280 .ctop conf -width $geometry(width) -height $geometry(height)
281 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
282 set geometry(ctexth) [expr {($texth - 8) /
283 [font metrics $textfont -linespace]}]
287 pack .ctop.top.bar -side bottom -fill x
288 set cscroll .ctop.top.csb
289 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
290 pack $cscroll -side right -fill y
291 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
292 pack .ctop.top.clist -side top -fill both -expand 1
294 set canv .ctop.top.clist.canv
295 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
297 -yscrollincr $linespc -yscrollcommand "$cscroll set"
298 .ctop.top.clist add $canv
299 set canv2 .ctop.top.clist.canv2
300 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
301 -bg white -bd 0 -yscrollincr $linespc
302 .ctop.top.clist add $canv2
303 set canv3 .ctop.top.clist.canv3
304 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
305 -bg white -bd 0 -yscrollincr $linespc
306 .ctop.top.clist add $canv3
307 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
309 set sha1entry .ctop.top.bar.sha1
310 set entries $sha1entry
311 set sha1but .ctop.top.bar.sha1label
312 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
313 -command gotocommit -width 8
314 $sha1but conf -disabledforeground [$sha1but cget -foreground]
315 pack .ctop.top.bar.sha1label -side left
316 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
317 trace add variable sha1string write sha1change
318 pack $sha1entry -side left -pady 2
319 button .ctop.top.bar.findbut -text "Find" -command dofind
320 pack .ctop.top.bar.findbut -side left
322 set fstring .ctop.top.bar.findstring
323 lappend entries $fstring
324 entry $fstring -width 30 -font $textfont -textvariable findstring
325 pack $fstring -side left -expand 1 -fill x
327 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
328 set findloc "All fields"
329 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
330 Comments Author Committer
331 pack .ctop.top.bar.findloc -side right
332 pack .ctop.top.bar.findtype -side right
334 panedwindow .ctop.cdet -orient horizontal
336 frame .ctop.cdet.left
337 set ctext .ctop.cdet.left.ctext
338 text $ctext -bg white -state disabled -font $textfont \
339 -width $geometry(ctextw) -height $geometry(ctexth) \
340 -yscrollcommand ".ctop.cdet.left.sb set"
341 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
342 pack .ctop.cdet.left.sb -side right -fill y
343 pack $ctext -side left -fill both -expand 1
344 .ctop.cdet add .ctop.cdet.left
346 $ctext tag conf filesep -font [concat $textfont bold]
347 $ctext tag conf hunksep -back blue -fore white
348 $ctext tag conf d0 -back "#ff8080"
349 $ctext tag conf d1 -back green
350 $ctext tag conf found -back yellow
352 frame .ctop.cdet.right
353 set cflist .ctop.cdet.right.cfiles
354 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
355 -yscrollcommand ".ctop.cdet.right.sb set"
356 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
357 pack .ctop.cdet.right.sb -side right -fill y
358 pack $cflist -side left -fill both -expand 1
359 .ctop.cdet add .ctop.cdet.right
360 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
362 pack .ctop -side top -fill both -expand 1
364 bindall <1> {selcanvline %x %y}
365 bindall <B1-Motion> {selcanvline %x %y}
366 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
367 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
368 bindall <2> "allcanvs scan mark 0 %y"
369 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
370 bind . <Key-Up> "selnextline -1"
371 bind . <Key-Down> "selnextline 1"
372 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
373 bind . <Key-Next> "allcanvs yview scroll 1 pages"
374 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
375 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
376 bindkey <Key-space> "$ctext yview scroll 1 pages"
377 bindkey p "selnextline -1"
378 bindkey n "selnextline 1"
379 bindkey b "$ctext yview scroll -1 pages"
380 bindkey d "$ctext yview scroll 18 units"
381 bindkey u "$ctext yview scroll -18 units"
385 bind . <Control-q> doquit
386 bind . <Control-f> dofind
387 bind . <Control-g> findnext
388 bind . <Control-r> findprev
389 bind . <Control-equal> {incrfont 1}
390 bind . <Control-KP_Add> {incrfont 1}
391 bind . <Control-minus> {incrfont -1}
392 bind . <Control-KP_Subtract> {incrfont -1}
393 bind $cflist <<ListboxSelect>> listboxsel
394 bind . <Destroy> {savestuff %W}
395 bind . <Button-1> "click %W"
396 bind $fstring <Key-Return> dofind
397 bind $sha1entry <Key-Return> gotocommit
399 set maincursor [. cget -cursor]
400 set textcursor [$ctext cget -cursor]
402 set linectxmenu .linectxmenu
403 menu $linectxmenu -tearoff 0
404 $linectxmenu add command -label "Select" -command lineselect
407 # when we make a key binding for the toplevel, make sure
408 # it doesn't get triggered when that key is pressed in the
409 # find string entry widget.
410 proc bindkey {ev script} {
413 set escript [bind Entry $ev]
414 if {$escript == {}} {
415 set escript [bind Entry <Key>]
418 bind $e $ev "$escript; break"
422 # set the focus back to the toplevel for any click outside
433 global canv canv2 canv3 ctext cflist mainfont textfont
435 if {$stuffsaved} return
436 if {![winfo viewable .]} return
438 set f [open "~/.gitk-new" w]
439 puts $f "set mainfont {$mainfont}"
440 puts $f "set textfont {$textfont}"
441 puts $f "set geometry(width) [winfo width .ctop]"
442 puts $f "set geometry(height) [winfo height .ctop]"
443 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
444 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
445 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
446 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
447 set wid [expr {([winfo width $ctext] - 8) \
448 / [font measure $textfont "0"]}]
449 puts $f "set geometry(ctextw) $wid"
450 set wid [expr {([winfo width $cflist] - 11) \
451 / [font measure [$cflist cget -font] "0"]}]
452 puts $f "set geometry(cflistw) $wid"
454 file rename -force "~/.gitk-new" "~/.gitk"
459 proc resizeclistpanes {win w} {
461 if [info exists oldwidth($win)] {
462 set s0 [$win sash coord 0]
463 set s1 [$win sash coord 1]
465 set sash0 [expr {int($w/2 - 2)}]
466 set sash1 [expr {int($w*5/6 - 2)}]
468 set factor [expr {1.0 * $w / $oldwidth($win)}]
469 set sash0 [expr {int($factor * [lindex $s0 0])}]
470 set sash1 [expr {int($factor * [lindex $s1 0])}]
474 if {$sash1 < $sash0 + 20} {
475 set sash1 [expr $sash0 + 20]
477 if {$sash1 > $w - 10} {
478 set sash1 [expr $w - 10]
479 if {$sash0 > $sash1 - 20} {
480 set sash0 [expr $sash1 - 20]
484 $win sash place 0 $sash0 [lindex $s0 1]
485 $win sash place 1 $sash1 [lindex $s1 1]
487 set oldwidth($win) $w
490 proc resizecdetpanes {win w} {
492 if [info exists oldwidth($win)] {
493 set s0 [$win sash coord 0]
495 set sash0 [expr {int($w*3/4 - 2)}]
497 set factor [expr {1.0 * $w / $oldwidth($win)}]
498 set sash0 [expr {int($factor * [lindex $s0 0])}]
502 if {$sash0 > $w - 15} {
503 set sash0 [expr $w - 15]
506 $win sash place 0 $sash0 [lindex $s0 1]
508 set oldwidth($win) $w
512 global canv canv2 canv3
518 proc bindall {event action} {
519 global canv canv2 canv3
520 bind $canv $event $action
521 bind $canv2 $event $action
522 bind $canv3 $event $action
527 if {[winfo exists $w]} {
532 wm title $w "About gitk"
536 Copyright © 2005 Paul Mackerras
538 Use and redistribute under the terms of the GNU General Public License
540 (CVS $Revision: 1.24 $)} \
541 -justify center -aspect 400
542 pack $w.m -side top -fill x -padx 20 -pady 20
543 button $w.ok -text Close -command "destroy $w"
544 pack $w.ok -side bottom
547 proc assigncolor {id} {
548 global commitinfo colormap commcolors colors nextcolor
549 global parents nparents children nchildren
550 if [info exists colormap($id)] return
551 set ncolors [llength $colors]
552 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
553 set child [lindex $children($id) 0]
554 if {[info exists colormap($child)]
555 && $nparents($child) == 1} {
556 set colormap($id) $colormap($child)
561 foreach child $children($id) {
562 if {[info exists colormap($child)]
563 && [lsearch -exact $badcolors $colormap($child)] < 0} {
564 lappend badcolors $colormap($child)
566 if {[info exists parents($child)]} {
567 foreach p $parents($child) {
568 if {[info exists colormap($p)]
569 && [lsearch -exact $badcolors $colormap($p)] < 0} {
570 lappend badcolors $colormap($p)
575 if {[llength $badcolors] >= $ncolors} {
578 for {set i 0} {$i <= $ncolors} {incr i} {
579 set c [lindex $colors $nextcolor]
580 if {[incr nextcolor] >= $ncolors} {
583 if {[lsearch -exact $badcolors $c]} break
589 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
590 global mainline sidelines
591 global nchildren ncleft
598 set lthickness [expr {int($linespc / 9) + 1}]
599 catch {unset mainline}
600 catch {unset sidelines}
601 foreach id [array names nchildren] {
602 set ncleft($id) $nchildren($id)
606 proc bindline {t id} {
609 $canv bind $t <Button-3> "linemenu %X %Y $id"
610 $canv bind $t <Enter> "lineenter %x %y $id"
611 $canv bind $t <Motion> "linemotion %x %y $id"
612 $canv bind $t <Leave> "lineleave $id"
615 proc drawcommitline {level} {
616 global parents children nparents nchildren todo
617 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
618 global lineid linehtag linentag linedtag commitinfo
619 global colormap numcommits currentparents dupparents
620 global oldlevel oldnlines oldtodo
621 global idtags idline idheads
622 global lineno lthickness mainline sidelines
627 set id [lindex $todo $level]
628 set lineid($lineno) $id
629 set idline($id) $lineno
630 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
631 if {![info exists commitinfo($id)]} {
633 if {![info exists commitinfo($id)]} {
634 set commitinfo($id) {"No commit information available"}
639 set currentparents {}
641 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
642 foreach p $parents($id) {
643 if {[lsearch -exact $currentparents $p] < 0} {
644 lappend currentparents $p
646 # remember that this parent was listed twice
647 lappend dupparents $p
651 set x [expr $canvx0 + $level * $linespc]
653 set canvy [expr $canvy + $linespc]
654 allcanvs conf -scrollregion \
655 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
656 if {[info exists mainline($id)]} {
657 lappend mainline($id) $x $y1
658 set t [$canv create line $mainline($id) \
659 -width $lthickness -fill $colormap($id)]
663 if {[info exists sidelines($id)]} {
664 foreach ls $sidelines($id) {
665 set coords [lindex $ls 0]
666 set thick [lindex $ls 1]
667 set t [$canv create line $coords -fill $colormap($id) \
668 -width [expr {$thick * $lthickness}]]
673 set orad [expr {$linespc / 3}]
674 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
675 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
676 -fill $ofill -outline black -width 1]
678 set xt [expr $canvx0 + [llength $todo] * $linespc]
679 if {[llength $currentparents] > 2} {
680 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
684 if {[info exists idtags($id)]} {
685 set marks $idtags($id)
686 set ntags [llength $marks]
688 if {[info exists idheads($id)]} {
689 set marks [concat $marks $idheads($id)]
692 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
693 set yt [expr $y1 - 0.5 * $linespc]
694 set yb [expr $yt + $linespc - 1]
698 set wid [font measure $mainfont $tag]
701 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
703 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
704 -width $lthickness -fill black]
706 foreach tag $marks x $xvals wid $wvals {
707 set xl [expr $x + $delta]
708 set xr [expr $x + $delta + $wid + $lthickness]
709 if {[incr ntags -1] >= 0} {
711 $canv create polygon $x [expr $yt + $delta] $xl $yt\
712 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
713 -width 1 -outline black -fill yellow
716 set xl [expr $xl - $delta/2]
717 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
718 -width 1 -outline black -fill green
720 $canv create text $xl $y1 -anchor w -text $tag \
724 set headline [lindex $commitinfo($id) 0]
725 set name [lindex $commitinfo($id) 1]
726 set date [lindex $commitinfo($id) 2]
727 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
728 -text $headline -font $mainfont ]
729 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
730 -text $name -font $namefont]
731 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
732 -text $date -font $mainfont]
735 proc updatetodo {level noshortcut} {
736 global currentparents ncleft todo
737 global mainline oldlevel oldtodo oldnlines
738 global canvx0 canvy linespc mainline
743 set oldnlines [llength $todo]
744 if {!$noshortcut && [llength $currentparents] == 1} {
745 set p [lindex $currentparents 0]
746 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
748 set x [expr $canvx0 + $level * $linespc]
749 set y [expr $canvy - $linespc]
750 set mainline($p) [list $x $y]
751 set todo [lreplace $todo $level $level $p]
756 set todo [lreplace $todo $level $level]
758 foreach p $currentparents {
760 set k [lsearch -exact $todo $p]
762 set todo [linsert $todo $i $p]
770 global canv mainline sidelines canvx0 canvy linespc
771 global oldlevel oldtodo todo currentparents dupparents
772 global lthickness linespc canvy colormap
774 set y1 [expr $canvy - $linespc]
777 foreach id $oldtodo {
779 if {$id == {}} continue
780 set xi [expr {$canvx0 + $i * $linespc}]
781 if {$i == $oldlevel} {
782 foreach p $currentparents {
783 set j [lsearch -exact $todo $p]
784 set coords [list $xi $y1]
785 set xj [expr {$canvx0 + $j * $linespc}]
787 lappend coords [expr $xj + $linespc] $y1
788 } elseif {$j > $i + 1} {
789 lappend coords [expr $xj - $linespc] $y1
791 if {[lsearch -exact $dupparents $p] >= 0} {
792 # draw a double-width line to indicate the doubled parent
793 lappend coords $xj $y2
794 lappend sidelines($p) [list $coords 2]
795 if {![info exists mainline($p)]} {
796 set mainline($p) [list $xj $y2]
799 # normal case, no parent duplicated
800 if {![info exists mainline($p)]} {
802 lappend coords $xj $y2
804 set mainline($p) $coords
806 lappend coords $xj $y2
807 lappend sidelines($p) [list $coords 1]
811 } elseif {[lindex $todo $i] != $id} {
812 set j [lsearch -exact $todo $id]
813 set xj [expr {$canvx0 + $j * $linespc}]
814 lappend mainline($id) $xi $y1 $xj $y2
820 global parents children nchildren ncleft todo
821 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
822 global datemode cdate
823 global lineid linehtag linentag linedtag commitinfo
824 global currentparents oldlevel oldnlines oldtodo
825 global lineno lthickness
827 # remove the null entry if present
828 set nullentry [lsearch -exact $todo {}]
829 if {$nullentry >= 0} {
830 set todo [lreplace $todo $nullentry $nullentry]
833 # choose which one to do next time around
834 set todol [llength $todo]
837 for {set k $todol} {[incr k -1] >= 0} {} {
838 set p [lindex $todo $k]
839 if {$ncleft($p) == 0} {
841 if {$latest == {} || $cdate($p) > $latest} {
843 set latest $cdate($p)
853 puts "ERROR: none of the pending commits can be done yet:"
855 puts " $p ($ncleft($p))"
861 # If we are reducing, put in a null entry
862 if {$todol < $oldnlines} {
863 if {$nullentry >= 0} {
866 && [lindex $oldtodo $i] == [lindex $todo $i]} {
876 set todo [linsert $todo $i {}]
885 proc drawcommit {id} {
886 global phase todo nchildren datemode nextupdate
889 if {$phase != "incrdraw"} {
895 updatetodo 0 $datemode
897 if {$nchildren($id) == 0} {
899 lappend startcommits $id
901 set level [decidenext]
902 if {$id != [lindex $todo $level]} {
907 drawcommitline $level
908 if {[updatetodo $level $datemode]} {
909 set level [decidenext]
911 set id [lindex $todo $level]
912 if {![info exists commitlisted($id)]} {
915 if {[clock clicks -milliseconds] >= $nextupdate} {
923 proc finishcommits {} {
926 global ctext maincursor textcursor
928 if {$phase != "incrdraw"} {
930 $canv create text 3 3 -anchor nw -text "No commits selected" \
931 -font $mainfont -tags textitems
936 set level [decidenext]
937 drawrest $level [llength $startcommits]
938 . config -cursor $maincursor
939 $ctext config -cursor $textcursor
943 global nextupdate startmsecs startcommits todo
945 if {$startcommits == {}} return
946 set startmsecs [clock clicks -milliseconds]
947 set nextupdate [expr $startmsecs + 100]
949 set todo [lindex $startcommits 0]
953 proc drawrest {level startix} {
954 global phase stopped redisplaying selectedline
955 global datemode currentparents todo
957 global nextupdate startmsecs startcommits idline
961 set startid [lindex $startcommits $startix]
963 if {$startid != {}} {
964 set startline $idline($startid)
968 drawcommitline $level
969 set hard [updatetodo $level $datemode]
970 if {$numcommits == $startline} {
971 lappend todo $startid
974 set startid [lindex $startcommits $startix]
976 if {$startid != {}} {
977 set startline $idline($startid)
981 set level [decidenext]
982 if {$level < 0} break
985 if {[clock clicks -milliseconds] >= $nextupdate} {
992 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
993 #puts "overall $drawmsecs ms for $numcommits commits"
995 if {$stopped == 0 && [info exists selectedline]} {
996 selectline $selectedline
1000 after idle drawgraph
1007 proc findmatches {f} {
1008 global findtype foundstring foundstrlen
1009 if {$findtype == "Regexp"} {
1010 set matches [regexp -indices -all -inline $foundstring $f]
1012 if {$findtype == "IgnCase"} {
1013 set str [string tolower $f]
1019 while {[set j [string first $foundstring $str $i]] >= 0} {
1020 lappend matches [list $j [expr $j+$foundstrlen-1]]
1021 set i [expr $j + $foundstrlen]
1028 global findtype findloc findstring markedmatches commitinfo
1029 global numcommits lineid linehtag linentag linedtag
1030 global mainfont namefont canv canv2 canv3 selectedline
1031 global matchinglines foundstring foundstrlen
1034 set matchinglines {}
1035 set fldtypes {Headline Author Date Committer CDate Comment}
1036 if {$findtype == "IgnCase"} {
1037 set foundstring [string tolower $findstring]
1039 set foundstring $findstring
1041 set foundstrlen [string length $findstring]
1042 if {$foundstrlen == 0} return
1043 if {![info exists selectedline]} {
1046 set oldsel $selectedline
1049 for {set l 0} {$l < $numcommits} {incr l} {
1051 set info $commitinfo($id)
1053 foreach f $info ty $fldtypes {
1054 if {$findloc != "All fields" && $findloc != $ty} {
1057 set matches [findmatches $f]
1058 if {$matches == {}} continue
1060 if {$ty == "Headline"} {
1061 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1062 } elseif {$ty == "Author"} {
1063 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1064 } elseif {$ty == "Date"} {
1065 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1069 lappend matchinglines $l
1070 if {!$didsel && $l > $oldsel} {
1076 if {$matchinglines == {}} {
1078 } elseif {!$didsel} {
1079 findselectline [lindex $matchinglines 0]
1083 proc findselectline {l} {
1084 global findloc commentend ctext
1086 if {$findloc == "All fields" || $findloc == "Comments"} {
1087 # highlight the matches in the comments
1088 set f [$ctext get 1.0 $commentend]
1089 set matches [findmatches $f]
1090 foreach match $matches {
1091 set start [lindex $match 0]
1092 set end [expr [lindex $match 1] + 1]
1093 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1099 global matchinglines selectedline
1100 if {![info exists matchinglines]} {
1104 if {![info exists selectedline]} return
1105 foreach l $matchinglines {
1106 if {$l > $selectedline} {
1115 global matchinglines selectedline
1116 if {![info exists matchinglines]} {
1120 if {![info exists selectedline]} return
1122 foreach l $matchinglines {
1123 if {$l >= $selectedline} break
1127 findselectline $prev
1133 proc markmatches {canv l str tag matches font} {
1134 set bbox [$canv bbox $tag]
1135 set x0 [lindex $bbox 0]
1136 set y0 [lindex $bbox 1]
1137 set y1 [lindex $bbox 3]
1138 foreach match $matches {
1139 set start [lindex $match 0]
1140 set end [lindex $match 1]
1141 if {$start > $end} continue
1142 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1143 set xlen [font measure $font [string range $str 0 [expr $end]]]
1144 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1145 -outline {} -tags matches -fill yellow]
1150 proc unmarkmatches {} {
1151 global matchinglines
1152 allcanvs delete matches
1153 catch {unset matchinglines}
1156 proc selcanvline {x y} {
1157 global canv canvy0 ctext linespc selectedline
1158 global lineid linehtag linentag linedtag
1159 set ymax [lindex [$canv cget -scrollregion] 3]
1160 if {$ymax == {}} return
1161 set yfrac [lindex [$canv yview] 0]
1162 set y [expr {$y + $yfrac * $ymax}]
1163 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1167 if {[info exists selectedline] && $selectedline == $l} return
1172 proc selectline {l} {
1173 global canv canv2 canv3 ctext commitinfo selectedline
1174 global lineid linehtag linentag linedtag
1175 global canvy0 linespc nparents treepending
1176 global cflist treediffs currentid sha1entry
1177 global commentend seenfile idtags
1179 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1181 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1182 -tags secsel -fill [$canv cget -selectbackground]]
1184 $canv2 delete secsel
1185 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1186 -tags secsel -fill [$canv2 cget -selectbackground]]
1188 $canv3 delete secsel
1189 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1190 -tags secsel -fill [$canv3 cget -selectbackground]]
1192 set y [expr {$canvy0 + $l * $linespc}]
1193 set ymax [lindex [$canv cget -scrollregion] 3]
1194 set ytop [expr {$y - $linespc - 1}]
1195 set ybot [expr {$y + $linespc + 1}]
1196 set wnow [$canv yview]
1197 set wtop [expr [lindex $wnow 0] * $ymax]
1198 set wbot [expr [lindex $wnow 1] * $ymax]
1199 set wh [expr {$wbot - $wtop}]
1201 if {$ytop < $wtop} {
1202 if {$ybot < $wtop} {
1203 set newtop [expr {$y - $wh / 2.0}]
1206 if {$newtop > $wtop - $linespc} {
1207 set newtop [expr {$wtop - $linespc}]
1210 } elseif {$ybot > $wbot} {
1211 if {$ytop > $wbot} {
1212 set newtop [expr {$y - $wh / 2.0}]
1214 set newtop [expr {$ybot - $wh}]
1215 if {$newtop < $wtop + $linespc} {
1216 set newtop [expr {$wtop + $linespc}]
1220 if {$newtop != $wtop} {
1224 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1230 $sha1entry delete 0 end
1231 $sha1entry insert 0 $id
1232 $sha1entry selection from 0
1233 $sha1entry selection to end
1235 $ctext conf -state normal
1236 $ctext delete 0.0 end
1237 set info $commitinfo($id)
1238 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1239 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1240 if {[info exists idtags($id)]} {
1241 $ctext insert end "Tags:"
1242 foreach tag $idtags($id) {
1243 $ctext insert end " $tag"
1245 $ctext insert end "\n"
1247 $ctext insert end "\n"
1248 $ctext insert end [lindex $info 5]
1249 $ctext insert end "\n"
1250 $ctext tag delete Comments
1251 $ctext tag remove found 1.0 end
1252 $ctext conf -state disabled
1253 set commentend [$ctext index "end - 1c"]
1255 $cflist delete 0 end
1256 if {$nparents($id) == 1} {
1257 if {![info exists treediffs($id)]} {
1258 if {![info exists treepending]} {
1265 catch {unset seenfile}
1268 proc selnextline {dir} {
1270 if {![info exists selectedline]} return
1271 set l [expr $selectedline + $dir]
1276 proc addtocflist {id} {
1277 global currentid treediffs cflist treepending
1278 if {$id != $currentid} {
1279 gettreediffs $currentid
1282 $cflist insert end "All files"
1283 foreach f $treediffs($currentid) {
1284 $cflist insert end $f
1289 proc gettreediffs {id} {
1290 global treediffs parents treepending
1292 set treediffs($id) {}
1293 set p [lindex $parents($id) 0]
1294 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1295 fconfigure $gdtf -blocking 0
1296 fileevent $gdtf readable "gettreediffline $gdtf $id"
1299 proc gettreediffline {gdtf id} {
1300 global treediffs treepending
1301 set n [gets $gdtf line]
1303 if {![eof $gdtf]} return
1309 set file [lindex $line 5]
1310 lappend treediffs($id) $file
1313 proc getblobdiffs {id} {
1314 global parents diffopts blobdifffd env curdifftag curtagstart
1315 global diffindex difffilestart
1316 set p [lindex $parents($id) 0]
1317 set env(GIT_DIFF_OPTS) $diffopts
1318 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1319 puts "error getting diffs: $err"
1322 fconfigure $bdf -blocking 0
1323 set blobdifffd($id) $bdf
1324 set curdifftag Comments
1327 catch {unset difffilestart}
1328 fileevent $bdf readable "getblobdiffline $bdf $id"
1331 proc getblobdiffline {bdf id} {
1332 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1333 global diffnexthead diffnextnote diffindex difffilestart
1334 set n [gets $bdf line]
1338 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1339 $ctext tag add $curdifftag $curtagstart end
1340 set seenfile($curdifftag) 1
1345 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1348 $ctext conf -state normal
1349 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1350 # start of a new file
1351 $ctext insert end "\n"
1352 $ctext tag add $curdifftag $curtagstart end
1353 set seenfile($curdifftag) 1
1354 set curtagstart [$ctext index "end - 1c"]
1356 if {[info exists diffnexthead]} {
1357 set fname $diffnexthead
1358 set header "$diffnexthead ($diffnextnote)"
1361 set difffilestart($diffindex) [$ctext index "end - 1c"]
1363 set curdifftag "f:$fname"
1364 $ctext tag delete $curdifftag
1365 set l [expr {(78 - [string length $header]) / 2}]
1366 set pad [string range "----------------------------------------" 1 $l]
1367 $ctext insert end "$pad $header $pad\n" filesep
1368 } elseif {[string range $line 0 2] == "+++"} {
1369 # no need to do anything with this
1370 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1371 set diffnexthead $fn
1372 set diffnextnote "created, mode $m"
1373 } elseif {[string range $line 0 8] == "Deleted: "} {
1374 set diffnexthead [string range $line 9 end]
1375 set diffnextnote "deleted"
1376 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1377 # save the filename in case the next thing is "new file mode ..."
1378 set diffnexthead $fn
1379 set diffnextnote "modified"
1380 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1381 set diffnextnote "new file, mode $m"
1382 } elseif {[string range $line 0 11] == "deleted file"} {
1383 set diffnextnote "deleted"
1384 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1385 $line match f1l f1c f2l f2c rest]} {
1386 $ctext insert end "\t" hunksep
1387 $ctext insert end " $f1l " d0 " $f2l " d1
1388 $ctext insert end " $rest \n" hunksep
1390 set x [string range $line 0 0]
1391 if {$x == "-" || $x == "+"} {
1392 set tag [expr {$x == "+"}]
1393 set line [string range $line 1 end]
1394 $ctext insert end "$line\n" d$tag
1395 } elseif {$x == " "} {
1396 set line [string range $line 1 end]
1397 $ctext insert end "$line\n"
1398 } elseif {$x == "\\"} {
1399 # e.g. "\ No newline at end of file"
1400 $ctext insert end "$line\n" filesep
1402 # Something else we don't recognize
1403 if {$curdifftag != "Comments"} {
1404 $ctext insert end "\n"
1405 $ctext tag add $curdifftag $curtagstart end
1406 set seenfile($curdifftag) 1
1407 set curtagstart [$ctext index "end - 1c"]
1408 set curdifftag Comments
1410 $ctext insert end "$line\n" filesep
1413 $ctext conf -state disabled
1417 global difffilestart ctext
1418 set here [$ctext index @0,0]
1419 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1420 if {[$ctext compare $difffilestart($i) > $here]} {
1421 $ctext yview $difffilestart($i)
1427 proc listboxsel {} {
1428 global ctext cflist currentid treediffs seenfile
1429 if {![info exists currentid]} return
1430 set sel [$cflist curselection]
1431 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1433 $ctext tag conf Comments -elide 0
1434 foreach f $treediffs($currentid) {
1435 if [info exists seenfile(f:$f)] {
1436 $ctext tag conf "f:$f" -elide 0
1440 # just show selected files
1441 $ctext tag conf Comments -elide 1
1443 foreach f $treediffs($currentid) {
1444 set elide [expr {[lsearch -exact $sel $i] < 0}]
1445 if [info exists seenfile(f:$f)] {
1446 $ctext tag conf "f:$f" -elide $elide
1454 global linespc charspc canvx0 canvy0 mainfont
1455 set linespc [font metrics $mainfont -linespace]
1456 set charspc [font measure $mainfont "m"]
1457 set canvy0 [expr 3 + 0.5 * $linespc]
1458 set canvx0 [expr 3 + 0.5 * $linespc]
1462 global selectedline stopped redisplaying phase
1463 if {$stopped > 1} return
1464 if {$phase == "getcommits"} return
1466 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1473 proc incrfont {inc} {
1474 global mainfont namefont textfont selectedline ctext canv phase
1475 global stopped entries
1477 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1478 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1479 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1481 $ctext conf -font $textfont
1482 $ctext tag conf filesep -font [concat $textfont bold]
1483 foreach e $entries {
1484 $e conf -font $mainfont
1486 if {$phase == "getcommits"} {
1487 $canv itemconf textitems -font $mainfont
1492 proc sha1change {n1 n2 op} {
1493 global sha1string currentid sha1but
1494 if {$sha1string == {}
1495 || ([info exists currentid] && $sha1string == $currentid)} {
1500 if {[$sha1but cget -state] == $state} return
1501 if {$state == "normal"} {
1502 $sha1but conf -state normal -relief raised -text "Goto: "
1504 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1508 proc gotocommit {} {
1509 global sha1string currentid idline tagids
1510 if {$sha1string == {}
1511 || ([info exists currentid] && $sha1string == $currentid)} return
1512 if {[info exists tagids($sha1string)]} {
1513 set id $tagids($sha1string)
1515 set id [string tolower $sha1string]
1517 if {[info exists idline($id)]} {
1518 selectline $idline($id)
1521 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1526 error_popup "$type $sha1string is not known"
1529 proc linemenu {x y id} {
1530 global linectxmenu linemenuid
1532 $linectxmenu post $x $y
1535 proc lineselect {} {
1536 global linemenuid idline
1537 if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
1538 selectline $idline($linemenuid)
1542 proc lineenter {x y id} {
1543 global hoverx hovery hoverid hovertimer
1544 global commitinfo canv
1546 if {![info exists commitinfo($id)]} return
1550 if {[info exists hovertimer]} {
1551 after cancel $hovertimer
1553 set hovertimer [after 500 linehover]
1557 proc linemotion {x y id} {
1558 global hoverx hovery hoverid hovertimer
1560 if {[info exists hoverid] && $id == $hoverid} {
1563 if {[info exists hovertimer]} {
1564 after cancel $hovertimer
1566 set hovertimer [after 500 linehover]
1570 proc lineleave {id} {
1571 global hoverid hovertimer canv
1573 if {[info exists hoverid] && $id == $hoverid} {
1575 if {[info exists hovertimer]} {
1576 after cancel $hovertimer
1584 global hoverx hovery hoverid hovertimer
1585 global canv linespc lthickness
1586 global commitinfo mainfont
1588 set text [lindex $commitinfo($hoverid) 0]
1589 set ymax [lindex [$canv cget -scrollregion] 3]
1590 if {$ymax == {}} return
1591 set yfrac [lindex [$canv yview] 0]
1592 set x [expr {$hoverx + 2 * $linespc}]
1593 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1594 set x0 [expr {$x - 2 * $lthickness}]
1595 set y0 [expr {$y - 2 * $lthickness}]
1596 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1597 set y1 [expr {$y + $linespc + 2 * $lthickness}]
1598 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1599 -fill \#ffff80 -outline black -width 1 -tags hover]
1601 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1614 set diffopts "-U 5 -p"
1616 set mainfont {Helvetica 9}
1617 set textfont {Courier 9}
1619 set colors {green red blue magenta darkgrey brown orange}
1621 catch {source ~/.gitk}
1623 set namefont $mainfont
1625 lappend namefont bold
1630 switch -regexp -- $arg {
1632 "^-b" { set boldnames 1 }
1633 "^-d" { set datemode 1 }
1635 lappend revtreeargs $arg
1646 getcommits $revtreeargs