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