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