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