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.5 $
  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 makewindow {} {
 119     global canv canv2 canv3 linespc charspc ctext cflist
 120     panedwindow .ctop -orient vertical
 121     panedwindow .ctop.clist -orient horizontal -sashpad 0 -handlesize 4
 122     .ctop add .ctop.clist
 123     set canv .ctop.clist.canv
 124     set cscroll .ctop.clist.dates.csb
 125     canvas $canv -height [expr 30 * $linespc + 4] -width [expr 45 * $charspc] \
 126         -bg white -bd 0 \
 127         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 128     .ctop.clist add $canv
 129     set canv2 .ctop.clist.canv2
 130     canvas $canv2 -height [expr 30 * $linespc +4] -width [expr 30 * $charspc] \
 131         -bg white -bd 0 -yscrollincr $linespc
 132     .ctop.clist add $canv2
 133     frame .ctop.clist.dates
 134     .ctop.clist add .ctop.clist.dates
 135     set canv3 .ctop.clist.dates.canv3
 136     canvas $canv3 -height [expr 30 * $linespc +4] -width [expr 15 * $charspc] \
 137         -bg white -bd 0 -yscrollincr $linespc
 138     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 139     pack .ctop.clist.dates.csb -side right -fill y
 140     pack $canv3 -side left -fill both -expand 1
 141
 142     panedwindow .ctop.cdet -orient horizontal
 143     .ctop add .ctop.cdet
 144     frame .ctop.cdet.left
 145     set ctext .ctop.cdet.left.ctext
 146     text $ctext -bg white -state disabled \
 147         -yscrollcommand ".ctop.cdet.left.sb set"
 148     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 149     pack .ctop.cdet.left.sb -side right -fill y
 150     pack $ctext -side left -fill both -expand 1
 151     .ctop.cdet add .ctop.cdet.left
 152
 153     frame .ctop.cdet.right
 154     set cflist .ctop.cdet.right.cfiles
 155     listbox $cflist -width 30 -bg white \
 156         -yscrollcommand ".ctop.cdet.right.sb set"
 157     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 158     pack .ctop.cdet.right.sb -side right -fill y
 159     pack $cflist -side left -fill both -expand 1
 160     .ctop.cdet add .ctop.cdet.right
 161
 162     pack .ctop -side top -fill both -expand 1
 163
 164     bindall <1> {selcanvline %x %y}
 165     bindall <B1-Motion> {selcanvline %x %y}
 166     bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
 167     bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
 168     bindall <2> "allcanvs scan mark 0 %y"
 169     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 170     bind . <Key-Prior> "allcanvs yview scroll -1 p"
 171     bind . <Key-Next> "allcanvs yview scroll 1 p"
 172     bind . <Key-Delete> "allcanvs yview scroll -1 p"
 173     bind . <Key-BackSpace> "allcanvs yview scroll -1 p"
 174     bind . <Key-space> "allcanvs yview scroll 1 p"
 175     bind . <Key-Up> "selnextline -1"
 176     bind . <Key-Down> "selnextline 1"
 177     bind . Q "set stopped 1; destroy ."
 178 }
 179
 180 proc allcanvs args {
 181     global canv canv2 canv3
 182     eval $canv $args
 183     eval $canv2 $args
 184     eval $canv3 $args
 185 }
 186
 187 proc bindall {event action} {
 188     global canv canv2 canv3
 189     bind $canv $event $action
 190     bind $canv2 $event $action
 191     bind $canv3 $event $action
 192 }
 193
 194 proc truncatetofit {str width font} {
 195     if {[font measure $font $str] <= $width} {
 196         return $str
 197     }
 198     set best 0
 199     set bad [string length $str]
 200     set tmp $str
 201     while {$best < $bad - 1} {
 202         set try [expr {int(($best + $bad) / 2)}]
 203         set tmp "[string range $str 0 [expr $try-1]]..."
 204         if {[font measure $font $tmp] <= $width} {
 205             set best $try
 206         } else {
 207             set bad $try
 208         }
 209     }
 210     return $tmp
 211 }
 212
 213 proc drawgraph {start} {
 214     global parents children nparents nchildren commits
 215     global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
 216     global datemode cdate
 217     global lineid linehtag linentag linedtag commitsummary
 218
 219     set colors {green red blue magenta darkgrey brown orange}
 220     set ncolors [llength $colors]
 221     set nextcolor 0
 222     set colormap($start) [lindex $colors 0]
 223     foreach id $commits {
 224         set ncleft($id) $nchildren($id)
 225     }
 226     set todo [list $start]
 227     set level 0
 228     set y2 $canvy0
 229     set linestarty(0) $canvy0
 230     set nullentry -1
 231     set lineno -1
 232     while 1 {
 233         set canvy $y2
 234         allcanvs conf -scrollregion [list 0 0 0 $canvy]
 235         update
 236         incr lineno
 237         set nlines [llength $todo]
 238         set id [lindex $todo $level]
 239         set lineid($lineno) $id
 240         set actualparents {}
 241         foreach p $parents($id) {
 242             if {[info exists ncleft($p)]} {
 243                 incr ncleft($p) -1
 244                 lappend actualparents $p
 245             }
 246         }
 247         if {![info exists commitsummary($id)]} {
 248             readcommit $id
 249         }
 250         set x [expr $canvx0 + $level * $linespc]
 251         set y2 [expr $canvy + $linespc]
 252         if {$linestarty($level) < $canvy} {
 253             set t [$canv create line $x $linestarty($level) $x $canvy \
 254                        -width 2 -fill $colormap($id)]
 255             $canv lower $t
 256             set linestarty($level) $canvy
 257         }
 258         set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
 259                    [expr $x + 3] [expr $canvy + 3] \
 260                    -fill blue -outline black -width 1]
 261         $canv raise $t
 262         set xt [expr $canvx0 + $nlines * $linespc]
 263         set headline [lindex $commitsummary($id) 0]
 264         set name [lindex $commitsummary($id) 1]
 265         set date [lindex $commitsummary($id) 2]
 266         set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
 267                                    -text $headline -font $mainfont ]
 268         set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
 269                                    -text $name -font $namefont]
 270         set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
 271                                  -text $date -font $mainfont]
 272         if {!$datemode && [llength $actualparents] == 1} {
 273             set p [lindex $actualparents 0]
 274             if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
 275                 set todo [lreplace $todo $level $level $p]
 276                 set colormap($p) $colormap($id)
 277                 continue
 278             }
 279         }
 280
 281         set oldtodo $todo
 282         set oldlevel $level
 283         set lines {}
 284         for {set i 0} {$i < $nlines} {incr i} {
 285             if {[lindex $todo $i] == {}} continue
 286             set oldstarty($i) $linestarty($i)
 287             if {$i != $level} {
 288                 lappend lines [list $i [lindex $todo $i]]
 289             }
 290         }
 291         unset linestarty
 292         if {$nullentry >= 0} {
 293             set todo [lreplace $todo $nullentry $nullentry]
 294             if {$nullentry < $level} {
 295                 incr level -1
 296             }
 297         }
 298
 299         set badcolors [list $colormap($id)]
 300         foreach p $actualparents {
 301             if {[info exists colormap($p)]} {
 302                 lappend badcolors $colormap($p)
 303             }
 304         }
 305         set todo [lreplace $todo $level $level]
 306         if {$nullentry > $level} {
 307             incr nullentry -1
 308         }
 309         set i $level
 310         foreach p $actualparents {
 311             set k [lsearch -exact $todo $p]
 312             if {$k < 0} {
 313                 set todo [linsert $todo $i $p]
 314                 if {$nullentry >= $i} {
 315                     incr nullentry
 316                 }
 317                 if {$nparents($id) == 1 && $nparents($p) == 1
 318                     && $nchildren($p) == 1} {
 319                     set colormap($p) $colormap($id)
 320                 } else {
 321                     for {set j 0} {$j <= $ncolors} {incr j} {
 322                         if {[incr nextcolor] >= $ncolors} {
 323                             set nextcolor 0
 324                         }
 325                         set c [lindex $colors $nextcolor]
 326                         # make sure the incoming and outgoing colors differ
 327                         if {[lsearch -exact $badcolors $c] < 0} break
 328                     }
 329                     set colormap($p) $c
 330                     lappend badcolors $c
 331                 }
 332             }
 333             lappend lines [list $oldlevel $p]
 334         }
 335
 336         # choose which one to do next time around
 337         set todol [llength $todo]
 338         set level -1
 339         set latest {}
 340         for {set k $todol} {[incr k -1] >= 0} {} {
 341             set p [lindex $todo $k]
 342             if {$p == {}} continue
 343             if {$ncleft($p) == 0} {
 344                 if {$datemode} {
 345                     if {$latest == {} || $cdate($p) > $latest} {
 346                         set level $k
 347                         set latest $cdate($p)
 348                     }
 349                 } else {
 350                     set level $k
 351                     break
 352                 }
 353             }
 354         }
 355         if {$level < 0} {
 356             if {$todo != {}} {
 357                 puts "ERROR: none of the pending commits can be done yet:"
 358                 foreach p $todo {
 359                     puts "  $p"
 360                 }
 361             }
 362             break
 363         }
 364
 365         # If we are reducing, put in a null entry
 366         if {$todol < $nlines} {
 367             if {$nullentry >= 0} {
 368                 set i $nullentry
 369                 while {$i < $todol
 370                        && [lindex $oldtodo $i] == [lindex $todo $i]} {
 371                     incr i
 372                 }
 373             } else {
 374                 set i $oldlevel
 375                 if {$level >= $i} {
 376                     incr i
 377                 }
 378             }
 379             if {$i >= $todol} {
 380                 set nullentry -1
 381             } else {
 382                 set nullentry $i
 383                 set todo [linsert $todo $nullentry {}]
 384                 if {$level >= $i} {
 385                     incr level
 386                 }
 387             }
 388         } else {
 389             set nullentry -1
 390         }
 391
 392         foreach l $lines {
 393             set i [lindex $l 0]
 394             set dst [lindex $l 1]
 395             set j [lsearch -exact $todo $dst]
 396             if {$i == $j} {
 397                 set linestarty($i) $oldstarty($i)
 398                 continue
 399             }
 400             set xi [expr {$canvx0 + $i * $linespc}]
 401             set xj [expr {$canvx0 + $j * $linespc}]
 402             set coords {}
 403             if {$oldstarty($i) < $canvy} {
 404                 lappend coords $xi $oldstarty($i)
 405             }
 406             lappend coords $xi $canvy
 407             if {$j < $i - 1} {
 408                 lappend coords [expr $xj + $linespc] $canvy
 409             } elseif {$j > $i + 1} {
 410                 lappend coords [expr $xj - $linespc] $canvy
 411             }
 412             lappend coords $xj $y2
 413             set t [$canv create line $coords -width 2 -fill $colormap($dst)]
 414             $canv lower $t
 415             if {![info exists linestarty($j)]} {
 416                 set linestarty($j) $y2
 417             }
 418         }
 419     }
 420 }
 421
 422 proc selcanvline {x y} {
 423     global canv canvy0 ctext linespc selectedline
 424     global lineid linehtag linentag linedtag commitinfo
 425     set ymax [lindex [$canv cget -scrollregion] 3]
 426     set yfrac [lindex [$canv yview] 0]
 427     set y [expr {$y + $yfrac * $ymax}]
 428     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
 429     if {$l < 0} {
 430         set l 0
 431     }
 432     if {[info exists selectedline] && $selectedline == $l} return
 433     selectline $l
 434 }
 435
 436 proc selectline {l} {
 437     global canv canv2 canv3 ctext commitinfo selectedline
 438     global lineid linehtag linentag linedtag
 439     global canvy canvy0 linespc nparents treepending
 440     global cflist treediffs currentid
 441     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
 442     $canv delete secsel
 443     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
 444                -tags secsel -fill [$canv cget -selectbackground]]
 445     $canv lower $t
 446     $canv2 delete secsel
 447     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
 448                -tags secsel -fill [$canv2 cget -selectbackground]]
 449     $canv2 lower $t
 450     $canv3 delete secsel
 451     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
 452                -tags secsel -fill [$canv3 cget -selectbackground]]
 453     $canv3 lower $t
 454     set y [expr {$canvy0 + $l * $linespc}]
 455     set ytop [expr {($y - $linespc / 2.0) / $canvy}]
 456     set ybot [expr {($y + $linespc / 2.0) / $canvy}]
 457     set wnow [$canv yview]
 458     if {$ytop < [lindex $wnow 0]} {
 459         allcanvs yview moveto $ytop
 460     } elseif {$ybot > [lindex $wnow 1]} {
 461         set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
 462         allcanvs yview moveto [expr {$ybot - $wh}]
 463     }
 464     set selectedline $l
 465
 466     set id $lineid($l)
 467     $ctext conf -state normal
 468     $ctext delete 0.0 end
 469     set info $commitinfo($id)
 470     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
 471     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
 472     $ctext insert end "\n"
 473     $ctext insert end [lindex $info 0]
 474     $ctext conf -state disabled
 475
 476     $cflist delete 0 end
 477     set currentid $id
 478     if {$nparents($id) == 1} {
 479         if {![info exists treediffs($id)]} {
 480             if {![info exists treepending]} {
 481                 gettreediffs $id
 482             }
 483         } else {
 484             addtocflist $id
 485         }
 486     }
 487
 488 }
 489
 490 proc addtocflist {id} {
 491     global currentid treediffs cflist treepending
 492     if {$id != $currentid} {
 493         gettreediffs $currentid
 494         return
 495     }
 496     foreach f $treediffs($currentid) {
 497         $cflist insert end $f
 498     }
 499 }
 500
 501 proc gettreediffs {id} {
 502     global treediffs parents treepending
 503     set treepending $id
 504     set treediffs($id) {}
 505     set p [lindex $parents($id) 0]
 506     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
 507     fconfigure $gdtf -blocking 0
 508     fileevent $gdtf readable "gettreediffline $gdtf $id"
 509 }
 510
 511 proc gettreediffline {gdtf id} {
 512     global treediffs treepending
 513     set n [gets $gdtf line]
 514     if {$n < 0} {
 515         if {![eof $gdtf]} return
 516         close $gdtf
 517         unset treepending
 518         addtocflist $id
 519         return
 520     }
 521     set type [lindex $line 1]
 522     set file [lindex $line 3]
 523     if {$type == "blob"} {
 524         lappend treediffs($id) $file
 525     }
 526 }
 527
 528 proc selnextline {dir} {
 529     global selectedline
 530     if {![info exists selectedline]} return
 531     set l [expr $selectedline + $dir]
 532     selectline $l
 533 }
 534
 535 getcommits $revtreeargs
 536
 537 set linespc [font metrics $mainfont -linespace]
 538 set charspc [font measure $mainfont "m"]
 539
 540 set canvy0 [expr 3 + 0.5 * $linespc]
 541 set canvx0 [expr 3 + 0.5 * $linespc]
 542 set namex [expr 45 * $charspc]
 543 set datex [expr 75 * $charspc]
 544
 545 makewindow
 546
 547 set start {}
 548 foreach id $commits {
 549     if {$nchildren($id) == 0} {
 550         set start $id
 551         break
 552     }
 553 }
 554 if {$start != {}} {
 555     drawgraph $start
 556 }