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