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