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.13 $
  11
  12 proc getcommits {rargs} {
  13     global commits commfd phase canv mainfont
  14     if {$rargs == {}} {
  15         set rargs HEAD
  16     }
  17     set commits {}
  18     set phase getcommits
  19     if [catch {set commfd [open "|git-rev-tree $rargs" r]} err] {
  20         puts stderr "Error executing git-rev-tree: $err"
  21         exit 1
  22     }
  23     fconfigure $commfd -blocking 0
  24     fileevent $commfd readable "getcommitline $commfd"
  25     $canv delete all
  26     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  27         -font $mainfont -tags textitems
  28 }
  29
  30 proc getcommitline {commfd}  {
  31     global commits parents cdate nparents children nchildren
  32     set n [gets $commfd line]
  33     if {$n < 0} {
  34         if {![eof $commfd]} return
  35         if {![catch {close $commfd} err]} {
  36             after idle drawgraph
  37             return
  38         }
  39         if {[string range $err 0 4] == "usage"} {
  40             puts stderr "Error reading commits: bad arguments to git-rev-tree"
  41             puts stderr "Note: arguments to gitk are passed to git-rev-tree"
  42             puts stderr "      to allow selection of commits to be displayed"
  43         } else {
  44             puts stderr "Error reading commits: $err"
  45         }
  46         exit 1
  47     }
  48
  49     set i 0
  50     set cid {}
  51     foreach f $line {
  52         if {$i == 0} {
  53             set d $f
  54         } else {
  55             set id [lindex [split $f :] 0]
  56             if {![info exists nchildren($id)]} {
  57                 set children($id) {}
  58                 set nchildren($id) 0
  59             }
  60             if {$i == 1} {
  61                 set cid $id
  62                 lappend commits $id
  63                 set parents($id) {}
  64                 set cdate($id) $d
  65                 set nparents($id) 0
  66             } else {
  67                 lappend parents($cid) $id
  68                 incr nparents($cid)
  69                 incr nchildren($id)
  70                 lappend children($id) $cid
  71             }
  72         }
  73         incr i
  74     }
  75 }
  76
  77 proc readcommit {id} {
  78     global commitinfo
  79     set inhdr 1
  80     set comment {}
  81     set headline {}
  82     set auname {}
  83     set audate {}
  84     set comname {}
  85     set comdate {}
  86     foreach line [split [exec git-cat-file commit $id] "\n"] {
  87         if {$inhdr} {
  88             if {$line == {}} {
  89                 set inhdr 0
  90             } else {
  91                 set tag [lindex $line 0]
  92                 if {$tag == "author"} {
  93                     set x [expr {[llength $line] - 2}]
  94                     set audate [lindex $line $x]
  95                     set auname [lrange $line 1 [expr {$x - 1}]]
  96                 } elseif {$tag == "committer"} {
  97                     set x [expr {[llength $line] - 2}]
  98                     set comdate [lindex $line $x]
  99                     set comname [lrange $line 1 [expr {$x - 1}]]
 100                 }
 101             }
 102         } else {
 103             if {$comment == {}} {
 104                 set headline $line
 105             } else {
 106                 append comment "\n"
 107             }
 108             append comment $line
 109         }
 110     }
 111     if {$audate != {}} {
 112         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 113     }
 114     if {$comdate != {}} {
 115         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 116     }
 117     set commitinfo($id) [list $headline $auname $audate \
 118                              $comname $comdate $comment]
 119 }
 120
 121 proc makewindow {} {
 122     global canv canv2 canv3 linespc charspc ctext cflist textfont
 123     global sha1entry findtype findloc findstring geometry
 124
 125     menu .bar
 126     .bar add cascade -label "File" -menu .bar.file
 127     menu .bar.file
 128     .bar.file add command -label "Quit" -command doquit
 129     menu .bar.help
 130     .bar add cascade -label "Help" -menu .bar.help
 131     .bar.help add command -label "About gitk" -command about
 132     . configure -menu .bar
 133
 134     if {![info exists geometry(canv1)]} {
 135         set geometry(canv1) [expr 45 * $charspc]
 136         set geometry(canv2) [expr 30 * $charspc]
 137         set geometry(canv3) [expr 15 * $charspc]
 138         set geometry(canvh) [expr 25 * $linespc + 4]
 139         set geometry(ctextw) 80
 140         set geometry(ctexth) 30
 141         set geometry(cflistw) 30
 142     }
 143     panedwindow .ctop -orient vertical
 144     if {[info exists geometry(width)]} {
 145         .ctop conf -width $geometry(width) -height $geometry(height)
 146     }
 147     frame .ctop.top
 148     frame .ctop.top.bar
 149     pack .ctop.top.bar -side bottom -fill x
 150     set cscroll .ctop.top.csb
 151     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 152     pack $cscroll -side right -fill y
 153     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 154     pack .ctop.top.clist -side top -fill both -expand 1
 155     .ctop add .ctop.top
 156     set canv .ctop.top.clist.canv
 157     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 158         -bg white -bd 0 \
 159         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 160     .ctop.top.clist add $canv
 161     set canv2 .ctop.top.clist.canv2
 162     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 163         -bg white -bd 0 -yscrollincr $linespc
 164     .ctop.top.clist add $canv2
 165     set canv3 .ctop.top.clist.canv3
 166     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 167         -bg white -bd 0 -yscrollincr $linespc
 168     .ctop.top.clist add $canv3
 169     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 170
 171     set sha1entry .ctop.top.bar.sha1
 172     label .ctop.top.bar.sha1label -text "SHA1 ID: "
 173     pack .ctop.top.bar.sha1label -side left
 174     entry $sha1entry -width 40 -font $textfont -state readonly
 175     pack $sha1entry -side left -pady 2
 176     button .ctop.top.bar.findbut -text "Find" -command dofind
 177     pack .ctop.top.bar.findbut -side left
 178     set findstring {}
 179     entry .ctop.top.bar.findstring -width 30 -font $textfont \
 180         -textvariable findstring
 181     pack .ctop.top.bar.findstring -side left -expand 1 -fill x
 182     set findtype Exact
 183     tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
 184     set findloc "All fields"
 185     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 186         Comments Author Committer
 187     pack .ctop.top.bar.findloc -side right
 188     pack .ctop.top.bar.findtype -side right
 189
 190     panedwindow .ctop.cdet -orient horizontal
 191     if {[info exists geometry(cdeth)]} {
 192         .ctop.cdet conf -height $geometry(cdeth)
 193     }
 194     .ctop add .ctop.cdet
 195     frame .ctop.cdet.left
 196     set ctext .ctop.cdet.left.ctext
 197     text $ctext -bg white -state disabled -font $textfont \
 198         -width $geometry(ctextw) -height $geometry(ctexth) \
 199         -yscrollcommand ".ctop.cdet.left.sb set"
 200     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 201     pack .ctop.cdet.left.sb -side right -fill y
 202     pack $ctext -side left -fill both -expand 1
 203     .ctop.cdet add .ctop.cdet.left
 204     if {[info exists geometry(detlw)]} {
 205         .ctop.cdet.left conf -width $geometry(detlw)
 206     }
 207
 208     $ctext tag conf filesep -font [concat $textfont bold]
 209     $ctext tag conf hunksep -back blue -fore white
 210     $ctext tag conf d0 -back "#ff8080"
 211     $ctext tag conf d1 -back green
 212
 213     frame .ctop.cdet.right
 214     set cflist .ctop.cdet.right.cfiles
 215     listbox $cflist -width $geometry(cflistw) -bg white -selectmode extended \
 216         -yscrollcommand ".ctop.cdet.right.sb set"
 217     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 218     pack .ctop.cdet.right.sb -side right -fill y
 219     pack $cflist -side left -fill both -expand 1
 220     .ctop.cdet add .ctop.cdet.right
 221     if {[info exists geometry(detsash)]} {
 222         eval .ctop.cdet sash place 0 $geometry(detsash)
 223     }
 224     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 225
 226     pack .ctop -side top -fill both -expand 1
 227
 228     bindall <1> {selcanvline %x %y}
 229     bindall <B1-Motion> {selcanvline %x %y}
 230     bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
 231     bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
 232     bindall <2> "allcanvs scan mark 0 %y"
 233     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 234     bind . <Key-Up> "selnextline -1"
 235     bind . <Key-Down> "selnextline 1"
 236     bind . p "selnextline -1"
 237     bind . n "selnextline 1"
 238     bind . <Key-Prior> "allcanvs yview scroll -1 p"
 239     bind . <Key-Next> "allcanvs yview scroll 1 p"
 240     bind . <Key-Delete> "$ctext yview scroll -1 p"
 241     bind . <Key-BackSpace> "$ctext yview scroll -1 p"
 242     bind . <Key-space> "$ctext yview scroll 1 p"
 243     bind . b "$ctext yview scroll -1 p"
 244     bind . d "$ctext yview scroll 18 u"
 245     bind . u "$ctext yview scroll -18 u"
 246     bind . Q doquit
 247     bind . <Control-q> doquit
 248     bind . <Control-f> dofind
 249     bind . <Control-g> findnext
 250     bind . <Control-r> findprev
 251     bind . <Control-equal> {incrfont 1}
 252     bind . <Control-KP_Add> {incrfont 1}
 253     bind . <Control-minus> {incrfont -1}
 254     bind . <Control-KP_Subtract> {incrfont -1}
 255     bind $cflist <<ListboxSelect>> listboxsel
 256     bind . <Destroy> {savestuff %W}
 257 }
 258
 259 proc savestuff {w} {
 260     global canv canv2 canv3 ctext cflist mainfont textfont
 261     global stuffsaved
 262     if {$stuffsaved} return
 263     catch {
 264         set f [open "~/.gitk-new" w]
 265         puts $f "set mainfont {$mainfont}"
 266         puts $f "set textfont {$textfont}"
 267         puts $f "set geometry(width) [winfo width .ctop]"
 268         puts $f "set geometry(height) [winfo height .ctop]"
 269         puts $f "set geometry(canv1) [winfo width $canv]"
 270         puts $f "set geometry(canv2) [winfo width $canv2]"
 271         puts $f "set geometry(canv3) [winfo width $canv3]"
 272         puts $f "set geometry(canvh) [winfo height $canv]"
 273         puts $f "set geometry(cdeth) [winfo height .ctop.cdet]"
 274         set wid [expr {([winfo width $ctext] - 8) \
 275                            / [font measure $textfont "0"]}]
 276         set ht [expr {([winfo height $ctext] - 8) \
 277                           / [font metrics $textfont -linespace]}]
 278         puts $f "set geometry(ctextw) $wid"
 279         puts $f "set geometry(ctexth) $ht"
 280         set wid [expr {([winfo width $cflist] - 11) \
 281                            / [font measure [$cflist cget -font] "0"]}]
 282         puts $f "set geometry(cflistw) $wid"
 283         close $f
 284         file rename -force "~/.gitk-new" "~/.gitk"
 285     }
 286     set stuffsaved 1
 287 }
 288
 289 proc resizeclistpanes {win w} {
 290     global oldwidth
 291     if [info exists oldwidth($win)] {
 292         set s0 [$win sash coord 0]
 293         set s1 [$win sash coord 1]
 294         if {$w < 60} {
 295             set sash0 [expr {int($w/2 - 2)}]
 296             set sash1 [expr {int($w*5/6 - 2)}]
 297         } else {
 298             set factor [expr {1.0 * $w / $oldwidth($win)}]
 299             set sash0 [expr {int($factor * [lindex $s0 0])}]
 300             set sash1 [expr {int($factor * [lindex $s1 0])}]
 301             if {$sash0 < 30} {
 302                 set sash0 30
 303             }
 304             if {$sash1 < $sash0 + 20} {
 305                 set sash1 [expr $sash0 + 20]
 306             }
 307             if {$sash1 > $w - 10} {
 308                 set sash1 [expr $w - 10]
 309                 if {$sash0 > $sash1 - 20} {
 310                     set sash0 [expr $sash1 - 20]
 311                 }
 312             }
 313         }
 314         $win sash place 0 $sash0 [lindex $s0 1]
 315         $win sash place 1 $sash1 [lindex $s1 1]
 316     }
 317     set oldwidth($win) $w
 318 }
 319
 320 proc resizecdetpanes {win w} {
 321     global oldwidth
 322     if [info exists oldwidth($win)] {
 323         set s0 [$win sash coord 0]
 324         if {$w < 60} {
 325             set sash0 [expr {int($w*3/4 - 2)}]
 326         } else {
 327             set factor [expr {1.0 * $w / $oldwidth($win)}]
 328             set sash0 [expr {int($factor * [lindex $s0 0])}]
 329             if {$sash0 < 45} {
 330                 set sash0 45
 331             }
 332             if {$sash0 > $w - 15} {
 333                 set sash0 [expr $w - 15]
 334             }
 335         }
 336         $win sash place 0 $sash0 [lindex $s0 1]
 337     }
 338     set oldwidth($win) $w
 339 }
 340
 341 proc allcanvs args {
 342     global canv canv2 canv3
 343     eval $canv $args
 344     eval $canv2 $args
 345     eval $canv3 $args
 346 }
 347
 348 proc bindall {event action} {
 349     global canv canv2 canv3
 350     bind $canv $event $action
 351     bind $canv2 $event $action
 352     bind $canv3 $event $action
 353 }
 354
 355 proc about {} {
 356     set w .about
 357     if {[winfo exists $w]} {
 358         raise $w
 359         return
 360     }
 361     toplevel $w
 362     wm title $w "About gitk"
 363     message $w.m -text {
 364 Gitk version 0.91
 365
 366 Copyright © 2005 Paul Mackerras
 367
 368 Use and redistribute under the terms of the GNU General Public License
 369
 370 (CVS $Revision: 1.13 $)} \
 371             -justify center -aspect 400
 372     pack $w.m -side top -fill x -padx 20 -pady 20
 373     button $w.ok -text Close -command "destroy $w"
 374     pack $w.ok -side bottom
 375 }
 376
 377 proc truncatetofit {str width font} {
 378     if {[font measure $font $str] <= $width} {
 379         return $str
 380     }
 381     set best 0
 382     set bad [string length $str]
 383     set tmp $str
 384     while {$best < $bad - 1} {
 385         set try [expr {int(($best + $bad) / 2)}]
 386         set tmp "[string range $str 0 [expr $try-1]]..."
 387         if {[font measure $font $tmp] <= $width} {
 388             set best $try
 389         } else {
 390             set bad $try
 391         }
 392     }
 393     return $tmp
 394 }
 395
 396 proc assigncolor {id} {
 397     global commitinfo colormap commcolors colors nextcolor
 398     global colorbycommitter
 399     global parents nparents children nchildren
 400     if [info exists colormap($id)] return
 401     set ncolors [llength $colors]
 402     if {$colorbycommitter} {
 403         if {![info exists commitinfo($id)]} {
 404             readcommit $id
 405         }
 406         set comm [lindex $commitinfo($id) 3]
 407         if {![info exists commcolors($comm)]} {
 408             set commcolors($comm) [lindex $colors $nextcolor]
 409             if {[incr nextcolor] >= $ncolors} {
 410                 set nextcolor 0
 411             }
 412         }
 413         set colormap($id) $commcolors($comm)
 414     } else {
 415         if {$nparents($id) == 1 && $nchildren($id) == 1} {
 416             set child [lindex $children($id) 0]
 417             if {[info exists colormap($child)]
 418                 && $nparents($child) == 1} {
 419                 set colormap($id) $colormap($child)
 420                 return
 421             }
 422         }
 423         set badcolors {}
 424         foreach child $children($id) {
 425             if {[info exists colormap($child)]
 426                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
 427                 lappend badcolors $colormap($child)
 428             }
 429             if {[info exists parents($child)]} {
 430                 foreach p $parents($child) {
 431                     if {[info exists colormap($p)]
 432                         && [lsearch -exact $badcolors $colormap($p)] < 0} {
 433                         lappend badcolors $colormap($p)
 434                     }
 435                 }
 436             }
 437         }
 438         if {[llength $badcolors] >= $ncolors} {
 439             set badcolors {}
 440         }
 441         for {set i 0} {$i <= $ncolors} {incr i} {
 442             set c [lindex $colors $nextcolor]
 443             if {[incr nextcolor] >= $ncolors} {
 444                 set nextcolor 0
 445             }
 446             if {[lsearch -exact $badcolors $c]} break
 447         }
 448         set colormap($id) $c
 449     }
 450 }
 451
 452 proc drawgraph {} {
 453     global parents children nparents nchildren commits
 454     global canv canv2 canv3 mainfont namefont canvx0 canvy0 canvy linespc
 455     global datemode cdate
 456     global lineid linehtag linentag linedtag commitinfo
 457     global nextcolor colormap numcommits
 458     global stopped phase redisplaying selectedline
 459
 460     allcanvs delete all
 461     set start {}
 462     foreach id $commits {
 463         if {$nchildren($id) == 0} {
 464             lappend start $id
 465         }
 466         set ncleft($id) $nchildren($id)
 467     }
 468     if {$start == {}} {
 469         $canv create text 3 3 -anchor nw -font $mainfont \
 470             -text "ERROR: No starting commits found"
 471         set phase {}
 472         return
 473     }
 474
 475     set nextcolor 0
 476     foreach id $start {
 477         assigncolor $id
 478     }
 479     set todo $start
 480     set level [expr [llength $todo] - 1]
 481     set y2 $canvy0
 482     set nullentry -1
 483     set lineno -1
 484     set numcommits 0
 485     set phase drawgraph
 486     while 1 {
 487         set canvy $y2
 488         allcanvs conf -scrollregion [list 0 0 0 $canvy]
 489         update
 490         if {$stopped} break
 491         incr numcommits
 492         incr lineno
 493         set nlines [llength $todo]
 494         set id [lindex $todo $level]
 495         set lineid($lineno) $id
 496         set actualparents {}
 497         foreach p $parents($id) {
 498             if {[info exists ncleft($p)]} {
 499                 incr ncleft($p) -1
 500                 lappend actualparents $p
 501             }
 502         }
 503         if {![info exists commitinfo($id)]} {
 504             readcommit $id
 505         }
 506         set x [expr $canvx0 + $level * $linespc]
 507         set y2 [expr $canvy + $linespc]
 508         if {[info exists linestarty($level)] && $linestarty($level) < $canvy} {
 509             set t [$canv create line $x $linestarty($level) $x $canvy \
 510                        -width 2 -fill $colormap($id)]
 511             $canv lower $t
 512         }
 513         set linestarty($level) $canvy
 514         set t [$canv create oval [expr $x - 4] [expr $canvy - 4] \
 515                    [expr $x + 3] [expr $canvy + 3] \
 516                    -fill blue -outline black -width 1]
 517         $canv raise $t
 518         set xt [expr $canvx0 + $nlines * $linespc]
 519         set headline [lindex $commitinfo($id) 0]
 520         set name [lindex $commitinfo($id) 1]
 521         set date [lindex $commitinfo($id) 2]
 522         set linehtag($lineno) [$canv create text $xt $canvy -anchor w \
 523                                    -text $headline -font $mainfont ]
 524         set linentag($lineno) [$canv2 create text 3 $canvy -anchor w \
 525                                    -text $name -font $namefont]
 526         set linedtag($lineno) [$canv3 create text 3 $canvy -anchor w \
 527                                  -text $date -font $mainfont]
 528         if {!$datemode && [llength $actualparents] == 1} {
 529             set p [lindex $actualparents 0]
 530             if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
 531                 assigncolor $p
 532                 set todo [lreplace $todo $level $level $p]
 533                 continue
 534             }
 535         }
 536
 537         set oldtodo $todo
 538         set oldlevel $level
 539         set lines {}
 540         for {set i 0} {$i < $nlines} {incr i} {
 541             if {[lindex $todo $i] == {}} continue
 542             if {[info exists linestarty($i)]} {
 543                 set oldstarty($i) $linestarty($i)
 544                 unset linestarty($i)
 545             }
 546             if {$i != $level} {
 547                 lappend lines [list $i [lindex $todo $i]]
 548             }
 549         }
 550         if {$nullentry >= 0} {
 551             set todo [lreplace $todo $nullentry $nullentry]
 552             if {$nullentry < $level} {
 553                 incr level -1
 554             }
 555         }
 556
 557         set todo [lreplace $todo $level $level]
 558         if {$nullentry > $level} {
 559             incr nullentry -1
 560         }
 561         set i $level
 562         foreach p $actualparents {
 563             set k [lsearch -exact $todo $p]
 564             if {$k < 0} {
 565                 assigncolor $p
 566                 set todo [linsert $todo $i $p]
 567                 if {$nullentry >= $i} {
 568                     incr nullentry
 569                 }
 570             }
 571             lappend lines [list $oldlevel $p]
 572         }
 573
 574         # choose which one to do next time around
 575         set todol [llength $todo]
 576         set level -1
 577         set latest {}
 578         for {set k $todol} {[incr k -1] >= 0} {} {
 579             set p [lindex $todo $k]
 580             if {$p == {}} continue
 581             if {$ncleft($p) == 0} {
 582                 if {$datemode} {
 583                     if {$latest == {} || $cdate($p) > $latest} {
 584                         set level $k
 585                         set latest $cdate($p)
 586                     }
 587                 } else {
 588                     set level $k
 589                     break
 590                 }
 591             }
 592         }
 593         if {$level < 0} {
 594             if {$todo != {}} {
 595                 puts "ERROR: none of the pending commits can be done yet:"
 596                 foreach p $todo {
 597                     puts "  $p"
 598                 }
 599             }
 600             break
 601         }
 602
 603         # If we are reducing, put in a null entry
 604         if {$todol < $nlines} {
 605             if {$nullentry >= 0} {
 606                 set i $nullentry
 607                 while {$i < $todol
 608                        && [lindex $oldtodo $i] == [lindex $todo $i]} {
 609                     incr i
 610                 }
 611             } else {
 612                 set i $oldlevel
 613                 if {$level >= $i} {
 614                     incr i
 615                 }
 616             }
 617             if {$i >= $todol} {
 618                 set nullentry -1
 619             } else {
 620                 set nullentry $i
 621                 set todo [linsert $todo $nullentry {}]
 622                 if {$level >= $i} {
 623                     incr level
 624                 }
 625             }
 626         } else {
 627             set nullentry -1
 628         }
 629
 630         foreach l $lines {
 631             set i [lindex $l 0]
 632             set dst [lindex $l 1]
 633             set j [lsearch -exact $todo $dst]
 634             if {$i == $j} {
 635                 if {[info exists oldstarty($i)]} {
 636                     set linestarty($i) $oldstarty($i)
 637                 }
 638                 continue
 639             }
 640             set xi [expr {$canvx0 + $i * $linespc}]
 641             set xj [expr {$canvx0 + $j * $linespc}]
 642             set coords {}
 643             if {[info exists oldstarty($i)] && $oldstarty($i) < $canvy} {
 644                 lappend coords $xi $oldstarty($i)
 645             }
 646             lappend coords $xi $canvy
 647             if {$j < $i - 1} {
 648                 lappend coords [expr $xj + $linespc] $canvy
 649             } elseif {$j > $i + 1} {
 650                 lappend coords [expr $xj - $linespc] $canvy
 651             }
 652             lappend coords $xj $y2
 653             set t [$canv create line $coords -width 2 -fill $colormap($dst)]
 654             $canv lower $t
 655             if {![info exists linestarty($j)]} {
 656                 set linestarty($j) $y2
 657             }
 658         }
 659     }
 660     set phase {}
 661     if {$redisplaying} {
 662         if {$stopped == 0 && [info exists selectedline]} {
 663             selectline $selectedline
 664         }
 665         if {$stopped == 1} {
 666             set stopped 0
 667             after idle drawgraph
 668         } else {
 669             set redisplaying 0
 670         }
 671     }
 672 }
 673
 674 proc dofind {} {
 675     global findtype findloc findstring markedmatches commitinfo
 676     global numcommits lineid linehtag linentag linedtag
 677     global mainfont namefont canv canv2 canv3 selectedline
 678     global matchinglines
 679     unmarkmatches
 680     set matchinglines {}
 681     set fldtypes {Headline Author Date Committer CDate Comment}
 682     if {$findtype == "IgnCase"} {
 683         set fstr [string tolower $findstring]
 684     } else {
 685         set fstr $findstring
 686     }
 687     set mlen [string length $findstring]
 688     if {$mlen == 0} return
 689     if {![info exists selectedline]} {
 690         set oldsel -1
 691     } else {
 692         set oldsel $selectedline
 693     }
 694     set didsel 0
 695     for {set l 0} {$l < $numcommits} {incr l} {
 696         set id $lineid($l)
 697         set info $commitinfo($id)
 698         set doesmatch 0
 699         foreach f $info ty $fldtypes {
 700             if {$findloc != "All fields" && $findloc != $ty} {
 701                 continue
 702             }
 703             if {$findtype == "Regexp"} {
 704                 set matches [regexp -indices -all -inline $fstr $f]
 705             } else {
 706                 if {$findtype == "IgnCase"} {
 707                     set str [string tolower $f]
 708                 } else {
 709                     set str $f
 710                 }
 711                 set matches {}
 712                 set i 0
 713                 while {[set j [string first $fstr $str $i]] >= 0} {
 714                     lappend matches [list $j [expr $j+$mlen-1]]
 715                     set i [expr $j + $mlen]
 716                 }
 717             }
 718             if {$matches == {}} continue
 719             set doesmatch 1
 720             if {$ty == "Headline"} {
 721                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
 722             } elseif {$ty == "Author"} {
 723                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
 724             } elseif {$ty == "Date"} {
 725                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
 726             }
 727         }
 728         if {$doesmatch} {
 729             lappend matchinglines $l
 730             if {!$didsel && $l > $oldsel} {
 731                 selectline $l
 732                 set didsel 1
 733             }
 734         }
 735     }
 736     if {$matchinglines == {}} {
 737         bell
 738     } elseif {!$didsel} {
 739         selectline [lindex $matchinglines 0]
 740     }
 741 }
 742
 743 proc findnext {} {
 744     global matchinglines selectedline
 745     if {![info exists matchinglines]} {
 746         dofind
 747         return
 748     }
 749     if {![info exists selectedline]} return
 750     foreach l $matchinglines {
 751         if {$l > $selectedline} {
 752             selectline $l
 753             return
 754         }
 755     }
 756     bell
 757 }
 758
 759 proc findprev {} {
 760     global matchinglines selectedline
 761     if {![info exists matchinglines]} {
 762         dofind
 763         return
 764     }
 765     if {![info exists selectedline]} return
 766     set prev {}
 767     foreach l $matchinglines {
 768         if {$l >= $selectedline} break
 769         set prev $l
 770     }
 771     if {$prev != {}} {
 772         selectline $prev
 773     } else {
 774         bell
 775     }
 776 }
 777
 778 proc markmatches {canv l str tag matches font} {
 779     set bbox [$canv bbox $tag]
 780     set x0 [lindex $bbox 0]
 781     set y0 [lindex $bbox 1]
 782     set y1 [lindex $bbox 3]
 783     foreach match $matches {
 784         set start [lindex $match 0]
 785         set end [lindex $match 1]
 786         if {$start > $end} continue
 787         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
 788         set xlen [font measure $font [string range $str 0 [expr $end]]]
 789         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
 790                    -outline {} -tags matches -fill yellow]
 791         $canv lower $t
 792     }
 793 }
 794
 795 proc unmarkmatches {} {
 796     global matchinglines
 797     allcanvs delete matches
 798     catch {unset matchinglines}
 799 }
 800
 801 proc selcanvline {x y} {
 802     global canv canvy0 ctext linespc selectedline
 803     global lineid linehtag linentag linedtag
 804     set ymax [lindex [$canv cget -scrollregion] 3]
 805     set yfrac [lindex [$canv yview] 0]
 806     set y [expr {$y + $yfrac * $ymax}]
 807     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
 808     if {$l < 0} {
 809         set l 0
 810     }
 811     if {[info exists selectedline] && $selectedline == $l} return
 812     unmarkmatches
 813     selectline $l
 814 }
 815
 816 proc selectline {l} {
 817     global canv canv2 canv3 ctext commitinfo selectedline
 818     global lineid linehtag linentag linedtag
 819     global canvy canvy0 linespc nparents treepending
 820     global cflist treediffs currentid sha1entry
 821     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
 822     $canv delete secsel
 823     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
 824                -tags secsel -fill [$canv cget -selectbackground]]
 825     $canv lower $t
 826     $canv2 delete secsel
 827     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
 828                -tags secsel -fill [$canv2 cget -selectbackground]]
 829     $canv2 lower $t
 830     $canv3 delete secsel
 831     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
 832                -tags secsel -fill [$canv3 cget -selectbackground]]
 833     $canv3 lower $t
 834     set y [expr {$canvy0 + $l * $linespc}]
 835     set ytop [expr {($y - $linespc / 2.0) / $canvy}]
 836     set ybot [expr {($y + $linespc / 2.0) / $canvy}]
 837     set wnow [$canv yview]
 838     if {$ytop < [lindex $wnow 0]} {
 839         allcanvs yview moveto $ytop
 840     } elseif {$ybot > [lindex $wnow 1]} {
 841         set wh [expr {[lindex $wnow 1] - [lindex $wnow 0]}]
 842         allcanvs yview moveto [expr {$ybot - $wh}]
 843     }
 844     set selectedline $l
 845
 846     set id $lineid($l)
 847     $sha1entry conf -state normal
 848     $sha1entry delete 0 end
 849     $sha1entry insert 0 $id
 850     $sha1entry selection from 0
 851     $sha1entry selection to end
 852     $sha1entry conf -state readonly
 853
 854     $ctext conf -state normal
 855     $ctext delete 0.0 end
 856     set info $commitinfo($id)
 857     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
 858     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
 859     $ctext insert end "\n"
 860     $ctext insert end [lindex $info 5]
 861     $ctext insert end "\n"
 862     $ctext tag delete Comments
 863     $ctext conf -state disabled
 864
 865     $cflist delete 0 end
 866     set currentid $id
 867     if {$nparents($id) == 1} {
 868         if {![info exists treediffs($id)]} {
 869             if {![info exists treepending]} {
 870                 gettreediffs $id
 871             }
 872         } else {
 873             addtocflist $id
 874         }
 875     }
 876 }
 877
 878 proc selnextline {dir} {
 879     global selectedline
 880     if {![info exists selectedline]} return
 881     set l [expr $selectedline + $dir]
 882     unmarkmatches
 883     selectline $l
 884 }
 885
 886 proc addtocflist {id} {
 887     global currentid treediffs cflist treepending
 888     if {$id != $currentid} {
 889         gettreediffs $currentid
 890         return
 891     }
 892     $cflist insert end "All files"
 893     foreach f $treediffs($currentid) {
 894         $cflist insert end $f
 895     }
 896     getblobdiffs $id
 897 }
 898
 899 proc gettreediffs {id} {
 900     global treediffs parents treepending
 901     set treepending $id
 902     set treediffs($id) {}
 903     set p [lindex $parents($id) 0]
 904     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
 905     fconfigure $gdtf -blocking 0
 906     fileevent $gdtf readable "gettreediffline $gdtf $id"
 907 }
 908
 909 proc gettreediffline {gdtf id} {
 910     global treediffs treepending
 911     set n [gets $gdtf line]
 912     if {$n < 0} {
 913         if {![eof $gdtf]} return
 914         close $gdtf
 915         unset treepending
 916         addtocflist $id
 917         return
 918     }
 919     set type [lindex $line 1]
 920     set file [lindex $line 3]
 921     if {$type == "blob"} {
 922         lappend treediffs($id) $file
 923     }
 924 }
 925
 926 proc getblobdiffs {id} {
 927     global parents diffopts blobdifffd env curdifftag curtagstart
 928     set p [lindex $parents($id) 0]
 929     set env(GIT_DIFF_OPTS) $diffopts
 930     if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
 931         puts "error getting diffs: $err"
 932         return
 933     }
 934     fconfigure $bdf -blocking 0
 935     set blobdifffd($id) $bdf
 936     set curdifftag Comments
 937     set curtagstart 0.0
 938     fileevent $bdf readable "getblobdiffline $bdf $id"
 939 }
 940
 941 proc getblobdiffline {bdf id} {
 942     global currentid blobdifffd ctext curdifftag curtagstart
 943     set n [gets $bdf line]
 944     if {$n < 0} {
 945         if {[eof $bdf]} {
 946             close $bdf
 947             if {$id == $currentid && $bdf == $blobdifffd($id)} {
 948                 $ctext tag add $curdifftag $curtagstart end
 949             }
 950         }
 951         return
 952     }
 953     if {$id != $currentid || $bdf != $blobdifffd($id)} {
 954         return
 955     }
 956     $ctext conf -state normal
 957     if {[regexp {^---[ \t]+([^/])+/(.*)} $line match s1 fname]} {
 958         # start of a new file
 959         $ctext insert end "\n"
 960         $ctext tag add $curdifftag $curtagstart end
 961         set curtagstart [$ctext index "end - 1c"]
 962         set curdifftag "f:$fname"
 963         $ctext tag delete $curdifftag
 964         set l [expr {(78 - [string length $fname]) / 2}]
 965         set pad [string range "----------------------------------------" 1 $l]
 966         $ctext insert end "$pad $fname $pad\n" filesep
 967     } elseif {[string range $line 0 2] == "+++"} {
 968         # no need to do anything with this
 969     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
 970                    $line match f1l f1c f2l f2c rest]} {
 971         $ctext insert end "\t" hunksep
 972         $ctext insert end "    $f1l    " d0 "    $f2l    " d1
 973         $ctext insert end "    $rest \n" hunksep
 974     } else {
 975         set x [string range $line 0 0]
 976         if {$x == "-" || $x == "+"} {
 977             set tag [expr {$x == "+"}]
 978             set line [string range $line 1 end]
 979             $ctext insert end "$line\n" d$tag
 980         } elseif {$x == " "} {
 981             set line [string range $line 1 end]
 982             $ctext insert end "$line\n"
 983         } else {
 984             # Something else we don't recognize
 985             if {$curdifftag != "Comments"} {
 986                 $ctext insert end "\n"
 987                 $ctext tag add $curdifftag $curtagstart end
 988                 set curtagstart [$ctext index "end - 1c"]
 989                 set curdifftag Comments
 990             }
 991             $ctext insert end "$line\n" filesep
 992         }
 993     }
 994     $ctext conf -state disabled
 995 }
 996
 997 proc listboxsel {} {
 998     global ctext cflist currentid treediffs
 999     if {![info exists currentid]} return
1000     set sel [$cflist curselection]
1001     if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1002         # show everything
1003         $ctext tag conf Comments -elide 0
1004         foreach f $treediffs($currentid) {
1005             $ctext tag conf "f:$f" -elide 0
1006         }
1007     } else {
1008         # just show selected files
1009         $ctext tag conf Comments -elide 1
1010         set i 1
1011         foreach f $treediffs($currentid) {
1012             set elide [expr {[lsearch -exact $sel $i] < 0}]
1013             $ctext tag conf "f:$f" -elide $elide
1014             incr i
1015         }
1016     }
1017 }
1018
1019 proc setcoords {} {
1020     global linespc charspc canvx0 canvy0 mainfont
1021     set linespc [font metrics $mainfont -linespace]
1022     set charspc [font measure $mainfont "m"]
1023     set canvy0 [expr 3 + 0.5 * $linespc]
1024     set canvx0 [expr 3 + 0.5 * $linespc]
1025 }
1026
1027 proc redisplay {} {
1028     global selectedline stopped redisplaying phase
1029     if {$stopped > 1} return
1030     if {$phase == "getcommits"} return
1031     set redisplaying 1
1032     if {$phase == "drawgraph"} {
1033         set stopped 1
1034     } else {
1035         drawgraph
1036     }
1037 }
1038
1039 proc incrfont {inc} {
1040     global mainfont namefont textfont selectedline ctext canv phase
1041     global stopped
1042     unmarkmatches
1043     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1044     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1045     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1046     setcoords
1047     $ctext conf -font $textfont
1048     $ctext tag conf filesep -font [concat $textfont bold]
1049     if {$phase == "getcommits"} {
1050         $canv itemconf textitems -font $mainfont
1051     }
1052     redisplay
1053 }
1054
1055 proc doquit {} {
1056     global stopped
1057     set stopped 100
1058     destroy .
1059 }
1060
1061 # defaults...
1062 set datemode 0
1063 set boldnames 0
1064 set diffopts "-U 5 -p"
1065
1066 set mainfont {Helvetica 9}
1067 set namefont $mainfont
1068 set textfont {Courier 9}
1069 if {$boldnames} {
1070     lappend namefont bold
1071 }
1072
1073 set colors {green red blue magenta darkgrey brown orange}
1074 set colorbycommitter false
1075
1076 catch {source ~/.gitk}
1077
1078 set revtreeargs {}
1079 foreach arg $argv {
1080     switch -regexp -- $arg {
1081         "^$" { }
1082         "^-b" { set boldnames 1 }
1083         "^-c" { set colorbycommitter 1 }
1084         "^-d" { set datemode 1 }
1085         "^-.*" {
1086             puts stderr "unrecognized option $arg"
1087             exit 1
1088         }
1089         default {
1090             lappend revtreeargs $arg
1091         }
1092     }
1093 }
1094
1095 set stopped 0
1096 set redisplaying 0
1097 set stuffsaved 0
1098 setcoords
1099 makewindow
1100 getcommits $revtreeargs