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