gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "${1+$@}"
   4
   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.
   9
  10 # CVS $Revision: 1.3 $
  11
  12 set datemode 0
  13 set boldnames 0
  14 set revtreeargs {}
  15
  16 foreach arg $argv {
  17     switch -regexp -- $arg {
  18         "^$" { }
  19         "^-d" { set datemode 1 }
  20         "^-b" { set boldnames 1 }
  21         "^-.*" {
  22             puts stderr "unrecognized option $arg"
  23             exit 1
  24         }
  25         default {
  26             lappend revtreeargs $arg
  27         }
  28     }
  29 }
  30
  31 proc getcommits {rargs} {
  32     global commits parents cdate nparents children nchildren
  33     if {$rargs == {}} {
  34         set rargs HEAD
  35     }
  36     set commits {}
  37     foreach c [split [eval exec git-rev-tree $rargs] "\n"] {
  38         set i 0
  39         set cid {}
  40         foreach f $c {
  41             if {$i == 0} {
  42                 set d $f
  43             } else {
  44                 set id [lindex [split $f :] 0]
  45                 if {![info exists nchildren($id)]} {
  46                     set children($id) {}
  47                     set nchildren($id) 0
  48                 }
  49                 if {$i == 1} {
  50                     set cid $id
  51                     lappend commits $id
  52                     set parents($id) {}
  53                     set cdate($id) $d
  54                     set nparents($id) 0
  55                 } else {
  56                     lappend parents($cid) $id
  57                     incr nparents($cid)
  58                     incr nchildren($id)
  59                     lappend children($id) $cid
  60                 }
  61             }
  62             incr i
  63         }
  64     }
  65 }
  66
  67 proc readcommit {id} {
  68     global commitinfo commitsummary
  69     set inhdr 1
  70     set comment {}
  71     set headline {}
  72     set auname {}
  73     set audate {}
  74     set comname {}
  75     set comdate {}
  76     foreach line [split [exec git-cat-file commit $id] "\n"] {
  77         if {$inhdr} {
  78             if {$line == {}} {
  79                 set inhdr 0
  80             } else {
  81                 set tag [lindex $line 0]
  82                 if {$tag == "author"} {
  83                     set x [expr {[llength $line] - 2}]
  84                     set audate [lindex $line $x]
  85                     set auname [lrange $line 1 [expr {$x - 1}]]
  86                 } elseif {$tag == "committer"} {
  87                     set x [expr {[llength $line] - 2}]
  88                     set comdate [lindex $line $x]
  89                     set comname [lrange $line 1 [expr {$x - 1}]]
  90                 }
  91             }
  92         } else {
  93             if {$comment == {}} {
  94                 set headline $line
  95             } else {
  96                 append comment "\n"
  97             }
  98             append comment $line
  99         }
 100     }
 101     if {$audate != {}} {
 102         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 103     }
 104     if {$comdate != {}} {
 105         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 106     }
 107     set commitinfo($id) [list $comment $auname $audate $comname $comdate]
 108     set commitsummary($id) [list $headline $auname $audate]
 109 }
 110
 111 proc gettreediffs {id} {
 112     global treediffs parents
 113     set p [lindex $parents($id) 0]
 114     set diff {}
 115     foreach line [split [exec git-diff-tree -r $p $id] "\n"] {
 116         set type [lindex $line 1]
 117         set file [lindex $line 3]
 118         if {$type == "blob"} {
 119             lappend diff $file
 120         }
 121     }
 122     set treediffs($id) $diff
 123 }
 124
 125 proc makewindow {} {
 126     global canv linespc charspc ctext cflist
 127     panedwindow .ctop -orient vertical
 128     frame .ctop.clist
 129     set canv .ctop.clist.canv
 130     canvas $canv -height [expr 30 * $linespc + 4] -width [expr 90 * $charspc] \
 131         -bg white -relief sunk -bd 1 \
 132         -yscrollincr $linespc -yscrollcommand ".ctop.clist.csb set"
 133     scrollbar .ctop.clist.csb -command "$canv yview" -highlightthickness 0
 134     pack .ctop.clist.csb -side right -fill y
 135     pack $canv -side bottom -fill both -expand 1
 136     .ctop add .ctop.clist
 137     #pack .ctop.clist -side top -fill both -expand 1
 138     panedwindow .ctop.cdet -orient horizontal
 139     .ctop add .ctop.cdet
 140     set ctext .ctop.cdet.ctext
 141     text $ctext -bg white -state disabled
 142     .ctop.cdet add $ctext
 143     #pack $ctext -side top -fill x -expand 1
 144     set cflist .ctop.cdet.cfiles
 145     listbox $cflist -width 30 -bg white
 146     .ctop.cdet add $cflist
 147     pack .ctop -side top -fill both -expand 1
 148
 149     bind $canv <1> {selcanvline %x %y}
 150     bind $canv <B1-Motion> {selcanvline %x %y}
 151     bind $canv <ButtonRelease-4> "$canv yview scroll -5 u"
 152     bind $canv <ButtonRelease-5> "$canv yview scroll 5 u"
 153     bind $canv <2> "$canv scan mark 0 %y"
 154     bind $canv <B2-Motion> "$canv scan dragto 0 %y"
 155     bind . <Key-Prior> "$canv yview scroll -1 p"
 156     bind . <Key-Next> "$canv yview scroll 1 p"
 157     bind . <Key-Delete> "$canv yview scroll -1 p"
 158     bind . <Key-BackSpace> "$canv yview scroll -1 p"
 159     bind . <Key-space> "$canv yview scroll 1 p"
 160     bind . <Key-Up> "selnextline -1"
 161     bind . <Key-Down> "selnextline 1"
 162     bind . Q "set stopped 1; destroy ."
 163 }
 164
 165 proc truncatetofit {str width font} {
 166     if {[font measure $font $str] <= $width} {
 167         return $str
 168     }
 169     set best 0
 170     set bad [string length $str]
 171     set tmp $str
 172     while {$best < $bad - 1} {
 173         set try [expr {int(($best + $bad) / 2)}]
 174         set tmp "[string range $str 0 [expr $try-1]]..."
 175         if {[font measure $font $tmp] <= $width} {
 176             set best $try
 177         } else {
 178             set bad $try
 179         }
 180     }
 181     return $tmp
 182 }
 183
 184 proc drawgraph {start} {
 185     global parents children nparents nchildren commits
 186     global canv mainfont namefont canvx0 canvy0 canvy linespc namex datex
 187     global datemode cdate
 188     global lineid linehtag linentag linedtag commitsummary
 189
 190     set colors {green red blue magenta darkgrey brown orange}
 191     set ncolors [llength $colors]
 192     set nextcolor 0
 193     set colormap($start) [lindex $colors 0]
 194     foreach id $commits {
 195         set ncleft($id) $nchildren($id)
 196     }
 197     set todo [list $start]
 198     set level 0
 199     set canvy $canvy0
 200     set linestarty(0) $canvy
 201     set nullentry -1
 202     set lineno -1
 203     while 1 {
 204         incr lineno
 205         set nlines [llength $todo]
 206         set id [lindex $todo $level]
 207         set lineid($lineno) $id
 208         set actualparents {}
 209         foreach p $parents($id) {
 210             if {[info exists ncleft($p)]} {
 211                 incr ncleft($p) -1
 212                 lappend actualparents $p
 213             }
 214         }
 215         if {![info exists commitsummary($id)]} {
 216             readcommit $id
 217         }
 218         set x [expr $canvx0 + $level * $linespc]
 219         set y2 [expr $canvy + $linespc]
 220         if {$linestarty($level) < $canvy} {
 221             set t [$canv create line $x $linestarty($level) $x $canvy \
 222                        -width 2 -fill $colormap($id)]
 223             $canv lower $t
 224             set linestarty($level) $canvy
 225         }
 226         set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
 227                    [expr $x + 3] [expr $canvy + 3] \
 228                    -fill blue -outline black -width 1]
 229         $canv raise $t
 230         set xt [expr $canvx0 + $nlines * $linespc]
 231         set headline [lindex $commitsummary($id) 0]
 232         set name [lindex $commitsummary($id) 1]
 233         set date [lindex $commitsummary($id) 2]
 234         set headline [truncatetofit $headline [expr $namex-$xt-$linespc] \
 235                          $mainfont]
 236         set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
 237                                    -text $headline -font $mainfont ]
 238         set name [truncatetofit $name [expr $datex-$namex-$linespc] $namefont]
 239         set linentag($lineno) [$canv create text $namex $canvy -anchor w \
 240                                    -text $name -font $namefont]
 241         set linedtag($lineno) [$canv create text $datex $canvy -anchor w \
 242                                  -text $date -font $mainfont]
 243         if {!$datemode && [llength $actualparents] == 1} {
 244             set p [lindex $actualparents 0]
 245             if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
 246                 set todo [lreplace $todo $level $level $p]
 247                 set colormap($p) $colormap($id)
 248                 set canvy $y2
 249                 $canv conf -scrollregion [list 0 0 0 $canvy]
 250                 update
 251                 continue
 252             }
 253         }
 254
 255         set oldtodo $todo
 256         set oldlevel $level
 257         set lines {}
 258         for {set i 0} {$i < $nlines} {incr i} {
 259             if {[lindex $todo $i] == {}} continue
 260             set oldstarty($i) $linestarty($i)
 261             if {$i != $level} {
 262                 lappend lines [list $i [lindex $todo $i]]
 263             }
 264         }
 265         unset linestarty
 266         if {$nullentry >= 0} {
 267             set todo [lreplace $todo $nullentry $nullentry]
 268             if {$nullentry < $level} {
 269                 incr level -1
 270             }
 271         }
 272
 273         set badcolors [list $colormap($id)]
 274         foreach p $actualparents {
 275             if {[info exists colormap($p)]} {
 276                 lappend badcolors $colormap($p)
 277             }
 278         }
 279         set todo [lreplace $todo $level $level]
 280         if {$nullentry > $level} {
 281             incr nullentry -1
 282         }
 283         set i $level
 284         foreach p $actualparents {
 285             set k [lsearch -exact $todo $p]
 286             if {$k < 0} {
 287                 set todo [linsert $todo $i $p]
 288                 if {$nullentry >= $i} {
 289                     incr nullentry
 290                 }
 291                 if {$nparents($id) == 1 && $nparents($p) == 1
 292                     && $nchildren($p) == 1} {
 293                     set colormap($p) $colormap($id)
 294                 } else {
 295                     for {set j 0} {$j <= $ncolors} {incr j} {
 296                         if {[incr nextcolor] >= $ncolors} {
 297                             set nextcolor 0
 298                         }
 299                         set c [lindex $colors $nextcolor]
 300                         # make sure the incoming and outgoing colors differ
 301                         if {[lsearch -exact $badcolors $c] < 0} break
 302                     }
 303                     set colormap($p) $c
 304                     lappend badcolors $c
 305                 }
 306             }
 307             lappend lines [list $oldlevel $p]
 308         }
 309
 310         # choose which one to do next time around
 311         set todol [llength $todo]
 312         set level -1
 313         set latest {}
 314         for {set k $todol} {[incr k -1] >= 0} {} {
 315             set p [lindex $todo $k]
 316             if {$p == {}} continue
 317             if {$ncleft($p) == 0} {
 318                 if {$datemode} {
 319                     if {$latest == {} || $cdate($p) > $latest} {
 320                         set level $k
 321                         set latest $cdate($p)
 322                     }
 323                 } else {
 324                     set level $k
 325                     break
 326                 }
 327             }
 328         }
 329         if {$level < 0} {
 330             if {$todo != {}} {
 331                 puts "ERROR: none of the pending commits can be done yet:"
 332                 foreach p $todo {
 333                     puts "  $p"
 334                 }
 335             }
 336             break
 337         }
 338
 339         # If we are reducing, put in a null entry
 340         if {$todol < $nlines} {
 341             if {$nullentry >= 0} {
 342                 set i $nullentry
 343                 while {$i < $todol
 344                        && [lindex $oldtodo $i] == [lindex $todo $i]} {
 345                     incr i
 346                 }
 347             } else {
 348                 set i $oldlevel
 349                 if {$level >= $i} {
 350                     incr i
 351                 }
 352             }
 353             if {$i >= $todol} {
 354                 set nullentry -1
 355             } else {
 356                 set nullentry $i
 357                 set todo [linsert $todo $nullentry {}]
 358                 if {$level >= $i} {
 359                     incr level
 360                 }
 361             }
 362         } else {
 363             set nullentry -1
 364         }
 365
 366         foreach l $lines {
 367             set i [lindex $l 0]
 368             set dst [lindex $l 1]
 369             set j [lsearch -exact $todo $dst]
 370             if {$i == $j} {
 371                 set linestarty($i) $oldstarty($i)
 372                 continue
 373             }
 374             set xi [expr {$canvx0 + $i * $linespc}]
 375             set xj [expr {$canvx0 + $j * $linespc}]
 376             set coords {}
 377             if {$oldstarty($i) < $canvy} {
 378                 lappend coords $xi $oldstarty($i)
 379             }
 380             lappend coords $xi $canvy
 381             if {$j < $i - 1} {
 382                 lappend coords [expr $xj + $linespc] $canvy
 383             } elseif {$j > $i + 1} {
 384                 lappend coords [expr $xj - $linespc] $canvy
 385             }
 386             lappend coords $xj $y2
 387             set t [$canv create line $coords -width 2 -fill $colormap($dst)]
 388             $canv lower $t
 389             if {![info exists linestarty($j)]} {
 390                 set linestarty($j) $y2
 391             }
 392         }
 393         set canvy $y2
 394         $canv conf -scrollregion [list 0 0 0 $canvy]
 395         update
 396     }
 397 }
 398
 399 proc selcanvline {x y} {
 400     global canv canvy0 ctext linespc selectedline
 401     global lineid linehtag linentag linedtag commitinfo
 402     set ymax [lindex [$canv cget -scrollregion] 3]
 403     set yfrac [lindex [$canv yview] 0]
 404     set y [expr {$y + $yfrac * $ymax}]
 405     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
 406     if {$l < 0} {
 407         set l 0
 408     }
 409     if {[info exists selectedline] && $selectedline == $l} return
 410     selectline $l
 411 }
 412
 413 proc selectline {l} {
 414     global canv ctext commitinfo selectedline lineid linehtag
 415     global canvy canvy0 linespc nparents
 416     global cflist treediffs
 417     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
 418     $canv select clear
 419     $canv select from $linehtag($l) 0
 420     $canv select to $linehtag($l) end
 421     set y [expr {$canvy0 + $l * $linespc}]
 422     set ytop [expr {($y - $linespc / 2.0) / $canvy}]
 423     set ybot [expr {($y + $linespc / 2.0) / $canvy}]
 424     set wnow [$canv yview]
 425     if {$ytop < [lindex $wnow 0]} {
 426         $canv yview moveto $ytop
 427     } elseif {$ybot > [lindex $wnow 1]} {
 428         set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
 429         $canv yview moveto [expr {$ybot - $wh}]
 430     }
 431     set selectedline $l
 432
 433     set id $lineid($l)
 434     $ctext conf -state normal
 435     $ctext delete 0.0 end
 436     set info $commitinfo($id)
 437     $ctext insert end "Author: [lindex $info 1]  \t[lindex $info 2]\n"
 438     $ctext insert end "Committer: [lindex $info 3]  \t[lindex $info 4]\n"
 439     $ctext insert end "\n"
 440     $ctext insert end [lindex $info 0]
 441     $ctext conf -state disabled
 442
 443     $cflist delete 0 end
 444     if {$nparents($id) == 1} {
 445         if {![info exists treediffs($id)]} {
 446             gettreediffs $id
 447         }
 448         foreach f $treediffs($id) {
 449             $cflist insert end $f
 450         }
 451     }
 452
 453 }
 454
 455 proc selnextline {dir} {
 456     global selectedline
 457     if {![info exists selectedline]} return
 458     set l [expr $selectedline + $dir]
 459     selectline $l
 460 }
 461
 462 getcommits $revtreeargs
 463
 464 set mainfont {Helvetica 9}
 465 set namefont $mainfont
 466 if {$boldnames} {
 467     lappend namefont bold
 468 }
 469 set linespc [font metrics $mainfont -linespace]
 470 set charspc [font measure $mainfont "m"]
 471
 472 set canvy0 [expr 3 + 0.5 * $linespc]
 473 set canvx0 [expr 3 + 0.5 * $linespc]
 474 set namex [expr 45 * $charspc]
 475 set datex [expr 75 * $charspc]
 476
 477 makewindow
 478
 479 set start {}
 480 foreach id $commits {
 481     if {$nchildren($id) == 0} {
 482         set start $id
 483         break
 484     }
 485 }
 486 if {$start != {}} {
 487     drawgraph $start
 488 }