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