34f55bc1ecb4424cd481d5ab316fe6fc7fc56c6e
   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    global findinprogress
1624
1625    if {$commitidx > 0} {
1626        drawrest
1627    } else {
1628        $canv delete all
1629        $canv create text 3 3 -anchor nw -text "No commits selected" \
1630            -font $mainfont -tags textitems
1631    }
1632    if {![info exists findinprogress]} {
1633        . config -cursor $maincursor
1634        settextcursor $textcursor
1635    }
1636    set phase {}
1637}
1638
1639# Don't change the text pane cursor if it is currently the hand cursor,
1640# showing that we are over a sha1 ID link.
1641proc settextcursor {c} {
1642    global ctext curtextcursor
1643
1644    if {[$ctext cget -cursor] == $curtextcursor} {
1645        $ctext config -cursor $c
1646    }
1647    set curtextcursor $c
1648}
1649
1650proc drawrest {} {
1651    global numcommits
1652    global startmsecs
1653    global canvy0 numcommits linespc
1654    global rowlaidout commitidx
1655
1656    set row $rowlaidout
1657    layoutrows $rowlaidout $commitidx 1
1658    layouttail
1659    optimize_rows $row 0 $commitidx
1660    showstuff $commitidx
1661
1662    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1663    puts "overall $drawmsecs ms for $numcommits commits"
1664}
1665
1666proc findmatches {f} {
1667    global findtype foundstring foundstrlen
1668    if {$findtype == "Regexp"} {
1669        set matches [regexp -indices -all -inline $foundstring $f]
1670    } else {
1671        if {$findtype == "IgnCase"} {
1672            set str [string tolower $f]
1673        } else {
1674            set str $f
1675        }
1676        set matches {}
1677        set i 0
1678        while {[set j [string first $foundstring $str $i]] >= 0} {
1679            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1680            set i [expr {$j + $foundstrlen}]
1681        }
1682    }
1683    return $matches
1684}
1685
1686proc dofind {} {
1687    global findtype findloc findstring markedmatches commitinfo
1688    global numcommits displayorder linehtag linentag linedtag
1689    global mainfont namefont canv canv2 canv3 selectedline
1690    global matchinglines foundstring foundstrlen matchstring
1691    global commitdata
1692
1693    stopfindproc
1694    unmarkmatches
1695    focus .
1696    set matchinglines {}
1697    if {$findloc == "Pickaxe"} {
1698        findpatches
1699        return
1700    }
1701    if {$findtype == "IgnCase"} {
1702        set foundstring [string tolower $findstring]
1703    } else {
1704        set foundstring $findstring
1705    }
1706    set foundstrlen [string length $findstring]
1707    if {$foundstrlen == 0} return
1708    regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1709    set matchstring "*$matchstring*"
1710    if {$findloc == "Files"} {
1711        findfiles
1712        return
1713    }
1714    if {![info exists selectedline]} {
1715        set oldsel -1
1716    } else {
1717        set oldsel $selectedline
1718    }
1719    set didsel 0
1720    set fldtypes {Headline Author Date Committer CDate Comment}
1721    set l -1
1722    foreach id $displayorder {
1723        set d $commitdata($id)
1724        incr l
1725        if {$findtype == "Regexp"} {
1726            set doesmatch [regexp $foundstring $d]
1727        } elseif {$findtype == "IgnCase"} {
1728            set doesmatch [string match -nocase $matchstring $d]
1729        } else {
1730            set doesmatch [string match $matchstring $d]
1731        }
1732        if {!$doesmatch} continue
1733        if {![info exists commitinfo($id)]} {
1734            getcommit $id
1735        }
1736        set info $commitinfo($id)
1737        set doesmatch 0
1738        foreach f $info ty $fldtypes {
1739            if {$findloc != "All fields" && $findloc != $ty} {
1740                continue
1741            }
1742            set matches [findmatches $f]
1743            if {$matches == {}} continue
1744            set doesmatch 1
1745            if {$ty == "Headline"} {
1746                drawcmitrow $l
1747                markmatches $canv $l $f $linehtag($l) $matches $mainfont
1748            } elseif {$ty == "Author"} {
1749                drawcmitrow $l
1750                markmatches $canv2 $l $f $linentag($l) $matches $namefont
1751            } elseif {$ty == "Date"} {
1752                drawcmitrow $l
1753                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1754            }
1755        }
1756        if {$doesmatch} {
1757            lappend matchinglines $l
1758            if {!$didsel && $l > $oldsel} {
1759                findselectline $l
1760                set didsel 1
1761            }
1762        }
1763    }
1764    if {$matchinglines == {}} {
1765        bell
1766    } elseif {!$didsel} {
1767        findselectline [lindex $matchinglines 0]
1768    }
1769}
1770
1771proc findselectline {l} {
1772    global findloc commentend ctext
1773    selectline $l 1
1774    if {$findloc == "All fields" || $findloc == "Comments"} {
1775        # highlight the matches in the comments
1776        set f [$ctext get 1.0 $commentend]
1777        set matches [findmatches $f]
1778        foreach match $matches {
1779            set start [lindex $match 0]
1780            set end [expr {[lindex $match 1] + 1}]
1781            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1782        }
1783    }
1784}
1785
1786proc findnext {restart} {
1787    global matchinglines selectedline
1788    if {![info exists matchinglines]} {
1789        if {$restart} {
1790            dofind
1791        }
1792        return
1793    }
1794    if {![info exists selectedline]} return
1795    foreach l $matchinglines {
1796        if {$l > $selectedline} {
1797            findselectline $l
1798            return
1799        }
1800    }
1801    bell
1802}
1803
1804proc findprev {} {
1805    global matchinglines selectedline
1806    if {![info exists matchinglines]} {
1807        dofind
1808        return
1809    }
1810    if {![info exists selectedline]} return
1811    set prev {}
1812    foreach l $matchinglines {
1813        if {$l >= $selectedline} break
1814        set prev $l
1815    }
1816    if {$prev != {}} {
1817        findselectline $prev
1818    } else {
1819        bell
1820    }
1821}
1822
1823proc findlocchange {name ix op} {
1824    global findloc findtype findtypemenu
1825    if {$findloc == "Pickaxe"} {
1826        set findtype Exact
1827        set state disabled
1828    } else {
1829        set state normal
1830    }
1831    $findtypemenu entryconf 1 -state $state
1832    $findtypemenu entryconf 2 -state $state
1833}
1834
1835proc stopfindproc {{done 0}} {
1836    global findprocpid findprocfile findids
1837    global ctext findoldcursor phase maincursor textcursor
1838    global findinprogress
1839
1840    catch {unset findids}
1841    if {[info exists findprocpid]} {
1842        if {!$done} {
1843            catch {exec kill $findprocpid}
1844        }
1845        catch {close $findprocfile}
1846        unset findprocpid
1847    }
1848    if {[info exists findinprogress]} {
1849        unset findinprogress
1850        if {$phase != "incrdraw"} {
1851            . config -cursor $maincursor
1852            settextcursor $textcursor
1853        }
1854    }
1855}
1856
1857proc findpatches {} {
1858    global findstring selectedline numcommits
1859    global findprocpid findprocfile
1860    global finddidsel ctext displayorder findinprogress
1861    global findinsertpos
1862
1863    if {$numcommits == 0} return
1864
1865    # make a list of all the ids to search, starting at the one
1866    # after the selected line (if any)
1867    if {[info exists selectedline]} {
1868        set l $selectedline
1869    } else {
1870        set l -1
1871    }
1872    set inputids {}
1873    for {set i 0} {$i < $numcommits} {incr i} {
1874        if {[incr l] >= $numcommits} {
1875            set l 0
1876        }
1877        append inputids [lindex $displayorder $l] "\n"
1878    }
1879
1880    if {[catch {
1881        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1882                         << $inputids] r]
1883    } err]} {
1884        error_popup "Error starting search process: $err"
1885        return
1886    }
1887
1888    set findinsertpos end
1889    set findprocfile $f
1890    set findprocpid [pid $f]
1891    fconfigure $f -blocking 0
1892    fileevent $f readable readfindproc
1893    set finddidsel 0
1894    . config -cursor watch
1895    settextcursor watch
1896    set findinprogress 1
1897}
1898
1899proc readfindproc {} {
1900    global findprocfile finddidsel
1901    global commitrow matchinglines findinsertpos
1902
1903    set n [gets $findprocfile line]
1904    if {$n < 0} {
1905        if {[eof $findprocfile]} {
1906            stopfindproc 1
1907            if {!$finddidsel} {
1908                bell
1909            }
1910        }
1911        return
1912    }
1913    if {![regexp {^[0-9a-f]{40}} $line id]} {
1914        error_popup "Can't parse git-diff-tree output: $line"
1915        stopfindproc
1916        return
1917    }
1918    if {![info exists commitrow($id)]} {
1919        puts stderr "spurious id: $id"
1920        return
1921    }
1922    set l $commitrow($id)
1923    insertmatch $l $id
1924}
1925
1926proc insertmatch {l id} {
1927    global matchinglines findinsertpos finddidsel
1928
1929    if {$findinsertpos == "end"} {
1930        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1931            set matchinglines [linsert $matchinglines 0 $l]
1932            set findinsertpos 1
1933        } else {
1934            lappend matchinglines $l
1935        }
1936    } else {
1937        set matchinglines [linsert $matchinglines $findinsertpos $l]
1938        incr findinsertpos
1939    }
1940    markheadline $l $id
1941    if {!$finddidsel} {
1942        findselectline $l
1943        set finddidsel 1
1944    }
1945}
1946
1947proc findfiles {} {
1948    global selectedline numcommits displayorder ctext
1949    global ffileline finddidsel parents nparents
1950    global findinprogress findstartline findinsertpos
1951    global treediffs fdiffid fdiffsneeded fdiffpos
1952    global findmergefiles
1953
1954    if {$numcommits == 0} return
1955
1956    if {[info exists selectedline]} {
1957        set l [expr {$selectedline + 1}]
1958    } else {
1959        set l 0
1960    }
1961    set ffileline $l
1962    set findstartline $l
1963    set diffsneeded {}
1964    set fdiffsneeded {}
1965    while 1 {
1966        set id [lindex $displayorder $l]
1967        if {$findmergefiles || $nparents($id) == 1} {
1968            if {![info exists treediffs($id)]} {
1969                append diffsneeded "$id\n"
1970                lappend fdiffsneeded $id
1971            }
1972        }
1973        if {[incr l] >= $numcommits} {
1974            set l 0
1975        }
1976        if {$l == $findstartline} break
1977    }
1978
1979    # start off a git-diff-tree process if needed
1980    if {$diffsneeded ne {}} {
1981        if {[catch {
1982            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1983        } err ]} {
1984            error_popup "Error starting search process: $err"
1985            return
1986        }
1987        catch {unset fdiffid}
1988        set fdiffpos 0
1989        fconfigure $df -blocking 0
1990        fileevent $df readable [list readfilediffs $df]
1991    }
1992
1993    set finddidsel 0
1994    set findinsertpos end
1995    set id [lindex $displayorder $l]
1996    . config -cursor watch
1997    settextcursor watch
1998    set findinprogress 1
1999    findcont $id
2000    update
2001}
2002
2003proc readfilediffs {df} {
2004    global findid fdiffid fdiffs
2005
2006    set n [gets $df line]
2007    if {$n < 0} {
2008        if {[eof $df]} {
2009            donefilediff
2010            if {[catch {close $df} err]} {
2011                stopfindproc
2012                bell
2013                error_popup "Error in git-diff-tree: $err"
2014            } elseif {[info exists findid]} {
2015                set id $findid
2016                stopfindproc
2017                bell
2018                error_popup "Couldn't find diffs for $id"
2019            }
2020        }
2021        return
2022    }
2023    if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2024        # start of a new string of diffs
2025        donefilediff
2026        set fdiffid $id
2027        set fdiffs {}
2028    } elseif {[string match ":*" $line]} {
2029        lappend fdiffs [lindex $line 5]
2030    }
2031}
2032
2033proc donefilediff {} {
2034    global fdiffid fdiffs treediffs findid
2035    global fdiffsneeded fdiffpos
2036
2037    if {[info exists fdiffid]} {
2038        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2039               && $fdiffpos < [llength $fdiffsneeded]} {
2040            # git-diff-tree doesn't output anything for a commit
2041            # which doesn't change anything
2042            set nullid [lindex $fdiffsneeded $fdiffpos]
2043            set treediffs($nullid) {}
2044            if {[info exists findid] && $nullid eq $findid} {
2045                unset findid
2046                findcont $nullid
2047            }
2048            incr fdiffpos
2049        }
2050        incr fdiffpos
2051
2052        if {![info exists treediffs($fdiffid)]} {
2053            set treediffs($fdiffid) $fdiffs
2054        }
2055        if {[info exists findid] && $fdiffid eq $findid} {
2056            unset findid
2057            findcont $fdiffid
2058        }
2059    }
2060}
2061
2062proc findcont {id} {
2063    global findid treediffs parents nparents
2064    global ffileline findstartline finddidsel
2065    global displayorder numcommits matchinglines findinprogress
2066    global findmergefiles
2067
2068    set l $ffileline
2069    while 1 {
2070        if {$findmergefiles || $nparents($id) == 1} {
2071            if {![info exists treediffs($id)]} {
2072                set findid $id
2073                set ffileline $l
2074                return
2075            }
2076            set doesmatch 0
2077            foreach f $treediffs($id) {
2078                set x [findmatches $f]
2079                if {$x != {}} {
2080                    set doesmatch 1
2081                    break
2082                }
2083            }
2084            if {$doesmatch} {
2085                insertmatch $l $id
2086            }
2087        }
2088        if {[incr l] >= $numcommits} {
2089            set l 0
2090        }
2091        if {$l == $findstartline} break
2092        set id [lindex $displayorder $l]
2093    }
2094    stopfindproc
2095    if {!$finddidsel} {
2096        bell
2097    }
2098}
2099
2100# mark a commit as matching by putting a yellow background
2101# behind the headline
2102proc markheadline {l id} {
2103    global canv mainfont linehtag
2104
2105    drawcmitrow $l
2106    set bbox [$canv bbox $linehtag($l)]
2107    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2108    $canv lower $t
2109}
2110
2111# mark the bits of a headline, author or date that match a find string
2112proc markmatches {canv l str tag matches font} {
2113    set bbox [$canv bbox $tag]
2114    set x0 [lindex $bbox 0]
2115    set y0 [lindex $bbox 1]
2116    set y1 [lindex $bbox 3]
2117    foreach match $matches {
2118        set start [lindex $match 0]
2119        set end [lindex $match 1]
2120        if {$start > $end} continue
2121        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2122        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2123        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2124                   [expr {$x0+$xlen+2}] $y1 \
2125                   -outline {} -tags matches -fill yellow]
2126        $canv lower $t
2127    }
2128}
2129
2130proc unmarkmatches {} {
2131    global matchinglines findids
2132    allcanvs delete matches
2133    catch {unset matchinglines}
2134    catch {unset findids}
2135}
2136
2137proc selcanvline {w x y} {
2138    global canv canvy0 ctext linespc
2139    global rowtextx
2140    set ymax [lindex [$canv cget -scrollregion] 3]
2141    if {$ymax == {}} return
2142    set yfrac [lindex [$canv yview] 0]
2143    set y [expr {$y + $yfrac * $ymax}]
2144    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2145    if {$l < 0} {
2146        set l 0
2147    }
2148    if {$w eq $canv} {
2149        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2150    }
2151    unmarkmatches
2152    selectline $l 1
2153}
2154
2155proc commit_descriptor {p} {
2156    global commitinfo
2157    set l "..."
2158    if {[info exists commitinfo($p)]} {
2159        set l [lindex $commitinfo($p) 0]
2160    }
2161    return "$p ($l)"
2162}
2163
2164# append some text to the ctext widget, and make any SHA1 ID
2165# that we know about be a clickable link.
2166proc appendwithlinks {text} {
2167    global ctext commitrow linknum
2168
2169    set start [$ctext index "end - 1c"]
2170    $ctext insert end $text
2171    $ctext insert end "\n"
2172    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2173    foreach l $links {
2174        set s [lindex $l 0]
2175        set e [lindex $l 1]
2176        set linkid [string range $text $s $e]
2177        if {![info exists commitrow($linkid)]} continue
2178        incr e
2179        $ctext tag add link "$start + $s c" "$start + $e c"
2180        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2181        $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2182        incr linknum
2183    }
2184    $ctext tag conf link -foreground blue -underline 1
2185    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2186    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2187}
2188
2189proc selectline {l isnew} {
2190    global canv canv2 canv3 ctext commitinfo selectedline
2191    global displayorder linehtag linentag linedtag
2192    global canvy0 linespc parents nparents children
2193    global cflist currentid sha1entry
2194    global commentend idtags linknum
2195    global mergemax numcommits
2196
2197    $canv delete hover
2198    normalline
2199    if {$l < 0 || $l >= $numcommits} return
2200    set y [expr {$canvy0 + $l * $linespc}]
2201    set ymax [lindex [$canv cget -scrollregion] 3]
2202    set ytop [expr {$y - $linespc - 1}]
2203    set ybot [expr {$y + $linespc + 1}]
2204    set wnow [$canv yview]
2205    set wtop [expr {[lindex $wnow 0] * $ymax}]
2206    set wbot [expr {[lindex $wnow 1] * $ymax}]
2207    set wh [expr {$wbot - $wtop}]
2208    set newtop $wtop
2209    if {$ytop < $wtop} {
2210        if {$ybot < $wtop} {
2211            set newtop [expr {$y - $wh / 2.0}]
2212        } else {
2213            set newtop $ytop
2214            if {$newtop > $wtop - $linespc} {
2215                set newtop [expr {$wtop - $linespc}]
2216            }
2217        }
2218    } elseif {$ybot > $wbot} {
2219        if {$ytop > $wbot} {
2220            set newtop [expr {$y - $wh / 2.0}]
2221        } else {
2222            set newtop [expr {$ybot - $wh}]
2223            if {$newtop < $wtop + $linespc} {
2224                set newtop [expr {$wtop + $linespc}]
2225            }
2226        }
2227    }
2228    if {$newtop != $wtop} {
2229        if {$newtop < 0} {
2230            set newtop 0
2231        }
2232        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2233        drawvisible
2234    }
2235
2236    if {![info exists linehtag($l)]} return
2237    $canv delete secsel
2238    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2239               -tags secsel -fill [$canv cget -selectbackground]]
2240    $canv lower $t
2241    $canv2 delete secsel
2242    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2243               -tags secsel -fill [$canv2 cget -selectbackground]]
2244    $canv2 lower $t
2245    $canv3 delete secsel
2246    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2247               -tags secsel -fill [$canv3 cget -selectbackground]]
2248    $canv3 lower $t
2249
2250    if {$isnew} {
2251        addtohistory [list selectline $l 0]
2252    }
2253
2254    set selectedline $l
2255
2256    set id [lindex $displayorder $l]
2257    set currentid $id
2258    $sha1entry delete 0 end
2259    $sha1entry insert 0 $id
2260    $sha1entry selection from 0
2261    $sha1entry selection to end
2262
2263    $ctext conf -state normal
2264    $ctext delete 0.0 end
2265    set linknum 0
2266    $ctext mark set fmark.0 0.0
2267    $ctext mark gravity fmark.0 left
2268    set info $commitinfo($id)
2269    set date [formatdate [lindex $info 2]]
2270    $ctext insert end "Author: [lindex $info 1]  $date\n"
2271    set date [formatdate [lindex $info 4]]
2272    $ctext insert end "Committer: [lindex $info 3]  $date\n"
2273    if {[info exists idtags($id)]} {
2274        $ctext insert end "Tags:"
2275        foreach tag $idtags($id) {
2276            $ctext insert end " $tag"
2277        }
2278        $ctext insert end "\n"
2279    }
2280 
2281    set comment {}
2282    if {$nparents($id) > 1} {
2283        set np 0
2284        foreach p $parents($id) {
2285            if {$np >= $mergemax} {
2286                set tag mmax
2287            } else {
2288                set tag m$np
2289            }
2290            $ctext insert end "Parent: " $tag
2291            appendwithlinks [commit_descriptor $p]
2292            incr np
2293        }
2294    } else {
2295        if {[info exists parents($id)]} {
2296            foreach p $parents($id) {
2297                append comment "Parent: [commit_descriptor $p]\n"
2298            }
2299        }
2300    }
2301
2302    if {[info exists children($id)]} {
2303        foreach c $children($id) {
2304            append comment "Child:  [commit_descriptor $c]\n"
2305        }
2306    }
2307    append comment "\n"
2308    append comment [lindex $info 5]
2309
2310    # make anything that looks like a SHA1 ID be a clickable link
2311    appendwithlinks $comment
2312
2313    $ctext tag delete Comments
2314    $ctext tag remove found 1.0 end
2315    $ctext conf -state disabled
2316    set commentend [$ctext index "end - 1c"]
2317
2318    $cflist delete 0 end
2319    $cflist insert end "Comments"
2320    if {$nparents($id) == 1} {
2321        startdiff $id
2322    } elseif {$nparents($id) > 1} {
2323        mergediff $id
2324    }
2325}
2326
2327proc selnextline {dir} {
2328    global selectedline
2329    if {![info exists selectedline]} return
2330    set l [expr {$selectedline + $dir}]
2331    unmarkmatches
2332    selectline $l 1
2333}
2334
2335proc unselectline {} {
2336    global selectedline
2337
2338    catch {unset selectedline}
2339    allcanvs delete secsel
2340}
2341
2342proc addtohistory {cmd} {
2343    global history historyindex
2344
2345    if {$historyindex > 0
2346        && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2347        return
2348    }
2349
2350    if {$historyindex < [llength $history]} {
2351        set history [lreplace $history $historyindex end $cmd]
2352    } else {
2353        lappend history $cmd
2354    }
2355    incr historyindex
2356    if {$historyindex > 1} {
2357        .ctop.top.bar.leftbut conf -state normal
2358    } else {
2359        .ctop.top.bar.leftbut conf -state disabled
2360    }
2361    .ctop.top.bar.rightbut conf -state disabled
2362}
2363
2364proc goback {} {
2365    global history historyindex
2366
2367    if {$historyindex > 1} {
2368        incr historyindex -1
2369        set cmd [lindex $history [expr {$historyindex - 1}]]
2370        eval $cmd
2371        .ctop.top.bar.rightbut conf -state normal
2372    }
2373    if {$historyindex <= 1} {
2374        .ctop.top.bar.leftbut conf -state disabled
2375    }
2376}
2377
2378proc goforw {} {
2379    global history historyindex
2380
2381    if {$historyindex < [llength $history]} {
2382        set cmd [lindex $history $historyindex]
2383        incr historyindex
2384        eval $cmd
2385        .ctop.top.bar.leftbut conf -state normal
2386    }
2387    if {$historyindex >= [llength $history]} {
2388        .ctop.top.bar.rightbut conf -state disabled
2389    }
2390}
2391
2392proc mergediff {id} {
2393    global parents diffmergeid diffopts mdifffd
2394    global difffilestart
2395
2396    set diffmergeid $id
2397    catch {unset difffilestart}
2398    # this doesn't seem to actually affect anything...
2399    set env(GIT_DIFF_OPTS) $diffopts
2400    set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2401    if {[catch {set mdf [open $cmd r]} err]} {
2402        error_popup "Error getting merge diffs: $err"
2403        return
2404    }
2405    fconfigure $mdf -blocking 0
2406    set mdifffd($id) $mdf
2407    fileevent $mdf readable [list getmergediffline $mdf $id]
2408    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2409}
2410
2411proc getmergediffline {mdf id} {
2412    global diffmergeid ctext cflist nextupdate nparents mergemax
2413    global difffilestart
2414
2415    set n [gets $mdf line]
2416    if {$n < 0} {
2417        if {[eof $mdf]} {
2418            close $mdf
2419        }
2420        return
2421    }
2422    if {![info exists diffmergeid] || $id != $diffmergeid} {
2423        return
2424    }
2425    $ctext conf -state normal
2426    if {[regexp {^diff --cc (.*)} $line match fname]} {
2427        # start of a new file
2428        $ctext insert end "\n"
2429        set here [$ctext index "end - 1c"]
2430        set i [$cflist index end]
2431        $ctext mark set fmark.$i $here
2432        $ctext mark gravity fmark.$i left
2433        set difffilestart([expr {$i-1}]) $here
2434        $cflist insert end $fname
2435        set l [expr {(78 - [string length $fname]) / 2}]
2436        set pad [string range "----------------------------------------" 1 $l]
2437        $ctext insert end "$pad $fname $pad\n" filesep
2438    } elseif {[regexp {^@@} $line]} {
2439        $ctext insert end "$line\n" hunksep
2440    } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2441        # do nothing
2442    } else {
2443        # parse the prefix - one ' ', '-' or '+' for each parent
2444        set np $nparents($id)
2445        set spaces {}
2446        set minuses {}
2447        set pluses {}
2448        set isbad 0
2449        for {set j 0} {$j < $np} {incr j} {
2450            set c [string range $line $j $j]
2451            if {$c == " "} {
2452                lappend spaces $j
2453            } elseif {$c == "-"} {
2454                lappend minuses $j
2455            } elseif {$c == "+"} {
2456                lappend pluses $j
2457            } else {
2458                set isbad 1
2459                break
2460            }
2461        }
2462        set tags {}
2463        set num {}
2464        if {!$isbad && $minuses ne {} && $pluses eq {}} {
2465            # line doesn't appear in result, parents in $minuses have the line
2466            set num [lindex $minuses 0]
2467        } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2468            # line appears in result, parents in $pluses don't have the line
2469            lappend tags mresult
2470            set num [lindex $spaces 0]
2471        }
2472        if {$num ne {}} {
2473            if {$num >= $mergemax} {
2474                set num "max"
2475            }
2476            lappend tags m$num
2477        }
2478        $ctext insert end "$line\n" $tags
2479    }
2480    $ctext conf -state disabled
2481    if {[clock clicks -milliseconds] >= $nextupdate} {
2482        incr nextupdate 100
2483        fileevent $mdf readable {}
2484        update
2485        fileevent $mdf readable [list getmergediffline $mdf $id]
2486    }
2487}
2488
2489proc startdiff {ids} {
2490    global treediffs diffids treepending diffmergeid
2491
2492    set diffids $ids
2493    catch {unset diffmergeid}
2494    if {![info exists treediffs($ids)]} {
2495        if {![info exists treepending]} {
2496            gettreediffs $ids
2497        }
2498    } else {
2499        addtocflist $ids
2500    }
2501}
2502
2503proc addtocflist {ids} {
2504    global treediffs cflist
2505    foreach f $treediffs($ids) {
2506        $cflist insert end $f
2507    }
2508    getblobdiffs $ids
2509}
2510
2511proc gettreediffs {ids} {
2512    global treediff parents treepending
2513    set treepending $ids
2514    set treediff {}
2515    if {[catch \
2516         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2517        ]} return
2518    fconfigure $gdtf -blocking 0
2519    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2520}
2521
2522proc gettreediffline {gdtf ids} {
2523    global treediff treediffs treepending diffids diffmergeid
2524
2525    set n [gets $gdtf line]
2526    if {$n < 0} {
2527        if {![eof $gdtf]} return
2528        close $gdtf
2529        set treediffs($ids) $treediff
2530        unset treepending
2531        if {$ids != $diffids} {
2532            gettreediffs $diffids
2533        } else {
2534            if {[info exists diffmergeid]} {
2535                contmergediff $ids
2536            } else {
2537                addtocflist $ids
2538            }
2539        }
2540        return
2541    }
2542    set file [lindex $line 5]
2543    lappend treediff $file
2544}
2545
2546proc getblobdiffs {ids} {
2547    global diffopts blobdifffd diffids env curdifftag curtagstart
2548    global difffilestart nextupdate diffinhdr treediffs
2549
2550    set env(GIT_DIFF_OPTS) $diffopts
2551    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2552    if {[catch {set bdf [open $cmd r]} err]} {
2553        puts "error getting diffs: $err"
2554        return
2555    }
2556    set diffinhdr 0
2557    fconfigure $bdf -blocking 0
2558    set blobdifffd($ids) $bdf
2559    set curdifftag Comments
2560    set curtagstart 0.0
2561    catch {unset difffilestart}
2562    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2563    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2564}
2565
2566proc getblobdiffline {bdf ids} {
2567    global diffids blobdifffd ctext curdifftag curtagstart
2568    global diffnexthead diffnextnote difffilestart
2569    global nextupdate diffinhdr treediffs
2570
2571    set n [gets $bdf line]
2572    if {$n < 0} {
2573        if {[eof $bdf]} {
2574            close $bdf
2575            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2576                $ctext tag add $curdifftag $curtagstart end
2577            }
2578        }
2579        return
2580    }
2581    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2582        return
2583    }
2584    $ctext conf -state normal
2585    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2586        # start of a new file
2587        $ctext insert end "\n"
2588        $ctext tag add $curdifftag $curtagstart end
2589        set curtagstart [$ctext index "end - 1c"]
2590        set header $newname
2591        set here [$ctext index "end - 1c"]
2592        set i [lsearch -exact $treediffs($diffids) $fname]
2593        if {$i >= 0} {
2594            set difffilestart($i) $here
2595            incr i
2596            $ctext mark set fmark.$i $here
2597            $ctext mark gravity fmark.$i left
2598        }
2599        if {$newname != $fname} {
2600            set i [lsearch -exact $treediffs($diffids) $newname]
2601            if {$i >= 0} {
2602                set difffilestart($i) $here
2603                incr i
2604                $ctext mark set fmark.$i $here
2605                $ctext mark gravity fmark.$i left
2606            }
2607        }
2608        set curdifftag "f:$fname"
2609        $ctext tag delete $curdifftag
2610        set l [expr {(78 - [string length $header]) / 2}]
2611        set pad [string range "----------------------------------------" 1 $l]
2612        $ctext insert end "$pad $header $pad\n" filesep
2613        set diffinhdr 1
2614    } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2615        # do nothing
2616    } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2617        set diffinhdr 0
2618    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2619                   $line match f1l f1c f2l f2c rest]} {
2620        $ctext insert end "$line\n" hunksep
2621        set diffinhdr 0
2622    } else {
2623        set x [string range $line 0 0]
2624        if {$x == "-" || $x == "+"} {
2625            set tag [expr {$x == "+"}]
2626            $ctext insert end "$line\n" d$tag
2627        } elseif {$x == " "} {
2628            $ctext insert end "$line\n"
2629        } elseif {$diffinhdr || $x == "\\"} {
2630            # e.g. "\ No newline at end of file"
2631            $ctext insert end "$line\n" filesep
2632        } else {
2633            # Something else we don't recognize
2634            if {$curdifftag != "Comments"} {
2635                $ctext insert end "\n"
2636                $ctext tag add $curdifftag $curtagstart end
2637                set curtagstart [$ctext index "end - 1c"]
2638                set curdifftag Comments
2639            }
2640            $ctext insert end "$line\n" filesep
2641        }
2642    }
2643    $ctext conf -state disabled
2644    if {[clock clicks -milliseconds] >= $nextupdate} {
2645        incr nextupdate 100
2646        fileevent $bdf readable {}
2647        update
2648        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2649    }
2650}
2651
2652proc nextfile {} {
2653    global difffilestart ctext
2654    set here [$ctext index @0,0]
2655    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2656        if {[$ctext compare $difffilestart($i) > $here]} {
2657            if {![info exists pos]
2658                || [$ctext compare $difffilestart($i) < $pos]} {
2659                set pos $difffilestart($i)
2660            }
2661        }
2662    }
2663    if {[info exists pos]} {
2664        $ctext yview $pos
2665    }
2666}
2667
2668proc listboxsel {} {
2669    global ctext cflist currentid
2670    if {![info exists currentid]} return
2671    set sel [lsort [$cflist curselection]]
2672    if {$sel eq {}} return
2673    set first [lindex $sel 0]
2674    catch {$ctext yview fmark.$first}
2675}
2676
2677proc setcoords {} {
2678    global linespc charspc canvx0 canvy0 mainfont
2679    global xspc1 xspc2 lthickness
2680
2681    set linespc [font metrics $mainfont -linespace]
2682    set charspc [font measure $mainfont "m"]
2683    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2684    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2685    set lthickness [expr {int($linespc / 9) + 1}]
2686    set xspc1(0) $linespc
2687    set xspc2 $linespc
2688}
2689
2690proc redisplay {} {
2691    global canv canvy0 linespc numcommits
2692    global selectedline
2693
2694    set ymax [lindex [$canv cget -scrollregion] 3]
2695    if {$ymax eq {} || $ymax == 0} return
2696    set span [$canv yview]
2697    clear_display
2698    allcanvs conf -scrollregion \
2699        [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2700    allcanvs yview moveto [lindex $span 0]
2701    drawvisible
2702    if {[info exists selectedline]} {
2703        selectline $selectedline 0
2704    }
2705}
2706
2707proc incrfont {inc} {
2708    global mainfont namefont textfont ctext canv phase
2709    global stopped entries
2710    unmarkmatches
2711    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2712    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2713    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2714    setcoords
2715    $ctext conf -font $textfont
2716    $ctext tag conf filesep -font [concat $textfont bold]
2717    foreach e $entries {
2718        $e conf -font $mainfont
2719    }
2720    if {$phase == "getcommits"} {
2721        $canv itemconf textitems -font $mainfont
2722    }
2723    redisplay
2724}
2725
2726proc clearsha1 {} {
2727    global sha1entry sha1string
2728    if {[string length $sha1string] == 40} {
2729        $sha1entry delete 0 end
2730    }
2731}
2732
2733proc sha1change {n1 n2 op} {
2734    global sha1string currentid sha1but
2735    if {$sha1string == {}
2736        || ([info exists currentid] && $sha1string == $currentid)} {
2737        set state disabled
2738    } else {
2739        set state normal
2740    }
2741    if {[$sha1but cget -state] == $state} return
2742    if {$state == "normal"} {
2743        $sha1but conf -state normal -relief raised -text "Goto: "
2744    } else {
2745        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2746    }
2747}
2748
2749proc gotocommit {} {
2750    global sha1string currentid commitrow tagids
2751    global displayorder numcommits
2752
2753    if {$sha1string == {}
2754        || ([info exists currentid] && $sha1string == $currentid)} return
2755    if {[info exists tagids($sha1string)]} {
2756        set id $tagids($sha1string)
2757    } else {
2758        set id [string tolower $sha1string]
2759        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2760            set matches {}
2761            foreach i $displayorder {
2762                if {[string match $id* $i]} {
2763                    lappend matches $i
2764                }
2765            }
2766            if {$matches ne {}} {
2767                if {[llength $matches] > 1} {
2768                    error_popup "Short SHA1 id $id is ambiguous"
2769                    return
2770                }
2771                set id [lindex $matches 0]
2772            }
2773        }
2774    }
2775    if {[info exists commitrow($id)]} {
2776        selectline $commitrow($id) 1
2777        return
2778    }
2779    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2780        set type "SHA1 id"
2781    } else {
2782        set type "Tag"
2783    }
2784    error_popup "$type $sha1string is not known"
2785}
2786
2787proc lineenter {x y id} {
2788    global hoverx hovery hoverid hovertimer
2789    global commitinfo canv
2790
2791    if {![info exists commitinfo($id)] && ![getcommit $id]} return
2792    set hoverx $x
2793    set hovery $y
2794    set hoverid $id
2795    if {[info exists hovertimer]} {
2796        after cancel $hovertimer
2797    }
2798    set hovertimer [after 500 linehover]
2799    $canv delete hover
2800}
2801
2802proc linemotion {x y id} {
2803    global hoverx hovery hoverid hovertimer
2804
2805    if {[info exists hoverid] && $id == $hoverid} {
2806        set hoverx $x
2807        set hovery $y
2808        if {[info exists hovertimer]} {
2809            after cancel $hovertimer
2810        }
2811        set hovertimer [after 500 linehover]
2812    }
2813}
2814
2815proc lineleave {id} {
2816    global hoverid hovertimer canv
2817
2818    if {[info exists hoverid] && $id == $hoverid} {
2819        $canv delete hover
2820        if {[info exists hovertimer]} {
2821            after cancel $hovertimer
2822            unset hovertimer
2823        }
2824        unset hoverid
2825    }
2826}
2827
2828proc linehover {} {
2829    global hoverx hovery hoverid hovertimer
2830    global canv linespc lthickness
2831    global commitinfo mainfont
2832
2833    set text [lindex $commitinfo($hoverid) 0]
2834    set ymax [lindex [$canv cget -scrollregion] 3]
2835    if {$ymax == {}} return
2836    set yfrac [lindex [$canv yview] 0]
2837    set x [expr {$hoverx + 2 * $linespc}]
2838    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2839    set x0 [expr {$x - 2 * $lthickness}]
2840    set y0 [expr {$y - 2 * $lthickness}]
2841    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2842    set y1 [expr {$y + $linespc + 2 * $lthickness}]
2843    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2844               -fill \#ffff80 -outline black -width 1 -tags hover]
2845    $canv raise $t
2846    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2847    $canv raise $t
2848}
2849
2850proc clickisonarrow {id y} {
2851    global lthickness idrowranges
2852
2853    set thresh [expr {2 * $lthickness + 6}]
2854    set n [expr {[llength $idrowranges($id)] - 1}]
2855    for {set i 1} {$i < $n} {incr i} {
2856        set row [lindex $idrowranges($id) $i]
2857        if {abs([yc $row] - $y) < $thresh} {
2858            return $i
2859        }
2860    }
2861    return {}
2862}
2863
2864proc arrowjump {id n y} {
2865    global idrowranges canv
2866
2867    # 1 <-> 2, 3 <-> 4, etc...
2868    set n [expr {(($n - 1) ^ 1) + 1}]
2869    set row [lindex $idrowranges($id) $n]
2870    set yt [yc $row]
2871    set ymax [lindex [$canv cget -scrollregion] 3]
2872    if {$ymax eq {} || $ymax <= 0} return
2873    set view [$canv yview]
2874    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2875    set yfrac [expr {$yt / $ymax - $yspan / 2}]
2876    if {$yfrac < 0} {
2877        set yfrac 0
2878    }
2879    allcanvs yview moveto $yfrac
2880}
2881
2882proc lineclick {x y id isnew} {
2883    global ctext commitinfo children cflist canv thickerline
2884
2885    if {![info exists commitinfo($id)] && ![getcommit $id]} return
2886    unmarkmatches
2887    unselectline
2888    normalline
2889    $canv delete hover
2890    # draw this line thicker than normal
2891    set thickerline $id
2892    drawlines $id
2893    if {$isnew} {
2894        set ymax [lindex [$canv cget -scrollregion] 3]
2895        if {$ymax eq {}} return
2896        set yfrac [lindex [$canv yview] 0]
2897        set y [expr {$y + $yfrac * $ymax}]
2898    }
2899    set dirn [clickisonarrow $id $y]
2900    if {$dirn ne {}} {
2901        arrowjump $id $dirn $y
2902        return
2903    }
2904
2905    if {$isnew} {
2906        addtohistory [list lineclick $x $y $id 0]
2907    }
2908    # fill the details pane with info about this line
2909    $ctext conf -state normal
2910    $ctext delete 0.0 end
2911    $ctext tag conf link -foreground blue -underline 1
2912    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2913    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2914    $ctext insert end "Parent:\t"
2915    $ctext insert end $id [list link link0]
2916    $ctext tag bind link0 <1> [list selbyid $id]
2917    set info $commitinfo($id)
2918    $ctext insert end "\n\t[lindex $info 0]\n"
2919    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2920    set date [formatdate [lindex $info 2]]
2921    $ctext insert end "\tDate:\t$date\n"
2922    if {[info exists children($id)]} {
2923        $ctext insert end "\nChildren:"
2924        set i 0
2925        foreach child $children($id) {
2926            incr i
2927            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
2928            set info $commitinfo($child)
2929            $ctext insert end "\n\t"
2930            $ctext insert end $child [list link link$i]
2931            $ctext tag bind link$i <1> [list selbyid $child]
2932            $ctext insert end "\n\t[lindex $info 0]"
2933            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2934            set date [formatdate [lindex $info 2]]
2935            $ctext insert end "\n\tDate:\t$date\n"
2936        }
2937    }
2938    $ctext conf -state disabled
2939
2940    $cflist delete 0 end
2941}
2942
2943proc normalline {} {
2944    global thickerline
2945    if {[info exists thickerline]} {
2946        set id $thickerline
2947        unset thickerline
2948        drawlines $id
2949    }
2950}
2951
2952proc selbyid {id} {
2953    global commitrow
2954    if {[info exists commitrow($id)]} {
2955        selectline $commitrow($id) 1
2956    }
2957}
2958
2959proc mstime {} {
2960    global startmstime
2961    if {![info exists startmstime]} {
2962        set startmstime [clock clicks -milliseconds]
2963    }
2964    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2965}
2966
2967proc rowmenu {x y id} {
2968    global rowctxmenu commitrow selectedline rowmenuid
2969
2970    if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2971        set state disabled
2972    } else {
2973        set state normal
2974    }
2975    $rowctxmenu entryconfigure 0 -state $state
2976    $rowctxmenu entryconfigure 1 -state $state
2977    $rowctxmenu entryconfigure 2 -state $state
2978    set rowmenuid $id
2979    tk_popup $rowctxmenu $x $y
2980}
2981
2982proc diffvssel {dirn} {
2983    global rowmenuid selectedline displayorder
2984
2985    if {![info exists selectedline]} return
2986    if {$dirn} {
2987        set oldid [lindex $displayorder $selectedline]
2988        set newid $rowmenuid
2989    } else {
2990        set oldid $rowmenuid
2991        set newid [lindex $displayorder $selectedline]
2992    }
2993    addtohistory [list doseldiff $oldid $newid]
2994    doseldiff $oldid $newid
2995}
2996
2997proc doseldiff {oldid newid} {
2998    global ctext cflist
2999    global commitinfo
3000
3001    $ctext conf -state normal
3002    $ctext delete 0.0 end
3003    $ctext mark set fmark.0 0.0
3004    $ctext mark gravity fmark.0 left
3005    $cflist delete 0 end
3006    $cflist insert end "Top"
3007    $ctext insert end "From "
3008    $ctext tag conf link -foreground blue -underline 1
3009    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3010    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3011    $ctext tag bind link0 <1> [list selbyid $oldid]
3012    $ctext insert end $oldid [list link link0]
3013    $ctext insert end "\n     "
3014    $ctext insert end [lindex $commitinfo($oldid) 0]
3015    $ctext insert end "\n\nTo   "
3016    $ctext tag bind link1 <1> [list selbyid $newid]
3017    $ctext insert end $newid [list link link1]
3018    $ctext insert end "\n     "
3019    $ctext insert end [lindex $commitinfo($newid) 0]
3020    $ctext insert end "\n"
3021    $ctext conf -state disabled
3022    $ctext tag delete Comments
3023    $ctext tag remove found 1.0 end
3024    startdiff [list $oldid $newid]
3025}
3026
3027proc mkpatch {} {
3028    global rowmenuid currentid commitinfo patchtop patchnum
3029
3030    if {![info exists currentid]} return
3031    set oldid $currentid
3032    set oldhead [lindex $commitinfo($oldid) 0]
3033    set newid $rowmenuid
3034    set newhead [lindex $commitinfo($newid) 0]
3035    set top .patch
3036    set patchtop $top
3037    catch {destroy $top}
3038    toplevel $top
3039    label $top.title -text "Generate patch"
3040    grid $top.title - -pady 10
3041    label $top.from -text "From:"
3042    entry $top.fromsha1 -width 40 -relief flat
3043    $top.fromsha1 insert 0 $oldid
3044    $top.fromsha1 conf -state readonly
3045    grid $top.from $top.fromsha1 -sticky w
3046    entry $top.fromhead -width 60 -relief flat
3047    $top.fromhead insert 0 $oldhead
3048    $top.fromhead conf -state readonly
3049    grid x $top.fromhead -sticky w
3050    label $top.to -text "To:"
3051    entry $top.tosha1 -width 40 -relief flat
3052    $top.tosha1 insert 0 $newid
3053    $top.tosha1 conf -state readonly
3054    grid $top.to $top.tosha1 -sticky w
3055    entry $top.tohead -width 60 -relief flat
3056    $top.tohead insert 0 $newhead
3057    $top.tohead conf -state readonly
3058    grid x $top.tohead -sticky w
3059    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3060    grid $top.rev x -pady 10
3061    label $top.flab -text "Output file:"
3062    entry $top.fname -width 60
3063    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3064    incr patchnum
3065    grid $top.flab $top.fname -sticky w
3066    frame $top.buts
3067    button $top.buts.gen -text "Generate" -command mkpatchgo
3068    button $top.buts.can -text "Cancel" -command mkpatchcan
3069    grid $top.buts.gen $top.buts.can
3070    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3071    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3072    grid $top.buts - -pady 10 -sticky ew
3073    focus $top.fname
3074}
3075
3076proc mkpatchrev {} {
3077    global patchtop
3078
3079    set oldid [$patchtop.fromsha1 get]
3080    set oldhead [$patchtop.fromhead get]
3081    set newid [$patchtop.tosha1 get]
3082    set newhead [$patchtop.tohead get]
3083    foreach e [list fromsha1 fromhead tosha1 tohead] \
3084            v [list $newid $newhead $oldid $oldhead] {
3085        $patchtop.$e conf -state normal
3086        $patchtop.$e delete 0 end
3087        $patchtop.$e insert 0 $v
3088        $patchtop.$e conf -state readonly
3089    }
3090}
3091
3092proc mkpatchgo {} {
3093    global patchtop
3094
3095    set oldid [$patchtop.fromsha1 get]
3096    set newid [$patchtop.tosha1 get]
3097    set fname [$patchtop.fname get]
3098    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3099        error_popup "Error creating patch: $err"
3100    }
3101    catch {destroy $patchtop}
3102    unset patchtop
3103}
3104
3105proc mkpatchcan {} {
3106    global patchtop
3107
3108    catch {destroy $patchtop}
3109    unset patchtop
3110}
3111
3112proc mktag {} {
3113    global rowmenuid mktagtop commitinfo
3114
3115    set top .maketag
3116    set mktagtop $top
3117    catch {destroy $top}
3118    toplevel $top
3119    label $top.title -text "Create tag"
3120    grid $top.title - -pady 10
3121    label $top.id -text "ID:"
3122    entry $top.sha1 -width 40 -relief flat
3123    $top.sha1 insert 0 $rowmenuid
3124    $top.sha1 conf -state readonly
3125    grid $top.id $top.sha1 -sticky w
3126    entry $top.head -width 60 -relief flat
3127    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3128    $top.head conf -state readonly
3129    grid x $top.head -sticky w
3130    label $top.tlab -text "Tag name:"
3131    entry $top.tag -width 60
3132    grid $top.tlab $top.tag -sticky w
3133    frame $top.buts
3134    button $top.buts.gen -text "Create" -command mktaggo
3135    button $top.buts.can -text "Cancel" -command mktagcan
3136    grid $top.buts.gen $top.buts.can
3137    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3138    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3139    grid $top.buts - -pady 10 -sticky ew
3140    focus $top.tag
3141}
3142
3143proc domktag {} {
3144    global mktagtop env tagids idtags
3145
3146    set id [$mktagtop.sha1 get]
3147    set tag [$mktagtop.tag get]
3148    if {$tag == {}} {
3149        error_popup "No tag name specified"
3150        return
3151    }
3152    if {[info exists tagids($tag)]} {
3153        error_popup "Tag \"$tag\" already exists"
3154        return
3155    }
3156    if {[catch {
3157        set dir [gitdir]
3158        set fname [file join $dir "refs/tags" $tag]
3159        set f [open $fname w]
3160        puts $f $id
3161        close $f
3162    } err]} {
3163        error_popup "Error creating tag: $err"
3164        return
3165    }
3166
3167    set tagids($tag) $id
3168    lappend idtags($id) $tag
3169    redrawtags $id
3170}
3171
3172proc redrawtags {id} {
3173    global canv linehtag commitrow idpos selectedline
3174
3175    if {![info exists commitrow($id)]} return
3176    drawcmitrow $commitrow($id)
3177    $canv delete tag.$id
3178    set xt [eval drawtags $id $idpos($id)]
3179    $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3180    if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3181        selectline $selectedline 0
3182    }
3183}
3184
3185proc mktagcan {} {
3186    global mktagtop
3187
3188    catch {destroy $mktagtop}
3189    unset mktagtop
3190}
3191
3192proc mktaggo {} {
3193    domktag
3194    mktagcan
3195}
3196
3197proc writecommit {} {
3198    global rowmenuid wrcomtop commitinfo wrcomcmd
3199
3200    set top .writecommit
3201    set wrcomtop $top
3202    catch {destroy $top}
3203    toplevel $top
3204    label $top.title -text "Write commit to file"
3205    grid $top.title - -pady 10
3206    label $top.id -text "ID:"
3207    entry $top.sha1 -width 40 -relief flat
3208    $top.sha1 insert 0 $rowmenuid
3209    $top.sha1 conf -state readonly
3210    grid $top.id $top.sha1 -sticky w
3211    entry $top.head -width 60 -relief flat
3212    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3213    $top.head conf -state readonly
3214    grid x $top.head -sticky w
3215    label $top.clab -text "Command:"
3216    entry $top.cmd -width 60 -textvariable wrcomcmd
3217    grid $top.clab $top.cmd -sticky w -pady 10
3218    label $top.flab -text "Output file:"
3219    entry $top.fname -width 60
3220    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3221    grid $top.flab $top.fname -sticky w
3222    frame $top.buts
3223    button $top.buts.gen -text "Write" -command wrcomgo
3224    button $top.buts.can -text "Cancel" -command wrcomcan
3225    grid $top.buts.gen $top.buts.can
3226    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3227    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3228    grid $top.buts - -pady 10 -sticky ew
3229    focus $top.fname
3230}
3231
3232proc wrcomgo {} {
3233    global wrcomtop
3234
3235    set id [$wrcomtop.sha1 get]
3236    set cmd "echo $id | [$wrcomtop.cmd get]"
3237    set fname [$wrcomtop.fname get]
3238    if {[catch {exec sh -c $cmd >$fname &} err]} {
3239        error_popup "Error writing commit: $err"
3240    }
3241    catch {destroy $wrcomtop}
3242    unset wrcomtop
3243}
3244
3245proc wrcomcan {} {
3246    global wrcomtop
3247
3248    catch {destroy $wrcomtop}
3249    unset wrcomtop
3250}
3251
3252proc listrefs {id} {
3253    global idtags idheads idotherrefs
3254
3255    set x {}
3256    if {[info exists idtags($id)]} {
3257        set x $idtags($id)
3258    }
3259    set y {}
3260    if {[info exists idheads($id)]} {
3261        set y $idheads($id)
3262    }
3263    set z {}
3264    if {[info exists idotherrefs($id)]} {
3265        set z $idotherrefs($id)
3266    }
3267    return [list $x $y $z]
3268}
3269
3270proc rereadrefs {} {
3271    global idtags idheads idotherrefs
3272    global tagids headids otherrefids
3273
3274    set refids [concat [array names idtags] \
3275                    [array names idheads] [array names idotherrefs]]
3276    foreach id $refids {
3277        if {![info exists ref($id)]} {
3278            set ref($id) [listrefs $id]
3279        }
3280    }
3281    readrefs
3282    set refids [lsort -unique [concat $refids [array names idtags] \
3283                        [array names idheads] [array names idotherrefs]]]
3284    foreach id $refids {
3285        set v [listrefs $id]
3286        if {![info exists ref($id)] || $ref($id) != $v} {
3287            redrawtags $id
3288        }
3289    }
3290}
3291
3292proc showtag {tag isnew} {
3293    global ctext cflist tagcontents tagids linknum
3294
3295    if {$isnew} {
3296        addtohistory [list showtag $tag 0]
3297    }
3298    $ctext conf -state normal
3299    $ctext delete 0.0 end
3300    set linknum 0
3301    if {[info exists tagcontents($tag)]} {
3302        set text $tagcontents($tag)
3303    } else {
3304        set text "Tag: $tag\nId:  $tagids($tag)"
3305    }
3306    appendwithlinks $text
3307    $ctext conf -state disabled
3308    $cflist delete 0 end
3309}
3310
3311proc doquit {} {
3312    global stopped
3313    set stopped 100
3314    destroy .
3315}
3316
3317proc doprefs {} {
3318    global maxwidth maxgraphpct diffopts findmergefiles
3319    global oldprefs prefstop
3320
3321    set top .gitkprefs
3322    set prefstop $top
3323    if {[winfo exists $top]} {
3324        raise $top
3325        return
3326    }
3327    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3328        set oldprefs($v) [set $v]
3329    }
3330    toplevel $top
3331    wm title $top "Gitk preferences"
3332    label $top.ldisp -text "Commit list display options"
3333    grid $top.ldisp - -sticky w -pady 10
3334    label $top.spacer -text " "
3335    label $top.maxwidthl -text "Maximum graph width (lines)" \
3336        -font optionfont
3337    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3338    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3339    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3340        -font optionfont
3341    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3342    grid x $top.maxpctl $top.maxpct -sticky w
3343    checkbutton $top.findm -variable findmergefiles
3344    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3345        -font optionfont
3346    grid $top.findm $top.findml - -sticky w
3347    label $top.ddisp -text "Diff display options"
3348    grid $top.ddisp - -sticky w -pady 10
3349    label $top.diffoptl -text "Options for diff program" \
3350        -font optionfont
3351    entry $top.diffopt -width 20 -textvariable diffopts
3352    grid x $top.diffoptl $top.diffopt -sticky w
3353    frame $top.buts
3354    button $top.buts.ok -text "OK" -command prefsok
3355    button $top.buts.can -text "Cancel" -command prefscan
3356    grid $top.buts.ok $top.buts.can
3357    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3358    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3359    grid $top.buts - - -pady 10 -sticky ew
3360}
3361
3362proc prefscan {} {
3363    global maxwidth maxgraphpct diffopts findmergefiles
3364    global oldprefs prefstop
3365
3366    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3367        set $v $oldprefs($v)
3368    }
3369    catch {destroy $prefstop}
3370    unset prefstop
3371}
3372
3373proc prefsok {} {
3374    global maxwidth maxgraphpct
3375    global oldprefs prefstop
3376
3377    catch {destroy $prefstop}
3378    unset prefstop
3379    if {$maxwidth != $oldprefs(maxwidth)
3380        || $maxgraphpct != $oldprefs(maxgraphpct)} {
3381        redisplay
3382    }
3383}
3384
3385proc formatdate {d} {
3386    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3387}
3388
3389# This list of encoding names and aliases is distilled from
3390# http://www.iana.org/assignments/character-sets.
3391# Not all of them are supported by Tcl.
3392set encoding_aliases {
3393    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3394      ISO646-US US-ASCII us IBM367 cp367 csASCII }
3395    { ISO-10646-UTF-1 csISO10646UTF1 }
3396    { ISO_646.basic:1983 ref csISO646basic1983 }
3397    { INVARIANT csINVARIANT }
3398    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3399    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3400    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3401    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3402    { NATS-DANO iso-ir-9-1 csNATSDANO }
3403    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3404    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3405    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3406    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3407    { ISO-2022-KR csISO2022KR }
3408    { EUC-KR csEUCKR }
3409    { ISO-2022-JP csISO2022JP }
3410    { ISO-2022-JP-2 csISO2022JP2 }
3411    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3412      csISO13JISC6220jp }
3413    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3414    { IT iso-ir-15 ISO646-IT csISO15Italian }
3415    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3416    { ES iso-ir-17 ISO646-ES csISO17Spanish }
3417    { greek7-old iso-ir-18 csISO18Greek7Old }
3418    { latin-greek iso-ir-19 csISO19LatinGreek }
3419    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3420    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3421    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3422    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3423    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3424    { BS_viewdata iso-ir-47 csISO47BSViewdata }
3425    { INIS iso-ir-49 csISO49INIS }
3426    { INIS-8 iso-ir-50 csISO50INIS8 }
3427    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3428    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3429    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3430    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3431    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3432    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3433      csISO60Norwegian1 }
3434    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3435    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3436    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3437    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3438    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3439    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3440    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3441    { greek7 iso-ir-88 csISO88Greek7 }
3442    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3443    { iso-ir-90 csISO90 }
3444    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3445    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3446      csISO92JISC62991984b }
3447    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3448    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3449    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3450      csISO95JIS62291984handadd }
3451    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3452    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3453    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3454    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3455      CP819 csISOLatin1 }
3456    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3457    { T.61-7bit iso-ir-102 csISO102T617bit }
3458    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3459    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3460    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3461    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3462    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3463    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3464    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3465    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3466      arabic csISOLatinArabic }
3467    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3468    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3469    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3470      greek greek8 csISOLatinGreek }
3471    { T.101-G2 iso-ir-128 csISO128T101G2 }
3472    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3473      csISOLatinHebrew }
3474    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3475    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3476    { CSN_369103 iso-ir-139 csISO139CSN369103 }
3477    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3478    { ISO_6937-2-add iso-ir-142 csISOTextComm }
3479    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3480    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3481      csISOLatinCyrillic }
3482    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3483    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3484    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3485    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3486    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3487    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3488    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3489    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3490    { ISO_10367-box iso-ir-155 csISO10367Box }
3491    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3492    { latin-lap lap iso-ir-158 csISO158Lap }
3493    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3494    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3495    { us-dk csUSDK }
3496    { dk-us csDKUS }
3497    { JIS_X0201 X0201 csHalfWidthKatakana }
3498    { KSC5636 ISO646-KR csKSC5636 }
3499    { ISO-10646-UCS-2 csUnicode }
3500    { ISO-10646-UCS-4 csUCS4 }
3501    { DEC-MCS dec csDECMCS }
3502    { hp-roman8 roman8 r8 csHPRoman8 }
3503    { macintosh mac csMacintosh }
3504    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3505      csIBM037 }
3506    { IBM038 EBCDIC-INT cp038 csIBM038 }
3507    { IBM273 CP273 csIBM273 }
3508    { IBM274 EBCDIC-BE CP274 csIBM274 }
3509    { IBM275 EBCDIC-BR cp275 csIBM275 }
3510    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3511    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3512    { IBM280 CP280 ebcdic-cp-it csIBM280 }
3513    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3514    { IBM284 CP284 ebcdic-cp-es csIBM284 }
3515    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3516    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3517    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3518    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3519    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3520    { IBM424 cp424 ebcdic-cp-he csIBM424 }
3521    { IBM437 cp437 437 csPC8CodePage437 }
3522    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3523    { IBM775 cp775 csPC775Baltic }
3524    { IBM850 cp850 850 csPC850Multilingual }
3525    { IBM851 cp851 851 csIBM851 }
3526    { IBM852 cp852 852 csPCp852 }
3527    { IBM855 cp855 855 csIBM855 }
3528    { IBM857 cp857 857 csIBM857 }
3529    { IBM860 cp860 860 csIBM860 }
3530    { IBM861 cp861 861 cp-is csIBM861 }
3531    { IBM862 cp862 862 csPC862LatinHebrew }
3532    { IBM863 cp863 863 csIBM863 }
3533    { IBM864 cp864 csIBM864 }
3534    { IBM865 cp865 865 csIBM865 }
3535    { IBM866 cp866 866 csIBM866 }
3536    { IBM868 CP868 cp-ar csIBM868 }
3537    { IBM869 cp869 869 cp-gr csIBM869 }
3538    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3539    { IBM871 CP871 ebcdic-cp-is csIBM871 }
3540    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3541    { IBM891 cp891 csIBM891 }
3542    { IBM903 cp903 csIBM903 }
3543    { IBM904 cp904 904 csIBBM904 }
3544    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3545    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3546    { IBM1026 CP1026 csIBM1026 }
3547    { EBCDIC-AT-DE csIBMEBCDICATDE }
3548    { EBCDIC-AT-DE-A csEBCDICATDEA }
3549    { EBCDIC-CA-FR csEBCDICCAFR }
3550    { EBCDIC-DK-NO csEBCDICDKNO }
3551    { EBCDIC-DK-NO-A csEBCDICDKNOA }
3552    { EBCDIC-FI-SE csEBCDICFISE }
3553    { EBCDIC-FI-SE-A csEBCDICFISEA }
3554    { EBCDIC-FR csEBCDICFR }
3555    { EBCDIC-IT csEBCDICIT }
3556    { EBCDIC-PT csEBCDICPT }
3557    { EBCDIC-ES csEBCDICES }
3558    { EBCDIC-ES-A csEBCDICESA }
3559    { EBCDIC-ES-S csEBCDICESS }
3560    { EBCDIC-UK csEBCDICUK }
3561    { EBCDIC-US csEBCDICUS }
3562    { UNKNOWN-8BIT csUnknown8BiT }
3563    { MNEMONIC csMnemonic }
3564    { MNEM csMnem }
3565    { VISCII csVISCII }
3566    { VIQR csVIQR }
3567    { KOI8-R csKOI8R }
3568    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3569    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3570    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3571    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3572    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3573    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3574    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3575    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3576    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3577    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3578    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3579    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3580    { IBM1047 IBM-1047 }
3581    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3582    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3583    { UNICODE-1-1 csUnicode11 }
3584    { CESU-8 csCESU-8 }
3585    { BOCU-1 csBOCU-1 }
3586    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3587    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3588      l8 }
3589    { ISO-8859-15 ISO_8859-15 Latin-9 }
3590    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3591    { GBK CP936 MS936 windows-936 }
3592    { JIS_Encoding csJISEncoding }
3593    { Shift_JIS MS_Kanji csShiftJIS }
3594    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3595      EUC-JP }
3596    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3597    { ISO-10646-UCS-Basic csUnicodeASCII }
3598    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3599    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3600    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3601    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3602    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3603    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3604    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3605    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3606    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3607    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3608    { Adobe-Standard-Encoding csAdobeStandardEncoding }
3609    { Ventura-US csVenturaUS }
3610    { Ventura-International csVenturaInternational }
3611    { PC8-Danish-Norwegian csPC8DanishNorwegian }
3612    { PC8-Turkish csPC8Turkish }
3613    { IBM-Symbols csIBMSymbols }
3614    { IBM-Thai csIBMThai }
3615    { HP-Legal csHPLegal }
3616    { HP-Pi-font csHPPiFont }
3617    { HP-Math8 csHPMath8 }
3618    { Adobe-Symbol-Encoding csHPPSMath }
3619    { HP-DeskTop csHPDesktop }
3620    { Ventura-Math csVenturaMath }
3621    { Microsoft-Publishing csMicrosoftPublishing }
3622    { Windows-31J csWindows31J }
3623    { GB2312 csGB2312 }
3624    { Big5 csBig5 }
3625}
3626
3627proc tcl_encoding {enc} {
3628    global encoding_aliases
3629    set names [encoding names]
3630    set lcnames [string tolower $names]
3631    set enc [string tolower $enc]
3632    set i [lsearch -exact $lcnames $enc]
3633    if {$i < 0} {
3634        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3635        if {[regsub {^iso[-_]} $enc iso encx]} {
3636            set i [lsearch -exact $lcnames $encx]
3637        }
3638    }
3639    if {$i < 0} {
3640        foreach l $encoding_aliases {
3641            set ll [string tolower $l]
3642            if {[lsearch -exact $ll $enc] < 0} continue
3643            # look through the aliases for one that tcl knows about
3644            foreach e $ll {
3645                set i [lsearch -exact $lcnames $e]
3646                if {$i < 0} {
3647                    if {[regsub {^iso[-_]} $e iso ex]} {
3648                        set i [lsearch -exact $lcnames $ex]
3649                    }
3650                }
3651                if {$i >= 0} break
3652            }
3653            break
3654        }
3655    }
3656    if {$i >= 0} {
3657        return [lindex $names $i]
3658    }
3659    return {}
3660}
3661
3662# defaults...
3663set datemode 0
3664set diffopts "-U 5 -p"
3665set wrcomcmd "git-diff-tree --stdin -p --pretty"
3666
3667set gitencoding {}
3668catch {
3669    set gitencoding [exec git-repo-config --get i18n.commitencoding]
3670}
3671if {$gitencoding == ""} {
3672    set gitencoding "utf-8"
3673}
3674set tclencoding [tcl_encoding $gitencoding]
3675if {$tclencoding == {}} {
3676    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3677}
3678
3679set mainfont {Helvetica 9}
3680set textfont {Courier 9}
3681set findmergefiles 0
3682set maxgraphpct 50
3683set maxwidth 16
3684set revlistorder 0
3685set fastdate 0
3686set uparrowlen 7
3687set downarrowlen 7
3688set mingaplen 30
3689
3690set colors {green red blue magenta darkgrey brown orange}
3691
3692catch {source ~/.gitk}
3693
3694set namefont $mainfont
3695
3696font create optionfont -family sans-serif -size -12
3697
3698set revtreeargs {}
3699foreach arg $argv {
3700    switch -regexp -- $arg {
3701        "^$" { }
3702        "^-d" { set datemode 1 }
3703        default {
3704            lappend revtreeargs $arg
3705        }
3706    }
3707}
3708
3709# check that we can find a .git directory somewhere...
3710set gitdir [gitdir]
3711if {![file isdirectory $gitdir]} {
3712    error_popup "Cannot find the git directory \"$gitdir\"."
3713    exit 1
3714}
3715
3716set history {}
3717set historyindex 0
3718
3719set optim_delay 16
3720
3721set stopped 0
3722set stuffsaved 0
3723set patchnum 0
3724setcoords
3725makewindow $revtreeargs
3726readrefs
3727getcommits $revtreeargs