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