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