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