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