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