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