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