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 nlines
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"
29 fconfigure $commfd -blocking 0
30 fileevent $commfd readable "getcommitline $commfd"
32 $canv create text 3 3 -anchor nw -text "Reading commits..." \
33 -font $mainfont -tags textitems
34 . config -cursor watch
35 $ctext config -cursor watch
38 proc getcommitline {commfd} {
39 global commits parents cdate children nchildren
40 global commitlisted phase commitinfo nextupdate
41 global stopped redisplaying nlines
43 set n [gets $commfd line]
45 if {![eof $commfd]} return
46 # this works around what is apparently a bug in Tcl...
47 fconfigure $commfd -blocking 1
48 if {![catch {close $commfd} err]} {
49 after idle finishcommits
52 if {[string range $err 0 4] == "usage"} {
54 {Gitk: error reading commits: bad arguments to git-rev-list.
55 (Note: arguments to gitk are passed to git-rev-list
56 to allow selection of commits to be displayed.)}
58 set err "Error reading commits: $err"
64 if {![regexp {^[0-9a-f]{40}$} $line id]} {
65 error_popup "Can't parse git-rev-list output: {$line}"
69 set commitlisted($id) 1
70 if {![info exists commitinfo($id)]} {
73 foreach p $parents($id) {
74 if {[info exists commitlisted($p)]} {
75 puts "oops, parent $p before child $id"
79 if {[clock clicks -milliseconds] >= $nextupdate} {
82 while {$redisplaying} {
86 set phase "getcommits"
90 if {[clock clicks -milliseconds] >= $nextupdate} {
99 global commfd nextupdate
102 fileevent $commfd readable {}
104 fileevent $commfd readable "getcommitline $commfd"
107 proc readcommit {id} {
108 global commitinfo children nchildren parents nparents cdate ncleft
118 if {![info exists nchildren($id)]} {
126 if [catch {set contents [exec git-cat-file commit $id]}] return
128 if [catch {set x [readobj $id]}] return
129 if {[lindex $x 0] != "commit"} return
130 set contents [lindex $x 1]
132 foreach line [split $contents "\n"] {
137 set tag [lindex $line 0]
138 if {$tag == "parent"} {
139 set p [lindex $line 1]
140 if {![info exists nchildren($p)]} {
145 lappend parents($id) $p
147 # sometimes we get a commit that lists a parent twice...
148 if {[lsearch -exact $children($p) $id] < 0} {
149 lappend children($p) $id
153 } elseif {$tag == "author"} {
154 set x [expr {[llength $line] - 2}]
155 set audate [lindex $line $x]
156 set auname [lrange $line 1 [expr {$x - 1}]]
157 } elseif {$tag == "committer"} {
158 set x [expr {[llength $line] - 2}]
159 set comdate [lindex $line $x]
160 set comname [lrange $line 1 [expr {$x - 1}]]
164 if {$comment == {}} {
173 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
175 if {$comdate != {}} {
176 set cdate($id) $comdate
177 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
179 set commitinfo($id) [list $headline $auname $audate \
180 $comname $comdate $comment]
184 global tagids idtags headids idheads
185 set tags [glob -nocomplain -types f .git/refs/tags/*]
190 if {[regexp {^[0-9a-f]{40}} $line id]} {
191 set direct [file tail $f]
192 set tagids($direct) $id
193 lappend idtags($id) $direct
194 set contents [split [exec git-cat-file tag $id] "\n"]
198 foreach l $contents {
200 switch -- [lindex $l 0] {
201 "object" {set obj [lindex $l 1]}
202 "type" {set type [lindex $l 1]}
203 "tag" {set tag [string range $l 4 end]}
206 if {$obj != {} && $type == "commit" && $tag != {}} {
207 set tagids($tag) $obj
208 lappend idtags($obj) $tag
214 set heads [glob -nocomplain -types f .git/refs/heads/*]
218 set line [read $fd 40]
219 if {[regexp {^[0-9a-f]{40}} $line id]} {
220 set head [file tail $f]
221 set headids($head) $line
222 lappend idheads($line) $head
229 proc error_popup msg {
233 message $w.m -text $msg -justify center -aspect 400
234 pack $w.m -side top -fill x -padx 20 -pady 20
235 button $w.ok -text OK -command "destroy $w"
236 pack $w.ok -side bottom -fill x
237 bind $w <Visibility> "grab $w; focus $w"
242 global canv canv2 canv3 linespc charspc ctext cflist textfont
243 global findtype findloc findstring fstring geometry
244 global entries sha1entry sha1string sha1but
245 global maincursor textcursor
249 .bar add cascade -label "File" -menu .bar.file
251 .bar.file add command -label "Quit" -command doquit
253 .bar add cascade -label "Help" -menu .bar.help
254 .bar.help add command -label "About gitk" -command about
255 . configure -menu .bar
257 if {![info exists geometry(canv1)]} {
258 set geometry(canv1) [expr 45 * $charspc]
259 set geometry(canv2) [expr 30 * $charspc]
260 set geometry(canv3) [expr 15 * $charspc]
261 set geometry(canvh) [expr 25 * $linespc + 4]
262 set geometry(ctextw) 80
263 set geometry(ctexth) 30
264 set geometry(cflistw) 30
266 panedwindow .ctop -orient vertical
267 if {[info exists geometry(width)]} {
268 .ctop conf -width $geometry(width) -height $geometry(height)
269 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
270 set geometry(ctexth) [expr {($texth - 8) /
271 [font metrics $textfont -linespace]}]
275 pack .ctop.top.bar -side bottom -fill x
276 set cscroll .ctop.top.csb
277 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
278 pack $cscroll -side right -fill y
279 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
280 pack .ctop.top.clist -side top -fill both -expand 1
282 set canv .ctop.top.clist.canv
283 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
285 -yscrollincr $linespc -yscrollcommand "$cscroll set"
286 .ctop.top.clist add $canv
287 set canv2 .ctop.top.clist.canv2
288 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
289 -bg white -bd 0 -yscrollincr $linespc
290 .ctop.top.clist add $canv2
291 set canv3 .ctop.top.clist.canv3
292 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
293 -bg white -bd 0 -yscrollincr $linespc
294 .ctop.top.clist add $canv3
295 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
297 set sha1entry .ctop.top.bar.sha1
298 set entries $sha1entry
299 set sha1but .ctop.top.bar.sha1label
300 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
301 -command gotocommit -width 8
302 $sha1but conf -disabledforeground [$sha1but cget -foreground]
303 pack .ctop.top.bar.sha1label -side left
304 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
305 trace add variable sha1string write sha1change
306 pack $sha1entry -side left -pady 2
307 button .ctop.top.bar.findbut -text "Find" -command dofind
308 pack .ctop.top.bar.findbut -side left
310 set fstring .ctop.top.bar.findstring
311 lappend entries $fstring
312 entry $fstring -width 30 -font $textfont -textvariable findstring
313 pack $fstring -side left -expand 1 -fill x
315 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
316 set findloc "All fields"
317 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
318 Comments Author Committer
319 pack .ctop.top.bar.findloc -side right
320 pack .ctop.top.bar.findtype -side right
322 panedwindow .ctop.cdet -orient horizontal
324 frame .ctop.cdet.left
325 set ctext .ctop.cdet.left.ctext
326 text $ctext -bg white -state disabled -font $textfont \
327 -width $geometry(ctextw) -height $geometry(ctexth) \
328 -yscrollcommand ".ctop.cdet.left.sb set"
329 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
330 pack .ctop.cdet.left.sb -side right -fill y
331 pack $ctext -side left -fill both -expand 1
332 .ctop.cdet add .ctop.cdet.left
334 $ctext tag conf filesep -font [concat $textfont bold]
335 $ctext tag conf hunksep -back blue -fore white
336 $ctext tag conf d0 -back "#ff8080"
337 $ctext tag conf d1 -back green
338 $ctext tag conf found -back yellow
340 frame .ctop.cdet.right
341 set cflist .ctop.cdet.right.cfiles
342 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
343 -yscrollcommand ".ctop.cdet.right.sb set"
344 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
345 pack .ctop.cdet.right.sb -side right -fill y
346 pack $cflist -side left -fill both -expand 1
347 .ctop.cdet add .ctop.cdet.right
348 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
350 pack .ctop -side top -fill both -expand 1
352 bindall <1> {selcanvline %x %y}
353 bindall <B1-Motion> {selcanvline %x %y}
354 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
355 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
356 bindall <2> "allcanvs scan mark 0 %y"
357 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
358 bind . <Key-Up> "selnextline -1"
359 bind . <Key-Down> "selnextline 1"
360 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
361 bind . <Key-Next> "allcanvs yview scroll 1 pages"
362 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
363 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
364 bindkey <Key-space> "$ctext yview scroll 1 pages"
365 bindkey p "selnextline -1"
366 bindkey n "selnextline 1"
367 bindkey b "$ctext yview scroll -1 pages"
368 bindkey d "$ctext yview scroll 18 units"
369 bindkey u "$ctext yview scroll -18 units"
373 bind . <Control-q> doquit
374 bind . <Control-f> dofind
375 bind . <Control-g> findnext
376 bind . <Control-r> findprev
377 bind . <Control-equal> {incrfont 1}
378 bind . <Control-KP_Add> {incrfont 1}
379 bind . <Control-minus> {incrfont -1}
380 bind . <Control-KP_Subtract> {incrfont -1}
381 bind $cflist <<ListboxSelect>> listboxsel
382 bind . <Destroy> {savestuff %W}
383 bind . <Button-1> "click %W"
384 bind $fstring <Key-Return> dofind
385 bind $sha1entry <Key-Return> gotocommit
387 set maincursor [. cget -cursor]
388 set textcursor [$ctext cget -cursor]
390 set linectxmenu .linectxmenu
391 menu $linectxmenu -tearoff 0
392 $linectxmenu add command -label "Select" -command lineselect
395 # when we make a key binding for the toplevel, make sure
396 # it doesn't get triggered when that key is pressed in the
397 # find string entry widget.
398 proc bindkey {ev script} {
401 set escript [bind Entry $ev]
402 if {$escript == {}} {
403 set escript [bind Entry <Key>]
406 bind $e $ev "$escript; break"
410 # set the focus back to the toplevel for any click outside
421 global canv canv2 canv3 ctext cflist mainfont textfont
423 if {$stuffsaved} return
424 if {![winfo viewable .]} return
426 set f [open "~/.gitk-new" w]
427 puts $f "set mainfont {$mainfont}"
428 puts $f "set textfont {$textfont}"
429 puts $f "set geometry(width) [winfo width .ctop]"
430 puts $f "set geometry(height) [winfo height .ctop]"
431 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
432 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
433 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
434 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
435 set wid [expr {([winfo width $ctext] - 8) \
436 / [font measure $textfont "0"]}]
437 puts $f "set geometry(ctextw) $wid"
438 set wid [expr {([winfo width $cflist] - 11) \
439 / [font measure [$cflist cget -font] "0"]}]
440 puts $f "set geometry(cflistw) $wid"
442 file rename -force "~/.gitk-new" "~/.gitk"
447 proc resizeclistpanes {win w} {
449 if [info exists oldwidth($win)] {
450 set s0 [$win sash coord 0]
451 set s1 [$win sash coord 1]
453 set sash0 [expr {int($w/2 - 2)}]
454 set sash1 [expr {int($w*5/6 - 2)}]
456 set factor [expr {1.0 * $w / $oldwidth($win)}]
457 set sash0 [expr {int($factor * [lindex $s0 0])}]
458 set sash1 [expr {int($factor * [lindex $s1 0])}]
462 if {$sash1 < $sash0 + 20} {
463 set sash1 [expr $sash0 + 20]
465 if {$sash1 > $w - 10} {
466 set sash1 [expr $w - 10]
467 if {$sash0 > $sash1 - 20} {
468 set sash0 [expr $sash1 - 20]
472 $win sash place 0 $sash0 [lindex $s0 1]
473 $win sash place 1 $sash1 [lindex $s1 1]
475 set oldwidth($win) $w
478 proc resizecdetpanes {win w} {
480 if [info exists oldwidth($win)] {
481 set s0 [$win sash coord 0]
483 set sash0 [expr {int($w*3/4 - 2)}]
485 set factor [expr {1.0 * $w / $oldwidth($win)}]
486 set sash0 [expr {int($factor * [lindex $s0 0])}]
490 if {$sash0 > $w - 15} {
491 set sash0 [expr $w - 15]
494 $win sash place 0 $sash0 [lindex $s0 1]
496 set oldwidth($win) $w
500 global canv canv2 canv3
506 proc bindall {event action} {
507 global canv canv2 canv3
508 bind $canv $event $action
509 bind $canv2 $event $action
510 bind $canv3 $event $action
515 if {[winfo exists $w]} {
520 wm title $w "About gitk"
524 Copyright © 2005 Paul Mackerras
526 Use and redistribute under the terms of the GNU General Public License
528 (CVS $Revision: 1.24 $)} \
529 -justify center -aspect 400
530 pack $w.m -side top -fill x -padx 20 -pady 20
531 button $w.ok -text Close -command "destroy $w"
532 pack $w.ok -side bottom
535 proc assigncolor {id} {
536 global commitinfo colormap commcolors colors nextcolor
537 global parents nparents children nchildren
538 if [info exists colormap($id)] return
539 set ncolors [llength $colors]
540 if {$nparents($id) == 1 && $nchildren($id) == 1} {
541 set child [lindex $children($id) 0]
542 if {[info exists colormap($child)]
543 && $nparents($child) == 1} {
544 set colormap($id) $colormap($child)
549 foreach child $children($id) {
550 if {[info exists colormap($child)]
551 && [lsearch -exact $badcolors $colormap($child)] < 0} {
552 lappend badcolors $colormap($child)
554 if {[info exists parents($child)]} {
555 foreach p $parents($child) {
556 if {[info exists colormap($p)]
557 && [lsearch -exact $badcolors $colormap($p)] < 0} {
558 lappend badcolors $colormap($p)
563 if {[llength $badcolors] >= $ncolors} {
566 for {set i 0} {$i <= $ncolors} {incr i} {
567 set c [lindex $colors $nextcolor]
568 if {[incr nextcolor] >= $ncolors} {
571 if {[lsearch -exact $badcolors $c]} break
577 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
579 global nchildren ncleft
586 set lthickness [expr {int($linespc / 9) + 1}]
588 foreach id [array names nchildren] {
589 set ncleft($id) $nchildren($id)
593 proc bindline {t id} {
596 $canv bind $t <Button-3> "linemenu %X %Y $id"
597 $canv bind $t <Enter> "lineenter %x %y $id"
598 $canv bind $t <Motion> "linemotion %x %y $id"
599 $canv bind $t <Leave> "lineleave $id"
602 proc drawcommitline {level} {
603 global parents children nparents nchildren todo
604 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
605 global datemode cdate
606 global lineid linehtag linentag linedtag commitinfo
607 global colormap numcommits currentparents dupparents
608 global oldlevel oldnlines oldtodo
609 global idtags idline idheads
610 global lineno lthickness glines
615 set id [lindex $todo $level]
616 set lineid($lineno) $id
617 set idline($id) $lineno
618 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
619 if {![info exists commitinfo($id)]} {
621 if {![info exists commitinfo($id)]} {
622 set commitinfo($id) {"No commit information available"}
626 set currentparents {}
628 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
629 foreach p $parents($id) {
630 if {[lsearch -exact $currentparents $p] < 0} {
631 lappend currentparents $p
633 # remember that this parent was listed twice
634 lappend dupparents $p
638 set x [expr $canvx0 + $level * $linespc]
640 set canvy [expr $canvy + $linespc]
641 allcanvs conf -scrollregion \
642 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
643 if {[info exists glines($id)]} {
644 lappend glines($id) $x $y1
645 set t [$canv create line $glines($id) \
646 -width $lthickness -fill $colormap($id)]
650 set orad [expr {$linespc / 3}]
651 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
652 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
653 -fill $ofill -outline black -width 1]
655 set xt [expr $canvx0 + [llength $todo] * $linespc]
656 if {$nparents($id) > 2} {
657 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
661 if {[info exists idtags($id)]} {
662 set marks $idtags($id)
663 set ntags [llength $marks]
665 if {[info exists idheads($id)]} {
666 set marks [concat $marks $idheads($id)]
669 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
670 set yt [expr $y1 - 0.5 * $linespc]
671 set yb [expr $yt + $linespc - 1]
675 set wid [font measure $mainfont $tag]
678 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
680 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
681 -width $lthickness -fill black]
683 foreach tag $marks x $xvals wid $wvals {
684 set xl [expr $x + $delta]
685 set xr [expr $x + $delta + $wid + $lthickness]
686 if {[incr ntags -1] >= 0} {
688 $canv create polygon $x [expr $yt + $delta] $xl $yt\
689 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
690 -width 1 -outline black -fill yellow
693 set xl [expr $xl - $delta/2]
694 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
695 -width 1 -outline black -fill green
697 $canv create text $xl $y1 -anchor w -text $tag \
701 set headline [lindex $commitinfo($id) 0]
702 set name [lindex $commitinfo($id) 1]
703 set date [lindex $commitinfo($id) 2]
704 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
705 -text $headline -font $mainfont ]
706 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
707 -text $name -font $namefont]
708 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
709 -text $date -font $mainfont]
712 proc updatetodo {level noshortcut} {
713 global datemode currentparents ncleft todo
714 global glines oldlevel oldtodo oldnlines
715 global canvx0 canvy linespc glines
718 foreach p $currentparents {
719 if {![info exists commitinfo($p)]} {
723 set x [expr $canvx0 + $level * $linespc]
724 set y [expr $canvy - $linespc]
725 if {!$noshortcut && [llength $currentparents] == 1} {
726 set p [lindex $currentparents 0]
727 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
729 set glines($p) [list $x $y]
730 set todo [lreplace $todo $level $level $p]
737 set oldnlines [llength $todo]
738 set todo [lreplace $todo $level $level]
740 foreach p $currentparents {
742 set k [lsearch -exact $todo $p]
745 set todo [linsert $todo $i $p]
753 global canv glines canvx0 canvy linespc
754 global oldlevel oldtodo todo currentparents dupparents
755 global lthickness linespc canvy colormap
757 set y1 [expr $canvy - $linespc]
760 foreach id $oldtodo {
762 if {$id == {}} continue
763 set xi [expr {$canvx0 + $i * $linespc}]
764 if {$i == $oldlevel} {
765 foreach p $currentparents {
766 set j [lsearch -exact $todo $p]
767 set coords [list $xi $y1]
768 set xj [expr {$canvx0 + $j * $linespc}]
770 lappend coords [expr $xj + $linespc] $y1
771 } elseif {$j > $i + 1} {
772 lappend coords [expr $xj - $linespc] $y1
774 if {[lsearch -exact $dupparents $p] >= 0} {
775 # draw a double-width line to indicate the doubled parent
776 lappend coords $xj $y2
777 set t [$canv create line $coords \
778 -width [expr 2*$lthickness] -fill $colormap($p)]
781 if {![info exists glines($p)]} {
782 set glines($p) [list $xj $y2]
785 # normal case, no parent duplicated
786 if {![info exists glines($p)]} {
788 lappend coords $xj $y2
790 set glines($p) $coords
792 lappend coords $xj $y2
793 set t [$canv create line $coords \
794 -width $lthickness -fill $colormap($p)]
800 } elseif {[lindex $todo $i] != $id} {
801 set j [lsearch -exact $todo $id]
802 set xj [expr {$canvx0 + $j * $linespc}]
803 lappend glines($id) $xi $y1 $xj $y2
809 global parents children nchildren ncleft todo
810 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
811 global datemode cdate
812 global lineid linehtag linentag linedtag commitinfo
813 global currentparents oldlevel oldnlines oldtodo
814 global lineno lthickness
816 # remove the null entry if present
817 set nullentry [lsearch -exact $todo {}]
818 if {$nullentry >= 0} {
819 set todo [lreplace $todo $nullentry $nullentry]
822 # choose which one to do next time around
823 set todol [llength $todo]
826 for {set k $todol} {[incr k -1] >= 0} {} {
827 set p [lindex $todo $k]
828 if {$ncleft($p) == 0} {
830 if {$latest == {} || $cdate($p) > $latest} {
832 set latest $cdate($p)
842 puts "ERROR: none of the pending commits can be done yet:"
850 # If we are reducing, put in a null entry
851 if {$todol < $oldnlines} {
852 if {$nullentry >= 0} {
855 && [lindex $oldtodo $i] == [lindex $todo $i]} {
865 set todo [linsert $todo $i {}]
874 proc drawcommit {id} {
875 global phase todo nchildren datemode nextupdate
878 if {$phase != "incrdraw"} {
885 updatetodo 0 $datemode
887 if {$nchildren($id) == 0} {
889 lappend startcommits $id
892 set level [decidenext]
893 if {$id != [lindex $todo $level]} {
898 drawcommitline $level
899 if {[updatetodo $level $datemode]} {
900 set level [decidenext]
902 set id [lindex $todo $level]
903 if {![info exists commitlisted($id)]} {
906 if {[clock clicks -milliseconds] >= $nextupdate} {
914 proc finishcommits {} {
917 global ctext maincursor textcursor
919 if {$phase != "incrdraw"} {
921 $canv create text 3 3 -anchor nw -text "No commits selected" \
922 -font $mainfont -tags textitems
927 set level [decidenext]
928 drawrest $level [llength $startcommits]
929 . config -cursor $maincursor
930 $ctext config -cursor $textcursor
934 global nextupdate startmsecs startcommits todo
936 if {$startcommits == {}} return
937 set startmsecs [clock clicks -milliseconds]
938 set nextupdate [expr $startmsecs + 100]
940 set todo [lindex $startcommits 0]
944 proc drawrest {level startix} {
945 global phase stopped redisplaying selectedline
946 global datemode currentparents todo
948 global nextupdate startmsecs startcommits idline
952 set startid [lindex $startcommits $startix]
954 if {$startid != {}} {
955 set startline $idline($startid)
959 drawcommitline $level
960 set hard [updatetodo $level $datemode]
961 if {$numcommits == $startline} {
962 lappend todo $startid
965 set startid [lindex $startcommits $startix]
967 if {$startid != {}} {
968 set startline $idline($startid)
972 set level [decidenext]
973 if {$level < 0} break
976 if {[clock clicks -milliseconds] >= $nextupdate} {
983 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
984 #puts "overall $drawmsecs ms for $numcommits commits"
986 if {$stopped == 0 && [info exists selectedline]} {
987 selectline $selectedline
998 proc findmatches {f} {
999 global findtype foundstring foundstrlen
1000 if {$findtype == "Regexp"} {
1001 set matches [regexp -indices -all -inline $foundstring $f]
1003 if {$findtype == "IgnCase"} {
1004 set str [string tolower $f]
1010 while {[set j [string first $foundstring $str $i]] >= 0} {
1011 lappend matches [list $j [expr $j+$foundstrlen-1]]
1012 set i [expr $j + $foundstrlen]
1019 global findtype findloc findstring markedmatches commitinfo
1020 global numcommits lineid linehtag linentag linedtag
1021 global mainfont namefont canv canv2 canv3 selectedline
1022 global matchinglines foundstring foundstrlen
1025 set matchinglines {}
1026 set fldtypes {Headline Author Date Committer CDate Comment}
1027 if {$findtype == "IgnCase"} {
1028 set foundstring [string tolower $findstring]
1030 set foundstring $findstring
1032 set foundstrlen [string length $findstring]
1033 if {$foundstrlen == 0} return
1034 if {![info exists selectedline]} {
1037 set oldsel $selectedline
1040 for {set l 0} {$l < $numcommits} {incr l} {
1042 set info $commitinfo($id)
1044 foreach f $info ty $fldtypes {
1045 if {$findloc != "All fields" && $findloc != $ty} {
1048 set matches [findmatches $f]
1049 if {$matches == {}} continue
1051 if {$ty == "Headline"} {
1052 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1053 } elseif {$ty == "Author"} {
1054 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1055 } elseif {$ty == "Date"} {
1056 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1060 lappend matchinglines $l
1061 if {!$didsel && $l > $oldsel} {
1067 if {$matchinglines == {}} {
1069 } elseif {!$didsel} {
1070 findselectline [lindex $matchinglines 0]
1074 proc findselectline {l} {
1075 global findloc commentend ctext
1077 if {$findloc == "All fields" || $findloc == "Comments"} {
1078 # highlight the matches in the comments
1079 set f [$ctext get 1.0 $commentend]
1080 set matches [findmatches $f]
1081 foreach match $matches {
1082 set start [lindex $match 0]
1083 set end [expr [lindex $match 1] + 1]
1084 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1090 global matchinglines selectedline
1091 if {![info exists matchinglines]} {
1095 if {![info exists selectedline]} return
1096 foreach l $matchinglines {
1097 if {$l > $selectedline} {
1106 global matchinglines selectedline
1107 if {![info exists matchinglines]} {
1111 if {![info exists selectedline]} return
1113 foreach l $matchinglines {
1114 if {$l >= $selectedline} break
1118 findselectline $prev
1124 proc markmatches {canv l str tag matches font} {
1125 set bbox [$canv bbox $tag]
1126 set x0 [lindex $bbox 0]
1127 set y0 [lindex $bbox 1]
1128 set y1 [lindex $bbox 3]
1129 foreach match $matches {
1130 set start [lindex $match 0]
1131 set end [lindex $match 1]
1132 if {$start > $end} continue
1133 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1134 set xlen [font measure $font [string range $str 0 [expr $end]]]
1135 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1136 -outline {} -tags matches -fill yellow]
1141 proc unmarkmatches {} {
1142 global matchinglines
1143 allcanvs delete matches
1144 catch {unset matchinglines}
1147 proc selcanvline {x y} {
1148 global canv canvy0 ctext linespc selectedline
1149 global lineid linehtag linentag linedtag
1150 set ymax [lindex [$canv cget -scrollregion] 3]
1151 if {$ymax == {}} return
1152 set yfrac [lindex [$canv yview] 0]
1153 set y [expr {$y + $yfrac * $ymax}]
1154 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1158 if {[info exists selectedline] && $selectedline == $l} return
1163 proc selectline {l} {
1164 global canv canv2 canv3 ctext commitinfo selectedline
1165 global lineid linehtag linentag linedtag
1166 global canvy0 linespc nparents treepending
1167 global cflist treediffs currentid sha1entry
1168 global commentend seenfile idtags
1170 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1172 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1173 -tags secsel -fill [$canv cget -selectbackground]]
1175 $canv2 delete secsel
1176 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1177 -tags secsel -fill [$canv2 cget -selectbackground]]
1179 $canv3 delete secsel
1180 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1181 -tags secsel -fill [$canv3 cget -selectbackground]]
1183 set y [expr {$canvy0 + $l * $linespc}]
1184 set ymax [lindex [$canv cget -scrollregion] 3]
1185 set ytop [expr {$y - $linespc - 1}]
1186 set ybot [expr {$y + $linespc + 1}]
1187 set wnow [$canv yview]
1188 set wtop [expr [lindex $wnow 0] * $ymax]
1189 set wbot [expr [lindex $wnow 1] * $ymax]
1190 set wh [expr {$wbot - $wtop}]
1192 if {$ytop < $wtop} {
1193 if {$ybot < $wtop} {
1194 set newtop [expr {$y - $wh / 2.0}]
1197 if {$newtop > $wtop - $linespc} {
1198 set newtop [expr {$wtop - $linespc}]
1201 } elseif {$ybot > $wbot} {
1202 if {$ytop > $wbot} {
1203 set newtop [expr {$y - $wh / 2.0}]
1205 set newtop [expr {$ybot - $wh}]
1206 if {$newtop < $wtop + $linespc} {
1207 set newtop [expr {$wtop + $linespc}]
1211 if {$newtop != $wtop} {
1215 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1221 $sha1entry delete 0 end
1222 $sha1entry insert 0 $id
1223 $sha1entry selection from 0
1224 $sha1entry selection to end
1226 $ctext conf -state normal
1227 $ctext delete 0.0 end
1228 set info $commitinfo($id)
1229 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1230 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1231 if {[info exists idtags($id)]} {
1232 $ctext insert end "Tags:"
1233 foreach tag $idtags($id) {
1234 $ctext insert end " $tag"
1236 $ctext insert end "\n"
1238 $ctext insert end "\n"
1239 $ctext insert end [lindex $info 5]
1240 $ctext insert end "\n"
1241 $ctext tag delete Comments
1242 $ctext tag remove found 1.0 end
1243 $ctext conf -state disabled
1244 set commentend [$ctext index "end - 1c"]
1246 $cflist delete 0 end
1247 if {$nparents($id) == 1} {
1248 if {![info exists treediffs($id)]} {
1249 if {![info exists treepending]} {
1256 catch {unset seenfile}
1259 proc selnextline {dir} {
1261 if {![info exists selectedline]} return
1262 set l [expr $selectedline + $dir]
1267 proc addtocflist {id} {
1268 global currentid treediffs cflist treepending
1269 if {$id != $currentid} {
1270 gettreediffs $currentid
1273 $cflist insert end "All files"
1274 foreach f $treediffs($currentid) {
1275 $cflist insert end $f
1280 proc gettreediffs {id} {
1281 global treediffs parents treepending
1283 set treediffs($id) {}
1284 set p [lindex $parents($id) 0]
1285 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1286 fconfigure $gdtf -blocking 0
1287 fileevent $gdtf readable "gettreediffline $gdtf $id"
1290 proc gettreediffline {gdtf id} {
1291 global treediffs treepending
1292 set n [gets $gdtf line]
1294 if {![eof $gdtf]} return
1300 set file [lindex $line 5]
1301 lappend treediffs($id) $file
1304 proc getblobdiffs {id} {
1305 global parents diffopts blobdifffd env curdifftag curtagstart
1306 global diffindex difffilestart
1307 set p [lindex $parents($id) 0]
1308 set env(GIT_DIFF_OPTS) $diffopts
1309 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1310 puts "error getting diffs: $err"
1313 fconfigure $bdf -blocking 0
1314 set blobdifffd($id) $bdf
1315 set curdifftag Comments
1318 catch {unset difffilestart}
1319 fileevent $bdf readable "getblobdiffline $bdf $id"
1322 proc getblobdiffline {bdf id} {
1323 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1324 global diffnexthead diffnextnote diffindex difffilestart
1325 set n [gets $bdf line]
1329 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1330 $ctext tag add $curdifftag $curtagstart end
1331 set seenfile($curdifftag) 1
1336 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1339 $ctext conf -state normal
1340 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1341 # start of a new file
1342 $ctext insert end "\n"
1343 $ctext tag add $curdifftag $curtagstart end
1344 set seenfile($curdifftag) 1
1345 set curtagstart [$ctext index "end - 1c"]
1347 if {[info exists diffnexthead]} {
1348 set fname $diffnexthead
1349 set header "$diffnexthead ($diffnextnote)"
1352 set difffilestart($diffindex) [$ctext index "end - 1c"]
1354 set curdifftag "f:$fname"
1355 $ctext tag delete $curdifftag
1356 set l [expr {(78 - [string length $header]) / 2}]
1357 set pad [string range "----------------------------------------" 1 $l]
1358 $ctext insert end "$pad $header $pad\n" filesep
1359 } elseif {[string range $line 0 2] == "+++"} {
1360 # no need to do anything with this
1361 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1362 set diffnexthead $fn
1363 set diffnextnote "created, mode $m"
1364 } elseif {[string range $line 0 8] == "Deleted: "} {
1365 set diffnexthead [string range $line 9 end]
1366 set diffnextnote "deleted"
1367 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1368 # save the filename in case the next thing is "new file mode ..."
1369 set diffnexthead $fn
1370 set diffnextnote "modified"
1371 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1372 set diffnextnote "new file, mode $m"
1373 } elseif {[string range $line 0 11] == "deleted file"} {
1374 set diffnextnote "deleted"
1375 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1376 $line match f1l f1c f2l f2c rest]} {
1377 $ctext insert end "\t" hunksep
1378 $ctext insert end " $f1l " d0 " $f2l " d1
1379 $ctext insert end " $rest \n" hunksep
1381 set x [string range $line 0 0]
1382 if {$x == "-" || $x == "+"} {
1383 set tag [expr {$x == "+"}]
1384 set line [string range $line 1 end]
1385 $ctext insert end "$line\n" d$tag
1386 } elseif {$x == " "} {
1387 set line [string range $line 1 end]
1388 $ctext insert end "$line\n"
1389 } elseif {$x == "\\"} {
1390 # e.g. "\ No newline at end of file"
1391 $ctext insert end "$line\n" filesep
1393 # Something else we don't recognize
1394 if {$curdifftag != "Comments"} {
1395 $ctext insert end "\n"
1396 $ctext tag add $curdifftag $curtagstart end
1397 set seenfile($curdifftag) 1
1398 set curtagstart [$ctext index "end - 1c"]
1399 set curdifftag Comments
1401 $ctext insert end "$line\n" filesep
1404 $ctext conf -state disabled
1408 global difffilestart ctext
1409 set here [$ctext index @0,0]
1410 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1411 if {[$ctext compare $difffilestart($i) > $here]} {
1412 $ctext yview $difffilestart($i)
1418 proc listboxsel {} {
1419 global ctext cflist currentid treediffs seenfile
1420 if {![info exists currentid]} return
1421 set sel [$cflist curselection]
1422 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1424 $ctext tag conf Comments -elide 0
1425 foreach f $treediffs($currentid) {
1426 if [info exists seenfile(f:$f)] {
1427 $ctext tag conf "f:$f" -elide 0
1431 # just show selected files
1432 $ctext tag conf Comments -elide 1
1434 foreach f $treediffs($currentid) {
1435 set elide [expr {[lsearch -exact $sel $i] < 0}]
1436 if [info exists seenfile(f:$f)] {
1437 $ctext tag conf "f:$f" -elide $elide
1445 global linespc charspc canvx0 canvy0 mainfont
1446 set linespc [font metrics $mainfont -linespace]
1447 set charspc [font measure $mainfont "m"]
1448 set canvy0 [expr 3 + 0.5 * $linespc]
1449 set canvx0 [expr 3 + 0.5 * $linespc]
1453 global selectedline stopped redisplaying phase
1454 if {$stopped > 1} return
1455 if {$phase == "getcommits"} return
1457 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1464 proc incrfont {inc} {
1465 global mainfont namefont textfont selectedline ctext canv phase
1466 global stopped entries
1468 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1469 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1470 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1472 $ctext conf -font $textfont
1473 $ctext tag conf filesep -font [concat $textfont bold]
1474 foreach e $entries {
1475 $e conf -font $mainfont
1477 if {$phase == "getcommits"} {
1478 $canv itemconf textitems -font $mainfont
1483 proc sha1change {n1 n2 op} {
1484 global sha1string currentid sha1but
1485 if {$sha1string == {}
1486 || ([info exists currentid] && $sha1string == $currentid)} {
1491 if {[$sha1but cget -state] == $state} return
1492 if {$state == "normal"} {
1493 $sha1but conf -state normal -relief raised -text "Goto: "
1495 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1499 proc gotocommit {} {
1500 global sha1string currentid idline tagids
1501 if {$sha1string == {}
1502 || ([info exists currentid] && $sha1string == $currentid)} return
1503 if {[info exists tagids($sha1string)]} {
1504 set id $tagids($sha1string)
1506 set id [string tolower $sha1string]
1508 if {[info exists idline($id)]} {
1509 selectline $idline($id)
1512 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1517 error_popup "$type $sha1string is not known"
1520 proc linemenu {x y id} {
1521 global linectxmenu linemenuid
1523 $linectxmenu post $x $y
1526 proc lineselect {} {
1527 global linemenuid idline
1528 if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
1529 selectline $idline($linemenuid)
1533 proc lineenter {x y id} {
1534 global hoverx hovery hoverid hovertimer
1535 global commitinfo canv
1537 if {![info exists commitinfo($id)]} return
1541 if {[info exists hovertimer]} {
1542 after cancel $hovertimer
1544 set hovertimer [after 500 linehover]
1548 proc linemotion {x y id} {
1549 global hoverx hovery hoverid hovertimer
1551 if {[info exists hoverid] && $id == $hoverid} {
1554 if {[info exists hovertimer]} {
1555 after cancel $hovertimer
1557 set hovertimer [after 500 linehover]
1561 proc lineleave {id} {
1562 global hoverid hovertimer canv
1564 if {[info exists hoverid] && $id == $hoverid} {
1566 if {[info exists hovertimer]} {
1567 after cancel $hovertimer
1575 global hoverx hovery hoverid hovertimer
1576 global canv linespc lthickness
1577 global commitinfo mainfont
1579 set text [lindex $commitinfo($hoverid) 0]
1580 set ymax [lindex [$canv cget -scrollregion] 3]
1581 if {$ymax == {}} return
1582 set yfrac [lindex [$canv yview] 0]
1583 set x [expr {$hoverx + 2 * $linespc}]
1584 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1585 set x0 [expr {$x - 2 * $lthickness}]
1586 set y0 [expr {$y - 2 * $lthickness}]
1587 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1588 set y1 [expr {$y + $linespc + 2 * $lthickness}]
1589 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1590 -fill \#ffff80 -outline black -width 1 -tags hover]
1592 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1605 set diffopts "-U 5 -p"
1607 set mainfont {Helvetica 9}
1608 set textfont {Courier 9}
1610 set colors {green red blue magenta darkgrey brown orange}
1612 catch {source ~/.gitk}
1614 set namefont $mainfont
1616 lappend namefont bold
1621 switch -regexp -- $arg {
1623 "^-b" { set boldnames 1 }
1624 "^-d" { set datemode 1 }
1626 lappend revtreeargs $arg
1631 set noreadobj [catch {load libreadobj.so.0.0}]
1638 getcommits $revtreeargs