path: root/gitk

#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "${1+$@}"
 
# Copyright (C) 2005 Paul Mackerras.  All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
 
# CVS $Revision: 1.7 $
 
set datemode 0
set boldnames 0
set revtreeargs {}
set diffopts "-U 5 -p"
 
set mainfont {Helvetica 9}
set namefont $mainfont
set textfont {Courier 9}
if {$boldnames} {
    lappend namefont bold
}
 
set colors {green red blue magenta darkgrey brown orange}
set colorbycommitter false
 
catch {source ~/.gitk}
 
foreach arg $argv {
    switch -regexp -- $arg {
	"^$" { }
	"^-b" { set boldnames 1 }
	"^-c" { set colorbycommitter 1 }
	"^-d" { set datemode 1 }
	"^-.*" {
	    puts stderr "unrecognized option $arg"
	    exit 1
	}
	default {
	    lappend revtreeargs $arg
	}
    }
}
 
proc getcommits {rargs} {
    global commits parents cdate nparents children nchildren
    if {$rargs == {}} {
	set rargs HEAD
    }
    set commits {}
    if [catch {set clist [eval exec git-rev-tree $rargs]} err] {
	if {[string range $err 0 4] == "usage"} {
	    puts stderr "Error reading commits: bad arguments to git-rev-tree"
	    puts stderr "Note: arguments to gitk are passed to git-rev-tree"
	    puts stderr "      to allow selection of commits to be displayed"
	} else {
	    puts stderr "Error reading commits: $err"
	}
	return 0
    }
    foreach c [split $clist "\n"] {
	set i 0
	set cid {}
	foreach f $c {
	    if {$i == 0} {
		set d $f
	    } else {
		set id [lindex [split $f :] 0]
		if {![info exists nchildren($id)]} {
		    set children($id) {}
		    set nchildren($id) 0
		}
		if {$i == 1} {
		    set cid $id
		    lappend commits $id
		    set parents($id) {}
		    set cdate($id) $d
		    set nparents($id) 0
		} else {
		    lappend parents($cid) $id
		    incr nparents($cid)
		    incr nchildren($id)
		    lappend children($id) $cid
		}
	    }
	    incr i
	}
    }
    return 1
}
 
proc readcommit {id} {
    global commitinfo
    set inhdr 1
    set comment {}
    set headline {}
    set auname {}
    set audate {}
    set comname {}
    set comdate {}
    foreach line [split [exec git-cat-file commit $id] "\n"] {
	if {$inhdr} {
	    if {$line == {}} {
		set inhdr 0
	    } else {
		set tag [lindex $line 0]
		if {$tag == "author"} {
		    set x [expr {[llength $line] - 2}]
		    set audate [lindex $line $x]
		    set auname [lrange $line 1 [expr {$x - 1}]]
		} elseif {$tag == "committer"} {
		    set x [expr {[llength $line] - 2}]
		    set comdate [lindex $line $x]
		    set comname [lrange $line 1 [expr {$x - 1}]]
		}
	    }
	} else {
	    if {$comment == {}} {
		set headline $line
	    } else {
		append comment "\n"
	    }
	    append comment $line
	}
    }
    if {$audate != {}} {
	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
    }
    if {$comdate != {}} {
	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
    }
    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment]
}
 
proc makewindow {} {
    global canv canv2 canv3 linespc charspc ctext cflist textfont
 
    menu .bar
    .bar add cascade -label "File" -menu .bar.file
    menu .bar.file
    .bar.file add command -label "Quit" -command "set stopped 1; destroy ."
    menu .bar.help
    .bar add cascade -label "Help" -menu .bar.help
    .bar.help add command -label "About gitk" -command about
    . configure -menu .bar
 
    panedwindow .ctop -orient vertical
    panedwindow .ctop.clist -orient horizontal -sashpad 0 -handlesize 4
    .ctop add .ctop.clist
    set canv .ctop.clist.canv
    set cscroll .ctop.clist.dates.csb
    set height [expr 25 * $linespc + 4]
    canvas $canv -height $height -width [expr 45 * $charspc] \
	-bg white -bd 0 \
	-yscrollincr $linespc -yscrollcommand "$cscroll set"
    .ctop.clist add $canv
    set canv2 .ctop.clist.canv2
    canvas $canv2 -height $height -width [expr 30 * $charspc] \
	-bg white -bd 0 -yscrollincr $linespc
    .ctop.clist add $canv2
    frame .ctop.clist.dates
    .ctop.clist add .ctop.clist.dates
    set canv3 .ctop.clist.dates.canv3
    canvas $canv3 -height $height -width [expr 15 * $charspc] \
	-bg white -bd 0 -yscrollincr $linespc
    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
    pack .ctop.clist.dates.csb -side right -fill y
    pack $canv3 -side left -fill both -expand 1
 
    panedwindow .ctop.cdet -orient horizontal
    .ctop add .ctop.cdet
    frame .ctop.cdet.left
    set ctext .ctop.cdet.left.ctext
    text $ctext -bg white -state disabled -font $textfont -height 32 \
	-yscrollcommand ".ctop.cdet.left.sb set"
    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
    pack .ctop.cdet.left.sb -side right -fill y
    pack $ctext -side left -fill both -expand 1
    .ctop.cdet add .ctop.cdet.left
 
    $ctext tag conf filesep -font [concat $textfont bold]
    $ctext tag conf hunksep -back blue -fore white
    $ctext tag conf d0 -back "#ff8080"
    $ctext tag conf d1 -back green
 
    frame .ctop.cdet.right
    set cflist .ctop.cdet.right.cfiles
    listbox $cflist -width 30 -bg white -selectmode extended \
	-yscrollcommand ".ctop.cdet.right.sb set"
    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
    pack .ctop.cdet.right.sb -side right -fill y
    pack $cflist -side left -fill both -expand 1
    .ctop.cdet add .ctop.cdet.right
 
    pack .ctop -side top -fill both -expand 1
 
    bindall <1> {selcanvline %x %y}
    bindall <B1-Motion> {selcanvline %x %y}
    bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
    bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
    bindall <2> "allcanvs scan mark 0 %y"
    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
    bind . <Key-Up> "selnextline -1"
    bind . <Key-Down> "selnextline 1"
    bind . p "selnextline -1"
    bind . n "selnextline 1"
    bind . <Key-Prior> "allcanvs yview scroll -1 p"
    bind . <Key-Next> "allcanvs yview scroll 1 p"
    bind . <Key-Delete> "$ctext yview scroll -1 p"
    bind . <Key-BackSpace> "$ctext yview scroll -1 p"
    bind . <Key-space> "$ctext yview scroll 1 p"
    bind . b "$ctext yview scroll -1 p"
    bind . d "$ctext yview scroll 18 u"
    bind . u "$ctext yview scroll -18 u"
    bind . Q "set stopped 1; destroy ."
    bind . <Control-q> "set stopped 1; destroy ."
    bind $cflist <<ListboxSelect>> listboxsel
}
 
proc allcanvs args {
    global canv canv2 canv3
    eval $canv $args
    eval $canv2 $args
    eval $canv3 $args
}
 
proc bindall {event action} {
    global canv canv2 canv3
    bind $canv $event $action
    bind $canv2 $event $action
    bind $canv3 $event $action
}
 
proc about {} {
    set w .about
    if {[winfo exists $w]} {
	raise $w
	return
    }
    toplevel $w
    wm title $w "About gitk"
    message $w.m -text {
Gitk version 0.9
 
Copyright © 2005 Paul Mackerras
 
Use and redistribute under the terms of the GNU General Public License
 
(CVS $Revision: 1.7 $)} \
	    -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text Close -command "destroy $w"
    pack $w.ok -side bottom
}
 
proc truncatetofit {str width font} {
    if {[font measure $font $str] <= $width} {
	return $str
    }
    set best 0
    set bad [string length $str]
    set tmp $str
    while {$best < $bad - 1} {
	set try [expr {int(($best + $bad) / 2)}]
	set tmp "[string range $str 0 [expr $try-1]]..."
	if {[font measure $font $tmp] <= $width} {
	    set best $try
	} else {
	    set bad $try
	}
    }
    return $tmp
}
 
proc assigncolor {id} {
    global commitinfo colormap commcolors colors nextcolor
    global colorbycommitter
    global parents nparents children nchildren
    if [info exists colormap($id)] return
    set ncolors [llength $colors]
    if {$colorbycommitter} {
	if {![info exists commitinfo($id)]} {
	    readcommit $id
	}
	set comm [lindex $commitinfo($id) 3]
	if {![info exists commcolors($comm)]} {
	    set commcolors($comm) [lindex $colors $nextcolor]
	    if {[incr nextcolor] >= $ncolors} {
		set nextcolor 0
	    }
	}
	set colormap($id) $commcolors($comm)
    } else {
	if {$nparents($id) == 1 && $nchildren($id) == 1} {
	    set child [lindex $children($id) 0]
	    if {[info exists colormap($child)]
		&& $nparents($child) == 1} {
		set colormap($id) $colormap($child)
		return
	    }
	}
	set badcolors {}
	foreach child $children($id) {
	    if {[info exists colormap($child)]
		&& [lsearch -exact $badcolors $colormap($child)] < 0} {
		lappend badcolors $colormap($child)
	    }
	    if {[info exists parents($child)]} {
		foreach p $parents($child) {
		    if {[info exists colormap($p)]
			&& [lsearch -exact $badcolors $colormap($p)] < 0} {
			lappend badcolors $colormap($p)
		    }
		}
	    }
	}
	if {[llength $badcolors] >= $ncolors} {
	    set badcolors {}
	}
	for {set i 0} {$i <= $ncolors} {incr i} {
	    set c [lindex $colors $nextcolor]
	    if {[incr nextcolor] >= $ncolors} {
		set nextcolor 0
	    }
	    if {[lsearch -exact $badcolors $c]} break
	}
	set colormap($id) $c
    }
}
 
proc drawgraph {start} {
    global parents children nparents nchildren commits
    global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
    global datemode cdate
    global lineid linehtag linentag linedtag commitinfo
    global nextcolor colormap
    global stopped
 
    set nextcolor 0
    assigncolor $start
    foreach id $commits {
	set ncleft($id) $nchildren($id)
    }
    set todo [list $start]
    set level 0
    set y2 $canvy0
    set linestarty(0) $canvy0
    set nullentry -1
    set lineno -1
    while 1 {
	set canvy $y2
	allcanvs conf -scrollregion [list 0 0 0 $canvy]
	update
	if {$stopped} return
	incr lineno
	set nlines [llength $todo]
	set id [lindex $todo $level]
	set lineid($lineno) $id
	set actualparents {}
	foreach p $parents($id) {
	    if {[info exists ncleft($p)]} {
		incr ncleft($p) -1
		lappend actualparents $p
	    }
	}
	if {![info exists commitinfo($id)]} {
	    readcommit $id
	}
	set x [expr $canvx0 + $level * $linespc]
	set y2 [expr $canvy + $linespc]
	if {$linestarty($level) < $canvy} {
	    set t [$canv create line $x $linestarty($level) $x $canvy \
		       -width 2 -fill $colormap($id)]
	    $canv lower $t
	    set linestarty($level) $canvy
	}
	set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
		   [expr $x + 3] [expr $canvy + 3] \
		   -fill blue -outline black -width 1]
	$canv raise $t
	set xt [expr $canvx0 + $nlines * $linespc]
	set headline [lindex $commitinfo($id) 0]
	set name [lindex $commitinfo($id) 1]
	set date [lindex $commitinfo($id) 2]
	set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
				   -text $headline -font $mainfont ]
	set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
				   -text $name -font $namefont]
	set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
				 -text $date -font $mainfont]
	if {!$datemode && [llength $actualparents] == 1} {
	    set p [lindex $actualparents 0]
	    if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
		assigncolor $p
		set todo [lreplace $todo $level $level $p]
		continue
	    }
	}
 
	set oldtodo $todo
	set oldlevel $level
	set lines {}
	for {set i 0} {$i < $nlines} {incr i} {
	    if {[lindex $todo $i] == {}} continue
	    set oldstarty($i) $linestarty($i)
	    if {$i != $level} {
		lappend lines [list $i [lindex $todo $i]]
	    }
	}
	unset linestarty
	if {$nullentry >= 0} {
	    set todo [lreplace $todo $nullentry $nullentry]
	    if {$nullentry < $level} {
		incr level -1
	    }
	}
 
	set todo [lreplace $todo $level $level]
	if {$nullentry > $level} {
	    incr nullentry -1
	}
	set i $level
	foreach p $actualparents {
	    set k [lsearch -exact $todo $p]
	    if {$k < 0} {
		assigncolor $p
		set todo [linsert $todo $i $p]
		if {$nullentry >= $i} {
		    incr nullentry
		}
	    }
	    lappend lines [list $oldlevel $p]
	}
 
	# choose which one to do next time around
	set todol [llength $todo]
	set level -1
	set latest {}
	for {set k $todol} {[incr k -1] >= 0} {} {
	    set p [lindex $todo $k]
	    if {$p == {}} continue
	    if {$ncleft($p) == 0} {
		if {$datemode} {
		    if {$latest == {} || $cdate($p) > $latest} {
			set level $k
			set latest $cdate($p)
		    }
		} else {
		    set level $k
		    break
		}
	    }
	}
	if {$level < 0} {
	    if {$todo != {}} {
		puts "ERROR: none of the pending commits can be done yet:"
		foreach p $todo {
		    puts "  $p"
		}
	    }
	    break
	}
 
	# If we are reducing, put in a null entry
	if {$todol < $nlines} {
	    if {$nullentry >= 0} {
		set i $nullentry
		while {$i < $todol
		       && [lindex $oldtodo $i] == [lindex $todo $i]} {
		    incr i
		}
	    } else {
		set i $oldlevel
		if {$level >= $i} {
		    incr i
		}
	    }
	    if {$i >= $todol} {
		set nullentry -1
	    } else {
		set nullentry $i
		set todo [linsert $todo $nullentry {}]
		if {$level >= $i} {
		    incr level
		}
	    }
	} else {
	    set nullentry -1
	}
 
	foreach l $lines {
	    set i [lindex $l 0]
	    set dst [lindex $l 1]
	    set j [lsearch -exact $todo $dst]
	    if {$i == $j} {
		set linestarty($i) $oldstarty($i)
		continue
	    }
	    set xi [expr {$canvx0 + $i * $linespc}]
	    set xj [expr {$canvx0 + $j * $linespc}]
	    set coords {}
	    if {$oldstarty($i) < $canvy} {
		lappend coords $xi $oldstarty($i)
	    }
	    lappend coords $xi $canvy
	    if {$j < $i - 1} {
		lappend coords [expr $xj + $linespc] $canvy
	    } elseif {$j > $i + 1} {
		lappend coords [expr $xj - $linespc] $canvy
	    }
	    lappend coords $xj $y2
	    set t [$canv create line $coords -width 2 -fill $colormap($dst)]
	    $canv lower $t
	    if {![info exists linestarty($j)]} {
		set linestarty($j) $y2
	    }
	}
    }
}
 
proc selcanvline {x y} {
    global canv canvy0 ctext linespc selectedline
    global lineid linehtag linentag linedtag
    set ymax [lindex [$canv cget -scrollregion] 3]
    set yfrac [lindex [$canv yview] 0]
    set y [expr {$y + $yfrac * $ymax}]
    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
    if {$l < 0} {
	set l 0
    }
    if {[info exists selectedline] && $selectedline == $l} return
    selectline $l
}
 
proc selectline {l} {
    global canv canv2 canv3 ctext commitinfo selectedline
    global lineid linehtag linentag linedtag
    global canvy canvy0 linespc nparents treepending
    global cflist treediffs currentid
    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
    $canv delete secsel
    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
	       -tags secsel -fill [$canv cget -selectbackground]]
    $canv lower $t
    $canv2 delete secsel
    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
	       -tags secsel -fill [$canv2 cget -selectbackground]]
    $canv2 lower $t
    $canv3 delete secsel
    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
	       -tags secsel -fill [$canv3 cget -selectbackground]]
    $canv3 lower $t
    set y [expr {$canvy0 + $l * $linespc}]
    set ytop [expr {($y - $linespc / 2.0) / $canvy}]
    set ybot [expr {($y + $linespc / 2.0) / $canvy}]
    set wnow [$canv yview]
    if {$ytop < [lindex $wnow 0]} {
	allcanvs yview moveto $ytop
    } elseif {$ybot > [lindex $wnow 1]} {
	set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
	allcanvs yview moveto [expr {$ybot - $wh}]
    }
    set selectedline $l
 
    set id $lineid($l)
    $ctext conf -state normal
    $ctext delete 0.0 end
    set info $commitinfo($id)
    $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
    $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
    $ctext insert end "\n"
    $ctext insert end [lindex $info 5]
    $ctext insert end "\n"
    $ctext tag delete Comments
    $ctext conf -state disabled
 
    $cflist delete 0 end
    set currentid $id
    if {$nparents($id) == 1} {
	if {![info exists treediffs($id)]} {
	    if {![info exists treepending]} {
		gettreediffs $id
	    }
	} else {
	    addtocflist $id
	}
    }
}
 
proc selnextline {dir} {
    global selectedline
    if {![info exists selectedline]} return
    set l [expr $selectedline + $dir]
    selectline $l
}
 
proc addtocflist {id} {
    global currentid treediffs cflist treepending
    if {$id != $currentid} {
	gettreediffs $currentid
	return
    }
    $cflist insert end "All files"
    foreach f $treediffs($currentid) {
	$cflist insert end $f
    }
    getblobdiffs $id
}
 
proc gettreediffs {id} {
    global treediffs parents treepending
    set treepending $id
    set treediffs($id) {}
    set p [lindex $parents($id) 0]
    if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
    fconfigure $gdtf -blocking 0
    fileevent $gdtf readable "gettreediffline $gdtf $id"
}
 
proc gettreediffline {gdtf id} {
    global treediffs treepending
    set n [gets $gdtf line]
    if {$n < 0} {
	if {![eof $gdtf]} return
	close $gdtf
	unset treepending
	addtocflist $id
	return
    }
    set type [lindex $line 1]
    set file [lindex $line 3]
    if {$type == "blob"} {
	lappend treediffs($id) $file
    }
}
 
proc getblobdiffs {id} {
    global parents diffopts blobdifffd env curdifftag curtagstart
    set p [lindex $parents($id) 0]
    set env(GIT_DIFF_OPTS) $diffopts
    if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
	puts "error getting diffs: $err"
	return
    }
    fconfigure $bdf -blocking 0
    set blobdifffd($id) $bdf
    set curdifftag Comments
    set curtagstart 0.0
    fileevent $bdf readable "getblobdiffline $bdf $id"
}
 
proc getblobdiffline {bdf id} {
    global currentid blobdifffd ctext curdifftag curtagstart
    set n [gets $bdf line]
    if {$n < 0} {
	if {[eof $bdf]} {
	    close $bdf
	    if {$id == $currentid && $bdf == $blobdifffd($id)} {
		$ctext tag add $curdifftag $curtagstart end
	    }
	}
	return
    }
    if {$id != $currentid || $bdf != $blobdifffd($id)} {
	return
    }
    $ctext conf -state normal
    if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
	# start of a new file
	$ctext insert end "\n"
	$ctext tag add $curdifftag $curtagstart end
	set curtagstart [$ctext index "end - 1c"]
	set curdifftag "f:$fname"
	$ctext tag delete $curdifftag
	set l [expr {(78 - [string length $fname]) / 2}]
	set pad [string range "----------------------------------------" 1 $l]
	$ctext insert end "$pad $fname $pad\n" filesep
    } elseif {[string range $line 0 2] == "+++"} {
	# no need to do anything with this
    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
		   $line match f1l f1c f2l f2c rest]} {
	$ctext insert end "\t" hunksep
	$ctext insert end "    $f1l    " d0 "    $f2l    " d1
	$ctext insert end "    $rest \n" hunksep
    } else {
	set x [string range $line 0 0]
	if {$x == "-" || $x == "+"} {
	    set tag [expr {$x == "+"}]
	    set line [string range $line 1 end]
	    $ctext insert end "$line\n" d$tag
	} elseif {$x == " "} {
	    set line [string range $line 1 end]
	    $ctext insert end "$line\n"
	} else {
	    # Something else we don't recognize
	    if {$curdifftag != "Comments"} {
		$ctext insert end "\n"
		$ctext tag add $curdifftag $curtagstart end
		set curtagstart [$ctext index "end - 1c"]
		set curdifftag Comments
	    }
	    $ctext insert end "$line\n" filesep
	}
    }
    $ctext conf -state disabled
}
 
proc listboxsel {} {
    global ctext cflist currentid treediffs
    if {![info exists currentid]} return
    set sel [$cflist curselection]
    if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
	# show everything
	$ctext tag conf Comments -elide 0
	foreach f $treediffs($currentid) {
	    $ctext tag conf "f:$f" -elide 0
	}
    } else {
	# just show selected files
	$ctext tag conf Comments -elide 1
	set i 1
	foreach f $treediffs($currentid) {
	    set elide [expr {[lsearch -exact $sel $i] < 0}]
	    $ctext tag conf "f:$f" -elide $elide
	    incr i
	}
    }
}
 
if {![getcommits $revtreeargs]} {
    exit 1
}
 
set linespc [font metrics $mainfont -linespace]
set charspc [font measure $mainfont "m"]
 
set canvy0 [expr 3 + 0.5 * $linespc]
set canvx0 [expr 3 + 0.5 * $linespc]
set namex [expr 45 * $charspc]
set datex [expr 75 * $charspc]
 
set stopped 0
makewindow
 
set start {}
foreach id $commits {
    if {$nchildren($id) == 0} {
	set start $id
	break
    }
}
if {$start != {}} {
    drawgraph $start
}