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.7 $
15 set diffopts "-U 5 -p"
17 set mainfont {Helvetica 9}
18 set namefont $mainfont
19 set textfont {Courier 9}
24 set colors {green red blue magenta darkgrey brown orange}
25 set colorbycommitter false
27 catch {source ~/.gitk}
30 switch -regexp -- $arg {
32 "^-b" { set boldnames 1 }
33 "^-c" { set colorbycommitter 1 }
34 "^-d" { set datemode 1 }
36 puts stderr "unrecognized option $arg"
40 lappend revtreeargs $arg
45 proc getcommits {rargs} {
46 global commits parents cdate nparents children nchildren
51 if [catch {set clist [eval exec git-rev-tree $rargs]} err] {
52 if {[string range $err 0 4] == "usage"} {
53 puts stderr "Error reading commits: bad arguments to git-rev-tree"
54 puts stderr "Note: arguments to gitk are passed to git-rev-tree"
55 puts stderr " to allow selection of commits to be displayed"
57 puts stderr "Error reading commits: $err"
61 foreach c [split $clist "\n"] {
68 set id [lindex [split $f :] 0]
69 if {![info exists nchildren($id)]} {
80 lappend parents($cid) $id
83 lappend children($id) $cid
92 proc readcommit {id} {
101 foreach line [split [exec git-cat-file commit $id] "\n"] {
106 set tag [lindex $line 0]
107 if {$tag == "author"} {
108 set x [expr {[llength $line] - 2}]
109 set audate [lindex $line $x]
110 set auname [lrange $line 1 [expr {$x - 1}]]
111 } elseif {$tag == "committer"} {
112 set x [expr {[llength $line] - 2}]
113 set comdate [lindex $line $x]
114 set comname [lrange $line 1 [expr {$x - 1}]]
118 if {$comment == {}} {
127 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
129 if {$comdate != {}} {
130 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
132 set commitinfo($id) [list $headline $auname $audate \
133 $comname $comdate $comment]
137 global canv canv2 canv3 linespc charspc ctext cflist textfont
140 .bar add cascade -label "File" -menu .bar.file
142 .bar.file add command -label "Quit" -command "set stopped 1; destroy ."
144 .bar add cascade -label "Help" -menu .bar.help
145 .bar.help add command -label "About gitk" -command about
146 . configure -menu .bar
148 panedwindow .ctop -orient vertical
149 panedwindow .ctop.clist -orient horizontal -sashpad 0 -handlesize 4
150 .ctop add .ctop.clist
151 set canv .ctop.clist.canv
152 set cscroll .ctop.clist.dates.csb
153 set height [expr 25 * $linespc + 4]
154 canvas $canv -height $height -width [expr 45 * $charspc] \
156 -yscrollincr $linespc -yscrollcommand "$cscroll set"
157 .ctop.clist add $canv
158 set canv2 .ctop.clist.canv2
159 canvas $canv2 -height $height -width [expr 30 * $charspc] \
160 -bg white -bd 0 -yscrollincr $linespc
161 .ctop.clist add $canv2
162 frame .ctop.clist.dates
163 .ctop.clist add .ctop.clist.dates
164 set canv3 .ctop.clist.dates.canv3
165 canvas $canv3 -height $height -width [expr 15 * $charspc] \
166 -bg white -bd 0 -yscrollincr $linespc
167 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
168 pack .ctop.clist.dates.csb -side right -fill y
169 pack $canv3 -side left -fill both -expand 1
171 panedwindow .ctop.cdet -orient horizontal
173 frame .ctop.cdet.left
174 set ctext .ctop.cdet.left.ctext
175 text $ctext -bg white -state disabled -font $textfont -height 32 \
176 -yscrollcommand ".ctop.cdet.left.sb set"
177 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
178 pack .ctop.cdet.left.sb -side right -fill y
179 pack $ctext -side left -fill both -expand 1
180 .ctop.cdet add .ctop.cdet.left
182 $ctext tag conf filesep -font [concat $textfont bold]
183 $ctext tag conf hunksep -back blue -fore white
184 $ctext tag conf d0 -back "#ff8080"
185 $ctext tag conf d1 -back green
187 frame .ctop.cdet.right
188 set cflist .ctop.cdet.right.cfiles
189 listbox $cflist -width 30 -bg white -selectmode extended \
190 -yscrollcommand ".ctop.cdet.right.sb set"
191 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
192 pack .ctop.cdet.right.sb -side right -fill y
193 pack $cflist -side left -fill both -expand 1
194 .ctop.cdet add .ctop.cdet.right
196 pack .ctop -side top -fill both -expand 1
198 bindall <1> {selcanvline %x %y}
199 bindall <B1-Motion> {selcanvline %x %y}
200 bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
201 bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
202 bindall <2> "allcanvs scan mark 0 %y"
203 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
204 bind . <Key-Up> "selnextline -1"
205 bind . <Key-Down> "selnextline 1"
206 bind . p "selnextline -1"
207 bind . n "selnextline 1"
208 bind . <Key-Prior> "allcanvs yview scroll -1 p"
209 bind . <Key-Next> "allcanvs yview scroll 1 p"
210 bind . <Key-Delete> "$ctext yview scroll -1 p"
211 bind . <Key-BackSpace> "$ctext yview scroll -1 p"
212 bind . <Key-space> "$ctext yview scroll 1 p"
213 bind . b "$ctext yview scroll -1 p"
214 bind . d "$ctext yview scroll 18 u"
215 bind . u "$ctext yview scroll -18 u"
216 bind . Q "set stopped 1; destroy ."
217 bind . <Control-q> "set stopped 1; destroy ."
218 bind $cflist <<ListboxSelect>> listboxsel
222 global canv canv2 canv3
228 proc bindall {event action} {
229 global canv canv2 canv3
230 bind $canv $event $action
231 bind $canv2 $event $action
232 bind $canv3 $event $action
237 if {[winfo exists $w]} {
242 wm title $w "About gitk"
246 Copyright © 2005 Paul Mackerras
248 Use and redistribute under the terms of the GNU General Public License
250 (CVS $Revision: 1.7 $)} \
251 -justify center -aspect 400
252 pack $w.m -side top -fill x -padx 20 -pady 20
253 button $w.ok -text Close -command "destroy $w"
254 pack $w.ok -side bottom
257 proc truncatetofit {str width font} {
258 if {[font measure $font $str] <= $width} {
262 set bad [string length $str]
264 while {$best < $bad - 1} {
265 set try [expr {int(($best + $bad) / 2)}]
266 set tmp "[string range $str 0 [expr $try-1]]..."
267 if {[font measure $font $tmp] <= $width} {
276 proc assigncolor {id} {
277 global commitinfo colormap commcolors colors nextcolor
278 global colorbycommitter
279 global parents nparents children nchildren
280 if [info exists colormap($id)] return
281 set ncolors [llength $colors]
282 if {$colorbycommitter} {
283 if {![info exists commitinfo($id)]} {
286 set comm [lindex $commitinfo($id) 3]
287 if {![info exists commcolors($comm)]} {
288 set commcolors($comm) [lindex $colors $nextcolor]
289 if {[incr nextcolor] >= $ncolors} {
293 set colormap($id) $commcolors($comm)
295 if {$nparents($id) == 1 && $nchildren($id) == 1} {
296 set child [lindex $children($id) 0]
297 if {[info exists colormap($child)]
298 && $nparents($child) == 1} {
299 set colormap($id) $colormap($child)
304 foreach child $children($id) {
305 if {[info exists colormap($child)]
306 && [lsearch -exact $badcolors $colormap($child)] < 0} {
307 lappend badcolors $colormap($child)
309 if {[info exists parents($child)]} {
310 foreach p $parents($child) {
311 if {[info exists colormap($p)]
312 && [lsearch -exact $badcolors $colormap($p)] < 0} {
313 lappend badcolors $colormap($p)
318 if {[llength $badcolors] >= $ncolors} {
321 for {set i 0} {$i <= $ncolors} {incr i} {
322 set c [lindex $colors $nextcolor]
323 if {[incr nextcolor] >= $ncolors} {
326 if {[lsearch -exact $badcolors $c]} break
332 proc drawgraph {start} {
333 global parents children nparents nchildren commits
334 global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
335 global datemode cdate
336 global lineid linehtag linentag linedtag commitinfo
337 global nextcolor colormap
342 foreach id $commits {
343 set ncleft($id) $nchildren($id)
345 set todo [list $start]
348 set linestarty(0) $canvy0
353 allcanvs conf -scrollregion [list 0 0 0 $canvy]
357 set nlines [llength $todo]
358 set id [lindex $todo $level]
359 set lineid($lineno) $id
361 foreach p $parents($id) {
362 if {[info exists ncleft($p)]} {
364 lappend actualparents $p
367 if {![info exists commitinfo($id)]} {
370 set x [expr $canvx0 + $level * $linespc]
371 set y2 [expr $canvy + $linespc]
372 if {$linestarty($level) < $canvy} {
373 set t [$canv create line $x $linestarty($level) $x $canvy \
374 -width 2 -fill $colormap($id)]
376 set linestarty($level) $canvy
378 set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
379 [expr $x + 3] [expr $canvy + 3] \
380 -fill blue -outline black -width 1]
382 set xt [expr $canvx0 + $nlines * $linespc]
383 set headline [lindex $commitinfo($id) 0]
384 set name [lindex $commitinfo($id) 1]
385 set date [lindex $commitinfo($id) 2]
386 set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
387 -text $headline -font $mainfont ]
388 set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
389 -text $name -font $namefont]
390 set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
391 -text $date -font $mainfont]
392 if {!$datemode && [llength $actualparents] == 1} {
393 set p [lindex $actualparents 0]
394 if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
396 set todo [lreplace $todo $level $level $p]
404 for {set i 0} {$i < $nlines} {incr i} {
405 if {[lindex $todo $i] == {}} continue
406 set oldstarty($i) $linestarty($i)
408 lappend lines [list $i [lindex $todo $i]]
412 if {$nullentry >= 0} {
413 set todo [lreplace $todo $nullentry $nullentry]
414 if {$nullentry < $level} {
419 set todo [lreplace $todo $level $level]
420 if {$nullentry > $level} {
424 foreach p $actualparents {
425 set k [lsearch -exact $todo $p]
428 set todo [linsert $todo $i $p]
429 if {$nullentry >= $i} {
433 lappend lines [list $oldlevel $p]
436 # choose which one to do next time around
437 set todol [llength $todo]
440 for {set k $todol} {[incr k -1] >= 0} {} {
441 set p [lindex $todo $k]
442 if {$p == {}} continue
443 if {$ncleft($p) == 0} {
445 if {$latest == {} || $cdate($p) > $latest} {
447 set latest $cdate($p)
457 puts "ERROR: none of the pending commits can be done yet:"
465 # If we are reducing, put in a null entry
466 if {$todol < $nlines} {
467 if {$nullentry >= 0} {
470 && [lindex $oldtodo $i] == [lindex $todo $i]} {
483 set todo [linsert $todo $nullentry {}]
494 set dst [lindex $l 1]
495 set j [lsearch -exact $todo $dst]
497 set linestarty($i) $oldstarty($i)
500 set xi [expr {$canvx0 + $i * $linespc}]
501 set xj [expr {$canvx0 + $j * $linespc}]
503 if {$oldstarty($i) < $canvy} {
504 lappend coords $xi $oldstarty($i)
506 lappend coords $xi $canvy
508 lappend coords [expr $xj + $linespc] $canvy
509 } elseif {$j > $i + 1} {
510 lappend coords [expr $xj - $linespc] $canvy
512 lappend coords $xj $y2
513 set t [$canv create line $coords -width 2 -fill $colormap($dst)]
515 if {![info exists linestarty($j)]} {
516 set linestarty($j) $y2
522 proc selcanvline {x y} {
523 global canv canvy0 ctext linespc selectedline
524 global lineid linehtag linentag linedtag
525 set ymax [lindex [$canv cget -scrollregion] 3]
526 set yfrac [lindex [$canv yview] 0]
527 set y [expr {$y + $yfrac * $ymax}]
528 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
532 if {[info exists selectedline] && $selectedline == $l} return
536 proc selectline {l} {
537 global canv canv2 canv3 ctext commitinfo selectedline
538 global lineid linehtag linentag linedtag
539 global canvy canvy0 linespc nparents treepending
540 global cflist treediffs currentid
541 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
543 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
544 -tags secsel -fill [$canv cget -selectbackground]]
547 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
548 -tags secsel -fill [$canv2 cget -selectbackground]]
551 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
552 -tags secsel -fill [$canv3 cget -selectbackground]]
554 set y [expr {$canvy0 + $l * $linespc}]
555 set ytop [expr {($y - $linespc / 2.0) / $canvy}]
556 set ybot [expr {($y + $linespc / 2.0) / $canvy}]
557 set wnow [$canv yview]
558 if {$ytop < [lindex $wnow 0]} {
559 allcanvs yview moveto $ytop
560 } elseif {$ybot > [lindex $wnow 1]} {
561 set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
562 allcanvs yview moveto [expr {$ybot - $wh}]
567 $ctext conf -state normal
568 $ctext delete 0.0 end
569 set info $commitinfo($id)
570 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
571 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
572 $ctext insert end "\n"
573 $ctext insert end [lindex $info 5]
574 $ctext insert end "\n"
575 $ctext tag delete Comments
576 $ctext conf -state disabled
580 if {$nparents($id) == 1} {
581 if {![info exists treediffs($id)]} {
582 if {![info exists treepending]} {
591 proc selnextline {dir} {
593 if {![info exists selectedline]} return
594 set l [expr $selectedline + $dir]
598 proc addtocflist {id} {
599 global currentid treediffs cflist treepending
600 if {$id != $currentid} {
601 gettreediffs $currentid
604 $cflist insert end "All files"
605 foreach f $treediffs($currentid) {
606 $cflist insert end $f
611 proc gettreediffs {id} {
612 global treediffs parents treepending
614 set treediffs($id) {}
615 set p [lindex $parents($id) 0]
616 if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
617 fconfigure $gdtf -blocking 0
618 fileevent $gdtf readable "gettreediffline $gdtf $id"
621 proc gettreediffline {gdtf id} {
622 global treediffs treepending
623 set n [gets $gdtf line]
625 if {![eof $gdtf]} return
631 set type [lindex $line 1]
632 set file [lindex $line 3]
633 if {$type == "blob"} {
634 lappend treediffs($id) $file
638 proc getblobdiffs {id} {
639 global parents diffopts blobdifffd env curdifftag curtagstart
640 set p [lindex $parents($id) 0]
641 set env(GIT_DIFF_OPTS) $diffopts
642 if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
643 puts "error getting diffs: $err"
646 fconfigure $bdf -blocking 0
647 set blobdifffd($id) $bdf
648 set curdifftag Comments
650 fileevent $bdf readable "getblobdiffline $bdf $id"
653 proc getblobdiffline {bdf id} {
654 global currentid blobdifffd ctext curdifftag curtagstart
655 set n [gets $bdf line]
659 if {$id == $currentid && $bdf == $blobdifffd($id)} {
660 $ctext tag add $curdifftag $curtagstart end
665 if {$id != $currentid || $bdf != $blobdifffd($id)} {
668 $ctext conf -state normal
669 if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
670 # start of a new file
671 $ctext insert end "\n"
672 $ctext tag add $curdifftag $curtagstart end
673 set curtagstart [$ctext index "end - 1c"]
674 set curdifftag "f:$fname"
675 $ctext tag delete $curdifftag
676 set l [expr {(78 - [string length $fname]) / 2}]
677 set pad [string range "----------------------------------------" 1 $l]
678 $ctext insert end "$pad $fname $pad\n" filesep
679 } elseif {[string range $line 0 2] == "+++"} {
680 # no need to do anything with this
681 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
682 $line match f1l f1c f2l f2c rest]} {
683 $ctext insert end "\t" hunksep
684 $ctext insert end " $f1l " d0 " $f2l " d1
685 $ctext insert end " $rest \n" hunksep
687 set x [string range $line 0 0]
688 if {$x == "-" || $x == "+"} {
689 set tag [expr {$x == "+"}]
690 set line [string range $line 1 end]
691 $ctext insert end "$line\n" d$tag
692 } elseif {$x == " "} {
693 set line [string range $line 1 end]
694 $ctext insert end "$line\n"
696 # Something else we don't recognize
697 if {$curdifftag != "Comments"} {
698 $ctext insert end "\n"
699 $ctext tag add $curdifftag $curtagstart end
700 set curtagstart [$ctext index "end - 1c"]
701 set curdifftag Comments
703 $ctext insert end "$line\n" filesep
706 $ctext conf -state disabled
710 global ctext cflist currentid treediffs
711 if {![info exists currentid]} return
712 set sel [$cflist curselection]
713 if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
715 $ctext tag conf Comments -elide 0
716 foreach f $treediffs($currentid) {
717 $ctext tag conf "f:$f" -elide 0
720 # just show selected files
721 $ctext tag conf Comments -elide 1
723 foreach f $treediffs($currentid) {
724 set elide [expr {[lsearch -exact $sel $i] < 0}]
725 $ctext tag conf "f:$f" -elide $elide
731 if {![getcommits $revtreeargs]} {
735 set linespc [font metrics $mainfont -linespace]
736 set charspc [font measure $mainfont "m"]
738 set canvy0 [expr 3 + 0.5 * $linespc]
739 set canvx0 [expr 3 + 0.5 * $linespc]
740 set namex [expr 45 * $charspc]
741 set datex [expr 75 * $charspc]
747 foreach id $commits {
748 if {$nchildren($id) == 0} {