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