git.oblomov.eu Git - git/blob - 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.2 $
  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 makewindow {} {
 112     global canv linespc charspc ctext
 113     panedwindow .ctop -orient vertical
 114     frame .ctop.clist
 115     set canv .ctop.clist.canv
 116     canvas $canv -height [expr 30 * $linespc + 4] -width [expr 90 * $charspc] \
 117         -bg white -relief sunk -bd 1 \
 118         -yscrollincr $linespc -yscrollcommand ".ctop.clist.csb set"
 119     scrollbar .ctop.clist.csb -command "$canv yview" -highlightthickness 0
 120     pack .ctop.clist.csb -side right -fill y
 121     pack $canv -side bottom -fill both -expand 1
 122     .ctop add .ctop.clist
 123     #pack .ctop.clist -side top -fill both -expand 1
 124     set ctext .ctop.ctext
 125     text $ctext -bg white
 126     .ctop add .ctop.ctext
 127     #pack $ctext -side top -fill x -expand 1
 128     pack .ctop -side top -fill both -expand 1
 129
 130     bind $canv <1> {selcanvline %x %y}
 131     bind $canv <B1-Motion> {selcanvline %x %y}
 132     bind $canv <ButtonRelease-4> "$canv yview scroll -5 u"
 133     bind $canv <ButtonRelease-5> "$canv yview scroll 5 u"
 134     bind $canv <2> "$canv scan mark 0 %y"
 135     bind $canv <B2-Motion> "$canv scan dragto 0 %y"
 136     bind . <Key-Prior> "$canv yview scroll -1 p"
 137     bind . <Key-Next> "$canv yview scroll 1 p"
 138     bind . <Key-Delete> "$canv yview scroll -1 p"
 139     bind . <Key-BackSpace> "$canv yview scroll -1 p"
 140     bind . <Key-space> "$canv yview scroll 1 p"
 141     bind . <Key-Up> "$canv yview scroll -1 u"
 142     bind . <Key-Down> "$canv yview scroll 1 u"
 143     bind . Q "set stopped 1; destroy ."
 144 }
 145
 146 proc truncatetofit {str width font} {
 147     if {[font measure $font $str] <= $width} {
 148         return $str
 149     }
 150     set best 0
 151     set bad [string length $str]
 152     set tmp $str
 153     while {$best < $bad - 1} {
 154         set try [expr {int(($best + $bad) / 2)}]
 155         set tmp "[string range $str 0 [expr $try-1]]..."
 156         if {[font measure $font $tmp] <= $width} {
 157             set best $try
 158         } else {
 159             set bad $try
 160         }
 161     }
 162     return $tmp
 163 }
 164
 165 proc drawgraph {start} {
 166     global parents children nparents nchildren commits
 167     global canv mainfont namefont canvx0 canvy0 linespc namex datex
 168     global datemode cdate
 169     global lineid linehtag linentag linedtag commitsummary
 170
 171     set colors {green red blue magenta darkgrey brown orange}
 172     set ncolors [llength $colors]
 173     set nextcolor 0
 174     set colormap($start) [lindex $colors 0]
 175     foreach id $commits {
 176         set ncleft($id) $nchildren($id)
 177     }
 178     set todo [list $start]
 179     set level 0
 180     set canvy $canvy0
 181     set linestarty(0) $canvy
 182     set nullentry -1
 183     set lineno -1
 184     while 1 {
 185         incr lineno
 186         set nlines [llength $todo]
 187         set id [lindex $todo $level]
 188         set lineid($lineno) $id
 189         set actualparents {}
 190         foreach p $parents($id) {
 191             if {[info exists ncleft($p)]} {
 192                 incr ncleft($p) -1
 193                 lappend actualparents $p
 194             }
 195         }
 196         if {![info exists commitsummary($id)]} {
 197             readcommit $id
 198         }
 199         set x [expr $canvx0 + $level * $linespc]
 200         set y2 [expr $canvy + $linespc]
 201         if {$linestarty($level) < $canvy} {
 202             set t [$canv create line $x $linestarty($level) $x $canvy \
 203                        -width 2 -fill $colormap($id)]
 204             $canv lower $t
 205             set linestarty($level) $canvy
 206         }
 207         set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
 208                    [expr $x + 3] [expr $canvy + 3] \
 209                    -fill blue -outline black -width 1]
 210         $canv raise $t
 211         set xt [expr $canvx0 + $nlines * $linespc]
 212         set headline [lindex $commitsummary($id) 0]
 213         set name [lindex $commitsummary($id) 1]
 214         set date [lindex $commitsummary($id) 2]
 215         set headline [truncatetofit $headline [expr $namex-$xt-$linespc] \
 216                          $mainfont]
 217         set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
 218                                    -text $headline -font $mainfont ]
 219         set name [truncatetofit $name [expr $datex-$namex-$linespc] $namefont]
 220         set linentag($lineno) [$canv create text $namex $canvy -anchor w \
 221                                    -text $name -font $namefont]
 222         set linedtag($lineno) [$canv create text $datex $canvy -anchor w \
 223                                  -text $date -font $mainfont]
 224         if {!$datemode && [llength $actualparents] == 1} {
 225             set p [lindex $actualparents 0]
 226             if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
 227                 set todo [lreplace $todo $level $level $p]
 228                 set colormap($p) $colormap($id)
 229                 set canvy $y2
 230                 $canv conf -scrollregion [list 0 0 0 $canvy]
 231                 update
 232                 continue
 233             }
 234         }
 235
 236         set oldtodo $todo
 237         set oldlevel $level
 238         set lines {}
 239         for {set i 0} {$i < $nlines} {incr i} {
 240             if {[lindex $todo $i] == {}} continue
 241             set oldstarty($i) $linestarty($i)
 242             if {$i != $level} {
 243                 lappend lines [list $i [lindex $todo $i]]
 244             }
 245         }
 246         unset linestarty
 247         if {$nullentry >= 0} {
 248             set todo [lreplace $todo $nullentry $nullentry]
 249             if {$nullentry < $level} {
 250                 incr level -1
 251             }
 252         }
 253
 254         set badcolors [list $colormap($id)]
 255         foreach p $actualparents {
 256             if {[info exists colormap($p)]} {
 257                 lappend badcolors $colormap($p)
 258             }
 259         }
 260         set todo [lreplace $todo $level $level]
 261         if {$nullentry > $level} {
 262             incr nullentry -1
 263         }
 264         set i $level
 265         foreach p $actualparents {
 266             set k [lsearch -exact $todo $p]
 267             if {$k < 0} {
 268                 set todo [linsert $todo $i $p]
 269                 if {$nullentry >= $i} {
 270                     incr nullentry
 271                 }
 272                 if {$nparents($id) == 1 && $nparents($p) == 1
 273                     && $nchildren($p) == 1} {
 274                     set colormap($p) $colormap($id)
 275                 } else {
 276                     for {set j 0} {$j <= $ncolors} {incr j} {
 277                         if {[incr nextcolor] >= $ncolors} {
 278                             set nextcolor 0
 279                         }
 280                         set c [lindex $colors $nextcolor]
 281                         # make sure the incoming and outgoing colors differ
 282                         if {[lsearch -exact $badcolors $c] < 0} break
 283                     }
 284                     set colormap($p) $c
 285                     lappend badcolors $c
 286                 }
 287             }
 288             lappend lines [list $oldlevel $p]
 289         }
 290
 291         # choose which one to do next time around
 292         set todol [llength $todo]
 293         set level -1
 294         set latest {}
 295         for {set k $todol} {[incr k -1] >= 0} {} {
 296             set p [lindex $todo $k]
 297             if {$p == {}} continue
 298             if {$ncleft($p) == 0} {
 299                 if {$datemode} {
 300                     if {$latest == {} || $cdate($p) > $latest} {
 301                         set level $k
 302                         set latest $cdate($p)
 303                     }
 304                 } else {
 305                     set level $k
 306                     break
 307                 }
 308             }
 309         }
 310         if {$level < 0} {
 311             if {$todo != {}} {
 312                 puts "ERROR: none of the pending commits can be done yet:"
 313                 foreach p $todo {
 314                     puts "  $p"
 315                 }
 316             }
 317             break
 318         }
 319
 320         # If we are reducing, put in a null entry
 321         if {$todol < $nlines} {
 322             if {$nullentry >= 0} {
 323                 set i $nullentry
 324                 while {$i < $todol
 325                        && [lindex $oldtodo $i] == [lindex $todo $i]} {
 326                     incr i
 327                 }
 328             } else {
 329                 set i $oldlevel
 330                 if {$level >= $i} {
 331                     incr i
 332                 }
 333             }
 334             if {$i >= $todol} {
 335                 set nullentry -1
 336             } else {
 337                 set nullentry $i
 338                 set todo [linsert $todo $nullentry {}]
 339                 if {$level >= $i} {
 340                     incr level
 341                 }
 342             }
 343         } else {
 344             set nullentry -1
 345         }
 346
 347         foreach l $lines {
 348             set i [lindex $l 0]
 349             set dst [lindex $l 1]
 350             set j [lsearch -exact $todo $dst]
 351             if {$i == $j} {
 352                 set linestarty($i) $oldstarty($i)
 353                 continue
 354             }
 355             set xi [expr {$canvx0 + $i * $linespc}]
 356             set xj [expr {$canvx0 + $j * $linespc}]
 357             set coords {}
 358             if {$oldstarty($i) < $canvy} {
 359                 lappend coords $xi $oldstarty($i)
 360             }
 361             lappend coords $xi $canvy
 362             if {$j < $i - 1} {
 363                 lappend coords [expr $xj + $linespc] $canvy
 364             } elseif {$j > $i + 1} {
 365                 lappend coords [expr $xj - $linespc] $canvy
 366             }
 367             lappend coords $xj $y2
 368             set t [$canv create line $coords -width 2 -fill $colormap($dst)]
 369             $canv lower $t
 370             if {![info exists linestarty($j)]} {
 371                 set linestarty($j) $y2
 372             }
 373         }
 374         set canvy $y2
 375         $canv conf -scrollregion [list 0 0 0 $canvy]
 376         update
 377     }
 378 }
 379
 380 proc selcanvline {x y} {
 381     global canv canvy0 ctext linespc selectedline
 382     global lineid linehtag linentag linedtag commitinfo
 383     set ymax [lindex [$canv cget -scrollregion] 3]
 384     set yfrac [lindex [$canv yview] 0]
 385     set y [expr {$y + $yfrac * $ymax}]
 386     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
 387     if {$l < 0} {
 388         set l 0
 389     }
 390     if {[info exists selectedline] && $selectedline == $l} return
 391     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
 392     $canv select clear
 393     $canv select from $linehtag($l) 0
 394     $canv select to $linehtag($l) end
 395     set id $lineid($l)
 396     $ctext delete 0.0 end
 397     set info $commitinfo($id)
 398     $ctext insert end "Author: [lindex $info 1]  \t[lindex $info 2]\n"
 399     $ctext insert end "Committer: [lindex $info 3]  \t[lindex $info 4]\n"
 400     $ctext insert end "\n"
 401     $ctext insert end [lindex $info 0]
 402 }
 403
 404 getcommits $revtreeargs
 405
 406 set mainfont {Helvetica 9}
 407 set namefont $mainfont
 408 if {$boldnames} {
 409     lappend namefont bold
 410 }
 411 set linespc [font metrics $mainfont -linespace]
 412 set charspc [font measure $mainfont "m"]
 413
 414 set canvy0 [expr 3 + 0.5 * $linespc]
 415 set canvx0 [expr 3 + 0.5 * $linespc]
 416 set namex [expr 45 * $charspc]
 417 set datex [expr 75 * $charspc]
 418
 419 makewindow
 420
 421 set start {}
 422 foreach id $commits {
 423     if {$nchildren($id) == 0} {
 424         set start $id
 425         break
 426     }
 427 }
 428 if {$start != {}} {
 429     drawgraph $start
 430 }