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