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