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