gitkon commit xread/xwrite: do not worry about EINTR at calling sites. (1c15afb)
   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 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]}] return
2916    fconfigure $gdtf -blocking 0
2917    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2918}
2919
2920proc gettreediffline {gdtf ids} {
2921    global treediff treediffs treepending diffids diffmergeid
2922
2923    set n [gets $gdtf line]
2924    if {$n < 0} {
2925        if {![eof $gdtf]} return
2926        close $gdtf
2927        set treediffs($ids) $treediff
2928        unset treepending
2929        if {$ids != $diffids} {
2930            gettreediffs $diffids
2931        } else {
2932            if {[info exists diffmergeid]} {
2933                contmergediff $ids
2934            } else {
2935                addtocflist $ids
2936            }
2937        }
2938        return
2939    }
2940    set file [lindex $line 5]
2941    lappend treediff $file
2942}
2943
2944proc getblobdiffs {ids} {
2945    global diffopts blobdifffd diffids env curdifftag curtagstart
2946    global difffilestart nextupdate diffinhdr treediffs
2947
2948    set env(GIT_DIFF_OPTS) $diffopts
2949    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2950    if {[catch {set bdf [open $cmd r]} err]} {
2951        puts "error getting diffs: $err"
2952        return
2953    }
2954    set diffinhdr 0
2955    fconfigure $bdf -blocking 0
2956    set blobdifffd($ids) $bdf
2957    set curdifftag Comments
2958    set curtagstart 0.0
2959    catch {unset difffilestart}
2960    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2961    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2962}
2963
2964proc getblobdiffline {bdf ids} {
2965    global diffids blobdifffd ctext curdifftag curtagstart
2966    global diffnexthead diffnextnote difffilestart
2967    global nextupdate diffinhdr treediffs
2968
2969    set n [gets $bdf line]
2970    if {$n < 0} {
2971        if {[eof $bdf]} {
2972            close $bdf
2973            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2974                $ctext tag add $curdifftag $curtagstart end
2975            }
2976        }
2977        return
2978    }
2979    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2980        return
2981    }
2982    $ctext conf -state normal
2983    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2984        # start of a new file
2985        $ctext insert end "\n"
2986        $ctext tag add $curdifftag $curtagstart end
2987        set curtagstart [$ctext index "end - 1c"]
2988        set header $newname
2989        set here [$ctext index "end - 1c"]
2990        set i [lsearch -exact $treediffs($diffids) $fname]
2991        if {$i >= 0} {
2992            set difffilestart($i) $here
2993            incr i
2994            $ctext mark set fmark.$i $here
2995            $ctext mark gravity fmark.$i left
2996        }
2997        if {$newname != $fname} {
2998            set i [lsearch -exact $treediffs($diffids) $newname]
2999            if {$i >= 0} {
3000                set difffilestart($i) $here
3001                incr i
3002                $ctext mark set fmark.$i $here
3003                $ctext mark gravity fmark.$i left
3004            }
3005        }
3006        set curdifftag "f:$fname"
3007        $ctext tag delete $curdifftag
3008        set l [expr {(78 - [string length $header]) / 2}]
3009        set pad [string range "----------------------------------------" 1 $l]
3010        $ctext insert end "$pad $header $pad\n" filesep
3011        set diffinhdr 1
3012    } elseif {[regexp {^(---|\+\+\+)} $line]} {
3013        set diffinhdr 0
3014    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3015                   $line match f1l f1c f2l f2c rest]} {
3016        $ctext insert end "$line\n" hunksep
3017        set diffinhdr 0
3018    } else {
3019        set x [string range $line 0 0]
3020        if {$x == "-" || $x == "+"} {
3021            set tag [expr {$x == "+"}]
3022            $ctext insert end "$line\n" d$tag
3023        } elseif {$x == " "} {
3024            $ctext insert end "$line\n"
3025        } elseif {$diffinhdr || $x == "\\"} {
3026            # e.g. "\ No newline at end of file"
3027            $ctext insert end "$line\n" filesep
3028        } else {
3029            # Something else we don't recognize
3030            if {$curdifftag != "Comments"} {
3031                $ctext insert end "\n"
3032                $ctext tag add $curdifftag $curtagstart end
3033                set curtagstart [$ctext index "end - 1c"]
3034                set curdifftag Comments
3035            }
3036            $ctext insert end "$line\n" filesep
3037        }
3038    }
3039    $ctext conf -state disabled
3040    if {[clock clicks -milliseconds] >= $nextupdate} {
3041        incr nextupdate 100
3042        fileevent $bdf readable {}
3043        update
3044        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3045    }
3046}
3047
3048proc nextfile {} {
3049    global difffilestart ctext
3050    set here [$ctext index @0,0]
3051    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3052        if {[$ctext compare $difffilestart($i) > $here]} {
3053            if {![info exists pos]
3054                || [$ctext compare $difffilestart($i) < $pos]} {
3055                set pos $difffilestart($i)
3056            }
3057        }
3058    }
3059    if {[info exists pos]} {
3060        $ctext yview $pos
3061    }
3062}
3063
3064proc listboxsel {} {
3065    global ctext cflist currentid
3066    if {![info exists currentid]} return
3067    set sel [lsort [$cflist curselection]]
3068    if {$sel eq {}} return
3069    set first [lindex $sel 0]
3070    catch {$ctext yview fmark.$first}
3071}
3072
3073proc setcoords {} {
3074    global linespc charspc canvx0 canvy0 mainfont
3075    global xspc1 xspc2 lthickness
3076
3077    set linespc [font metrics $mainfont -linespace]
3078    set charspc [font measure $mainfont "m"]
3079    set canvy0 [expr {3 + 0.5 * $linespc}]
3080    set canvx0 [expr {3 + 0.5 * $linespc}]
3081    set lthickness [expr {int($linespc / 9) + 1}]
3082    set xspc1(0) $linespc
3083    set xspc2 $linespc
3084}
3085
3086proc redisplay {} {
3087    global stopped redisplaying phase
3088    if {$stopped > 1} return
3089    if {$phase == "getcommits"} return
3090    set redisplaying 1
3091    if {$phase == "drawgraph" || $phase == "incrdraw"} {
3092        set stopped 1
3093    } else {
3094        drawgraph
3095    }
3096}
3097
3098proc incrfont {inc} {
3099    global mainfont namefont textfont ctext canv phase
3100    global stopped entries
3101    unmarkmatches
3102    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3103    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3104    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3105    setcoords
3106    $ctext conf -font $textfont
3107    $ctext tag conf filesep -font [concat $textfont bold]
3108    foreach e $entries {
3109        $e conf -font $mainfont
3110    }
3111    if {$phase == "getcommits"} {
3112        $canv itemconf textitems -font $mainfont
3113    }
3114    redisplay
3115}
3116
3117proc clearsha1 {} {
3118    global sha1entry sha1string
3119    if {[string length $sha1string] == 40} {
3120        $sha1entry delete 0 end
3121    }
3122}
3123
3124proc sha1change {n1 n2 op} {
3125    global sha1string currentid sha1but
3126    if {$sha1string == {}
3127        || ([info exists currentid] && $sha1string == $currentid)} {
3128        set state disabled
3129    } else {
3130        set state normal
3131    }
3132    if {[$sha1but cget -state] == $state} return
3133    if {$state == "normal"} {
3134        $sha1but conf -state normal -relief raised -text "Goto: "
3135    } else {
3136        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3137    }
3138}
3139
3140proc gotocommit {} {
3141    global sha1string currentid idline tagids
3142    global lineid numcommits
3143
3144    if {$sha1string == {}
3145        || ([info exists currentid] && $sha1string == $currentid)} return
3146    if {[info exists tagids($sha1string)]} {
3147        set id $tagids($sha1string)
3148    } else {
3149        set id [string tolower $sha1string]
3150        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3151            set matches {}
3152            for {set l 0} {$l < $numcommits} {incr l} {
3153                if {[string match $id* $lineid($l)]} {
3154                    lappend matches $lineid($l)
3155                }
3156            }
3157            if {$matches ne {}} {
3158                if {[llength $matches] > 1} {
3159                    error_popup "Short SHA1 id $id is ambiguous"
3160                    return
3161                }
3162                set id [lindex $matches 0]
3163            }
3164        }
3165    }
3166    if {[info exists idline($id)]} {
3167        selectline $idline($id) 1
3168        return
3169    }
3170    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3171        set type "SHA1 id"
3172    } else {
3173        set type "Tag"
3174    }
3175    error_popup "$type $sha1string is not known"
3176}
3177
3178proc lineenter {x y id} {
3179    global hoverx hovery hoverid hovertimer
3180    global commitinfo canv
3181
3182    if {![info exists commitinfo($id)]} return
3183    set hoverx $x
3184    set hovery $y
3185    set hoverid $id
3186    if {[info exists hovertimer]} {
3187        after cancel $hovertimer
3188    }
3189    set hovertimer [after 500 linehover]
3190    $canv delete hover
3191}
3192
3193proc linemotion {x y id} {
3194    global hoverx hovery hoverid hovertimer
3195
3196    if {[info exists hoverid] && $id == $hoverid} {
3197        set hoverx $x
3198        set hovery $y
3199        if {[info exists hovertimer]} {
3200            after cancel $hovertimer
3201        }
3202        set hovertimer [after 500 linehover]
3203    }
3204}
3205
3206proc lineleave {id} {
3207    global hoverid hovertimer canv
3208
3209    if {[info exists hoverid] && $id == $hoverid} {
3210        $canv delete hover
3211        if {[info exists hovertimer]} {
3212            after cancel $hovertimer
3213            unset hovertimer
3214        }
3215        unset hoverid
3216    }
3217}
3218
3219proc linehover {} {
3220    global hoverx hovery hoverid hovertimer
3221    global canv linespc lthickness
3222    global commitinfo mainfont
3223
3224    set text [lindex $commitinfo($hoverid) 0]
3225    set ymax [lindex [$canv cget -scrollregion] 3]
3226    if {$ymax == {}} return
3227    set yfrac [lindex [$canv yview] 0]
3228    set x [expr {$hoverx + 2 * $linespc}]
3229    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3230    set x0 [expr {$x - 2 * $lthickness}]
3231    set y0 [expr {$y - 2 * $lthickness}]
3232    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3233    set y1 [expr {$y + $linespc + 2 * $lthickness}]
3234    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3235               -fill \#ffff80 -outline black -width 1 -tags hover]
3236    $canv raise $t
3237    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3238    $canv raise $t
3239}
3240
3241proc clickisonarrow {id y} {
3242    global mainline mainlinearrow sidelines lthickness
3243
3244    set thresh [expr {2 * $lthickness + 6}]
3245    if {[info exists mainline($id)]} {
3246        if {$mainlinearrow($id) ne "none"} {
3247            if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3248                return "up"
3249            }
3250        }
3251    }
3252    if {[info exists sidelines($id)]} {
3253        foreach ls $sidelines($id) {
3254            set coords [lindex $ls 0]
3255            set arrow [lindex $ls 2]
3256            if {$arrow eq "first" || $arrow eq "both"} {
3257                if {abs([lindex $coords 1] - $y) < $thresh} {
3258                    return "up"
3259                }
3260            }
3261            if {$arrow eq "last" || $arrow eq "both"} {
3262                if {abs([lindex $coords end] - $y) < $thresh} {
3263                    return "down"
3264                }
3265            }
3266        }
3267    }
3268    return {}
3269}
3270
3271proc arrowjump {id dirn y} {
3272    global mainline sidelines canv canv2 canv3
3273
3274    set yt {}
3275    if {$dirn eq "down"} {
3276        if {[info exists mainline($id)]} {
3277            set y1 [lindex $mainline($id) 1]
3278            if {$y1 > $y} {
3279                set yt $y1
3280            }
3281        }
3282        if {[info exists sidelines($id)]} {
3283            foreach ls $sidelines($id) {
3284                set y1 [lindex $ls 0 1]
3285                if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3286                    set yt $y1
3287                }
3288            }
3289        }
3290    } else {
3291        if {[info exists sidelines($id)]} {
3292            foreach ls $sidelines($id) {
3293                set y1 [lindex $ls 0 end]
3294                if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3295                    set yt $y1
3296                }
3297            }
3298        }
3299    }
3300    if {$yt eq {}} return
3301    set ymax [lindex [$canv cget -scrollregion] 3]
3302    if {$ymax eq {} || $ymax <= 0} return
3303    set view [$canv yview]
3304    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3305    set yfrac [expr {$yt / $ymax - $yspan / 2}]
3306    if {$yfrac < 0} {
3307        set yfrac 0
3308    }
3309    $canv yview moveto $yfrac
3310    $canv2 yview moveto $yfrac
3311    $canv3 yview moveto $yfrac
3312}
3313
3314proc lineclick {x y id isnew} {
3315    global ctext commitinfo children cflist canv thickerline
3316
3317    unmarkmatches
3318    unselectline
3319    normalline
3320    $canv delete hover
3321    # draw this line thicker than normal
3322    drawlines $id 1 1
3323    set thickerline $id
3324    if {$isnew} {
3325        set ymax [lindex [$canv cget -scrollregion] 3]
3326        if {$ymax eq {}} return
3327        set yfrac [lindex [$canv yview] 0]
3328        set y [expr {$y + $yfrac * $ymax}]
3329    }
3330    set dirn [clickisonarrow $id $y]
3331    if {$dirn ne {}} {
3332        arrowjump $id $dirn $y
3333        return
3334    }
3335
3336    if {$isnew} {
3337        addtohistory [list lineclick $x $y $id 0]
3338    }
3339    # fill the details pane with info about this line
3340    $ctext conf -state normal
3341    $ctext delete 0.0 end
3342    $ctext tag conf link -foreground blue -underline 1
3343    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3344    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3345    $ctext insert end "Parent:\t"
3346    $ctext insert end $id [list link link0]
3347    $ctext tag bind link0 <1> [list selbyid $id]
3348    set info $commitinfo($id)
3349    $ctext insert end "\n\t[lindex $info 0]\n"
3350    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3351    set date [formatdate [lindex $info 2]]
3352    $ctext insert end "\tDate:\t$date\n"
3353    if {[info exists children($id)]} {
3354        $ctext insert end "\nChildren:"
3355        set i 0
3356        foreach child $children($id) {
3357            incr i
3358            set info $commitinfo($child)
3359            $ctext insert end "\n\t"
3360            $ctext insert end $child [list link link$i]
3361            $ctext tag bind link$i <1> [list selbyid $child]
3362            $ctext insert end "\n\t[lindex $info 0]"
3363            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3364            set date [formatdate [lindex $info 2]]
3365            $ctext insert end "\n\tDate:\t$date\n"
3366        }
3367    }
3368    $ctext conf -state disabled
3369
3370    $cflist delete 0 end
3371}
3372
3373proc normalline {} {
3374    global thickerline
3375    if {[info exists thickerline]} {
3376        drawlines $thickerline 0 1
3377        unset thickerline
3378    }
3379}
3380
3381proc selbyid {id} {
3382    global idline
3383    if {[info exists idline($id)]} {
3384        selectline $idline($id) 1
3385    }
3386}
3387
3388proc mstime {} {
3389    global startmstime
3390    if {![info exists startmstime]} {
3391        set startmstime [clock clicks -milliseconds]
3392    }
3393    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3394}
3395
3396proc rowmenu {x y id} {
3397    global rowctxmenu idline selectedline rowmenuid
3398
3399    if {![info exists selectedline] || $idline($id) eq $selectedline} {
3400        set state disabled
3401    } else {
3402        set state normal
3403    }
3404    $rowctxmenu entryconfigure 0 -state $state
3405    $rowctxmenu entryconfigure 1 -state $state
3406    $rowctxmenu entryconfigure 2 -state $state
3407    set rowmenuid $id
3408    tk_popup $rowctxmenu $x $y
3409}
3410
3411proc diffvssel {dirn} {
3412    global rowmenuid selectedline lineid
3413
3414    if {![info exists selectedline]} return
3415    if {$dirn} {
3416        set oldid $lineid($selectedline)
3417        set newid $rowmenuid
3418    } else {
3419        set oldid $rowmenuid
3420        set newid $lineid($selectedline)
3421    }
3422    addtohistory [list doseldiff $oldid $newid]
3423    doseldiff $oldid $newid
3424}
3425
3426proc doseldiff {oldid newid} {
3427    global ctext cflist
3428    global commitinfo
3429
3430    $ctext conf -state normal
3431    $ctext delete 0.0 end
3432    $ctext mark set fmark.0 0.0
3433    $ctext mark gravity fmark.0 left
3434    $cflist delete 0 end
3435    $cflist insert end "Top"
3436    $ctext insert end "From "
3437    $ctext tag conf link -foreground blue -underline 1
3438    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3439    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3440    $ctext tag bind link0 <1> [list selbyid $oldid]
3441    $ctext insert end $oldid [list link link0]
3442    $ctext insert end "\n     "
3443    $ctext insert end [lindex $commitinfo($oldid) 0]
3444    $ctext insert end "\n\nTo   "
3445    $ctext tag bind link1 <1> [list selbyid $newid]
3446    $ctext insert end $newid [list link link1]
3447    $ctext insert end "\n     "
3448    $ctext insert end [lindex $commitinfo($newid) 0]
3449    $ctext insert end "\n"
3450    $ctext conf -state disabled
3451    $ctext tag delete Comments
3452    $ctext tag remove found 1.0 end
3453    startdiff [list $oldid $newid]
3454}
3455
3456proc mkpatch {} {
3457    global rowmenuid currentid commitinfo patchtop patchnum
3458
3459    if {![info exists currentid]} return
3460    set oldid $currentid
3461    set oldhead [lindex $commitinfo($oldid) 0]
3462    set newid $rowmenuid
3463    set newhead [lindex $commitinfo($newid) 0]
3464    set top .patch
3465    set patchtop $top
3466    catch {destroy $top}
3467    toplevel $top
3468    label $top.title -text "Generate patch"
3469    grid $top.title - -pady 10
3470    label $top.from -text "From:"
3471    entry $top.fromsha1 -width 40 -relief flat
3472    $top.fromsha1 insert 0 $oldid
3473    $top.fromsha1 conf -state readonly
3474    grid $top.from $top.fromsha1 -sticky w
3475    entry $top.fromhead -width 60 -relief flat
3476    $top.fromhead insert 0 $oldhead
3477    $top.fromhead conf -state readonly
3478    grid x $top.fromhead -sticky w
3479    label $top.to -text "To:"
3480    entry $top.tosha1 -width 40 -relief flat
3481    $top.tosha1 insert 0 $newid
3482    $top.tosha1 conf -state readonly
3483    grid $top.to $top.tosha1 -sticky w
3484    entry $top.tohead -width 60 -relief flat
3485    $top.tohead insert 0 $newhead
3486    $top.tohead conf -state readonly
3487    grid x $top.tohead -sticky w
3488    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3489    grid $top.rev x -pady 10
3490    label $top.flab -text "Output file:"
3491    entry $top.fname -width 60
3492    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3493    incr patchnum
3494    grid $top.flab $top.fname -sticky w
3495    frame $top.buts
3496    button $top.buts.gen -text "Generate" -command mkpatchgo
3497    button $top.buts.can -text "Cancel" -command mkpatchcan
3498    grid $top.buts.gen $top.buts.can
3499    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3500    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3501    grid $top.buts - -pady 10 -sticky ew
3502    focus $top.fname
3503}
3504
3505proc mkpatchrev {} {
3506    global patchtop
3507
3508    set oldid [$patchtop.fromsha1 get]
3509    set oldhead [$patchtop.fromhead get]
3510    set newid [$patchtop.tosha1 get]
3511    set newhead [$patchtop.tohead get]
3512    foreach e [list fromsha1 fromhead tosha1 tohead] \
3513            v [list $newid $newhead $oldid $oldhead] {
3514        $patchtop.$e conf -state normal
3515        $patchtop.$e delete 0 end
3516        $patchtop.$e insert 0 $v
3517        $patchtop.$e conf -state readonly
3518    }
3519}
3520
3521proc mkpatchgo {} {
3522    global patchtop
3523
3524    set oldid [$patchtop.fromsha1 get]
3525    set newid [$patchtop.tosha1 get]
3526    set fname [$patchtop.fname get]
3527    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3528        error_popup "Error creating patch: $err"
3529    }
3530    catch {destroy $patchtop}
3531    unset patchtop
3532}
3533
3534proc mkpatchcan {} {
3535    global patchtop
3536
3537    catch {destroy $patchtop}
3538    unset patchtop
3539}
3540
3541proc mktag {} {
3542    global rowmenuid mktagtop commitinfo
3543
3544    set top .maketag
3545    set mktagtop $top
3546    catch {destroy $top}
3547    toplevel $top
3548    label $top.title -text "Create tag"
3549    grid $top.title - -pady 10
3550    label $top.id -text "ID:"
3551    entry $top.sha1 -width 40 -relief flat
3552    $top.sha1 insert 0 $rowmenuid
3553    $top.sha1 conf -state readonly
3554    grid $top.id $top.sha1 -sticky w
3555    entry $top.head -width 60 -relief flat
3556    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3557    $top.head conf -state readonly
3558    grid x $top.head -sticky w
3559    label $top.tlab -text "Tag name:"
3560    entry $top.tag -width 60
3561    grid $top.tlab $top.tag -sticky w
3562    frame $top.buts
3563    button $top.buts.gen -text "Create" -command mktaggo
3564    button $top.buts.can -text "Cancel" -command mktagcan
3565    grid $top.buts.gen $top.buts.can
3566    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3567    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3568    grid $top.buts - -pady 10 -sticky ew
3569    focus $top.tag
3570}
3571
3572proc domktag {} {
3573    global mktagtop env tagids idtags
3574
3575    set id [$mktagtop.sha1 get]
3576    set tag [$mktagtop.tag get]
3577    if {$tag == {}} {
3578        error_popup "No tag name specified"
3579        return
3580    }
3581    if {[info exists tagids($tag)]} {
3582        error_popup "Tag \"$tag\" already exists"
3583        return
3584    }
3585    if {[catch {
3586        set dir [gitdir]
3587        set fname [file join $dir "refs/tags" $tag]
3588        set f [open $fname w]
3589        puts $f $id
3590        close $f
3591    } err]} {
3592        error_popup "Error creating tag: $err"
3593        return
3594    }
3595
3596    set tagids($tag) $id
3597    lappend idtags($id) $tag
3598    redrawtags $id
3599}
3600
3601proc redrawtags {id} {
3602    global canv linehtag idline idpos selectedline
3603
3604    if {![info exists idline($id)]} return
3605    $canv delete tag.$id
3606    set xt [eval drawtags $id $idpos($id)]
3607    $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3608    if {[info exists selectedline] && $selectedline == $idline($id)} {
3609        selectline $selectedline 0
3610    }
3611}
3612
3613proc mktagcan {} {
3614    global mktagtop
3615
3616    catch {destroy $mktagtop}
3617    unset mktagtop
3618}
3619
3620proc mktaggo {} {
3621    domktag
3622    mktagcan
3623}
3624
3625proc writecommit {} {
3626    global rowmenuid wrcomtop commitinfo wrcomcmd
3627
3628    set top .writecommit
3629    set wrcomtop $top
3630    catch {destroy $top}
3631    toplevel $top
3632    label $top.title -text "Write commit to file"
3633    grid $top.title - -pady 10
3634    label $top.id -text "ID:"
3635    entry $top.sha1 -width 40 -relief flat
3636    $top.sha1 insert 0 $rowmenuid
3637    $top.sha1 conf -state readonly
3638    grid $top.id $top.sha1 -sticky w
3639    entry $top.head -width 60 -relief flat
3640    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3641    $top.head conf -state readonly
3642    grid x $top.head -sticky w
3643    label $top.clab -text "Command:"
3644    entry $top.cmd -width 60 -textvariable wrcomcmd
3645    grid $top.clab $top.cmd -sticky w -pady 10
3646    label $top.flab -text "Output file:"
3647    entry $top.fname -width 60
3648    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3649    grid $top.flab $top.fname -sticky w
3650    frame $top.buts
3651    button $top.buts.gen -text "Write" -command wrcomgo
3652    button $top.buts.can -text "Cancel" -command wrcomcan
3653    grid $top.buts.gen $top.buts.can
3654    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3655    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3656    grid $top.buts - -pady 10 -sticky ew
3657    focus $top.fname
3658}
3659
3660proc wrcomgo {} {
3661    global wrcomtop
3662
3663    set id [$wrcomtop.sha1 get]
3664    set cmd "echo $id | [$wrcomtop.cmd get]"
3665    set fname [$wrcomtop.fname get]
3666    if {[catch {exec sh -c $cmd >$fname &} err]} {
3667        error_popup "Error writing commit: $err"
3668    }
3669    catch {destroy $wrcomtop}
3670    unset wrcomtop
3671}
3672
3673proc wrcomcan {} {
3674    global wrcomtop
3675
3676    catch {destroy $wrcomtop}
3677    unset wrcomtop
3678}
3679
3680proc listrefs {id} {
3681    global idtags idheads idotherrefs
3682
3683    set x {}
3684    if {[info exists idtags($id)]} {
3685        set x $idtags($id)
3686    }
3687    set y {}
3688    if {[info exists idheads($id)]} {
3689        set y $idheads($id)
3690    }
3691    set z {}
3692    if {[info exists idotherrefs($id)]} {
3693        set z $idotherrefs($id)
3694    }
3695    return [list $x $y $z]
3696}
3697
3698proc rereadrefs {} {
3699    global idtags idheads idotherrefs
3700    global tagids headids otherrefids
3701
3702    set refids [concat [array names idtags] \
3703                    [array names idheads] [array names idotherrefs]]
3704    foreach id $refids {
3705        if {![info exists ref($id)]} {
3706            set ref($id) [listrefs $id]
3707        }
3708    }
3709    readrefs
3710    set refids [lsort -unique [concat $refids [array names idtags] \
3711                        [array names idheads] [array names idotherrefs]]]
3712    foreach id $refids {
3713        set v [listrefs $id]
3714        if {![info exists ref($id)] || $ref($id) != $v} {
3715            redrawtags $id
3716        }
3717    }
3718}
3719
3720proc showtag {tag isnew} {
3721    global ctext cflist tagcontents tagids linknum
3722
3723    if {$isnew} {
3724        addtohistory [list showtag $tag 0]
3725    }
3726    $ctext conf -state normal
3727    $ctext delete 0.0 end
3728    set linknum 0
3729    if {[info exists tagcontents($tag)]} {
3730        set text $tagcontents($tag)
3731    } else {
3732        set text "Tag: $tag\nId:  $tagids($tag)"
3733    }
3734    appendwithlinks $text
3735    $ctext conf -state disabled
3736    $cflist delete 0 end
3737}
3738
3739proc doquit {} {
3740    global stopped
3741    set stopped 100
3742    destroy .
3743}
3744
3745proc doprefs {} {
3746    global maxwidth maxgraphpct diffopts findmergefiles
3747    global oldprefs prefstop
3748
3749    set top .gitkprefs
3750    set prefstop $top
3751    if {[winfo exists $top]} {
3752        raise $top
3753        return
3754    }
3755    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3756        set oldprefs($v) [set $v]
3757    }
3758    toplevel $top
3759    wm title $top "Gitk preferences"
3760    label $top.ldisp -text "Commit list display options"
3761    grid $top.ldisp - -sticky w -pady 10
3762    label $top.spacer -text " "
3763    label $top.maxwidthl -text "Maximum graph width (lines)" \
3764        -font optionfont
3765    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3766    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3767    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3768        -font optionfont
3769    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3770    grid x $top.maxpctl $top.maxpct -sticky w
3771    checkbutton $top.findm -variable findmergefiles
3772    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3773        -font optionfont
3774    grid $top.findm $top.findml - -sticky w
3775    label $top.ddisp -text "Diff display options"
3776    grid $top.ddisp - -sticky w -pady 10
3777    label $top.diffoptl -text "Options for diff program" \
3778        -font optionfont
3779    entry $top.diffopt -width 20 -textvariable diffopts
3780    grid x $top.diffoptl $top.diffopt -sticky w
3781    frame $top.buts
3782    button $top.buts.ok -text "OK" -command prefsok
3783    button $top.buts.can -text "Cancel" -command prefscan
3784    grid $top.buts.ok $top.buts.can
3785    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3786    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3787    grid $top.buts - - -pady 10 -sticky ew
3788}
3789
3790proc prefscan {} {
3791    global maxwidth maxgraphpct diffopts findmergefiles
3792    global oldprefs prefstop
3793
3794    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3795        set $v $oldprefs($v)
3796    }
3797    catch {destroy $prefstop}
3798    unset prefstop
3799}
3800
3801proc prefsok {} {
3802    global maxwidth maxgraphpct
3803    global oldprefs prefstop
3804
3805    catch {destroy $prefstop}
3806    unset prefstop
3807    if {$maxwidth != $oldprefs(maxwidth)
3808        || $maxgraphpct != $oldprefs(maxgraphpct)} {
3809        redisplay
3810    }
3811}
3812
3813proc formatdate {d} {
3814    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3815}
3816
3817# This list of encoding names and aliases is distilled from
3818# http://www.iana.org/assignments/character-sets.
3819# Not all of them are supported by Tcl.
3820set encoding_aliases {
3821    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3822      ISO646-US US-ASCII us IBM367 cp367 csASCII }
3823    { ISO-10646-UTF-1 csISO10646UTF1 }
3824    { ISO_646.basic:1983 ref csISO646basic1983 }
3825    { INVARIANT csINVARIANT }
3826    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3827    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3828    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3829    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3830    { NATS-DANO iso-ir-9-1 csNATSDANO }
3831    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3832    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3833    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3834    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3835    { ISO-2022-KR csISO2022KR }
3836    { EUC-KR csEUCKR }
3837    { ISO-2022-JP csISO2022JP }
3838    { ISO-2022-JP-2 csISO2022JP2 }
3839    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3840      csISO13JISC6220jp }
3841    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3842    { IT iso-ir-15 ISO646-IT csISO15Italian }
3843    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3844    { ES iso-ir-17 ISO646-ES csISO17Spanish }
3845    { greek7-old iso-ir-18 csISO18Greek7Old }
3846    { latin-greek iso-ir-19 csISO19LatinGreek }
3847    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3848    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3849    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3850    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3851    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3852    { BS_viewdata iso-ir-47 csISO47BSViewdata }
3853    { INIS iso-ir-49 csISO49INIS }
3854    { INIS-8 iso-ir-50 csISO50INIS8 }
3855    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3856    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3857    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3858    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3859    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3860    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3861      csISO60Norwegian1 }
3862    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3863    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3864    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3865    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3866    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3867    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3868    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3869    { greek7 iso-ir-88 csISO88Greek7 }
3870    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3871    { iso-ir-90 csISO90 }
3872    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3873    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3874      csISO92JISC62991984b }
3875    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3876    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3877    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3878      csISO95JIS62291984handadd }
3879    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3880    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3881    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3882    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3883      CP819 csISOLatin1 }
3884    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3885    { T.61-7bit iso-ir-102 csISO102T617bit }
3886    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3887    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3888    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3889    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3890    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3891    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3892    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3893    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3894      arabic csISOLatinArabic }
3895    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3896    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3897    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3898      greek greek8 csISOLatinGreek }
3899    { T.101-G2 iso-ir-128 csISO128T101G2 }
3900    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3901      csISOLatinHebrew }
3902    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3903    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3904    { CSN_369103 iso-ir-139 csISO139CSN369103 }
3905    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3906    { ISO_6937-2-add iso-ir-142 csISOTextComm }
3907    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3908    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3909      csISOLatinCyrillic }
3910    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3911    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3912    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3913    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3914    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3915    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3916    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3917    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3918    { ISO_10367-box iso-ir-155 csISO10367Box }
3919    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3920    { latin-lap lap iso-ir-158 csISO158Lap }
3921    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3922    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3923    { us-dk csUSDK }
3924    { dk-us csDKUS }
3925    { JIS_X0201 X0201 csHalfWidthKatakana }
3926    { KSC5636 ISO646-KR csKSC5636 }
3927    { ISO-10646-UCS-2 csUnicode }
3928    { ISO-10646-UCS-4 csUCS4 }
3929    { DEC-MCS dec csDECMCS }
3930    { hp-roman8 roman8 r8 csHPRoman8 }
3931    { macintosh mac csMacintosh }
3932    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3933      csIBM037 }
3934    { IBM038 EBCDIC-INT cp038 csIBM038 }
3935    { IBM273 CP273 csIBM273 }
3936    { IBM274 EBCDIC-BE CP274 csIBM274 }
3937    { IBM275 EBCDIC-BR cp275 csIBM275 }
3938    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3939    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3940    { IBM280 CP280 ebcdic-cp-it csIBM280 }
3941    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3942    { IBM284 CP284 ebcdic-cp-es csIBM284 }
3943    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3944    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3945    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3946    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3947    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3948    { IBM424 cp424 ebcdic-cp-he csIBM424 }
3949    { IBM437 cp437 437 csPC8CodePage437 }
3950    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3951    { IBM775 cp775 csPC775Baltic }
3952    { IBM850 cp850 850 csPC850Multilingual }
3953    { IBM851 cp851 851 csIBM851 }
3954    { IBM852 cp852 852 csPCp852 }
3955    { IBM855 cp855 855 csIBM855 }
3956    { IBM857 cp857 857 csIBM857 }
3957    { IBM860 cp860 860 csIBM860 }
3958    { IBM861 cp861 861 cp-is csIBM861 }
3959    { IBM862 cp862 862 csPC862LatinHebrew }
3960    { IBM863 cp863 863 csIBM863 }
3961    { IBM864 cp864 csIBM864 }
3962    { IBM865 cp865 865 csIBM865 }
3963    { IBM866 cp866 866 csIBM866 }
3964    { IBM868 CP868 cp-ar csIBM868 }
3965    { IBM869 cp869 869 cp-gr csIBM869 }
3966    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3967    { IBM871 CP871 ebcdic-cp-is csIBM871 }
3968    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3969    { IBM891 cp891 csIBM891 }
3970    { IBM903 cp903 csIBM903 }
3971    { IBM904 cp904 904 csIBBM904 }
3972    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3973    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3974    { IBM1026 CP1026 csIBM1026 }
3975    { EBCDIC-AT-DE csIBMEBCDICATDE }
3976    { EBCDIC-AT-DE-A csEBCDICATDEA }
3977    { EBCDIC-CA-FR csEBCDICCAFR }
3978    { EBCDIC-DK-NO csEBCDICDKNO }
3979    { EBCDIC-DK-NO-A csEBCDICDKNOA }
3980    { EBCDIC-FI-SE csEBCDICFISE }
3981    { EBCDIC-FI-SE-A csEBCDICFISEA }
3982    { EBCDIC-FR csEBCDICFR }
3983    { EBCDIC-IT csEBCDICIT }
3984    { EBCDIC-PT csEBCDICPT }
3985    { EBCDIC-ES csEBCDICES }
3986    { EBCDIC-ES-A csEBCDICESA }
3987    { EBCDIC-ES-S csEBCDICESS }
3988    { EBCDIC-UK csEBCDICUK }
3989    { EBCDIC-US csEBCDICUS }
3990    { UNKNOWN-8BIT csUnknown8BiT }
3991    { MNEMONIC csMnemonic }
3992    { MNEM csMnem }
3993    { VISCII csVISCII }
3994    { VIQR csVIQR }
3995    { KOI8-R csKOI8R }
3996    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3997    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3998    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3999    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4000    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4001    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4002    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4003    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4004    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4005    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4006    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4007    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4008    { IBM1047 IBM-1047 }
4009    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4010    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4011    { UNICODE-1-1 csUnicode11 }
4012    { CESU-8 csCESU-8 }
4013    { BOCU-1 csBOCU-1 }
4014    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4015    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4016      l8 }
4017    { ISO-8859-15 ISO_8859-15 Latin-9 }
4018    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4019    { GBK CP936 MS936 windows-936 }
4020    { JIS_Encoding csJISEncoding }
4021    { Shift_JIS MS_Kanji csShiftJIS }
4022    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4023      EUC-JP }
4024    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4025    { ISO-10646-UCS-Basic csUnicodeASCII }
4026    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4027    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4028    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4029    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4030    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4031    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4032    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4033    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4034    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4035    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4036    { Adobe-Standard-Encoding csAdobeStandardEncoding }
4037    { Ventura-US csVenturaUS }
4038    { Ventura-International csVenturaInternational }
4039    { PC8-Danish-Norwegian csPC8DanishNorwegian }
4040    { PC8-Turkish csPC8Turkish }
4041    { IBM-Symbols csIBMSymbols }
4042    { IBM-Thai csIBMThai }
4043    { HP-Legal csHPLegal }
4044    { HP-Pi-font csHPPiFont }
4045    { HP-Math8 csHPMath8 }
4046    { Adobe-Symbol-Encoding csHPPSMath }
4047    { HP-DeskTop csHPDesktop }
4048    { Ventura-Math csVenturaMath }
4049    { Microsoft-Publishing csMicrosoftPublishing }
4050    { Windows-31J csWindows31J }
4051    { GB2312 csGB2312 }
4052    { Big5 csBig5 }
4053}
4054
4055proc tcl_encoding {enc} {
4056    global encoding_aliases
4057    set names [encoding names]
4058    set lcnames [string tolower $names]
4059    set enc [string tolower $enc]
4060    set i [lsearch -exact $lcnames $enc]
4061    if {$i < 0} {
4062        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4063        if {[regsub {^iso[-_]} $enc iso encx]} {
4064            set i [lsearch -exact $lcnames $encx]
4065        }
4066    }
4067    if {$i < 0} {
4068        foreach l $encoding_aliases {
4069            set ll [string tolower $l]
4070            if {[lsearch -exact $ll $enc] < 0} continue
4071            # look through the aliases for one that tcl knows about
4072            foreach e $ll {
4073                set i [lsearch -exact $lcnames $e]
4074                if {$i < 0} {
4075                    if {[regsub {^iso[-_]} $e iso ex]} {
4076                        set i [lsearch -exact $lcnames $ex]
4077                    }
4078                }
4079                if {$i >= 0} break
4080            }
4081            break
4082        }
4083    }
4084    if {$i >= 0} {
4085        return [lindex $names $i]
4086    }
4087    return {}
4088}
4089
4090# defaults...
4091set datemode 0
4092set diffopts "-U 5 -p"
4093set wrcomcmd "git-diff-tree --stdin -p --pretty"
4094
4095set gitencoding {}
4096catch {
4097    set gitencoding [exec git-repo-config --get i18n.commitencoding]
4098}
4099if {$gitencoding == ""} {
4100    set gitencoding "utf-8"
4101}
4102set tclencoding [tcl_encoding $gitencoding]
4103if {$tclencoding == {}} {
4104    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4105}
4106
4107set mainfont {Helvetica 9}
4108set textfont {Courier 9}
4109set findmergefiles 0
4110set maxgraphpct 50
4111set maxwidth 16
4112set revlistorder 0
4113set fastdate 0
4114
4115set colors {green red blue magenta darkgrey brown orange}
4116
4117catch {source ~/.gitk}
4118
4119set namefont $mainfont
4120
4121font create optionfont -family sans-serif -size -12
4122
4123set revtreeargs {}
4124foreach arg $argv {
4125    switch -regexp -- $arg {
4126        "^$" { }
4127        "^-d" { set datemode 1 }
4128        "^-r" { set revlistorder 1 }
4129        default {
4130            lappend revtreeargs $arg
4131        }
4132    }
4133}
4134
4135set history {}
4136set historyindex 0
4137
4138set stopped 0
4139set redisplaying 0
4140set stuffsaved 0
4141set patchnum 0
4142setcoords
4143makewindow $revtreeargs
4144readrefs
4145getcommits $revtreeargs