Andrew's git - gitweb.git/blob

   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
  10proc getcommits {rargs} {
  11    global commits commfd phase canv mainfont env
  12    global startmsecs nextupdate
  13    global ctext maincursor textcursor leftover
  14
  15    # check that we can find a .git directory somewhere...
  16    if {[info exists env(GIT_DIR)]} {
  17        set gitdir $env(GIT_DIR)
  18    } else {
  19        set gitdir ".git"
  20    }
  21    if {![file isdirectory $gitdir]} {
  22        error_popup "Cannot find the git directory \"$gitdir\"."
  23        exit 1
  24    }
  25    set commits {}
  26    set phase getcommits
  27    set startmsecs [clock clicks -milliseconds]
  28    set nextupdate [expr $startmsecs + 100]
  29    if [catch {
  30        set parse_args [concat --default HEAD $rargs]
  31        set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
  32    }] {
  33        # if git-rev-parse failed for some reason...
  34        if {$rargs == {}} {
  35            set rargs HEAD
  36        }
  37        set parsed_args $rargs
  38    }
  39    if [catch {
  40        set commfd [open "|git-rev-list --header --topo-order $parsed_args" r]
  41    } err] {
  42        puts stderr "Error executing git-rev-list: $err"
  43        exit 1
  44    }
  45    set leftover {}
  46    fconfigure $commfd -blocking 0 -translation binary
  47    fileevent $commfd readable "getcommitlines $commfd"
  48    $canv delete all
  49    $canv create text 3 3 -anchor nw -text "Reading commits..." \
  50        -font $mainfont -tags textitems
  51    . config -cursor watch
  52    $ctext config -cursor watch
  53}
  54
  55proc getcommitlines {commfd}  {
  56    global commits parents cdate children nchildren
  57    global commitlisted phase commitinfo nextupdate
  58    global stopped redisplaying leftover
  59
  60    set stuff [read $commfd]
  61    if {$stuff == {}} {
  62        if {![eof $commfd]} return
  63        # set it blocking so we wait for the process to terminate
  64        fconfigure $commfd -blocking 1
  65        if {![catch {close $commfd} err]} {
  66            after idle finishcommits
  67            return
  68        }
  69        if {[string range $err 0 4] == "usage"} {
  70            set err \
  71{Gitk: error reading commits: bad arguments to git-rev-list.
  72(Note: arguments to gitk are passed to git-rev-list
  73to allow selection of commits to be displayed.)}
  74        } else {
  75            set err "Error reading commits: $err"
  76        }
  77        error_popup $err
  78        exit 1
  79    }
  80    set start 0
  81    while 1 {
  82        set i [string first "\0" $stuff $start]
  83        if {$i < 0} {
  84            append leftover [string range $stuff $start end]
  85            return
  86        }
  87        set cmit [string range $stuff $start [expr {$i - 1}]]
  88        if {$start == 0} {
  89            set cmit "$leftover$cmit"
  90            set leftover {}
  91        }
  92        set start [expr {$i + 1}]
  93        if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
  94            set shortcmit $cmit
  95            if {[string length $shortcmit] > 80} {
  96                set shortcmit "[string range $shortcmit 0 80]..."
  97            }
  98            error_popup "Can't parse git-rev-list output: {$shortcmit}"
  99            exit 1
 100        }
 101        set cmit [string range $cmit 41 end]
 102        lappend commits $id
 103        set commitlisted($id) 1
 104        parsecommit $id $cmit 1
 105        drawcommit $id
 106        if {[clock clicks -milliseconds] >= $nextupdate} {
 107            doupdate
 108        }
 109        while {$redisplaying} {
 110            set redisplaying 0
 111            if {$stopped == 1} {
 112                set stopped 0
 113                set phase "getcommits"
 114                foreach id $commits {
 115                    drawcommit $id
 116                    if {$stopped} break
 117                    if {[clock clicks -milliseconds] >= $nextupdate} {
 118                        doupdate
 119                    }
 120                }
 121            }
 122        }
 123    }
 124}
 125
 126proc doupdate {} {
 127    global commfd nextupdate
 128
 129    incr nextupdate 100
 130    fileevent $commfd readable {}
 131    update
 132    fileevent $commfd readable "getcommitlines $commfd"
 133}
 134
 135proc readcommit {id} {
 136    if [catch {set contents [exec git-cat-file commit $id]}] return
 137    parsecommit $id $contents 0
 138}
 139
 140proc parsecommit {id contents listed} {
 141    global commitinfo children nchildren parents nparents cdate ncleft
 142
 143    set inhdr 1
 144    set comment {}
 145    set headline {}
 146    set auname {}
 147    set audate {}
 148    set comname {}
 149    set comdate {}
 150    if {![info exists nchildren($id)]} {
 151        set children($id) {}
 152        set nchildren($id) 0
 153        set ncleft($id) 0
 154    }
 155    set parents($id) {}
 156    set nparents($id) 0
 157    foreach line [split $contents "\n"] {
 158        if {$inhdr} {
 159            if {$line == {}} {
 160                set inhdr 0
 161            } else {
 162                set tag [lindex $line 0]
 163                if {$tag == "parent"} {
 164                    set p [lindex $line 1]
 165                    if {![info exists nchildren($p)]} {
 166                        set children($p) {}
 167                        set nchildren($p) 0
 168                        set ncleft($p) 0
 169                    }
 170                    lappend parents($id) $p
 171                    incr nparents($id)
 172                    # sometimes we get a commit that lists a parent twice...
 173                    if {$listed && [lsearch -exact $children($p) $id] < 0} {
 174                        lappend children($p) $id
 175                        incr nchildren($p)
 176                        incr ncleft($p)
 177                    }
 178                } elseif {$tag == "author"} {
 179                    set x [expr {[llength $line] - 2}]
 180                    set audate [lindex $line $x]
 181                    set auname [lrange $line 1 [expr {$x - 1}]]
 182                } elseif {$tag == "committer"} {
 183                    set x [expr {[llength $line] - 2}]
 184                    set comdate [lindex $line $x]
 185                    set comname [lrange $line 1 [expr {$x - 1}]]
 186                }
 187            }
 188        } else {
 189            if {$comment == {}} {
 190                set headline [string trim $line]
 191            } else {
 192                append comment "\n"
 193            }
 194            if {!$listed} {
 195                # git-rev-list indents the comment by 4 spaces;
 196                # if we got this via git-cat-file, add the indentation
 197                append comment "    "
 198            }
 199            append comment $line
 200        }
 201    }
 202    if {$audate != {}} {
 203        set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 204    }
 205    if {$comdate != {}} {
 206        set cdate($id) $comdate
 207        set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 208    }
 209    set commitinfo($id) [list $headline $auname $audate \
 210                             $comname $comdate $comment]
 211}
 212
 213proc readrefs {} {
 214    global tagids idtags headids idheads
 215    set tags [glob -nocomplain -types f .git/refs/tags/*]
 216    foreach f $tags {
 217        catch {
 218            set fd [open $f r]
 219            set line [read $fd]
 220            if {[regexp {^[0-9a-f]{40}} $line id]} {
 221                set direct [file tail $f]
 222                set tagids($direct) $id
 223                lappend idtags($id) $direct
 224                set contents [split [exec git-cat-file tag $id] "\n"]
 225                set obj {}
 226                set type {}
 227                set tag {}
 228                foreach l $contents {
 229                    if {$l == {}} break
 230                    switch -- [lindex $l 0] {
 231                        "object" {set obj [lindex $l 1]}
 232                        "type" {set type [lindex $l 1]}
 233                        "tag" {set tag [string range $l 4 end]}
 234                    }
 235                }
 236                if {$obj != {} && $type == "commit" && $tag != {}} {
 237                    set tagids($tag) $obj
 238                    lappend idtags($obj) $tag
 239                }
 240            }
 241            close $fd
 242        }
 243    }
 244    set heads [glob -nocomplain -types f .git/refs/heads/*]
 245    foreach f $heads {
 246        catch {
 247            set fd [open $f r]
 248            set line [read $fd 40]
 249            if {[regexp {^[0-9a-f]{40}} $line id]} {
 250                set head [file tail $f]
 251                set headids($head) $line
 252                lappend idheads($line) $head
 253            }
 254            close $fd
 255        }
 256    }
 257}
 258
 259proc error_popup msg {
 260    set w .error
 261    toplevel $w
 262    wm transient $w .
 263    message $w.m -text $msg -justify center -aspect 400
 264    pack $w.m -side top -fill x -padx 20 -pady 20
 265    button $w.ok -text OK -command "destroy $w"
 266    pack $w.ok -side bottom -fill x
 267    bind $w <Visibility> "grab $w; focus $w"
 268    tkwait window $w
 269}
 270
 271proc makewindow {} {
 272    global canv canv2 canv3 linespc charspc ctext cflist textfont
 273    global findtype findtypemenu findloc findstring fstring geometry
 274    global entries sha1entry sha1string sha1but
 275    global maincursor textcursor
 276    global rowctxmenu gaudydiff mergemax
 277
 278    menu .bar
 279    .bar add cascade -label "File" -menu .bar.file
 280    menu .bar.file
 281    .bar.file add command -label "Quit" -command doquit
 282    menu .bar.help
 283    .bar add cascade -label "Help" -menu .bar.help
 284    .bar.help add command -label "About gitk" -command about
 285    . configure -menu .bar
 286
 287    if {![info exists geometry(canv1)]} {
 288        set geometry(canv1) [expr 45 * $charspc]
 289        set geometry(canv2) [expr 30 * $charspc]
 290        set geometry(canv3) [expr 15 * $charspc]
 291        set geometry(canvh) [expr 25 * $linespc + 4]
 292        set geometry(ctextw) 80
 293        set geometry(ctexth) 30
 294        set geometry(cflistw) 30
 295    }
 296    panedwindow .ctop -orient vertical
 297    if {[info exists geometry(width)]} {
 298        .ctop conf -width $geometry(width) -height $geometry(height)
 299        set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 300        set geometry(ctexth) [expr {($texth - 8) /
 301                                    [font metrics $textfont -linespace]}]
 302    }
 303    frame .ctop.top
 304    frame .ctop.top.bar
 305    pack .ctop.top.bar -side bottom -fill x
 306    set cscroll .ctop.top.csb
 307    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 308    pack $cscroll -side right -fill y
 309    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 310    pack .ctop.top.clist -side top -fill both -expand 1
 311    .ctop add .ctop.top
 312    set canv .ctop.top.clist.canv
 313    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 314        -bg white -bd 0 \
 315        -yscrollincr $linespc -yscrollcommand "$cscroll set"
 316    .ctop.top.clist add $canv
 317    set canv2 .ctop.top.clist.canv2
 318    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 319        -bg white -bd 0 -yscrollincr $linespc
 320    .ctop.top.clist add $canv2
 321    set canv3 .ctop.top.clist.canv3
 322    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 323        -bg white -bd 0 -yscrollincr $linespc
 324    .ctop.top.clist add $canv3
 325    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 326
 327    set sha1entry .ctop.top.bar.sha1
 328    set entries $sha1entry
 329    set sha1but .ctop.top.bar.sha1label
 330    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 331        -command gotocommit -width 8
 332    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 333    pack .ctop.top.bar.sha1label -side left
 334    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 335    trace add variable sha1string write sha1change
 336    pack $sha1entry -side left -pady 2
 337    button .ctop.top.bar.findbut -text "Find" -command dofind
 338    pack .ctop.top.bar.findbut -side left
 339    set findstring {}
 340    set fstring .ctop.top.bar.findstring
 341    lappend entries $fstring
 342    entry $fstring -width 30 -font $textfont -textvariable findstring
 343    pack $fstring -side left -expand 1 -fill x
 344    set findtype Exact
 345    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 346                          findtype Exact IgnCase Regexp]
 347    set findloc "All fields"
 348    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 349        Comments Author Committer Files Pickaxe
 350    pack .ctop.top.bar.findloc -side right
 351    pack .ctop.top.bar.findtype -side right
 352    # for making sure type==Exact whenever loc==Pickaxe
 353    trace add variable findloc write findlocchange
 354
 355    panedwindow .ctop.cdet -orient horizontal
 356    .ctop add .ctop.cdet
 357    frame .ctop.cdet.left
 358    set ctext .ctop.cdet.left.ctext
 359    text $ctext -bg white -state disabled -font $textfont \
 360        -width $geometry(ctextw) -height $geometry(ctexth) \
 361        -yscrollcommand ".ctop.cdet.left.sb set"
 362    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 363    pack .ctop.cdet.left.sb -side right -fill y
 364    pack $ctext -side left -fill both -expand 1
 365    .ctop.cdet add .ctop.cdet.left
 366
 367    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 368    if {$gaudydiff} {
 369        $ctext tag conf hunksep -back blue -fore white
 370        $ctext tag conf d0 -back "#ff8080"
 371        $ctext tag conf d1 -back green
 372    } else {
 373        $ctext tag conf hunksep -fore blue
 374        $ctext tag conf d0 -fore red
 375        $ctext tag conf d1 -fore "#00a000"
 376        $ctext tag conf m0 -fore red
 377        $ctext tag conf m1 -fore blue
 378        $ctext tag conf m2 -fore green
 379        $ctext tag conf m3 -fore purple
 380        $ctext tag conf m4 -fore brown
 381        $ctext tag conf mmax -fore darkgrey
 382        set mergemax 5
 383        $ctext tag conf mresult -font [concat $textfont bold]
 384        $ctext tag conf msep -font [concat $textfont bold]
 385        $ctext tag conf found -back yellow
 386    }
 387
 388    frame .ctop.cdet.right
 389    set cflist .ctop.cdet.right.cfiles
 390    listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 391        -yscrollcommand ".ctop.cdet.right.sb set"
 392    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 393    pack .ctop.cdet.right.sb -side right -fill y
 394    pack $cflist -side left -fill both -expand 1
 395    .ctop.cdet add .ctop.cdet.right
 396    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 397
 398    pack .ctop -side top -fill both -expand 1
 399
 400    bindall <1> {selcanvline %W %x %y}
 401    #bindall <B1-Motion> {selcanvline %W %x %y}
 402    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 403    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 404    bindall <2> "allcanvs scan mark 0 %y"
 405    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 406    bind . <Key-Up> "selnextline -1"
 407    bind . <Key-Down> "selnextline 1"
 408    bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 409    bind . <Key-Next> "allcanvs yview scroll 1 pages"
 410    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 411    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 412    bindkey <Key-space> "$ctext yview scroll 1 pages"
 413    bindkey p "selnextline -1"
 414    bindkey n "selnextline 1"
 415    bindkey b "$ctext yview scroll -1 pages"
 416    bindkey d "$ctext yview scroll 18 units"
 417    bindkey u "$ctext yview scroll -18 units"
 418    bindkey / {findnext 1}
 419    bindkey <Key-Return> {findnext 0}
 420    bindkey ? findprev
 421    bindkey f nextfile
 422    bind . <Control-q> doquit
 423    bind . <Control-f> dofind
 424    bind . <Control-g> {findnext 0}
 425    bind . <Control-r> findprev
 426    bind . <Control-equal> {incrfont 1}
 427    bind . <Control-KP_Add> {incrfont 1}
 428    bind . <Control-minus> {incrfont -1}
 429    bind . <Control-KP_Subtract> {incrfont -1}
 430    bind $cflist <<ListboxSelect>> listboxsel
 431    bind . <Destroy> {savestuff %W}
 432    bind . <Button-1> "click %W"
 433    bind $fstring <Key-Return> dofind
 434    bind $sha1entry <Key-Return> gotocommit
 435    bind $sha1entry <<PasteSelection>> clearsha1
 436
 437    set maincursor [. cget -cursor]
 438    set textcursor [$ctext cget -cursor]
 439
 440    set rowctxmenu .rowctxmenu
 441    menu $rowctxmenu -tearoff 0
 442    $rowctxmenu add command -label "Diff this -> selected" \
 443        -command {diffvssel 0}
 444    $rowctxmenu add command -label "Diff selected -> this" \
 445        -command {diffvssel 1}
 446    $rowctxmenu add command -label "Make patch" -command mkpatch
 447    $rowctxmenu add command -label "Create tag" -command mktag
 448    $rowctxmenu add command -label "Write commit to file" -command writecommit
 449}
 450
 451# when we make a key binding for the toplevel, make sure
 452# it doesn't get triggered when that key is pressed in the
 453# find string entry widget.
 454proc bindkey {ev script} {
 455    global entries
 456    bind . $ev $script
 457    set escript [bind Entry $ev]
 458    if {$escript == {}} {
 459        set escript [bind Entry <Key>]
 460    }
 461    foreach e $entries {
 462        bind $e $ev "$escript; break"
 463    }
 464}
 465
 466# set the focus back to the toplevel for any click outside
 467# the entry widgets
 468proc click {w} {
 469    global entries
 470    foreach e $entries {
 471        if {$w == $e} return
 472    }
 473    focus .
 474}
 475
 476proc savestuff {w} {
 477    global canv canv2 canv3 ctext cflist mainfont textfont
 478    global stuffsaved findmergefiles gaudydiff
 479
 480    if {$stuffsaved} return
 481    if {![winfo viewable .]} return
 482    catch {
 483        set f [open "~/.gitk-new" w]
 484        puts $f [list set mainfont $mainfont]
 485        puts $f [list set textfont $textfont]
 486        puts $f [list set findmergefiles $findmergefiles]
 487        puts $f [list set gaudydiff $gaudydiff]
 488        puts $f "set geometry(width) [winfo width .ctop]"
 489        puts $f "set geometry(height) [winfo height .ctop]"
 490        puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
 491        puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
 492        puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
 493        puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
 494        set wid [expr {([winfo width $ctext] - 8) \
 495                           / [font measure $textfont "0"]}]
 496        puts $f "set geometry(ctextw) $wid"
 497        set wid [expr {([winfo width $cflist] - 11) \
 498                           / [font measure [$cflist cget -font] "0"]}]
 499        puts $f "set geometry(cflistw) $wid"
 500        close $f
 501        file rename -force "~/.gitk-new" "~/.gitk"
 502    }
 503    set stuffsaved 1
 504}
 505
 506proc resizeclistpanes {win w} {
 507    global oldwidth
 508    if [info exists oldwidth($win)] {
 509        set s0 [$win sash coord 0]
 510        set s1 [$win sash coord 1]
 511        if {$w < 60} {
 512            set sash0 [expr {int($w/2 - 2)}]
 513            set sash1 [expr {int($w*5/6 - 2)}]
 514        } else {
 515            set factor [expr {1.0 * $w / $oldwidth($win)}]
 516            set sash0 [expr {int($factor * [lindex $s0 0])}]
 517            set sash1 [expr {int($factor * [lindex $s1 0])}]
 518            if {$sash0 < 30} {
 519                set sash0 30
 520            }
 521            if {$sash1 < $sash0 + 20} {
 522                set sash1 [expr $sash0 + 20]
 523            }
 524            if {$sash1 > $w - 10} {
 525                set sash1 [expr $w - 10]
 526                if {$sash0 > $sash1 - 20} {
 527                    set sash0 [expr $sash1 - 20]
 528                }
 529            }
 530        }
 531        $win sash place 0 $sash0 [lindex $s0 1]
 532        $win sash place 1 $sash1 [lindex $s1 1]
 533    }
 534    set oldwidth($win) $w
 535}
 536
 537proc resizecdetpanes {win w} {
 538    global oldwidth
 539    if [info exists oldwidth($win)] {
 540        set s0 [$win sash coord 0]
 541        if {$w < 60} {
 542            set sash0 [expr {int($w*3/4 - 2)}]
 543        } else {
 544            set factor [expr {1.0 * $w / $oldwidth($win)}]
 545            set sash0 [expr {int($factor * [lindex $s0 0])}]
 546            if {$sash0 < 45} {
 547                set sash0 45
 548            }
 549            if {$sash0 > $w - 15} {
 550                set sash0 [expr $w - 15]
 551            }
 552        }
 553        $win sash place 0 $sash0 [lindex $s0 1]
 554    }
 555    set oldwidth($win) $w
 556}
 557
 558proc allcanvs args {
 559    global canv canv2 canv3
 560    eval $canv $args
 561    eval $canv2 $args
 562    eval $canv3 $args
 563}
 564
 565proc bindall {event action} {
 566    global canv canv2 canv3
 567    bind $canv $event $action
 568    bind $canv2 $event $action
 569    bind $canv3 $event $action
 570}
 571
 572proc about {} {
 573    set w .about
 574    if {[winfo exists $w]} {
 575        raise $w
 576        return
 577    }
 578    toplevel $w
 579    wm title $w "About gitk"
 580    message $w.m -text {
 581Gitk version 1.2
 582
 583Copyright © 2005 Paul Mackerras
 584
 585Use and redistribute under the terms of the GNU General Public License} \
 586            -justify center -aspect 400
 587    pack $w.m -side top -fill x -padx 20 -pady 20
 588    button $w.ok -text Close -command "destroy $w"
 589    pack $w.ok -side bottom
 590}
 591
 592proc assigncolor {id} {
 593    global commitinfo colormap commcolors colors nextcolor
 594    global parents nparents children nchildren
 595    global cornercrossings crossings
 596
 597    if [info exists colormap($id)] return
 598    set ncolors [llength $colors]
 599    if {$nparents($id) <= 1 && $nchildren($id) == 1} {
 600        set child [lindex $children($id) 0]
 601        if {[info exists colormap($child)]
 602            && $nparents($child) == 1} {
 603            set colormap($id) $colormap($child)
 604            return
 605        }
 606    }
 607    set badcolors {}
 608    if {[info exists cornercrossings($id)]} {
 609        foreach x $cornercrossings($id) {
 610            if {[info exists colormap($x)]
 611                && [lsearch -exact $badcolors $colormap($x)] < 0} {
 612                lappend badcolors $colormap($x)
 613            }
 614        }
 615        if {[llength $badcolors] >= $ncolors} {
 616            set badcolors {}
 617        }
 618    }
 619    set origbad $badcolors
 620    if {[llength $badcolors] < $ncolors - 1} {
 621        if {[info exists crossings($id)]} {
 622            foreach x $crossings($id) {
 623                if {[info exists colormap($x)]
 624                    && [lsearch -exact $badcolors $colormap($x)] < 0} {
 625                    lappend badcolors $colormap($x)
 626                }
 627            }
 628            if {[llength $badcolors] >= $ncolors} {
 629                set badcolors $origbad
 630            }
 631        }
 632        set origbad $badcolors
 633    }
 634    if {[llength $badcolors] < $ncolors - 1} {
 635        foreach child $children($id) {
 636            if {[info exists colormap($child)]
 637                && [lsearch -exact $badcolors $colormap($child)] < 0} {
 638                lappend badcolors $colormap($child)
 639            }
 640            if {[info exists parents($child)]} {
 641                foreach p $parents($child) {
 642                    if {[info exists colormap($p)]
 643                        && [lsearch -exact $badcolors $colormap($p)] < 0} {
 644                        lappend badcolors $colormap($p)
 645                    }
 646                }
 647            }
 648        }
 649        if {[llength $badcolors] >= $ncolors} {
 650            set badcolors $origbad
 651        }
 652    }
 653    for {set i 0} {$i <= $ncolors} {incr i} {
 654        set c [lindex $colors $nextcolor]
 655        if {[incr nextcolor] >= $ncolors} {
 656            set nextcolor 0
 657        }
 658        if {[lsearch -exact $badcolors $c]} break
 659    }
 660    set colormap($id) $c
 661}
 662
 663proc initgraph {} {
 664    global canvy canvy0 lineno numcommits lthickness nextcolor linespc
 665    global mainline sidelines
 666    global nchildren ncleft
 667
 668    allcanvs delete all
 669    set nextcolor 0
 670    set canvy $canvy0
 671    set lineno -1
 672    set numcommits 0
 673    set lthickness [expr {int($linespc / 9) + 1}]
 674    catch {unset mainline}
 675    catch {unset sidelines}
 676    foreach id [array names nchildren] {
 677        set ncleft($id) $nchildren($id)
 678    }
 679}
 680
 681proc bindline {t id} {
 682    global canv
 683
 684    $canv bind $t <Enter> "lineenter %x %y $id"
 685    $canv bind $t <Motion> "linemotion %x %y $id"
 686    $canv bind $t <Leave> "lineleave $id"
 687    $canv bind $t <Button-1> "lineclick %x %y $id"
 688}
 689
 690proc drawcommitline {level} {
 691    global parents children nparents nchildren todo
 692    global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 693    global lineid linehtag linentag linedtag commitinfo
 694    global colormap numcommits currentparents dupparents
 695    global oldlevel oldnlines oldtodo
 696    global idtags idline idheads
 697    global lineno lthickness mainline sidelines
 698    global commitlisted rowtextx idpos
 699
 700    incr numcommits
 701    incr lineno
 702    set id [lindex $todo $level]
 703    set lineid($lineno) $id
 704    set idline($id) $lineno
 705    set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 706    if {![info exists commitinfo($id)]} {
 707        readcommit $id
 708        if {![info exists commitinfo($id)]} {
 709            set commitinfo($id) {"No commit information available"}
 710            set nparents($id) 0
 711        }
 712    }
 713    assigncolor $id
 714    set currentparents {}
 715    set dupparents {}
 716    if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 717        foreach p $parents($id) {
 718            if {[lsearch -exact $currentparents $p] < 0} {
 719                lappend currentparents $p
 720            } else {
 721                # remember that this parent was listed twice
 722                lappend dupparents $p
 723            }
 724        }
 725    }
 726    set x [expr $canvx0 + $level * $linespc]
 727    set y1 $canvy
 728    set canvy [expr $canvy + $linespc]
 729    allcanvs conf -scrollregion \
 730        [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
 731    if {[info exists mainline($id)]} {
 732        lappend mainline($id) $x $y1
 733        set t [$canv create line $mainline($id) \
 734                   -width $lthickness -fill $colormap($id)]
 735        $canv lower $t
 736        bindline $t $id
 737    }
 738    if {[info exists sidelines($id)]} {
 739        foreach ls $sidelines($id) {
 740            set coords [lindex $ls 0]
 741            set thick [lindex $ls 1]
 742            set t [$canv create line $coords -fill $colormap($id) \
 743                       -width [expr {$thick * $lthickness}]]
 744            $canv lower $t
 745            bindline $t $id
 746        }
 747    }
 748    set orad [expr {$linespc / 3}]
 749    set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
 750               [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
 751               -fill $ofill -outline black -width 1]
 752    $canv raise $t
 753    $canv bind $t <1> {selcanvline {} %x %y}
 754    set xt [expr $canvx0 + [llength $todo] * $linespc]
 755    if {[llength $currentparents] > 2} {
 756        set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
 757    }
 758    set rowtextx($lineno) $xt
 759    set idpos($id) [list $x $xt $y1]
 760    if {[info exists idtags($id)] || [info exists idheads($id)]} {
 761        set xt [drawtags $id $x $xt $y1]
 762    }
 763    set headline [lindex $commitinfo($id) 0]
 764    set name [lindex $commitinfo($id) 1]
 765    set date [lindex $commitinfo($id) 2]
 766    set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 767                               -text $headline -font $mainfont ]
 768    $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
 769    set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 770                               -text $name -font $namefont]
 771    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 772                               -text $date -font $mainfont]
 773}
 774
 775proc drawtags {id x xt y1} {
 776    global idtags idheads
 777    global linespc lthickness
 778    global canv mainfont
 779
 780    set marks {}
 781    set ntags 0
 782    if {[info exists idtags($id)]} {
 783        set marks $idtags($id)
 784        set ntags [llength $marks]
 785    }
 786    if {[info exists idheads($id)]} {
 787        set marks [concat $marks $idheads($id)]
 788    }
 789    if {$marks eq {}} {
 790        return $xt
 791    }
 792
 793    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 794    set yt [expr $y1 - 0.5 * $linespc]
 795    set yb [expr $yt + $linespc - 1]
 796    set xvals {}
 797    set wvals {}
 798    foreach tag $marks {
 799        set wid [font measure $mainfont $tag]
 800        lappend xvals $xt
 801        lappend wvals $wid
 802        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 803    }
 804    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 805               -width $lthickness -fill black -tags tag.$id]
 806    $canv lower $t
 807    foreach tag $marks x $xvals wid $wvals {
 808        set xl [expr $x + $delta]
 809        set xr [expr $x + $delta + $wid + $lthickness]
 810        if {[incr ntags -1] >= 0} {
 811            # draw a tag
 812            $canv create polygon $x [expr $yt + $delta] $xl $yt\
 813                $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
 814                -width 1 -outline black -fill yellow -tags tag.$id
 815        } else {
 816            # draw a head
 817            set xl [expr $xl - $delta/2]
 818            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 819                -width 1 -outline black -fill green -tags tag.$id
 820        }
 821        $canv create text $xl $y1 -anchor w -text $tag \
 822            -font $mainfont -tags tag.$id
 823    }
 824    return $xt
 825}
 826
 827proc updatetodo {level noshortcut} {
 828    global currentparents ncleft todo
 829    global mainline oldlevel oldtodo oldnlines
 830    global canvx0 canvy linespc mainline
 831    global commitinfo
 832
 833    set oldlevel $level
 834    set oldtodo $todo
 835    set oldnlines [llength $todo]
 836    if {!$noshortcut && [llength $currentparents] == 1} {
 837        set p [lindex $currentparents 0]
 838        if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
 839            set ncleft($p) 0
 840            set x [expr $canvx0 + $level * $linespc]
 841            set y [expr $canvy - $linespc]
 842            set mainline($p) [list $x $y]
 843            set todo [lreplace $todo $level $level $p]
 844            return 0
 845        }
 846    }
 847
 848    set todo [lreplace $todo $level $level]
 849    set i $level
 850    foreach p $currentparents {
 851        incr ncleft($p) -1
 852        set k [lsearch -exact $todo $p]
 853        if {$k < 0} {
 854            set todo [linsert $todo $i $p]
 855            incr i
 856        }
 857    }
 858    return 1
 859}
 860
 861proc notecrossings {id lo hi corner} {
 862    global oldtodo crossings cornercrossings
 863
 864    for {set i $lo} {[incr i] < $hi} {} {
 865        set p [lindex $oldtodo $i]
 866        if {$p == {}} continue
 867        if {$i == $corner} {
 868            if {![info exists cornercrossings($id)]
 869                || [lsearch -exact $cornercrossings($id) $p] < 0} {
 870                lappend cornercrossings($id) $p
 871            }
 872            if {![info exists cornercrossings($p)]
 873                || [lsearch -exact $cornercrossings($p) $id] < 0} {
 874                lappend cornercrossings($p) $id
 875            }
 876        } else {
 877            if {![info exists crossings($id)]
 878                || [lsearch -exact $crossings($id) $p] < 0} {
 879                lappend crossings($id) $p
 880            }
 881            if {![info exists crossings($p)]
 882                || [lsearch -exact $crossings($p) $id] < 0} {
 883                lappend crossings($p) $id
 884            }
 885        }
 886    }
 887}
 888
 889proc drawslants {} {
 890    global canv mainline sidelines canvx0 canvy linespc
 891    global oldlevel oldtodo todo currentparents dupparents
 892    global lthickness linespc canvy colormap
 893
 894    set y1 [expr $canvy - $linespc]
 895    set y2 $canvy
 896    set i -1
 897    foreach id $oldtodo {
 898        incr i
 899        if {$id == {}} continue
 900        set xi [expr {$canvx0 + $i * $linespc}]
 901        if {$i == $oldlevel} {
 902            foreach p $currentparents {
 903                set j [lsearch -exact $todo $p]
 904                set coords [list $xi $y1]
 905                set xj [expr {$canvx0 + $j * $linespc}]
 906                if {$j < $i - 1} {
 907                    lappend coords [expr $xj + $linespc] $y1
 908                    notecrossings $p $j $i [expr {$j + 1}]
 909                } elseif {$j > $i + 1} {
 910                    lappend coords [expr $xj - $linespc] $y1
 911                    notecrossings $p $i $j [expr {$j - 1}]
 912                }
 913                if {[lsearch -exact $dupparents $p] >= 0} {
 914                    # draw a double-width line to indicate the doubled parent
 915                    lappend coords $xj $y2
 916                    lappend sidelines($p) [list $coords 2]
 917                    if {![info exists mainline($p)]} {
 918                        set mainline($p) [list $xj $y2]
 919                    }
 920                } else {
 921                    # normal case, no parent duplicated
 922                    if {![info exists mainline($p)]} {
 923                        if {$i != $j} {
 924                            lappend coords $xj $y2
 925                        }
 926                        set mainline($p) $coords
 927                    } else {
 928                        lappend coords $xj $y2
 929                        lappend sidelines($p) [list $coords 1]
 930                    }
 931                }
 932            }
 933        } elseif {[lindex $todo $i] != $id} {
 934            set j [lsearch -exact $todo $id]
 935            set xj [expr {$canvx0 + $j * $linespc}]
 936            lappend mainline($id) $xi $y1 $xj $y2
 937        }
 938    }
 939}
 940
 941proc decidenext {{noread 0}} {
 942    global parents children nchildren ncleft todo
 943    global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 944    global datemode cdate
 945    global commitinfo
 946    global currentparents oldlevel oldnlines oldtodo
 947    global lineno lthickness
 948
 949    # remove the null entry if present
 950    set nullentry [lsearch -exact $todo {}]
 951    if {$nullentry >= 0} {
 952        set todo [lreplace $todo $nullentry $nullentry]
 953    }
 954
 955    # choose which one to do next time around
 956    set todol [llength $todo]
 957    set level -1
 958    set latest {}
 959    for {set k $todol} {[incr k -1] >= 0} {} {
 960        set p [lindex $todo $k]
 961        if {$ncleft($p) == 0} {
 962            if {$datemode} {
 963                if {![info exists commitinfo($p)]} {
 964                    if {$noread} {
 965                        return {}
 966                    }
 967                    readcommit $p
 968                }
 969                if {$latest == {} || $cdate($p) > $latest} {
 970                    set level $k
 971                    set latest $cdate($p)
 972                }
 973            } else {
 974                set level $k
 975                break
 976            }
 977        }
 978    }
 979    if {$level < 0} {
 980        if {$todo != {}} {
 981            puts "ERROR: none of the pending commits can be done yet:"
 982            foreach p $todo {
 983                puts "  $p ($ncleft($p))"
 984            }
 985        }
 986        return -1
 987    }
 988
 989    # If we are reducing, put in a null entry
 990    if {$todol < $oldnlines} {
 991        if {$nullentry >= 0} {
 992            set i $nullentry
 993            while {$i < $todol
 994                   && [lindex $oldtodo $i] == [lindex $todo $i]} {
 995                incr i
 996            }
 997        } else {
 998            set i $oldlevel
 999            if {$level >= $i} {
1000                incr i
1001            }
1002        }
1003        if {$i < $todol} {
1004            set todo [linsert $todo $i {}]
1005            if {$level >= $i} {
1006                incr level
1007            }
1008        }
1009    }
1010    return $level
1011}
1012
1013proc drawcommit {id} {
1014    global phase todo nchildren datemode nextupdate
1015    global startcommits
1016
1017    if {$phase != "incrdraw"} {
1018        set phase incrdraw
1019        set todo $id
1020        set startcommits $id
1021        initgraph
1022        drawcommitline 0
1023        updatetodo 0 $datemode
1024    } else {
1025        if {$nchildren($id) == 0} {
1026            lappend todo $id
1027            lappend startcommits $id
1028        }
1029        set level [decidenext 1]
1030        if {$level == {} || $id != [lindex $todo $level]} {
1031            return
1032        }
1033        while 1 {
1034            drawslants
1035            drawcommitline $level
1036            if {[updatetodo $level $datemode]} {
1037                set level [decidenext 1]
1038                if {$level == {}} break
1039            }
1040            set id [lindex $todo $level]
1041            if {![info exists commitlisted($id)]} {
1042                break
1043            }
1044            if {[clock clicks -milliseconds] >= $nextupdate} {
1045                doupdate
1046                if {$stopped} break
1047            }
1048        }
1049    }
1050}
1051
1052proc finishcommits {} {
1053    global phase
1054    global startcommits
1055    global canv mainfont ctext maincursor textcursor
1056
1057    if {$phase != "incrdraw"} {
1058        $canv delete all
1059        $canv create text 3 3 -anchor nw -text "No commits selected" \
1060            -font $mainfont -tags textitems
1061        set phase {}
1062    } else {
1063        drawslants
1064        set level [decidenext]
1065        drawrest $level [llength $startcommits]
1066    }
1067    . config -cursor $maincursor
1068    $ctext config -cursor $textcursor
1069}
1070
1071proc drawgraph {} {
1072    global nextupdate startmsecs startcommits todo
1073
1074    if {$startcommits == {}} return
1075    set startmsecs [clock clicks -milliseconds]
1076    set nextupdate [expr $startmsecs + 100]
1077    initgraph
1078    set todo [lindex $startcommits 0]
1079    drawrest 0 1
1080}
1081
1082proc drawrest {level startix} {
1083    global phase stopped redisplaying selectedline
1084    global datemode currentparents todo
1085    global numcommits
1086    global nextupdate startmsecs startcommits idline
1087
1088    if {$level >= 0} {
1089        set phase drawgraph
1090        set startid [lindex $startcommits $startix]
1091        set startline -1
1092        if {$startid != {}} {
1093            set startline $idline($startid)
1094        }
1095        while 1 {
1096            if {$stopped} break
1097            drawcommitline $level
1098            set hard [updatetodo $level $datemode]
1099            if {$numcommits == $startline} {
1100                lappend todo $startid
1101                set hard 1
1102                incr startix
1103                set startid [lindex $startcommits $startix]
1104                set startline -1
1105                if {$startid != {}} {
1106                    set startline $idline($startid)
1107                }
1108            }
1109            if {$hard} {
1110                set level [decidenext]
1111                if {$level < 0} break
1112                drawslants
1113            }
1114            if {[clock clicks -milliseconds] >= $nextupdate} {
1115                update
1116                incr nextupdate 100
1117            }
1118        }
1119    }
1120    set phase {}
1121    set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1122    #puts "overall $drawmsecs ms for $numcommits commits"
1123    if {$redisplaying} {
1124        if {$stopped == 0 && [info exists selectedline]} {
1125            selectline $selectedline
1126        }
1127        if {$stopped == 1} {
1128            set stopped 0
1129            after idle drawgraph
1130        } else {
1131            set redisplaying 0
1132        }
1133    }
1134}
1135
1136proc findmatches {f} {
1137    global findtype foundstring foundstrlen
1138    if {$findtype == "Regexp"} {
1139        set matches [regexp -indices -all -inline $foundstring $f]
1140    } else {
1141        if {$findtype == "IgnCase"} {
1142            set str [string tolower $f]
1143        } else {
1144            set str $f
1145        }
1146        set matches {}
1147        set i 0
1148        while {[set j [string first $foundstring $str $i]] >= 0} {
1149            lappend matches [list $j [expr $j+$foundstrlen-1]]
1150            set i [expr $j + $foundstrlen]
1151        }
1152    }
1153    return $matches
1154}
1155
1156proc dofind {} {
1157    global findtype findloc findstring markedmatches commitinfo
1158    global numcommits lineid linehtag linentag linedtag
1159    global mainfont namefont canv canv2 canv3 selectedline
1160    global matchinglines foundstring foundstrlen
1161
1162    stopfindproc
1163    unmarkmatches
1164    focus .
1165    set matchinglines {}
1166    if {$findloc == "Pickaxe"} {
1167        findpatches
1168        return
1169    }
1170    if {$findtype == "IgnCase"} {
1171        set foundstring [string tolower $findstring]
1172    } else {
1173        set foundstring $findstring
1174    }
1175    set foundstrlen [string length $findstring]
1176    if {$foundstrlen == 0} return
1177    if {$findloc == "Files"} {
1178        findfiles
1179        return
1180    }
1181    if {![info exists selectedline]} {
1182        set oldsel -1
1183    } else {
1184        set oldsel $selectedline
1185    }
1186    set didsel 0
1187    set fldtypes {Headline Author Date Committer CDate Comment}
1188    for {set l 0} {$l < $numcommits} {incr l} {
1189        set id $lineid($l)
1190        set info $commitinfo($id)
1191        set doesmatch 0
1192        foreach f $info ty $fldtypes {
1193            if {$findloc != "All fields" && $findloc != $ty} {
1194                continue
1195            }
1196            set matches [findmatches $f]
1197            if {$matches == {}} continue
1198            set doesmatch 1
1199            if {$ty == "Headline"} {
1200                markmatches $canv $l $f $linehtag($l) $matches $mainfont
1201            } elseif {$ty == "Author"} {
1202                markmatches $canv2 $l $f $linentag($l) $matches $namefont
1203            } elseif {$ty == "Date"} {
1204                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1205            }
1206        }
1207        if {$doesmatch} {
1208            lappend matchinglines $l
1209            if {!$didsel && $l > $oldsel} {
1210                findselectline $l
1211                set didsel 1
1212            }
1213        }
1214    }
1215    if {$matchinglines == {}} {
1216        bell
1217    } elseif {!$didsel} {
1218        findselectline [lindex $matchinglines 0]
1219    }
1220}
1221
1222proc findselectline {l} {
1223    global findloc commentend ctext
1224    selectline $l
1225    if {$findloc == "All fields" || $findloc == "Comments"} {
1226        # highlight the matches in the comments
1227        set f [$ctext get 1.0 $commentend]
1228        set matches [findmatches $f]
1229        foreach match $matches {
1230            set start [lindex $match 0]
1231            set end [expr [lindex $match 1] + 1]
1232            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1233        }
1234    }
1235}
1236
1237proc findnext {restart} {
1238    global matchinglines selectedline
1239    if {![info exists matchinglines]} {
1240        if {$restart} {
1241            dofind
1242        }
1243        return
1244    }
1245    if {![info exists selectedline]} return
1246    foreach l $matchinglines {
1247        if {$l > $selectedline} {
1248            findselectline $l
1249            return
1250        }
1251    }
1252    bell
1253}
1254
1255proc findprev {} {
1256    global matchinglines selectedline
1257    if {![info exists matchinglines]} {
1258        dofind
1259        return
1260    }
1261    if {![info exists selectedline]} return
1262    set prev {}
1263    foreach l $matchinglines {
1264        if {$l >= $selectedline} break
1265        set prev $l
1266    }
1267    if {$prev != {}} {
1268        findselectline $prev
1269    } else {
1270        bell
1271    }
1272}
1273
1274proc findlocchange {name ix op} {
1275    global findloc findtype findtypemenu
1276    if {$findloc == "Pickaxe"} {
1277        set findtype Exact
1278        set state disabled
1279    } else {
1280        set state normal
1281    }
1282    $findtypemenu entryconf 1 -state $state
1283    $findtypemenu entryconf 2 -state $state
1284}
1285
1286proc stopfindproc {{done 0}} {
1287    global findprocpid findprocfile findids
1288    global ctext findoldcursor phase maincursor textcursor
1289    global findinprogress
1290
1291    catch {unset findids}
1292    if {[info exists findprocpid]} {
1293        if {!$done} {
1294            catch {exec kill $findprocpid}
1295        }
1296        catch {close $findprocfile}
1297        unset findprocpid
1298    }
1299    if {[info exists findinprogress]} {
1300        unset findinprogress
1301        if {$phase != "incrdraw"} {
1302            . config -cursor $maincursor
1303            $ctext config -cursor $textcursor
1304        }
1305    }
1306}
1307
1308proc findpatches {} {
1309    global findstring selectedline numcommits
1310    global findprocpid findprocfile
1311    global finddidsel ctext lineid findinprogress
1312    global findinsertpos
1313
1314    if {$numcommits == 0} return
1315
1316    # make a list of all the ids to search, starting at the one
1317    # after the selected line (if any)
1318    if {[info exists selectedline]} {
1319        set l $selectedline
1320    } else {
1321        set l -1
1322    }
1323    set inputids {}
1324    for {set i 0} {$i < $numcommits} {incr i} {
1325        if {[incr l] >= $numcommits} {
1326            set l 0
1327        }
1328        append inputids $lineid($l) "\n"
1329    }
1330
1331    if {[catch {
1332        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1333                         << $inputids] r]
1334    } err]} {
1335        error_popup "Error starting search process: $err"
1336        return
1337    }
1338
1339    set findinsertpos end
1340    set findprocfile $f
1341    set findprocpid [pid $f]
1342    fconfigure $f -blocking 0
1343    fileevent $f readable readfindproc
1344    set finddidsel 0
1345    . config -cursor watch
1346    $ctext config -cursor watch
1347    set findinprogress 1
1348}
1349
1350proc readfindproc {} {
1351    global findprocfile finddidsel
1352    global idline matchinglines findinsertpos
1353
1354    set n [gets $findprocfile line]
1355    if {$n < 0} {
1356        if {[eof $findprocfile]} {
1357            stopfindproc 1
1358            if {!$finddidsel} {
1359                bell
1360            }
1361        }
1362        return
1363    }
1364    if {![regexp {^[0-9a-f]{40}} $line id]} {
1365        error_popup "Can't parse git-diff-tree output: $line"
1366        stopfindproc
1367        return
1368    }
1369    if {![info exists idline($id)]} {
1370        puts stderr "spurious id: $id"
1371        return
1372    }
1373    set l $idline($id)
1374    insertmatch $l $id
1375}
1376
1377proc insertmatch {l id} {
1378    global matchinglines findinsertpos finddidsel
1379
1380    if {$findinsertpos == "end"} {
1381        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1382            set matchinglines [linsert $matchinglines 0 $l]
1383            set findinsertpos 1
1384        } else {
1385            lappend matchinglines $l
1386        }
1387    } else {
1388        set matchinglines [linsert $matchinglines $findinsertpos $l]
1389        incr findinsertpos
1390    }
1391    markheadline $l $id
1392    if {!$finddidsel} {
1393        findselectline $l
1394        set finddidsel 1
1395    }
1396}
1397
1398proc findfiles {} {
1399    global selectedline numcommits lineid ctext
1400    global ffileline finddidsel parents nparents
1401    global findinprogress findstartline findinsertpos
1402    global treediffs fdiffids fdiffsneeded fdiffpos
1403    global findmergefiles
1404
1405    if {$numcommits == 0} return
1406
1407    if {[info exists selectedline]} {
1408        set l [expr {$selectedline + 1}]
1409    } else {
1410        set l 0
1411    }
1412    set ffileline $l
1413    set findstartline $l
1414    set diffsneeded {}
1415    set fdiffsneeded {}
1416    while 1 {
1417        set id $lineid($l)
1418        if {$findmergefiles || $nparents($id) == 1} {
1419            foreach p $parents($id) {
1420                if {![info exists treediffs([list $id $p])]} {
1421                    append diffsneeded "$id $p\n"
1422                    lappend fdiffsneeded [list $id $p]
1423                }
1424            }
1425        }
1426        if {[incr l] >= $numcommits} {
1427            set l 0
1428        }
1429        if {$l == $findstartline} break
1430    }
1431
1432    # start off a git-diff-tree process if needed
1433    if {$diffsneeded ne {}} {
1434        if {[catch {
1435            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1436        } err ]} {
1437            error_popup "Error starting search process: $err"
1438            return
1439        }
1440        catch {unset fdiffids}
1441        set fdiffpos 0
1442        fconfigure $df -blocking 0
1443        fileevent $df readable [list readfilediffs $df]
1444    }
1445
1446    set finddidsel 0
1447    set findinsertpos end
1448    set id $lineid($l)
1449    set p [lindex $parents($id) 0]
1450    . config -cursor watch
1451    $ctext config -cursor watch
1452    set findinprogress 1
1453    findcont [list $id $p]
1454    update
1455}
1456
1457proc readfilediffs {df} {
1458    global findids fdiffids fdiffs
1459
1460    set n [gets $df line]
1461    if {$n < 0} {
1462        if {[eof $df]} {
1463            donefilediff
1464            if {[catch {close $df} err]} {
1465                stopfindproc
1466                bell
1467                error_popup "Error in git-diff-tree: $err"
1468            } elseif {[info exists findids]} {
1469                set ids $findids
1470                stopfindproc
1471                bell
1472                error_popup "Couldn't find diffs for {$ids}"
1473            }
1474        }
1475        return
1476    }
1477    if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1478        # start of a new string of diffs
1479        donefilediff
1480        set fdiffids [list $id $p]
1481        set fdiffs {}
1482    } elseif {[string match ":*" $line]} {
1483        lappend fdiffs [lindex $line 5]
1484    }
1485}
1486
1487proc donefilediff {} {
1488    global fdiffids fdiffs treediffs findids
1489    global fdiffsneeded fdiffpos
1490
1491    if {[info exists fdiffids]} {
1492        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1493               && $fdiffpos < [llength $fdiffsneeded]} {
1494            # git-diff-tree doesn't output anything for a commit
1495            # which doesn't change anything
1496            set nullids [lindex $fdiffsneeded $fdiffpos]
1497            set treediffs($nullids) {}
1498            if {[info exists findids] && $nullids eq $findids} {
1499                unset findids
1500                findcont $nullids
1501            }
1502            incr fdiffpos
1503        }
1504        incr fdiffpos
1505
1506        if {![info exists treediffs($fdiffids)]} {
1507            set treediffs($fdiffids) $fdiffs
1508        }
1509        if {[info exists findids] && $fdiffids eq $findids} {
1510            unset findids
1511            findcont $fdiffids
1512        }
1513    }
1514}
1515
1516proc findcont {ids} {
1517    global findids treediffs parents nparents
1518    global ffileline findstartline finddidsel
1519    global lineid numcommits matchinglines findinprogress
1520    global findmergefiles
1521
1522    set id [lindex $ids 0]
1523    set p [lindex $ids 1]
1524    set pi [lsearch -exact $parents($id) $p]
1525    set l $ffileline
1526    while 1 {
1527        if {$findmergefiles || $nparents($id) == 1} {
1528            if {![info exists treediffs($ids)]} {
1529                set findids $ids
1530                set ffileline $l
1531                return
1532            }
1533            set doesmatch 0
1534            foreach f $treediffs($ids) {
1535                set x [findmatches $f]
1536                if {$x != {}} {
1537                    set doesmatch 1
1538                    break
1539                }
1540            }
1541            if {$doesmatch} {
1542                insertmatch $l $id
1543                set pi $nparents($id)
1544            }
1545        } else {
1546            set pi $nparents($id)
1547        }
1548        if {[incr pi] >= $nparents($id)} {
1549            set pi 0
1550            if {[incr l] >= $numcommits} {
1551                set l 0
1552            }
1553            if {$l == $findstartline} break
1554            set id $lineid($l)
1555        }
1556        set p [lindex $parents($id) $pi]
1557        set ids [list $id $p]
1558    }
1559    stopfindproc
1560    if {!$finddidsel} {
1561        bell
1562    }
1563}
1564
1565# mark a commit as matching by putting a yellow background
1566# behind the headline
1567proc markheadline {l id} {
1568    global canv mainfont linehtag commitinfo
1569
1570    set bbox [$canv bbox $linehtag($l)]
1571    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1572    $canv lower $t
1573}
1574
1575# mark the bits of a headline, author or date that match a find string
1576proc markmatches {canv l str tag matches font} {
1577    set bbox [$canv bbox $tag]
1578    set x0 [lindex $bbox 0]
1579    set y0 [lindex $bbox 1]
1580    set y1 [lindex $bbox 3]
1581    foreach match $matches {
1582        set start [lindex $match 0]
1583        set end [lindex $match 1]
1584        if {$start > $end} continue
1585        set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1586        set xlen [font measure $font [string range $str 0 [expr $end]]]
1587        set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1588                   -outline {} -tags matches -fill yellow]
1589        $canv lower $t
1590    }
1591}
1592
1593proc unmarkmatches {} {
1594    global matchinglines findids
1595    allcanvs delete matches
1596    catch {unset matchinglines}
1597    catch {unset findids}
1598}
1599
1600proc selcanvline {w x y} {
1601    global canv canvy0 ctext linespc selectedline
1602    global lineid linehtag linentag linedtag rowtextx
1603    set ymax [lindex [$canv cget -scrollregion] 3]
1604    if {$ymax == {}} return
1605    set yfrac [lindex [$canv yview] 0]
1606    set y [expr {$y + $yfrac * $ymax}]
1607    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1608    if {$l < 0} {
1609        set l 0
1610    }
1611    if {$w eq $canv} {
1612        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1613    }
1614    unmarkmatches
1615    selectline $l
1616}
1617
1618proc selectline {l} {
1619    global canv canv2 canv3 ctext commitinfo selectedline
1620    global lineid linehtag linentag linedtag
1621    global canvy0 linespc parents nparents
1622    global cflist currentid sha1entry
1623    global commentend idtags
1624    $canv delete hover
1625    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1626    $canv delete secsel
1627    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1628               -tags secsel -fill [$canv cget -selectbackground]]
1629    $canv lower $t
1630    $canv2 delete secsel
1631    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1632               -tags secsel -fill [$canv2 cget -selectbackground]]
1633    $canv2 lower $t
1634    $canv3 delete secsel
1635    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1636               -tags secsel -fill [$canv3 cget -selectbackground]]
1637    $canv3 lower $t
1638    set y [expr {$canvy0 + $l * $linespc}]
1639    set ymax [lindex [$canv cget -scrollregion] 3]
1640    set ytop [expr {$y - $linespc - 1}]
1641    set ybot [expr {$y + $linespc + 1}]
1642    set wnow [$canv yview]
1643    set wtop [expr [lindex $wnow 0] * $ymax]
1644    set wbot [expr [lindex $wnow 1] * $ymax]
1645    set wh [expr {$wbot - $wtop}]
1646    set newtop $wtop
1647    if {$ytop < $wtop} {
1648        if {$ybot < $wtop} {
1649            set newtop [expr {$y - $wh / 2.0}]
1650        } else {
1651            set newtop $ytop
1652            if {$newtop > $wtop - $linespc} {
1653                set newtop [expr {$wtop - $linespc}]
1654            }
1655        }
1656    } elseif {$ybot > $wbot} {
1657        if {$ytop > $wbot} {
1658            set newtop [expr {$y - $wh / 2.0}]
1659        } else {
1660            set newtop [expr {$ybot - $wh}]
1661            if {$newtop < $wtop + $linespc} {
1662                set newtop [expr {$wtop + $linespc}]
1663            }
1664        }
1665    }
1666    if {$newtop != $wtop} {
1667        if {$newtop < 0} {
1668            set newtop 0
1669        }
1670        allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1671    }
1672    set selectedline $l
1673
1674    set id $lineid($l)
1675    set currentid $id
1676    $sha1entry delete 0 end
1677    $sha1entry insert 0 $id
1678    $sha1entry selection from 0
1679    $sha1entry selection to end
1680
1681    $ctext conf -state normal
1682    $ctext delete 0.0 end
1683    $ctext mark set fmark.0 0.0
1684    $ctext mark gravity fmark.0 left
1685    set info $commitinfo($id)
1686    $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
1687    $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
1688    if {[info exists idtags($id)]} {
1689        $ctext insert end "Tags:"
1690        foreach tag $idtags($id) {
1691            $ctext insert end " $tag"
1692        }
1693        $ctext insert end "\n"
1694    }
1695    $ctext insert end "\n"
1696    $ctext insert end [lindex $info 5]
1697    $ctext insert end "\n"
1698    $ctext tag delete Comments
1699    $ctext tag remove found 1.0 end
1700    $ctext conf -state disabled
1701    set commentend [$ctext index "end - 1c"]
1702
1703    $cflist delete 0 end
1704    $cflist insert end "Comments"
1705    if {$nparents($id) == 1} {
1706        startdiff [concat $id $parents($id)]
1707    } elseif {$nparents($id) > 1} {
1708        mergediff $id
1709    }
1710}
1711
1712proc selnextline {dir} {
1713    global selectedline
1714    if {![info exists selectedline]} return
1715    set l [expr $selectedline + $dir]
1716    unmarkmatches
1717    selectline $l
1718}
1719
1720proc mergediff {id} {
1721    global parents diffmergeid diffmergegca mergefilelist diffpindex
1722
1723    set diffmergeid $id
1724    set diffpindex -1
1725    set diffmergegca [findgca $parents($id)]
1726    if {[info exists mergefilelist($id)]} {
1727        showmergediff
1728    } else {
1729        contmergediff {}
1730    }
1731}
1732
1733proc findgca {ids} {
1734    set gca {}
1735    foreach id $ids {
1736        if {$gca eq {}} {
1737            set gca $id
1738        } else {
1739            if {[catch {
1740                set gca [exec git-merge-base $gca $id]
1741            } err]} {
1742                return {}
1743            }
1744        }
1745    }
1746    return $gca
1747}
1748
1749proc contmergediff {ids} {
1750    global diffmergeid diffpindex parents nparents diffmergegca
1751    global treediffs mergefilelist diffids
1752
1753    # diff the child against each of the parents, and diff
1754    # each of the parents against the GCA.
1755    while 1 {
1756        if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
1757            set ids [list [lindex $ids 1] $diffmergegca]
1758        } else {
1759            if {[incr diffpindex] >= $nparents($diffmergeid)} break
1760            set p [lindex $parents($diffmergeid) $diffpindex]
1761            set ids [list $diffmergeid $p]
1762        }
1763        if {![info exists treediffs($ids)]} {
1764            set diffids $ids
1765            if {![info exists treepending]} {
1766                gettreediffs $ids
1767            }
1768            return
1769        }
1770    }
1771
1772    # If a file in some parent is different from the child and also
1773    # different from the GCA, then it's interesting.
1774    # If we don't have a GCA, then a file is interesting if it is
1775    # different from the child in all the parents.
1776    if {$diffmergegca ne {}} {
1777        set files {}
1778        foreach p $parents($diffmergeid) {
1779            set gcadiffs $treediffs([list $p $diffmergegca])
1780            foreach f $treediffs([list $diffmergeid $p]) {
1781                if {[lsearch -exact $files $f] < 0
1782                    && [lsearch -exact $gcadiffs $f] >= 0} {
1783                    lappend files $f
1784                }
1785            }
1786        }
1787        set files [lsort $files]
1788    } else {
1789        set p [lindex $parents($diffmergeid) 0]
1790        set files $treediffs([list $diffmergeid $p])
1791        for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
1792            set p [lindex $parents($diffmergeid) $i]
1793            set df $treediffs([list $diffmergeid $p])
1794            set nf {}
1795            foreach f $files {
1796                if {[lsearch -exact $df $f] >= 0} {
1797                    lappend nf $f
1798                }
1799            }
1800            set files $nf
1801        }
1802    }
1803
1804    set mergefilelist($diffmergeid) $files
1805    if {$files ne {}} {
1806        showmergediff
1807    }
1808}
1809
1810proc showmergediff {} {
1811    global cflist diffmergeid mergefilelist parents
1812    global diffopts diffinhunk currentfile diffblocked
1813    global groupfilelast mergefds
1814
1815    set files $mergefilelist($diffmergeid)
1816    foreach f $files {
1817        $cflist insert end $f
1818    }
1819    set env(GIT_DIFF_OPTS) $diffopts
1820    set flist {}
1821    catch {unset currentfile}
1822    catch {unset currenthunk}
1823    catch {unset filelines}
1824    set groupfilelast -1
1825    foreach p $parents($diffmergeid) {
1826        set cmd [list | git-diff-tree -p $p $diffmergeid]
1827        set cmd [concat $cmd $mergefilelist($diffmergeid)]
1828        if {[catch {set f [open $cmd r]} err]} {
1829            error_popup "Error getting diffs: $err"
1830            foreach f $flist {
1831                catch {close $f}
1832            }
1833            return
1834        }
1835        lappend flist $f
1836        set ids [list $diffmergeid $p]
1837        set mergefds($ids) $f
1838        set diffinhunk($ids) 0
1839        set diffblocked($ids) 0
1840        fconfigure $f -blocking 0
1841        fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
1842    }
1843}
1844
1845proc getmergediffline {f ids id} {
1846    global diffmergeid diffinhunk diffoldlines diffnewlines
1847    global currentfile currenthunk
1848    global diffoldstart diffnewstart diffoldlno diffnewlno
1849    global diffblocked mergefilelist
1850    global noldlines nnewlines difflcounts filelines
1851
1852    set n [gets $f line]
1853    if {$n < 0} {
1854        if {![eof $f]} return
1855    }
1856
1857    if {!([info exists diffmergeid] && $diffmergeid == $id)} {
1858        if {$n < 0} {
1859            close $f
1860        }
1861        return
1862    }
1863
1864    if {$diffinhunk($ids) != 0} {
1865        set fi $currentfile($ids)
1866        if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
1867            # continuing an existing hunk
1868            set line [string range $line 1 end]
1869            set p [lindex $ids 1]
1870            if {$match eq "-" || $match eq " "} {
1871                set filelines($p,$fi,$diffoldlno($ids)) $line
1872                incr diffoldlno($ids)
1873            }
1874            if {$match eq "+" || $match eq " "} {
1875                set filelines($id,$fi,$diffnewlno($ids)) $line
1876                incr diffnewlno($ids)
1877            }
1878            if {$match eq " "} {
1879                if {$diffinhunk($ids) == 2} {
1880                    lappend difflcounts($ids) \
1881                        [list $noldlines($ids) $nnewlines($ids)]
1882                    set noldlines($ids) 0
1883                    set diffinhunk($ids) 1
1884                }
1885                incr noldlines($ids)
1886            } elseif {$match eq "-" || $match eq "+"} {
1887                if {$diffinhunk($ids) == 1} {
1888                    lappend difflcounts($ids) [list $noldlines($ids)]
1889                    set noldlines($ids) 0
1890                    set nnewlines($ids) 0
1891                    set diffinhunk($ids) 2
1892                }
1893                if {$match eq "-"} {
1894                    incr noldlines($ids)
1895                } else {
1896                    incr nnewlines($ids)
1897                }
1898            }
1899            # and if it's \ No newline at end of line, then what?
1900            return
1901        }
1902        # end of a hunk
1903        if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
1904            lappend difflcounts($ids) [list $noldlines($ids)]
1905        } elseif {$diffinhunk($ids) == 2
1906                  && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
1907            lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
1908        }
1909        set currenthunk($ids) [list $currentfile($ids) \
1910                                   $diffoldstart($ids) $diffnewstart($ids) \
1911                                   $diffoldlno($ids) $diffnewlno($ids) \
1912                                   $difflcounts($ids)]
1913        set diffinhunk($ids) 0
1914        # -1 = need to block, 0 = unblocked, 1 = is blocked
1915        set diffblocked($ids) -1
1916        processhunks
1917        if {$diffblocked($ids) == -1} {
1918            fileevent $f readable {}
1919            set diffblocked($ids) 1
1920        }
1921    }
1922
1923    if {$n < 0} {
1924        # eof
1925        if {!$diffblocked($ids)} {
1926            close $f
1927            set currentfile($ids) [llength $mergefilelist($diffmergeid)]
1928            set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
1929            processhunks
1930        }
1931    } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
1932        # start of a new file
1933        set currentfile($ids) \
1934            [lsearch -exact $mergefilelist($diffmergeid) $fname]
1935    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1936                   $line match f1l f1c f2l f2c rest]} {
1937        if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
1938            # start of a new hunk
1939            if {$f1l == 0 && $f1c == 0} {
1940                set f1l 1
1941            }
1942            if {$f2l == 0 && $f2c == 0} {
1943                set f2l 1
1944            }
1945            set diffinhunk($ids) 1
1946            set diffoldstart($ids) $f1l
1947            set diffnewstart($ids) $f2l
1948            set diffoldlno($ids) $f1l
1949            set diffnewlno($ids) $f2l
1950            set difflcounts($ids) {}
1951            set noldlines($ids) 0
1952            set nnewlines($ids) 0
1953        }
1954    }
1955}
1956
1957proc processhunks {} {
1958    global diffmergeid parents nparents currenthunk
1959    global mergefilelist diffblocked mergefds
1960    global grouphunks grouplinestart grouplineend groupfilenum
1961
1962    set nfiles [llength $mergefilelist($diffmergeid)]
1963    while 1 {
1964        set fi $nfiles
1965        set lno 0
1966        # look for the earliest hunk
1967        foreach p $parents($diffmergeid) {
1968            set ids [list $diffmergeid $p]
1969            if {![info exists currenthunk($ids)]} return
1970            set i [lindex $currenthunk($ids) 0]
1971            set l [lindex $currenthunk($ids) 2]
1972            if {$i < $fi || ($i == $fi && $l < $lno)} {
1973                set fi $i
1974                set lno $l
1975                set pi $p
1976            }
1977        }
1978
1979        if {$fi < $nfiles} {
1980            set ids [list $diffmergeid $pi]
1981            set hunk $currenthunk($ids)
1982            unset currenthunk($ids)
1983            if {$diffblocked($ids) > 0} {
1984                fileevent $mergefds($ids) readable \
1985                    [list getmergediffline $mergefds($ids) $ids $diffmergeid]
1986            }
1987            set diffblocked($ids) 0
1988
1989            if {[info exists groupfilenum] && $groupfilenum == $fi
1990                && $lno <= $grouplineend} {
1991                # add this hunk to the pending group
1992                lappend grouphunks($pi) $hunk
1993                set endln [lindex $hunk 4]
1994                if {$endln > $grouplineend} {
1995                    set grouplineend $endln
1996                }
1997                continue
1998            }
1999        }
2000
2001        # succeeding stuff doesn't belong in this group, so
2002        # process the group now
2003        if {[info exists groupfilenum]} {
2004            processgroup
2005            unset groupfilenum
2006            unset grouphunks
2007        }
2008
2009        if {$fi >= $nfiles} break
2010
2011        # start a new group
2012        set groupfilenum $fi
2013        set grouphunks($pi) [list $hunk]
2014        set grouplinestart $lno
2015        set grouplineend [lindex $hunk 4]
2016    }
2017}
2018
2019proc processgroup {} {
2020    global groupfilelast groupfilenum difffilestart
2021    global mergefilelist diffmergeid ctext filelines
2022    global parents diffmergeid diffoffset
2023    global grouphunks grouplinestart grouplineend nparents
2024    global mergemax
2025
2026    $ctext conf -state normal
2027    set id $diffmergeid
2028    set f $groupfilenum
2029    if {$groupfilelast != $f} {
2030        $ctext insert end "\n"
2031        set here [$ctext index "end - 1c"]
2032        set difffilestart($f) $here
2033        set mark fmark.[expr {$f + 1}]
2034        $ctext mark set $mark $here
2035        $ctext mark gravity $mark left
2036        set header [lindex $mergefilelist($id) $f]
2037        set l [expr {(78 - [string length $header]) / 2}]
2038        set pad [string range "----------------------------------------" 1 $l]
2039        $ctext insert end "$pad $header $pad\n" filesep
2040        set groupfilelast $f
2041        foreach p $parents($id) {
2042            set diffoffset($p) 0
2043        }
2044    }
2045
2046    $ctext insert end "@@" msep
2047    set nlines [expr {$grouplineend - $grouplinestart}]
2048    set events {}
2049    set pnum 0
2050    foreach p $parents($id) {
2051        set startline [expr {$grouplinestart + $diffoffset($p)}]
2052        set offset($p) $diffoffset($p)
2053        set ol $startline
2054        set nl $grouplinestart
2055        if {[info exists grouphunks($p)]} {
2056            foreach h $grouphunks($p) {
2057                set l [lindex $h 2]
2058                if {$nl < $l} {
2059                    for {} {$nl < $l} {incr nl} {
2060                        set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2061                        incr ol
2062                    }
2063                }
2064                foreach chunk [lindex $h 5] {
2065                    if {[llength $chunk] == 2} {
2066                        set olc [lindex $chunk 0]
2067                        set nlc [lindex $chunk 1]
2068                        set nnl [expr {$nl + $nlc}]
2069                        lappend events [list $nl $nnl $pnum $olc $nlc]
2070                        incr ol $olc
2071                        set nl $nnl
2072                    } else {
2073                        incr ol [lindex $chunk 0]
2074                        incr nl [lindex $chunk 0]
2075                    }
2076                }
2077            }
2078        }
2079        if {$nl < $grouplineend} {
2080            for {} {$nl < $grouplineend} {incr nl} {
2081                set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2082                incr ol
2083            }
2084        }
2085        set nlines [expr {$ol - $startline}]
2086        $ctext insert end " -$startline,$nlines" msep
2087        incr pnum
2088    }
2089
2090    set nlines [expr {$grouplineend - $grouplinestart}]
2091    $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2092
2093    set events [lsort -integer -index 0 $events]
2094    set nevents [llength $events]
2095    set nmerge $nparents($diffmergeid)
2096    set i 0
2097    set l $grouplinestart
2098    while {$i < $nevents} {
2099        set nl [lindex $events $i 0]
2100        while {$l < $nl} {
2101            $ctext insert end " $filelines($id,$f,$l)\n"
2102            incr l
2103        }
2104        set e [lindex $events $i]
2105        set enl [lindex $e 1]
2106        set j $i
2107        set active {}
2108        while 1 {
2109            set pnum [lindex $e 2]
2110            set olc [lindex $e 3]
2111            set nlc [lindex $e 4]
2112            if {![info exists delta($pnum)]} {
2113                set delta($pnum) [expr {$olc - $nlc}]
2114                lappend active $pnum
2115            } else {
2116                incr delta($pnum) [expr {$olc - $nlc}]
2117            }
2118            if {[incr j] >= $nevents} break
2119            set e [lindex $events $j]
2120            if {[lindex $e 0] >= $enl} break
2121            if {[lindex $e 1] > $enl} {
2122                set enl [lindex $e 1]
2123            }
2124        }
2125        set nlc [expr {$enl - $l}]
2126        set ncol mresult
2127        if {[llength $active] == $nmerge - 1} {
2128            for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2129                if {![info exists delta($pnum)]} {
2130                    if {$pnum < $mergemax} {
2131                        lappend ncol m$pnum
2132                    } else {
2133                        lappend ncol mmax
2134                    }
2135                    break
2136                }
2137            }
2138        }
2139        set pnum -1
2140        foreach p $parents($id) {
2141            incr pnum
2142            if {![info exists delta($pnum)]} continue
2143            set olc [expr {$nlc + $delta($pnum)}]
2144            set ol [expr {$l + $diffoffset($p)}]
2145            incr diffoffset($p) $delta($pnum)
2146            unset delta($pnum)
2147            for {} {$olc > 0} {incr olc -1} {
2148                $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2149                incr ol
2150            }
2151        }
2152        for {} {$nlc > 0} {incr nlc -1} {
2153            $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2154            incr l
2155        }
2156        set i $j
2157    }
2158    while {$l < $grouplineend} {
2159        $ctext insert end " $filelines($id,$f,$l)\n"
2160        incr l
2161    }
2162    $ctext conf -state disabled
2163}
2164
2165proc startdiff {ids} {
2166    global treediffs diffids treepending diffmergeid
2167
2168    set diffids $ids
2169    catch {unset diffmergeid}
2170    if {![info exists treediffs($ids)]} {
2171        if {![info exists treepending]} {
2172            gettreediffs $ids
2173        }
2174    } else {
2175        addtocflist $ids
2176    }
2177}
2178
2179proc addtocflist {ids} {
2180    global treediffs cflist
2181    foreach f $treediffs($ids) {
2182        $cflist insert end $f
2183    }
2184    getblobdiffs $ids
2185}
2186
2187proc gettreediffs {ids} {
2188    global treediff parents treepending
2189    set treepending $ids
2190    set treediff {}
2191    set id [lindex $ids 0]
2192    set p [lindex $ids 1]
2193    if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
2194    fconfigure $gdtf -blocking 0
2195    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2196}
2197
2198proc gettreediffline {gdtf ids} {
2199    global treediff treediffs treepending diffids diffmergeid
2200
2201    set n [gets $gdtf line]
2202    if {$n < 0} {
2203        if {![eof $gdtf]} return
2204        close $gdtf
2205        set treediffs($ids) $treediff
2206        unset treepending
2207        if {$ids != $diffids} {
2208            gettreediffs $diffids
2209        } else {
2210            if {[info exists diffmergeid]} {
2211                contmergediff $ids
2212            } else {
2213                addtocflist $ids
2214            }
2215        }
2216        return
2217    }
2218    set file [lindex $line 5]
2219    lappend treediff $file
2220}
2221
2222proc getblobdiffs {ids} {
2223    global diffopts blobdifffd diffids env curdifftag curtagstart
2224    global difffilestart nextupdate diffinhdr treediffs
2225
2226    set id [lindex $ids 0]
2227    set p [lindex $ids 1]
2228    set env(GIT_DIFF_OPTS) $diffopts
2229    set cmd [list | git-diff-tree -r -p -C $p $id]
2230    if {[catch {set bdf [open $cmd r]} err]} {
2231        puts "error getting diffs: $err"
2232        return
2233    }
2234    set diffinhdr 0
2235    fconfigure $bdf -blocking 0
2236    set blobdifffd($ids) $bdf
2237    set curdifftag Comments
2238    set curtagstart 0.0
2239    catch {unset difffilestart}
2240    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2241    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2242}
2243
2244proc getblobdiffline {bdf ids} {
2245    global diffids blobdifffd ctext curdifftag curtagstart
2246    global diffnexthead diffnextnote difffilestart
2247    global nextupdate diffinhdr treediffs
2248    global gaudydiff
2249
2250    set n [gets $bdf line]
2251    if {$n < 0} {
2252        if {[eof $bdf]} {
2253            close $bdf
2254            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2255                $ctext tag add $curdifftag $curtagstart end
2256            }
2257        }
2258        return
2259    }
2260    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2261        return
2262    }
2263    $ctext conf -state normal
2264    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2265        # start of a new file
2266        $ctext insert end "\n"
2267        $ctext tag add $curdifftag $curtagstart end
2268        set curtagstart [$ctext index "end - 1c"]
2269        set header $newname
2270        set here [$ctext index "end - 1c"]
2271        set i [lsearch -exact $treediffs($diffids) $fname]
2272        if {$i >= 0} {
2273            set difffilestart($i) $here
2274            incr i
2275            $ctext mark set fmark.$i $here
2276            $ctext mark gravity fmark.$i left
2277        }
2278        if {$newname != $fname} {
2279            set i [lsearch -exact $treediffs($diffids) $newname]
2280            if {$i >= 0} {
2281                set difffilestart($i) $here
2282                incr i
2283                $ctext mark set fmark.$i $here
2284                $ctext mark gravity fmark.$i left
2285            }
2286        }
2287        set curdifftag "f:$fname"
2288        $ctext tag delete $curdifftag
2289        set l [expr {(78 - [string length $header]) / 2}]
2290        set pad [string range "----------------------------------------" 1 $l]
2291        $ctext insert end "$pad $header $pad\n" filesep
2292        set diffinhdr 1
2293    } elseif {[regexp {^(---|\+\+\+)} $line]} {
2294        set diffinhdr 0
2295    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2296                   $line match f1l f1c f2l f2c rest]} {
2297        if {$gaudydiff} {
2298            $ctext insert end "\t" hunksep
2299            $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2300            $ctext insert end "    $rest \n" hunksep
2301        } else {
2302            $ctext insert end "$line\n" hunksep
2303        }
2304        set diffinhdr 0
2305    } else {
2306        set x [string range $line 0 0]
2307        if {$x == "-" || $x == "+"} {
2308            set tag [expr {$x == "+"}]
2309            if {$gaudydiff} {
2310                set line [string range $line 1 end]
2311            }
2312            $ctext insert end "$line\n" d$tag
2313        } elseif {$x == " "} {
2314            if {$gaudydiff} {
2315                set line [string range $line 1 end]
2316            }
2317            $ctext insert end "$line\n"
2318        } elseif {$diffinhdr || $x == "\\"} {
2319            # e.g. "\ No newline at end of file"
2320            $ctext insert end "$line\n" filesep
2321        } else {
2322            # Something else we don't recognize
2323            if {$curdifftag != "Comments"} {
2324                $ctext insert end "\n"
2325                $ctext tag add $curdifftag $curtagstart end
2326                set curtagstart [$ctext index "end - 1c"]
2327                set curdifftag Comments
2328            }
2329            $ctext insert end "$line\n" filesep
2330        }
2331    }
2332    $ctext conf -state disabled
2333    if {[clock clicks -milliseconds] >= $nextupdate} {
2334        incr nextupdate 100
2335        fileevent $bdf readable {}
2336        update
2337        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2338    }
2339}
2340
2341proc nextfile {} {
2342    global difffilestart ctext
2343    set here [$ctext index @0,0]
2344    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2345        if {[$ctext compare $difffilestart($i) > $here]} {
2346            if {![info exists pos]
2347                || [$ctext compare $difffilestart($i) < $pos]} {
2348                set pos $difffilestart($i)
2349            }
2350        }
2351    }
2352    if {[info exists pos]} {
2353        $ctext yview $pos
2354    }
2355}
2356
2357proc listboxsel {} {
2358    global ctext cflist currentid
2359    if {![info exists currentid]} return
2360    set sel [lsort [$cflist curselection]]
2361    if {$sel eq {}} return
2362    set first [lindex $sel 0]
2363    catch {$ctext yview fmark.$first}
2364}
2365
2366proc setcoords {} {
2367    global linespc charspc canvx0 canvy0 mainfont
2368    set linespc [font metrics $mainfont -linespace]
2369    set charspc [font measure $mainfont "m"]
2370    set canvy0 [expr 3 + 0.5 * $linespc]
2371    set canvx0 [expr 3 + 0.5 * $linespc]
2372}
2373
2374proc redisplay {} {
2375    global selectedline stopped redisplaying phase
2376    if {$stopped > 1} return
2377    if {$phase == "getcommits"} return
2378    set redisplaying 1
2379    if {$phase == "drawgraph" || $phase == "incrdraw"} {
2380        set stopped 1
2381    } else {
2382        drawgraph
2383    }
2384}
2385
2386proc incrfont {inc} {
2387    global mainfont namefont textfont selectedline ctext canv phase
2388    global stopped entries
2389    unmarkmatches
2390    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2391    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2392    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2393    setcoords
2394    $ctext conf -font $textfont
2395    $ctext tag conf filesep -font [concat $textfont bold]
2396    foreach e $entries {
2397        $e conf -font $mainfont
2398    }
2399    if {$phase == "getcommits"} {
2400        $canv itemconf textitems -font $mainfont
2401    }
2402    redisplay
2403}
2404
2405proc clearsha1 {} {
2406    global sha1entry sha1string
2407    if {[string length $sha1string] == 40} {
2408        $sha1entry delete 0 end
2409    }
2410}
2411
2412proc sha1change {n1 n2 op} {
2413    global sha1string currentid sha1but
2414    if {$sha1string == {}
2415        || ([info exists currentid] && $sha1string == $currentid)} {
2416        set state disabled
2417    } else {
2418        set state normal
2419    }
2420    if {[$sha1but cget -state] == $state} return
2421    if {$state == "normal"} {
2422        $sha1but conf -state normal -relief raised -text "Goto: "
2423    } else {
2424        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2425    }
2426}
2427
2428proc gotocommit {} {
2429    global sha1string currentid idline tagids
2430    global lineid numcommits
2431
2432    if {$sha1string == {}
2433        || ([info exists currentid] && $sha1string == $currentid)} return
2434    if {[info exists tagids($sha1string)]} {
2435        set id $tagids($sha1string)
2436    } else {
2437        set id [string tolower $sha1string]
2438        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2439            set matches {}
2440            for {set l 0} {$l < $numcommits} {incr l} {
2441                if {[string match $id* $lineid($l)]} {
2442                    lappend matches $lineid($l)
2443                }
2444            }
2445            if {$matches ne {}} {
2446                if {[llength $matches] > 1} {
2447                    error_popup "Short SHA1 id $id is ambiguous"
2448                    return
2449                }
2450                set id [lindex $matches 0]
2451            }
2452        }
2453    }
2454    if {[info exists idline($id)]} {
2455        selectline $idline($id)
2456        return
2457    }
2458    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2459        set type "SHA1 id"
2460    } else {
2461        set type "Tag"
2462    }
2463    error_popup "$type $sha1string is not known"
2464}
2465
2466proc lineenter {x y id} {
2467    global hoverx hovery hoverid hovertimer
2468    global commitinfo canv
2469
2470    if {![info exists commitinfo($id)]} return
2471    set hoverx $x
2472    set hovery $y
2473    set hoverid $id
2474    if {[info exists hovertimer]} {
2475        after cancel $hovertimer
2476    }
2477    set hovertimer [after 500 linehover]
2478    $canv delete hover
2479}
2480
2481proc linemotion {x y id} {
2482    global hoverx hovery hoverid hovertimer
2483
2484    if {[info exists hoverid] && $id == $hoverid} {
2485        set hoverx $x
2486        set hovery $y
2487        if {[info exists hovertimer]} {
2488            after cancel $hovertimer
2489        }
2490        set hovertimer [after 500 linehover]
2491    }
2492}
2493
2494proc lineleave {id} {
2495    global hoverid hovertimer canv
2496
2497    if {[info exists hoverid] && $id == $hoverid} {
2498        $canv delete hover
2499        if {[info exists hovertimer]} {
2500            after cancel $hovertimer
2501            unset hovertimer
2502        }
2503        unset hoverid
2504    }
2505}
2506
2507proc linehover {} {
2508    global hoverx hovery hoverid hovertimer
2509    global canv linespc lthickness
2510    global commitinfo mainfont
2511
2512    set text [lindex $commitinfo($hoverid) 0]
2513    set ymax [lindex [$canv cget -scrollregion] 3]
2514    if {$ymax == {}} return
2515    set yfrac [lindex [$canv yview] 0]
2516    set x [expr {$hoverx + 2 * $linespc}]
2517    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2518    set x0 [expr {$x - 2 * $lthickness}]
2519    set y0 [expr {$y - 2 * $lthickness}]
2520    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2521    set y1 [expr {$y + $linespc + 2 * $lthickness}]
2522    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2523               -fill \#ffff80 -outline black -width 1 -tags hover]
2524    $canv raise $t
2525    set t [$canv create text $x $y -anchor nw -text $text -tags hover]
2526    $canv raise $t
2527}
2528
2529proc lineclick {x y id} {
2530    global ctext commitinfo children cflist canv
2531
2532    unmarkmatches
2533    $canv delete hover
2534    # fill the details pane with info about this line
2535    $ctext conf -state normal
2536    $ctext delete 0.0 end
2537    $ctext insert end "Parent:\n "
2538    catch {destroy $ctext.$id}
2539    button $ctext.$id -text "Go:" -command "selbyid $id" \
2540        -padx 4 -pady 0
2541    $ctext window create end -window $ctext.$id -align center
2542    set info $commitinfo($id)
2543    $ctext insert end "\t[lindex $info 0]\n"
2544    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2545    $ctext insert end "\tDate:\t[lindex $info 2]\n"
2546    $ctext insert end "\tID:\t$id\n"
2547    if {[info exists children($id)]} {
2548        $ctext insert end "\nChildren:"
2549        foreach child $children($id) {
2550            $ctext insert end "\n "
2551            catch {destroy $ctext.$child}
2552            button $ctext.$child -text "Go:" -command "selbyid $child" \
2553                -padx 4 -pady 0
2554            $ctext window create end -window $ctext.$child -align center
2555            set info $commitinfo($child)
2556            $ctext insert end "\t[lindex $info 0]"
2557        }
2558    }
2559    $ctext conf -state disabled
2560
2561    $cflist delete 0 end
2562}
2563
2564proc selbyid {id} {
2565    global idline
2566    if {[info exists idline($id)]} {
2567        selectline $idline($id)
2568    }
2569}
2570
2571proc mstime {} {
2572    global startmstime
2573    if {![info exists startmstime]} {
2574        set startmstime [clock clicks -milliseconds]
2575    }
2576    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2577}
2578
2579proc rowmenu {x y id} {
2580    global rowctxmenu idline selectedline rowmenuid
2581
2582    if {![info exists selectedline] || $idline($id) eq $selectedline} {
2583        set state disabled
2584    } else {
2585        set state normal
2586    }
2587    $rowctxmenu entryconfigure 0 -state $state
2588    $rowctxmenu entryconfigure 1 -state $state
2589    $rowctxmenu entryconfigure 2 -state $state
2590    set rowmenuid $id
2591    tk_popup $rowctxmenu $x $y
2592}
2593
2594proc diffvssel {dirn} {
2595    global rowmenuid selectedline lineid
2596    global ctext cflist
2597    global commitinfo
2598
2599    if {![info exists selectedline]} return
2600    if {$dirn} {
2601        set oldid $lineid($selectedline)
2602        set newid $rowmenuid
2603    } else {
2604        set oldid $rowmenuid
2605        set newid $lineid($selectedline)
2606    }
2607    $ctext conf -state normal
2608    $ctext delete 0.0 end
2609    $ctext mark set fmark.0 0.0
2610    $ctext mark gravity fmark.0 left
2611    $cflist delete 0 end
2612    $cflist insert end "Top"
2613    $ctext insert end "From $oldid\n     "
2614    $ctext insert end [lindex $commitinfo($oldid) 0]
2615    $ctext insert end "\n\nTo   $newid\n     "
2616    $ctext insert end [lindex $commitinfo($newid) 0]
2617    $ctext insert end "\n"
2618    $ctext conf -state disabled
2619    $ctext tag delete Comments
2620    $ctext tag remove found 1.0 end
2621    startdiff $newid [list $oldid]
2622}
2623
2624proc mkpatch {} {
2625    global rowmenuid currentid commitinfo patchtop patchnum
2626
2627    if {![info exists currentid]} return
2628    set oldid $currentid
2629    set oldhead [lindex $commitinfo($oldid) 0]
2630    set newid $rowmenuid
2631    set newhead [lindex $commitinfo($newid) 0]
2632    set top .patch
2633    set patchtop $top
2634    catch {destroy $top}
2635    toplevel $top
2636    label $top.title -text "Generate patch"
2637    grid $top.title - -pady 10
2638    label $top.from -text "From:"
2639    entry $top.fromsha1 -width 40 -relief flat
2640    $top.fromsha1 insert 0 $oldid
2641    $top.fromsha1 conf -state readonly
2642    grid $top.from $top.fromsha1 -sticky w
2643    entry $top.fromhead -width 60 -relief flat
2644    $top.fromhead insert 0 $oldhead
2645    $top.fromhead conf -state readonly
2646    grid x $top.fromhead -sticky w
2647    label $top.to -text "To:"
2648    entry $top.tosha1 -width 40 -relief flat
2649    $top.tosha1 insert 0 $newid
2650    $top.tosha1 conf -state readonly
2651    grid $top.to $top.tosha1 -sticky w
2652    entry $top.tohead -width 60 -relief flat
2653    $top.tohead insert 0 $newhead
2654    $top.tohead conf -state readonly
2655    grid x $top.tohead -sticky w
2656    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
2657    grid $top.rev x -pady 10
2658    label $top.flab -text "Output file:"
2659    entry $top.fname -width 60
2660    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
2661    incr patchnum
2662    grid $top.flab $top.fname -sticky w
2663    frame $top.buts
2664    button $top.buts.gen -text "Generate" -command mkpatchgo
2665    button $top.buts.can -text "Cancel" -command mkpatchcan
2666    grid $top.buts.gen $top.buts.can
2667    grid columnconfigure $top.buts 0 -weight 1 -uniform a
2668    grid columnconfigure $top.buts 1 -weight 1 -uniform a
2669    grid $top.buts - -pady 10 -sticky ew
2670    focus $top.fname
2671}
2672
2673proc mkpatchrev {} {
2674    global patchtop
2675
2676    set oldid [$patchtop.fromsha1 get]
2677    set oldhead [$patchtop.fromhead get]
2678    set newid [$patchtop.tosha1 get]
2679    set newhead [$patchtop.tohead get]
2680    foreach e [list fromsha1 fromhead tosha1 tohead] \
2681            v [list $newid $newhead $oldid $oldhead] {
2682        $patchtop.$e conf -state normal
2683        $patchtop.$e delete 0 end
2684        $patchtop.$e insert 0 $v
2685        $patchtop.$e conf -state readonly
2686    }
2687}
2688
2689proc mkpatchgo {} {
2690    global patchtop
2691
2692    set oldid [$patchtop.fromsha1 get]
2693    set newid [$patchtop.tosha1 get]
2694    set fname [$patchtop.fname get]
2695    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
2696        error_popup "Error creating patch: $err"
2697    }
2698    catch {destroy $patchtop}
2699    unset patchtop
2700}
2701
2702proc mkpatchcan {} {
2703    global patchtop
2704
2705    catch {destroy $patchtop}
2706    unset patchtop
2707}
2708
2709proc mktag {} {
2710    global rowmenuid mktagtop commitinfo
2711
2712    set top .maketag
2713    set mktagtop $top
2714    catch {destroy $top}
2715    toplevel $top
2716    label $top.title -text "Create tag"
2717    grid $top.title - -pady 10
2718    label $top.id -text "ID:"
2719    entry $top.sha1 -width 40 -relief flat
2720    $top.sha1 insert 0 $rowmenuid
2721    $top.sha1 conf -state readonly
2722    grid $top.id $top.sha1 -sticky w
2723    entry $top.head -width 60 -relief flat
2724    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2725    $top.head conf -state readonly
2726    grid x $top.head -sticky w
2727    label $top.tlab -text "Tag name:"
2728    entry $top.tag -width 60
2729    grid $top.tlab $top.tag -sticky w
2730    frame $top.buts
2731    button $top.buts.gen -text "Create" -command mktaggo
2732    button $top.buts.can -text "Cancel" -command mktagcan
2733    grid $top.buts.gen $top.buts.can
2734    grid columnconfigure $top.buts 0 -weight 1 -uniform a
2735    grid columnconfigure $top.buts 1 -weight 1 -uniform a
2736    grid $top.buts - -pady 10 -sticky ew
2737    focus $top.tag
2738}
2739
2740proc domktag {} {
2741    global mktagtop env tagids idtags
2742    global idpos idline linehtag canv selectedline
2743
2744    set id [$mktagtop.sha1 get]
2745    set tag [$mktagtop.tag get]
2746    if {$tag == {}} {
2747        error_popup "No tag name specified"
2748        return
2749    }
2750    if {[info exists tagids($tag)]} {
2751        error_popup "Tag \"$tag\" already exists"
2752        return
2753    }
2754    if {[catch {
2755        set dir ".git"
2756        if {[info exists env(GIT_DIR)]} {
2757            set dir $env(GIT_DIR)
2758        }
2759        set fname [file join $dir "refs/tags" $tag]
2760        set f [open $fname w]
2761        puts $f $id
2762        close $f
2763    } err]} {
2764        error_popup "Error creating tag: $err"
2765        return
2766    }
2767
2768    set tagids($tag) $id
2769    lappend idtags($id) $tag
2770    $canv delete tag.$id
2771    set xt [eval drawtags $id $idpos($id)]
2772    $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
2773    if {[info exists selectedline] && $selectedline == $idline($id)} {
2774        selectline $selectedline
2775    }
2776}
2777
2778proc mktagcan {} {
2779    global mktagtop
2780
2781    catch {destroy $mktagtop}
2782    unset mktagtop
2783}
2784
2785proc mktaggo {} {
2786    domktag
2787    mktagcan
2788}
2789
2790proc writecommit {} {
2791    global rowmenuid wrcomtop commitinfo wrcomcmd
2792
2793    set top .writecommit
2794    set wrcomtop $top
2795    catch {destroy $top}
2796    toplevel $top
2797    label $top.title -text "Write commit to file"
2798    grid $top.title - -pady 10
2799    label $top.id -text "ID:"
2800    entry $top.sha1 -width 40 -relief flat
2801    $top.sha1 insert 0 $rowmenuid
2802    $top.sha1 conf -state readonly
2803    grid $top.id $top.sha1 -sticky w
2804    entry $top.head -width 60 -relief flat
2805    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
2806    $top.head conf -state readonly
2807    grid x $top.head -sticky w
2808    label $top.clab -text "Command:"
2809    entry $top.cmd -width 60 -textvariable wrcomcmd
2810    grid $top.clab $top.cmd -sticky w -pady 10
2811    label $top.flab -text "Output file:"
2812    entry $top.fname -width 60
2813    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
2814    grid $top.flab $top.fname -sticky w
2815    frame $top.buts
2816    button $top.buts.gen -text "Write" -command wrcomgo
2817    button $top.buts.can -text "Cancel" -command wrcomcan
2818    grid $top.buts.gen $top.buts.can
2819    grid columnconfigure $top.buts 0 -weight 1 -uniform a
2820    grid columnconfigure $top.buts 1 -weight 1 -uniform a
2821    grid $top.buts - -pady 10 -sticky ew
2822    focus $top.fname
2823}
2824
2825proc wrcomgo {} {
2826    global wrcomtop
2827
2828    set id [$wrcomtop.sha1 get]
2829    set cmd "echo $id | [$wrcomtop.cmd get]"
2830    set fname [$wrcomtop.fname get]
2831    if {[catch {exec sh -c $cmd >$fname &} err]} {
2832        error_popup "Error writing commit: $err"
2833    }
2834    catch {destroy $wrcomtop}
2835    unset wrcomtop
2836}
2837
2838proc wrcomcan {} {
2839    global wrcomtop
2840
2841    catch {destroy $wrcomtop}
2842    unset wrcomtop
2843}
2844
2845proc doquit {} {
2846    global stopped
2847    set stopped 100
2848    destroy .
2849}
2850
2851# defaults...
2852set datemode 0
2853set boldnames 0
2854set diffopts "-U 5 -p"
2855set wrcomcmd "git-diff-tree --stdin -p --pretty"
2856
2857set mainfont {Helvetica 9}
2858set textfont {Courier 9}
2859set findmergefiles 0
2860set gaudydiff 0
2861
2862set colors {green red blue magenta darkgrey brown orange}
2863
2864catch {source ~/.gitk}
2865
2866set namefont $mainfont
2867if {$boldnames} {
2868    lappend namefont bold
2869}
2870
2871set revtreeargs {}
2872foreach arg $argv {
2873    switch -regexp -- $arg {
2874        "^$" { }
2875        "^-b" { set boldnames 1 }
2876        "^-d" { set datemode 1 }
2877        default {
2878            lappend revtreeargs $arg
2879        }
2880    }
2881}
2882
2883set stopped 0
2884set redisplaying 0
2885set stuffsaved 0
2886set patchnum 0
2887setcoords
2888makewindow
2889readrefs
2890getcommits $revtreeargs