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.22 $
12 proc getcommits {rargs} {
13 global commits commfd phase canv mainfont
14 global startmsecs nextupdate
21 set startmsecs [clock clicks -milliseconds]
22 set nextupdate [expr $startmsecs + 100]
23 if [catch {set commfd [open "|git-rev-list --merge-order $rargs" r]} err] {
24 puts stderr "Error executing git-rev-list: $err"
27 fconfigure $commfd -blocking 0
28 fileevent $commfd readable "getcommitline $commfd"
30 $canv create text 3 3 -anchor nw -text "Reading commits..." \
31 -font $mainfont -tags textitems
34 proc getcommitline {commfd} {
35 global commits parents cdate children nchildren ncleft
36 global commitlisted phase commitinfo nextupdate
37 global stopped redisplaying
39 set n [gets $commfd line]
41 if {![eof $commfd]} return
42 # this works around what is apparently a bug in Tcl...
43 fconfigure $commfd -blocking 1
44 if {![catch {close $commfd} err]} {
45 after idle finishcommits
48 if {[string range $err 0 4] == "usage"} {
50 {Gitk: error reading commits: bad arguments to git-rev-list.
51 (Note: arguments to gitk are passed to git-rev-list
52 to allow selection of commits to be displayed.)}
54 set err "Error reading commits: $err"
59 if {![regexp {^[0-9a-f]{40}$} $line id]} {
60 error_popup "Can't parse git-rev-list output: {$line}"
64 set commitlisted($id) 1
65 if {![info exists commitinfo($id)]} {
68 foreach p $parents($id) {
69 if {[info exists commitlisted($p)]} {
70 puts "oops, parent $p before child $id"
74 if {[clock clicks -milliseconds] >= $nextupdate} {
77 while {$redisplaying} {
81 set phase "getcommits"
85 if {[clock clicks -milliseconds] >= $nextupdate} {
94 global commfd nextupdate
97 fileevent $commfd readable {}
99 fileevent $commfd readable "getcommitline $commfd"
102 proc readcommit {id} {
103 global commitinfo children nchildren parents nparents cdate ncleft
113 if {![info exists nchildren($id)]} {
121 if [catch {set contents [exec git-cat-file commit $id]}] return
123 if [catch {set x [readobj $id]}] return
124 if {[lindex $x 0] != "commit"} return
125 set contents [lindex $x 1]
127 foreach line [split $contents "\n"] {
132 set tag [lindex $line 0]
133 if {$tag == "parent"} {
134 set p [lindex $line 1]
135 if {![info exists nchildren($p)]} {
140 lappend parents($id) $p
142 if {[lsearch -exact $children($p) $id] < 0} {
143 lappend children($p) $id
147 puts "child $id already in $p's list??"
149 } elseif {$tag == "author"} {
150 set x [expr {[llength $line] - 2}]
151 set audate [lindex $line $x]
152 set auname [lrange $line 1 [expr {$x - 1}]]
153 } elseif {$tag == "committer"} {
154 set x [expr {[llength $line] - 2}]
155 set comdate [lindex $line $x]
156 set comname [lrange $line 1 [expr {$x - 1}]]
160 if {$comment == {}} {
169 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
171 if {$comdate != {}} {
172 set cdate($id) $comdate
173 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
175 set commitinfo($id) [list $headline $auname $audate \
176 $comname $comdate $comment]
180 global tagids idtags headids idheads
181 set tags [glob -nocomplain -types f .git/refs/tags/*]
186 if {[regexp {^[0-9a-f]{40}} $line id]} {
187 set direct [file tail $f]
188 set tagids($direct) $id
189 lappend idtags($id) $direct
190 set contents [split [exec git-cat-file tag $id] "\n"]
194 foreach l $contents {
196 switch -- [lindex $l 0] {
197 "object" {set obj [lindex $l 1]}
198 "type" {set type [lindex $l 1]}
199 "tag" {set tag [string range $l 4 end]}
202 if {$obj != {} && $type == "commit" && $tag != {}} {
203 set tagids($tag) $obj
204 lappend idtags($obj) $tag
210 set heads [glob -nocomplain -types f .git/refs/heads/*]
214 set line [read $fd 40]
215 if {[regexp {^[0-9a-f]{40}} $line id]} {
216 set head [file tail $f]
217 set headids($head) $line
218 lappend idheads($line) $head
225 proc error_popup msg {
229 message $w.m -text $msg -justify center -aspect 400
230 pack $w.m -side top -fill x -padx 20 -pady 20
231 button $w.ok -text OK -command "destroy $w"
232 pack $w.ok -side bottom -fill x
233 bind $w <Visibility> "grab $w; focus $w"
238 global canv canv2 canv3 linespc charspc ctext cflist textfont
239 global findtype findloc findstring fstring geometry
240 global entries sha1entry sha1string sha1but
243 .bar add cascade -label "File" -menu .bar.file
245 .bar.file add command -label "Quit" -command doquit
247 .bar add cascade -label "Help" -menu .bar.help
248 .bar.help add command -label "About gitk" -command about
249 . configure -menu .bar
251 if {![info exists geometry(canv1)]} {
252 set geometry(canv1) [expr 45 * $charspc]
253 set geometry(canv2) [expr 30 * $charspc]
254 set geometry(canv3) [expr 15 * $charspc]
255 set geometry(canvh) [expr 25 * $linespc + 4]
256 set geometry(ctextw) 80
257 set geometry(ctexth) 30
258 set geometry(cflistw) 30
260 panedwindow .ctop -orient vertical
261 if {[info exists geometry(width)]} {
262 .ctop conf -width $geometry(width) -height $geometry(height)
263 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
264 set geometry(ctexth) [expr {($texth - 8) /
265 [font metrics $textfont -linespace]}]
269 pack .ctop.top.bar -side bottom -fill x
270 set cscroll .ctop.top.csb
271 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
272 pack $cscroll -side right -fill y
273 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
274 pack .ctop.top.clist -side top -fill both -expand 1
276 set canv .ctop.top.clist.canv
277 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
279 -yscrollincr $linespc -yscrollcommand "$cscroll set"
280 .ctop.top.clist add $canv
281 set canv2 .ctop.top.clist.canv2
282 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
283 -bg white -bd 0 -yscrollincr $linespc
284 .ctop.top.clist add $canv2
285 set canv3 .ctop.top.clist.canv3
286 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
287 -bg white -bd 0 -yscrollincr $linespc
288 .ctop.top.clist add $canv3
289 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
291 set sha1entry .ctop.top.bar.sha1
292 set entries $sha1entry
293 set sha1but .ctop.top.bar.sha1label
294 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
295 -command gotocommit -width 8
296 $sha1but conf -disabledforeground [$sha1but cget -foreground]
297 pack .ctop.top.bar.sha1label -side left
298 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
299 trace add variable sha1string write sha1change
300 pack $sha1entry -side left -pady 2
301 button .ctop.top.bar.findbut -text "Find" -command dofind
302 pack .ctop.top.bar.findbut -side left
304 set fstring .ctop.top.bar.findstring
305 lappend entries $fstring
306 entry $fstring -width 30 -font $textfont -textvariable findstring
307 pack $fstring -side left -expand 1 -fill x
309 tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
310 set findloc "All fields"
311 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
312 Comments Author Committer
313 pack .ctop.top.bar.findloc -side right
314 pack .ctop.top.bar.findtype -side right
316 panedwindow .ctop.cdet -orient horizontal
318 frame .ctop.cdet.left
319 set ctext .ctop.cdet.left.ctext
320 text $ctext -bg white -state disabled -font $textfont \
321 -width $geometry(ctextw) -height $geometry(ctexth) \
322 -yscrollcommand ".ctop.cdet.left.sb set"
323 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
324 pack .ctop.cdet.left.sb -side right -fill y
325 pack $ctext -side left -fill both -expand 1
326 .ctop.cdet add .ctop.cdet.left
328 $ctext tag conf filesep -font [concat $textfont bold]
329 $ctext tag conf hunksep -back blue -fore white
330 $ctext tag conf d0 -back "#ff8080"
331 $ctext tag conf d1 -back green
332 $ctext tag conf found -back yellow
334 frame .ctop.cdet.right
335 set cflist .ctop.cdet.right.cfiles
336 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
337 -yscrollcommand ".ctop.cdet.right.sb set"
338 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
339 pack .ctop.cdet.right.sb -side right -fill y
340 pack $cflist -side left -fill both -expand 1
341 .ctop.cdet add .ctop.cdet.right
342 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
344 pack .ctop -side top -fill both -expand 1
346 bindall <1> {selcanvline %x %y}
347 bindall <B1-Motion> {selcanvline %x %y}
348 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
349 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
350 bindall <2> "allcanvs scan mark 0 %y"
351 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
352 bind . <Key-Up> "selnextline -1"
353 bind . <Key-Down> "selnextline 1"
354 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
355 bind . <Key-Next> "allcanvs yview scroll 1 pages"
356 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
357 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
358 bindkey <Key-space> "$ctext yview scroll 1 pages"
359 bindkey p "selnextline -1"
360 bindkey n "selnextline 1"
361 bindkey b "$ctext yview scroll -1 pages"
362 bindkey d "$ctext yview scroll 18 units"
363 bindkey u "$ctext yview scroll -18 units"
367 bind . <Control-q> doquit
368 bind . <Control-f> dofind
369 bind . <Control-g> findnext
370 bind . <Control-r> findprev
371 bind . <Control-equal> {incrfont 1}
372 bind . <Control-KP_Add> {incrfont 1}
373 bind . <Control-minus> {incrfont -1}
374 bind . <Control-KP_Subtract> {incrfont -1}
375 bind $cflist <<ListboxSelect>> listboxsel
376 bind . <Destroy> {savestuff %W}
377 bind . <Button-1> "click %W"
378 bind $fstring <Key-Return> dofind
379 bind $sha1entry <Key-Return> gotocommit
382 # when we make a key binding for the toplevel, make sure
383 # it doesn't get triggered when that key is pressed in the
384 # find string entry widget.
385 proc bindkey {ev script} {
388 set escript [bind Entry $ev]
389 if {$escript == {}} {
390 set escript [bind Entry <Key>]
393 bind $e $ev "$escript; break"
397 # set the focus back to the toplevel for any click outside
408 global canv canv2 canv3 ctext cflist mainfont textfont
410 if {$stuffsaved} return
411 if {![winfo viewable .]} return
413 set f [open "~/.gitk-new" w]
414 puts $f "set mainfont {$mainfont}"
415 puts $f "set textfont {$textfont}"
416 puts $f "set geometry(width) [winfo width .ctop]"
417 puts $f "set geometry(height) [winfo height .ctop]"
418 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
419 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
420 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
421 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
422 set wid [expr {([winfo width $ctext] - 8) \
423 / [font measure $textfont "0"]}]
424 puts $f "set geometry(ctextw) $wid"
425 set wid [expr {([winfo width $cflist] - 11) \
426 / [font measure [$cflist cget -font] "0"]}]
427 puts $f "set geometry(cflistw) $wid"
429 file rename -force "~/.gitk-new" "~/.gitk"
434 proc resizeclistpanes {win w} {
436 if [info exists oldwidth($win)] {
437 set s0 [$win sash coord 0]
438 set s1 [$win sash coord 1]
440 set sash0 [expr {int($w/2 - 2)}]
441 set sash1 [expr {int($w*5/6 - 2)}]
443 set factor [expr {1.0 * $w / $oldwidth($win)}]
444 set sash0 [expr {int($factor * [lindex $s0 0])}]
445 set sash1 [expr {int($factor * [lindex $s1 0])}]
449 if {$sash1 < $sash0 + 20} {
450 set sash1 [expr $sash0 + 20]
452 if {$sash1 > $w - 10} {
453 set sash1 [expr $w - 10]
454 if {$sash0 > $sash1 - 20} {
455 set sash0 [expr $sash1 - 20]
459 $win sash place 0 $sash0 [lindex $s0 1]
460 $win sash place 1 $sash1 [lindex $s1 1]
462 set oldwidth($win) $w
465 proc resizecdetpanes {win w} {
467 if [info exists oldwidth($win)] {
468 set s0 [$win sash coord 0]
470 set sash0 [expr {int($w*3/4 - 2)}]
472 set factor [expr {1.0 * $w / $oldwidth($win)}]
473 set sash0 [expr {int($factor * [lindex $s0 0])}]
477 if {$sash0 > $w - 15} {
478 set sash0 [expr $w - 15]
481 $win sash place 0 $sash0 [lindex $s0 1]
483 set oldwidth($win) $w
487 global canv canv2 canv3
493 proc bindall {event action} {
494 global canv canv2 canv3
495 bind $canv $event $action
496 bind $canv2 $event $action
497 bind $canv3 $event $action
502 if {[winfo exists $w]} {
507 wm title $w "About gitk"
511 Copyright © 2005 Paul Mackerras
513 Use and redistribute under the terms of the GNU General Public License
515 (CVS $Revision: 1.22 $)} \
516 -justify center -aspect 400
517 pack $w.m -side top -fill x -padx 20 -pady 20
518 button $w.ok -text Close -command "destroy $w"
519 pack $w.ok -side bottom
522 proc assigncolor {id} {
523 global commitinfo colormap commcolors colors nextcolor
524 global parents nparents children nchildren
525 if [info exists colormap($id)] return
526 set ncolors [llength $colors]
527 if {$nparents($id) == 1 && $nchildren($id) == 1} {
528 set child [lindex $children($id) 0]
529 if {[info exists colormap($child)]
530 && $nparents($child) == 1} {
531 set colormap($id) $colormap($child)
536 foreach child $children($id) {
537 if {[info exists colormap($child)]
538 && [lsearch -exact $badcolors $colormap($child)] < 0} {
539 lappend badcolors $colormap($child)
541 if {[info exists parents($child)]} {
542 foreach p $parents($child) {
543 if {[info exists colormap($p)]
544 && [lsearch -exact $badcolors $colormap($p)] < 0} {
545 lappend badcolors $colormap($p)
550 if {[llength $badcolors] >= $ncolors} {
553 for {set i 0} {$i <= $ncolors} {incr i} {
554 set c [lindex $colors $nextcolor]
555 if {[incr nextcolor] >= $ncolors} {
558 if {[lsearch -exact $badcolors $c]} break
564 global canvy canvy0 lineno numcommits lthickness nextcolor linespc
566 global nchildren ncleft
573 set lthickness [expr {int($linespc / 9) + 1}]
574 catch {unset linestarty}
575 foreach id [array names nchildren] {
576 set ncleft($id) $nchildren($id)
580 proc drawcommitline {level} {
581 global parents children nparents nchildren ncleft todo
582 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
583 global datemode cdate
584 global lineid linehtag linentag linedtag commitinfo
585 global colormap numcommits currentparents
586 global oldlevel oldnlines oldtodo
587 global idtags idline idheads
588 global lineno lthickness linestarty
593 set id [lindex $todo $level]
594 set lineid($lineno) $id
595 set idline($id) $lineno
596 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
597 if {![info exists commitinfo($id)]} {
599 if {![info exists commitinfo($id)]} {
600 set commitinfo($id) {"No commit information available"}
604 set currentparents {}
605 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
606 set currentparents $parents($id)
608 set x [expr $canvx0 + $level * $linespc]
610 set canvy [expr $canvy + $linespc]
611 allcanvs conf -scrollregion \
612 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
613 if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
614 set t [$canv create line $x $linestarty($id) $x $y1 \
615 -width $lthickness -fill $colormap($id)]
618 set orad [expr {$linespc / 3}]
619 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
620 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
621 -fill $ofill -outline black -width 1]
623 set xt [expr $canvx0 + [llength $todo] * $linespc]
624 if {$nparents($id) > 2} {
625 set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
629 if {[info exists idtags($id)]} {
630 set marks $idtags($id)
631 set ntags [llength $marks]
633 if {[info exists idheads($id)]} {
634 set marks [concat $marks $idheads($id)]
637 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
638 set yt [expr $y1 - 0.5 * $linespc]
639 set yb [expr $yt + $linespc - 1]
643 set wid [font measure $mainfont $tag]
646 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
648 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
649 -width $lthickness -fill black]
651 foreach tag $marks x $xvals wid $wvals {
652 set xl [expr $x + $delta]
653 set xr [expr $x + $delta + $wid + $lthickness]
654 if {[incr ntags -1] >= 0} {
656 $canv create polygon $x [expr $yt + $delta] $xl $yt\
657 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
658 -width 1 -outline black -fill yellow
661 set xl [expr $xl - $delta/2]
662 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
663 -width 1 -outline black -fill green
665 $canv create text $xl $y1 -anchor w -text $tag \
669 set headline [lindex $commitinfo($id) 0]
670 set name [lindex $commitinfo($id) 1]
671 set date [lindex $commitinfo($id) 2]
672 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
673 -text $headline -font $mainfont ]
674 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
675 -text $name -font $namefont]
676 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
677 -text $date -font $mainfont]
680 proc updatetodo {level noshortcut} {
681 global datemode currentparents ncleft todo
682 global linestarty oldlevel oldtodo oldnlines
686 foreach p $currentparents {
687 if {![info exists commitinfo($p)]} {
691 if {!$noshortcut && [llength $currentparents] == 1} {
692 set p [lindex $currentparents 0]
693 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
695 set linestarty($p) [expr $canvy - $linespc]
696 set todo [lreplace $todo $level $level $p]
703 set oldnlines [llength $todo]
704 set todo [lreplace $todo $level $level]
706 foreach p $currentparents {
708 set k [lsearch -exact $todo $p]
711 set todo [linsert $todo $i $p]
719 global canv linestarty canvx0 canvy linespc
720 global oldlevel oldtodo todo currentparents
721 global lthickness linespc canvy colormap
723 set y1 [expr $canvy - $linespc]
726 foreach id $oldtodo {
728 if {$id == {}} continue
729 set xi [expr {$canvx0 + $i * $linespc}]
730 if {$i == $oldlevel} {
731 foreach p $currentparents {
732 set j [lsearch -exact $todo $p]
733 if {$i == $j && ![info exists linestarty($p)]} {
734 set linestarty($p) $y1
736 set xj [expr {$canvx0 + $j * $linespc}]
737 set coords [list $xi $y1]
739 lappend coords [expr $xj + $linespc] $y1
740 } elseif {$j > $i + 1} {
741 lappend coords [expr $xj - $linespc] $y1
743 lappend coords $xj $y2
744 set t [$canv create line $coords -width $lthickness \
747 if {![info exists linestarty($p)]} {
748 set linestarty($p) $y2
752 } elseif {[lindex $todo $i] != $id} {
753 set j [lsearch -exact $todo $id]
754 set xj [expr {$canvx0 + $j * $linespc}]
756 if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
757 lappend coords $xi $linestarty($id)
759 lappend coords $xi $y1 $xj $y2
760 set t [$canv create line $coords -width $lthickness \
761 -fill $colormap($id)]
763 set linestarty($id) $y2
769 global parents children nchildren ncleft todo
770 global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
771 global datemode cdate
772 global lineid linehtag linentag linedtag commitinfo
773 global currentparents oldlevel oldnlines oldtodo
774 global lineno lthickness
776 # remove the null entry if present
777 set nullentry [lsearch -exact $todo {}]
778 if {$nullentry >= 0} {
779 set todo [lreplace $todo $nullentry $nullentry]
782 # choose which one to do next time around
783 set todol [llength $todo]
786 for {set k $todol} {[incr k -1] >= 0} {} {
787 set p [lindex $todo $k]
788 if {$ncleft($p) == 0} {
790 if {$latest == {} || $cdate($p) > $latest} {
792 set latest $cdate($p)
802 puts "ERROR: none of the pending commits can be done yet:"
810 # If we are reducing, put in a null entry
811 if {$todol < $oldnlines} {
812 if {$nullentry >= 0} {
815 && [lindex $oldtodo $i] == [lindex $todo $i]} {
825 set todo [linsert $todo $i {}]
834 proc drawcommit {id} {
835 global phase todo nchildren datemode nextupdate
838 if {$phase != "incrdraw"} {
845 updatetodo 0 $datemode
847 if {$nchildren($id) == 0} {
849 lappend startcommits $id
852 set level [decidenext]
853 if {$id != [lindex $todo $level]} {
858 drawcommitline $level
859 if {[updatetodo $level $datemode]} {
860 set level [decidenext]
862 set id [lindex $todo $level]
863 if {![info exists commitlisted($id)]} {
866 if {[clock clicks -milliseconds] >= $nextupdate} {
874 proc finishcommits {} {
878 if {$phase != "incrdraw"} {
880 $canv create text 3 3 -anchor nw -text "No commits selected" \
881 -font $mainfont -tags textitems
886 set level [decidenext]
887 drawrest $level [llength $startcommits]
891 global nextupdate startmsecs startcommits todo
893 if {$startcommits == {}} return
894 set startmsecs [clock clicks -milliseconds]
895 set nextupdate [expr $startmsecs + 100]
897 set todo [lindex $startcommits 0]
901 proc drawrest {level startix} {
902 global phase stopped redisplaying selectedline
903 global datemode currentparents todo
905 global nextupdate startmsecs startcommits idline
908 set startid [lindex $startcommits $startix]
910 if {$startid != {}} {
911 set startline $idline($startid)
915 drawcommitline $level
916 set hard [updatetodo $level $datemode]
917 if {$numcommits == $startline} {
918 lappend todo $startid
921 set startid [lindex $startcommits $startix]
923 if {$startid != {}} {
924 set startline $idline($startid)
928 set level [decidenext]
929 if {$level < 0} break
932 if {[clock clicks -milliseconds] >= $nextupdate} {
938 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
939 puts "overall $drawmsecs ms for $numcommits commits"
941 if {$stopped == 0 && [info exists selectedline]} {
942 selectline $selectedline
953 proc findmatches {f} {
954 global findtype foundstring foundstrlen
955 if {$findtype == "Regexp"} {
956 set matches [regexp -indices -all -inline $foundstring $f]
958 if {$findtype == "IgnCase"} {
959 set str [string tolower $f]
965 while {[set j [string first $foundstring $str $i]] >= 0} {
966 lappend matches [list $j [expr $j+$foundstrlen-1]]
967 set i [expr $j + $foundstrlen]
974 global findtype findloc findstring markedmatches commitinfo
975 global numcommits lineid linehtag linentag linedtag
976 global mainfont namefont canv canv2 canv3 selectedline
977 global matchinglines foundstring foundstrlen
981 set fldtypes {Headline Author Date Committer CDate Comment}
982 if {$findtype == "IgnCase"} {
983 set foundstring [string tolower $findstring]
985 set foundstring $findstring
987 set foundstrlen [string length $findstring]
988 if {$foundstrlen == 0} return
989 if {![info exists selectedline]} {
992 set oldsel $selectedline
995 for {set l 0} {$l < $numcommits} {incr l} {
997 set info $commitinfo($id)
999 foreach f $info ty $fldtypes {
1000 if {$findloc != "All fields" && $findloc != $ty} {
1003 set matches [findmatches $f]
1004 if {$matches == {}} continue
1006 if {$ty == "Headline"} {
1007 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1008 } elseif {$ty == "Author"} {
1009 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1010 } elseif {$ty == "Date"} {
1011 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1015 lappend matchinglines $l
1016 if {!$didsel && $l > $oldsel} {
1022 if {$matchinglines == {}} {
1024 } elseif {!$didsel} {
1025 findselectline [lindex $matchinglines 0]
1029 proc findselectline {l} {
1030 global findloc commentend ctext
1032 if {$findloc == "All fields" || $findloc == "Comments"} {
1033 # highlight the matches in the comments
1034 set f [$ctext get 1.0 $commentend]
1035 set matches [findmatches $f]
1036 foreach match $matches {
1037 set start [lindex $match 0]
1038 set end [expr [lindex $match 1] + 1]
1039 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1045 global matchinglines selectedline
1046 if {![info exists matchinglines]} {
1050 if {![info exists selectedline]} return
1051 foreach l $matchinglines {
1052 if {$l > $selectedline} {
1061 global matchinglines selectedline
1062 if {![info exists matchinglines]} {
1066 if {![info exists selectedline]} return
1068 foreach l $matchinglines {
1069 if {$l >= $selectedline} break
1073 findselectline $prev
1079 proc markmatches {canv l str tag matches font} {
1080 set bbox [$canv bbox $tag]
1081 set x0 [lindex $bbox 0]
1082 set y0 [lindex $bbox 1]
1083 set y1 [lindex $bbox 3]
1084 foreach match $matches {
1085 set start [lindex $match 0]
1086 set end [lindex $match 1]
1087 if {$start > $end} continue
1088 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1089 set xlen [font measure $font [string range $str 0 [expr $end]]]
1090 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1091 -outline {} -tags matches -fill yellow]
1096 proc unmarkmatches {} {
1097 global matchinglines
1098 allcanvs delete matches
1099 catch {unset matchinglines}
1102 proc selcanvline {x y} {
1103 global canv canvy0 ctext linespc selectedline
1104 global lineid linehtag linentag linedtag
1105 set ymax [lindex [$canv cget -scrollregion] 3]
1106 if {$ymax == {}} return
1107 set yfrac [lindex [$canv yview] 0]
1108 set y [expr {$y + $yfrac * $ymax}]
1109 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1113 if {[info exists selectedline] && $selectedline == $l} return
1118 proc selectline {l} {
1119 global canv canv2 canv3 ctext commitinfo selectedline
1120 global lineid linehtag linentag linedtag
1121 global canvy0 linespc nparents treepending
1122 global cflist treediffs currentid sha1entry
1123 global commentend seenfile idtags
1124 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1126 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1127 -tags secsel -fill [$canv cget -selectbackground]]
1129 $canv2 delete secsel
1130 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1131 -tags secsel -fill [$canv2 cget -selectbackground]]
1133 $canv3 delete secsel
1134 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1135 -tags secsel -fill [$canv3 cget -selectbackground]]
1137 set y [expr {$canvy0 + $l * $linespc}]
1138 set ymax [lindex [$canv cget -scrollregion] 3]
1139 set ytop [expr {$y - $linespc - 1}]
1140 set ybot [expr {$y + $linespc + 1}]
1141 set wnow [$canv yview]
1142 set wtop [expr [lindex $wnow 0] * $ymax]
1143 set wbot [expr [lindex $wnow 1] * $ymax]
1144 set wh [expr {$wbot - $wtop}]
1146 if {$ytop < $wtop} {
1147 if {$ybot < $wtop} {
1148 set newtop [expr {$y - $wh / 2.0}]
1151 if {$newtop > $wtop - $linespc} {
1152 set newtop [expr {$wtop - $linespc}]
1155 } elseif {$ybot > $wbot} {
1156 if {$ytop > $wbot} {
1157 set newtop [expr {$y - $wh / 2.0}]
1159 set newtop [expr {$ybot - $wh}]
1160 if {$newtop < $wtop + $linespc} {
1161 set newtop [expr {$wtop + $linespc}]
1165 if {$newtop != $wtop} {
1169 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1175 $sha1entry delete 0 end
1176 $sha1entry insert 0 $id
1177 $sha1entry selection from 0
1178 $sha1entry selection to end
1180 $ctext conf -state normal
1181 $ctext delete 0.0 end
1182 set info $commitinfo($id)
1183 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
1184 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
1185 if {[info exists idtags($id)]} {
1186 $ctext insert end "Tags:"
1187 foreach tag $idtags($id) {
1188 $ctext insert end " $tag"
1190 $ctext insert end "\n"
1192 $ctext insert end "\n"
1193 $ctext insert end [lindex $info 5]
1194 $ctext insert end "\n"
1195 $ctext tag delete Comments
1196 $ctext tag remove found 1.0 end
1197 $ctext conf -state disabled
1198 set commentend [$ctext index "end - 1c"]
1200 $cflist delete 0 end
1201 if {$nparents($id) == 1} {
1202 if {![info exists treediffs($id)]} {
1203 if {![info exists treepending]} {
1210 catch {unset seenfile}
1213 proc selnextline {dir} {
1215 if {![info exists selectedline]} return
1216 set l [expr $selectedline + $dir]
1221 proc addtocflist {id} {
1222 global currentid treediffs cflist treepending
1223 if {$id != $currentid} {
1224 gettreediffs $currentid
1227 $cflist insert end "All files"
1228 foreach f $treediffs($currentid) {
1229 $cflist insert end $f
1234 proc gettreediffs {id} {
1235 global treediffs parents treepending
1237 set treediffs($id) {}
1238 set p [lindex $parents($id) 0]
1239 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1240 fconfigure $gdtf -blocking 0
1241 fileevent $gdtf readable "gettreediffline $gdtf $id"
1244 proc gettreediffline {gdtf id} {
1245 global treediffs treepending
1246 set n [gets $gdtf line]
1248 if {![eof $gdtf]} return
1254 set file [lindex $line 5]
1255 lappend treediffs($id) $file
1258 proc getblobdiffs {id} {
1259 global parents diffopts blobdifffd env curdifftag curtagstart
1260 global diffindex difffilestart
1261 set p [lindex $parents($id) 0]
1262 set env(GIT_DIFF_OPTS) $diffopts
1263 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1264 puts "error getting diffs: $err"
1267 fconfigure $bdf -blocking 0
1268 set blobdifffd($id) $bdf
1269 set curdifftag Comments
1272 catch {unset difffilestart}
1273 fileevent $bdf readable "getblobdiffline $bdf $id"
1276 proc getblobdiffline {bdf id} {
1277 global currentid blobdifffd ctext curdifftag curtagstart seenfile
1278 global diffnexthead diffnextnote diffindex difffilestart
1279 set n [gets $bdf line]
1283 if {$id == $currentid && $bdf == $blobdifffd($id)} {
1284 $ctext tag add $curdifftag $curtagstart end
1285 set seenfile($curdifftag) 1
1290 if {$id != $currentid || $bdf != $blobdifffd($id)} {
1293 $ctext conf -state normal
1294 if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1295 # start of a new file
1296 $ctext insert end "\n"
1297 $ctext tag add $curdifftag $curtagstart end
1298 set seenfile($curdifftag) 1
1299 set curtagstart [$ctext index "end - 1c"]
1301 if {[info exists diffnexthead]} {
1302 set fname $diffnexthead
1303 set header "$diffnexthead ($diffnextnote)"
1306 set difffilestart($diffindex) [$ctext index "end - 1c"]
1308 set curdifftag "f:$fname"
1309 $ctext tag delete $curdifftag
1310 set l [expr {(78 - [string length $header]) / 2}]
1311 set pad [string range "----------------------------------------" 1 $l]
1312 $ctext insert end "$pad $header $pad\n" filesep
1313 } elseif {[string range $line 0 2] == "+++"} {
1314 # no need to do anything with this
1315 } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1316 set diffnexthead $fn
1317 set diffnextnote "created, mode $m"
1318 } elseif {[string range $line 0 8] == "Deleted: "} {
1319 set diffnexthead [string range $line 9 end]
1320 set diffnextnote "deleted"
1321 } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1322 # save the filename in case the next thing is "new file mode ..."
1323 set diffnexthead $fn
1324 set diffnextnote "modified"
1325 } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1326 set diffnextnote "new file, mode $m"
1327 } elseif {[string range $line 0 11] == "deleted file"} {
1328 set diffnextnote "deleted"
1329 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1330 $line match f1l f1c f2l f2c rest]} {
1331 $ctext insert end "\t" hunksep
1332 $ctext insert end " $f1l " d0 " $f2l " d1
1333 $ctext insert end " $rest \n" hunksep
1335 set x [string range $line 0 0]
1336 if {$x == "-" || $x == "+"} {
1337 set tag [expr {$x == "+"}]
1338 set line [string range $line 1 end]
1339 $ctext insert end "$line\n" d$tag
1340 } elseif {$x == " "} {
1341 set line [string range $line 1 end]
1342 $ctext insert end "$line\n"
1343 } elseif {$x == "\\"} {
1344 # e.g. "\ No newline at end of file"
1345 $ctext insert end "$line\n" filesep
1347 # Something else we don't recognize
1348 if {$curdifftag != "Comments"} {
1349 $ctext insert end "\n"
1350 $ctext tag add $curdifftag $curtagstart end
1351 set seenfile($curdifftag) 1
1352 set curtagstart [$ctext index "end - 1c"]
1353 set curdifftag Comments
1355 $ctext insert end "$line\n" filesep
1358 $ctext conf -state disabled
1362 global difffilestart ctext
1363 set here [$ctext index @0,0]
1364 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1365 if {[$ctext compare $difffilestart($i) > $here]} {
1366 $ctext yview $difffilestart($i)
1372 proc listboxsel {} {
1373 global ctext cflist currentid treediffs seenfile
1374 if {![info exists currentid]} return
1375 set sel [$cflist curselection]
1376 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1378 $ctext tag conf Comments -elide 0
1379 foreach f $treediffs($currentid) {
1380 if [info exists seenfile(f:$f)] {
1381 $ctext tag conf "f:$f" -elide 0
1385 # just show selected files
1386 $ctext tag conf Comments -elide 1
1388 foreach f $treediffs($currentid) {
1389 set elide [expr {[lsearch -exact $sel $i] < 0}]
1390 if [info exists seenfile(f:$f)] {
1391 $ctext tag conf "f:$f" -elide $elide
1399 global linespc charspc canvx0 canvy0 mainfont
1400 set linespc [font metrics $mainfont -linespace]
1401 set charspc [font measure $mainfont "m"]
1402 set canvy0 [expr 3 + 0.5 * $linespc]
1403 set canvx0 [expr 3 + 0.5 * $linespc]
1407 global selectedline stopped redisplaying phase
1408 if {$stopped > 1} return
1409 if {$phase == "getcommits"} return
1411 if {$phase == "drawgraph" || $phase == "incrdraw"} {
1418 proc incrfont {inc} {
1419 global mainfont namefont textfont selectedline ctext canv phase
1420 global stopped entries
1422 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1423 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1424 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1426 $ctext conf -font $textfont
1427 $ctext tag conf filesep -font [concat $textfont bold]
1428 foreach e $entries {
1429 $e conf -font $mainfont
1431 if {$phase == "getcommits"} {
1432 $canv itemconf textitems -font $mainfont
1437 proc sha1change {n1 n2 op} {
1438 global sha1string currentid sha1but
1439 if {$sha1string == {}
1440 || ([info exists currentid] && $sha1string == $currentid)} {
1445 if {[$sha1but cget -state] == $state} return
1446 if {$state == "normal"} {
1447 $sha1but conf -state normal -relief raised -text "Goto: "
1449 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1453 proc gotocommit {} {
1454 global sha1string currentid idline tagids
1455 if {$sha1string == {}
1456 || ([info exists currentid] && $sha1string == $currentid)} return
1457 if {[info exists tagids($sha1string)]} {
1458 set id $tagids($sha1string)
1460 set id [string tolower $sha1string]
1462 if {[info exists idline($id)]} {
1463 selectline $idline($id)
1466 if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1471 error_popup "$type $sha1string is not known"
1483 set diffopts "-U 5 -p"
1485 set mainfont {Helvetica 9}
1486 set textfont {Courier 9}
1488 set colors {green red blue magenta darkgrey brown orange}
1490 catch {source ~/.gitk}
1492 set namefont $mainfont
1494 lappend namefont bold
1499 switch -regexp -- $arg {
1501 "^-b" { set boldnames 1 }
1502 "^-d" { set datemode 1 }
1504 lappend revtreeargs $arg
1509 set noreadobj [load libreadobj.so.0.0]
1517 getcommits $revtreeargs