gitkon commit gitk: Add braces around if expressions (418c4c7)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   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 parse_args {rargs} {
  20    global parsed_args
  21
  22    if {[catch {
  23        set parse_args [concat --default HEAD $rargs]
  24        set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
  25    }]} {
  26        # if git-rev-parse failed for some reason...
  27        if {$rargs == {}} {
  28            set rargs HEAD
  29        }
  30        set parsed_args $rargs
  31    }
  32    return $parsed_args
  33}
  34
  35proc start_rev_list {rlargs} {
  36    global startmsecs nextupdate ncmupdate
  37    global commfd leftover tclencoding
  38
  39    set startmsecs [clock clicks -milliseconds]
  40    set nextupdate [expr {$startmsecs + 100}]
  41    set ncmupdate 1
  42    if {[catch {
  43        set commfd [open [concat | git-rev-list --header --topo-order \
  44                              --parents $rlargs] r]
  45    } err]} {
  46        puts stderr "Error executing git-rev-list: $err"
  47        exit 1
  48    }
  49    set leftover {}
  50    fconfigure $commfd -blocking 0 -translation lf
  51    if {$tclencoding != {}} {
  52        fconfigure $commfd -encoding $tclencoding
  53    }
  54    fileevent $commfd readable [list getcommitlines $commfd]
  55    . config -cursor watch
  56    settextcursor watch
  57}
  58
  59proc getcommits {rargs} {
  60    global oldcommits commits phase canv mainfont env
  61
  62    # check that we can find a .git directory somewhere...
  63    set gitdir [gitdir]
  64    if {![file isdirectory $gitdir]} {
  65        error_popup "Cannot find the git directory \"$gitdir\"."
  66        exit 1
  67    }
  68    set oldcommits {}
  69    set commits {}
  70    set phase getcommits
  71    start_rev_list [parse_args $rargs]
  72    $canv delete all
  73    $canv create text 3 3 -anchor nw -text "Reading commits..." \
  74        -font $mainfont -tags textitems
  75}
  76
  77proc getcommitlines {commfd}  {
  78    global oldcommits commits parents cdate children nchildren
  79    global commitlisted phase nextupdate
  80    global stopped redisplaying leftover
  81    global canv
  82
  83    set stuff [read $commfd]
  84    if {$stuff == {}} {
  85        if {![eof $commfd]} return
  86        # set it blocking so we wait for the process to terminate
  87        fconfigure $commfd -blocking 1
  88        if {![catch {close $commfd} err]} {
  89            after idle finishcommits
  90            return
  91        }
  92        if {[string range $err 0 4] == "usage"} {
  93            set err \
  94                "Gitk: error reading commits: bad arguments to git-rev-list.\
  95                (Note: arguments to gitk are passed to git-rev-list\
  96                to allow selection of commits to be displayed.)"
  97        } else {
  98            set err "Error reading commits: $err"
  99        }
 100        error_popup $err
 101        exit 1
 102    }
 103    set start 0
 104    while 1 {
 105        set i [string first "\0" $stuff $start]
 106        if {$i < 0} {
 107            append leftover [string range $stuff $start end]
 108            return
 109        }
 110        set cmit [string range $stuff $start [expr {$i - 1}]]
 111        if {$start == 0} {
 112            set cmit "$leftover$cmit"
 113            set leftover {}
 114        }
 115        set start [expr {$i + 1}]
 116        set j [string first "\n" $cmit]
 117        set ok 0
 118        if {$j >= 0} {
 119            set ids [string range $cmit 0 [expr {$j - 1}]]
 120            set ok 1
 121            foreach id $ids {
 122                if {![regexp {^[0-9a-f]{40}$} $id]} {
 123                    set ok 0
 124                    break
 125                }
 126            }
 127        }
 128        if {!$ok} {
 129            set shortcmit $cmit
 130            if {[string length $shortcmit] > 80} {
 131                set shortcmit "[string range $shortcmit 0 80]..."
 132            }
 133            error_popup "Can't parse git-rev-list output: {$shortcmit}"
 134            exit 1
 135        }
 136        set id [lindex $ids 0]
 137        set olds [lrange $ids 1 end]
 138        set cmit [string range $cmit [expr {$j + 1}] end]
 139        lappend commits $id
 140        set commitlisted($id) 1
 141        parsecommit $id $cmit 1 [lrange $ids 1 end]
 142        drawcommit $id 1
 143        if {[clock clicks -milliseconds] >= $nextupdate} {
 144            doupdate 1
 145        }
 146        while {$redisplaying} {
 147            set redisplaying 0
 148            if {$stopped == 1} {
 149                set stopped 0
 150                set phase "getcommits"
 151                foreach id $commits {
 152                    drawcommit $id 1
 153                    if {$stopped} break
 154                    if {[clock clicks -milliseconds] >= $nextupdate} {
 155                        doupdate 1
 156                    }
 157                }
 158            }
 159        }
 160    }
 161}
 162
 163proc doupdate {reading} {
 164    global commfd nextupdate numcommits ncmupdate
 165
 166    if {$reading} {
 167        fileevent $commfd readable {}
 168    }
 169    update
 170    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 171    if {$numcommits < 100} {
 172        set ncmupdate [expr {$numcommits + 1}]
 173    } elseif {$numcommits < 10000} {
 174        set ncmupdate [expr {$numcommits + 10}]
 175    } else {
 176        set ncmupdate [expr {$numcommits + 100}]
 177    }
 178    if {$reading} {
 179        fileevent $commfd readable [list getcommitlines $commfd]
 180    }
 181}
 182
 183proc readcommit {id} {
 184    if {[catch {set contents [exec git-cat-file commit $id]}]} return
 185    parsecommit $id $contents 0 {}
 186}
 187
 188proc updatecommits {rargs} {
 189    global commitlisted commfd phase
 190    global startmsecs nextupdate ncmupdate
 191    global idtags idheads idotherrefs
 192    global leftover
 193    global parsed_args
 194    global canv mainfont
 195    global oldcommits commits
 196    global parents nchildren children ncleft
 197
 198    set old_args $parsed_args
 199    parse_args $rargs
 200
 201    if {$phase == "getcommits" || $phase == "incrdraw"} {
 202        # havent read all the old commits, just start again from scratch
 203        stopfindproc
 204        set oldcommits {}
 205        set commits {}
 206        foreach v {children nchildren parents commitlisted commitinfo
 207                   selectedline matchinglines treediffs
 208                   mergefilelist currentid rowtextx} {
 209            global $v
 210            catch {unset $v}
 211        }
 212        readrefs
 213        if {$phase == "incrdraw"} {
 214            allcanvs delete all
 215            $canv create text 3 3 -anchor nw -text "Reading commits..." \
 216                -font $mainfont -tags textitems
 217            set phase getcommits
 218        }
 219        start_rev_list $parsed_args
 220        return
 221    }
 222
 223    foreach id $old_args {
 224        if {![regexp {^[0-9a-f]{40}$} $id]} continue
 225        if {[info exists oldref($id)]} continue
 226        set oldref($id) $id
 227        lappend ignoreold "^$id"
 228    }
 229    foreach id $parsed_args {
 230        if {![regexp {^[0-9a-f]{40}$} $id]} continue
 231        if {[info exists ref($id)]} continue
 232        set ref($id) $id
 233        lappend ignorenew "^$id"
 234    }
 235
 236    foreach a $old_args {
 237        if {![info exists ref($a)]} {
 238            lappend ignorenew $a
 239        }
 240    }
 241
 242    set phase updatecommits
 243    set oldcommits $commits
 244    set commits {}
 245    set removed_commits [split [eval exec git-rev-list $ignorenew] "\n" ]
 246    if {[llength $removed_commits] > 0} {
 247        allcanvs delete all
 248        foreach c $removed_commits {
 249            set i [lsearch -exact $oldcommits $c]
 250            if {$i >= 0} {
 251                set oldcommits [lreplace $oldcommits $i $i]
 252                unset commitlisted($c)
 253                foreach p $parents($c) {
 254                    if {[info exists nchildren($p)]} {
 255                        set j [lsearch -exact $children($p) $c]
 256                        if {$j >= 0} {
 257                            set children($p) [lreplace $children($p) $j $j]
 258                            incr nchildren($p) -1
 259                        }
 260                    }
 261                }
 262            }
 263        }
 264        set phase removecommits
 265    }
 266
 267    set args {}
 268    foreach a $parsed_args {
 269        if {![info exists oldref($a)]} {
 270            lappend args $a
 271        }
 272    }
 273
 274    readrefs
 275    start_rev_list [concat $ignoreold $args]
 276}
 277
 278proc updatechildren {id olds} {
 279    global children nchildren parents nparents ncleft
 280
 281    if {![info exists nchildren($id)]} {
 282        set children($id) {}
 283        set nchildren($id) 0
 284        set ncleft($id) 0
 285    }
 286    set parents($id) $olds
 287    set nparents($id) [llength $olds]
 288    foreach p $olds {
 289        if {![info exists nchildren($p)]} {
 290            set children($p) [list $id]
 291            set nchildren($p) 1
 292            set ncleft($p) 1
 293        } elseif {[lsearch -exact $children($p) $id] < 0} {
 294            lappend children($p) $id
 295            incr nchildren($p)
 296            incr ncleft($p)
 297        }
 298    }
 299}
 300
 301proc parsecommit {id contents listed olds} {
 302    global commitinfo cdate
 303
 304    set inhdr 1
 305    set comment {}
 306    set headline {}
 307    set auname {}
 308    set audate {}
 309    set comname {}
 310    set comdate {}
 311    updatechildren $id $olds
 312    set hdrend [string first "\n\n" $contents]
 313    if {$hdrend < 0} {
 314        # should never happen...
 315        set hdrend [string length $contents]
 316    }
 317    set header [string range $contents 0 [expr {$hdrend - 1}]]
 318    set comment [string range $contents [expr {$hdrend + 2}] end]
 319    foreach line [split $header "\n"] {
 320        set tag [lindex $line 0]
 321        if {$tag == "author"} {
 322            set audate [lindex $line end-1]
 323            set auname [lrange $line 1 end-2]
 324        } elseif {$tag == "committer"} {
 325            set comdate [lindex $line end-1]
 326            set comname [lrange $line 1 end-2]
 327        }
 328    }
 329    set headline {}
 330    # take the first line of the comment as the headline
 331    set i [string first "\n" $comment]
 332    if {$i >= 0} {
 333        set headline [string trim [string range $comment 0 $i]]
 334    } else {
 335        set headline $comment
 336    }
 337    if {!$listed} {
 338        # git-rev-list indents the comment by 4 spaces;
 339        # if we got this via git-cat-file, add the indentation
 340        set newcomment {}
 341        foreach line [split $comment "\n"] {
 342            append newcomment "    "
 343            append newcomment $line
 344            append newcomment "\n"
 345        }
 346        set comment $newcomment
 347    }
 348    if {$comdate != {}} {
 349        set cdate($id) $comdate
 350    }
 351    set commitinfo($id) [list $headline $auname $audate \
 352                             $comname $comdate $comment]
 353}
 354
 355proc readrefs {} {
 356    global tagids idtags headids idheads tagcontents
 357    global otherrefids idotherrefs
 358
 359    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 360        catch {unset $v}
 361    }
 362    set refd [open [list | git-ls-remote [gitdir]] r]
 363    while {0 <= [set n [gets $refd line]]} {
 364        if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
 365            match id path]} {
 366            continue
 367        }
 368        if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 369            set type others
 370            set name $path
 371        }
 372        if {$type == "tags"} {
 373            set tagids($name) $id
 374            lappend idtags($id) $name
 375            set obj {}
 376            set type {}
 377            set tag {}
 378            catch {
 379                set commit [exec git-rev-parse "$id^0"]
 380                if {"$commit" != "$id"} {
 381                    set tagids($name) $commit
 382                    lappend idtags($commit) $name
 383                }
 384            }           
 385            catch {
 386                set tagcontents($name) [exec git-cat-file tag "$id"]
 387            }
 388        } elseif { $type == "heads" } {
 389            set headids($name) $id
 390            lappend idheads($id) $name
 391        } else {
 392            set otherrefids($name) $id
 393            lappend idotherrefs($id) $name
 394        }
 395    }
 396    close $refd
 397}
 398
 399proc error_popup msg {
 400    set w .error
 401    toplevel $w
 402    wm transient $w .
 403    message $w.m -text $msg -justify center -aspect 400
 404    pack $w.m -side top -fill x -padx 20 -pady 20
 405    button $w.ok -text OK -command "destroy $w"
 406    pack $w.ok -side bottom -fill x
 407    bind $w <Visibility> "grab $w; focus $w"
 408    tkwait window $w
 409}
 410
 411proc makewindow {rargs} {
 412    global canv canv2 canv3 linespc charspc ctext cflist textfont
 413    global findtype findtypemenu findloc findstring fstring geometry
 414    global entries sha1entry sha1string sha1but
 415    global maincursor textcursor curtextcursor
 416    global rowctxmenu mergemax
 417
 418    menu .bar
 419    .bar add cascade -label "File" -menu .bar.file
 420    menu .bar.file
 421    .bar.file add command -label "Update" -command [list updatecommits $rargs]
 422    .bar.file add command -label "Reread references" -command rereadrefs
 423    .bar.file add command -label "Quit" -command doquit
 424    menu .bar.edit
 425    .bar add cascade -label "Edit" -menu .bar.edit
 426    .bar.edit add command -label "Preferences" -command doprefs
 427    menu .bar.help
 428    .bar add cascade -label "Help" -menu .bar.help
 429    .bar.help add command -label "About gitk" -command about
 430    . configure -menu .bar
 431
 432    if {![info exists geometry(canv1)]} {
 433        set geometry(canv1) [expr {45 * $charspc}]
 434        set geometry(canv2) [expr {30 * $charspc}]
 435        set geometry(canv3) [expr {15 * $charspc}]
 436        set geometry(canvh) [expr {25 * $linespc + 4}]
 437        set geometry(ctextw) 80
 438        set geometry(ctexth) 30
 439        set geometry(cflistw) 30
 440    }
 441    panedwindow .ctop -orient vertical
 442    if {[info exists geometry(width)]} {
 443        .ctop conf -width $geometry(width) -height $geometry(height)
 444        set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 445        set geometry(ctexth) [expr {($texth - 8) /
 446                                    [font metrics $textfont -linespace]}]
 447    }
 448    frame .ctop.top
 449    frame .ctop.top.bar
 450    pack .ctop.top.bar -side bottom -fill x
 451    set cscroll .ctop.top.csb
 452    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 453    pack $cscroll -side right -fill y
 454    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 455    pack .ctop.top.clist -side top -fill both -expand 1
 456    .ctop add .ctop.top
 457    set canv .ctop.top.clist.canv
 458    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 459        -bg white -bd 0 \
 460        -yscrollincr $linespc -yscrollcommand "$cscroll set"
 461    .ctop.top.clist add $canv
 462    set canv2 .ctop.top.clist.canv2
 463    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 464        -bg white -bd 0 -yscrollincr $linespc
 465    .ctop.top.clist add $canv2
 466    set canv3 .ctop.top.clist.canv3
 467    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 468        -bg white -bd 0 -yscrollincr $linespc
 469    .ctop.top.clist add $canv3
 470    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 471
 472    set sha1entry .ctop.top.bar.sha1
 473    set entries $sha1entry
 474    set sha1but .ctop.top.bar.sha1label
 475    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 476        -command gotocommit -width 8
 477    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 478    pack .ctop.top.bar.sha1label -side left
 479    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 480    trace add variable sha1string write sha1change
 481    pack $sha1entry -side left -pady 2
 482
 483    image create bitmap bm-left -data {
 484        #define left_width 16
 485        #define left_height 16
 486        static unsigned char left_bits[] = {
 487        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 488        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 489        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 490    }
 491    image create bitmap bm-right -data {
 492        #define right_width 16
 493        #define right_height 16
 494        static unsigned char right_bits[] = {
 495        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 496        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 497        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 498    }
 499    button .ctop.top.bar.leftbut -image bm-left -command goback \
 500        -state disabled -width 26
 501    pack .ctop.top.bar.leftbut -side left -fill y
 502    button .ctop.top.bar.rightbut -image bm-right -command goforw \
 503        -state disabled -width 26
 504    pack .ctop.top.bar.rightbut -side left -fill y
 505
 506    button .ctop.top.bar.findbut -text "Find" -command dofind
 507    pack .ctop.top.bar.findbut -side left
 508    set findstring {}
 509    set fstring .ctop.top.bar.findstring
 510    lappend entries $fstring
 511    entry $fstring -width 30 -font $textfont -textvariable findstring
 512    pack $fstring -side left -expand 1 -fill x
 513    set findtype Exact
 514    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 515                          findtype Exact IgnCase Regexp]
 516    set findloc "All fields"
 517    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 518        Comments Author Committer Files Pickaxe
 519    pack .ctop.top.bar.findloc -side right
 520    pack .ctop.top.bar.findtype -side right
 521    # for making sure type==Exact whenever loc==Pickaxe
 522    trace add variable findloc write findlocchange
 523
 524    panedwindow .ctop.cdet -orient horizontal
 525    .ctop add .ctop.cdet
 526    frame .ctop.cdet.left
 527    set ctext .ctop.cdet.left.ctext
 528    text $ctext -bg white -state disabled -font $textfont \
 529        -width $geometry(ctextw) -height $geometry(ctexth) \
 530        -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
 531    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 532    pack .ctop.cdet.left.sb -side right -fill y
 533    pack $ctext -side left -fill both -expand 1
 534    .ctop.cdet add .ctop.cdet.left
 535
 536    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 537    $ctext tag conf hunksep -fore blue
 538    $ctext tag conf d0 -fore red
 539    $ctext tag conf d1 -fore "#00a000"
 540    $ctext tag conf m0 -fore red
 541    $ctext tag conf m1 -fore blue
 542    $ctext tag conf m2 -fore green
 543    $ctext tag conf m3 -fore purple
 544    $ctext tag conf m4 -fore brown
 545    $ctext tag conf mmax -fore darkgrey
 546    set mergemax 5
 547    $ctext tag conf mresult -font [concat $textfont bold]
 548    $ctext tag conf msep -font [concat $textfont bold]
 549    $ctext tag conf found -back yellow
 550
 551    frame .ctop.cdet.right
 552    set cflist .ctop.cdet.right.cfiles
 553    listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 554        -yscrollcommand ".ctop.cdet.right.sb set"
 555    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 556    pack .ctop.cdet.right.sb -side right -fill y
 557    pack $cflist -side left -fill both -expand 1
 558    .ctop.cdet add .ctop.cdet.right
 559    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 560
 561    pack .ctop -side top -fill both -expand 1
 562
 563    bindall <1> {selcanvline %W %x %y}
 564    #bindall <B1-Motion> {selcanvline %W %x %y}
 565    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 566    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 567    bindall <2> "allcanvs scan mark 0 %y"
 568    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 569    bind . <Key-Up> "selnextline -1"
 570    bind . <Key-Down> "selnextline 1"
 571    bind . <Key-Right> "goforw"
 572    bind . <Key-Left> "goback"
 573    bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 574    bind . <Key-Next> "allcanvs yview scroll 1 pages"
 575    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 576    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 577    bindkey <Key-space> "$ctext yview scroll 1 pages"
 578    bindkey p "selnextline -1"
 579    bindkey n "selnextline 1"
 580    bindkey z "goback"
 581    bindkey x "goforw"
 582    bindkey i "selnextline -1"
 583    bindkey k "selnextline 1"
 584    bindkey j "goback"
 585    bindkey l "goforw"
 586    bindkey b "$ctext yview scroll -1 pages"
 587    bindkey d "$ctext yview scroll 18 units"
 588    bindkey u "$ctext yview scroll -18 units"
 589    bindkey / {findnext 1}
 590    bindkey <Key-Return> {findnext 0}
 591    bindkey ? findprev
 592    bindkey f nextfile
 593    bind . <Control-q> doquit
 594    bind . <Control-f> dofind
 595    bind . <Control-g> {findnext 0}
 596    bind . <Control-r> findprev
 597    bind . <Control-equal> {incrfont 1}
 598    bind . <Control-KP_Add> {incrfont 1}
 599    bind . <Control-minus> {incrfont -1}
 600    bind . <Control-KP_Subtract> {incrfont -1}
 601    bind $cflist <<ListboxSelect>> listboxsel
 602    bind . <Destroy> {savestuff %W}
 603    bind . <Button-1> "click %W"
 604    bind $fstring <Key-Return> dofind
 605    bind $sha1entry <Key-Return> gotocommit
 606    bind $sha1entry <<PasteSelection>> clearsha1
 607
 608    set maincursor [. cget -cursor]
 609    set textcursor [$ctext cget -cursor]
 610    set curtextcursor $textcursor
 611
 612    set rowctxmenu .rowctxmenu
 613    menu $rowctxmenu -tearoff 0
 614    $rowctxmenu add command -label "Diff this -> selected" \
 615        -command {diffvssel 0}
 616    $rowctxmenu add command -label "Diff selected -> this" \
 617        -command {diffvssel 1}
 618    $rowctxmenu add command -label "Make patch" -command mkpatch
 619    $rowctxmenu add command -label "Create tag" -command mktag
 620    $rowctxmenu add command -label "Write commit to file" -command writecommit
 621}
 622
 623# when we make a key binding for the toplevel, make sure
 624# it doesn't get triggered when that key is pressed in the
 625# find string entry widget.
 626proc bindkey {ev script} {
 627    global entries
 628    bind . $ev $script
 629    set escript [bind Entry $ev]
 630    if {$escript == {}} {
 631        set escript [bind Entry <Key>]
 632    }
 633    foreach e $entries {
 634        bind $e $ev "$escript; break"
 635    }
 636}
 637
 638# set the focus back to the toplevel for any click outside
 639# the entry widgets
 640proc click {w} {
 641    global entries
 642    foreach e $entries {
 643        if {$w == $e} return
 644    }
 645    focus .
 646}
 647
 648proc savestuff {w} {
 649    global canv canv2 canv3 ctext cflist mainfont textfont
 650    global stuffsaved findmergefiles maxgraphpct
 651    global maxwidth
 652
 653    if {$stuffsaved} return
 654    if {![winfo viewable .]} return
 655    catch {
 656        set f [open "~/.gitk-new" w]
 657        puts $f [list set mainfont $mainfont]
 658        puts $f [list set textfont $textfont]
 659        puts $f [list set findmergefiles $findmergefiles]
 660        puts $f [list set maxgraphpct $maxgraphpct]
 661        puts $f [list set maxwidth $maxwidth]
 662        puts $f "set geometry(width) [winfo width .ctop]"
 663        puts $f "set geometry(height) [winfo height .ctop]"
 664        puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
 665        puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
 666        puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
 667        puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
 668        set wid [expr {([winfo width $ctext] - 8) \
 669                           / [font measure $textfont "0"]}]
 670        puts $f "set geometry(ctextw) $wid"
 671        set wid [expr {([winfo width $cflist] - 11) \
 672                           / [font measure [$cflist cget -font] "0"]}]
 673        puts $f "set geometry(cflistw) $wid"
 674        close $f
 675        file rename -force "~/.gitk-new" "~/.gitk"
 676    }
 677    set stuffsaved 1
 678}
 679
 680proc resizeclistpanes {win w} {
 681    global oldwidth
 682    if {[info exists oldwidth($win)]} {
 683        set s0 [$win sash coord 0]
 684        set s1 [$win sash coord 1]
 685        if {$w < 60} {
 686            set sash0 [expr {int($w/2 - 2)}]
 687            set sash1 [expr {int($w*5/6 - 2)}]
 688        } else {
 689            set factor [expr {1.0 * $w / $oldwidth($win)}]
 690            set sash0 [expr {int($factor * [lindex $s0 0])}]
 691            set sash1 [expr {int($factor * [lindex $s1 0])}]
 692            if {$sash0 < 30} {
 693                set sash0 30
 694            }
 695            if {$sash1 < $sash0 + 20} {
 696                set sash1 [expr {$sash0 + 20}]
 697            }
 698            if {$sash1 > $w - 10} {
 699                set sash1 [expr {$w - 10}]
 700                if {$sash0 > $sash1 - 20} {
 701                    set sash0 [expr {$sash1 - 20}]
 702                }
 703            }
 704        }
 705        $win sash place 0 $sash0 [lindex $s0 1]
 706        $win sash place 1 $sash1 [lindex $s1 1]
 707    }
 708    set oldwidth($win) $w
 709}
 710
 711proc resizecdetpanes {win w} {
 712    global oldwidth
 713    if {[info exists oldwidth($win)]} {
 714        set s0 [$win sash coord 0]
 715        if {$w < 60} {
 716            set sash0 [expr {int($w*3/4 - 2)}]
 717        } else {
 718            set factor [expr {1.0 * $w / $oldwidth($win)}]
 719            set sash0 [expr {int($factor * [lindex $s0 0])}]
 720            if {$sash0 < 45} {
 721                set sash0 45
 722            }
 723            if {$sash0 > $w - 15} {
 724                set sash0 [expr {$w - 15}]
 725            }
 726        }
 727        $win sash place 0 $sash0 [lindex $s0 1]
 728    }
 729    set oldwidth($win) $w
 730}
 731
 732proc allcanvs args {
 733    global canv canv2 canv3
 734    eval $canv $args
 735    eval $canv2 $args
 736    eval $canv3 $args
 737}
 738
 739proc bindall {event action} {
 740    global canv canv2 canv3
 741    bind $canv $event $action
 742    bind $canv2 $event $action
 743    bind $canv3 $event $action
 744}
 745
 746proc about {} {
 747    set w .about
 748    if {[winfo exists $w]} {
 749        raise $w
 750        return
 751    }
 752    toplevel $w
 753    wm title $w "About gitk"
 754    message $w.m -text {
 755Gitk version 1.2
 756
 757Copyright © 2005 Paul Mackerras
 758
 759Use and redistribute under the terms of the GNU General Public License} \
 760            -justify center -aspect 400
 761    pack $w.m -side top -fill x -padx 20 -pady 20
 762    button $w.ok -text Close -command "destroy $w"
 763    pack $w.ok -side bottom
 764}
 765
 766proc assigncolor {id} {
 767    global colormap commcolors colors nextcolor
 768    global parents nparents children nchildren
 769    global cornercrossings crossings
 770
 771    if {[info exists colormap($id)]} return
 772    set ncolors [llength $colors]
 773    if {$nparents($id) <= 1 && $nchildren($id) == 1} {
 774        set child [lindex $children($id) 0]
 775        if {[info exists colormap($child)]
 776            && $nparents($child) == 1} {
 777            set colormap($id) $colormap($child)
 778            return
 779        }
 780    }
 781    set badcolors {}
 782    if {[info exists cornercrossings($id)]} {
 783        foreach x $cornercrossings($id) {
 784            if {[info exists colormap($x)]
 785                && [lsearch -exact $badcolors $colormap($x)] < 0} {
 786                lappend badcolors $colormap($x)
 787            }
 788        }
 789        if {[llength $badcolors] >= $ncolors} {
 790            set badcolors {}
 791        }
 792    }
 793    set origbad $badcolors
 794    if {[llength $badcolors] < $ncolors - 1} {
 795        if {[info exists crossings($id)]} {
 796            foreach x $crossings($id) {
 797                if {[info exists colormap($x)]
 798                    && [lsearch -exact $badcolors $colormap($x)] < 0} {
 799                    lappend badcolors $colormap($x)
 800                }
 801            }
 802            if {[llength $badcolors] >= $ncolors} {
 803                set badcolors $origbad
 804            }
 805        }
 806        set origbad $badcolors
 807    }
 808    if {[llength $badcolors] < $ncolors - 1} {
 809        foreach child $children($id) {
 810            if {[info exists colormap($child)]
 811                && [lsearch -exact $badcolors $colormap($child)] < 0} {
 812                lappend badcolors $colormap($child)
 813            }
 814            if {[info exists parents($child)]} {
 815                foreach p $parents($child) {
 816                    if {[info exists colormap($p)]
 817                        && [lsearch -exact $badcolors $colormap($p)] < 0} {
 818                        lappend badcolors $colormap($p)
 819                    }
 820                }
 821            }
 822        }
 823        if {[llength $badcolors] >= $ncolors} {
 824            set badcolors $origbad
 825        }
 826    }
 827    for {set i 0} {$i <= $ncolors} {incr i} {
 828        set c [lindex $colors $nextcolor]
 829        if {[incr nextcolor] >= $ncolors} {
 830            set nextcolor 0
 831        }
 832        if {[lsearch -exact $badcolors $c]} break
 833    }
 834    set colormap($id) $c
 835}
 836
 837proc initgraph {} {
 838    global canvy canvy0 lineno numcommits nextcolor linespc
 839    global nchildren ncleft
 840    global displist nhyperspace
 841
 842    allcanvs delete all
 843    set nextcolor 0
 844    set canvy $canvy0
 845    set lineno -1
 846    set numcommits 0
 847    foreach v {mainline mainlinearrow sidelines colormap cornercrossings
 848                crossings idline lineid} {
 849        global $v
 850        catch {unset $v}
 851    }
 852    foreach id [array names nchildren] {
 853        set ncleft($id) $nchildren($id)
 854    }
 855    set displist {}
 856    set nhyperspace 0
 857}
 858
 859proc bindline {t id} {
 860    global canv
 861
 862    $canv bind $t <Enter> "lineenter %x %y $id"
 863    $canv bind $t <Motion> "linemotion %x %y $id"
 864    $canv bind $t <Leave> "lineleave $id"
 865    $canv bind $t <Button-1> "lineclick %x %y $id 1"
 866}
 867
 868proc drawlines {id xtra delold} {
 869    global mainline mainlinearrow sidelines lthickness colormap canv
 870
 871    if {$delold} {
 872        $canv delete lines.$id
 873    }
 874    if {[info exists mainline($id)]} {
 875        set t [$canv create line $mainline($id) \
 876                   -width [expr {($xtra + 1) * $lthickness}] \
 877                   -fill $colormap($id) -tags lines.$id \
 878                   -arrow $mainlinearrow($id)]
 879        $canv lower $t
 880        bindline $t $id
 881    }
 882    if {[info exists sidelines($id)]} {
 883        foreach ls $sidelines($id) {
 884            set coords [lindex $ls 0]
 885            set thick [lindex $ls 1]
 886            set arrow [lindex $ls 2]
 887            set t [$canv create line $coords -fill $colormap($id) \
 888                       -width [expr {($thick + $xtra) * $lthickness}] \
 889                       -arrow $arrow -tags lines.$id]
 890            $canv lower $t
 891            bindline $t $id
 892        }
 893    }
 894}
 895
 896# level here is an index in displist
 897proc drawcommitline {level} {
 898    global parents children nparents displist
 899    global canv canv2 canv3 mainfont namefont canvy linespc
 900    global lineid linehtag linentag linedtag commitinfo
 901    global colormap numcommits currentparents dupparents
 902    global idtags idline idheads idotherrefs
 903    global lineno lthickness mainline mainlinearrow sidelines
 904    global commitlisted rowtextx idpos lastuse displist
 905    global oldnlines olddlevel olddisplist
 906
 907    incr numcommits
 908    incr lineno
 909    set id [lindex $displist $level]
 910    set lastuse($id) $lineno
 911    set lineid($lineno) $id
 912    set idline($id) $lineno
 913    set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 914    if {![info exists commitinfo($id)]} {
 915        readcommit $id
 916        if {![info exists commitinfo($id)]} {
 917            set commitinfo($id) {"No commit information available"}
 918            set nparents($id) 0
 919        }
 920    }
 921    assigncolor $id
 922    set currentparents {}
 923    set dupparents {}
 924    if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 925        foreach p $parents($id) {
 926            if {[lsearch -exact $currentparents $p] < 0} {
 927                lappend currentparents $p
 928            } else {
 929                # remember that this parent was listed twice
 930                lappend dupparents $p
 931            }
 932        }
 933    }
 934    set x [xcoord $level $level $lineno]
 935    set y1 $canvy
 936    set canvy [expr {$canvy + $linespc}]
 937    allcanvs conf -scrollregion \
 938        [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]]
 939    if {[info exists mainline($id)]} {
 940        lappend mainline($id) $x $y1
 941        if {$mainlinearrow($id) ne "none"} {
 942            set mainline($id) [trimdiagstart $mainline($id)]
 943        }
 944    }
 945    drawlines $id 0 0
 946    set orad [expr {$linespc / 3}]
 947    set t [$canv create oval [expr {$x - $orad}] [expr {$y1 - $orad}] \
 948               [expr {$x + $orad - 1}] [expr {$y1 + $orad - 1}] \
 949               -fill $ofill -outline black -width 1]
 950    $canv raise $t
 951    $canv bind $t <1> {selcanvline {} %x %y}
 952    set xt [xcoord [llength $displist] $level $lineno]
 953    if {[llength $currentparents] > 2} {
 954        set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
 955    }
 956    set rowtextx($lineno) $xt
 957    set idpos($id) [list $x $xt $y1]
 958    if {[info exists idtags($id)] || [info exists idheads($id)]
 959        || [info exists idotherrefs($id)]} {
 960        set xt [drawtags $id $x $xt $y1]
 961    }
 962    set headline [lindex $commitinfo($id) 0]
 963    set name [lindex $commitinfo($id) 1]
 964    set date [lindex $commitinfo($id) 2]
 965    set date [formatdate $date]
 966    set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 967                               -text $headline -font $mainfont ]
 968    $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
 969    set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 970                               -text $name -font $namefont]
 971    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 972                               -text $date -font $mainfont]
 973
 974    set olddlevel $level
 975    set olddisplist $displist
 976    set oldnlines [llength $displist]
 977}
 978
 979proc drawtags {id x xt y1} {
 980    global idtags idheads idotherrefs
 981    global linespc lthickness
 982    global canv mainfont idline rowtextx
 983
 984    set marks {}
 985    set ntags 0
 986    set nheads 0
 987    if {[info exists idtags($id)]} {
 988        set marks $idtags($id)
 989        set ntags [llength $marks]
 990    }
 991    if {[info exists idheads($id)]} {
 992        set marks [concat $marks $idheads($id)]
 993        set nheads [llength $idheads($id)]
 994    }
 995    if {[info exists idotherrefs($id)]} {
 996        set marks [concat $marks $idotherrefs($id)]
 997    }
 998    if {$marks eq {}} {
 999        return $xt
1000    }
1001
1002    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1003    set yt [expr {$y1 - 0.5 * $linespc}]
1004    set yb [expr {$yt + $linespc - 1}]
1005    set xvals {}
1006    set wvals {}
1007    foreach tag $marks {
1008        set wid [font measure $mainfont $tag]
1009        lappend xvals $xt
1010        lappend wvals $wid
1011        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1012    }
1013    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1014               -width $lthickness -fill black -tags tag.$id]
1015    $canv lower $t
1016    foreach tag $marks x $xvals wid $wvals {
1017        set xl [expr {$x + $delta}]
1018        set xr [expr {$x + $delta + $wid + $lthickness}]
1019        if {[incr ntags -1] >= 0} {
1020            # draw a tag
1021            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1022                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1023                       -width 1 -outline black -fill yellow -tags tag.$id]
1024            $canv bind $t <1> [list showtag $tag 1]
1025            set rowtextx($idline($id)) [expr {$xr + $linespc}]
1026        } else {
1027            # draw a head or other ref
1028            if {[incr nheads -1] >= 0} {
1029                set col green
1030            } else {
1031                set col "#ddddff"
1032            }
1033            set xl [expr {$xl - $delta/2}]
1034            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1035                -width 1 -outline black -fill $col -tags tag.$id
1036        }
1037        set t [$canv create text $xl $y1 -anchor w -text $tag \
1038                   -font $mainfont -tags tag.$id]
1039        if {$ntags >= 0} {
1040            $canv bind $t <1> [list showtag $tag 1]
1041        }
1042    }
1043    return $xt
1044}
1045
1046proc notecrossings {id lo hi corner} {
1047    global olddisplist crossings cornercrossings
1048
1049    for {set i $lo} {[incr i] < $hi} {} {
1050        set p [lindex $olddisplist $i]
1051        if {$p == {}} continue
1052        if {$i == $corner} {
1053            if {![info exists cornercrossings($id)]
1054                || [lsearch -exact $cornercrossings($id) $p] < 0} {
1055                lappend cornercrossings($id) $p
1056            }
1057            if {![info exists cornercrossings($p)]
1058                || [lsearch -exact $cornercrossings($p) $id] < 0} {
1059                lappend cornercrossings($p) $id
1060            }
1061        } else {
1062            if {![info exists crossings($id)]
1063                || [lsearch -exact $crossings($id) $p] < 0} {
1064                lappend crossings($id) $p
1065            }
1066            if {![info exists crossings($p)]
1067                || [lsearch -exact $crossings($p) $id] < 0} {
1068                lappend crossings($p) $id
1069            }
1070        }
1071    }
1072}
1073
1074proc xcoord {i level ln} {
1075    global canvx0 xspc1 xspc2
1076
1077    set x [expr {$canvx0 + $i * $xspc1($ln)}]
1078    if {$i > 0 && $i == $level} {
1079        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1080    } elseif {$i > $level} {
1081        set x [expr {$x + $xspc2 - $xspc1($ln)}]
1082    }
1083    return $x
1084}
1085
1086# it seems Tk can't draw arrows on the end of diagonal line segments...
1087proc trimdiagend {line} {
1088    while {[llength $line] > 4} {
1089        set x1 [lindex $line end-3]
1090        set y1 [lindex $line end-2]
1091        set x2 [lindex $line end-1]
1092        set y2 [lindex $line end]
1093        if {($x1 == $x2) != ($y1 == $y2)} break
1094        set line [lreplace $line end-1 end]
1095    }
1096    return $line
1097}
1098
1099proc trimdiagstart {line} {
1100    while {[llength $line] > 4} {
1101        set x1 [lindex $line 0]
1102        set y1 [lindex $line 1]
1103        set x2 [lindex $line 2]
1104        set y2 [lindex $line 3]
1105        if {($x1 == $x2) != ($y1 == $y2)} break
1106        set line [lreplace $line 0 1]
1107    }
1108    return $line
1109}
1110
1111proc drawslants {id needonscreen nohs} {
1112    global canv mainline mainlinearrow sidelines
1113    global canvx0 canvy xspc1 xspc2 lthickness
1114    global currentparents dupparents
1115    global lthickness linespc canvy colormap lineno geometry
1116    global maxgraphpct maxwidth
1117    global displist onscreen lastuse
1118    global parents commitlisted
1119    global oldnlines olddlevel olddisplist
1120    global nhyperspace numcommits nnewparents
1121
1122    if {$lineno < 0} {
1123        lappend displist $id
1124        set onscreen($id) 1
1125        return 0
1126    }
1127
1128    set y1 [expr {$canvy - $linespc}]
1129    set y2 $canvy
1130
1131    # work out what we need to get back on screen
1132    set reins {}
1133    if {$onscreen($id) < 0} {
1134        # next to do isn't displayed, better get it on screen...
1135        lappend reins [list $id 0]
1136    }
1137    # make sure all the previous commits's parents are on the screen
1138    foreach p $currentparents {
1139        if {$onscreen($p) < 0} {
1140            lappend reins [list $p 0]
1141        }
1142    }
1143    # bring back anything requested by caller
1144    if {$needonscreen ne {}} {
1145        lappend reins $needonscreen
1146    }
1147
1148    # try the shortcut
1149    if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1150        set dlevel $olddlevel
1151        set x [xcoord $dlevel $dlevel $lineno]
1152        set mainline($id) [list $x $y1]
1153        set mainlinearrow($id) none
1154        set lastuse($id) $lineno
1155        set displist [lreplace $displist $dlevel $dlevel $id]
1156        set onscreen($id) 1
1157        set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1158        return $dlevel
1159    }
1160
1161    # update displist
1162    set displist [lreplace $displist $olddlevel $olddlevel]
1163    set j $olddlevel
1164    foreach p $currentparents {
1165        set lastuse($p) $lineno
1166        if {$onscreen($p) == 0} {
1167            set displist [linsert $displist $j $p]
1168            set onscreen($p) 1
1169            incr j
1170        }
1171    }
1172    if {$onscreen($id) == 0} {
1173        lappend displist $id
1174        set onscreen($id) 1
1175    }
1176
1177    # remove the null entry if present
1178    set nullentry [lsearch -exact $displist {}]
1179    if {$nullentry >= 0} {
1180        set displist [lreplace $displist $nullentry $nullentry]
1181    }
1182
1183    # bring back the ones we need now (if we did it earlier
1184    # it would change displist and invalidate olddlevel)
1185    foreach pi $reins {
1186        # test again in case of duplicates in reins
1187        set p [lindex $pi 0]
1188        if {$onscreen($p) < 0} {
1189            set onscreen($p) 1
1190            set lastuse($p) $lineno
1191            set displist [linsert $displist [lindex $pi 1] $p]
1192            incr nhyperspace -1
1193        }
1194    }
1195
1196    set lastuse($id) $lineno
1197
1198    # see if we need to make any lines jump off into hyperspace
1199    set displ [llength $displist]
1200    if {$displ > $maxwidth} {
1201        set ages {}
1202        foreach x $displist {
1203            lappend ages [list $lastuse($x) $x]
1204        }
1205        set ages [lsort -integer -index 0 $ages]
1206        set k 0
1207        while {$displ > $maxwidth} {
1208            set use [lindex $ages $k 0]
1209            set victim [lindex $ages $k 1]
1210            if {$use >= $lineno - 5} break
1211            incr k
1212            if {[lsearch -exact $nohs $victim] >= 0} continue
1213            set i [lsearch -exact $displist $victim]
1214            set displist [lreplace $displist $i $i]
1215            set onscreen($victim) -1
1216            incr nhyperspace
1217            incr displ -1
1218            if {$i < $nullentry} {
1219                incr nullentry -1
1220            }
1221            set x [lindex $mainline($victim) end-1]
1222            lappend mainline($victim) $x $y1
1223            set line [trimdiagend $mainline($victim)]
1224            set arrow "last"
1225            if {$mainlinearrow($victim) ne "none"} {
1226                set line [trimdiagstart $line]
1227                set arrow "both"
1228            }
1229            lappend sidelines($victim) [list $line 1 $arrow]
1230            unset mainline($victim)
1231        }
1232    }
1233
1234    set dlevel [lsearch -exact $displist $id]
1235
1236    # If we are reducing, put in a null entry
1237    if {$displ < $oldnlines} {
1238        # does the next line look like a merge?
1239        # i.e. does it have > 1 new parent?
1240        if {$nnewparents($id) > 1} {
1241            set i [expr {$dlevel + 1}]
1242        } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1243            set i $olddlevel
1244            if {$nullentry >= 0 && $nullentry < $i} {
1245                incr i -1
1246            }
1247        } elseif {$nullentry >= 0} {
1248            set i $nullentry
1249            while {$i < $displ
1250                   && [lindex $olddisplist $i] == [lindex $displist $i]} {
1251                incr i
1252            }
1253        } else {
1254            set i $olddlevel
1255            if {$dlevel >= $i} {
1256                incr i
1257            }
1258        }
1259        if {$i < $displ} {
1260            set displist [linsert $displist $i {}]
1261            incr displ
1262            if {$dlevel >= $i} {
1263                incr dlevel
1264            }
1265        }
1266    }
1267
1268    # decide on the line spacing for the next line
1269    set lj [expr {$lineno + 1}]
1270    set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1271    if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1272        set xspc1($lj) $xspc2
1273    } else {
1274        set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1275        if {$xspc1($lj) < $lthickness} {
1276            set xspc1($lj) $lthickness
1277        }
1278    }
1279
1280    foreach idi $reins {
1281        set id [lindex $idi 0]
1282        set j [lsearch -exact $displist $id]
1283        set xj [xcoord $j $dlevel $lj]
1284        set mainline($id) [list $xj $y2]
1285        set mainlinearrow($id) first
1286    }
1287
1288    set i -1
1289    foreach id $olddisplist {
1290        incr i
1291        if {$id == {}} continue
1292        if {$onscreen($id) <= 0} continue
1293        set xi [xcoord $i $olddlevel $lineno]
1294        if {$i == $olddlevel} {
1295            foreach p $currentparents {
1296                set j [lsearch -exact $displist $p]
1297                set coords [list $xi $y1]
1298                set xj [xcoord $j $dlevel $lj]
1299                if {$xj < $xi - $linespc} {
1300                    lappend coords [expr {$xj + $linespc}] $y1
1301                    notecrossings $p $j $i [expr {$j + 1}]
1302                } elseif {$xj > $xi + $linespc} {
1303                    lappend coords [expr {$xj - $linespc}] $y1
1304                    notecrossings $p $i $j [expr {$j - 1}]
1305                }
1306                if {[lsearch -exact $dupparents $p] >= 0} {
1307                    # draw a double-width line to indicate the doubled parent
1308                    lappend coords $xj $y2
1309                    lappend sidelines($p) [list $coords 2 none]
1310                    if {![info exists mainline($p)]} {
1311                        set mainline($p) [list $xj $y2]
1312                        set mainlinearrow($p) none
1313                    }
1314                } else {
1315                    # normal case, no parent duplicated
1316                    set yb $y2
1317                    set dx [expr {abs($xi - $xj)}]
1318                    if {0 && $dx < $linespc} {
1319                        set yb [expr {$y1 + $dx}]
1320                    }
1321                    if {![info exists mainline($p)]} {
1322                        if {$xi != $xj} {
1323                            lappend coords $xj $yb
1324                        }
1325                        set mainline($p) $coords
1326                        set mainlinearrow($p) none
1327                    } else {
1328                        lappend coords $xj $yb
1329                        if {$yb < $y2} {
1330                            lappend coords $xj $y2
1331                        }
1332                        lappend sidelines($p) [list $coords 1 none]
1333                    }
1334                }
1335            }
1336        } else {
1337            set j $i
1338            if {[lindex $displist $i] != $id} {
1339                set j [lsearch -exact $displist $id]
1340            }
1341            if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1342                || ($olddlevel < $i && $i < $dlevel)
1343                || ($dlevel < $i && $i < $olddlevel)} {
1344                set xj [xcoord $j $dlevel $lj]
1345                lappend mainline($id) $xi $y1 $xj $y2
1346            }
1347        }
1348    }
1349    return $dlevel
1350}
1351
1352# search for x in a list of lists
1353proc llsearch {llist x} {
1354    set i 0
1355    foreach l $llist {
1356        if {$l == $x || [lsearch -exact $l $x] >= 0} {
1357            return $i
1358        }
1359        incr i
1360    }
1361    return -1
1362}
1363
1364proc drawmore {reading} {
1365    global displayorder numcommits ncmupdate nextupdate
1366    global stopped nhyperspace parents commitlisted
1367    global maxwidth onscreen displist currentparents olddlevel
1368
1369    set n [llength $displayorder]
1370    while {$numcommits < $n} {
1371        set id [lindex $displayorder $numcommits]
1372        set ctxend [expr {$numcommits + 10}]
1373        if {!$reading && $ctxend > $n} {
1374            set ctxend $n
1375        }
1376        set dlist {}
1377        if {$numcommits > 0} {
1378            set dlist [lreplace $displist $olddlevel $olddlevel]
1379            set i $olddlevel
1380            foreach p $currentparents {
1381                if {$onscreen($p) == 0} {
1382                    set dlist [linsert $dlist $i $p]
1383                    incr i
1384                }
1385            }
1386        }
1387        set nohs {}
1388        set reins {}
1389        set isfat [expr {[llength $dlist] > $maxwidth}]
1390        if {$nhyperspace > 0 || $isfat} {
1391            if {$ctxend > $n} break
1392            # work out what to bring back and
1393            # what we want to don't want to send into hyperspace
1394            set room 1
1395            for {set k $numcommits} {$k < $ctxend} {incr k} {
1396                set x [lindex $displayorder $k]
1397                set i [llsearch $dlist $x]
1398                if {$i < 0} {
1399                    set i [llength $dlist]
1400                    lappend dlist $x
1401                }
1402                if {[lsearch -exact $nohs $x] < 0} {
1403                    lappend nohs $x
1404                }
1405                if {$reins eq {} && $onscreen($x) < 0 && $room} {
1406                    set reins [list $x $i]
1407                }
1408                set newp {}
1409                if {[info exists commitlisted($x)]} {
1410                    set right 0
1411                    foreach p $parents($x) {
1412                        if {[llsearch $dlist $p] < 0} {
1413                            lappend newp $p
1414                            if {[lsearch -exact $nohs $p] < 0} {
1415                                lappend nohs $p
1416                            }
1417                            if {$reins eq {} && $onscreen($p) < 0 && $room} {
1418                                set reins [list $p [expr {$i + $right}]]
1419                            }
1420                        }
1421                        set right 1
1422                    }
1423                }
1424                set l [lindex $dlist $i]
1425                if {[llength $l] == 1} {
1426                    set l $newp
1427                } else {
1428                    set j [lsearch -exact $l $x]
1429                    set l [concat [lreplace $l $j $j] $newp]
1430                }
1431                set dlist [lreplace $dlist $i $i $l]
1432                if {$room && $isfat && [llength $newp] <= 1} {
1433                    set room 0
1434                }
1435            }
1436        }
1437
1438        set dlevel [drawslants $id $reins $nohs]
1439        drawcommitline $dlevel
1440        if {[clock clicks -milliseconds] >= $nextupdate
1441            && $numcommits >= $ncmupdate} {
1442            doupdate $reading
1443            if {$stopped} break
1444        }
1445    }
1446}
1447
1448# level here is an index in todo
1449proc updatetodo {level noshortcut} {
1450    global ncleft todo nnewparents
1451    global commitlisted parents onscreen
1452
1453    set id [lindex $todo $level]
1454    set olds {}
1455    if {[info exists commitlisted($id)]} {
1456        foreach p $parents($id) {
1457            if {[lsearch -exact $olds $p] < 0} {
1458                lappend olds $p
1459            }
1460        }
1461    }
1462    if {!$noshortcut && [llength $olds] == 1} {
1463        set p [lindex $olds 0]
1464        if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1465            set ncleft($p) 0
1466            set todo [lreplace $todo $level $level $p]
1467            set onscreen($p) 0
1468            set nnewparents($id) 1
1469            return 0
1470        }
1471    }
1472
1473    set todo [lreplace $todo $level $level]
1474    set i $level
1475    set n 0
1476    foreach p $olds {
1477        incr ncleft($p) -1
1478        set k [lsearch -exact $todo $p]
1479        if {$k < 0} {
1480            set todo [linsert $todo $i $p]
1481            set onscreen($p) 0
1482            incr i
1483            incr n
1484        }
1485    }
1486    set nnewparents($id) $n
1487
1488    return 1
1489}
1490
1491proc decidenext {{noread 0}} {
1492    global ncleft todo
1493    global datemode cdate
1494    global commitinfo
1495
1496    # choose which one to do next time around
1497    set todol [llength $todo]
1498    set level -1
1499    set latest {}
1500    for {set k $todol} {[incr k -1] >= 0} {} {
1501        set p [lindex $todo $k]
1502        if {$ncleft($p) == 0} {
1503            if {$datemode} {
1504                if {![info exists commitinfo($p)]} {
1505                    if {$noread} {
1506                        return {}
1507                    }
1508                    readcommit $p
1509                }
1510                if {$latest == {} || $cdate($p) > $latest} {
1511                    set level $k
1512                    set latest $cdate($p)
1513                }
1514            } else {
1515                set level $k
1516                break
1517            }
1518        }
1519    }
1520
1521    return $level
1522}
1523
1524proc drawcommit {id reading} {
1525    global phase todo nchildren datemode nextupdate revlistorder ncleft
1526    global numcommits ncmupdate displayorder todo onscreen parents
1527    global commitlisted commitordered
1528
1529    if {$phase != "incrdraw"} {
1530        set phase incrdraw
1531        set displayorder {}
1532        set todo {}
1533        initgraph
1534        catch {unset commitordered}
1535    }
1536    set commitordered($id) 1
1537    if {$nchildren($id) == 0} {
1538        lappend todo $id
1539        set onscreen($id) 0
1540    }
1541    if {$revlistorder} {
1542        set level [lsearch -exact $todo $id]
1543        if {$level < 0} {
1544            error_popup "oops, $id isn't in todo"
1545            return
1546        }
1547        lappend displayorder $id
1548        updatetodo $level 0
1549    } else {
1550        set level [decidenext 1]
1551        if {$level == {} || $level < 0} return
1552        while 1 {
1553            set id [lindex $todo $level]
1554            if {![info exists commitordered($id)]} {
1555                break
1556            }
1557            lappend displayorder [lindex $todo $level]
1558            if {[updatetodo $level $datemode]} {
1559                set level [decidenext 1]
1560                if {$level == {} || $level < 0} break
1561            }
1562        }
1563    }
1564    drawmore $reading
1565}
1566
1567proc finishcommits {} {
1568    global phase oldcommits commits
1569    global canv mainfont ctext maincursor textcursor
1570    global parents displayorder todo
1571
1572    if {$phase == "incrdraw" || $phase == "removecommits"} {
1573        foreach id $oldcommits {
1574            lappend commits $id
1575            drawcommit $id 0
1576        }
1577        set oldcommits {}
1578        drawrest
1579    } elseif {$phase == "updatecommits"} {
1580        # there were no new commits, in fact
1581        set commits $oldcommits
1582        set oldcommits {}
1583        set phase {}
1584    } else {
1585        $canv delete all
1586        $canv create text 3 3 -anchor nw -text "No commits selected" \
1587            -font $mainfont -tags textitems
1588        set phase {}
1589    }
1590    . config -cursor $maincursor
1591    settextcursor $textcursor
1592}
1593
1594# Don't change the text pane cursor if it is currently the hand cursor,
1595# showing that we are over a sha1 ID link.
1596proc settextcursor {c} {
1597    global ctext curtextcursor
1598
1599    if {[$ctext cget -cursor] == $curtextcursor} {
1600        $ctext config -cursor $c
1601    }
1602    set curtextcursor $c
1603}
1604
1605proc drawgraph {} {
1606    global nextupdate startmsecs ncmupdate
1607    global displayorder onscreen
1608
1609    if {$displayorder == {}} return
1610    set startmsecs [clock clicks -milliseconds]
1611    set nextupdate [expr {$startmsecs + 100}]
1612    set ncmupdate 1
1613    initgraph
1614    foreach id $displayorder {
1615        set onscreen($id) 0
1616    }
1617    drawmore 0
1618}
1619
1620proc drawrest {} {
1621    global phase stopped redisplaying selectedline
1622    global datemode todo displayorder ncleft
1623    global numcommits ncmupdate
1624    global nextupdate startmsecs revlistorder
1625
1626    set level [decidenext]
1627    if {$level >= 0} {
1628        set phase drawgraph
1629        while 1 {
1630            lappend displayorder [lindex $todo $level]
1631            set hard [updatetodo $level $datemode]
1632            if {$hard} {
1633                set level [decidenext]
1634                if {$level < 0} break
1635            }
1636        }
1637    }
1638    if {$todo != {}} {
1639        puts "ERROR: none of the pending commits can be done yet:"
1640        foreach p $todo {
1641            puts "  $p ($ncleft($p))"
1642        }
1643    }
1644
1645    drawmore 0
1646    set phase {}
1647    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1648    #puts "overall $drawmsecs ms for $numcommits commits"
1649    if {$redisplaying} {
1650        if {$stopped == 0 && [info exists selectedline]} {
1651            selectline $selectedline 0
1652        }
1653        if {$stopped == 1} {
1654            set stopped 0
1655            after idle drawgraph
1656        } else {
1657            set redisplaying 0
1658        }
1659    }
1660}
1661
1662proc findmatches {f} {
1663    global findtype foundstring foundstrlen
1664    if {$findtype == "Regexp"} {
1665        set matches [regexp -indices -all -inline $foundstring $f]
1666    } else {
1667        if {$findtype == "IgnCase"} {
1668            set str [string tolower $f]
1669        } else {
1670            set str $f
1671        }
1672        set matches {}
1673        set i 0
1674        while {[set j [string first $foundstring $str $i]] >= 0} {
1675            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1676            set i [expr {$j + $foundstrlen}]
1677        }
1678    }
1679    return $matches
1680}
1681
1682proc dofind {} {
1683    global findtype findloc findstring markedmatches commitinfo
1684    global numcommits lineid linehtag linentag linedtag
1685    global mainfont namefont canv canv2 canv3 selectedline
1686    global matchinglines foundstring foundstrlen
1687
1688    stopfindproc
1689    unmarkmatches
1690    focus .
1691    set matchinglines {}
1692    if {$findloc == "Pickaxe"} {
1693        findpatches
1694        return
1695    }
1696    if {$findtype == "IgnCase"} {
1697        set foundstring [string tolower $findstring]
1698    } else {
1699        set foundstring $findstring
1700    }
1701    set foundstrlen [string length $findstring]
1702    if {$foundstrlen == 0} return
1703    if {$findloc == "Files"} {
1704        findfiles
1705        return
1706    }
1707    if {![info exists selectedline]} {
1708        set oldsel -1
1709    } else {
1710        set oldsel $selectedline
1711    }
1712    set didsel 0
1713    set fldtypes {Headline Author Date Committer CDate Comment}
1714    for {set l 0} {$l < $numcommits} {incr l} {
1715        set id $lineid($l)
1716        set info $commitinfo($id)
1717        set doesmatch 0
1718        foreach f $info ty $fldtypes {
1719            if {$findloc != "All fields" && $findloc != $ty} {
1720                continue
1721            }
1722            set matches [findmatches $f]
1723            if {$matches == {}} continue
1724            set doesmatch 1
1725            if {$ty == "Headline"} {
1726                markmatches $canv $l $f $linehtag($l) $matches $mainfont
1727            } elseif {$ty == "Author"} {
1728                markmatches $canv2 $l $f $linentag($l) $matches $namefont
1729            } elseif {$ty == "Date"} {
1730                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1731            }
1732        }
1733        if {$doesmatch} {
1734            lappend matchinglines $l
1735            if {!$didsel && $l > $oldsel} {
1736                findselectline $l
1737                set didsel 1
1738            }
1739        }
1740    }
1741    if {$matchinglines == {}} {
1742        bell
1743    } elseif {!$didsel} {
1744        findselectline [lindex $matchinglines 0]
1745    }
1746}
1747
1748proc findselectline {l} {
1749    global findloc commentend ctext
1750    selectline $l 1
1751    if {$findloc == "All fields" || $findloc == "Comments"} {
1752        # highlight the matches in the comments
1753        set f [$ctext get 1.0 $commentend]
1754        set matches [findmatches $f]
1755        foreach match $matches {
1756            set start [lindex $match 0]
1757            set end [expr {[lindex $match 1] + 1}]
1758            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1759        }
1760    }
1761}
1762
1763proc findnext {restart} {
1764    global matchinglines selectedline
1765    if {![info exists matchinglines]} {
1766        if {$restart} {
1767            dofind
1768        }
1769        return
1770    }
1771    if {![info exists selectedline]} return
1772    foreach l $matchinglines {
1773        if {$l > $selectedline} {
1774            findselectline $l
1775            return
1776        }
1777    }
1778    bell
1779}
1780
1781proc findprev {} {
1782    global matchinglines selectedline
1783    if {![info exists matchinglines]} {
1784        dofind
1785        return
1786    }
1787    if {![info exists selectedline]} return
1788    set prev {}
1789    foreach l $matchinglines {
1790        if {$l >= $selectedline} break
1791        set prev $l
1792    }
1793    if {$prev != {}} {
1794        findselectline $prev
1795    } else {
1796        bell
1797    }
1798}
1799
1800proc findlocchange {name ix op} {
1801    global findloc findtype findtypemenu
1802    if {$findloc == "Pickaxe"} {
1803        set findtype Exact
1804        set state disabled
1805    } else {
1806        set state normal
1807    }
1808    $findtypemenu entryconf 1 -state $state
1809    $findtypemenu entryconf 2 -state $state
1810}
1811
1812proc stopfindproc {{done 0}} {
1813    global findprocpid findprocfile findids
1814    global ctext findoldcursor phase maincursor textcursor
1815    global findinprogress
1816
1817    catch {unset findids}
1818    if {[info exists findprocpid]} {
1819        if {!$done} {
1820            catch {exec kill $findprocpid}
1821        }
1822        catch {close $findprocfile}
1823        unset findprocpid
1824    }
1825    if {[info exists findinprogress]} {
1826        unset findinprogress
1827        if {$phase != "incrdraw"} {
1828            . config -cursor $maincursor
1829            settextcursor $textcursor
1830        }
1831    }
1832}
1833
1834proc findpatches {} {
1835    global findstring selectedline numcommits
1836    global findprocpid findprocfile
1837    global finddidsel ctext lineid findinprogress
1838    global findinsertpos
1839
1840    if {$numcommits == 0} return
1841
1842    # make a list of all the ids to search, starting at the one
1843    # after the selected line (if any)
1844    if {[info exists selectedline]} {
1845        set l $selectedline
1846    } else {
1847        set l -1
1848    }
1849    set inputids {}
1850    for {set i 0} {$i < $numcommits} {incr i} {
1851        if {[incr l] >= $numcommits} {
1852            set l 0
1853        }
1854        append inputids $lineid($l) "\n"
1855    }
1856
1857    if {[catch {
1858        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1859                         << $inputids] r]
1860    } err]} {
1861        error_popup "Error starting search process: $err"
1862        return
1863    }
1864
1865    set findinsertpos end
1866    set findprocfile $f
1867    set findprocpid [pid $f]
1868    fconfigure $f -blocking 0
1869    fileevent $f readable readfindproc
1870    set finddidsel 0
1871    . config -cursor watch
1872    settextcursor watch
1873    set findinprogress 1
1874}
1875
1876proc readfindproc {} {
1877    global findprocfile finddidsel
1878    global idline matchinglines findinsertpos
1879
1880    set n [gets $findprocfile line]
1881    if {$n < 0} {
1882        if {[eof $findprocfile]} {
1883            stopfindproc 1
1884            if {!$finddidsel} {
1885                bell
1886            }
1887        }
1888        return
1889    }
1890    if {![regexp {^[0-9a-f]{40}} $line id]} {
1891        error_popup "Can't parse git-diff-tree output: $line"
1892        stopfindproc
1893        return
1894    }
1895    if {![info exists idline($id)]} {
1896        puts stderr "spurious id: $id"
1897        return
1898    }
1899    set l $idline($id)
1900    insertmatch $l $id
1901}
1902
1903proc insertmatch {l id} {
1904    global matchinglines findinsertpos finddidsel
1905
1906    if {$findinsertpos == "end"} {
1907        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1908            set matchinglines [linsert $matchinglines 0 $l]
1909            set findinsertpos 1
1910        } else {
1911            lappend matchinglines $l
1912        }
1913    } else {
1914        set matchinglines [linsert $matchinglines $findinsertpos $l]
1915        incr findinsertpos
1916    }
1917    markheadline $l $id
1918    if {!$finddidsel} {
1919        findselectline $l
1920        set finddidsel 1
1921    }
1922}
1923
1924proc findfiles {} {
1925    global selectedline numcommits lineid ctext
1926    global ffileline finddidsel parents nparents
1927    global findinprogress findstartline findinsertpos
1928    global treediffs fdiffids fdiffsneeded fdiffpos
1929    global findmergefiles
1930
1931    if {$numcommits == 0} return
1932
1933    if {[info exists selectedline]} {
1934        set l [expr {$selectedline + 1}]
1935    } else {
1936        set l 0
1937    }
1938    set ffileline $l
1939    set findstartline $l
1940    set diffsneeded {}
1941    set fdiffsneeded {}
1942    while 1 {
1943        set id $lineid($l)
1944        if {$findmergefiles || $nparents($id) == 1} {
1945            foreach p $parents($id) {
1946                if {![info exists treediffs([list $id $p])]} {
1947                    append diffsneeded "$id $p\n"
1948                    lappend fdiffsneeded [list $id $p]
1949                }
1950            }
1951        }
1952        if {[incr l] >= $numcommits} {
1953            set l 0
1954        }
1955        if {$l == $findstartline} break
1956    }
1957
1958    # start off a git-diff-tree process if needed
1959    if {$diffsneeded ne {}} {
1960        if {[catch {
1961            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1962        } err ]} {
1963            error_popup "Error starting search process: $err"
1964            return
1965        }
1966        catch {unset fdiffids}
1967        set fdiffpos 0
1968        fconfigure $df -blocking 0
1969        fileevent $df readable [list readfilediffs $df]
1970    }
1971
1972    set finddidsel 0
1973    set findinsertpos end
1974    set id $lineid($l)
1975    set p [lindex $parents($id) 0]
1976    . config -cursor watch
1977    settextcursor watch
1978    set findinprogress 1
1979    findcont [list $id $p]
1980    update
1981}
1982
1983proc readfilediffs {df} {
1984    global findids fdiffids fdiffs
1985
1986    set n [gets $df line]
1987    if {$n < 0} {
1988        if {[eof $df]} {
1989            donefilediff
1990            if {[catch {close $df} err]} {
1991                stopfindproc
1992                bell
1993                error_popup "Error in git-diff-tree: $err"
1994            } elseif {[info exists findids]} {
1995                set ids $findids
1996                stopfindproc
1997                bell
1998                error_popup "Couldn't find diffs for {$ids}"
1999            }
2000        }
2001        return
2002    }
2003    if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
2004        # start of a new string of diffs
2005        donefilediff
2006        set fdiffids [list $id $p]
2007        set fdiffs {}
2008    } elseif {[string match ":*" $line]} {
2009        lappend fdiffs [lindex $line 5]
2010    }
2011}
2012
2013proc donefilediff {} {
2014    global fdiffids fdiffs treediffs findids
2015    global fdiffsneeded fdiffpos
2016
2017    if {[info exists fdiffids]} {
2018        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
2019               && $fdiffpos < [llength $fdiffsneeded]} {
2020            # git-diff-tree doesn't output anything for a commit
2021            # which doesn't change anything
2022            set nullids [lindex $fdiffsneeded $fdiffpos]
2023            set treediffs($nullids) {}
2024            if {[info exists findids] && $nullids eq $findids} {
2025                unset findids
2026                findcont $nullids
2027            }
2028            incr fdiffpos
2029        }
2030        incr fdiffpos
2031
2032        if {![info exists treediffs($fdiffids)]} {
2033            set treediffs($fdiffids) $fdiffs
2034        }
2035        if {[info exists findids] && $fdiffids eq $findids} {
2036            unset findids
2037            findcont $fdiffids
2038        }
2039    }
2040}
2041
2042proc findcont {ids} {
2043    global findids treediffs parents nparents
2044    global ffileline findstartline finddidsel
2045    global lineid numcommits matchinglines findinprogress
2046    global findmergefiles
2047
2048    set id [lindex $ids 0]
2049    set p [lindex $ids 1]
2050    set pi [lsearch -exact $parents($id) $p]
2051    set l $ffileline
2052    while 1 {
2053        if {$findmergefiles || $nparents($id) == 1} {
2054            if {![info exists treediffs($ids)]} {
2055                set findids $ids
2056                set ffileline $l
2057                return
2058            }
2059            set doesmatch 0
2060            foreach f $treediffs($ids) {
2061                set x [findmatches $f]
2062                if {$x != {}} {
2063                    set doesmatch 1
2064                    break
2065                }
2066            }
2067            if {$doesmatch} {
2068                insertmatch $l $id
2069                set pi $nparents($id)
2070            }
2071        } else {
2072            set pi $nparents($id)
2073        }
2074        if {[incr pi] >= $nparents($id)} {
2075            set pi 0
2076            if {[incr l] >= $numcommits} {
2077                set l 0
2078            }
2079            if {$l == $findstartline} break
2080            set id $lineid($l)
2081        }
2082        set p [lindex $parents($id) $pi]
2083        set ids [list $id $p]
2084    }
2085    stopfindproc
2086    if {!$finddidsel} {
2087        bell
2088    }
2089}
2090
2091# mark a commit as matching by putting a yellow background
2092# behind the headline
2093proc markheadline {l id} {
2094    global canv mainfont linehtag commitinfo
2095
2096    set bbox [$canv bbox $linehtag($l)]
2097    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2098    $canv lower $t
2099}
2100
2101# mark the bits of a headline, author or date that match a find string
2102proc markmatches {canv l str tag matches font} {
2103    set bbox [$canv bbox $tag]
2104    set x0 [lindex $bbox 0]
2105    set y0 [lindex $bbox 1]
2106    set y1 [lindex $bbox 3]
2107    foreach match $matches {
2108        set start [lindex $match 0]
2109        set end [lindex $match 1]
2110        if {$start > $end} continue
2111        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2112        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2113        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2114                   [expr {$x0+$xlen+2}] $y1 \
2115                   -outline {} -tags matches -fill yellow]
2116        $canv lower $t
2117    }
2118}
2119
2120proc unmarkmatches {} {
2121    global matchinglines findids
2122    allcanvs delete matches
2123    catch {unset matchinglines}
2124    catch {unset findids}
2125}
2126
2127proc selcanvline {w x y} {
2128    global canv canvy0 ctext linespc
2129    global lineid linehtag linentag linedtag rowtextx
2130    set ymax [lindex [$canv cget -scrollregion] 3]
2131    if {$ymax == {}} return
2132    set yfrac [lindex [$canv yview] 0]
2133    set y [expr {$y + $yfrac * $ymax}]
2134    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2135    if {$l < 0} {
2136        set l 0
2137    }
2138    if {$w eq $canv} {
2139        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2140    }
2141    unmarkmatches
2142    selectline $l 1
2143}
2144
2145proc commit_descriptor {p} {
2146    global commitinfo
2147    set l "..."
2148    if {[info exists commitinfo($p)]} {
2149        set l [lindex $commitinfo($p) 0]
2150    }
2151    return "$p ($l)"
2152}
2153
2154# append some text to the ctext widget, and make any SHA1 ID
2155# that we know about be a clickable link.
2156proc appendwithlinks {text} {
2157    global ctext idline linknum
2158
2159    set start [$ctext index "end - 1c"]
2160    $ctext insert end $text
2161    $ctext insert end "\n"
2162    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2163    foreach l $links {
2164        set s [lindex $l 0]
2165        set e [lindex $l 1]
2166        set linkid [string range $text $s $e]
2167        if {![info exists idline($linkid)]} continue
2168        incr e
2169        $ctext tag add link "$start + $s c" "$start + $e c"
2170        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2171        $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2172        incr linknum
2173    }
2174    $ctext tag conf link -foreground blue -underline 1
2175    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2176    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2177}
2178
2179proc selectline {l isnew} {
2180    global canv canv2 canv3 ctext commitinfo selectedline
2181    global lineid linehtag linentag linedtag
2182    global canvy0 linespc parents nparents children
2183    global cflist currentid sha1entry
2184    global commentend idtags idline linknum
2185
2186    $canv delete hover
2187    normalline
2188    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2189    $canv delete secsel
2190    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2191               -tags secsel -fill [$canv cget -selectbackground]]
2192    $canv lower $t
2193    $canv2 delete secsel
2194    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2195               -tags secsel -fill [$canv2 cget -selectbackground]]
2196    $canv2 lower $t
2197    $canv3 delete secsel
2198    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2199               -tags secsel -fill [$canv3 cget -selectbackground]]
2200    $canv3 lower $t
2201    set y [expr {$canvy0 + $l * $linespc}]
2202    set ymax [lindex [$canv cget -scrollregion] 3]
2203    set ytop [expr {$y - $linespc - 1}]
2204    set ybot [expr {$y + $linespc + 1}]
2205    set wnow [$canv yview]
2206    set wtop [expr {[lindex $wnow 0] * $ymax}]
2207    set wbot [expr {[lindex $wnow 1] * $ymax}]
2208    set wh [expr {$wbot - $wtop}]
2209    set newtop $wtop
2210    if {$ytop < $wtop} {
2211        if {$ybot < $wtop} {
2212            set newtop [expr {$y - $wh / 2.0}]
2213        } else {
2214            set newtop $ytop
2215            if {$newtop > $wtop - $linespc} {
2216                set newtop [expr {$wtop - $linespc}]
2217            }
2218        }
2219    } elseif {$ybot > $wbot} {
2220        if {$ytop > $wbot} {
2221            set newtop [expr {$y - $wh / 2.0}]
2222        } else {
2223            set newtop [expr {$ybot - $wh}]
2224            if {$newtop < $wtop + $linespc} {
2225                set newtop [expr {$wtop + $linespc}]
2226            }
2227        }
2228    }
2229    if {$newtop != $wtop} {
2230        if {$newtop < 0} {
2231            set newtop 0
2232        }
2233        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2234    }
2235
2236    if {$isnew} {
2237        addtohistory [list selectline $l 0]
2238    }
2239
2240    set selectedline $l
2241
2242    set id $lineid($l)
2243    set currentid $id
2244    $sha1entry delete 0 end
2245    $sha1entry insert 0 $id
2246    $sha1entry selection from 0
2247    $sha1entry selection to end
2248
2249    $ctext conf -state normal
2250    $ctext delete 0.0 end
2251    set linknum 0
2252    $ctext mark set fmark.0 0.0
2253    $ctext mark gravity fmark.0 left
2254    set info $commitinfo($id)
2255    set date [formatdate [lindex $info 2]]
2256    $ctext insert end "Author: [lindex $info 1]  $date\n"
2257    set date [formatdate [lindex $info 4]]
2258    $ctext insert end "Committer: [lindex $info 3]  $date\n"
2259    if {[info exists idtags($id)]} {
2260        $ctext insert end "Tags:"
2261        foreach tag $idtags($id) {
2262            $ctext insert end " $tag"
2263        }
2264        $ctext insert end "\n"
2265    }
2266 
2267    set comment {}
2268    if {[info exists parents($id)]} {
2269        foreach p $parents($id) {
2270            append comment "Parent: [commit_descriptor $p]\n"
2271        }
2272    }
2273    if {[info exists children($id)]} {
2274        foreach c $children($id) {
2275            append comment "Child:  [commit_descriptor $c]\n"
2276        }
2277    }
2278    append comment "\n"
2279    append comment [lindex $info 5]
2280
2281    # make anything that looks like a SHA1 ID be a clickable link
2282    appendwithlinks $comment
2283
2284    $ctext tag delete Comments
2285    $ctext tag remove found 1.0 end
2286    $ctext conf -state disabled
2287    set commentend [$ctext index "end - 1c"]
2288
2289    $cflist delete 0 end
2290    $cflist insert end "Comments"
2291    if {$nparents($id) == 1} {
2292        startdiff $id
2293    } elseif {$nparents($id) > 1} {
2294        mergediff $id
2295    }
2296}
2297
2298proc selnextline {dir} {
2299    global selectedline
2300    if {![info exists selectedline]} return
2301    set l [expr {$selectedline + $dir}]
2302    unmarkmatches
2303    selectline $l 1
2304}
2305
2306proc unselectline {} {
2307    global selectedline
2308
2309    catch {unset selectedline}
2310    allcanvs delete secsel
2311}
2312
2313proc addtohistory {cmd} {
2314    global history historyindex
2315
2316    if {$historyindex > 0
2317        && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2318        return
2319    }
2320
2321    if {$historyindex < [llength $history]} {
2322        set history [lreplace $history $historyindex end $cmd]
2323    } else {
2324        lappend history $cmd
2325    }
2326    incr historyindex
2327    if {$historyindex > 1} {
2328        .ctop.top.bar.leftbut conf -state normal
2329    } else {
2330        .ctop.top.bar.leftbut conf -state disabled
2331    }
2332    .ctop.top.bar.rightbut conf -state disabled
2333}
2334
2335proc goback {} {
2336    global history historyindex
2337
2338    if {$historyindex > 1} {
2339        incr historyindex -1
2340        set cmd [lindex $history [expr {$historyindex - 1}]]
2341        eval $cmd
2342        .ctop.top.bar.rightbut conf -state normal
2343    }
2344    if {$historyindex <= 1} {
2345        .ctop.top.bar.leftbut conf -state disabled
2346    }
2347}
2348
2349proc goforw {} {
2350    global history historyindex
2351
2352    if {$historyindex < [llength $history]} {
2353        set cmd [lindex $history $historyindex]
2354        incr historyindex
2355        eval $cmd
2356        .ctop.top.bar.leftbut conf -state normal
2357    }
2358    if {$historyindex >= [llength $history]} {
2359        .ctop.top.bar.rightbut conf -state disabled
2360    }
2361}
2362
2363proc mergediff {id} {
2364    global parents diffmergeid diffmergegca mergefilelist diffpindex
2365
2366    set diffmergeid $id
2367    set diffpindex -1
2368    set diffmergegca [findgca $parents($id)]
2369    if {[info exists mergefilelist($id)]} {
2370        if {$mergefilelist($id) ne {}} {
2371            showmergediff
2372        }
2373    } else {
2374        contmergediff {}
2375    }
2376}
2377
2378proc findgca {ids} {
2379    set gca {}
2380    foreach id $ids {
2381        if {$gca eq {}} {
2382            set gca $id
2383        } else {
2384            if {[catch {
2385                set gca [exec git-merge-base $gca $id]
2386            } err]} {
2387                return {}
2388            }
2389        }
2390    }
2391    return $gca
2392}
2393
2394proc contmergediff {ids} {
2395    global diffmergeid diffpindex parents nparents diffmergegca
2396    global treediffs mergefilelist diffids treepending
2397
2398    # diff the child against each of the parents, and diff
2399    # each of the parents against the GCA.
2400    while 1 {
2401        if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} {
2402            set ids [list $diffmergegca [lindex $ids 0]]
2403        } else {
2404            if {[incr diffpindex] >= $nparents($diffmergeid)} break
2405            set p [lindex $parents($diffmergeid) $diffpindex]
2406            set ids [list $p $diffmergeid]
2407        }
2408        if {![info exists treediffs($ids)]} {
2409            set diffids $ids
2410            if {![info exists treepending]} {
2411                gettreediffs $ids
2412            }
2413            return
2414        }
2415    }
2416
2417    # If a file in some parent is different from the child and also
2418    # different from the GCA, then it's interesting.
2419    # If we don't have a GCA, then a file is interesting if it is
2420    # different from the child in all the parents.
2421    if {$diffmergegca ne {}} {
2422        set files {}
2423        foreach p $parents($diffmergeid) {
2424            set gcadiffs $treediffs([list $diffmergegca $p])
2425            foreach f $treediffs([list $p $diffmergeid]) {
2426                if {[lsearch -exact $files $f] < 0
2427                    && [lsearch -exact $gcadiffs $f] >= 0} {
2428                    lappend files $f
2429                }
2430            }
2431        }
2432        set files [lsort $files]
2433    } else {
2434        set p [lindex $parents($diffmergeid) 0]
2435        set files $treediffs([list $diffmergeid $p])
2436        for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2437            set p [lindex $parents($diffmergeid) $i]
2438            set df $treediffs([list $p $diffmergeid])
2439            set nf {}
2440            foreach f $files {
2441                if {[lsearch -exact $df $f] >= 0} {
2442                    lappend nf $f
2443                }
2444            }
2445            set files $nf
2446        }
2447    }
2448
2449    set mergefilelist($diffmergeid) $files
2450    if {$files ne {}} {
2451        showmergediff
2452    }
2453}
2454
2455proc showmergediff {} {
2456    global cflist diffmergeid mergefilelist parents
2457    global diffopts diffinhunk currentfile currenthunk filelines
2458    global diffblocked groupfilelast mergefds groupfilenum grouphunks
2459
2460    set files $mergefilelist($diffmergeid)
2461    foreach f $files {
2462        $cflist insert end $f
2463    }
2464    set env(GIT_DIFF_OPTS) $diffopts
2465    set flist {}
2466    catch {unset currentfile}
2467    catch {unset currenthunk}
2468    catch {unset filelines}
2469    catch {unset groupfilenum}
2470    catch {unset grouphunks}
2471    set groupfilelast -1
2472    foreach p $parents($diffmergeid) {
2473        set cmd [list | git-diff-tree -p $p $diffmergeid]
2474        set cmd [concat $cmd $mergefilelist($diffmergeid)]
2475        if {[catch {set f [open $cmd r]} err]} {
2476            error_popup "Error getting diffs: $err"
2477            foreach f $flist {
2478                catch {close $f}
2479            }
2480            return
2481        }
2482        lappend flist $f
2483        set ids [list $diffmergeid $p]
2484        set mergefds($ids) $f
2485        set diffinhunk($ids) 0
2486        set diffblocked($ids) 0
2487        fconfigure $f -blocking 0
2488        fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2489    }
2490}
2491
2492proc getmergediffline {f ids id} {
2493    global diffmergeid diffinhunk diffoldlines diffnewlines
2494    global currentfile currenthunk
2495    global diffoldstart diffnewstart diffoldlno diffnewlno
2496    global diffblocked mergefilelist
2497    global noldlines nnewlines difflcounts filelines
2498
2499    set n [gets $f line]
2500    if {$n < 0} {
2501        if {![eof $f]} return
2502    }
2503
2504    if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2505        if {$n < 0} {
2506            close $f
2507        }
2508        return
2509    }
2510
2511    if {$diffinhunk($ids) != 0} {
2512        set fi $currentfile($ids)
2513        if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2514            # continuing an existing hunk
2515            set line [string range $line 1 end]
2516            set p [lindex $ids 1]
2517            if {$match eq "-" || $match eq " "} {
2518                set filelines($p,$fi,$diffoldlno($ids)) $line
2519                incr diffoldlno($ids)
2520            }
2521            if {$match eq "+" || $match eq " "} {
2522                set filelines($id,$fi,$diffnewlno($ids)) $line
2523                incr diffnewlno($ids)
2524            }
2525            if {$match eq " "} {
2526                if {$diffinhunk($ids) == 2} {
2527                    lappend difflcounts($ids) \
2528                        [list $noldlines($ids) $nnewlines($ids)]
2529                    set noldlines($ids) 0
2530                    set diffinhunk($ids) 1
2531                }
2532                incr noldlines($ids)
2533            } elseif {$match eq "-" || $match eq "+"} {
2534                if {$diffinhunk($ids) == 1} {
2535                    lappend difflcounts($ids) [list $noldlines($ids)]
2536                    set noldlines($ids) 0
2537                    set nnewlines($ids) 0
2538                    set diffinhunk($ids) 2
2539                }
2540                if {$match eq "-"} {
2541                    incr noldlines($ids)
2542                } else {
2543                    incr nnewlines($ids)
2544                }
2545            }
2546            # and if it's \ No newline at end of line, then what?
2547            return
2548        }
2549        # end of a hunk
2550        if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2551            lappend difflcounts($ids) [list $noldlines($ids)]
2552        } elseif {$diffinhunk($ids) == 2
2553                  && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2554            lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2555        }
2556        set currenthunk($ids) [list $currentfile($ids) \
2557                                   $diffoldstart($ids) $diffnewstart($ids) \
2558                                   $diffoldlno($ids) $diffnewlno($ids) \
2559                                   $difflcounts($ids)]
2560        set diffinhunk($ids) 0
2561        # -1 = need to block, 0 = unblocked, 1 = is blocked
2562        set diffblocked($ids) -1
2563        processhunks
2564        if {$diffblocked($ids) == -1} {
2565            fileevent $f readable {}
2566            set diffblocked($ids) 1
2567        }
2568    }
2569
2570    if {$n < 0} {
2571        # eof
2572        if {!$diffblocked($ids)} {
2573            close $f
2574            set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2575            set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2576            processhunks
2577        }
2578    } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2579        # start of a new file
2580        set currentfile($ids) \
2581            [lsearch -exact $mergefilelist($diffmergeid) $fname]
2582    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2583                   $line match f1l f1c f2l f2c rest]} {
2584        if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2585            # start of a new hunk
2586            if {$f1l == 0 && $f1c == 0} {
2587                set f1l 1
2588            }
2589            if {$f2l == 0 && $f2c == 0} {
2590                set f2l 1
2591            }
2592            set diffinhunk($ids) 1
2593            set diffoldstart($ids) $f1l
2594            set diffnewstart($ids) $f2l
2595            set diffoldlno($ids) $f1l
2596            set diffnewlno($ids) $f2l
2597            set difflcounts($ids) {}
2598            set noldlines($ids) 0
2599            set nnewlines($ids) 0
2600        }
2601    }
2602}
2603
2604proc processhunks {} {
2605    global diffmergeid parents nparents currenthunk
2606    global mergefilelist diffblocked mergefds
2607    global grouphunks grouplinestart grouplineend groupfilenum
2608
2609    set nfiles [llength $mergefilelist($diffmergeid)]
2610    while 1 {
2611        set fi $nfiles
2612        set lno 0
2613        # look for the earliest hunk
2614        foreach p $parents($diffmergeid) {
2615            set ids [list $diffmergeid $p]
2616            if {![info exists currenthunk($ids)]} return
2617            set i [lindex $currenthunk($ids) 0]
2618            set l [lindex $currenthunk($ids) 2]
2619            if {$i < $fi || ($i == $fi && $l < $lno)} {
2620                set fi $i
2621                set lno $l
2622                set pi $p
2623            }
2624        }
2625
2626        if {$fi < $nfiles} {
2627            set ids [list $diffmergeid $pi]
2628            set hunk $currenthunk($ids)
2629            unset currenthunk($ids)
2630            if {$diffblocked($ids) > 0} {
2631                fileevent $mergefds($ids) readable \
2632                    [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2633            }
2634            set diffblocked($ids) 0
2635
2636            if {[info exists groupfilenum] && $groupfilenum == $fi
2637                && $lno <= $grouplineend} {
2638                # add this hunk to the pending group
2639                lappend grouphunks($pi) $hunk
2640                set endln [lindex $hunk 4]
2641                if {$endln > $grouplineend} {
2642                    set grouplineend $endln
2643                }
2644                continue
2645            }
2646        }
2647
2648        # succeeding stuff doesn't belong in this group, so
2649        # process the group now
2650        if {[info exists groupfilenum]} {
2651            processgroup
2652            unset groupfilenum
2653            unset grouphunks
2654        }
2655
2656        if {$fi >= $nfiles} break
2657
2658        # start a new group
2659        set groupfilenum $fi
2660        set grouphunks($pi) [list $hunk]
2661        set grouplinestart $lno
2662        set grouplineend [lindex $hunk 4]
2663    }
2664}
2665
2666proc processgroup {} {
2667    global groupfilelast groupfilenum difffilestart
2668    global mergefilelist diffmergeid ctext filelines
2669    global parents diffmergeid diffoffset
2670    global grouphunks grouplinestart grouplineend nparents
2671    global mergemax
2672
2673    $ctext conf -state normal
2674    set id $diffmergeid
2675    set f $groupfilenum
2676    if {$groupfilelast != $f} {
2677        $ctext insert end "\n"
2678        set here [$ctext index "end - 1c"]
2679        set difffilestart($f) $here
2680        set mark fmark.[expr {$f + 1}]
2681        $ctext mark set $mark $here
2682        $ctext mark gravity $mark left
2683        set header [lindex $mergefilelist($id) $f]
2684        set l [expr {(78 - [string length $header]) / 2}]
2685        set pad [string range "----------------------------------------" 1 $l]
2686        $ctext insert end "$pad $header $pad\n" filesep
2687        set groupfilelast $f
2688        foreach p $parents($id) {
2689            set diffoffset($p) 0
2690        }
2691    }
2692
2693    $ctext insert end "@@" msep
2694    set nlines [expr {$grouplineend - $grouplinestart}]
2695    set events {}
2696    set pnum 0
2697    foreach p $parents($id) {
2698        set startline [expr {$grouplinestart + $diffoffset($p)}]
2699        set ol $startline
2700        set nl $grouplinestart
2701        if {[info exists grouphunks($p)]} {
2702            foreach h $grouphunks($p) {
2703                set l [lindex $h 2]
2704                if {$nl < $l} {
2705                    for {} {$nl < $l} {incr nl} {
2706                        set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2707                        incr ol
2708                    }
2709                }
2710                foreach chunk [lindex $h 5] {
2711                    if {[llength $chunk] == 2} {
2712                        set olc [lindex $chunk 0]
2713                        set nlc [lindex $chunk 1]
2714                        set nnl [expr {$nl + $nlc}]
2715                        lappend events [list $nl $nnl $pnum $olc $nlc]
2716                        incr ol $olc
2717                        set nl $nnl
2718                    } else {
2719                        incr ol [lindex $chunk 0]
2720                        incr nl [lindex $chunk 0]
2721                    }
2722                }
2723            }
2724        }
2725        if {$nl < $grouplineend} {
2726            for {} {$nl < $grouplineend} {incr nl} {
2727                set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2728                incr ol
2729            }
2730        }
2731        set nlines [expr {$ol - $startline}]
2732        $ctext insert end " -$startline,$nlines" msep
2733        incr pnum
2734    }
2735
2736    set nlines [expr {$grouplineend - $grouplinestart}]
2737    $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2738
2739    set events [lsort -integer -index 0 $events]
2740    set nevents [llength $events]
2741    set nmerge $nparents($diffmergeid)
2742    set l $grouplinestart
2743    for {set i 0} {$i < $nevents} {set i $j} {
2744        set nl [lindex $events $i 0]
2745        while {$l < $nl} {
2746            $ctext insert end " $filelines($id,$f,$l)\n"
2747            incr l
2748        }
2749        set e [lindex $events $i]
2750        set enl [lindex $e 1]
2751        set j $i
2752        set active {}
2753        while 1 {
2754            set pnum [lindex $e 2]
2755            set olc [lindex $e 3]
2756            set nlc [lindex $e 4]
2757            if {![info exists delta($pnum)]} {
2758                set delta($pnum) [expr {$olc - $nlc}]
2759                lappend active $pnum
2760            } else {
2761                incr delta($pnum) [expr {$olc - $nlc}]
2762            }
2763            if {[incr j] >= $nevents} break
2764            set e [lindex $events $j]
2765            if {[lindex $e 0] >= $enl} break
2766            if {[lindex $e 1] > $enl} {
2767                set enl [lindex $e 1]
2768            }
2769        }
2770        set nlc [expr {$enl - $l}]
2771        set ncol mresult
2772        set bestpn -1
2773        if {[llength $active] == $nmerge - 1} {
2774            # no diff for one of the parents, i.e. it's identical
2775            for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2776                if {![info exists delta($pnum)]} {
2777                    if {$pnum < $mergemax} {
2778                        lappend ncol m$pnum
2779                    } else {
2780                        lappend ncol mmax
2781                    }
2782                    break
2783                }
2784            }
2785        } elseif {[llength $active] == $nmerge} {
2786            # all parents are different, see if one is very similar
2787            set bestsim 30
2788            for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2789                set sim [similarity $pnum $l $nlc $f \
2790                             [lrange $events $i [expr {$j-1}]]]
2791                if {$sim > $bestsim} {
2792                    set bestsim $sim
2793                    set bestpn $pnum
2794                }
2795            }
2796            if {$bestpn >= 0} {
2797                lappend ncol m$bestpn
2798            }
2799        }
2800        set pnum -1
2801        foreach p $parents($id) {
2802            incr pnum
2803            if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2804            set olc [expr {$nlc + $delta($pnum)}]
2805            set ol [expr {$l + $diffoffset($p)}]
2806            incr diffoffset($p) $delta($pnum)
2807            unset delta($pnum)
2808            for {} {$olc > 0} {incr olc -1} {
2809                $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2810                incr ol
2811            }
2812        }
2813        set endl [expr {$l + $nlc}]
2814        if {$bestpn >= 0} {
2815            # show this pretty much as a normal diff
2816            set p [lindex $parents($id) $bestpn]
2817            set ol [expr {$l + $diffoffset($p)}]
2818            incr diffoffset($p) $delta($bestpn)
2819            unset delta($bestpn)
2820            for {set k $i} {$k < $j} {incr k} {
2821                set e [lindex $events $k]
2822                if {[lindex $e 2] != $bestpn} continue
2823                set nl [lindex $e 0]
2824                set ol [expr {$ol + $nl - $l}]
2825                for {} {$l < $nl} {incr l} {
2826                    $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2827                }
2828                set c [lindex $e 3]
2829                for {} {$c > 0} {incr c -1} {
2830                    $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2831                    incr ol
2832                }
2833                set nl [lindex $e 1]
2834                for {} {$l < $nl} {incr l} {
2835                    $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2836                }
2837            }
2838        }
2839        for {} {$l < $endl} {incr l} {
2840            $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2841        }
2842    }
2843    while {$l < $grouplineend} {
2844        $ctext insert end " $filelines($id,$f,$l)\n"
2845        incr l
2846    }
2847    $ctext conf -state disabled
2848}
2849
2850proc similarity {pnum l nlc f events} {
2851    global diffmergeid parents diffoffset filelines
2852
2853    set id $diffmergeid
2854    set p [lindex $parents($id) $pnum]
2855    set ol [expr {$l + $diffoffset($p)}]
2856    set endl [expr {$l + $nlc}]
2857    set same 0
2858    set diff 0
2859    foreach e $events {
2860        if {[lindex $e 2] != $pnum} continue
2861        set nl [lindex $e 0]
2862        set ol [expr {$ol + $nl - $l}]
2863        for {} {$l < $nl} {incr l} {
2864            incr same [string length $filelines($id,$f,$l)]
2865            incr same
2866        }
2867        set oc [lindex $e 3]
2868        for {} {$oc > 0} {incr oc -1} {
2869            incr diff [string length $filelines($p,$f,$ol)]
2870            incr diff
2871            incr ol
2872        }
2873        set nl [lindex $e 1]
2874        for {} {$l < $nl} {incr l} {
2875            incr diff [string length $filelines($id,$f,$l)]
2876            incr diff
2877        }
2878    }
2879    for {} {$l < $endl} {incr l} {
2880        incr same [string length $filelines($id,$f,$l)]
2881        incr same
2882    }
2883    if {$same == 0} {
2884        return 0
2885    }
2886    return [expr {200 * $same / (2 * $same + $diff)}]
2887}
2888
2889proc startdiff {ids} {
2890    global treediffs diffids treepending diffmergeid
2891
2892    set diffids $ids
2893    catch {unset diffmergeid}
2894    if {![info exists treediffs($ids)]} {
2895        if {![info exists treepending]} {
2896            gettreediffs $ids
2897        }
2898    } else {
2899        addtocflist $ids
2900    }
2901}
2902
2903proc addtocflist {ids} {
2904    global treediffs cflist
2905    foreach f $treediffs($ids) {
2906        $cflist insert end $f
2907    }
2908    getblobdiffs $ids
2909}
2910
2911proc gettreediffs {ids} {
2912    global treediff parents treepending
2913    set treepending $ids
2914    set treediff {}
2915    if {[catch \
2916         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2917        ]} return
2918    fconfigure $gdtf -blocking 0
2919    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2920}
2921
2922proc gettreediffline {gdtf ids} {
2923    global treediff treediffs treepending diffids diffmergeid
2924
2925    set n [gets $gdtf line]
2926    if {$n < 0} {
2927        if {![eof $gdtf]} return
2928        close $gdtf
2929        set treediffs($ids) $treediff
2930        unset treepending
2931        if {$ids != $diffids} {
2932            gettreediffs $diffids
2933        } else {
2934            if {[info exists diffmergeid]} {
2935                contmergediff $ids
2936            } else {
2937                addtocflist $ids
2938            }
2939        }
2940        return
2941    }
2942    set file [lindex $line 5]
2943    lappend treediff $file
2944}
2945
2946proc getblobdiffs {ids} {
2947    global diffopts blobdifffd diffids env curdifftag curtagstart
2948    global difffilestart nextupdate diffinhdr treediffs
2949
2950    set env(GIT_DIFF_OPTS) $diffopts
2951    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2952    if {[catch {set bdf [open $cmd r]} err]} {
2953        puts "error getting diffs: $err"
2954        return
2955    }
2956    set diffinhdr 0
2957    fconfigure $bdf -blocking 0
2958    set blobdifffd($ids) $bdf
2959    set curdifftag Comments
2960    set curtagstart 0.0
2961    catch {unset difffilestart}
2962    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2963    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2964}
2965
2966proc getblobdiffline {bdf ids} {
2967    global diffids blobdifffd ctext curdifftag curtagstart
2968    global diffnexthead diffnextnote difffilestart
2969    global nextupdate diffinhdr treediffs
2970
2971    set n [gets $bdf line]
2972    if {$n < 0} {
2973        if {[eof $bdf]} {
2974            close $bdf
2975            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2976                $ctext tag add $curdifftag $curtagstart end
2977            }
2978        }
2979        return
2980    }
2981    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2982        return
2983    }
2984    $ctext conf -state normal
2985    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2986        # start of a new file
2987        $ctext insert end "\n"
2988        $ctext tag add $curdifftag $curtagstart end
2989        set curtagstart [$ctext index "end - 1c"]
2990        set header $newname
2991        set here [$ctext index "end - 1c"]
2992        set i [lsearch -exact $treediffs($diffids) $fname]
2993        if {$i >= 0} {
2994            set difffilestart($i) $here
2995            incr i
2996            $ctext mark set fmark.$i $here
2997            $ctext mark gravity fmark.$i left
2998        }
2999        if {$newname != $fname} {
3000            set i [lsearch -exact $treediffs($diffids) $newname]
3001            if {$i >= 0} {
3002                set difffilestart($i) $here
3003                incr i
3004                $ctext mark set fmark.$i $here
3005                $ctext mark gravity fmark.$i left
3006            }
3007        }
3008        set curdifftag "f:$fname"
3009        $ctext tag delete $curdifftag
3010        set l [expr {(78 - [string length $header]) / 2}]
3011        set pad [string range "----------------------------------------" 1 $l]
3012        $ctext insert end "$pad $header $pad\n" filesep
3013        set diffinhdr 1
3014    } elseif {[regexp {^(---|\+\+\+)} $line]} {
3015        set diffinhdr 0
3016    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3017                   $line match f1l f1c f2l f2c rest]} {
3018        $ctext insert end "$line\n" hunksep
3019        set diffinhdr 0
3020    } else {
3021        set x [string range $line 0 0]
3022        if {$x == "-" || $x == "+"} {
3023            set tag [expr {$x == "+"}]
3024            $ctext insert end "$line\n" d$tag
3025        } elseif {$x == " "} {
3026            $ctext insert end "$line\n"
3027        } elseif {$diffinhdr || $x == "\\"} {
3028            # e.g. "\ No newline at end of file"
3029            $ctext insert end "$line\n" filesep
3030        } else {
3031            # Something else we don't recognize
3032            if {$curdifftag != "Comments"} {
3033                $ctext insert end "\n"
3034                $ctext tag add $curdifftag $curtagstart end
3035                set curtagstart [$ctext index "end - 1c"]
3036                set curdifftag Comments
3037            }
3038            $ctext insert end "$line\n" filesep
3039        }
3040    }
3041    $ctext conf -state disabled
3042    if {[clock clicks -milliseconds] >= $nextupdate} {
3043        incr nextupdate 100
3044        fileevent $bdf readable {}
3045        update
3046        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3047    }
3048}
3049
3050proc nextfile {} {
3051    global difffilestart ctext
3052    set here [$ctext index @0,0]
3053    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3054        if {[$ctext compare $difffilestart($i) > $here]} {
3055            if {![info exists pos]
3056                || [$ctext compare $difffilestart($i) < $pos]} {
3057                set pos $difffilestart($i)
3058            }
3059        }
3060    }
3061    if {[info exists pos]} {
3062        $ctext yview $pos
3063    }
3064}
3065
3066proc listboxsel {} {
3067    global ctext cflist currentid
3068    if {![info exists currentid]} return
3069    set sel [lsort [$cflist curselection]]
3070    if {$sel eq {}} return
3071    set first [lindex $sel 0]
3072    catch {$ctext yview fmark.$first}
3073}
3074
3075proc setcoords {} {
3076    global linespc charspc canvx0 canvy0 mainfont
3077    global xspc1 xspc2 lthickness
3078
3079    set linespc [font metrics $mainfont -linespace]
3080    set charspc [font measure $mainfont "m"]
3081    set canvy0 [expr {3 + 0.5 * $linespc}]
3082    set canvx0 [expr {3 + 0.5 * $linespc}]
3083    set lthickness [expr {int($linespc / 9) + 1}]
3084    set xspc1(0) $linespc
3085    set xspc2 $linespc
3086}
3087
3088proc redisplay {} {
3089    global stopped redisplaying phase
3090    if {$stopped > 1} return
3091    if {$phase == "getcommits"} return
3092    set redisplaying 1
3093    if {$phase == "drawgraph" || $phase == "incrdraw"} {
3094        set stopped 1
3095    } else {
3096        drawgraph
3097    }
3098}
3099
3100proc incrfont {inc} {
3101    global mainfont namefont textfont ctext canv phase
3102    global stopped entries
3103    unmarkmatches
3104    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3105    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3106    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3107    setcoords
3108    $ctext conf -font $textfont
3109    $ctext tag conf filesep -font [concat $textfont bold]
3110    foreach e $entries {
3111        $e conf -font $mainfont
3112    }
3113    if {$phase == "getcommits"} {
3114        $canv itemconf textitems -font $mainfont
3115    }
3116    redisplay
3117}
3118
3119proc clearsha1 {} {
3120    global sha1entry sha1string
3121    if {[string length $sha1string] == 40} {
3122        $sha1entry delete 0 end
3123    }
3124}
3125
3126proc sha1change {n1 n2 op} {
3127    global sha1string currentid sha1but
3128    if {$sha1string == {}
3129        || ([info exists currentid] && $sha1string == $currentid)} {
3130        set state disabled
3131    } else {
3132        set state normal
3133    }
3134    if {[$sha1but cget -state] == $state} return
3135    if {$state == "normal"} {
3136        $sha1but conf -state normal -relief raised -text "Goto: "
3137    } else {
3138        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3139    }
3140}
3141
3142proc gotocommit {} {
3143    global sha1string currentid idline tagids
3144    global lineid numcommits
3145
3146    if {$sha1string == {}
3147        || ([info exists currentid] && $sha1string == $currentid)} return
3148    if {[info exists tagids($sha1string)]} {
3149        set id $tagids($sha1string)
3150    } else {
3151        set id [string tolower $sha1string]
3152        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3153            set matches {}
3154            for {set l 0} {$l < $numcommits} {incr l} {
3155                if {[string match $id* $lineid($l)]} {
3156                    lappend matches $lineid($l)
3157                }
3158            }
3159            if {$matches ne {}} {
3160                if {[llength $matches] > 1} {
3161                    error_popup "Short SHA1 id $id is ambiguous"
3162                    return
3163                }
3164                set id [lindex $matches 0]
3165            }
3166        }
3167    }
3168    if {[info exists idline($id)]} {
3169        selectline $idline($id) 1
3170        return
3171    }
3172    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3173        set type "SHA1 id"
3174    } else {
3175        set type "Tag"
3176    }
3177    error_popup "$type $sha1string is not known"
3178}
3179
3180proc lineenter {x y id} {
3181    global hoverx hovery hoverid hovertimer
3182    global commitinfo canv
3183
3184    if {![info exists commitinfo($id)]} return
3185    set hoverx $x
3186    set hovery $y
3187    set hoverid $id
3188    if {[info exists hovertimer]} {
3189        after cancel $hovertimer
3190    }
3191    set hovertimer [after 500 linehover]
3192    $canv delete hover
3193}
3194
3195proc linemotion {x y id} {
3196    global hoverx hovery hoverid hovertimer
3197
3198    if {[info exists hoverid] && $id == $hoverid} {
3199        set hoverx $x
3200        set hovery $y
3201        if {[info exists hovertimer]} {
3202            after cancel $hovertimer
3203        }
3204        set hovertimer [after 500 linehover]
3205    }
3206}
3207
3208proc lineleave {id} {
3209    global hoverid hovertimer canv
3210
3211    if {[info exists hoverid] && $id == $hoverid} {
3212        $canv delete hover
3213        if {[info exists hovertimer]} {
3214            after cancel $hovertimer
3215            unset hovertimer
3216        }
3217        unset hoverid
3218    }
3219}
3220
3221proc linehover {} {
3222    global hoverx hovery hoverid hovertimer
3223    global canv linespc lthickness
3224    global commitinfo mainfont
3225
3226    set text [lindex $commitinfo($hoverid) 0]
3227    set ymax [lindex [$canv cget -scrollregion] 3]
3228    if {$ymax == {}} return
3229    set yfrac [lindex [$canv yview] 0]
3230    set x [expr {$hoverx + 2 * $linespc}]
3231    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3232    set x0 [expr {$x - 2 * $lthickness}]
3233    set y0 [expr {$y - 2 * $lthickness}]
3234    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3235    set y1 [expr {$y + $linespc + 2 * $lthickness}]
3236    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3237               -fill \#ffff80 -outline black -width 1 -tags hover]
3238    $canv raise $t
3239    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3240    $canv raise $t
3241}
3242
3243proc clickisonarrow {id y} {
3244    global mainline mainlinearrow sidelines lthickness
3245
3246    set thresh [expr {2 * $lthickness + 6}]
3247    if {[info exists mainline($id)]} {
3248        if {$mainlinearrow($id) ne "none"} {
3249            if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3250                return "up"
3251            }
3252        }
3253    }
3254    if {[info exists sidelines($id)]} {
3255        foreach ls $sidelines($id) {
3256            set coords [lindex $ls 0]
3257            set arrow [lindex $ls 2]
3258            if {$arrow eq "first" || $arrow eq "both"} {
3259                if {abs([lindex $coords 1] - $y) < $thresh} {
3260                    return "up"
3261                }
3262            }
3263            if {$arrow eq "last" || $arrow eq "both"} {
3264                if {abs([lindex $coords end] - $y) < $thresh} {
3265                    return "down"
3266                }
3267            }
3268        }
3269    }
3270    return {}
3271}
3272
3273proc arrowjump {id dirn y} {
3274    global mainline sidelines canv canv2 canv3
3275
3276    set yt {}
3277    if {$dirn eq "down"} {
3278        if {[info exists mainline($id)]} {
3279            set y1 [lindex $mainline($id) 1]
3280            if {$y1 > $y} {
3281                set yt $y1
3282            }
3283        }
3284        if {[info exists sidelines($id)]} {
3285            foreach ls $sidelines($id) {
3286                set y1 [lindex $ls 0 1]
3287                if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3288                    set yt $y1
3289                }
3290            }
3291        }
3292    } else {
3293        if {[info exists sidelines($id)]} {
3294            foreach ls $sidelines($id) {
3295                set y1 [lindex $ls 0 end]
3296                if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3297                    set yt $y1
3298                }
3299            }
3300        }
3301    }
3302    if {$yt eq {}} return
3303    set ymax [lindex [$canv cget -scrollregion] 3]
3304    if {$ymax eq {} || $ymax <= 0} return
3305    set view [$canv yview]
3306    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3307    set yfrac [expr {$yt / $ymax - $yspan / 2}]
3308    if {$yfrac < 0} {
3309        set yfrac 0
3310    }
3311    $canv yview moveto $yfrac
3312    $canv2 yview moveto $yfrac
3313    $canv3 yview moveto $yfrac
3314}
3315
3316proc lineclick {x y id isnew} {
3317    global ctext commitinfo children cflist canv thickerline
3318
3319    unmarkmatches
3320    unselectline
3321    normalline
3322    $canv delete hover
3323    # draw this line thicker than normal
3324    drawlines $id 1 1
3325    set thickerline $id
3326    if {$isnew} {
3327        set ymax [lindex [$canv cget -scrollregion] 3]
3328        if {$ymax eq {}} return
3329        set yfrac [lindex [$canv yview] 0]
3330        set y [expr {$y + $yfrac * $ymax}]
3331    }
3332    set dirn [clickisonarrow $id $y]
3333    if {$dirn ne {}} {
3334        arrowjump $id $dirn $y
3335        return
3336    }
3337
3338    if {$isnew} {
3339        addtohistory [list lineclick $x $y $id 0]
3340    }
3341    # fill the details pane with info about this line
3342    $ctext conf -state normal
3343    $ctext delete 0.0 end
3344    $ctext tag conf link -foreground blue -underline 1
3345    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3346    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3347    $ctext insert end "Parent:\t"
3348    $ctext insert end $id [list link link0]
3349    $ctext tag bind link0 <1> [list selbyid $id]
3350    set info $commitinfo($id)
3351    $ctext insert end "\n\t[lindex $info 0]\n"
3352    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3353    set date [formatdate [lindex $info 2]]
3354    $ctext insert end "\tDate:\t$date\n"
3355    if {[info exists children($id)]} {
3356        $ctext insert end "\nChildren:"
3357        set i 0
3358        foreach child $children($id) {
3359            incr i
3360            set info $commitinfo($child)
3361            $ctext insert end "\n\t"
3362            $ctext insert end $child [list link link$i]
3363            $ctext tag bind link$i <1> [list selbyid $child]
3364            $ctext insert end "\n\t[lindex $info 0]"
3365            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3366            set date [formatdate [lindex $info 2]]
3367            $ctext insert end "\n\tDate:\t$date\n"
3368        }
3369    }
3370    $ctext conf -state disabled
3371
3372    $cflist delete 0 end
3373}
3374
3375proc normalline {} {
3376    global thickerline
3377    if {[info exists thickerline]} {
3378        drawlines $thickerline 0 1
3379        unset thickerline
3380    }
3381}
3382
3383proc selbyid {id} {
3384    global idline
3385    if {[info exists idline($id)]} {
3386        selectline $idline($id) 1
3387    }
3388}
3389
3390proc mstime {} {
3391    global startmstime
3392    if {![info exists startmstime]} {
3393        set startmstime [clock clicks -milliseconds]
3394    }
3395    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3396}
3397
3398proc rowmenu {x y id} {
3399    global rowctxmenu idline selectedline rowmenuid
3400
3401    if {![info exists selectedline] || $idline($id) eq $selectedline} {
3402        set state disabled
3403    } else {
3404        set state normal
3405    }
3406    $rowctxmenu entryconfigure 0 -state $state
3407    $rowctxmenu entryconfigure 1 -state $state
3408    $rowctxmenu entryconfigure 2 -state $state
3409    set rowmenuid $id
3410    tk_popup $rowctxmenu $x $y
3411}
3412
3413proc diffvssel {dirn} {
3414    global rowmenuid selectedline lineid
3415
3416    if {![info exists selectedline]} return
3417    if {$dirn} {
3418        set oldid $lineid($selectedline)
3419        set newid $rowmenuid
3420    } else {
3421        set oldid $rowmenuid
3422        set newid $lineid($selectedline)
3423    }
3424    addtohistory [list doseldiff $oldid $newid]
3425    doseldiff $oldid $newid
3426}
3427
3428proc doseldiff {oldid newid} {
3429    global ctext cflist
3430    global commitinfo
3431
3432    $ctext conf -state normal
3433    $ctext delete 0.0 end
3434    $ctext mark set fmark.0 0.0
3435    $ctext mark gravity fmark.0 left
3436    $cflist delete 0 end
3437    $cflist insert end "Top"
3438    $ctext insert end "From "
3439    $ctext tag conf link -foreground blue -underline 1
3440    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3441    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3442    $ctext tag bind link0 <1> [list selbyid $oldid]
3443    $ctext insert end $oldid [list link link0]
3444    $ctext insert end "\n     "
3445    $ctext insert end [lindex $commitinfo($oldid) 0]
3446    $ctext insert end "\n\nTo   "
3447    $ctext tag bind link1 <1> [list selbyid $newid]
3448    $ctext insert end $newid [list link link1]
3449    $ctext insert end "\n     "
3450    $ctext insert end [lindex $commitinfo($newid) 0]
3451    $ctext insert end "\n"
3452    $ctext conf -state disabled
3453    $ctext tag delete Comments
3454    $ctext tag remove found 1.0 end
3455    startdiff [list $oldid $newid]
3456}
3457
3458proc mkpatch {} {
3459    global rowmenuid currentid commitinfo patchtop patchnum
3460
3461    if {![info exists currentid]} return
3462    set oldid $currentid
3463    set oldhead [lindex $commitinfo($oldid) 0]
3464    set newid $rowmenuid
3465    set newhead [lindex $commitinfo($newid) 0]
3466    set top .patch
3467    set patchtop $top
3468    catch {destroy $top}
3469    toplevel $top
3470    label $top.title -text "Generate patch"
3471    grid $top.title - -pady 10
3472    label $top.from -text "From:"
3473    entry $top.fromsha1 -width 40 -relief flat
3474    $top.fromsha1 insert 0 $oldid
3475    $top.fromsha1 conf -state readonly
3476    grid $top.from $top.fromsha1 -sticky w
3477    entry $top.fromhead -width 60 -relief flat
3478    $top.fromhead insert 0 $oldhead
3479    $top.fromhead conf -state readonly
3480    grid x $top.fromhead -sticky w
3481    label $top.to -text "To:"
3482    entry $top.tosha1 -width 40 -relief flat
3483    $top.tosha1 insert 0 $newid
3484    $top.tosha1 conf -state readonly
3485    grid $top.to $top.tosha1 -sticky w
3486    entry $top.tohead -width 60 -relief flat
3487    $top.tohead insert 0 $newhead
3488    $top.tohead conf -state readonly
3489    grid x $top.tohead -sticky w
3490    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3491    grid $top.rev x -pady 10
3492    label $top.flab -text "Output file:"
3493    entry $top.fname -width 60
3494    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3495    incr patchnum
3496    grid $top.flab $top.fname -sticky w
3497    frame $top.buts
3498    button $top.buts.gen -text "Generate" -command mkpatchgo
3499    button $top.buts.can -text "Cancel" -command mkpatchcan
3500    grid $top.buts.gen $top.buts.can
3501    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3502    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3503    grid $top.buts - -pady 10 -sticky ew
3504    focus $top.fname
3505}
3506
3507proc mkpatchrev {} {
3508    global patchtop
3509
3510    set oldid [$patchtop.fromsha1 get]
3511    set oldhead [$patchtop.fromhead get]
3512    set newid [$patchtop.tosha1 get]
3513    set newhead [$patchtop.tohead get]
3514    foreach e [list fromsha1 fromhead tosha1 tohead] \
3515            v [list $newid $newhead $oldid $oldhead] {
3516        $patchtop.$e conf -state normal
3517        $patchtop.$e delete 0 end
3518        $patchtop.$e insert 0 $v
3519        $patchtop.$e conf -state readonly
3520    }
3521}
3522
3523proc mkpatchgo {} {
3524    global patchtop
3525
3526    set oldid [$patchtop.fromsha1 get]
3527    set newid [$patchtop.tosha1 get]
3528    set fname [$patchtop.fname get]
3529    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3530        error_popup "Error creating patch: $err"
3531    }
3532    catch {destroy $patchtop}
3533    unset patchtop
3534}
3535
3536proc mkpatchcan {} {
3537    global patchtop
3538
3539    catch {destroy $patchtop}
3540    unset patchtop
3541}
3542
3543proc mktag {} {
3544    global rowmenuid mktagtop commitinfo
3545
3546    set top .maketag
3547    set mktagtop $top
3548    catch {destroy $top}
3549    toplevel $top
3550    label $top.title -text "Create tag"
3551    grid $top.title - -pady 10
3552    label $top.id -text "ID:"
3553    entry $top.sha1 -width 40 -relief flat
3554    $top.sha1 insert 0 $rowmenuid
3555    $top.sha1 conf -state readonly
3556    grid $top.id $top.sha1 -sticky w
3557    entry $top.head -width 60 -relief flat
3558    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3559    $top.head conf -state readonly
3560    grid x $top.head -sticky w
3561    label $top.tlab -text "Tag name:"
3562    entry $top.tag -width 60
3563    grid $top.tlab $top.tag -sticky w
3564    frame $top.buts
3565    button $top.buts.gen -text "Create" -command mktaggo
3566    button $top.buts.can -text "Cancel" -command mktagcan
3567    grid $top.buts.gen $top.buts.can
3568    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3569    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3570    grid $top.buts - -pady 10 -sticky ew
3571    focus $top.tag
3572}
3573
3574proc domktag {} {
3575    global mktagtop env tagids idtags
3576
3577    set id [$mktagtop.sha1 get]
3578    set tag [$mktagtop.tag get]
3579    if {$tag == {}} {
3580        error_popup "No tag name specified"
3581        return
3582    }
3583    if {[info exists tagids($tag)]} {
3584        error_popup "Tag \"$tag\" already exists"
3585        return
3586    }
3587    if {[catch {
3588        set dir [gitdir]
3589        set fname [file join $dir "refs/tags" $tag]
3590        set f [open $fname w]
3591        puts $f $id
3592        close $f
3593    } err]} {
3594        error_popup "Error creating tag: $err"
3595        return
3596    }
3597
3598    set tagids($tag) $id
3599    lappend idtags($id) $tag
3600    redrawtags $id
3601}
3602
3603proc redrawtags {id} {
3604    global canv linehtag idline idpos selectedline
3605
3606    if {![info exists idline($id)]} return
3607    $canv delete tag.$id
3608    set xt [eval drawtags $id $idpos($id)]
3609    $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3610    if {[info exists selectedline] && $selectedline == $idline($id)} {
3611        selectline $selectedline 0
3612    }
3613}
3614
3615proc mktagcan {} {
3616    global mktagtop
3617
3618    catch {destroy $mktagtop}
3619    unset mktagtop
3620}
3621
3622proc mktaggo {} {
3623    domktag
3624    mktagcan
3625}
3626
3627proc writecommit {} {
3628    global rowmenuid wrcomtop commitinfo wrcomcmd
3629
3630    set top .writecommit
3631    set wrcomtop $top
3632    catch {destroy $top}
3633    toplevel $top
3634    label $top.title -text "Write commit to file"
3635    grid $top.title - -pady 10
3636    label $top.id -text "ID:"
3637    entry $top.sha1 -width 40 -relief flat
3638    $top.sha1 insert 0 $rowmenuid
3639    $top.sha1 conf -state readonly
3640    grid $top.id $top.sha1 -sticky w
3641    entry $top.head -width 60 -relief flat
3642    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3643    $top.head conf -state readonly
3644    grid x $top.head -sticky w
3645    label $top.clab -text "Command:"
3646    entry $top.cmd -width 60 -textvariable wrcomcmd
3647    grid $top.clab $top.cmd -sticky w -pady 10
3648    label $top.flab -text "Output file:"
3649    entry $top.fname -width 60
3650    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3651    grid $top.flab $top.fname -sticky w
3652    frame $top.buts
3653    button $top.buts.gen -text "Write" -command wrcomgo
3654    button $top.buts.can -text "Cancel" -command wrcomcan
3655    grid $top.buts.gen $top.buts.can
3656    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3657    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3658    grid $top.buts - -pady 10 -sticky ew
3659    focus $top.fname
3660}
3661
3662proc wrcomgo {} {
3663    global wrcomtop
3664
3665    set id [$wrcomtop.sha1 get]
3666    set cmd "echo $id | [$wrcomtop.cmd get]"
3667    set fname [$wrcomtop.fname get]
3668    if {[catch {exec sh -c $cmd >$fname &} err]} {
3669        error_popup "Error writing commit: $err"
3670    }
3671    catch {destroy $wrcomtop}
3672    unset wrcomtop
3673}
3674
3675proc wrcomcan {} {
3676    global wrcomtop
3677
3678    catch {destroy $wrcomtop}
3679    unset wrcomtop
3680}
3681
3682proc listrefs {id} {
3683    global idtags idheads idotherrefs
3684
3685    set x {}
3686    if {[info exists idtags($id)]} {
3687        set x $idtags($id)
3688    }
3689    set y {}
3690    if {[info exists idheads($id)]} {
3691        set y $idheads($id)
3692    }
3693    set z {}
3694    if {[info exists idotherrefs($id)]} {
3695        set z $idotherrefs($id)
3696    }
3697    return [list $x $y $z]
3698}
3699
3700proc rereadrefs {} {
3701    global idtags idheads idotherrefs
3702    global tagids headids otherrefids
3703
3704    set refids [concat [array names idtags] \
3705                    [array names idheads] [array names idotherrefs]]
3706    foreach id $refids {
3707        if {![info exists ref($id)]} {
3708            set ref($id) [listrefs $id]
3709        }
3710    }
3711    readrefs
3712    set refids [lsort -unique [concat $refids [array names idtags] \
3713                        [array names idheads] [array names idotherrefs]]]
3714    foreach id $refids {
3715        set v [listrefs $id]
3716        if {![info exists ref($id)] || $ref($id) != $v} {
3717            redrawtags $id
3718        }
3719    }
3720}
3721
3722proc showtag {tag isnew} {
3723    global ctext cflist tagcontents tagids linknum
3724
3725    if {$isnew} {
3726        addtohistory [list showtag $tag 0]
3727    }
3728    $ctext conf -state normal
3729    $ctext delete 0.0 end
3730    set linknum 0
3731    if {[info exists tagcontents($tag)]} {
3732        set text $tagcontents($tag)
3733    } else {
3734        set text "Tag: $tag\nId:  $tagids($tag)"
3735    }
3736    appendwithlinks $text
3737    $ctext conf -state disabled
3738    $cflist delete 0 end
3739}
3740
3741proc doquit {} {
3742    global stopped
3743    set stopped 100
3744    destroy .
3745}
3746
3747proc doprefs {} {
3748    global maxwidth maxgraphpct diffopts findmergefiles
3749    global oldprefs prefstop
3750
3751    set top .gitkprefs
3752    set prefstop $top
3753    if {[winfo exists $top]} {
3754        raise $top
3755        return
3756    }
3757    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3758        set oldprefs($v) [set $v]
3759    }
3760    toplevel $top
3761    wm title $top "Gitk preferences"
3762    label $top.ldisp -text "Commit list display options"
3763    grid $top.ldisp - -sticky w -pady 10
3764    label $top.spacer -text " "
3765    label $top.maxwidthl -text "Maximum graph width (lines)" \
3766        -font optionfont
3767    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3768    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3769    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3770        -font optionfont
3771    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3772    grid x $top.maxpctl $top.maxpct -sticky w
3773    checkbutton $top.findm -variable findmergefiles
3774    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3775        -font optionfont
3776    grid $top.findm $top.findml - -sticky w
3777    label $top.ddisp -text "Diff display options"
3778    grid $top.ddisp - -sticky w -pady 10
3779    label $top.diffoptl -text "Options for diff program" \
3780        -font optionfont
3781    entry $top.diffopt -width 20 -textvariable diffopts
3782    grid x $top.diffoptl $top.diffopt -sticky w
3783    frame $top.buts
3784    button $top.buts.ok -text "OK" -command prefsok
3785    button $top.buts.can -text "Cancel" -command prefscan
3786    grid $top.buts.ok $top.buts.can
3787    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3788    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3789    grid $top.buts - - -pady 10 -sticky ew
3790}
3791
3792proc prefscan {} {
3793    global maxwidth maxgraphpct diffopts findmergefiles
3794    global oldprefs prefstop
3795
3796    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3797        set $v $oldprefs($v)
3798    }
3799    catch {destroy $prefstop}
3800    unset prefstop
3801}
3802
3803proc prefsok {} {
3804    global maxwidth maxgraphpct
3805    global oldprefs prefstop
3806
3807    catch {destroy $prefstop}
3808    unset prefstop
3809    if {$maxwidth != $oldprefs(maxwidth)
3810        || $maxgraphpct != $oldprefs(maxgraphpct)} {
3811        redisplay
3812    }
3813}
3814
3815proc formatdate {d} {
3816    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3817}
3818
3819# This list of encoding names and aliases is distilled from
3820# http://www.iana.org/assignments/character-sets.
3821# Not all of them are supported by Tcl.
3822set encoding_aliases {
3823    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3824      ISO646-US US-ASCII us IBM367 cp367 csASCII }
3825    { ISO-10646-UTF-1 csISO10646UTF1 }
3826    { ISO_646.basic:1983 ref csISO646basic1983 }
3827    { INVARIANT csINVARIANT }
3828    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3829    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3830    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3831    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3832    { NATS-DANO iso-ir-9-1 csNATSDANO }
3833    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3834    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3835    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3836    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3837    { ISO-2022-KR csISO2022KR }
3838    { EUC-KR csEUCKR }
3839    { ISO-2022-JP csISO2022JP }
3840    { ISO-2022-JP-2 csISO2022JP2 }
3841    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3842      csISO13JISC6220jp }
3843    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3844    { IT iso-ir-15 ISO646-IT csISO15Italian }
3845    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3846    { ES iso-ir-17 ISO646-ES csISO17Spanish }
3847    { greek7-old iso-ir-18 csISO18Greek7Old }
3848    { latin-greek iso-ir-19 csISO19LatinGreek }
3849    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3850    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3851    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3852    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3853    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3854    { BS_viewdata iso-ir-47 csISO47BSViewdata }
3855    { INIS iso-ir-49 csISO49INIS }
3856    { INIS-8 iso-ir-50 csISO50INIS8 }
3857    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3858    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3859    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3860    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3861    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3862    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3863      csISO60Norwegian1 }
3864    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3865    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3866    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3867    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3868    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3869    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3870    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3871    { greek7 iso-ir-88 csISO88Greek7 }
3872    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3873    { iso-ir-90 csISO90 }
3874    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3875    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3876      csISO92JISC62991984b }
3877    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3878    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3879    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3880      csISO95JIS62291984handadd }
3881    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3882    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3883    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3884    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3885      CP819 csISOLatin1 }
3886    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3887    { T.61-7bit iso-ir-102 csISO102T617bit }
3888    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3889    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3890    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3891    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3892    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3893    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3894    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3895    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3896      arabic csISOLatinArabic }
3897    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3898    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3899    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3900      greek greek8 csISOLatinGreek }
3901    { T.101-G2 iso-ir-128 csISO128T101G2 }
3902    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3903      csISOLatinHebrew }
3904    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3905    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3906    { CSN_369103 iso-ir-139 csISO139CSN369103 }
3907    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3908    { ISO_6937-2-add iso-ir-142 csISOTextComm }
3909    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3910    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3911      csISOLatinCyrillic }
3912    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3913    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3914    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3915    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3916    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3917    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3918    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3919    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3920    { ISO_10367-box iso-ir-155 csISO10367Box }
3921    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3922    { latin-lap lap iso-ir-158 csISO158Lap }
3923    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3924    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3925    { us-dk csUSDK }
3926    { dk-us csDKUS }
3927    { JIS_X0201 X0201 csHalfWidthKatakana }
3928    { KSC5636 ISO646-KR csKSC5636 }
3929    { ISO-10646-UCS-2 csUnicode }
3930    { ISO-10646-UCS-4 csUCS4 }
3931    { DEC-MCS dec csDECMCS }
3932    { hp-roman8 roman8 r8 csHPRoman8 }
3933    { macintosh mac csMacintosh }
3934    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3935      csIBM037 }
3936    { IBM038 EBCDIC-INT cp038 csIBM038 }
3937    { IBM273 CP273 csIBM273 }
3938    { IBM274 EBCDIC-BE CP274 csIBM274 }
3939    { IBM275 EBCDIC-BR cp275 csIBM275 }
3940    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3941    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3942    { IBM280 CP280 ebcdic-cp-it csIBM280 }
3943    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3944    { IBM284 CP284 ebcdic-cp-es csIBM284 }
3945    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3946    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3947    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3948    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3949    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3950    { IBM424 cp424 ebcdic-cp-he csIBM424 }
3951    { IBM437 cp437 437 csPC8CodePage437 }
3952    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3953    { IBM775 cp775 csPC775Baltic }
3954    { IBM850 cp850 850 csPC850Multilingual }
3955    { IBM851 cp851 851 csIBM851 }
3956    { IBM852 cp852 852 csPCp852 }
3957    { IBM855 cp855 855 csIBM855 }
3958    { IBM857 cp857 857 csIBM857 }
3959    { IBM860 cp860 860 csIBM860 }
3960    { IBM861 cp861 861 cp-is csIBM861 }
3961    { IBM862 cp862 862 csPC862LatinHebrew }
3962    { IBM863 cp863 863 csIBM863 }
3963    { IBM864 cp864 csIBM864 }
3964    { IBM865 cp865 865 csIBM865 }
3965    { IBM866 cp866 866 csIBM866 }
3966    { IBM868 CP868 cp-ar csIBM868 }
3967    { IBM869 cp869 869 cp-gr csIBM869 }
3968    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3969    { IBM871 CP871 ebcdic-cp-is csIBM871 }
3970    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3971    { IBM891 cp891 csIBM891 }
3972    { IBM903 cp903 csIBM903 }
3973    { IBM904 cp904 904 csIBBM904 }
3974    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3975    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3976    { IBM1026 CP1026 csIBM1026 }
3977    { EBCDIC-AT-DE csIBMEBCDICATDE }
3978    { EBCDIC-AT-DE-A csEBCDICATDEA }
3979    { EBCDIC-CA-FR csEBCDICCAFR }
3980    { EBCDIC-DK-NO csEBCDICDKNO }
3981    { EBCDIC-DK-NO-A csEBCDICDKNOA }
3982    { EBCDIC-FI-SE csEBCDICFISE }
3983    { EBCDIC-FI-SE-A csEBCDICFISEA }
3984    { EBCDIC-FR csEBCDICFR }
3985    { EBCDIC-IT csEBCDICIT }
3986    { EBCDIC-PT csEBCDICPT }
3987    { EBCDIC-ES csEBCDICES }
3988    { EBCDIC-ES-A csEBCDICESA }
3989    { EBCDIC-ES-S csEBCDICESS }
3990    { EBCDIC-UK csEBCDICUK }
3991    { EBCDIC-US csEBCDICUS }
3992    { UNKNOWN-8BIT csUnknown8BiT }
3993    { MNEMONIC csMnemonic }
3994    { MNEM csMnem }
3995    { VISCII csVISCII }
3996    { VIQR csVIQR }
3997    { KOI8-R csKOI8R }
3998    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3999    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4000    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4001    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4002    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4003    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4004    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4005    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4006    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4007    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4008    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4009    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4010    { IBM1047 IBM-1047 }
4011    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4012    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4013    { UNICODE-1-1 csUnicode11 }
4014    { CESU-8 csCESU-8 }
4015    { BOCU-1 csBOCU-1 }
4016    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4017    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4018      l8 }
4019    { ISO-8859-15 ISO_8859-15 Latin-9 }
4020    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4021    { GBK CP936 MS936 windows-936 }
4022    { JIS_Encoding csJISEncoding }
4023    { Shift_JIS MS_Kanji csShiftJIS }
4024    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4025      EUC-JP }
4026    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4027    { ISO-10646-UCS-Basic csUnicodeASCII }
4028    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4029    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4030    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4031    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4032    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4033    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4034    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4035    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4036    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4037    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4038    { Adobe-Standard-Encoding csAdobeStandardEncoding }
4039    { Ventura-US csVenturaUS }
4040    { Ventura-International csVenturaInternational }
4041    { PC8-Danish-Norwegian csPC8DanishNorwegian }
4042    { PC8-Turkish csPC8Turkish }
4043    { IBM-Symbols csIBMSymbols }
4044    { IBM-Thai csIBMThai }
4045    { HP-Legal csHPLegal }
4046    { HP-Pi-font csHPPiFont }
4047    { HP-Math8 csHPMath8 }
4048    { Adobe-Symbol-Encoding csHPPSMath }
4049    { HP-DeskTop csHPDesktop }
4050    { Ventura-Math csVenturaMath }
4051    { Microsoft-Publishing csMicrosoftPublishing }
4052    { Windows-31J csWindows31J }
4053    { GB2312 csGB2312 }
4054    { Big5 csBig5 }
4055}
4056
4057proc tcl_encoding {enc} {
4058    global encoding_aliases
4059    set names [encoding names]
4060    set lcnames [string tolower $names]
4061    set enc [string tolower $enc]
4062    set i [lsearch -exact $lcnames $enc]
4063    if {$i < 0} {
4064        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4065        if {[regsub {^iso[-_]} $enc iso encx]} {
4066            set i [lsearch -exact $lcnames $encx]
4067        }
4068    }
4069    if {$i < 0} {
4070        foreach l $encoding_aliases {
4071            set ll [string tolower $l]
4072            if {[lsearch -exact $ll $enc] < 0} continue
4073            # look through the aliases for one that tcl knows about
4074            foreach e $ll {
4075                set i [lsearch -exact $lcnames $e]
4076                if {$i < 0} {
4077                    if {[regsub {^iso[-_]} $e iso ex]} {
4078                        set i [lsearch -exact $lcnames $ex]
4079                    }
4080                }
4081                if {$i >= 0} break
4082            }
4083            break
4084        }
4085    }
4086    if {$i >= 0} {
4087        return [lindex $names $i]
4088    }
4089    return {}
4090}
4091
4092# defaults...
4093set datemode 0
4094set diffopts "-U 5 -p"
4095set wrcomcmd "git-diff-tree --stdin -p --pretty"
4096
4097set gitencoding {}
4098catch {
4099    set gitencoding [exec git-repo-config --get i18n.commitencoding]
4100}
4101if {$gitencoding == ""} {
4102    set gitencoding "utf-8"
4103}
4104set tclencoding [tcl_encoding $gitencoding]
4105if {$tclencoding == {}} {
4106    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4107}
4108
4109set mainfont {Helvetica 9}
4110set textfont {Courier 9}
4111set findmergefiles 0
4112set maxgraphpct 50
4113set maxwidth 16
4114set revlistorder 0
4115set fastdate 0
4116
4117set colors {green red blue magenta darkgrey brown orange}
4118
4119catch {source ~/.gitk}
4120
4121set namefont $mainfont
4122
4123font create optionfont -family sans-serif -size -12
4124
4125set revtreeargs {}
4126foreach arg $argv {
4127    switch -regexp -- $arg {
4128        "^$" { }
4129        "^-d" { set datemode 1 }
4130        "^-r" { set revlistorder 1 }
4131        default {
4132            lappend revtreeargs $arg
4133        }
4134    }
4135}
4136
4137set history {}
4138set historyindex 0
4139
4140set stopped 0
4141set redisplaying 0
4142set stuffsaved 0
4143set patchnum 0
4144setcoords
4145makewindow $revtreeargs
4146readrefs
4147getcommits $revtreeargs