gitkon commit Use git-rev-list --header. (b490a99)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec 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
  12proc 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
  47proc 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
  65to 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
 113proc doupdate {} {
 114    global commfd nextupdate
 115
 116    incr nextupdate 100
 117    fileevent $commfd readable {}
 118    update
 119    fileevent $commfd readable "getcommitlines $commfd"
 120}
 121
 122proc readcommit {id} {
 123    if [catch {set contents [exec git-cat-file commit $id]}] return
 124    parsecommit $id $contents 0
 125}
 126
 127proc 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
 195proc 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
 241proc 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
 253proc 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.
 410proc 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
 424proc click {w} {
 425    global entries
 426    foreach e $entries {
 427        if {$w == $e} return
 428    }
 429    focus .
 430}
 431
 432proc 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
 459proc 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
 490proc 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
 511proc allcanvs args {
 512    global canv canv2 canv3
 513    eval $canv $args
 514    eval $canv2 $args
 515    eval $canv3 $args
 516}
 517
 518proc 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
 525proc 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 {
 534Gitk version 1.1
 535
 536Copyright © 2005 Paul Mackerras
 537
 538Use 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
 547proc 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
 588proc 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
 606proc 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
 615proc 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
 735proc 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
 769proc 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
 819proc 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
 885proc 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
 923proc 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
 942proc 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
 953proc 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
1007proc 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
1027proc 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
1083proc 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
1098proc 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
1114proc 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
1133proc 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
1150proc unmarkmatches {} {
1151    global matchinglines
1152    allcanvs delete matches
1153    catch {unset matchinglines}
1154}
1155
1156proc 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
1172proc 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
1268proc selnextline {dir} {
1269    global selectedline
1270    if {![info exists selectedline]} return
1271    set l [expr $selectedline + $dir]
1272    unmarkmatches
1273    selectline $l
1274}
1275
1276proc 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
1289proc 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
1299proc 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
1313proc 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
1331proc 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
1416proc 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
1427proc 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
1453proc 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
1461proc 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
1473proc 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
1492proc 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
1508proc 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
1529proc linemenu {x y id} {
1530    global linectxmenu linemenuid
1531    set linemenuid $id
1532    $linectxmenu post $x $y
1533}
1534
1535proc lineselect {} {
1536    global linemenuid idline
1537    if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
1538        selectline $idline($linemenuid)
1539    }
1540}
1541
1542proc 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
1557proc 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
1570proc 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
1583proc 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
1605proc doquit {} {
1606    global stopped
1607    set stopped 100
1608    destroy .
1609}
1610
1611# defaults...
1612set datemode 0
1613set boldnames 0
1614set diffopts "-U 5 -p"
1615
1616set mainfont {Helvetica 9}
1617set textfont {Courier 9}
1618
1619set colors {green red blue magenta darkgrey brown orange}
1620
1621catch {source ~/.gitk}
1622
1623set namefont $mainfont
1624if {$boldnames} {
1625    lappend namefont bold
1626}
1627
1628set revtreeargs {}
1629foreach 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
1640set stopped 0
1641set redisplaying 0
1642set stuffsaved 0
1643setcoords
1644makewindow
1645readrefs
1646getcommits $revtreeargs