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