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