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.16 $
  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 1.0
 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.16 $)} \
 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 - 1}]
 907     set ybot [expr {$y + $linespc + 1}]
 908     set wnow [$canv yview]
 909     set wtop [expr [lindex $wnow 0] * $ymax]
 910     set wbot [expr [lindex $wnow 1] * $ymax]
 911     set wh [expr {$wbot - $wtop}]
 912     set newtop $wtop
 913     if {$ytop < $wtop} {
 914         if {$ybot < $wtop} {
 915             set newtop [expr {$y - $wh / 2.0}]
 916         } else {
 917             set newtop $ytop
 918             if {$newtop > $wtop - $linespc} {
 919                 set newtop [expr {$wtop - $linespc}]
 920             }
 921         }
 922     } elseif {$ybot > $wbot} {
 923         if {$ytop > $wbot} {
 924             set newtop [expr {$y - $wh / 2.0}]
 925         } else {
 926             set newtop [expr {$ybot - $wh}]
 927             if {$newtop < $wtop + $linespc} {
 928                 set newtop [expr {$wtop + $linespc}]
 929             }
 930         }
 931     }
 932     if {$newtop != $wtop} {
 933         if {$newtop < 0} {
 934             set newtop 0
 935         }
 936         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
 937     }
 938     set selectedline $l
 939
 940     set id $lineid($l)
 941     $sha1entry conf -state normal
 942     $sha1entry delete 0 end
 943     $sha1entry insert 0 $id
 944     $sha1entry selection from 0
 945     $sha1entry selection to end
 946     $sha1entry conf -state readonly
 947
 948     $ctext conf -state normal
 949     $ctext delete 0.0 end
 950     set info $commitinfo($id)
 951     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
 952     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
 953     $ctext insert end "\n"
 954     $ctext insert end [lindex $info 5]
 955     $ctext insert end "\n"
 956     $ctext tag delete Comments
 957     $ctext tag remove found 1.0 end
 958     $ctext conf -state disabled
 959     set commentend [$ctext index "end - 1c"]
 960
 961     $cflist delete 0 end
 962     set currentid $id
 963     if {$nparents($id) == 1} {
 964         if {![info exists treediffs($id)]} {
 965             if {![info exists treepending]} {
 966                 gettreediffs $id
 967             }
 968         } else {
 969             addtocflist $id
 970         }
 971     }
 972     catch {unset seenfile}
 973 }
 974
 975 proc selnextline {dir} {
 976     global selectedline
 977     if {![info exists selectedline]} return
 978     set l [expr $selectedline + $dir]
 979     unmarkmatches
 980     selectline $l
 981 }
 982
 983 proc addtocflist {id} {
 984     global currentid treediffs cflist treepending
 985     if {$id != $currentid} {
 986         gettreediffs $currentid
 987         return
 988     }
 989     $cflist insert end "All files"
 990     foreach f $treediffs($currentid) {
 991         $cflist insert end $f
 992     }
 993     getblobdiffs $id
 994 }
 995
 996 proc gettreediffs {id} {
 997     global treediffs parents treepending
 998     set treepending $id
 999     set treediffs($id) {}
1000     set p [lindex $parents($id) 0]
1001     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1002     fconfigure $gdtf -blocking 0
1003     fileevent $gdtf readable "gettreediffline $gdtf $id"
1004 }
1005
1006 proc gettreediffline {gdtf id} {
1007     global treediffs treepending
1008     set n [gets $gdtf line]
1009     if {$n < 0} {
1010         if {![eof $gdtf]} return
1011         close $gdtf
1012         unset treepending
1013         addtocflist $id
1014         return
1015     }
1016     set type [lindex $line 1]
1017     set file [lindex $line 3]
1018     if {$type == "blob"} {
1019         lappend treediffs($id) $file
1020     }
1021 }
1022
1023 proc getblobdiffs {id} {
1024     global parents diffopts blobdifffd env curdifftag curtagstart
1025     set p [lindex $parents($id) 0]
1026     set env(GIT_DIFF_OPTS) $diffopts
1027     if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1028         puts "error getting diffs: $err"
1029         return
1030     }
1031     fconfigure $bdf -blocking 0
1032     set blobdifffd($id) $bdf
1033     set curdifftag Comments
1034     set curtagstart 0.0
1035     fileevent $bdf readable "getblobdiffline $bdf $id"
1036 }
1037
1038 proc getblobdiffline {bdf id} {
1039     global currentid blobdifffd ctext curdifftag curtagstart seenfile
1040     global diffnexthead diffnextnote
1041     set n [gets $bdf line]
1042     if {$n < 0} {
1043         if {[eof $bdf]} {
1044             close $bdf
1045             if {$id == $currentid && $bdf == $blobdifffd($id)} {
1046                 $ctext tag add $curdifftag $curtagstart end
1047                 set seenfile($curdifftag) 1
1048             }
1049         }
1050         return
1051     }
1052     if {$id != $currentid || $bdf != $blobdifffd($id)} {
1053         return
1054     }
1055     $ctext conf -state normal
1056     if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1057         # start of a new file
1058         $ctext insert end "\n"
1059         $ctext tag add $curdifftag $curtagstart end
1060         set seenfile($curdifftag) 1
1061         set curtagstart [$ctext index "end - 1c"]
1062         set header $fname
1063         if {[info exists diffnexthead]} {
1064             set fname $diffnexthead
1065             set header "$diffnexthead ($diffnextnote)"
1066             unset diffnexthead
1067         }
1068         set curdifftag "f:$fname"
1069         $ctext tag delete $curdifftag
1070         set l [expr {(78 - [string length $header]) / 2}]
1071         set pad [string range "----------------------------------------" 1 $l]
1072         $ctext insert end "$pad $header $pad\n" filesep
1073     } elseif {[string range $line 0 2] == "+++"} {
1074         # no need to do anything with this
1075     } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1076         set diffnexthead $fn
1077         set diffnextnote "created, mode $m"
1078     } elseif {[string range $line 0 8] == "Deleted: "} {
1079         set diffnexthead [string range $line 9 end]
1080         set diffnextnote "deleted"
1081     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1082                    $line match f1l f1c f2l f2c rest]} {
1083         $ctext insert end "\t" hunksep
1084         $ctext insert end "    $f1l    " d0 "    $f2l    " d1
1085         $ctext insert end "    $rest \n" hunksep
1086     } else {
1087         set x [string range $line 0 0]
1088         if {$x == "-" || $x == "+"} {
1089             set tag [expr {$x == "+"}]
1090             set line [string range $line 1 end]
1091             $ctext insert end "$line\n" d$tag
1092         } elseif {$x == " "} {
1093             set line [string range $line 1 end]
1094             $ctext insert end "$line\n"
1095         } elseif {$x == "\\"} {
1096             # e.g. "\ No newline at end of file"
1097             $ctext insert end "$line\n" filesep
1098         } else {
1099             # Something else we don't recognize
1100             if {$curdifftag != "Comments"} {
1101                 $ctext insert end "\n"
1102                 $ctext tag add $curdifftag $curtagstart end
1103                 set seenfile($curdifftag) 1
1104                 set curtagstart [$ctext index "end - 1c"]
1105                 set curdifftag Comments
1106             }
1107             $ctext insert end "$line\n" filesep
1108         }
1109     }
1110     $ctext conf -state disabled
1111 }
1112
1113 proc listboxsel {} {
1114     global ctext cflist currentid treediffs seenfile
1115     if {![info exists currentid]} return
1116     set sel [$cflist curselection]
1117     if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1118         # show everything
1119         $ctext tag conf Comments -elide 0
1120         foreach f $treediffs($currentid) {
1121             if [info exists seenfile(f:$f)] {
1122                 $ctext tag conf "f:$f" -elide 0
1123             }
1124         }
1125     } else {
1126         # just show selected files
1127         $ctext tag conf Comments -elide 1
1128         set i 1
1129         foreach f $treediffs($currentid) {
1130             set elide [expr {[lsearch -exact $sel $i] < 0}]
1131             if [info exists seenfile(f:$f)] {
1132                 $ctext tag conf "f:$f" -elide $elide
1133             }
1134             incr i
1135         }
1136     }
1137 }
1138
1139 proc setcoords {} {
1140     global linespc charspc canvx0 canvy0 mainfont
1141     set linespc [font metrics $mainfont -linespace]
1142     set charspc [font measure $mainfont "m"]
1143     set canvy0 [expr 3 + 0.5 * $linespc]
1144     set canvx0 [expr 3 + 0.5 * $linespc]
1145 }
1146
1147 proc redisplay {} {
1148     global selectedline stopped redisplaying phase
1149     if {$stopped > 1} return
1150     if {$phase == "getcommits"} return
1151     set redisplaying 1
1152     if {$phase == "drawgraph"} {
1153         set stopped 1
1154     } else {
1155         drawgraph
1156     }
1157 }
1158
1159 proc incrfont {inc} {
1160     global mainfont namefont textfont selectedline ctext canv phase
1161     global stopped
1162     unmarkmatches
1163     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1164     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1165     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1166     setcoords
1167     $ctext conf -font $textfont
1168     $ctext tag conf filesep -font [concat $textfont bold]
1169     if {$phase == "getcommits"} {
1170         $canv itemconf textitems -font $mainfont
1171     }
1172     redisplay
1173 }
1174
1175 proc doquit {} {
1176     global stopped
1177     set stopped 100
1178     destroy .
1179 }
1180
1181 # defaults...
1182 set datemode 0
1183 set boldnames 0
1184 set diffopts "-U 5 -p"
1185
1186 set mainfont {Helvetica 9}
1187 set textfont {Courier 9}
1188
1189 set colors {green red blue magenta darkgrey brown orange}
1190 set colorbycommitter false
1191
1192 catch {source ~/.gitk}
1193
1194 set namefont $mainfont
1195 if {$boldnames} {
1196     lappend namefont bold
1197 }
1198
1199 set revtreeargs {}
1200 foreach arg $argv {
1201     switch -regexp -- $arg {
1202         "^$" { }
1203         "^-b" { set boldnames 1 }
1204         "^-c" { set colorbycommitter 1 }
1205         "^-d" { set datemode 1 }
1206         "^-.*" {
1207             puts stderr "unrecognized option $arg"
1208             exit 1
1209         }
1210         default {
1211             lappend revtreeargs $arg
1212         }
1213     }
1214 }
1215
1216 set stopped 0
1217 set redisplaying 0
1218 set stuffsaved 0
1219 setcoords
1220 makewindow
1221 getcommits $revtreeargs