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.23 $
  11
  12 proc getcommits {rargs} {
  13     global commits commfd phase canv mainfont
  14     global startmsecs nextupdate
  15     global ctext maincursor textcursor
  16
  17     if {$rargs == {}} {
  18         set rargs HEAD
  19     }
  20     set commits {}
  21     set phase getcommits
  22     set startmsecs [clock clicks -milliseconds]
  23     set nextupdate [expr $startmsecs + 100]
  24     if [catch {set commfd [open "|git-rev-list --merge-order $rargs" r]} err] {
  25         puts stderr "Error executing git-rev-list: $err"
  26         exit 1
  27     }
  28     fconfigure $commfd -blocking 0
  29     fileevent $commfd readable "getcommitline $commfd"
  30     $canv delete all
  31     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  32         -font $mainfont -tags textitems
  33     . config -cursor watch
  34     $ctext config -cursor watch
  35 }
  36
  37 proc getcommitline {commfd}  {
  38     global commits parents cdate children nchildren ncleft
  39     global commitlisted phase commitinfo nextupdate
  40     global stopped redisplaying
  41
  42     set n [gets $commfd line]
  43     if {$n < 0} {
  44         if {![eof $commfd]} return
  45         # this works around what is apparently a bug in Tcl...
  46         fconfigure $commfd -blocking 1
  47         if {![catch {close $commfd} err]} {
  48             after idle finishcommits
  49             return
  50         }
  51         if {[string range $err 0 4] == "usage"} {
  52             set err \
  53 {Gitk: error reading commits: bad arguments to git-rev-list.
  54 (Note: arguments to gitk are passed to git-rev-list
  55 to allow selection of commits to be displayed.)}
  56         } else {
  57             set err "Error reading commits: $err"
  58         }
  59         error_popup $err
  60         exit 1
  61     }
  62     if {![regexp {^[0-9a-f]{40}$} $line id]} {
  63         error_popup "Can't parse git-rev-list output: {$line}"
  64         exit 1
  65     }
  66     lappend commits $id
  67     set commitlisted($id) 1
  68     if {![info exists commitinfo($id)]} {
  69         readcommit $id
  70     }
  71     foreach p $parents($id) {
  72         if {[info exists commitlisted($p)]} {
  73             puts "oops, parent $p before child $id"
  74         }
  75     }
  76     drawcommit $id
  77     if {[clock clicks -milliseconds] >= $nextupdate} {
  78         doupdate
  79     }
  80     while {$redisplaying} {
  81         set redisplaying 0
  82         if {$stopped == 1} {
  83             set stopped 0
  84             set phase "getcommits"
  85             foreach id $commits {
  86                 drawcommit $id
  87                 if {$stopped} break
  88                 if {[clock clicks -milliseconds] >= $nextupdate} {
  89                     doupdate
  90                 }
  91             }
  92         }
  93     }
  94 }
  95
  96 proc doupdate {} {
  97     global commfd nextupdate
  98
  99     incr nextupdate 100
 100     fileevent $commfd readable {}
 101     update
 102     fileevent $commfd readable "getcommitline $commfd"
 103 }
 104
 105 proc readcommit {id} {
 106     global commitinfo children nchildren parents nparents cdate ncleft
 107     global noreadobj
 108
 109     set inhdr 1
 110     set comment {}
 111     set headline {}
 112     set auname {}
 113     set audate {}
 114     set comname {}
 115     set comdate {}
 116     if {![info exists nchildren($id)]} {
 117         set children($id) {}
 118         set nchildren($id) 0
 119         set ncleft($id) 0
 120     }
 121     set parents($id) {}
 122     set nparents($id) 0
 123     if {$noreadobj} {
 124         if [catch {set contents [exec git-cat-file commit $id]}] return
 125     } else {
 126         if [catch {set x [readobj $id]}] return
 127         if {[lindex $x 0] != "commit"} return
 128         set contents [lindex $x 1]
 129     }
 130     foreach line [split $contents "\n"] {
 131         if {$inhdr} {
 132             if {$line == {}} {
 133                 set inhdr 0
 134             } else {
 135                 set tag [lindex $line 0]
 136                 if {$tag == "parent"} {
 137                     set p [lindex $line 1]
 138                     if {![info exists nchildren($p)]} {
 139                         set children($p) {}
 140                         set nchildren($p) 0
 141                         set ncleft($p) 0
 142                     }
 143                     lappend parents($id) $p
 144                     incr nparents($id)
 145                     if {[lsearch -exact $children($p) $id] < 0} {
 146                         lappend children($p) $id
 147                         incr nchildren($p)
 148                         incr ncleft($p)
 149                     } else {
 150                         puts "child $id already in $p's list??"
 151                     }
 152                 } elseif {$tag == "author"} {
 153                     set x [expr {[llength $line] - 2}]
 154                     set audate [lindex $line $x]
 155                     set auname [lrange $line 1 [expr {$x - 1}]]
 156                 } elseif {$tag == "committer"} {
 157                     set x [expr {[llength $line] - 2}]
 158                     set comdate [lindex $line $x]
 159                     set comname [lrange $line 1 [expr {$x - 1}]]
 160                 }
 161             }
 162         } else {
 163             if {$comment == {}} {
 164                 set headline $line
 165             } else {
 166                 append comment "\n"
 167             }
 168             append comment $line
 169         }
 170     }
 171     if {$audate != {}} {
 172         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 173     }
 174     if {$comdate != {}} {
 175         set cdate($id) $comdate
 176         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 177     }
 178     set commitinfo($id) [list $headline $auname $audate \
 179                              $comname $comdate $comment]
 180 }
 181
 182 proc readrefs {} {
 183     global tagids idtags headids idheads
 184     set tags [glob -nocomplain -types f .git/refs/tags/*]
 185     foreach f $tags {
 186         catch {
 187             set fd [open $f r]
 188             set line [read $fd]
 189             if {[regexp {^[0-9a-f]{40}} $line id]} {
 190                 set direct [file tail $f]
 191                 set tagids($direct) $id
 192                 lappend idtags($id) $direct
 193                 set contents [split [exec git-cat-file tag $id] "\n"]
 194                 set obj {}
 195                 set type {}
 196                 set tag {}
 197                 foreach l $contents {
 198                     if {$l == {}} break
 199                     switch -- [lindex $l 0] {
 200                         "object" {set obj [lindex $l 1]}
 201                         "type" {set type [lindex $l 1]}
 202                         "tag" {set tag [string range $l 4 end]}
 203                     }
 204                 }
 205                 if {$obj != {} && $type == "commit" && $tag != {}} {
 206                     set tagids($tag) $obj
 207                     lappend idtags($obj) $tag
 208                 }
 209             }
 210             close $fd
 211         }
 212     }
 213     set heads [glob -nocomplain -types f .git/refs/heads/*]
 214     foreach f $heads {
 215         catch {
 216             set fd [open $f r]
 217             set line [read $fd 40]
 218             if {[regexp {^[0-9a-f]{40}} $line id]} {
 219                 set head [file tail $f]
 220                 set headids($head) $line
 221                 lappend idheads($line) $head
 222             }
 223             close $fd
 224         }
 225     }
 226 }
 227
 228 proc error_popup msg {
 229     set w .error
 230     toplevel $w
 231     wm transient $w .
 232     message $w.m -text $msg -justify center -aspect 400
 233     pack $w.m -side top -fill x -padx 20 -pady 20
 234     button $w.ok -text OK -command "destroy $w"
 235     pack $w.ok -side bottom -fill x
 236     bind $w <Visibility> "grab $w; focus $w"
 237     tkwait window $w
 238 }
 239
 240 proc makewindow {} {
 241     global canv canv2 canv3 linespc charspc ctext cflist textfont
 242     global findtype findloc findstring fstring geometry
 243     global entries sha1entry sha1string sha1but
 244     global maincursor textcursor
 245
 246     menu .bar
 247     .bar add cascade -label "File" -menu .bar.file
 248     menu .bar.file
 249     .bar.file add command -label "Quit" -command doquit
 250     menu .bar.help
 251     .bar add cascade -label "Help" -menu .bar.help
 252     .bar.help add command -label "About gitk" -command about
 253     . configure -menu .bar
 254
 255     if {![info exists geometry(canv1)]} {
 256         set geometry(canv1) [expr 45 * $charspc]
 257         set geometry(canv2) [expr 30 * $charspc]
 258         set geometry(canv3) [expr 15 * $charspc]
 259         set geometry(canvh) [expr 25 * $linespc + 4]
 260         set geometry(ctextw) 80
 261         set geometry(ctexth) 30
 262         set geometry(cflistw) 30
 263     }
 264     panedwindow .ctop -orient vertical
 265     if {[info exists geometry(width)]} {
 266         .ctop conf -width $geometry(width) -height $geometry(height)
 267         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 268         set geometry(ctexth) [expr {($texth - 8) /
 269                                     [font metrics $textfont -linespace]}]
 270     }
 271     frame .ctop.top
 272     frame .ctop.top.bar
 273     pack .ctop.top.bar -side bottom -fill x
 274     set cscroll .ctop.top.csb
 275     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 276     pack $cscroll -side right -fill y
 277     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 278     pack .ctop.top.clist -side top -fill both -expand 1
 279     .ctop add .ctop.top
 280     set canv .ctop.top.clist.canv
 281     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 282         -bg white -bd 0 \
 283         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 284     .ctop.top.clist add $canv
 285     set canv2 .ctop.top.clist.canv2
 286     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 287         -bg white -bd 0 -yscrollincr $linespc
 288     .ctop.top.clist add $canv2
 289     set canv3 .ctop.top.clist.canv3
 290     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 291         -bg white -bd 0 -yscrollincr $linespc
 292     .ctop.top.clist add $canv3
 293     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 294
 295     set sha1entry .ctop.top.bar.sha1
 296     set entries $sha1entry
 297     set sha1but .ctop.top.bar.sha1label
 298     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 299         -command gotocommit -width 8
 300     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 301     pack .ctop.top.bar.sha1label -side left
 302     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 303     trace add variable sha1string write sha1change
 304     pack $sha1entry -side left -pady 2
 305     button .ctop.top.bar.findbut -text "Find" -command dofind
 306     pack .ctop.top.bar.findbut -side left
 307     set findstring {}
 308     set fstring .ctop.top.bar.findstring
 309     lappend entries $fstring
 310     entry $fstring -width 30 -font $textfont -textvariable findstring
 311     pack $fstring -side left -expand 1 -fill x
 312     set findtype Exact
 313     tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
 314     set findloc "All fields"
 315     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 316         Comments Author Committer
 317     pack .ctop.top.bar.findloc -side right
 318     pack .ctop.top.bar.findtype -side right
 319
 320     panedwindow .ctop.cdet -orient horizontal
 321     .ctop add .ctop.cdet
 322     frame .ctop.cdet.left
 323     set ctext .ctop.cdet.left.ctext
 324     text $ctext -bg white -state disabled -font $textfont \
 325         -width $geometry(ctextw) -height $geometry(ctexth) \
 326         -yscrollcommand ".ctop.cdet.left.sb set"
 327     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 328     pack .ctop.cdet.left.sb -side right -fill y
 329     pack $ctext -side left -fill both -expand 1
 330     .ctop.cdet add .ctop.cdet.left
 331
 332     $ctext tag conf filesep -font [concat $textfont bold]
 333     $ctext tag conf hunksep -back blue -fore white
 334     $ctext tag conf d0 -back "#ff8080"
 335     $ctext tag conf d1 -back green
 336     $ctext tag conf found -back yellow
 337
 338     frame .ctop.cdet.right
 339     set cflist .ctop.cdet.right.cfiles
 340     listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 341         -yscrollcommand ".ctop.cdet.right.sb set"
 342     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 343     pack .ctop.cdet.right.sb -side right -fill y
 344     pack $cflist -side left -fill both -expand 1
 345     .ctop.cdet add .ctop.cdet.right
 346     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 347
 348     pack .ctop -side top -fill both -expand 1
 349
 350     bindall <1> {selcanvline %x %y}
 351     bindall <B1-Motion> {selcanvline %x %y}
 352     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 353     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 354     bindall <2> "allcanvs scan mark 0 %y"
 355     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 356     bind . <Key-Up> "selnextline -1"
 357     bind . <Key-Down> "selnextline 1"
 358     bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 359     bind . <Key-Next> "allcanvs yview scroll 1 pages"
 360     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 361     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 362     bindkey <Key-space> "$ctext yview scroll 1 pages"
 363     bindkey p "selnextline -1"
 364     bindkey n "selnextline 1"
 365     bindkey b "$ctext yview scroll -1 pages"
 366     bindkey d "$ctext yview scroll 18 units"
 367     bindkey u "$ctext yview scroll -18 units"
 368     bindkey / findnext
 369     bindkey ? findprev
 370     bindkey f nextfile
 371     bind . <Control-q> doquit
 372     bind . <Control-f> dofind
 373     bind . <Control-g> findnext
 374     bind . <Control-r> findprev
 375     bind . <Control-equal> {incrfont 1}
 376     bind . <Control-KP_Add> {incrfont 1}
 377     bind . <Control-minus> {incrfont -1}
 378     bind . <Control-KP_Subtract> {incrfont -1}
 379     bind $cflist <<ListboxSelect>> listboxsel
 380     bind . <Destroy> {savestuff %W}
 381     bind . <Button-1> "click %W"
 382     bind $fstring <Key-Return> dofind
 383     bind $sha1entry <Key-Return> gotocommit
 384
 385     set maincursor [. cget -cursor]
 386     set textcursor [$ctext cget -cursor]
 387 }
 388
 389 # when we make a key binding for the toplevel, make sure
 390 # it doesn't get triggered when that key is pressed in the
 391 # find string entry widget.
 392 proc bindkey {ev script} {
 393     global entries
 394     bind . $ev $script
 395     set escript [bind Entry $ev]
 396     if {$escript == {}} {
 397         set escript [bind Entry <Key>]
 398     }
 399     foreach e $entries {
 400         bind $e $ev "$escript; break"
 401     }
 402 }
 403
 404 # set the focus back to the toplevel for any click outside
 405 # the entry widgets
 406 proc click {w} {
 407     global entries
 408     foreach e $entries {
 409         if {$w == $e} return
 410     }
 411     focus .
 412 }
 413
 414 proc savestuff {w} {
 415     global canv canv2 canv3 ctext cflist mainfont textfont
 416     global stuffsaved
 417     if {$stuffsaved} return
 418     if {![winfo viewable .]} return
 419     catch {
 420         set f [open "~/.gitk-new" w]
 421         puts $f "set mainfont {$mainfont}"
 422         puts $f "set textfont {$textfont}"
 423         puts $f "set geometry(width) [winfo width .ctop]"
 424         puts $f "set geometry(height) [winfo height .ctop]"
 425         puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
 426         puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
 427         puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
 428         puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
 429         set wid [expr {([winfo width $ctext] - 8) \
 430                            / [font measure $textfont "0"]}]
 431         puts $f "set geometry(ctextw) $wid"
 432         set wid [expr {([winfo width $cflist] - 11) \
 433                            / [font measure [$cflist cget -font] "0"]}]
 434         puts $f "set geometry(cflistw) $wid"
 435         close $f
 436         file rename -force "~/.gitk-new" "~/.gitk"
 437     }
 438     set stuffsaved 1
 439 }
 440
 441 proc resizeclistpanes {win w} {
 442     global oldwidth
 443     if [info exists oldwidth($win)] {
 444         set s0 [$win sash coord 0]
 445         set s1 [$win sash coord 1]
 446         if {$w < 60} {
 447             set sash0 [expr {int($w/2 - 2)}]
 448             set sash1 [expr {int($w*5/6 - 2)}]
 449         } else {
 450             set factor [expr {1.0 * $w / $oldwidth($win)}]
 451             set sash0 [expr {int($factor * [lindex $s0 0])}]
 452             set sash1 [expr {int($factor * [lindex $s1 0])}]
 453             if {$sash0 < 30} {
 454                 set sash0 30
 455             }
 456             if {$sash1 < $sash0 + 20} {
 457                 set sash1 [expr $sash0 + 20]
 458             }
 459             if {$sash1 > $w - 10} {
 460                 set sash1 [expr $w - 10]
 461                 if {$sash0 > $sash1 - 20} {
 462                     set sash0 [expr $sash1 - 20]
 463                 }
 464             }
 465         }
 466         $win sash place 0 $sash0 [lindex $s0 1]
 467         $win sash place 1 $sash1 [lindex $s1 1]
 468     }
 469     set oldwidth($win) $w
 470 }
 471
 472 proc resizecdetpanes {win w} {
 473     global oldwidth
 474     if [info exists oldwidth($win)] {
 475         set s0 [$win sash coord 0]
 476         if {$w < 60} {
 477             set sash0 [expr {int($w*3/4 - 2)}]
 478         } else {
 479             set factor [expr {1.0 * $w / $oldwidth($win)}]
 480             set sash0 [expr {int($factor * [lindex $s0 0])}]
 481             if {$sash0 < 45} {
 482                 set sash0 45
 483             }
 484             if {$sash0 > $w - 15} {
 485                 set sash0 [expr $w - 15]
 486             }
 487         }
 488         $win sash place 0 $sash0 [lindex $s0 1]
 489     }
 490     set oldwidth($win) $w
 491 }
 492
 493 proc allcanvs args {
 494     global canv canv2 canv3
 495     eval $canv $args
 496     eval $canv2 $args
 497     eval $canv3 $args
 498 }
 499
 500 proc bindall {event action} {
 501     global canv canv2 canv3
 502     bind $canv $event $action
 503     bind $canv2 $event $action
 504     bind $canv3 $event $action
 505 }
 506
 507 proc about {} {
 508     set w .about
 509     if {[winfo exists $w]} {
 510         raise $w
 511         return
 512     }
 513     toplevel $w
 514     wm title $w "About gitk"
 515     message $w.m -text {
 516 Gitk version 1.1
 517
 518 Copyright © 2005 Paul Mackerras
 519
 520 Use and redistribute under the terms of the GNU General Public License
 521
 522 (CVS $Revision: 1.23 $)} \
 523             -justify center -aspect 400
 524     pack $w.m -side top -fill x -padx 20 -pady 20
 525     button $w.ok -text Close -command "destroy $w"
 526     pack $w.ok -side bottom
 527 }
 528
 529 proc assigncolor {id} {
 530     global commitinfo colormap commcolors colors nextcolor
 531     global parents nparents children nchildren
 532     if [info exists colormap($id)] return
 533     set ncolors [llength $colors]
 534     if {$nparents($id) == 1 && $nchildren($id) == 1} {
 535         set child [lindex $children($id) 0]
 536         if {[info exists colormap($child)]
 537             && $nparents($child) == 1} {
 538             set colormap($id) $colormap($child)
 539             return
 540         }
 541     }
 542     set badcolors {}
 543     foreach child $children($id) {
 544         if {[info exists colormap($child)]
 545             && [lsearch -exact $badcolors $colormap($child)] < 0} {
 546             lappend badcolors $colormap($child)
 547         }
 548         if {[info exists parents($child)]} {
 549             foreach p $parents($child) {
 550                 if {[info exists colormap($p)]
 551                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
 552                     lappend badcolors $colormap($p)
 553                 }
 554             }
 555         }
 556     }
 557     if {[llength $badcolors] >= $ncolors} {
 558         set badcolors {}
 559     }
 560     for {set i 0} {$i <= $ncolors} {incr i} {
 561         set c [lindex $colors $nextcolor]
 562         if {[incr nextcolor] >= $ncolors} {
 563             set nextcolor 0
 564         }
 565         if {[lsearch -exact $badcolors $c]} break
 566     }
 567     set colormap($id) $c
 568 }
 569
 570 proc initgraph {} {
 571     global canvy canvy0 lineno numcommits lthickness nextcolor linespc
 572     global linestarty
 573     global nchildren ncleft
 574
 575     allcanvs delete all
 576     set nextcolor 0
 577     set canvy $canvy0
 578     set lineno -1
 579     set numcommits 0
 580     set lthickness [expr {int($linespc / 9) + 1}]
 581     catch {unset linestarty}
 582     foreach id [array names nchildren] {
 583         set ncleft($id) $nchildren($id)
 584     }
 585 }
 586
 587 proc drawcommitline {level} {
 588     global parents children nparents nchildren ncleft todo
 589     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 590     global datemode cdate
 591     global lineid linehtag linentag linedtag commitinfo
 592     global colormap numcommits currentparents
 593     global oldlevel oldnlines oldtodo
 594     global idtags idline idheads
 595     global lineno lthickness linestarty
 596     global commitlisted
 597
 598     incr numcommits
 599     incr lineno
 600     set id [lindex $todo $level]
 601     set lineid($lineno) $id
 602     set idline($id) $lineno
 603     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 604     if {![info exists commitinfo($id)]} {
 605         readcommit $id
 606         if {![info exists commitinfo($id)]} {
 607             set commitinfo($id) {"No commit information available"}
 608             set nparents($id) 0
 609         }
 610     }
 611     set currentparents {}
 612     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 613         set currentparents $parents($id)
 614     }
 615     set x [expr $canvx0 + $level * $linespc]
 616     set y1 $canvy
 617     set canvy [expr $canvy + $linespc]
 618     allcanvs conf -scrollregion \
 619         [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
 620     if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
 621         set t [$canv create line $x $linestarty($id) $x $y1 \
 622                    -width $lthickness -fill $colormap($id)]
 623         $canv lower $t
 624     }
 625     set orad [expr {$linespc / 3}]
 626     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
 627                [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
 628                -fill $ofill -outline black -width 1]
 629     $canv raise $t
 630     set xt [expr $canvx0 + [llength $todo] * $linespc]
 631     if {$nparents($id) > 2} {
 632         set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
 633     }
 634     set marks {}
 635     set ntags 0
 636     if {[info exists idtags($id)]} {
 637         set marks $idtags($id)
 638         set ntags [llength $marks]
 639     }
 640     if {[info exists idheads($id)]} {
 641         set marks [concat $marks $idheads($id)]
 642     }
 643     if {$marks != {}} {
 644         set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 645         set yt [expr $y1 - 0.5 * $linespc]
 646         set yb [expr $yt + $linespc - 1]
 647         set xvals {}
 648         set wvals {}
 649         foreach tag $marks {
 650             set wid [font measure $mainfont $tag]
 651             lappend xvals $xt
 652             lappend wvals $wid
 653             set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 654         }
 655         set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 656                    -width $lthickness -fill black]
 657         $canv lower $t
 658         foreach tag $marks x $xvals wid $wvals {
 659             set xl [expr $x + $delta]
 660             set xr [expr $x + $delta + $wid + $lthickness]
 661             if {[incr ntags -1] >= 0} {
 662                 # draw a tag
 663                 $canv create polygon $x [expr $yt + $delta] $xl $yt\
 664                     $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
 665                     -width 1 -outline black -fill yellow
 666             } else {
 667                 # draw a head
 668                 set xl [expr $xl - $delta/2]
 669                 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 670                     -width 1 -outline black -fill green
 671             }
 672             $canv create text $xl $y1 -anchor w -text $tag \
 673                 -font $mainfont
 674         }
 675     }
 676     set headline [lindex $commitinfo($id) 0]
 677     set name [lindex $commitinfo($id) 1]
 678     set date [lindex $commitinfo($id) 2]
 679     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 680                                -text $headline -font $mainfont ]
 681     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 682                                -text $name -font $namefont]
 683     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 684                                -text $date -font $mainfont]
 685 }
 686
 687 proc updatetodo {level noshortcut} {
 688     global datemode currentparents ncleft todo
 689     global linestarty oldlevel oldtodo oldnlines
 690     global canvy linespc
 691     global commitinfo
 692
 693     foreach p $currentparents {
 694         if {![info exists commitinfo($p)]} {
 695             readcommit $p
 696         }
 697     }
 698     if {!$noshortcut && [llength $currentparents] == 1} {
 699         set p [lindex $currentparents 0]
 700         if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
 701             assigncolor $p
 702             set linestarty($p) [expr $canvy - $linespc]
 703             set todo [lreplace $todo $level $level $p]
 704             return 0
 705         }
 706     }
 707
 708     set oldlevel $level
 709     set oldtodo $todo
 710     set oldnlines [llength $todo]
 711     set todo [lreplace $todo $level $level]
 712     set i $level
 713     foreach p $currentparents {
 714         incr ncleft($p) -1
 715         set k [lsearch -exact $todo $p]
 716         if {$k < 0} {
 717             assigncolor $p
 718             set todo [linsert $todo $i $p]
 719             incr i
 720         }
 721     }
 722     return 1
 723 }
 724
 725 proc drawslants {} {
 726     global canv linestarty canvx0 canvy linespc
 727     global oldlevel oldtodo todo currentparents
 728     global lthickness linespc canvy colormap
 729
 730     set y1 [expr $canvy - $linespc]
 731     set y2 $canvy
 732     set i -1
 733     foreach id $oldtodo {
 734         incr i
 735         if {$id == {}} continue
 736         set xi [expr {$canvx0 + $i * $linespc}]
 737         if {$i == $oldlevel} {
 738             foreach p $currentparents {
 739                 set j [lsearch -exact $todo $p]
 740                 if {$i == $j && ![info exists linestarty($p)]} {
 741                     set linestarty($p) $y1
 742                 } else {
 743                     set xj [expr {$canvx0 + $j * $linespc}]
 744                     set coords [list $xi $y1]
 745                     if {$j < $i - 1} {
 746                         lappend coords [expr $xj + $linespc] $y1
 747                     } elseif {$j > $i + 1} {
 748                         lappend coords [expr $xj - $linespc] $y1
 749                     }
 750                     lappend coords $xj $y2
 751                     set t [$canv create line $coords -width $lthickness \
 752                                -fill $colormap($p)]
 753                     $canv lower $t
 754                     if {![info exists linestarty($p)]} {
 755                         set linestarty($p) $y2
 756                     }
 757                 }
 758             }
 759         } elseif {[lindex $todo $i] != $id} {
 760             set j [lsearch -exact $todo $id]
 761             set xj [expr {$canvx0 + $j * $linespc}]
 762             set coords {}
 763             if {[info exists linestarty($id)] && $linestarty($id) < $y1} {
 764                 lappend coords $xi $linestarty($id)
 765             }
 766             lappend coords $xi $y1 $xj $y2
 767             set t [$canv create line $coords -width $lthickness \
 768                        -fill $colormap($id)]
 769             $canv lower $t
 770             set linestarty($id) $y2
 771         }
 772     }
 773 }
 774
 775 proc decidenext {} {
 776     global parents children nchildren ncleft todo
 777     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 778     global datemode cdate
 779     global lineid linehtag linentag linedtag commitinfo
 780     global currentparents oldlevel oldnlines oldtodo
 781     global lineno lthickness
 782
 783     # remove the null entry if present
 784     set nullentry [lsearch -exact $todo {}]
 785     if {$nullentry >= 0} {
 786         set todo [lreplace $todo $nullentry $nullentry]
 787     }
 788
 789     # choose which one to do next time around
 790     set todol [llength $todo]
 791     set level -1
 792     set latest {}
 793     for {set k $todol} {[incr k -1] >= 0} {} {
 794         set p [lindex $todo $k]
 795         if {$ncleft($p) == 0} {
 796             if {$datemode} {
 797                 if {$latest == {} || $cdate($p) > $latest} {
 798                     set level $k
 799                     set latest $cdate($p)
 800                 }
 801             } else {
 802                 set level $k
 803                 break
 804             }
 805         }
 806     }
 807     if {$level < 0} {
 808         if {$todo != {}} {
 809             puts "ERROR: none of the pending commits can be done yet:"
 810             foreach p $todo {
 811                 puts "  $p"
 812             }
 813         }
 814         return -1
 815     }
 816
 817     # If we are reducing, put in a null entry
 818     if {$todol < $oldnlines} {
 819         if {$nullentry >= 0} {
 820             set i $nullentry
 821             while {$i < $todol
 822                    && [lindex $oldtodo $i] == [lindex $todo $i]} {
 823                 incr i
 824             }
 825         } else {
 826             set i $oldlevel
 827             if {$level >= $i} {
 828                 incr i
 829             }
 830         }
 831         if {$i < $todol} {
 832             set todo [linsert $todo $i {}]
 833             if {$level >= $i} {
 834                 incr level
 835             }
 836         }
 837     }
 838     return $level
 839 }
 840
 841 proc drawcommit {id} {
 842     global phase todo nchildren datemode nextupdate
 843     global startcommits
 844
 845     if {$phase != "incrdraw"} {
 846         set phase incrdraw
 847         set todo $id
 848         set startcommits $id
 849         initgraph
 850         assigncolor $id
 851         drawcommitline 0
 852         updatetodo 0 $datemode
 853     } else {
 854         if {$nchildren($id) == 0} {
 855             lappend todo $id
 856             lappend startcommits $id
 857             assigncolor $id
 858         }
 859         set level [decidenext]
 860         if {$id != [lindex $todo $level]} {
 861             return
 862         }
 863         while 1 {
 864             drawslants
 865             drawcommitline $level
 866             if {[updatetodo $level $datemode]} {
 867                 set level [decidenext]
 868             }
 869             set id [lindex $todo $level]
 870             if {![info exists commitlisted($id)]} {
 871                 break
 872             }
 873             if {[clock clicks -milliseconds] >= $nextupdate} {
 874                 doupdate
 875                 if {$stopped} break
 876             }
 877         }
 878     }
 879 }
 880
 881 proc finishcommits {} {
 882     global phase
 883     global startcommits
 884     global ctext maincursor textcursor
 885
 886     if {$phase != "incrdraw"} {
 887         $canv delete all
 888         $canv create text 3 3 -anchor nw -text "No commits selected" \
 889             -font $mainfont -tags textitems
 890         set phase {}
 891         return
 892     }
 893     drawslants
 894     set level [decidenext]
 895     drawrest $level [llength $startcommits]
 896     . config -cursor $maincursor
 897     $ctext config -cursor $textcursor
 898 }
 899
 900 proc drawgraph {} {
 901     global nextupdate startmsecs startcommits todo
 902
 903     if {$startcommits == {}} return
 904     set startmsecs [clock clicks -milliseconds]
 905     set nextupdate [expr $startmsecs + 100]
 906     initgraph
 907     set todo [lindex $startcommits 0]
 908     drawrest 0 1
 909 }
 910
 911 proc drawrest {level startix} {
 912     global phase stopped redisplaying selectedline
 913     global datemode currentparents todo
 914     global numcommits
 915     global nextupdate startmsecs startcommits idline
 916
 917     set phase drawgraph
 918     set startid [lindex $startcommits $startix]
 919     set startline -1
 920     if {$startid != {}} {
 921         set startline $idline($startid)
 922     }
 923     while 1 {
 924         if {$stopped} break
 925         drawcommitline $level
 926         set hard [updatetodo $level $datemode]
 927         if {$numcommits == $startline} {
 928             lappend todo $startid
 929             set hard 1
 930             incr startix
 931             set startid [lindex $startcommits $startix]
 932             set startline -1
 933             if {$startid != {}} {
 934                 set startline $idline($startid)
 935             }
 936         }
 937         if {$hard} {
 938             set level [decidenext]
 939             if {$level < 0} break
 940             drawslants
 941         }
 942         if {[clock clicks -milliseconds] >= $nextupdate} {
 943             update
 944             incr nextupdate 100
 945         }
 946     }
 947     set phase {}
 948     set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
 949     puts "overall $drawmsecs ms for $numcommits commits"
 950     if {$redisplaying} {
 951         if {$stopped == 0 && [info exists selectedline]} {
 952             selectline $selectedline
 953         }
 954         if {$stopped == 1} {
 955             set stopped 0
 956             after idle drawgraph
 957         } else {
 958             set redisplaying 0
 959         }
 960     }
 961 }
 962
 963 proc findmatches {f} {
 964     global findtype foundstring foundstrlen
 965     if {$findtype == "Regexp"} {
 966         set matches [regexp -indices -all -inline $foundstring $f]
 967     } else {
 968         if {$findtype == "IgnCase"} {
 969             set str [string tolower $f]
 970         } else {
 971             set str $f
 972         }
 973         set matches {}
 974         set i 0
 975         while {[set j [string first $foundstring $str $i]] >= 0} {
 976             lappend matches [list $j [expr $j+$foundstrlen-1]]
 977             set i [expr $j + $foundstrlen]
 978         }
 979     }
 980     return $matches
 981 }
 982
 983 proc dofind {} {
 984     global findtype findloc findstring markedmatches commitinfo
 985     global numcommits lineid linehtag linentag linedtag
 986     global mainfont namefont canv canv2 canv3 selectedline
 987     global matchinglines foundstring foundstrlen
 988     unmarkmatches
 989     focus .
 990     set matchinglines {}
 991     set fldtypes {Headline Author Date Committer CDate Comment}
 992     if {$findtype == "IgnCase"} {
 993         set foundstring [string tolower $findstring]
 994     } else {
 995         set foundstring $findstring
 996     }
 997     set foundstrlen [string length $findstring]
 998     if {$foundstrlen == 0} return
 999     if {![info exists selectedline]} {
1000         set oldsel -1
1001     } else {
1002         set oldsel $selectedline
1003     }
1004     set didsel 0
1005     for {set l 0} {$l < $numcommits} {incr l} {
1006         set id $lineid($l)
1007         set info $commitinfo($id)
1008         set doesmatch 0
1009         foreach f $info ty $fldtypes {
1010             if {$findloc != "All fields" && $findloc != $ty} {
1011                 continue
1012             }
1013             set matches [findmatches $f]
1014             if {$matches == {}} continue
1015             set doesmatch 1
1016             if {$ty == "Headline"} {
1017                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1018             } elseif {$ty == "Author"} {
1019                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1020             } elseif {$ty == "Date"} {
1021                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1022             }
1023         }
1024         if {$doesmatch} {
1025             lappend matchinglines $l
1026             if {!$didsel && $l > $oldsel} {
1027                 findselectline $l
1028                 set didsel 1
1029             }
1030         }
1031     }
1032     if {$matchinglines == {}} {
1033         bell
1034     } elseif {!$didsel} {
1035         findselectline [lindex $matchinglines 0]
1036     }
1037 }
1038
1039 proc findselectline {l} {
1040     global findloc commentend ctext
1041     selectline $l
1042     if {$findloc == "All fields" || $findloc == "Comments"} {
1043         # highlight the matches in the comments
1044         set f [$ctext get 1.0 $commentend]
1045         set matches [findmatches $f]
1046         foreach match $matches {
1047             set start [lindex $match 0]
1048             set end [expr [lindex $match 1] + 1]
1049             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1050         }
1051     }
1052 }
1053
1054 proc findnext {} {
1055     global matchinglines selectedline
1056     if {![info exists matchinglines]} {
1057         dofind
1058         return
1059     }
1060     if {![info exists selectedline]} return
1061     foreach l $matchinglines {
1062         if {$l > $selectedline} {
1063             findselectline $l
1064             return
1065         }
1066     }
1067     bell
1068 }
1069
1070 proc findprev {} {
1071     global matchinglines selectedline
1072     if {![info exists matchinglines]} {
1073         dofind
1074         return
1075     }
1076     if {![info exists selectedline]} return
1077     set prev {}
1078     foreach l $matchinglines {
1079         if {$l >= $selectedline} break
1080         set prev $l
1081     }
1082     if {$prev != {}} {
1083         findselectline $prev
1084     } else {
1085         bell
1086     }
1087 }
1088
1089 proc markmatches {canv l str tag matches font} {
1090     set bbox [$canv bbox $tag]
1091     set x0 [lindex $bbox 0]
1092     set y0 [lindex $bbox 1]
1093     set y1 [lindex $bbox 3]
1094     foreach match $matches {
1095         set start [lindex $match 0]
1096         set end [lindex $match 1]
1097         if {$start > $end} continue
1098         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1099         set xlen [font measure $font [string range $str 0 [expr $end]]]
1100         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1101                    -outline {} -tags matches -fill yellow]
1102         $canv lower $t
1103     }
1104 }
1105
1106 proc unmarkmatches {} {
1107     global matchinglines
1108     allcanvs delete matches
1109     catch {unset matchinglines}
1110 }
1111
1112 proc selcanvline {x y} {
1113     global canv canvy0 ctext linespc selectedline
1114     global lineid linehtag linentag linedtag
1115     set ymax [lindex [$canv cget -scrollregion] 3]
1116     if {$ymax == {}} return
1117     set yfrac [lindex [$canv yview] 0]
1118     set y [expr {$y + $yfrac * $ymax}]
1119     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1120     if {$l < 0} {
1121         set l 0
1122     }
1123     if {[info exists selectedline] && $selectedline == $l} return
1124     unmarkmatches
1125     selectline $l
1126 }
1127
1128 proc selectline {l} {
1129     global canv canv2 canv3 ctext commitinfo selectedline
1130     global lineid linehtag linentag linedtag
1131     global canvy0 linespc nparents treepending
1132     global cflist treediffs currentid sha1entry
1133     global commentend seenfile idtags
1134     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1135     $canv delete secsel
1136     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1137                -tags secsel -fill [$canv cget -selectbackground]]
1138     $canv lower $t
1139     $canv2 delete secsel
1140     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1141                -tags secsel -fill [$canv2 cget -selectbackground]]
1142     $canv2 lower $t
1143     $canv3 delete secsel
1144     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1145                -tags secsel -fill [$canv3 cget -selectbackground]]
1146     $canv3 lower $t
1147     set y [expr {$canvy0 + $l * $linespc}]
1148     set ymax [lindex [$canv cget -scrollregion] 3]
1149     set ytop [expr {$y - $linespc - 1}]
1150     set ybot [expr {$y + $linespc + 1}]
1151     set wnow [$canv yview]
1152     set wtop [expr [lindex $wnow 0] * $ymax]
1153     set wbot [expr [lindex $wnow 1] * $ymax]
1154     set wh [expr {$wbot - $wtop}]
1155     set newtop $wtop
1156     if {$ytop < $wtop} {
1157         if {$ybot < $wtop} {
1158             set newtop [expr {$y - $wh / 2.0}]
1159         } else {
1160             set newtop $ytop
1161             if {$newtop > $wtop - $linespc} {
1162                 set newtop [expr {$wtop - $linespc}]
1163             }
1164         }
1165     } elseif {$ybot > $wbot} {
1166         if {$ytop > $wbot} {
1167             set newtop [expr {$y - $wh / 2.0}]
1168         } else {
1169             set newtop [expr {$ybot - $wh}]
1170             if {$newtop < $wtop + $linespc} {
1171                 set newtop [expr {$wtop + $linespc}]
1172             }
1173         }
1174     }
1175     if {$newtop != $wtop} {
1176         if {$newtop < 0} {
1177             set newtop 0
1178         }
1179         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1180     }
1181     set selectedline $l
1182
1183     set id $lineid($l)
1184     set currentid $id
1185     $sha1entry delete 0 end
1186     $sha1entry insert 0 $id
1187     $sha1entry selection from 0
1188     $sha1entry selection to end
1189
1190     $ctext conf -state normal
1191     $ctext delete 0.0 end
1192     set info $commitinfo($id)
1193     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
1194     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
1195     if {[info exists idtags($id)]} {
1196         $ctext insert end "Tags:"
1197         foreach tag $idtags($id) {
1198             $ctext insert end " $tag"
1199         }
1200         $ctext insert end "\n"
1201     }
1202     $ctext insert end "\n"
1203     $ctext insert end [lindex $info 5]
1204     $ctext insert end "\n"
1205     $ctext tag delete Comments
1206     $ctext tag remove found 1.0 end
1207     $ctext conf -state disabled
1208     set commentend [$ctext index "end - 1c"]
1209
1210     $cflist delete 0 end
1211     if {$nparents($id) == 1} {
1212         if {![info exists treediffs($id)]} {
1213             if {![info exists treepending]} {
1214                 gettreediffs $id
1215             }
1216         } else {
1217             addtocflist $id
1218         }
1219     }
1220     catch {unset seenfile}
1221 }
1222
1223 proc selnextline {dir} {
1224     global selectedline
1225     if {![info exists selectedline]} return
1226     set l [expr $selectedline + $dir]
1227     unmarkmatches
1228     selectline $l
1229 }
1230
1231 proc addtocflist {id} {
1232     global currentid treediffs cflist treepending
1233     if {$id != $currentid} {
1234         gettreediffs $currentid
1235         return
1236     }
1237     $cflist insert end "All files"
1238     foreach f $treediffs($currentid) {
1239         $cflist insert end $f
1240     }
1241     getblobdiffs $id
1242 }
1243
1244 proc gettreediffs {id} {
1245     global treediffs parents treepending
1246     set treepending $id
1247     set treediffs($id) {}
1248     set p [lindex $parents($id) 0]
1249     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1250     fconfigure $gdtf -blocking 0
1251     fileevent $gdtf readable "gettreediffline $gdtf $id"
1252 }
1253
1254 proc gettreediffline {gdtf id} {
1255     global treediffs treepending
1256     set n [gets $gdtf line]
1257     if {$n < 0} {
1258         if {![eof $gdtf]} return
1259         close $gdtf
1260         unset treepending
1261         addtocflist $id
1262         return
1263     }
1264     set file [lindex $line 5]
1265     lappend treediffs($id) $file
1266 }
1267
1268 proc getblobdiffs {id} {
1269     global parents diffopts blobdifffd env curdifftag curtagstart
1270     global diffindex difffilestart
1271     set p [lindex $parents($id) 0]
1272     set env(GIT_DIFF_OPTS) $diffopts
1273     if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1274         puts "error getting diffs: $err"
1275         return
1276     }
1277     fconfigure $bdf -blocking 0
1278     set blobdifffd($id) $bdf
1279     set curdifftag Comments
1280     set curtagstart 0.0
1281     set diffindex 0
1282     catch {unset difffilestart}
1283     fileevent $bdf readable "getblobdiffline $bdf $id"
1284 }
1285
1286 proc getblobdiffline {bdf id} {
1287     global currentid blobdifffd ctext curdifftag curtagstart seenfile
1288     global diffnexthead diffnextnote diffindex difffilestart
1289     set n [gets $bdf line]
1290     if {$n < 0} {
1291         if {[eof $bdf]} {
1292             close $bdf
1293             if {$id == $currentid && $bdf == $blobdifffd($id)} {
1294                 $ctext tag add $curdifftag $curtagstart end
1295                 set seenfile($curdifftag) 1
1296             }
1297         }
1298         return
1299     }
1300     if {$id != $currentid || $bdf != $blobdifffd($id)} {
1301         return
1302     }
1303     $ctext conf -state normal
1304     if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1305         # start of a new file
1306         $ctext insert end "\n"
1307         $ctext tag add $curdifftag $curtagstart end
1308         set seenfile($curdifftag) 1
1309         set curtagstart [$ctext index "end - 1c"]
1310         set header $fname
1311         if {[info exists diffnexthead]} {
1312             set fname $diffnexthead
1313             set header "$diffnexthead ($diffnextnote)"
1314             unset diffnexthead
1315         }
1316         set difffilestart($diffindex) [$ctext index "end - 1c"]
1317         incr diffindex
1318         set curdifftag "f:$fname"
1319         $ctext tag delete $curdifftag
1320         set l [expr {(78 - [string length $header]) / 2}]
1321         set pad [string range "----------------------------------------" 1 $l]
1322         $ctext insert end "$pad $header $pad\n" filesep
1323     } elseif {[string range $line 0 2] == "+++"} {
1324         # no need to do anything with this
1325     } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1326         set diffnexthead $fn
1327         set diffnextnote "created, mode $m"
1328     } elseif {[string range $line 0 8] == "Deleted: "} {
1329         set diffnexthead [string range $line 9 end]
1330         set diffnextnote "deleted"
1331     } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1332         # save the filename in case the next thing is "new file mode ..."
1333         set diffnexthead $fn
1334         set diffnextnote "modified"
1335     } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1336         set diffnextnote "new file, mode $m"
1337     } elseif {[string range $line 0 11] == "deleted file"} {
1338         set diffnextnote "deleted"
1339     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1340                    $line match f1l f1c f2l f2c rest]} {
1341         $ctext insert end "\t" hunksep
1342         $ctext insert end "    $f1l    " d0 "    $f2l    " d1
1343         $ctext insert end "    $rest \n" hunksep
1344     } else {
1345         set x [string range $line 0 0]
1346         if {$x == "-" || $x == "+"} {
1347             set tag [expr {$x == "+"}]
1348             set line [string range $line 1 end]
1349             $ctext insert end "$line\n" d$tag
1350         } elseif {$x == " "} {
1351             set line [string range $line 1 end]
1352             $ctext insert end "$line\n"
1353         } elseif {$x == "\\"} {
1354             # e.g. "\ No newline at end of file"
1355             $ctext insert end "$line\n" filesep
1356         } else {
1357             # Something else we don't recognize
1358             if {$curdifftag != "Comments"} {
1359                 $ctext insert end "\n"
1360                 $ctext tag add $curdifftag $curtagstart end
1361                 set seenfile($curdifftag) 1
1362                 set curtagstart [$ctext index "end - 1c"]
1363                 set curdifftag Comments
1364             }
1365             $ctext insert end "$line\n" filesep
1366         }
1367     }
1368     $ctext conf -state disabled
1369 }
1370
1371 proc nextfile {} {
1372     global difffilestart ctext
1373     set here [$ctext index @0,0]
1374     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1375         if {[$ctext compare $difffilestart($i) > $here]} {
1376             $ctext yview $difffilestart($i)
1377             break
1378         }
1379     }
1380 }
1381
1382 proc listboxsel {} {
1383     global ctext cflist currentid treediffs seenfile
1384     if {![info exists currentid]} return
1385     set sel [$cflist curselection]
1386     if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1387         # show everything
1388         $ctext tag conf Comments -elide 0
1389         foreach f $treediffs($currentid) {
1390             if [info exists seenfile(f:$f)] {
1391                 $ctext tag conf "f:$f" -elide 0
1392             }
1393         }
1394     } else {
1395         # just show selected files
1396         $ctext tag conf Comments -elide 1
1397         set i 1
1398         foreach f $treediffs($currentid) {
1399             set elide [expr {[lsearch -exact $sel $i] < 0}]
1400             if [info exists seenfile(f:$f)] {
1401                 $ctext tag conf "f:$f" -elide $elide
1402             }
1403             incr i
1404         }
1405     }
1406 }
1407
1408 proc setcoords {} {
1409     global linespc charspc canvx0 canvy0 mainfont
1410     set linespc [font metrics $mainfont -linespace]
1411     set charspc [font measure $mainfont "m"]
1412     set canvy0 [expr 3 + 0.5 * $linespc]
1413     set canvx0 [expr 3 + 0.5 * $linespc]
1414 }
1415
1416 proc redisplay {} {
1417     global selectedline stopped redisplaying phase
1418     if {$stopped > 1} return
1419     if {$phase == "getcommits"} return
1420     set redisplaying 1
1421     if {$phase == "drawgraph" || $phase == "incrdraw"} {
1422         set stopped 1
1423     } else {
1424         drawgraph
1425     }
1426 }
1427
1428 proc incrfont {inc} {
1429     global mainfont namefont textfont selectedline ctext canv phase
1430     global stopped entries
1431     unmarkmatches
1432     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1433     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1434     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1435     setcoords
1436     $ctext conf -font $textfont
1437     $ctext tag conf filesep -font [concat $textfont bold]
1438     foreach e $entries {
1439         $e conf -font $mainfont
1440     }
1441     if {$phase == "getcommits"} {
1442         $canv itemconf textitems -font $mainfont
1443     }
1444     redisplay
1445 }
1446
1447 proc sha1change {n1 n2 op} {
1448     global sha1string currentid sha1but
1449     if {$sha1string == {}
1450         || ([info exists currentid] && $sha1string == $currentid)} {
1451         set state disabled
1452     } else {
1453         set state normal
1454     }
1455     if {[$sha1but cget -state] == $state} return
1456     if {$state == "normal"} {
1457         $sha1but conf -state normal -relief raised -text "Goto: "
1458     } else {
1459         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1460     }
1461 }
1462
1463 proc gotocommit {} {
1464     global sha1string currentid idline tagids
1465     if {$sha1string == {}
1466         || ([info exists currentid] && $sha1string == $currentid)} return
1467     if {[info exists tagids($sha1string)]} {
1468         set id $tagids($sha1string)
1469     } else {
1470         set id [string tolower $sha1string]
1471     }
1472     if {[info exists idline($id)]} {
1473         selectline $idline($id)
1474         return
1475     }
1476     if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1477         set type "SHA1 id"
1478     } else {
1479         set type "Tag"
1480     }
1481     error_popup "$type $sha1string is not known"
1482 }
1483
1484 proc doquit {} {
1485     global stopped
1486     set stopped 100
1487     destroy .
1488 }
1489
1490 # defaults...
1491 set datemode 0
1492 set boldnames 0
1493 set diffopts "-U 5 -p"
1494
1495 set mainfont {Helvetica 9}
1496 set textfont {Courier 9}
1497
1498 set colors {green red blue magenta darkgrey brown orange}
1499
1500 catch {source ~/.gitk}
1501
1502 set namefont $mainfont
1503 if {$boldnames} {
1504     lappend namefont bold
1505 }
1506
1507 set revtreeargs {}
1508 foreach arg $argv {
1509     switch -regexp -- $arg {
1510         "^$" { }
1511         "^-b" { set boldnames 1 }
1512         "^-d" { set datemode 1 }
1513         default {
1514             lappend revtreeargs $arg
1515         }
1516     }
1517 }
1518
1519 set noreadobj [catch {load libreadobj.so.0.0}]
1520 set stopped 0
1521 set redisplaying 0
1522 set stuffsaved 0
1523 setcoords
1524 makewindow
1525 readrefs
1526 getcommits $revtreeargs