gitkon commit gitk: Get rid of idrowranges and rowrangelist (92ed666)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2005-2006 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 [exec git rev-parse --git-dir]
  16    }
  17}
  18
  19# A simple scheduler for compute-intensive stuff.
  20# The aim is to make sure that event handlers for GUI actions can
  21# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22# run before X event handlers, so reading from a fast source can
  23# make the GUI completely unresponsive.
  24proc run args {
  25    global isonrunq runq
  26
  27    set script $args
  28    if {[info exists isonrunq($script)]} return
  29    if {$runq eq {}} {
  30        after idle dorunq
  31    }
  32    lappend runq [list {} $script]
  33    set isonrunq($script) 1
  34}
  35
  36proc filerun {fd script} {
  37    fileevent $fd readable [list filereadable $fd $script]
  38}
  39
  40proc filereadable {fd script} {
  41    global runq
  42
  43    fileevent $fd readable {}
  44    if {$runq eq {}} {
  45        after idle dorunq
  46    }
  47    lappend runq [list $fd $script]
  48}
  49
  50proc dorunq {} {
  51    global isonrunq runq
  52
  53    set tstart [clock clicks -milliseconds]
  54    set t0 $tstart
  55    while {$runq ne {}} {
  56        set fd [lindex $runq 0 0]
  57        set script [lindex $runq 0 1]
  58        set repeat [eval $script]
  59        set t1 [clock clicks -milliseconds]
  60        set t [expr {$t1 - $t0}]
  61        set runq [lrange $runq 1 end]
  62        if {$repeat ne {} && $repeat} {
  63            if {$fd eq {} || $repeat == 2} {
  64                # script returns 1 if it wants to be readded
  65                # file readers return 2 if they could do more straight away
  66                lappend runq [list $fd $script]
  67            } else {
  68                fileevent $fd readable [list filereadable $fd $script]
  69            }
  70        } elseif {$fd eq {}} {
  71            unset isonrunq($script)
  72        }
  73        set t0 $t1
  74        if {$t1 - $tstart >= 80} break
  75    }
  76    if {$runq ne {}} {
  77        after idle dorunq
  78    }
  79}
  80
  81# Start off a git rev-list process and arrange to read its output
  82proc start_rev_list {view} {
  83    global startmsecs
  84    global commfd leftover tclencoding datemode
  85    global viewargs viewfiles commitidx vnextroot
  86    global lookingforhead showlocalchanges
  87
  88    set startmsecs [clock clicks -milliseconds]
  89    set commitidx($view) 0
  90    set vnextroot($view) 0
  91    set order "--topo-order"
  92    if {$datemode} {
  93        set order "--date-order"
  94    }
  95    if {[catch {
  96        set fd [open [concat | git log -z --pretty=raw $order --parents \
  97                         --boundary $viewargs($view) "--" $viewfiles($view)] r]
  98    } err]} {
  99        error_popup "Error executing git rev-list: $err"
 100        exit 1
 101    }
 102    set commfd($view) $fd
 103    set leftover($view) {}
 104    set lookingforhead $showlocalchanges
 105    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 106    if {$tclencoding != {}} {
 107        fconfigure $fd -encoding $tclencoding
 108    }
 109    filerun $fd [list getcommitlines $fd $view]
 110    nowbusy $view
 111}
 112
 113proc stop_rev_list {} {
 114    global commfd curview
 115
 116    if {![info exists commfd($curview)]} return
 117    set fd $commfd($curview)
 118    catch {
 119        set pid [pid $fd]
 120        exec kill $pid
 121    }
 122    catch {close $fd}
 123    unset commfd($curview)
 124}
 125
 126proc getcommits {} {
 127    global phase canv mainfont curview
 128
 129    set phase getcommits
 130    initlayout
 131    start_rev_list $curview
 132    show_status "Reading commits..."
 133}
 134
 135# This makes a string representation of a positive integer which
 136# sorts as a string in numerical order
 137proc strrep {n} {
 138    if {$n < 16} {
 139        return [format "%x" $n]
 140    } elseif {$n < 256} {
 141        return [format "x%.2x" $n]
 142    } elseif {$n < 65536} {
 143        return [format "y%.4x" $n]
 144    }
 145    return [format "z%.8x" $n]
 146}
 147
 148proc getcommitlines {fd view}  {
 149    global commitlisted
 150    global leftover commfd
 151    global displayorder commitidx commitrow commitdata
 152    global parentlist children curview hlview
 153    global vparentlist vdisporder vcmitlisted
 154    global ordertok vnextroot
 155
 156    set stuff [read $fd 500000]
 157    # git log doesn't terminate the last commit with a null...
 158    if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
 159        set stuff "\0"
 160    }
 161    if {$stuff == {}} {
 162        if {![eof $fd]} {
 163            return 1
 164        }
 165        global viewname
 166        unset commfd($view)
 167        notbusy $view
 168        # set it blocking so we wait for the process to terminate
 169        fconfigure $fd -blocking 1
 170        if {[catch {close $fd} err]} {
 171            set fv {}
 172            if {$view != $curview} {
 173                set fv " for the \"$viewname($view)\" view"
 174            }
 175            if {[string range $err 0 4] == "usage"} {
 176                set err "Gitk: error reading commits$fv:\
 177                        bad arguments to git rev-list."
 178                if {$viewname($view) eq "Command line"} {
 179                    append err \
 180                        "  (Note: arguments to gitk are passed to git rev-list\
 181                         to allow selection of commits to be displayed.)"
 182                }
 183            } else {
 184                set err "Error reading commits$fv: $err"
 185            }
 186            error_popup $err
 187        }
 188        if {$view == $curview} {
 189            run chewcommits $view
 190        }
 191        return 0
 192    }
 193    set start 0
 194    set gotsome 0
 195    while 1 {
 196        set i [string first "\0" $stuff $start]
 197        if {$i < 0} {
 198            append leftover($view) [string range $stuff $start end]
 199            break
 200        }
 201        if {$start == 0} {
 202            set cmit $leftover($view)
 203            append cmit [string range $stuff 0 [expr {$i - 1}]]
 204            set leftover($view) {}
 205        } else {
 206            set cmit [string range $stuff $start [expr {$i - 1}]]
 207        }
 208        set start [expr {$i + 1}]
 209        set j [string first "\n" $cmit]
 210        set ok 0
 211        set listed 1
 212        if {$j >= 0 && [string match "commit *" $cmit]} {
 213            set ids [string range $cmit 7 [expr {$j - 1}]]
 214            if {[string match {[-<>]*} $ids]} {
 215                switch -- [string index $ids 0] {
 216                    "-" {set listed 0}
 217                    "<" {set listed 2}
 218                    ">" {set listed 3}
 219                }
 220                set ids [string range $ids 1 end]
 221            }
 222            set ok 1
 223            foreach id $ids {
 224                if {[string length $id] != 40} {
 225                    set ok 0
 226                    break
 227                }
 228            }
 229        }
 230        if {!$ok} {
 231            set shortcmit $cmit
 232            if {[string length $shortcmit] > 80} {
 233                set shortcmit "[string range $shortcmit 0 80]..."
 234            }
 235            error_popup "Can't parse git log output: {$shortcmit}"
 236            exit 1
 237        }
 238        set id [lindex $ids 0]
 239        if {![info exists ordertok($view,$id)]} {
 240            set otok "o[strrep $vnextroot($view)]"
 241            incr vnextroot($view)
 242            set ordertok($view,$id) $otok
 243        } else {
 244            set otok $ordertok($view,$id)
 245        }
 246        if {$listed} {
 247            set olds [lrange $ids 1 end]
 248            if {[llength $olds] == 1} {
 249                set p [lindex $olds 0]
 250                lappend children($view,$p) $id
 251                if {![info exists ordertok($view,$p)]} {
 252                    set ordertok($view,$p) $ordertok($view,$id)
 253                }
 254            } else {
 255                set i 0
 256                foreach p $olds {
 257                    if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 258                        lappend children($view,$p) $id
 259                    }
 260                    if {![info exists ordertok($view,$p)]} {
 261                        set ordertok($view,$p) "$otok[strrep $i]]"
 262                    }
 263                    incr i
 264                }
 265            }
 266        } else {
 267            set olds {}
 268        }
 269        if {![info exists children($view,$id)]} {
 270            set children($view,$id) {}
 271        }
 272        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 273        set commitrow($view,$id) $commitidx($view)
 274        incr commitidx($view)
 275        if {$view == $curview} {
 276            lappend parentlist $olds
 277            lappend displayorder $id
 278            lappend commitlisted $listed
 279        } else {
 280            lappend vparentlist($view) $olds
 281            lappend vdisporder($view) $id
 282            lappend vcmitlisted($view) $listed
 283        }
 284        set gotsome 1
 285    }
 286    if {$gotsome} {
 287        run chewcommits $view
 288    }
 289    return 2
 290}
 291
 292proc chewcommits {view} {
 293    global curview hlview commfd
 294    global selectedline pending_select
 295
 296    set more 0
 297    if {$view == $curview} {
 298        set allread [expr {![info exists commfd($view)]}]
 299        set tlimit [expr {[clock clicks -milliseconds] + 50}]
 300        set more [layoutmore $tlimit $allread]
 301        if {$allread && !$more} {
 302            global displayorder commitidx phase
 303            global numcommits startmsecs
 304
 305            if {[info exists pending_select]} {
 306                set row [first_real_row]
 307                selectline $row 1
 308            }
 309            if {$commitidx($curview) > 0} {
 310                #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 311                #puts "overall $ms ms for $numcommits commits"
 312            } else {
 313                show_status "No commits selected"
 314            }
 315            notbusy layout
 316            set phase {}
 317        }
 318    }
 319    if {[info exists hlview] && $view == $hlview} {
 320        vhighlightmore
 321    }
 322    return $more
 323}
 324
 325proc readcommit {id} {
 326    if {[catch {set contents [exec git cat-file commit $id]}]} return
 327    parsecommit $id $contents 0
 328}
 329
 330proc updatecommits {} {
 331    global viewdata curview phase displayorder
 332    global children commitrow selectedline thickerline showneartags
 333
 334    if {$phase ne {}} {
 335        stop_rev_list
 336        set phase {}
 337    }
 338    set n $curview
 339    foreach id $displayorder {
 340        catch {unset children($n,$id)}
 341        catch {unset commitrow($n,$id)}
 342    }
 343    set curview -1
 344    catch {unset selectedline}
 345    catch {unset thickerline}
 346    catch {unset viewdata($n)}
 347    readrefs
 348    changedrefs
 349    if {$showneartags} {
 350        getallcommits
 351    }
 352    showview $n
 353}
 354
 355proc parsecommit {id contents listed} {
 356    global commitinfo cdate
 357
 358    set inhdr 1
 359    set comment {}
 360    set headline {}
 361    set auname {}
 362    set audate {}
 363    set comname {}
 364    set comdate {}
 365    set hdrend [string first "\n\n" $contents]
 366    if {$hdrend < 0} {
 367        # should never happen...
 368        set hdrend [string length $contents]
 369    }
 370    set header [string range $contents 0 [expr {$hdrend - 1}]]
 371    set comment [string range $contents [expr {$hdrend + 2}] end]
 372    foreach line [split $header "\n"] {
 373        set tag [lindex $line 0]
 374        if {$tag == "author"} {
 375            set audate [lindex $line end-1]
 376            set auname [lrange $line 1 end-2]
 377        } elseif {$tag == "committer"} {
 378            set comdate [lindex $line end-1]
 379            set comname [lrange $line 1 end-2]
 380        }
 381    }
 382    set headline {}
 383    # take the first non-blank line of the comment as the headline
 384    set headline [string trimleft $comment]
 385    set i [string first "\n" $headline]
 386    if {$i >= 0} {
 387        set headline [string range $headline 0 $i]
 388    }
 389    set headline [string trimright $headline]
 390    set i [string first "\r" $headline]
 391    if {$i >= 0} {
 392        set headline [string trimright [string range $headline 0 $i]]
 393    }
 394    if {!$listed} {
 395        # git rev-list indents the comment by 4 spaces;
 396        # if we got this via git cat-file, add the indentation
 397        set newcomment {}
 398        foreach line [split $comment "\n"] {
 399            append newcomment "    "
 400            append newcomment $line
 401            append newcomment "\n"
 402        }
 403        set comment $newcomment
 404    }
 405    if {$comdate != {}} {
 406        set cdate($id) $comdate
 407    }
 408    set commitinfo($id) [list $headline $auname $audate \
 409                             $comname $comdate $comment]
 410}
 411
 412proc getcommit {id} {
 413    global commitdata commitinfo
 414
 415    if {[info exists commitdata($id)]} {
 416        parsecommit $id $commitdata($id) 1
 417    } else {
 418        readcommit $id
 419        if {![info exists commitinfo($id)]} {
 420            set commitinfo($id) {"No commit information available"}
 421        }
 422    }
 423    return 1
 424}
 425
 426proc readrefs {} {
 427    global tagids idtags headids idheads tagobjid
 428    global otherrefids idotherrefs mainhead mainheadid
 429
 430    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 431        catch {unset $v}
 432    }
 433    set refd [open [list | git show-ref -d] r]
 434    while {[gets $refd line] >= 0} {
 435        if {[string index $line 40] ne " "} continue
 436        set id [string range $line 0 39]
 437        set ref [string range $line 41 end]
 438        if {![string match "refs/*" $ref]} continue
 439        set name [string range $ref 5 end]
 440        if {[string match "remotes/*" $name]} {
 441            if {![string match "*/HEAD" $name]} {
 442                set headids($name) $id
 443                lappend idheads($id) $name
 444            }
 445        } elseif {[string match "heads/*" $name]} {
 446            set name [string range $name 6 end]
 447            set headids($name) $id
 448            lappend idheads($id) $name
 449        } elseif {[string match "tags/*" $name]} {
 450            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
 451            # which is what we want since the former is the commit ID
 452            set name [string range $name 5 end]
 453            if {[string match "*^{}" $name]} {
 454                set name [string range $name 0 end-3]
 455            } else {
 456                set tagobjid($name) $id
 457            }
 458            set tagids($name) $id
 459            lappend idtags($id) $name
 460        } else {
 461            set otherrefids($name) $id
 462            lappend idotherrefs($id) $name
 463        }
 464    }
 465    catch {close $refd}
 466    set mainhead {}
 467    set mainheadid {}
 468    catch {
 469        set thehead [exec git symbolic-ref HEAD]
 470        if {[string match "refs/heads/*" $thehead]} {
 471            set mainhead [string range $thehead 11 end]
 472            if {[info exists headids($mainhead)]} {
 473                set mainheadid $headids($mainhead)
 474            }
 475        }
 476    }
 477}
 478
 479# skip over fake commits
 480proc first_real_row {} {
 481    global nullid nullid2 displayorder numcommits
 482
 483    for {set row 0} {$row < $numcommits} {incr row} {
 484        set id [lindex $displayorder $row]
 485        if {$id ne $nullid && $id ne $nullid2} {
 486            break
 487        }
 488    }
 489    return $row
 490}
 491
 492# update things for a head moved to a child of its previous location
 493proc movehead {id name} {
 494    global headids idheads
 495
 496    removehead $headids($name) $name
 497    set headids($name) $id
 498    lappend idheads($id) $name
 499}
 500
 501# update things when a head has been removed
 502proc removehead {id name} {
 503    global headids idheads
 504
 505    if {$idheads($id) eq $name} {
 506        unset idheads($id)
 507    } else {
 508        set i [lsearch -exact $idheads($id) $name]
 509        if {$i >= 0} {
 510            set idheads($id) [lreplace $idheads($id) $i $i]
 511        }
 512    }
 513    unset headids($name)
 514}
 515
 516proc show_error {w top msg} {
 517    message $w.m -text $msg -justify center -aspect 400
 518    pack $w.m -side top -fill x -padx 20 -pady 20
 519    button $w.ok -text OK -command "destroy $top"
 520    pack $w.ok -side bottom -fill x
 521    bind $top <Visibility> "grab $top; focus $top"
 522    bind $top <Key-Return> "destroy $top"
 523    tkwait window $top
 524}
 525
 526proc error_popup msg {
 527    set w .error
 528    toplevel $w
 529    wm transient $w .
 530    show_error $w $w $msg
 531}
 532
 533proc confirm_popup msg {
 534    global confirm_ok
 535    set confirm_ok 0
 536    set w .confirm
 537    toplevel $w
 538    wm transient $w .
 539    message $w.m -text $msg -justify center -aspect 400
 540    pack $w.m -side top -fill x -padx 20 -pady 20
 541    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
 542    pack $w.ok -side left -fill x
 543    button $w.cancel -text Cancel -command "destroy $w"
 544    pack $w.cancel -side right -fill x
 545    bind $w <Visibility> "grab $w; focus $w"
 546    tkwait window $w
 547    return $confirm_ok
 548}
 549
 550proc makewindow {} {
 551    global canv canv2 canv3 linespc charspc ctext cflist
 552    global textfont mainfont uifont tabstop
 553    global findtype findtypemenu findloc findstring fstring geometry
 554    global entries sha1entry sha1string sha1but
 555    global diffcontextstring diffcontext
 556    global maincursor textcursor curtextcursor
 557    global rowctxmenu fakerowmenu mergemax wrapcomment
 558    global highlight_files gdttype
 559    global searchstring sstring
 560    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 561    global headctxmenu
 562
 563    menu .bar
 564    .bar add cascade -label "File" -menu .bar.file
 565    .bar configure -font $uifont
 566    menu .bar.file
 567    .bar.file add command -label "Update" -command updatecommits
 568    .bar.file add command -label "Reread references" -command rereadrefs
 569    .bar.file add command -label "List references" -command showrefs
 570    .bar.file add command -label "Quit" -command doquit
 571    .bar.file configure -font $uifont
 572    menu .bar.edit
 573    .bar add cascade -label "Edit" -menu .bar.edit
 574    .bar.edit add command -label "Preferences" -command doprefs
 575    .bar.edit configure -font $uifont
 576
 577    menu .bar.view -font $uifont
 578    .bar add cascade -label "View" -menu .bar.view
 579    .bar.view add command -label "New view..." -command {newview 0}
 580    .bar.view add command -label "Edit view..." -command editview \
 581        -state disabled
 582    .bar.view add command -label "Delete view" -command delview -state disabled
 583    .bar.view add separator
 584    .bar.view add radiobutton -label "All files" -command {showview 0} \
 585        -variable selectedview -value 0
 586
 587    menu .bar.help
 588    .bar add cascade -label "Help" -menu .bar.help
 589    .bar.help add command -label "About gitk" -command about
 590    .bar.help add command -label "Key bindings" -command keys
 591    .bar.help configure -font $uifont
 592    . configure -menu .bar
 593
 594    # the gui has upper and lower half, parts of a paned window.
 595    panedwindow .ctop -orient vertical
 596
 597    # possibly use assumed geometry
 598    if {![info exists geometry(pwsash0)]} {
 599        set geometry(topheight) [expr {15 * $linespc}]
 600        set geometry(topwidth) [expr {80 * $charspc}]
 601        set geometry(botheight) [expr {15 * $linespc}]
 602        set geometry(botwidth) [expr {50 * $charspc}]
 603        set geometry(pwsash0) "[expr {40 * $charspc}] 2"
 604        set geometry(pwsash1) "[expr {60 * $charspc}] 2"
 605    }
 606
 607    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 608    frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 609    frame .tf.histframe
 610    panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
 611
 612    # create three canvases
 613    set cscroll .tf.histframe.csb
 614    set canv .tf.histframe.pwclist.canv
 615    canvas $canv \
 616        -selectbackground $selectbgcolor \
 617        -background $bgcolor -bd 0 \
 618        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 619    .tf.histframe.pwclist add $canv
 620    set canv2 .tf.histframe.pwclist.canv2
 621    canvas $canv2 \
 622        -selectbackground $selectbgcolor \
 623        -background $bgcolor -bd 0 -yscrollincr $linespc
 624    .tf.histframe.pwclist add $canv2
 625    set canv3 .tf.histframe.pwclist.canv3
 626    canvas $canv3 \
 627        -selectbackground $selectbgcolor \
 628        -background $bgcolor -bd 0 -yscrollincr $linespc
 629    .tf.histframe.pwclist add $canv3
 630    eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 631    eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 632
 633    # a scroll bar to rule them
 634    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 635    pack $cscroll -side right -fill y
 636    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 637    lappend bglist $canv $canv2 $canv3
 638    pack .tf.histframe.pwclist -fill both -expand 1 -side left
 639
 640    # we have two button bars at bottom of top frame. Bar 1
 641    frame .tf.bar
 642    frame .tf.lbar -height 15
 643
 644    set sha1entry .tf.bar.sha1
 645    set entries $sha1entry
 646    set sha1but .tf.bar.sha1label
 647    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 648        -command gotocommit -width 8 -font $uifont
 649    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 650    pack .tf.bar.sha1label -side left
 651    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 652    trace add variable sha1string write sha1change
 653    pack $sha1entry -side left -pady 2
 654
 655    image create bitmap bm-left -data {
 656        #define left_width 16
 657        #define left_height 16
 658        static unsigned char left_bits[] = {
 659        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 660        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 661        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 662    }
 663    image create bitmap bm-right -data {
 664        #define right_width 16
 665        #define right_height 16
 666        static unsigned char right_bits[] = {
 667        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 668        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 669        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 670    }
 671    button .tf.bar.leftbut -image bm-left -command goback \
 672        -state disabled -width 26
 673    pack .tf.bar.leftbut -side left -fill y
 674    button .tf.bar.rightbut -image bm-right -command goforw \
 675        -state disabled -width 26
 676    pack .tf.bar.rightbut -side left -fill y
 677
 678    button .tf.bar.findbut -text "Find" -command dofind -font $uifont
 679    pack .tf.bar.findbut -side left
 680    set findstring {}
 681    set fstring .tf.bar.findstring
 682    lappend entries $fstring
 683    entry $fstring -width 30 -font $textfont -textvariable findstring
 684    trace add variable findstring write find_change
 685    pack $fstring -side left -expand 1 -fill x -in .tf.bar
 686    set findtype Exact
 687    set findtypemenu [tk_optionMenu .tf.bar.findtype \
 688                      findtype Exact IgnCase Regexp]
 689    trace add variable findtype write find_change
 690    .tf.bar.findtype configure -font $uifont
 691    .tf.bar.findtype.menu configure -font $uifont
 692    set findloc "All fields"
 693    tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
 694        Comments Author Committer
 695    trace add variable findloc write find_change
 696    .tf.bar.findloc configure -font $uifont
 697    .tf.bar.findloc.menu configure -font $uifont
 698    pack .tf.bar.findloc -side right
 699    pack .tf.bar.findtype -side right
 700
 701    # build up the bottom bar of upper window
 702    label .tf.lbar.flabel -text "Highlight:  Commits " \
 703    -font $uifont
 704    pack .tf.lbar.flabel -side left -fill y
 705    set gdttype "touching paths:"
 706    set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
 707        "adding/removing string:"]
 708    trace add variable gdttype write hfiles_change
 709    $gm conf -font $uifont
 710    .tf.lbar.gdttype conf -font $uifont
 711    pack .tf.lbar.gdttype -side left -fill y
 712    entry .tf.lbar.fent -width 25 -font $textfont \
 713        -textvariable highlight_files
 714    trace add variable highlight_files write hfiles_change
 715    lappend entries .tf.lbar.fent
 716    pack .tf.lbar.fent -side left -fill x -expand 1
 717    label .tf.lbar.vlabel -text " OR in view" -font $uifont
 718    pack .tf.lbar.vlabel -side left -fill y
 719    global viewhlmenu selectedhlview
 720    set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
 721    $viewhlmenu entryconf None -command delvhighlight
 722    $viewhlmenu conf -font $uifont
 723    .tf.lbar.vhl conf -font $uifont
 724    pack .tf.lbar.vhl -side left -fill y
 725    label .tf.lbar.rlabel -text " OR " -font $uifont
 726    pack .tf.lbar.rlabel -side left -fill y
 727    global highlight_related
 728    set m [tk_optionMenu .tf.lbar.relm highlight_related None \
 729        "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
 730    $m conf -font $uifont
 731    .tf.lbar.relm conf -font $uifont
 732    trace add variable highlight_related write vrel_change
 733    pack .tf.lbar.relm -side left -fill y
 734
 735    # Finish putting the upper half of the viewer together
 736    pack .tf.lbar -in .tf -side bottom -fill x
 737    pack .tf.bar -in .tf -side bottom -fill x
 738    pack .tf.histframe -fill both -side top -expand 1
 739    .ctop add .tf
 740    .ctop paneconfigure .tf -height $geometry(topheight)
 741    .ctop paneconfigure .tf -width $geometry(topwidth)
 742
 743    # now build up the bottom
 744    panedwindow .pwbottom -orient horizontal
 745
 746    # lower left, a text box over search bar, scroll bar to the right
 747    # if we know window height, then that will set the lower text height, otherwise
 748    # we set lower text height which will drive window height
 749    if {[info exists geometry(main)]} {
 750        frame .bleft -width $geometry(botwidth)
 751    } else {
 752        frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 753    }
 754    frame .bleft.top
 755    frame .bleft.mid
 756
 757    button .bleft.top.search -text "Search" -command dosearch \
 758        -font $uifont
 759    pack .bleft.top.search -side left -padx 5
 760    set sstring .bleft.top.sstring
 761    entry $sstring -width 20 -font $textfont -textvariable searchstring
 762    lappend entries $sstring
 763    trace add variable searchstring write incrsearch
 764    pack $sstring -side left -expand 1 -fill x
 765    radiobutton .bleft.mid.diff -text "Diff" \
 766        -command changediffdisp -variable diffelide -value {0 0}
 767    radiobutton .bleft.mid.old -text "Old version" \
 768        -command changediffdisp -variable diffelide -value {0 1}
 769    radiobutton .bleft.mid.new -text "New version" \
 770        -command changediffdisp -variable diffelide -value {1 0}
 771    label .bleft.mid.labeldiffcontext -text "      Lines of context: " \
 772        -font $uifont
 773    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 774    spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
 775        -from 1 -increment 1 -to 10000000 \
 776        -validate all -validatecommand "diffcontextvalidate %P" \
 777        -textvariable diffcontextstring
 778    .bleft.mid.diffcontext set $diffcontext
 779    trace add variable diffcontextstring write diffcontextchange
 780    lappend entries .bleft.mid.diffcontext
 781    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
 782    set ctext .bleft.ctext
 783    text $ctext -background $bgcolor -foreground $fgcolor \
 784        -tabs "[expr {$tabstop * $charspc}]" \
 785        -state disabled -font $textfont \
 786        -yscrollcommand scrolltext -wrap none
 787    scrollbar .bleft.sb -command "$ctext yview"
 788    pack .bleft.top -side top -fill x
 789    pack .bleft.mid -side top -fill x
 790    pack .bleft.sb -side right -fill y
 791    pack $ctext -side left -fill both -expand 1
 792    lappend bglist $ctext
 793    lappend fglist $ctext
 794
 795    $ctext tag conf comment -wrap $wrapcomment
 796    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 797    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 798    $ctext tag conf d0 -fore [lindex $diffcolors 0]
 799    $ctext tag conf d1 -fore [lindex $diffcolors 1]
 800    $ctext tag conf m0 -fore red
 801    $ctext tag conf m1 -fore blue
 802    $ctext tag conf m2 -fore green
 803    $ctext tag conf m3 -fore purple
 804    $ctext tag conf m4 -fore brown
 805    $ctext tag conf m5 -fore "#009090"
 806    $ctext tag conf m6 -fore magenta
 807    $ctext tag conf m7 -fore "#808000"
 808    $ctext tag conf m8 -fore "#009000"
 809    $ctext tag conf m9 -fore "#ff0080"
 810    $ctext tag conf m10 -fore cyan
 811    $ctext tag conf m11 -fore "#b07070"
 812    $ctext tag conf m12 -fore "#70b0f0"
 813    $ctext tag conf m13 -fore "#70f0b0"
 814    $ctext tag conf m14 -fore "#f0b070"
 815    $ctext tag conf m15 -fore "#ff70b0"
 816    $ctext tag conf mmax -fore darkgrey
 817    set mergemax 16
 818    $ctext tag conf mresult -font [concat $textfont bold]
 819    $ctext tag conf msep -font [concat $textfont bold]
 820    $ctext tag conf found -back yellow
 821
 822    .pwbottom add .bleft
 823    .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 824
 825    # lower right
 826    frame .bright
 827    frame .bright.mode
 828    radiobutton .bright.mode.patch -text "Patch" \
 829        -command reselectline -variable cmitmode -value "patch"
 830    .bright.mode.patch configure -font $uifont
 831    radiobutton .bright.mode.tree -text "Tree" \
 832        -command reselectline -variable cmitmode -value "tree"
 833    .bright.mode.tree configure -font $uifont
 834    grid .bright.mode.patch .bright.mode.tree -sticky ew
 835    pack .bright.mode -side top -fill x
 836    set cflist .bright.cfiles
 837    set indent [font measure $mainfont "nn"]
 838    text $cflist \
 839        -selectbackground $selectbgcolor \
 840        -background $bgcolor -foreground $fgcolor \
 841        -font $mainfont \
 842        -tabs [list $indent [expr {2 * $indent}]] \
 843        -yscrollcommand ".bright.sb set" \
 844        -cursor [. cget -cursor] \
 845        -spacing1 1 -spacing3 1
 846    lappend bglist $cflist
 847    lappend fglist $cflist
 848    scrollbar .bright.sb -command "$cflist yview"
 849    pack .bright.sb -side right -fill y
 850    pack $cflist -side left -fill both -expand 1
 851    $cflist tag configure highlight \
 852        -background [$cflist cget -selectbackground]
 853    $cflist tag configure bold -font [concat $mainfont bold]
 854
 855    .pwbottom add .bright
 856    .ctop add .pwbottom
 857
 858    # restore window position if known
 859    if {[info exists geometry(main)]} {
 860        wm geometry . "$geometry(main)"
 861    }
 862
 863    if {[tk windowingsystem] eq {aqua}} {
 864        set M1B M1
 865    } else {
 866        set M1B Control
 867    }
 868
 869    bind .pwbottom <Configure> {resizecdetpanes %W %w}
 870    pack .ctop -fill both -expand 1
 871    bindall <1> {selcanvline %W %x %y}
 872    #bindall <B1-Motion> {selcanvline %W %x %y}
 873    if {[tk windowingsystem] == "win32"} {
 874        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
 875        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
 876    } else {
 877        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 878        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 879    }
 880    bindall <2> "canvscan mark %W %x %y"
 881    bindall <B2-Motion> "canvscan dragto %W %x %y"
 882    bindkey <Home> selfirstline
 883    bindkey <End> sellastline
 884    bind . <Key-Up> "selnextline -1"
 885    bind . <Key-Down> "selnextline 1"
 886    bind . <Shift-Key-Up> "next_highlight -1"
 887    bind . <Shift-Key-Down> "next_highlight 1"
 888    bindkey <Key-Right> "goforw"
 889    bindkey <Key-Left> "goback"
 890    bind . <Key-Prior> "selnextpage -1"
 891    bind . <Key-Next> "selnextpage 1"
 892    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
 893    bind . <$M1B-End> "allcanvs yview moveto 1.0"
 894    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
 895    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
 896    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
 897    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
 898    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 899    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 900    bindkey <Key-space> "$ctext yview scroll 1 pages"
 901    bindkey p "selnextline -1"
 902    bindkey n "selnextline 1"
 903    bindkey z "goback"
 904    bindkey x "goforw"
 905    bindkey i "selnextline -1"
 906    bindkey k "selnextline 1"
 907    bindkey j "goback"
 908    bindkey l "goforw"
 909    bindkey b "$ctext yview scroll -1 pages"
 910    bindkey d "$ctext yview scroll 18 units"
 911    bindkey u "$ctext yview scroll -18 units"
 912    bindkey / {findnext 1}
 913    bindkey <Key-Return> {findnext 0}
 914    bindkey ? findprev
 915    bindkey f nextfile
 916    bindkey <F5> updatecommits
 917    bind . <$M1B-q> doquit
 918    bind . <$M1B-f> dofind
 919    bind . <$M1B-g> {findnext 0}
 920    bind . <$M1B-r> dosearchback
 921    bind . <$M1B-s> dosearch
 922    bind . <$M1B-equal> {incrfont 1}
 923    bind . <$M1B-KP_Add> {incrfont 1}
 924    bind . <$M1B-minus> {incrfont -1}
 925    bind . <$M1B-KP_Subtract> {incrfont -1}
 926    wm protocol . WM_DELETE_WINDOW doquit
 927    bind . <Button-1> "click %W"
 928    bind $fstring <Key-Return> dofind
 929    bind $sha1entry <Key-Return> gotocommit
 930    bind $sha1entry <<PasteSelection>> clearsha1
 931    bind $cflist <1> {sel_flist %W %x %y; break}
 932    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 933    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 934    bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
 935
 936    set maincursor [. cget -cursor]
 937    set textcursor [$ctext cget -cursor]
 938    set curtextcursor $textcursor
 939
 940    set rowctxmenu .rowctxmenu
 941    menu $rowctxmenu -tearoff 0
 942    $rowctxmenu add command -label "Diff this -> selected" \
 943        -command {diffvssel 0}
 944    $rowctxmenu add command -label "Diff selected -> this" \
 945        -command {diffvssel 1}
 946    $rowctxmenu add command -label "Make patch" -command mkpatch
 947    $rowctxmenu add command -label "Create tag" -command mktag
 948    $rowctxmenu add command -label "Write commit to file" -command writecommit
 949    $rowctxmenu add command -label "Create new branch" -command mkbranch
 950    $rowctxmenu add command -label "Cherry-pick this commit" \
 951        -command cherrypick
 952    $rowctxmenu add command -label "Reset HEAD branch to here" \
 953        -command resethead
 954
 955    set fakerowmenu .fakerowmenu
 956    menu $fakerowmenu -tearoff 0
 957    $fakerowmenu add command -label "Diff this -> selected" \
 958        -command {diffvssel 0}
 959    $fakerowmenu add command -label "Diff selected -> this" \
 960        -command {diffvssel 1}
 961    $fakerowmenu add command -label "Make patch" -command mkpatch
 962#    $fakerowmenu add command -label "Commit" -command {mkcommit 0}
 963#    $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
 964#    $fakerowmenu add command -label "Revert local changes" -command revertlocal
 965
 966    set headctxmenu .headctxmenu
 967    menu $headctxmenu -tearoff 0
 968    $headctxmenu add command -label "Check out this branch" \
 969        -command cobranch
 970    $headctxmenu add command -label "Remove this branch" \
 971        -command rmbranch
 972
 973    global flist_menu
 974    set flist_menu .flistctxmenu
 975    menu $flist_menu -tearoff 0
 976    $flist_menu add command -label "Highlight this too" \
 977        -command {flist_hl 0}
 978    $flist_menu add command -label "Highlight this only" \
 979        -command {flist_hl 1}
 980}
 981
 982# Windows sends all mouse wheel events to the current focused window, not
 983# the one where the mouse hovers, so bind those events here and redirect
 984# to the correct window
 985proc windows_mousewheel_redirector {W X Y D} {
 986    global canv canv2 canv3
 987    set w [winfo containing -displayof $W $X $Y]
 988    if {$w ne ""} {
 989        set u [expr {$D < 0 ? 5 : -5}]
 990        if {$w == $canv || $w == $canv2 || $w == $canv3} {
 991            allcanvs yview scroll $u units
 992        } else {
 993            catch {
 994                $w yview scroll $u units
 995            }
 996        }
 997    }
 998}
 999
1000# mouse-2 makes all windows scan vertically, but only the one
1001# the cursor is in scans horizontally
1002proc canvscan {op w x y} {
1003    global canv canv2 canv3
1004    foreach c [list $canv $canv2 $canv3] {
1005        if {$c == $w} {
1006            $c scan $op $x $y
1007        } else {
1008            $c scan $op 0 $y
1009        }
1010    }
1011}
1012
1013proc scrollcanv {cscroll f0 f1} {
1014    $cscroll set $f0 $f1
1015    drawfrac $f0 $f1
1016    flushhighlights
1017}
1018
1019# when we make a key binding for the toplevel, make sure
1020# it doesn't get triggered when that key is pressed in the
1021# find string entry widget.
1022proc bindkey {ev script} {
1023    global entries
1024    bind . $ev $script
1025    set escript [bind Entry $ev]
1026    if {$escript == {}} {
1027        set escript [bind Entry <Key>]
1028    }
1029    foreach e $entries {
1030        bind $e $ev "$escript; break"
1031    }
1032}
1033
1034# set the focus back to the toplevel for any click outside
1035# the entry widgets
1036proc click {w} {
1037    global ctext entries
1038    foreach e [concat $entries $ctext] {
1039        if {$w == $e} return
1040    }
1041    focus .
1042}
1043
1044proc savestuff {w} {
1045    global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1046    global stuffsaved findmergefiles maxgraphpct
1047    global maxwidth showneartags showlocalchanges
1048    global viewname viewfiles viewargs viewperm nextviewnum
1049    global cmitmode wrapcomment datetimeformat
1050    global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1051
1052    if {$stuffsaved} return
1053    if {![winfo viewable .]} return
1054    catch {
1055        set f [open "~/.gitk-new" w]
1056        puts $f [list set mainfont $mainfont]
1057        puts $f [list set textfont $textfont]
1058        puts $f [list set uifont $uifont]
1059        puts $f [list set tabstop $tabstop]
1060        puts $f [list set findmergefiles $findmergefiles]
1061        puts $f [list set maxgraphpct $maxgraphpct]
1062        puts $f [list set maxwidth $maxwidth]
1063        puts $f [list set cmitmode $cmitmode]
1064        puts $f [list set wrapcomment $wrapcomment]
1065        puts $f [list set showneartags $showneartags]
1066        puts $f [list set showlocalchanges $showlocalchanges]
1067        puts $f [list set datetimeformat $datetimeformat]
1068        puts $f [list set bgcolor $bgcolor]
1069        puts $f [list set fgcolor $fgcolor]
1070        puts $f [list set colors $colors]
1071        puts $f [list set diffcolors $diffcolors]
1072        puts $f [list set diffcontext $diffcontext]
1073        puts $f [list set selectbgcolor $selectbgcolor]
1074
1075        puts $f "set geometry(main) [wm geometry .]"
1076        puts $f "set geometry(topwidth) [winfo width .tf]"
1077        puts $f "set geometry(topheight) [winfo height .tf]"
1078        puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1079        puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1080        puts $f "set geometry(botwidth) [winfo width .bleft]"
1081        puts $f "set geometry(botheight) [winfo height .bleft]"
1082
1083        puts -nonewline $f "set permviews {"
1084        for {set v 0} {$v < $nextviewnum} {incr v} {
1085            if {$viewperm($v)} {
1086                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1087            }
1088        }
1089        puts $f "}"
1090        close $f
1091        file rename -force "~/.gitk-new" "~/.gitk"
1092    }
1093    set stuffsaved 1
1094}
1095
1096proc resizeclistpanes {win w} {
1097    global oldwidth
1098    if {[info exists oldwidth($win)]} {
1099        set s0 [$win sash coord 0]
1100        set s1 [$win sash coord 1]
1101        if {$w < 60} {
1102            set sash0 [expr {int($w/2 - 2)}]
1103            set sash1 [expr {int($w*5/6 - 2)}]
1104        } else {
1105            set factor [expr {1.0 * $w / $oldwidth($win)}]
1106            set sash0 [expr {int($factor * [lindex $s0 0])}]
1107            set sash1 [expr {int($factor * [lindex $s1 0])}]
1108            if {$sash0 < 30} {
1109                set sash0 30
1110            }
1111            if {$sash1 < $sash0 + 20} {
1112                set sash1 [expr {$sash0 + 20}]
1113            }
1114            if {$sash1 > $w - 10} {
1115                set sash1 [expr {$w - 10}]
1116                if {$sash0 > $sash1 - 20} {
1117                    set sash0 [expr {$sash1 - 20}]
1118                }
1119            }
1120        }
1121        $win sash place 0 $sash0 [lindex $s0 1]
1122        $win sash place 1 $sash1 [lindex $s1 1]
1123    }
1124    set oldwidth($win) $w
1125}
1126
1127proc resizecdetpanes {win w} {
1128    global oldwidth
1129    if {[info exists oldwidth($win)]} {
1130        set s0 [$win sash coord 0]
1131        if {$w < 60} {
1132            set sash0 [expr {int($w*3/4 - 2)}]
1133        } else {
1134            set factor [expr {1.0 * $w / $oldwidth($win)}]
1135            set sash0 [expr {int($factor * [lindex $s0 0])}]
1136            if {$sash0 < 45} {
1137                set sash0 45
1138            }
1139            if {$sash0 > $w - 15} {
1140                set sash0 [expr {$w - 15}]
1141            }
1142        }
1143        $win sash place 0 $sash0 [lindex $s0 1]
1144    }
1145    set oldwidth($win) $w
1146}
1147
1148proc allcanvs args {
1149    global canv canv2 canv3
1150    eval $canv $args
1151    eval $canv2 $args
1152    eval $canv3 $args
1153}
1154
1155proc bindall {event action} {
1156    global canv canv2 canv3
1157    bind $canv $event $action
1158    bind $canv2 $event $action
1159    bind $canv3 $event $action
1160}
1161
1162proc about {} {
1163    global uifont
1164    set w .about
1165    if {[winfo exists $w]} {
1166        raise $w
1167        return
1168    }
1169    toplevel $w
1170    wm title $w "About gitk"
1171    message $w.m -text {
1172Gitk - a commit viewer for git
1173
1174Copyright © 2005-2006 Paul Mackerras
1175
1176Use and redistribute under the terms of the GNU General Public License} \
1177            -justify center -aspect 400 -border 2 -bg white -relief groove
1178    pack $w.m -side top -fill x -padx 2 -pady 2
1179    $w.m configure -font $uifont
1180    button $w.ok -text Close -command "destroy $w" -default active
1181    pack $w.ok -side bottom
1182    $w.ok configure -font $uifont
1183    bind $w <Visibility> "focus $w.ok"
1184    bind $w <Key-Escape> "destroy $w"
1185    bind $w <Key-Return> "destroy $w"
1186}
1187
1188proc keys {} {
1189    global uifont
1190    set w .keys
1191    if {[winfo exists $w]} {
1192        raise $w
1193        return
1194    }
1195    if {[tk windowingsystem] eq {aqua}} {
1196        set M1T Cmd
1197    } else {
1198        set M1T Ctrl
1199    }
1200    toplevel $w
1201    wm title $w "Gitk key bindings"
1202    message $w.m -text "
1203Gitk key bindings:
1204
1205<$M1T-Q>                Quit
1206<Home>          Move to first commit
1207<End>           Move to last commit
1208<Up>, p, i      Move up one commit
1209<Down>, n, k    Move down one commit
1210<Left>, z, j    Go back in history list
1211<Right>, x, l   Go forward in history list
1212<PageUp>        Move up one page in commit list
1213<PageDown>      Move down one page in commit list
1214<$M1T-Home>     Scroll to top of commit list
1215<$M1T-End>      Scroll to bottom of commit list
1216<$M1T-Up>       Scroll commit list up one line
1217<$M1T-Down>     Scroll commit list down one line
1218<$M1T-PageUp>   Scroll commit list up one page
1219<$M1T-PageDown> Scroll commit list down one page
1220<Shift-Up>      Move to previous highlighted line
1221<Shift-Down>    Move to next highlighted line
1222<Delete>, b     Scroll diff view up one page
1223<Backspace>     Scroll diff view up one page
1224<Space>         Scroll diff view down one page
1225u               Scroll diff view up 18 lines
1226d               Scroll diff view down 18 lines
1227<$M1T-F>                Find
1228<$M1T-G>                Move to next find hit
1229<Return>        Move to next find hit
1230/               Move to next find hit, or redo find
1231?               Move to previous find hit
1232f               Scroll diff view to next file
1233<$M1T-S>                Search for next hit in diff view
1234<$M1T-R>                Search for previous hit in diff view
1235<$M1T-KP+>      Increase font size
1236<$M1T-plus>     Increase font size
1237<$M1T-KP->      Decrease font size
1238<$M1T-minus>    Decrease font size
1239<F5>            Update
1240" \
1241            -justify left -bg white -border 2 -relief groove
1242    pack $w.m -side top -fill both -padx 2 -pady 2
1243    $w.m configure -font $uifont
1244    button $w.ok -text Close -command "destroy $w" -default active
1245    pack $w.ok -side bottom
1246    $w.ok configure -font $uifont
1247    bind $w <Visibility> "focus $w.ok"
1248    bind $w <Key-Escape> "destroy $w"
1249    bind $w <Key-Return> "destroy $w"
1250}
1251
1252# Procedures for manipulating the file list window at the
1253# bottom right of the overall window.
1254
1255proc treeview {w l openlevs} {
1256    global treecontents treediropen treeheight treeparent treeindex
1257
1258    set ix 0
1259    set treeindex() 0
1260    set lev 0
1261    set prefix {}
1262    set prefixend -1
1263    set prefendstack {}
1264    set htstack {}
1265    set ht 0
1266    set treecontents() {}
1267    $w conf -state normal
1268    foreach f $l {
1269        while {[string range $f 0 $prefixend] ne $prefix} {
1270            if {$lev <= $openlevs} {
1271                $w mark set e:$treeindex($prefix) "end -1c"
1272                $w mark gravity e:$treeindex($prefix) left
1273            }
1274            set treeheight($prefix) $ht
1275            incr ht [lindex $htstack end]
1276            set htstack [lreplace $htstack end end]
1277            set prefixend [lindex $prefendstack end]
1278            set prefendstack [lreplace $prefendstack end end]
1279            set prefix [string range $prefix 0 $prefixend]
1280            incr lev -1
1281        }
1282        set tail [string range $f [expr {$prefixend+1}] end]
1283        while {[set slash [string first "/" $tail]] >= 0} {
1284            lappend htstack $ht
1285            set ht 0
1286            lappend prefendstack $prefixend
1287            incr prefixend [expr {$slash + 1}]
1288            set d [string range $tail 0 $slash]
1289            lappend treecontents($prefix) $d
1290            set oldprefix $prefix
1291            append prefix $d
1292            set treecontents($prefix) {}
1293            set treeindex($prefix) [incr ix]
1294            set treeparent($prefix) $oldprefix
1295            set tail [string range $tail [expr {$slash+1}] end]
1296            if {$lev <= $openlevs} {
1297                set ht 1
1298                set treediropen($prefix) [expr {$lev < $openlevs}]
1299                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1300                $w mark set d:$ix "end -1c"
1301                $w mark gravity d:$ix left
1302                set str "\n"
1303                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1304                $w insert end $str
1305                $w image create end -align center -image $bm -padx 1 \
1306                    -name a:$ix
1307                $w insert end $d [highlight_tag $prefix]
1308                $w mark set s:$ix "end -1c"
1309                $w mark gravity s:$ix left
1310            }
1311            incr lev
1312        }
1313        if {$tail ne {}} {
1314            if {$lev <= $openlevs} {
1315                incr ht
1316                set str "\n"
1317                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1318                $w insert end $str
1319                $w insert end $tail [highlight_tag $f]
1320            }
1321            lappend treecontents($prefix) $tail
1322        }
1323    }
1324    while {$htstack ne {}} {
1325        set treeheight($prefix) $ht
1326        incr ht [lindex $htstack end]
1327        set htstack [lreplace $htstack end end]
1328        set prefixend [lindex $prefendstack end]
1329        set prefendstack [lreplace $prefendstack end end]
1330        set prefix [string range $prefix 0 $prefixend]
1331    }
1332    $w conf -state disabled
1333}
1334
1335proc linetoelt {l} {
1336    global treeheight treecontents
1337
1338    set y 2
1339    set prefix {}
1340    while {1} {
1341        foreach e $treecontents($prefix) {
1342            if {$y == $l} {
1343                return "$prefix$e"
1344            }
1345            set n 1
1346            if {[string index $e end] eq "/"} {
1347                set n $treeheight($prefix$e)
1348                if {$y + $n > $l} {
1349                    append prefix $e
1350                    incr y
1351                    break
1352                }
1353            }
1354            incr y $n
1355        }
1356    }
1357}
1358
1359proc highlight_tree {y prefix} {
1360    global treeheight treecontents cflist
1361
1362    foreach e $treecontents($prefix) {
1363        set path $prefix$e
1364        if {[highlight_tag $path] ne {}} {
1365            $cflist tag add bold $y.0 "$y.0 lineend"
1366        }
1367        incr y
1368        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1369            set y [highlight_tree $y $path]
1370        }
1371    }
1372    return $y
1373}
1374
1375proc treeclosedir {w dir} {
1376    global treediropen treeheight treeparent treeindex
1377
1378    set ix $treeindex($dir)
1379    $w conf -state normal
1380    $w delete s:$ix e:$ix
1381    set treediropen($dir) 0
1382    $w image configure a:$ix -image tri-rt
1383    $w conf -state disabled
1384    set n [expr {1 - $treeheight($dir)}]
1385    while {$dir ne {}} {
1386        incr treeheight($dir) $n
1387        set dir $treeparent($dir)
1388    }
1389}
1390
1391proc treeopendir {w dir} {
1392    global treediropen treeheight treeparent treecontents treeindex
1393
1394    set ix $treeindex($dir)
1395    $w conf -state normal
1396    $w image configure a:$ix -image tri-dn
1397    $w mark set e:$ix s:$ix
1398    $w mark gravity e:$ix right
1399    set lev 0
1400    set str "\n"
1401    set n [llength $treecontents($dir)]
1402    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1403        incr lev
1404        append str "\t"
1405        incr treeheight($x) $n
1406    }
1407    foreach e $treecontents($dir) {
1408        set de $dir$e
1409        if {[string index $e end] eq "/"} {
1410            set iy $treeindex($de)
1411            $w mark set d:$iy e:$ix
1412            $w mark gravity d:$iy left
1413            $w insert e:$ix $str
1414            set treediropen($de) 0
1415            $w image create e:$ix -align center -image tri-rt -padx 1 \
1416                -name a:$iy
1417            $w insert e:$ix $e [highlight_tag $de]
1418            $w mark set s:$iy e:$ix
1419            $w mark gravity s:$iy left
1420            set treeheight($de) 1
1421        } else {
1422            $w insert e:$ix $str
1423            $w insert e:$ix $e [highlight_tag $de]
1424        }
1425    }
1426    $w mark gravity e:$ix left
1427    $w conf -state disabled
1428    set treediropen($dir) 1
1429    set top [lindex [split [$w index @0,0] .] 0]
1430    set ht [$w cget -height]
1431    set l [lindex [split [$w index s:$ix] .] 0]
1432    if {$l < $top} {
1433        $w yview $l.0
1434    } elseif {$l + $n + 1 > $top + $ht} {
1435        set top [expr {$l + $n + 2 - $ht}]
1436        if {$l < $top} {
1437            set top $l
1438        }
1439        $w yview $top.0
1440    }
1441}
1442
1443proc treeclick {w x y} {
1444    global treediropen cmitmode ctext cflist cflist_top
1445
1446    if {$cmitmode ne "tree"} return
1447    if {![info exists cflist_top]} return
1448    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1449    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1450    $cflist tag add highlight $l.0 "$l.0 lineend"
1451    set cflist_top $l
1452    if {$l == 1} {
1453        $ctext yview 1.0
1454        return
1455    }
1456    set e [linetoelt $l]
1457    if {[string index $e end] ne "/"} {
1458        showfile $e
1459    } elseif {$treediropen($e)} {
1460        treeclosedir $w $e
1461    } else {
1462        treeopendir $w $e
1463    }
1464}
1465
1466proc setfilelist {id} {
1467    global treefilelist cflist
1468
1469    treeview $cflist $treefilelist($id) 0
1470}
1471
1472image create bitmap tri-rt -background black -foreground blue -data {
1473    #define tri-rt_width 13
1474    #define tri-rt_height 13
1475    static unsigned char tri-rt_bits[] = {
1476       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1477       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1478       0x00, 0x00};
1479} -maskdata {
1480    #define tri-rt-mask_width 13
1481    #define tri-rt-mask_height 13
1482    static unsigned char tri-rt-mask_bits[] = {
1483       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1484       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1485       0x08, 0x00};
1486}
1487image create bitmap tri-dn -background black -foreground blue -data {
1488    #define tri-dn_width 13
1489    #define tri-dn_height 13
1490    static unsigned char tri-dn_bits[] = {
1491       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1492       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1493       0x00, 0x00};
1494} -maskdata {
1495    #define tri-dn-mask_width 13
1496    #define tri-dn-mask_height 13
1497    static unsigned char tri-dn-mask_bits[] = {
1498       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1499       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1500       0x00, 0x00};
1501}
1502
1503image create bitmap reficon-T -background black -foreground yellow -data {
1504    #define tagicon_width 13
1505    #define tagicon_height 9
1506    static unsigned char tagicon_bits[] = {
1507       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1508       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1509} -maskdata {
1510    #define tagicon-mask_width 13
1511    #define tagicon-mask_height 9
1512    static unsigned char tagicon-mask_bits[] = {
1513       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1514       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1515}
1516set rectdata {
1517    #define headicon_width 13
1518    #define headicon_height 9
1519    static unsigned char headicon_bits[] = {
1520       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1521       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1522}
1523set rectmask {
1524    #define headicon-mask_width 13
1525    #define headicon-mask_height 9
1526    static unsigned char headicon-mask_bits[] = {
1527       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1528       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1529}
1530image create bitmap reficon-H -background black -foreground green \
1531    -data $rectdata -maskdata $rectmask
1532image create bitmap reficon-o -background black -foreground "#ddddff" \
1533    -data $rectdata -maskdata $rectmask
1534
1535proc init_flist {first} {
1536    global cflist cflist_top selectedline difffilestart
1537
1538    $cflist conf -state normal
1539    $cflist delete 0.0 end
1540    if {$first ne {}} {
1541        $cflist insert end $first
1542        set cflist_top 1
1543        $cflist tag add highlight 1.0 "1.0 lineend"
1544    } else {
1545        catch {unset cflist_top}
1546    }
1547    $cflist conf -state disabled
1548    set difffilestart {}
1549}
1550
1551proc highlight_tag {f} {
1552    global highlight_paths
1553
1554    foreach p $highlight_paths {
1555        if {[string match $p $f]} {
1556            return "bold"
1557        }
1558    }
1559    return {}
1560}
1561
1562proc highlight_filelist {} {
1563    global cmitmode cflist
1564
1565    $cflist conf -state normal
1566    if {$cmitmode ne "tree"} {
1567        set end [lindex [split [$cflist index end] .] 0]
1568        for {set l 2} {$l < $end} {incr l} {
1569            set line [$cflist get $l.0 "$l.0 lineend"]
1570            if {[highlight_tag $line] ne {}} {
1571                $cflist tag add bold $l.0 "$l.0 lineend"
1572            }
1573        }
1574    } else {
1575        highlight_tree 2 {}
1576    }
1577    $cflist conf -state disabled
1578}
1579
1580proc unhighlight_filelist {} {
1581    global cflist
1582
1583    $cflist conf -state normal
1584    $cflist tag remove bold 1.0 end
1585    $cflist conf -state disabled
1586}
1587
1588proc add_flist {fl} {
1589    global cflist
1590
1591    $cflist conf -state normal
1592    foreach f $fl {
1593        $cflist insert end "\n"
1594        $cflist insert end $f [highlight_tag $f]
1595    }
1596    $cflist conf -state disabled
1597}
1598
1599proc sel_flist {w x y} {
1600    global ctext difffilestart cflist cflist_top cmitmode
1601
1602    if {$cmitmode eq "tree"} return
1603    if {![info exists cflist_top]} return
1604    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1605    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1606    $cflist tag add highlight $l.0 "$l.0 lineend"
1607    set cflist_top $l
1608    if {$l == 1} {
1609        $ctext yview 1.0
1610    } else {
1611        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1612    }
1613}
1614
1615proc pop_flist_menu {w X Y x y} {
1616    global ctext cflist cmitmode flist_menu flist_menu_file
1617    global treediffs diffids
1618
1619    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1620    if {$l <= 1} return
1621    if {$cmitmode eq "tree"} {
1622        set e [linetoelt $l]
1623        if {[string index $e end] eq "/"} return
1624    } else {
1625        set e [lindex $treediffs($diffids) [expr {$l-2}]]
1626    }
1627    set flist_menu_file $e
1628    tk_popup $flist_menu $X $Y
1629}
1630
1631proc flist_hl {only} {
1632    global flist_menu_file highlight_files
1633
1634    set x [shellquote $flist_menu_file]
1635    if {$only || $highlight_files eq {}} {
1636        set highlight_files $x
1637    } else {
1638        append highlight_files " " $x
1639    }
1640}
1641
1642# Functions for adding and removing shell-type quoting
1643
1644proc shellquote {str} {
1645    if {![string match "*\['\"\\ \t]*" $str]} {
1646        return $str
1647    }
1648    if {![string match "*\['\"\\]*" $str]} {
1649        return "\"$str\""
1650    }
1651    if {![string match "*'*" $str]} {
1652        return "'$str'"
1653    }
1654    return "\"[string map {\" \\\" \\ \\\\} $str]\""
1655}
1656
1657proc shellarglist {l} {
1658    set str {}
1659    foreach a $l {
1660        if {$str ne {}} {
1661            append str " "
1662        }
1663        append str [shellquote $a]
1664    }
1665    return $str
1666}
1667
1668proc shelldequote {str} {
1669    set ret {}
1670    set used -1
1671    while {1} {
1672        incr used
1673        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1674            append ret [string range $str $used end]
1675            set used [string length $str]
1676            break
1677        }
1678        set first [lindex $first 0]
1679        set ch [string index $str $first]
1680        if {$first > $used} {
1681            append ret [string range $str $used [expr {$first - 1}]]
1682            set used $first
1683        }
1684        if {$ch eq " " || $ch eq "\t"} break
1685        incr used
1686        if {$ch eq "'"} {
1687            set first [string first "'" $str $used]
1688            if {$first < 0} {
1689                error "unmatched single-quote"
1690            }
1691            append ret [string range $str $used [expr {$first - 1}]]
1692            set used $first
1693            continue
1694        }
1695        if {$ch eq "\\"} {
1696            if {$used >= [string length $str]} {
1697                error "trailing backslash"
1698            }
1699            append ret [string index $str $used]
1700            continue
1701        }
1702        # here ch == "\""
1703        while {1} {
1704            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1705                error "unmatched double-quote"
1706            }
1707            set first [lindex $first 0]
1708            set ch [string index $str $first]
1709            if {$first > $used} {
1710                append ret [string range $str $used [expr {$first - 1}]]
1711                set used $first
1712            }
1713            if {$ch eq "\""} break
1714            incr used
1715            append ret [string index $str $used]
1716            incr used
1717        }
1718    }
1719    return [list $used $ret]
1720}
1721
1722proc shellsplit {str} {
1723    set l {}
1724    while {1} {
1725        set str [string trimleft $str]
1726        if {$str eq {}} break
1727        set dq [shelldequote $str]
1728        set n [lindex $dq 0]
1729        set word [lindex $dq 1]
1730        set str [string range $str $n end]
1731        lappend l $word
1732    }
1733    return $l
1734}
1735
1736# Code to implement multiple views
1737
1738proc newview {ishighlight} {
1739    global nextviewnum newviewname newviewperm uifont newishighlight
1740    global newviewargs revtreeargs
1741
1742    set newishighlight $ishighlight
1743    set top .gitkview
1744    if {[winfo exists $top]} {
1745        raise $top
1746        return
1747    }
1748    set newviewname($nextviewnum) "View $nextviewnum"
1749    set newviewperm($nextviewnum) 0
1750    set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1751    vieweditor $top $nextviewnum "Gitk view definition"
1752}
1753
1754proc editview {} {
1755    global curview
1756    global viewname viewperm newviewname newviewperm
1757    global viewargs newviewargs
1758
1759    set top .gitkvedit-$curview
1760    if {[winfo exists $top]} {
1761        raise $top
1762        return
1763    }
1764    set newviewname($curview) $viewname($curview)
1765    set newviewperm($curview) $viewperm($curview)
1766    set newviewargs($curview) [shellarglist $viewargs($curview)]
1767    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1768}
1769
1770proc vieweditor {top n title} {
1771    global newviewname newviewperm viewfiles
1772    global uifont
1773
1774    toplevel $top
1775    wm title $top $title
1776    label $top.nl -text "Name" -font $uifont
1777    entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1778    grid $top.nl $top.name -sticky w -pady 5
1779    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1780        -font $uifont
1781    grid $top.perm - -pady 5 -sticky w
1782    message $top.al -aspect 1000 -font $uifont \
1783        -text "Commits to include (arguments to git rev-list):"
1784    grid $top.al - -sticky w -pady 5
1785    entry $top.args -width 50 -textvariable newviewargs($n) \
1786        -background white -font $uifont
1787    grid $top.args - -sticky ew -padx 5
1788    message $top.l -aspect 1000 -font $uifont \
1789        -text "Enter files and directories to include, one per line:"
1790    grid $top.l - -sticky w
1791    text $top.t -width 40 -height 10 -background white -font $uifont
1792    if {[info exists viewfiles($n)]} {
1793        foreach f $viewfiles($n) {
1794            $top.t insert end $f
1795            $top.t insert end "\n"
1796        }
1797        $top.t delete {end - 1c} end
1798        $top.t mark set insert 0.0
1799    }
1800    grid $top.t - -sticky ew -padx 5
1801    frame $top.buts
1802    button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1803        -font $uifont
1804    button $top.buts.can -text "Cancel" -command [list destroy $top] \
1805        -font $uifont
1806    grid $top.buts.ok $top.buts.can
1807    grid columnconfigure $top.buts 0 -weight 1 -uniform a
1808    grid columnconfigure $top.buts 1 -weight 1 -uniform a
1809    grid $top.buts - -pady 10 -sticky ew
1810    focus $top.t
1811}
1812
1813proc doviewmenu {m first cmd op argv} {
1814    set nmenu [$m index end]
1815    for {set i $first} {$i <= $nmenu} {incr i} {
1816        if {[$m entrycget $i -command] eq $cmd} {
1817            eval $m $op $i $argv
1818            break
1819        }
1820    }
1821}
1822
1823proc allviewmenus {n op args} {
1824    global viewhlmenu
1825
1826    doviewmenu .bar.view 5 [list showview $n] $op $args
1827    doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1828}
1829
1830proc newviewok {top n} {
1831    global nextviewnum newviewperm newviewname newishighlight
1832    global viewname viewfiles viewperm selectedview curview
1833    global viewargs newviewargs viewhlmenu
1834
1835    if {[catch {
1836        set newargs [shellsplit $newviewargs($n)]
1837    } err]} {
1838        error_popup "Error in commit selection arguments: $err"
1839        wm raise $top
1840        focus $top
1841        return
1842    }
1843    set files {}
1844    foreach f [split [$top.t get 0.0 end] "\n"] {
1845        set ft [string trim $f]
1846        if {$ft ne {}} {
1847            lappend files $ft
1848        }
1849    }
1850    if {![info exists viewfiles($n)]} {
1851        # creating a new view
1852        incr nextviewnum
1853        set viewname($n) $newviewname($n)
1854        set viewperm($n) $newviewperm($n)
1855        set viewfiles($n) $files
1856        set viewargs($n) $newargs
1857        addviewmenu $n
1858        if {!$newishighlight} {
1859            run showview $n
1860        } else {
1861            run addvhighlight $n
1862        }
1863    } else {
1864        # editing an existing view
1865        set viewperm($n) $newviewperm($n)
1866        if {$newviewname($n) ne $viewname($n)} {
1867            set viewname($n) $newviewname($n)
1868            doviewmenu .bar.view 5 [list showview $n] \
1869                entryconf [list -label $viewname($n)]
1870            doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1871                entryconf [list -label $viewname($n) -value $viewname($n)]
1872        }
1873        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1874            set viewfiles($n) $files
1875            set viewargs($n) $newargs
1876            if {$curview == $n} {
1877                run updatecommits
1878            }
1879        }
1880    }
1881    catch {destroy $top}
1882}
1883
1884proc delview {} {
1885    global curview viewdata viewperm hlview selectedhlview
1886
1887    if {$curview == 0} return
1888    if {[info exists hlview] && $hlview == $curview} {
1889        set selectedhlview None
1890        unset hlview
1891    }
1892    allviewmenus $curview delete
1893    set viewdata($curview) {}
1894    set viewperm($curview) 0
1895    showview 0
1896}
1897
1898proc addviewmenu {n} {
1899    global viewname viewhlmenu
1900
1901    .bar.view add radiobutton -label $viewname($n) \
1902        -command [list showview $n] -variable selectedview -value $n
1903    $viewhlmenu add radiobutton -label $viewname($n) \
1904        -command [list addvhighlight $n] -variable selectedhlview
1905}
1906
1907proc flatten {var} {
1908    global $var
1909
1910    set ret {}
1911    foreach i [array names $var] {
1912        lappend ret $i [set $var\($i\)]
1913    }
1914    return $ret
1915}
1916
1917proc unflatten {var l} {
1918    global $var
1919
1920    catch {unset $var}
1921    foreach {i v} $l {
1922        set $var\($i\) $v
1923    }
1924}
1925
1926proc showview {n} {
1927    global curview viewdata viewfiles
1928    global displayorder parentlist rowidlist
1929    global colormap rowtextx commitrow nextcolor canvxmax
1930    global numcommits commitlisted rowchk
1931    global selectedline currentid canv canvy0
1932    global treediffs
1933    global pending_select phase
1934    global commitidx rowlaidout rowoptim
1935    global commfd
1936    global selectedview selectfirst
1937    global vparentlist vdisporder vcmitlisted
1938    global hlview selectedhlview
1939
1940    if {$n == $curview} return
1941    set selid {}
1942    if {[info exists selectedline]} {
1943        set selid $currentid
1944        set y [yc $selectedline]
1945        set ymax [lindex [$canv cget -scrollregion] 3]
1946        set span [$canv yview]
1947        set ytop [expr {[lindex $span 0] * $ymax}]
1948        set ybot [expr {[lindex $span 1] * $ymax}]
1949        if {$ytop < $y && $y < $ybot} {
1950            set yscreen [expr {$y - $ytop}]
1951        } else {
1952            set yscreen [expr {($ybot - $ytop) / 2}]
1953        }
1954    } elseif {[info exists pending_select]} {
1955        set selid $pending_select
1956        unset pending_select
1957    }
1958    unselectline
1959    normalline
1960    if {$curview >= 0} {
1961        set vparentlist($curview) $parentlist
1962        set vdisporder($curview) $displayorder
1963        set vcmitlisted($curview) $commitlisted
1964        if {$phase ne {}} {
1965            set viewdata($curview) \
1966                [list $phase $rowidlist {} {} \
1967                     {} [flatten idinlist] \
1968                     $rowlaidout $rowoptim $numcommits]
1969        } elseif {![info exists viewdata($curview)]
1970                  || [lindex $viewdata($curview) 0] ne {}} {
1971            set viewdata($curview) \
1972                [list {} $rowidlist {} {}]
1973        }
1974    }
1975    catch {unset treediffs}
1976    clear_display
1977    if {[info exists hlview] && $hlview == $n} {
1978        unset hlview
1979        set selectedhlview None
1980    }
1981
1982    set curview $n
1983    set selectedview $n
1984    .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1985    .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1986
1987    if {![info exists viewdata($n)]} {
1988        if {$selid ne {}} {
1989            set pending_select $selid
1990        }
1991        getcommits
1992        return
1993    }
1994
1995    set v $viewdata($n)
1996    set phase [lindex $v 0]
1997    set displayorder $vdisporder($n)
1998    set parentlist $vparentlist($n)
1999    set commitlisted $vcmitlisted($n)
2000    set rowidlist [lindex $v 1]
2001    if {$phase eq {}} {
2002        set numcommits [llength $displayorder]
2003    } else {
2004        unflatten idinlist [lindex $v 5]
2005        set rowlaidout [lindex $v 6]
2006        set rowoptim [lindex $v 7]
2007        set numcommits [lindex $v 8]
2008        catch {unset rowchk}
2009    }
2010
2011    catch {unset colormap}
2012    catch {unset rowtextx}
2013    set nextcolor 0
2014    set canvxmax [$canv cget -width]
2015    set curview $n
2016    set row 0
2017    setcanvscroll
2018    set yf 0
2019    set row {}
2020    set selectfirst 0
2021    if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2022        set row $commitrow($n,$selid)
2023        # try to get the selected row in the same position on the screen
2024        set ymax [lindex [$canv cget -scrollregion] 3]
2025        set ytop [expr {[yc $row] - $yscreen}]
2026        if {$ytop < 0} {
2027            set ytop 0
2028        }
2029        set yf [expr {$ytop * 1.0 / $ymax}]
2030    }
2031    allcanvs yview moveto $yf
2032    drawvisible
2033    if {$row ne {}} {
2034        selectline $row 0
2035    } elseif {$selid ne {}} {
2036        set pending_select $selid
2037    } else {
2038        set row [first_real_row]
2039        if {$row < $numcommits} {
2040            selectline $row 0
2041        } else {
2042            set selectfirst 1
2043        }
2044    }
2045    if {$phase ne {}} {
2046        if {$phase eq "getcommits"} {
2047            show_status "Reading commits..."
2048        }
2049        run chewcommits $n
2050    } elseif {$numcommits == 0} {
2051        show_status "No commits selected"
2052    }
2053    run refill_reflist
2054}
2055
2056# Stuff relating to the highlighting facility
2057
2058proc ishighlighted {row} {
2059    global vhighlights fhighlights nhighlights rhighlights
2060
2061    if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2062        return $nhighlights($row)
2063    }
2064    if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2065        return $vhighlights($row)
2066    }
2067    if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2068        return $fhighlights($row)
2069    }
2070    if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2071        return $rhighlights($row)
2072    }
2073    return 0
2074}
2075
2076proc bolden {row font} {
2077    global canv linehtag selectedline boldrows
2078
2079    lappend boldrows $row
2080    $canv itemconf $linehtag($row) -font $font
2081    if {[info exists selectedline] && $row == $selectedline} {
2082        $canv delete secsel
2083        set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2084                   -outline {{}} -tags secsel \
2085                   -fill [$canv cget -selectbackground]]
2086        $canv lower $t
2087    }
2088}
2089
2090proc bolden_name {row font} {
2091    global canv2 linentag selectedline boldnamerows
2092
2093    lappend boldnamerows $row
2094    $canv2 itemconf $linentag($row) -font $font
2095    if {[info exists selectedline] && $row == $selectedline} {
2096        $canv2 delete secsel
2097        set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2098                   -outline {{}} -tags secsel \
2099                   -fill [$canv2 cget -selectbackground]]
2100        $canv2 lower $t
2101    }
2102}
2103
2104proc unbolden {} {
2105    global mainfont boldrows
2106
2107    set stillbold {}
2108    foreach row $boldrows {
2109        if {![ishighlighted $row]} {
2110            bolden $row $mainfont
2111        } else {
2112            lappend stillbold $row
2113        }
2114    }
2115    set boldrows $stillbold
2116}
2117
2118proc addvhighlight {n} {
2119    global hlview curview viewdata vhl_done vhighlights commitidx
2120
2121    if {[info exists hlview]} {
2122        delvhighlight
2123    }
2124    set hlview $n
2125    if {$n != $curview && ![info exists viewdata($n)]} {
2126        set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
2127        set vparentlist($n) {}
2128        set vdisporder($n) {}
2129        set vcmitlisted($n) {}
2130        start_rev_list $n
2131    }
2132    set vhl_done $commitidx($hlview)
2133    if {$vhl_done > 0} {
2134        drawvisible
2135    }
2136}
2137
2138proc delvhighlight {} {
2139    global hlview vhighlights
2140
2141    if {![info exists hlview]} return
2142    unset hlview
2143    catch {unset vhighlights}
2144    unbolden
2145}
2146
2147proc vhighlightmore {} {
2148    global hlview vhl_done commitidx vhighlights
2149    global displayorder vdisporder curview mainfont
2150
2151    set font [concat $mainfont bold]
2152    set max $commitidx($hlview)
2153    if {$hlview == $curview} {
2154        set disp $displayorder
2155    } else {
2156        set disp $vdisporder($hlview)
2157    }
2158    set vr [visiblerows]
2159    set r0 [lindex $vr 0]
2160    set r1 [lindex $vr 1]
2161    for {set i $vhl_done} {$i < $max} {incr i} {
2162        set id [lindex $disp $i]
2163        if {[info exists commitrow($curview,$id)]} {
2164            set row $commitrow($curview,$id)
2165            if {$r0 <= $row && $row <= $r1} {
2166                if {![highlighted $row]} {
2167                    bolden $row $font
2168                }
2169                set vhighlights($row) 1
2170            }
2171        }
2172    }
2173    set vhl_done $max
2174}
2175
2176proc askvhighlight {row id} {
2177    global hlview vhighlights commitrow iddrawn mainfont
2178
2179    if {[info exists commitrow($hlview,$id)]} {
2180        if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2181            bolden $row [concat $mainfont bold]
2182        }
2183        set vhighlights($row) 1
2184    } else {
2185        set vhighlights($row) 0
2186    }
2187}
2188
2189proc hfiles_change {name ix op} {
2190    global highlight_files filehighlight fhighlights fh_serial
2191    global mainfont highlight_paths
2192
2193    if {[info exists filehighlight]} {
2194        # delete previous highlights
2195        catch {close $filehighlight}
2196        unset filehighlight
2197        catch {unset fhighlights}
2198        unbolden
2199        unhighlight_filelist
2200    }
2201    set highlight_paths {}
2202    after cancel do_file_hl $fh_serial
2203    incr fh_serial
2204    if {$highlight_files ne {}} {
2205        after 300 do_file_hl $fh_serial
2206    }
2207}
2208
2209proc makepatterns {l} {
2210    set ret {}
2211    foreach e $l {
2212        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2213        if {[string index $ee end] eq "/"} {
2214            lappend ret "$ee*"
2215        } else {
2216            lappend ret $ee
2217            lappend ret "$ee/*"
2218        }
2219    }
2220    return $ret
2221}
2222
2223proc do_file_hl {serial} {
2224    global highlight_files filehighlight highlight_paths gdttype fhl_list
2225
2226    if {$gdttype eq "touching paths:"} {
2227        if {[catch {set paths [shellsplit $highlight_files]}]} return
2228        set highlight_paths [makepatterns $paths]
2229        highlight_filelist
2230        set gdtargs [concat -- $paths]
2231    } else {
2232        set gdtargs [list "-S$highlight_files"]
2233    }
2234    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2235    set filehighlight [open $cmd r+]
2236    fconfigure $filehighlight -blocking 0
2237    filerun $filehighlight readfhighlight
2238    set fhl_list {}
2239    drawvisible
2240    flushhighlights
2241}
2242
2243proc flushhighlights {} {
2244    global filehighlight fhl_list
2245
2246    if {[info exists filehighlight]} {
2247        lappend fhl_list {}
2248        puts $filehighlight ""
2249        flush $filehighlight
2250    }
2251}
2252
2253proc askfilehighlight {row id} {
2254    global filehighlight fhighlights fhl_list
2255
2256    lappend fhl_list $id
2257    set fhighlights($row) -1
2258    puts $filehighlight $id
2259}
2260
2261proc readfhighlight {} {
2262    global filehighlight fhighlights commitrow curview mainfont iddrawn
2263    global fhl_list
2264
2265    if {![info exists filehighlight]} {
2266        return 0
2267    }
2268    set nr 0
2269    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2270        set line [string trim $line]
2271        set i [lsearch -exact $fhl_list $line]
2272        if {$i < 0} continue
2273        for {set j 0} {$j < $i} {incr j} {
2274            set id [lindex $fhl_list $j]
2275            if {[info exists commitrow($curview,$id)]} {
2276                set fhighlights($commitrow($curview,$id)) 0
2277            }
2278        }
2279        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2280        if {$line eq {}} continue
2281        if {![info exists commitrow($curview,$line)]} continue
2282        set row $commitrow($curview,$line)
2283        if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2284            bolden $row [concat $mainfont bold]
2285        }
2286        set fhighlights($row) 1
2287    }
2288    if {[eof $filehighlight]} {
2289        # strange...
2290        puts "oops, git diff-tree died"
2291        catch {close $filehighlight}
2292        unset filehighlight
2293        return 0
2294    }
2295    next_hlcont
2296    return 1
2297}
2298
2299proc find_change {name ix op} {
2300    global nhighlights mainfont boldnamerows
2301    global findstring findpattern findtype
2302
2303    # delete previous highlights, if any
2304    foreach row $boldnamerows {
2305        bolden_name $row $mainfont
2306    }
2307    set boldnamerows {}
2308    catch {unset nhighlights}
2309    unbolden
2310    unmarkmatches
2311    if {$findtype ne "Regexp"} {
2312        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2313                   $findstring]
2314        set findpattern "*$e*"
2315    }
2316    drawvisible
2317}
2318
2319proc doesmatch {f} {
2320    global findtype findstring findpattern
2321
2322    if {$findtype eq "Regexp"} {
2323        return [regexp $findstring $f]
2324    } elseif {$findtype eq "IgnCase"} {
2325        return [string match -nocase $findpattern $f]
2326    } else {
2327        return [string match $findpattern $f]
2328    }
2329}
2330
2331proc askfindhighlight {row id} {
2332    global nhighlights commitinfo iddrawn mainfont
2333    global findloc
2334    global markingmatches
2335
2336    if {![info exists commitinfo($id)]} {
2337        getcommit $id
2338    }
2339    set info $commitinfo($id)
2340    set isbold 0
2341    set fldtypes {Headline Author Date Committer CDate Comments}
2342    foreach f $info ty $fldtypes {
2343        if {($findloc eq "All fields" || $findloc eq $ty) &&
2344            [doesmatch $f]} {
2345            if {$ty eq "Author"} {
2346                set isbold 2
2347                break
2348            }
2349            set isbold 1
2350        }
2351    }
2352    if {$isbold && [info exists iddrawn($id)]} {
2353        set f [concat $mainfont bold]
2354        if {![ishighlighted $row]} {
2355            bolden $row $f
2356            if {$isbold > 1} {
2357                bolden_name $row $f
2358            }
2359        }
2360        if {$markingmatches} {
2361            markrowmatches $row $id
2362        }
2363    }
2364    set nhighlights($row) $isbold
2365}
2366
2367proc markrowmatches {row id} {
2368    global canv canv2 linehtag linentag commitinfo findloc
2369
2370    set headline [lindex $commitinfo($id) 0]
2371    set author [lindex $commitinfo($id) 1]
2372    $canv delete match$row
2373    $canv2 delete match$row
2374    if {$findloc eq "All fields" || $findloc eq "Headline"} {
2375        set m [findmatches $headline]
2376        if {$m ne {}} {
2377            markmatches $canv $row $headline $linehtag($row) $m \
2378                [$canv itemcget $linehtag($row) -font] $row
2379        }
2380    }
2381    if {$findloc eq "All fields" || $findloc eq "Author"} {
2382        set m [findmatches $author]
2383        if {$m ne {}} {
2384            markmatches $canv2 $row $author $linentag($row) $m \
2385                [$canv2 itemcget $linentag($row) -font] $row
2386        }
2387    }
2388}
2389
2390proc vrel_change {name ix op} {
2391    global highlight_related
2392
2393    rhighlight_none
2394    if {$highlight_related ne "None"} {
2395        run drawvisible
2396    }
2397}
2398
2399# prepare for testing whether commits are descendents or ancestors of a
2400proc rhighlight_sel {a} {
2401    global descendent desc_todo ancestor anc_todo
2402    global highlight_related rhighlights
2403
2404    catch {unset descendent}
2405    set desc_todo [list $a]
2406    catch {unset ancestor}
2407    set anc_todo [list $a]
2408    if {$highlight_related ne "None"} {
2409        rhighlight_none
2410        run drawvisible
2411    }
2412}
2413
2414proc rhighlight_none {} {
2415    global rhighlights
2416
2417    catch {unset rhighlights}
2418    unbolden
2419}
2420
2421proc is_descendent {a} {
2422    global curview children commitrow descendent desc_todo
2423
2424    set v $curview
2425    set la $commitrow($v,$a)
2426    set todo $desc_todo
2427    set leftover {}
2428    set done 0
2429    for {set i 0} {$i < [llength $todo]} {incr i} {
2430        set do [lindex $todo $i]
2431        if {$commitrow($v,$do) < $la} {
2432            lappend leftover $do
2433            continue
2434        }
2435        foreach nk $children($v,$do) {
2436            if {![info exists descendent($nk)]} {
2437                set descendent($nk) 1
2438                lappend todo $nk
2439                if {$nk eq $a} {
2440                    set done 1
2441                }
2442            }
2443        }
2444        if {$done} {
2445            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2446            return
2447        }
2448    }
2449    set descendent($a) 0
2450    set desc_todo $leftover
2451}
2452
2453proc is_ancestor {a} {
2454    global curview parentlist commitrow ancestor anc_todo
2455
2456    set v $curview
2457    set la $commitrow($v,$a)
2458    set todo $anc_todo
2459    set leftover {}
2460    set done 0
2461    for {set i 0} {$i < [llength $todo]} {incr i} {
2462        set do [lindex $todo $i]
2463        if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2464            lappend leftover $do
2465            continue
2466        }
2467        foreach np [lindex $parentlist $commitrow($v,$do)] {
2468            if {![info exists ancestor($np)]} {
2469                set ancestor($np) 1
2470                lappend todo $np
2471                if {$np eq $a} {
2472                    set done 1
2473                }
2474            }
2475        }
2476        if {$done} {
2477            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2478            return
2479        }
2480    }
2481    set ancestor($a) 0
2482    set anc_todo $leftover
2483}
2484
2485proc askrelhighlight {row id} {
2486    global descendent highlight_related iddrawn mainfont rhighlights
2487    global selectedline ancestor
2488
2489    if {![info exists selectedline]} return
2490    set isbold 0
2491    if {$highlight_related eq "Descendent" ||
2492        $highlight_related eq "Not descendent"} {
2493        if {![info exists descendent($id)]} {
2494            is_descendent $id
2495        }
2496        if {$descendent($id) == ($highlight_related eq "Descendent")} {
2497            set isbold 1
2498        }
2499    } elseif {$highlight_related eq "Ancestor" ||
2500              $highlight_related eq "Not ancestor"} {
2501        if {![info exists ancestor($id)]} {
2502            is_ancestor $id
2503        }
2504        if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2505            set isbold 1
2506        }
2507    }
2508    if {[info exists iddrawn($id)]} {
2509        if {$isbold && ![ishighlighted $row]} {
2510            bolden $row [concat $mainfont bold]
2511        }
2512    }
2513    set rhighlights($row) $isbold
2514}
2515
2516proc next_hlcont {} {
2517    global fhl_row fhl_dirn displayorder numcommits
2518    global vhighlights fhighlights nhighlights rhighlights
2519    global hlview filehighlight findstring highlight_related
2520
2521    if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2522    set row $fhl_row
2523    while {1} {
2524        if {$row < 0 || $row >= $numcommits} {
2525            bell
2526            set fhl_dirn 0
2527            return
2528        }
2529        set id [lindex $displayorder $row]
2530        if {[info exists hlview]} {
2531            if {![info exists vhighlights($row)]} {
2532                askvhighlight $row $id
2533            }
2534            if {$vhighlights($row) > 0} break
2535        }
2536        if {$findstring ne {}} {
2537            if {![info exists nhighlights($row)]} {
2538                askfindhighlight $row $id
2539            }
2540            if {$nhighlights($row) > 0} break
2541        }
2542        if {$highlight_related ne "None"} {
2543            if {![info exists rhighlights($row)]} {
2544                askrelhighlight $row $id
2545            }
2546            if {$rhighlights($row) > 0} break
2547        }
2548        if {[info exists filehighlight]} {
2549            if {![info exists fhighlights($row)]} {
2550                # ask for a few more while we're at it...
2551                set r $row
2552                for {set n 0} {$n < 100} {incr n} {
2553                    if {![info exists fhighlights($r)]} {
2554                        askfilehighlight $r [lindex $displayorder $r]
2555                    }
2556                    incr r $fhl_dirn
2557                    if {$r < 0 || $r >= $numcommits} break
2558                }
2559                flushhighlights
2560            }
2561            if {$fhighlights($row) < 0} {
2562                set fhl_row $row
2563                return
2564            }
2565            if {$fhighlights($row) > 0} break
2566        }
2567        incr row $fhl_dirn
2568    }
2569    set fhl_dirn 0
2570    selectline $row 1
2571}
2572
2573proc next_highlight {dirn} {
2574    global selectedline fhl_row fhl_dirn
2575    global hlview filehighlight findstring highlight_related
2576
2577    if {![info exists selectedline]} return
2578    if {!([info exists hlview] || $findstring ne {} ||
2579          $highlight_related ne "None" || [info exists filehighlight])} return
2580    set fhl_row [expr {$selectedline + $dirn}]
2581    set fhl_dirn $dirn
2582    next_hlcont
2583}
2584
2585proc cancel_next_highlight {} {
2586    global fhl_dirn
2587
2588    set fhl_dirn 0
2589}
2590
2591# Graph layout functions
2592
2593proc shortids {ids} {
2594    set res {}
2595    foreach id $ids {
2596        if {[llength $id] > 1} {
2597            lappend res [shortids $id]
2598        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2599            lappend res [string range $id 0 7]
2600        } else {
2601            lappend res $id
2602        }
2603    }
2604    return $res
2605}
2606
2607proc incrange {l x o} {
2608    set n [llength $l]
2609    while {$x < $n} {
2610        set e [lindex $l $x]
2611        if {$e ne {}} {
2612            lset l $x [expr {$e + $o}]
2613        }
2614        incr x
2615    }
2616    return $l
2617}
2618
2619proc ntimes {n o} {
2620    set ret {}
2621    for {} {$n > 0} {incr n -1} {
2622        lappend ret $o
2623    }
2624    return $ret
2625}
2626
2627proc usedinrange {id l1 l2} {
2628    global children commitrow curview
2629
2630    if {[info exists commitrow($curview,$id)]} {
2631        set r $commitrow($curview,$id)
2632        if {$l1 <= $r && $r <= $l2} {
2633            return [expr {$r - $l1 + 1}]
2634        }
2635    }
2636    set kids $children($curview,$id)
2637    foreach c $kids {
2638        set r $commitrow($curview,$c)
2639        if {$l1 <= $r && $r <= $l2} {
2640            return [expr {$r - $l1 + 1}]
2641        }
2642    }
2643    return 0
2644}
2645
2646# Work out where id should go in idlist so that order-token
2647# values increase from left to right
2648proc idcol {idlist id {i 0}} {
2649    global ordertok curview
2650
2651    set t $ordertok($curview,$id)
2652    if {$i >= [llength $idlist] ||
2653        $t < $ordertok($curview,[lindex $idlist $i])} {
2654        if {$i > [llength $idlist]} {
2655            set i [llength $idlist]
2656        }
2657        while {[incr i -1] >= 0 &&
2658               $t < $ordertok($curview,[lindex $idlist $i])} {}
2659        incr i
2660    } else {
2661        if {$t > $ordertok($curview,[lindex $idlist $i])} {
2662            while {[incr i] < [llength $idlist] &&
2663                   $t >= $ordertok($curview,[lindex $idlist $i])} {}
2664        }
2665    }
2666    return $i
2667}
2668
2669proc makeuparrow {oid y x} {
2670    global rowidlist uparrowlen displayorder
2671
2672    for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
2673        incr y -1
2674        set idl [lindex $rowidlist $y]
2675        set x [idcol $idl $oid $x]
2676        lset rowidlist $y [linsert $idl $x $oid]
2677    }
2678}
2679
2680proc initlayout {} {
2681    global rowidlist displayorder commitlisted
2682    global rowlaidout rowoptim
2683    global idinlist rowchk
2684    global numcommits canvxmax canv
2685    global nextcolor
2686    global parentlist
2687    global colormap rowtextx
2688    global selectfirst
2689
2690    set numcommits 0
2691    set displayorder {}
2692    set commitlisted {}
2693    set parentlist {}
2694    set nextcolor 0
2695    set rowidlist {{}}
2696    catch {unset idinlist}
2697    catch {unset rowchk}
2698    set rowlaidout 0
2699    set rowoptim 0
2700    set canvxmax [$canv cget -width]
2701    catch {unset colormap}
2702    catch {unset rowtextx}
2703    set selectfirst 1
2704}
2705
2706proc setcanvscroll {} {
2707    global canv canv2 canv3 numcommits linespc canvxmax canvy0
2708
2709    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2710    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2711    $canv2 conf -scrollregion [list 0 0 0 $ymax]
2712    $canv3 conf -scrollregion [list 0 0 0 $ymax]
2713}
2714
2715proc visiblerows {} {
2716    global canv numcommits linespc
2717
2718    set ymax [lindex [$canv cget -scrollregion] 3]
2719    if {$ymax eq {} || $ymax == 0} return
2720    set f [$canv yview]
2721    set y0 [expr {int([lindex $f 0] * $ymax)}]
2722    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2723    if {$r0 < 0} {
2724        set r0 0
2725    }
2726    set y1 [expr {int([lindex $f 1] * $ymax)}]
2727    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2728    if {$r1 >= $numcommits} {
2729        set r1 [expr {$numcommits - 1}]
2730    }
2731    return [list $r0 $r1]
2732}
2733
2734proc layoutmore {tmax allread} {
2735    global rowlaidout rowoptim commitidx numcommits optim_delay
2736    global uparrowlen curview rowidlist idinlist
2737
2738    set showlast 0
2739    set showdelay $optim_delay
2740    set optdelay [expr {$uparrowlen + 1}]
2741    while {1} {
2742        if {$rowoptim - $showdelay > $numcommits} {
2743            showstuff [expr {$rowoptim - $showdelay}] $showlast
2744        } elseif {$rowlaidout - $optdelay > $rowoptim} {
2745            set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2746            if {$nr > 100} {
2747                set nr 100
2748            }
2749            optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2750            incr rowoptim $nr
2751        } elseif {$commitidx($curview) > $rowlaidout} {
2752            set nr [expr {$commitidx($curview) - $rowlaidout}]
2753            # may need to increase this threshold if uparrowlen or
2754            # mingaplen are increased...
2755            if {$nr > 200} {
2756                set nr 200
2757            }
2758            set row $rowlaidout
2759            set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2760            if {$rowlaidout == $row} {
2761                return 0
2762            }
2763        } elseif {$allread} {
2764            set optdelay 0
2765            set nrows $commitidx($curview)
2766            if {[lindex $rowidlist $nrows] ne {} ||
2767                [array names idinlist] ne {}} {
2768                layouttail
2769                set rowlaidout $commitidx($curview)
2770            } elseif {$rowoptim == $nrows} {
2771                set showdelay 0
2772                set showlast 1
2773                if {$numcommits == $nrows} {
2774                    return 0
2775                }
2776            }
2777        } else {
2778            return 0
2779        }
2780        if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2781            return 1
2782        }
2783    }
2784}
2785
2786proc showstuff {canshow last} {
2787    global numcommits commitrow pending_select selectedline curview
2788    global lookingforhead mainheadid displayorder selectfirst
2789    global lastscrollset commitinterest
2790
2791    if {$numcommits == 0} {
2792        global phase
2793        set phase "incrdraw"
2794        allcanvs delete all
2795    }
2796    for {set l $numcommits} {$l < $canshow} {incr l} {
2797        set id [lindex $displayorder $l]
2798        if {[info exists commitinterest($id)]} {
2799            foreach script $commitinterest($id) {
2800                eval [string map [list "%I" $id] $script]
2801            }
2802            unset commitinterest($id)
2803        }
2804    }
2805    set r0 $numcommits
2806    set prev $numcommits
2807    set numcommits $canshow
2808    set t [clock clicks -milliseconds]
2809    if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2810        set lastscrollset $t
2811        setcanvscroll
2812    }
2813    set rows [visiblerows]
2814    set r1 [lindex $rows 1]
2815    if {$r1 >= $canshow} {
2816        set r1 [expr {$canshow - 1}]
2817    }
2818    if {$r0 <= $r1} {
2819        drawcommits $r0 $r1
2820    }
2821    if {[info exists pending_select] &&
2822        [info exists commitrow($curview,$pending_select)] &&
2823        $commitrow($curview,$pending_select) < $numcommits} {
2824        selectline $commitrow($curview,$pending_select) 1
2825    }
2826    if {$selectfirst} {
2827        if {[info exists selectedline] || [info exists pending_select]} {
2828            set selectfirst 0
2829        } else {
2830            set l [first_real_row]
2831            selectline $l 1
2832            set selectfirst 0
2833        }
2834    }
2835    if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2836        && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2837        set lookingforhead 0
2838        dodiffindex
2839    }
2840}
2841
2842proc doshowlocalchanges {} {
2843    global lookingforhead curview mainheadid phase commitrow
2844
2845    if {[info exists commitrow($curview,$mainheadid)] &&
2846        ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2847        dodiffindex
2848    } elseif {$phase ne {}} {
2849        set lookingforhead 1
2850    }
2851}
2852
2853proc dohidelocalchanges {} {
2854    global lookingforhead localfrow localirow lserial
2855
2856    set lookingforhead 0
2857    if {$localfrow >= 0} {
2858        removerow $localfrow
2859        set localfrow -1
2860        if {$localirow > 0} {
2861            incr localirow -1
2862        }
2863    }
2864    if {$localirow >= 0} {
2865        removerow $localirow
2866        set localirow -1
2867    }
2868    incr lserial
2869}
2870
2871# spawn off a process to do git diff-index --cached HEAD
2872proc dodiffindex {} {
2873    global localirow localfrow lserial
2874
2875    incr lserial
2876    set localfrow -1
2877    set localirow -1
2878    set fd [open "|git diff-index --cached HEAD" r]
2879    fconfigure $fd -blocking 0
2880    filerun $fd [list readdiffindex $fd $lserial]
2881}
2882
2883proc readdiffindex {fd serial} {
2884    global localirow commitrow mainheadid nullid2 curview
2885    global commitinfo commitdata lserial
2886
2887    set isdiff 1
2888    if {[gets $fd line] < 0} {
2889        if {![eof $fd]} {
2890            return 1
2891        }
2892        set isdiff 0
2893    }
2894    # we only need to see one line and we don't really care what it says...
2895    close $fd
2896
2897    # now see if there are any local changes not checked in to the index
2898    if {$serial == $lserial} {
2899        set fd [open "|git diff-files" r]
2900        fconfigure $fd -blocking 0
2901        filerun $fd [list readdifffiles $fd $serial]
2902    }
2903
2904    if {$isdiff && $serial == $lserial && $localirow == -1} {
2905        # add the line for the changes in the index to the graph
2906        set localirow $commitrow($curview,$mainheadid)
2907        set hl "Local changes checked in to index but not committed"
2908        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2909        set commitdata($nullid2) "\n    $hl\n"
2910        insertrow $localirow $nullid2
2911    }
2912    return 0
2913}
2914
2915proc readdifffiles {fd serial} {
2916    global localirow localfrow commitrow mainheadid nullid curview
2917    global commitinfo commitdata lserial
2918
2919    set isdiff 1
2920    if {[gets $fd line] < 0} {
2921        if {![eof $fd]} {
2922            return 1
2923        }
2924        set isdiff 0
2925    }
2926    # we only need to see one line and we don't really care what it says...
2927    close $fd
2928
2929    if {$isdiff && $serial == $lserial && $localfrow == -1} {
2930        # add the line for the local diff to the graph
2931        if {$localirow >= 0} {
2932            set localfrow $localirow
2933            incr localirow
2934        } else {
2935            set localfrow $commitrow($curview,$mainheadid)
2936        }
2937        set hl "Local uncommitted changes, not checked in to index"
2938        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2939        set commitdata($nullid) "\n    $hl\n"
2940        insertrow $localfrow $nullid
2941    }
2942    return 0
2943}
2944
2945proc layoutrows {row endrow last} {
2946    global rowidlist displayorder
2947    global uparrowlen downarrowlen maxwidth mingaplen
2948    global children parentlist
2949    global commitidx curview
2950    global idinlist rowchk
2951
2952    set idlist [lindex $rowidlist $row]
2953    while {$row < $endrow} {
2954        set id [lindex $displayorder $row]
2955        if {1} {
2956            if {!$last &&
2957                $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2958            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2959                set i [lindex $idlist $x]
2960                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2961                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
2962                               [expr {$row + $uparrowlen + $mingaplen}]]
2963                    if {$r == 0} {
2964                        set idlist [lreplace $idlist $x $x]
2965                        set idinlist($i) 0
2966                        continue
2967                    }
2968                    set rowchk($i) [expr {$row + $r}]
2969                }
2970            }
2971            lset rowidlist $row $idlist
2972        }
2973        set oldolds {}
2974        set newolds {}
2975        foreach p [lindex $parentlist $row] {
2976            if {![info exists idinlist($p)]} {
2977                lappend newolds $p
2978            } elseif {!$idinlist($p)} {
2979                lappend oldolds $p
2980            }
2981            set idinlist($p) 1
2982        }
2983        set col [lsearch -exact $idlist $id]
2984        if {$col < 0} {
2985            set col [idcol $idlist $id]
2986            set idlist [linsert $idlist $col $id]
2987            lset rowidlist $row $idlist
2988            if {$children($curview,$id) ne {}} {
2989                unset idinlist($id)
2990                makeuparrow $id $row $col
2991            }
2992        } else {
2993            unset idinlist($id)
2994        }
2995        incr row
2996        set idlist [lreplace $idlist $col $col]
2997        set x $col
2998        foreach i $newolds {
2999            set x [idcol $idlist $i $x]
3000            set idlist [linsert $idlist $x $i]
3001        }
3002        foreach oid $oldolds {
3003            set x [idcol $idlist $oid $x]
3004            set idlist [linsert $idlist $x $oid]
3005            makeuparrow $oid $row $x
3006        }
3007        lappend rowidlist $idlist
3008    }
3009    return $row
3010}
3011
3012proc addextraid {id row} {
3013    global displayorder commitrow commitinfo
3014    global commitidx commitlisted
3015    global parentlist children curview
3016
3017    incr commitidx($curview)
3018    lappend displayorder $id
3019    lappend commitlisted 0
3020    lappend parentlist {}
3021    set commitrow($curview,$id) $row
3022    readcommit $id
3023    if {![info exists commitinfo($id)]} {
3024        set commitinfo($id) {"No commit information available"}
3025    }
3026    if {![info exists children($curview,$id)]} {
3027        set children($curview,$id) {}
3028    }
3029}
3030
3031proc layouttail {} {
3032    global rowidlist idinlist commitidx curview
3033
3034    set row $commitidx($curview)
3035    set idlist [lindex $rowidlist $row]
3036    while {$idlist ne {}} {
3037        set col [expr {[llength $idlist] - 1}]
3038        set id [lindex $idlist $col]
3039        addextraid $id $row
3040        catch {unset idinlist($id)}
3041        incr row
3042        set idlist [lreplace $idlist $col $col]
3043        lappend rowidlist $idlist
3044    }
3045
3046    foreach id [array names idinlist] {
3047        unset idinlist($id)
3048        addextraid $id $row
3049        lset rowidlist $row [list $id]
3050        makeuparrow $id $row 0
3051        incr row
3052        lappend rowidlist {}
3053    }
3054}
3055
3056proc insert_pad {row col npad} {
3057    global rowidlist
3058
3059    set pad [ntimes $npad {}]
3060    set idlist [lindex $rowidlist $row]
3061    set bef [lrange $idlist 0 [expr {$col - 1}]]
3062    set aft [lrange $idlist $col end]
3063    set i [lsearch -exact $aft {}]
3064    if {$i > 0} {
3065        set aft [lreplace $aft $i $i]
3066    }
3067    lset rowidlist $row [concat $bef $pad $aft]
3068}
3069
3070proc optimize_rows {row col endrow} {
3071    global rowidlist displayorder curview children
3072
3073    if {$row < 1} {
3074        set row 1
3075    }
3076    set idlist [lindex $rowidlist [expr {$row - 1}]]
3077    if {$row >= 2} {
3078        set previdlist [lindex $rowidlist [expr {$row - 2}]]
3079    } else {
3080        set previdlist {}
3081    }
3082    for {} {$row < $endrow} {incr row} {
3083        set pprevidlist $previdlist
3084        set previdlist $idlist
3085        set idlist [lindex $rowidlist $row]
3086        set haspad 0
3087        set y0 [expr {$row - 1}]
3088        set ym [expr {$row - 2}]
3089        set x0 -1
3090        set xm -1
3091        for {} {$col < [llength $idlist]} {incr col} {
3092            set id [lindex $idlist $col]
3093            if {[lindex $previdlist $col] eq $id} continue
3094            if {$id eq {}} {
3095                set haspad 1
3096                continue
3097            }
3098            set x0 [lsearch -exact $previdlist $id]
3099            if {$x0 < 0} continue
3100            set z [expr {$x0 - $col}]
3101            set isarrow 0
3102            set z0 {}
3103            if {$ym >= 0} {
3104                set xm [lsearch -exact $pprevidlist $id]
3105                if {$xm >= 0} {
3106                    set z0 [expr {$xm - $x0}]
3107                }
3108            }
3109            if {$z0 eq {}} {
3110                # if row y0 is the first child of $id then it's not an arrow
3111                if {[lindex $children($curview,$id) 0] ne
3112                    [lindex $displayorder $y0]} {
3113                    set isarrow 1
3114                }
3115            }
3116            if {!$isarrow && $id ne [lindex $displayorder $row] &&
3117                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3118                set isarrow 1
3119            }
3120            # Looking at lines from this row to the previous row,
3121            # make them go straight up if they end in an arrow on
3122            # the previous row; otherwise make them go straight up
3123            # or at 45 degrees.
3124            if {$z < -1 || ($z < 0 && $isarrow)} {
3125                # Line currently goes left too much;
3126                # insert pads in the previous row, then optimize it
3127                set npad [expr {-1 - $z + $isarrow}]
3128                insert_pad $y0 $x0 $npad
3129                if {$y0 > 0} {
3130                    optimize_rows $y0 $x0 $row
3131                }
3132                set previdlist [lindex $rowidlist $y0]
3133                set x0 [lsearch -exact $previdlist $id]
3134                set z [expr {$x0 - $col}]
3135                if {$z0 ne {}} {
3136                    set pprevidlist [lindex $rowidlist $ym]
3137                    set xm [lsearch -exact $pprevidlist $id]
3138                    set z0 [expr {$xm - $x0}]
3139                }
3140            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3141                # Line currently goes right too much;
3142                # insert pads in this line
3143                set npad [expr {$z - 1 + $isarrow}]
3144                insert_pad $row $col $npad
3145                set idlist [lindex $rowidlist $row]
3146                incr col $npad
3147                set z [expr {$x0 - $col}]
3148                set haspad 1
3149            }
3150            if {$z0 eq {} && !$isarrow && $ym >= 0} {
3151                # this line links to its first child on row $row-2
3152                set id [lindex $displayorder $ym]
3153                set xc [lsearch -exact $pprevidlist $id]
3154                if {$xc >= 0} {
3155                    set z0 [expr {$xc - $x0}]
3156                }
3157            }
3158            # avoid lines jigging left then immediately right
3159            if {$z0 ne {} && $z < 0 && $z0 > 0} {
3160                insert_pad $y0 $x0 1
3161                incr x0
3162                optimize_rows $y0 $x0 $row
3163                set previdlist [lindex $rowidlist $y0]
3164                set pprevidlist [lindex $rowidlist $ym]
3165            }
3166        }
3167        if {!$haspad} {
3168            # Find the first column that doesn't have a line going right
3169            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3170                set id [lindex $idlist $col]
3171                if {$id eq {}} break
3172                set x0 [lsearch -exact $previdlist $id]
3173                if {$x0 < 0} {
3174                    # check if this is the link to the first child
3175                    set kid [lindex $displayorder $y0]
3176                    if {[lindex $children($curview,$id) 0] eq $kid} {
3177                        # it is, work out offset to child
3178                        set x0 [lsearch -exact $previdlist $kid]
3179                    }
3180                }
3181                if {$x0 <= $col} break
3182            }
3183            # Insert a pad at that column as long as it has a line and
3184            # isn't the last column
3185            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3186                set idlist [linsert $idlist $col {}]
3187            }
3188        }
3189        lset rowidlist $row $idlist
3190        set col 0
3191    }
3192}
3193
3194proc xc {row col} {
3195    global canvx0 linespc
3196    return [expr {$canvx0 + $col * $linespc}]
3197}
3198
3199proc yc {row} {
3200    global canvy0 linespc
3201    return [expr {$canvy0 + $row * $linespc}]
3202}
3203
3204proc linewidth {id} {
3205    global thickerline lthickness
3206
3207    set wid $lthickness
3208    if {[info exists thickerline] && $id eq $thickerline} {
3209        set wid [expr {2 * $lthickness}]
3210    }
3211    return $wid
3212}
3213
3214proc rowranges {id} {
3215    global commitrow curview children uparrowlen downarrowlen
3216    global rowidlist
3217
3218    set kids $children($curview,$id)
3219    if {$kids eq {}} {
3220        return {}
3221    }
3222    set ret {}
3223    lappend kids $id
3224    foreach child $kids {
3225        if {![info exists commitrow($curview,$child)]} break
3226        set row $commitrow($curview,$child)
3227        if {![info exists prev]} {
3228            lappend ret [expr {$row + 1}]
3229        } else {
3230            if {$row <= $prevrow} {
3231                puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3232            }
3233            # see if the line extends the whole way from prevrow to row
3234            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3235                [lsearch -exact [lindex $rowidlist \
3236                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3237                # it doesn't, see where it ends
3238                set r [expr {$prevrow + $downarrowlen}]
3239                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3240                    while {[incr r -1] > $prevrow &&
3241                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3242                } else {
3243                    while {[incr r] <= $row &&
3244                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3245                    incr r -1
3246                }
3247                lappend ret $r
3248                # see where it starts up again
3249                set r [expr {$row - $uparrowlen}]
3250                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3251                    while {[incr r] < $row &&
3252                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3253                } else {
3254                    while {[incr r -1] >= $prevrow &&
3255                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3256                    incr r
3257                }
3258                lappend ret $r
3259            }
3260        }
3261        if {$child eq $id} {
3262            lappend ret $row
3263        }
3264        set prev $id
3265        set prevrow $row
3266    }
3267    return $ret
3268}
3269
3270proc drawlineseg {id row endrow arrowlow} {
3271    global rowidlist displayorder iddrawn linesegs
3272    global canv colormap linespc curview maxlinelen parentlist
3273
3274    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3275    set le [expr {$row + 1}]
3276    set arrowhigh 1
3277    while {1} {
3278        set c [lsearch -exact [lindex $rowidlist $le] $id]
3279        if {$c < 0} {
3280            incr le -1
3281            break
3282        }
3283        lappend cols $c
3284        set x [lindex $displayorder $le]
3285        if {$x eq $id} {
3286            set arrowhigh 0
3287            break
3288        }
3289        if {[info exists iddrawn($x)] || $le == $endrow} {
3290            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3291            if {$c >= 0} {
3292                lappend cols $c
3293                set arrowhigh 0
3294            }
3295            break
3296        }
3297        incr le
3298    }
3299    if {$le <= $row} {
3300        return $row
3301    }
3302
3303    set lines {}
3304    set i 0
3305    set joinhigh 0
3306    if {[info exists linesegs($id)]} {
3307        set lines $linesegs($id)
3308        foreach li $lines {
3309            set r0 [lindex $li 0]
3310            if {$r0 > $row} {
3311                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3312                    set joinhigh 1
3313                }
3314                break
3315            }
3316            incr i
3317        }
3318    }
3319    set joinlow 0
3320    if {$i > 0} {
3321        set li [lindex $lines [expr {$i-1}]]
3322        set r1 [lindex $li 1]
3323        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3324            set joinlow 1
3325        }
3326    }
3327
3328    set x [lindex $cols [expr {$le - $row}]]
3329    set xp [lindex $cols [expr {$le - 1 - $row}]]
3330    set dir [expr {$xp - $x}]
3331    if {$joinhigh} {
3332        set ith [lindex $lines $i 2]
3333        set coords [$canv coords $ith]
3334        set ah [$canv itemcget $ith -arrow]
3335        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3336        set x2 [lindex $cols [expr {$le + 1 - $row}]]
3337        if {$x2 ne {} && $x - $x2 == $dir} {
3338            set coords [lrange $coords 0 end-2]
3339        }
3340    } else {
3341        set coords [list [xc $le $x] [yc $le]]
3342    }
3343    if {$joinlow} {
3344        set itl [lindex $lines [expr {$i-1}] 2]
3345        set al [$canv itemcget $itl -arrow]
3346        set arrowlow [expr {$al eq "last" || $al eq "both"}]
3347    } elseif {$arrowlow} {
3348        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3349            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3350            set arrowlow 0
3351        }
3352    }
3353    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3354    for {set y $le} {[incr y -1] > $row} {} {
3355        set x $xp
3356        set xp [lindex $cols [expr {$y - 1 - $row}]]
3357        set ndir [expr {$xp - $x}]
3358        if {$dir != $ndir || $xp < 0} {
3359            lappend coords [xc $y $x] [yc $y]
3360        }
3361        set dir $ndir
3362    }
3363    if {!$joinlow} {
3364        if {$xp < 0} {
3365            # join parent line to first child
3366            set ch [lindex $displayorder $row]
3367            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3368            if {$xc < 0} {
3369                puts "oops: drawlineseg: child $ch not on row $row"
3370            } elseif {$xc != $x} {
3371                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3372                    set d [expr {int(0.5 * $linespc)}]
3373                    set x1 [xc $row $x]
3374                    if {$xc < $x} {
3375                        set x2 [expr {$x1 - $d}]
3376                    } else {
3377                        set x2 [expr {$x1 + $d}]
3378                    }
3379                    set y2 [yc $row]
3380                    set y1 [expr {$y2 + $d}]
3381                    lappend coords $x1 $y1 $x2 $y2
3382                } elseif {$xc < $x - 1} {
3383                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
3384                } elseif {$xc > $x + 1} {
3385                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
3386                }
3387                set x $xc
3388            }
3389            lappend coords [xc $row $x] [yc $row]
3390        } else {
3391            set xn [xc $row $xp]
3392            set yn [yc $row]
3393            lappend coords $xn $yn
3394        }
3395        if {!$joinhigh} {
3396            assigncolor $id
3397            set t [$canv create line $coords -width [linewidth $id] \
3398                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
3399            $canv lower $t
3400            bindline $t $id
3401            set lines [linsert $lines $i [list $row $le $t]]
3402        } else {
3403            $canv coords $ith $coords
3404            if {$arrow ne $ah} {
3405                $canv itemconf $ith -arrow $arrow
3406            }
3407            lset lines $i 0 $row
3408        }
3409    } else {
3410        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3411        set ndir [expr {$xo - $xp}]
3412        set clow [$canv coords $itl]
3413        if {$dir == $ndir} {
3414            set clow [lrange $clow 2 end]
3415        }
3416        set coords [concat $coords $clow]
3417        if {!$joinhigh} {
3418            lset lines [expr {$i-1}] 1 $le
3419        } else {
3420            # coalesce two pieces
3421            $canv delete $ith
3422            set b [lindex $lines [expr {$i-1}] 0]
3423            set e [lindex $lines $i 1]
3424            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3425        }
3426        $canv coords $itl $coords
3427        if {$arrow ne $al} {
3428            $canv itemconf $itl -arrow $arrow
3429        }
3430    }
3431
3432    set linesegs($id) $lines
3433    return $le
3434}
3435
3436proc drawparentlinks {id row} {
3437    global rowidlist canv colormap curview parentlist
3438    global idpos linespc
3439
3440    set rowids [lindex $rowidlist $row]
3441    set col [lsearch -exact $rowids $id]
3442    if {$col < 0} return
3443    set olds [lindex $parentlist $row]
3444    set row2 [expr {$row + 1}]
3445    set x [xc $row $col]
3446    set y [yc $row]
3447    set y2 [yc $row2]
3448    set d [expr {int(0.5 * $linespc)}]
3449    set ymid [expr {$y + $d}]
3450    set ids [lindex $rowidlist $row2]
3451    # rmx = right-most X coord used
3452    set rmx 0
3453    foreach p $olds {
3454        set i [lsearch -exact $ids $p]
3455        if {$i < 0} {
3456            puts "oops, parent $p of $id not in list"
3457            continue
3458        }
3459        set x2 [xc $row2 $i]
3460        if {$x2 > $rmx} {
3461            set rmx $x2
3462        }
3463        set j [lsearch -exact $rowids $p]
3464        if {$j < 0} {
3465            # drawlineseg will do this one for us
3466            continue
3467        }
3468        assigncolor $p
3469        # should handle duplicated parents here...
3470        set coords [list $x $y]
3471        if {$i != $col} {
3472            # if attaching to a vertical segment, draw a smaller
3473            # slant for visual distinctness
3474            if {$i == $j} {
3475                if {$i < $col} {
3476                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3477                } else {
3478                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3479                }
3480            } elseif {$i < $col && $i < $j} {
3481                # segment slants towards us already
3482                lappend coords [xc $row $j] $y
3483            } else {
3484                if {$i < $col - 1} {
3485                    lappend coords [expr {$x2 + $linespc}] $y
3486                } elseif {$i > $col + 1} {
3487                    lappend coords [expr {$x2 - $linespc}] $y
3488                }
3489                lappend coords $x2 $y2
3490            }
3491        } else {
3492            lappend coords $x2 $y2
3493        }
3494        set t [$canv create line $coords -width [linewidth $p] \
3495                   -fill $colormap($p) -tags lines.$p]
3496        $canv lower $t
3497        bindline $t $p
3498    }
3499    if {$rmx > [lindex $idpos($id) 1]} {
3500        lset idpos($id) 1 $rmx
3501        redrawtags $id
3502    }
3503}
3504
3505proc drawlines {id} {
3506    global canv
3507
3508    $canv itemconf lines.$id -width [linewidth $id]
3509}
3510
3511proc drawcmittext {id row col} {
3512    global linespc canv canv2 canv3 canvy0 fgcolor curview
3513    global commitlisted commitinfo rowidlist parentlist
3514    global rowtextx idpos idtags idheads idotherrefs
3515    global linehtag linentag linedtag
3516    global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3517
3518    # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3519    set listed [lindex $commitlisted $row]
3520    if {$id eq $nullid} {
3521        set ofill red
3522    } elseif {$id eq $nullid2} {
3523        set ofill green
3524    } else {
3525        set ofill [expr {$listed != 0? "blue": "white"}]
3526    }
3527    set x [xc $row $col]
3528    set y [yc $row]
3529    set orad [expr {$linespc / 3}]
3530    if {$listed <= 1} {
3531        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3532                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3533                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3534    } elseif {$listed == 2} {
3535        # triangle pointing left for left-side commits
3536        set t [$canv create polygon \
3537                   [expr {$x - $orad}] $y \
3538                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3539                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3540                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3541    } else {
3542        # triangle pointing right for right-side commits
3543        set t [$canv create polygon \
3544                   [expr {$x + $orad - 1}] $y \
3545                   [expr {$x - $orad}] [expr {$y - $orad}] \
3546                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3547                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3548    }
3549    $canv raise $t
3550    $canv bind $t <1> {selcanvline {} %x %y}
3551    set rmx [llength [lindex $rowidlist $row]]
3552    set olds [lindex $parentlist $row]
3553    if {$olds ne {}} {
3554        set nextids [lindex $rowidlist [expr {$row + 1}]]
3555        foreach p $olds {
3556            set i [lsearch -exact $nextids $p]
3557            if {$i > $rmx} {
3558                set rmx $i
3559            }
3560        }
3561    }
3562    set xt [xc $row $rmx]
3563    set rowtextx($row) $xt
3564    set idpos($id) [list $x $xt $y]
3565    if {[info exists idtags($id)] || [info exists idheads($id)]
3566        || [info exists idotherrefs($id)]} {
3567        set xt [drawtags $id $x $xt $y]
3568    }
3569    set headline [lindex $commitinfo($id) 0]
3570    set name [lindex $commitinfo($id) 1]
3571    set date [lindex $commitinfo($id) 2]
3572    set date [formatdate $date]
3573    set font $mainfont
3574    set nfont $mainfont
3575    set isbold [ishighlighted $row]
3576    if {$isbold > 0} {
3577        lappend boldrows $row
3578        lappend font bold
3579        if {$isbold > 1} {
3580            lappend boldnamerows $row
3581            lappend nfont bold
3582        }
3583    }
3584    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3585                            -text $headline -font $font -tags text]
3586    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3587    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3588                            -text $name -font $nfont -tags text]
3589    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3590                            -text $date -font $mainfont -tags text]
3591    set xr [expr {$xt + [font measure $mainfont $headline]}]
3592    if {$xr > $canvxmax} {
3593        set canvxmax $xr
3594        setcanvscroll
3595    }
3596}
3597
3598proc drawcmitrow {row} {
3599    global displayorder rowidlist
3600    global iddrawn markingmatches
3601    global commitinfo parentlist numcommits
3602    global filehighlight fhighlights findstring nhighlights
3603    global hlview vhighlights
3604    global highlight_related rhighlights
3605
3606    if {$row >= $numcommits} return
3607
3608    set id [lindex $displayorder $row]
3609    if {[info exists hlview] && ![info exists vhighlights($row)]} {
3610        askvhighlight $row $id
3611    }
3612    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3613        askfilehighlight $row $id
3614    }
3615    if {$findstring ne {} && ![info exists nhighlights($row)]} {
3616        askfindhighlight $row $id
3617    }
3618    if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3619        askrelhighlight $row $id
3620    }
3621    if {![info exists iddrawn($id)]} {
3622        set col [lsearch -exact [lindex $rowidlist $row] $id]
3623        if {$col < 0} {
3624            puts "oops, row $row id $id not in list"
3625            return
3626        }
3627        if {![info exists commitinfo($id)]} {
3628            getcommit $id
3629        }
3630        assigncolor $id
3631        drawcmittext $id $row $col
3632        set iddrawn($id) 1
3633    }
3634    if {$markingmatches} {
3635        markrowmatches $row $id
3636    }
3637}
3638
3639proc drawcommits {row {endrow {}}} {
3640    global numcommits iddrawn displayorder curview
3641    global parentlist rowidlist
3642
3643    if {$row < 0} {
3644        set row 0
3645    }
3646    if {$endrow eq {}} {
3647        set endrow $row
3648    }
3649    if {$endrow >= $numcommits} {
3650        set endrow [expr {$numcommits - 1}]
3651    }
3652
3653    # make the lines join to already-drawn rows either side
3654    set r [expr {$row - 1}]
3655    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3656        set r $row
3657    }
3658    set er [expr {$endrow + 1}]
3659    if {$er >= $numcommits ||
3660        ![info exists iddrawn([lindex $displayorder $er])]} {
3661        set er $endrow
3662    }
3663    for {} {$r <= $er} {incr r} {
3664        set id [lindex $displayorder $r]
3665        set wasdrawn [info exists iddrawn($id)]
3666        drawcmitrow $r
3667        if {$r == $er} break
3668        set nextid [lindex $displayorder [expr {$r + 1}]]
3669        if {$wasdrawn && [info exists iddrawn($nextid)]} {
3670            catch {unset prevlines}
3671            continue
3672        }
3673        drawparentlinks $id $r
3674
3675        if {[info exists lineends($r)]} {
3676            foreach lid $lineends($r) {
3677                unset prevlines($lid)
3678            }
3679        }
3680        set rowids [lindex $rowidlist $r]
3681        foreach lid $rowids {
3682            if {$lid eq {}} continue
3683            if {$lid eq $id} {
3684                # see if this is the first child of any of its parents
3685                foreach p [lindex $parentlist $r] {
3686                    if {[lsearch -exact $rowids $p] < 0} {
3687                        # make this line extend up to the child
3688                        set le [drawlineseg $p $r $er 0]
3689                        lappend lineends($le) $p
3690                        set prevlines($p) 1
3691                    }
3692                }
3693            } elseif {![info exists prevlines($lid)]} {
3694                set le [drawlineseg $lid $r $er 1]
3695                lappend lineends($le) $lid
3696                set prevlines($lid) 1
3697            }
3698        }
3699    }
3700}
3701
3702proc drawfrac {f0 f1} {
3703    global canv linespc
3704
3705    set ymax [lindex [$canv cget -scrollregion] 3]
3706    if {$ymax eq {} || $ymax == 0} return
3707    set y0 [expr {int($f0 * $ymax)}]
3708    set row [expr {int(($y0 - 3) / $linespc) - 1}]
3709    set y1 [expr {int($f1 * $ymax)}]
3710    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3711    drawcommits $row $endrow
3712}
3713
3714proc drawvisible {} {
3715    global canv
3716    eval drawfrac [$canv yview]
3717}
3718
3719proc clear_display {} {
3720    global iddrawn linesegs
3721    global vhighlights fhighlights nhighlights rhighlights
3722
3723    allcanvs delete all
3724    catch {unset iddrawn}
3725    catch {unset linesegs}
3726    catch {unset vhighlights}
3727    catch {unset fhighlights}
3728    catch {unset nhighlights}
3729    catch {unset rhighlights}
3730}
3731
3732proc findcrossings {id} {
3733    global rowidlist parentlist numcommits displayorder
3734
3735    set cross {}
3736    set ccross {}
3737    foreach {s e} [rowranges $id] {
3738        if {$e >= $numcommits} {
3739            set e [expr {$numcommits - 1}]
3740        }
3741        if {$e <= $s} continue
3742        for {set row $e} {[incr row -1] >= $s} {} {
3743            set x [lsearch -exact [lindex $rowidlist $row] $id]
3744            if {$x < 0} break
3745            set olds [lindex $parentlist $row]
3746            set kid [lindex $displayorder $row]
3747            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3748            if {$kidx < 0} continue
3749            set nextrow [lindex $rowidlist [expr {$row + 1}]]
3750            foreach p $olds {
3751                set px [lsearch -exact $nextrow $p]
3752                if {$px < 0} continue
3753                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3754                    if {[lsearch -exact $ccross $p] >= 0} continue
3755                    if {$x == $px + ($kidx < $px? -1: 1)} {
3756                        lappend ccross $p
3757                    } elseif {[lsearch -exact $cross $p] < 0} {
3758                        lappend cross $p
3759                    }
3760                }
3761            }
3762        }
3763    }
3764    return [concat $ccross {{}} $cross]
3765}
3766
3767proc assigncolor {id} {
3768    global colormap colors nextcolor
3769    global commitrow parentlist children children curview
3770
3771    if {[info exists colormap($id)]} return
3772    set ncolors [llength $colors]
3773    if {[info exists children($curview,$id)]} {
3774        set kids $children($curview,$id)
3775    } else {
3776        set kids {}
3777    }
3778    if {[llength $kids] == 1} {
3779        set child [lindex $kids 0]
3780        if {[info exists colormap($child)]
3781            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3782            set colormap($id) $colormap($child)
3783            return
3784        }
3785    }
3786    set badcolors {}
3787    set origbad {}
3788    foreach x [findcrossings $id] {
3789        if {$x eq {}} {
3790            # delimiter between corner crossings and other crossings
3791            if {[llength $badcolors] >= $ncolors - 1} break
3792            set origbad $badcolors
3793        }
3794        if {[info exists colormap($x)]
3795            && [lsearch -exact $badcolors $colormap($x)] < 0} {
3796            lappend badcolors $colormap($x)
3797        }
3798    }
3799    if {[llength $badcolors] >= $ncolors} {
3800        set badcolors $origbad
3801    }
3802    set origbad $badcolors
3803    if {[llength $badcolors] < $ncolors - 1} {
3804        foreach child $kids {
3805            if {[info exists colormap($child)]
3806                && [lsearch -exact $badcolors $colormap($child)] < 0} {
3807                lappend badcolors $colormap($child)
3808            }
3809            foreach p [lindex $parentlist $commitrow($curview,$child)] {
3810                if {[info exists colormap($p)]
3811                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
3812                    lappend badcolors $colormap($p)
3813                }
3814            }
3815        }
3816        if {[llength $badcolors] >= $ncolors} {
3817            set badcolors $origbad
3818        }
3819    }
3820    for {set i 0} {$i <= $ncolors} {incr i} {
3821        set c [lindex $colors $nextcolor]
3822        if {[incr nextcolor] >= $ncolors} {
3823            set nextcolor 0
3824        }
3825        if {[lsearch -exact $badcolors $c]} break
3826    }
3827    set colormap($id) $c
3828}
3829
3830proc bindline {t id} {
3831    global canv
3832
3833    $canv bind $t <Enter> "lineenter %x %y $id"
3834    $canv bind $t <Motion> "linemotion %x %y $id"
3835    $canv bind $t <Leave> "lineleave $id"
3836    $canv bind $t <Button-1> "lineclick %x %y $id 1"
3837}
3838
3839proc drawtags {id x xt y1} {
3840    global idtags idheads idotherrefs mainhead
3841    global linespc lthickness
3842    global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3843
3844    set marks {}
3845    set ntags 0
3846    set nheads 0
3847    if {[info exists idtags($id)]} {
3848        set marks $idtags($id)
3849        set ntags [llength $marks]
3850    }
3851    if {[info exists idheads($id)]} {
3852        set marks [concat $marks $idheads($id)]
3853        set nheads [llength $idheads($id)]
3854    }
3855    if {[info exists idotherrefs($id)]} {
3856        set marks [concat $marks $idotherrefs($id)]
3857    }
3858    if {$marks eq {}} {
3859        return $xt
3860    }
3861
3862    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3863    set yt [expr {$y1 - 0.5 * $linespc}]
3864    set yb [expr {$yt + $linespc - 1}]
3865    set xvals {}
3866    set wvals {}
3867    set i -1
3868    foreach tag $marks {
3869        incr i
3870        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3871            set wid [font measure [concat $mainfont bold] $tag]
3872        } else {
3873            set wid [font measure $mainfont $tag]
3874        }
3875        lappend xvals $xt
3876        lappend wvals $wid
3877        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3878    }
3879    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3880               -width $lthickness -fill black -tags tag.$id]
3881    $canv lower $t
3882    foreach tag $marks x $xvals wid $wvals {
3883        set xl [expr {$x + $delta}]
3884        set xr [expr {$x + $delta + $wid + $lthickness}]
3885        set font $mainfont
3886        if {[incr ntags -1] >= 0} {
3887            # draw a tag
3888            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3889                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3890                       -width 1 -outline black -fill yellow -tags tag.$id]
3891            $canv bind $t <1> [list showtag $tag 1]
3892            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3893        } else {
3894            # draw a head or other ref
3895            if {[incr nheads -1] >= 0} {
3896                set col green
3897                if {$tag eq $mainhead} {
3898                    lappend font bold
3899                }
3900            } else {
3901                set col "#ddddff"
3902            }
3903            set xl [expr {$xl - $delta/2}]
3904            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3905                -width 1 -outline black -fill $col -tags tag.$id
3906            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3907                set rwid [font measure $mainfont $remoteprefix]
3908                set xi [expr {$x + 1}]
3909                set yti [expr {$yt + 1}]
3910                set xri [expr {$x + $rwid}]
3911                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3912                        -width 0 -fill "#ffddaa" -tags tag.$id
3913            }
3914        }
3915        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3916                   -font $font -tags [list tag.$id text]]
3917        if {$ntags >= 0} {
3918            $canv bind $t <1> [list showtag $tag 1]
3919        } elseif {$nheads >= 0} {
3920            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3921        }
3922    }
3923    return $xt
3924}
3925
3926proc xcoord {i level ln} {
3927    global canvx0 xspc1 xspc2
3928
3929    set x [expr {$canvx0 + $i * $xspc1($ln)}]
3930    if {$i > 0 && $i == $level} {
3931        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3932    } elseif {$i > $level} {
3933        set x [expr {$x + $xspc2 - $xspc1($ln)}]
3934    }
3935    return $x
3936}
3937
3938proc show_status {msg} {
3939    global canv mainfont fgcolor
3940
3941    clear_display
3942    $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3943        -tags text -fill $fgcolor
3944}
3945
3946# Insert a new commit as the child of the commit on row $row.
3947# The new commit will be displayed on row $row and the commits
3948# on that row and below will move down one row.
3949proc insertrow {row newcmit} {
3950    global displayorder parentlist commitlisted children
3951    global commitrow curview rowidlist numcommits
3952    global rowlaidout rowoptim numcommits
3953    global selectedline rowchk commitidx
3954
3955    if {$row >= $numcommits} {
3956        puts "oops, inserting new row $row but only have $numcommits rows"
3957        return
3958    }
3959    set p [lindex $displayorder $row]
3960    set displayorder [linsert $displayorder $row $newcmit]
3961    set parentlist [linsert $parentlist $row $p]
3962    set kids $children($curview,$p)
3963    lappend kids $newcmit
3964    set children($curview,$p) $kids
3965    set children($curview,$newcmit) {}
3966    set commitlisted [linsert $commitlisted $row 1]
3967    set l [llength $displayorder]
3968    for {set r $row} {$r < $l} {incr r} {
3969        set id [lindex $displayorder $r]
3970        set commitrow($curview,$id) $r
3971    }
3972    incr commitidx($curview)
3973
3974    set idlist [lindex $rowidlist $row]
3975    if {[llength $kids] == 1} {
3976        set col [lsearch -exact $idlist $p]
3977        lset idlist $col $newcmit
3978    } else {
3979        set col [llength $idlist]
3980        lappend idlist $newcmit
3981    }
3982    set rowidlist [linsert $rowidlist $row $idlist]
3983
3984    catch {unset rowchk}
3985
3986    incr rowlaidout
3987    incr rowoptim
3988    incr numcommits
3989
3990    if {[info exists selectedline] && $selectedline >= $row} {
3991        incr selectedline
3992    }
3993    redisplay
3994}
3995
3996# Remove a commit that was inserted with insertrow on row $row.
3997proc removerow {row} {
3998    global displayorder parentlist commitlisted children
3999    global commitrow curview rowidlist numcommits
4000    global rowlaidout rowoptim numcommits
4001    global linesegends selectedline rowchk commitidx
4002
4003    if {$row >= $numcommits} {
4004        puts "oops, removing row $row but only have $numcommits rows"
4005        return
4006    }
4007    set rp1 [expr {$row + 1}]
4008    set id [lindex $displayorder $row]
4009    set p [lindex $parentlist $row]
4010    set displayorder [lreplace $displayorder $row $row]
4011    set parentlist [lreplace $parentlist $row $row]
4012    set commitlisted [lreplace $commitlisted $row $row]
4013    set kids $children($curview,$p)
4014    set i [lsearch -exact $kids $id]
4015    if {$i >= 0} {
4016        set kids [lreplace $kids $i $i]
4017        set children($curview,$p) $kids
4018    }
4019    set l [llength $displayorder]
4020    for {set r $row} {$r < $l} {incr r} {
4021        set id [lindex $displayorder $r]
4022        set commitrow($curview,$id) $r
4023    }
4024    incr commitidx($curview) -1
4025
4026    set rowidlist [lreplace $rowidlist $row $row]
4027
4028    catch {unset rowchk}
4029
4030    incr rowlaidout -1
4031    incr rowoptim -1
4032    incr numcommits -1
4033
4034    if {[info exists selectedline] && $selectedline > $row} {
4035        incr selectedline -1
4036    }
4037    redisplay
4038}
4039
4040# Don't change the text pane cursor if it is currently the hand cursor,
4041# showing that we are over a sha1 ID link.
4042proc settextcursor {c} {
4043    global ctext curtextcursor
4044
4045    if {[$ctext cget -cursor] == $curtextcursor} {
4046        $ctext config -cursor $c
4047    }
4048    set curtextcursor $c
4049}
4050
4051proc nowbusy {what} {
4052    global isbusy
4053
4054    if {[array names isbusy] eq {}} {
4055        . config -cursor watch
4056        settextcursor watch
4057    }
4058    set isbusy($what) 1
4059}
4060
4061proc notbusy {what} {
4062    global isbusy maincursor textcursor
4063
4064    catch {unset isbusy($what)}
4065    if {[array names isbusy] eq {}} {
4066        . config -cursor $maincursor
4067        settextcursor $textcursor
4068    }
4069}
4070
4071proc findmatches {f} {
4072    global findtype findstring
4073    if {$findtype == "Regexp"} {
4074        set matches [regexp -indices -all -inline $findstring $f]
4075    } else {
4076        set fs $findstring
4077        if {$findtype == "IgnCase"} {
4078            set f [string tolower $f]
4079            set fs [string tolower $fs]
4080        }
4081        set matches {}
4082        set i 0
4083        set l [string length $fs]
4084        while {[set j [string first $fs $f $i]] >= 0} {
4085            lappend matches [list $j [expr {$j+$l-1}]]
4086            set i [expr {$j + $l}]
4087        }
4088    }
4089    return $matches
4090}
4091
4092proc dofind {{rev 0}} {
4093    global findstring findstartline findcurline selectedline numcommits
4094
4095    unmarkmatches
4096    cancel_next_highlight
4097    focus .
4098    if {$findstring eq {} || $numcommits == 0} return
4099    if {![info exists selectedline]} {
4100        set findstartline [lindex [visiblerows] $rev]
4101    } else {
4102        set findstartline $selectedline
4103    }
4104    set findcurline $findstartline
4105    nowbusy finding
4106    if {!$rev} {
4107        run findmore
4108    } else {
4109        if {$findcurline == 0} {
4110            set findcurline $numcommits
4111        }
4112        incr findcurline -1
4113        run findmorerev
4114    }
4115}
4116
4117proc findnext {restart} {
4118    global findcurline
4119    if {![info exists findcurline]} {
4120        if {$restart} {
4121            dofind
4122        } else {
4123            bell
4124        }
4125    } else {
4126        run findmore
4127        nowbusy finding
4128    }
4129}
4130
4131proc findprev {} {
4132    global findcurline
4133    if {![info exists findcurline]} {
4134        dofind 1
4135    } else {
4136        run findmorerev
4137        nowbusy finding
4138    }
4139}
4140
4141proc findmore {} {
4142    global commitdata commitinfo numcommits findstring findpattern findloc
4143    global findstartline findcurline displayorder
4144
4145    set fldtypes {Headline Author Date Committer CDate Comments}
4146    set l [expr {$findcurline + 1}]
4147    if {$l >= $numcommits} {
4148        set l 0
4149    }
4150    if {$l <= $findstartline} {
4151        set lim [expr {$findstartline + 1}]
4152    } else {
4153        set lim $numcommits
4154    }
4155    if {$lim - $l > 500} {
4156        set lim [expr {$l + 500}]
4157    }
4158    set last 0
4159    for {} {$l < $lim} {incr l} {
4160        set id [lindex $displayorder $l]
4161        # shouldn't happen unless git log doesn't give all the commits...
4162        if {![info exists commitdata($id)]} continue
4163        if {![doesmatch $commitdata($id)]} continue
4164        if {![info exists commitinfo($id)]} {
4165            getcommit $id
4166        }
4167        set info $commitinfo($id)
4168        foreach f $info ty $fldtypes {
4169            if {($findloc eq "All fields" || $findloc eq $ty) &&
4170                [doesmatch $f]} {
4171                findselectline $l
4172                notbusy finding
4173                return 0
4174            }
4175        }
4176    }
4177    if {$l == $findstartline + 1} {
4178        bell
4179        unset findcurline
4180        notbusy finding
4181        return 0
4182    }
4183    set findcurline [expr {$l - 1}]
4184    return 1
4185}
4186
4187proc findmorerev {} {
4188    global commitdata commitinfo numcommits findstring findpattern findloc
4189    global findstartline findcurline displayorder
4190
4191    set fldtypes {Headline Author Date Committer CDate Comments}
4192    set l $findcurline
4193    if {$l == 0} {
4194        set l $numcommits
4195    }
4196    incr l -1
4197    if {$l >= $findstartline} {
4198        set lim [expr {$findstartline - 1}]
4199    } else {
4200        set lim -1
4201    }
4202    if {$l - $lim > 500} {
4203        set lim [expr {$l - 500}]
4204    }
4205    set last 0
4206    for {} {$l > $lim} {incr l -1} {
4207        set id [lindex $displayorder $l]
4208        if {![doesmatch $commitdata($id)]} continue
4209        if {![info exists commitinfo($id)]} {
4210            getcommit $id
4211        }
4212        set info $commitinfo($id)
4213        foreach f $info ty $fldtypes {
4214            if {($findloc eq "All fields" || $findloc eq $ty) &&
4215                [doesmatch $f]} {
4216                findselectline $l
4217                notbusy finding
4218                return 0
4219            }
4220        }
4221    }
4222    if {$l == -1} {
4223        bell
4224        unset findcurline
4225        notbusy finding
4226        return 0
4227    }
4228    set findcurline [expr {$l + 1}]
4229    return 1
4230}
4231
4232proc findselectline {l} {
4233    global findloc commentend ctext findcurline markingmatches
4234
4235    set markingmatches 1
4236    set findcurline $l
4237    selectline $l 1
4238    if {$findloc == "All fields" || $findloc == "Comments"} {
4239        # highlight the matches in the comments
4240        set f [$ctext get 1.0 $commentend]
4241        set matches [findmatches $f]
4242        foreach match $matches {
4243            set start [lindex $match 0]
4244            set end [expr {[lindex $match 1] + 1}]
4245            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4246        }
4247    }
4248    drawvisible
4249}
4250
4251# mark the bits of a headline or author that match a find string
4252proc markmatches {canv l str tag matches font row} {
4253    global selectedline
4254
4255    set bbox [$canv bbox $tag]
4256    set x0 [lindex $bbox 0]
4257    set y0 [lindex $bbox 1]
4258    set y1 [lindex $bbox 3]
4259    foreach match $matches {
4260        set start [lindex $match 0]
4261        set end [lindex $match 1]
4262        if {$start > $end} continue
4263        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4264        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4265        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4266                   [expr {$x0+$xlen+2}] $y1 \
4267                   -outline {} -tags [list match$l matches] -fill yellow]
4268        $canv lower $t
4269        if {[info exists selectedline] && $row == $selectedline} {
4270            $canv raise $t secsel
4271        }
4272    }
4273}
4274
4275proc unmarkmatches {} {
4276    global findids markingmatches findcurline
4277
4278    allcanvs delete matches
4279    catch {unset findids}
4280    set markingmatches 0
4281    catch {unset findcurline}
4282}
4283
4284proc selcanvline {w x y} {
4285    global canv canvy0 ctext linespc
4286    global rowtextx
4287    set ymax [lindex [$canv cget -scrollregion] 3]
4288    if {$ymax == {}} return
4289    set yfrac [lindex [$canv yview] 0]
4290    set y [expr {$y + $yfrac * $ymax}]
4291    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4292    if {$l < 0} {
4293        set l 0
4294    }
4295    if {$w eq $canv} {
4296        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4297    }
4298    unmarkmatches
4299    selectline $l 1
4300}
4301
4302proc commit_descriptor {p} {
4303    global commitinfo
4304    if {![info exists commitinfo($p)]} {
4305        getcommit $p
4306    }
4307    set l "..."
4308    if {[llength $commitinfo($p)] > 1} {
4309        set l [lindex $commitinfo($p) 0]
4310    }
4311    return "$p ($l)\n"
4312}
4313
4314# append some text to the ctext widget, and make any SHA1 ID
4315# that we know about be a clickable link.
4316proc appendwithlinks {text tags} {
4317    global ctext commitrow linknum curview
4318
4319    set start [$ctext index "end - 1c"]
4320    $ctext insert end $text $tags
4321    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4322    foreach l $links {
4323        set s [lindex $l 0]
4324        set e [lindex $l 1]
4325        set linkid [string range $text $s $e]
4326        if {![info exists commitrow($curview,$linkid)]} continue
4327        incr e
4328        $ctext tag add link "$start + $s c" "$start + $e c"
4329        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4330        $ctext tag bind link$linknum <1> \
4331            [list selectline $commitrow($curview,$linkid) 1]
4332        incr linknum
4333    }
4334    $ctext tag conf link -foreground blue -underline 1
4335    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4336    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4337}
4338
4339proc viewnextline {dir} {
4340    global canv linespc
4341
4342    $canv delete hover
4343    set ymax [lindex [$canv cget -scrollregion] 3]
4344    set wnow [$canv yview]
4345    set wtop [expr {[lindex $wnow 0] * $ymax}]
4346    set newtop [expr {$wtop + $dir * $linespc}]
4347    if {$newtop < 0} {
4348        set newtop 0
4349    } elseif {$newtop > $ymax} {
4350        set newtop $ymax
4351    }
4352    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4353}
4354
4355# add a list of tag or branch names at position pos
4356# returns the number of names inserted
4357proc appendrefs {pos ids var} {
4358    global ctext commitrow linknum curview $var maxrefs
4359
4360    if {[catch {$ctext index $pos}]} {
4361        return 0
4362    }
4363    $ctext conf -state normal
4364    $ctext delete $pos "$pos lineend"
4365    set tags {}
4366    foreach id $ids {
4367        foreach tag [set $var\($id\)] {
4368            lappend tags [list $tag $id]
4369        }
4370    }
4371    if {[llength $tags] > $maxrefs} {
4372        $ctext insert $pos "many ([llength $tags])"
4373    } else {
4374        set tags [lsort -index 0 -decreasing $tags]
4375        set sep {}
4376        foreach ti $tags {
4377            set id [lindex $ti 1]
4378            set lk link$linknum
4379            incr linknum
4380            $ctext tag delete $lk
4381            $ctext insert $pos $sep
4382            $ctext insert $pos [lindex $ti 0] $lk
4383            if {[info exists commitrow($curview,$id)]} {
4384                $ctext tag conf $lk -foreground blue
4385                $ctext tag bind $lk <1> \
4386                    [list selectline $commitrow($curview,$id) 1]
4387                $ctext tag conf $lk -underline 1
4388                $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4389                $ctext tag bind $lk <Leave> \
4390                    { %W configure -cursor $curtextcursor }
4391            }
4392            set sep ", "
4393        }
4394    }
4395    $ctext conf -state disabled
4396    return [llength $tags]
4397}
4398
4399# called when we have finished computing the nearby tags
4400proc dispneartags {delay} {
4401    global selectedline currentid showneartags tagphase
4402
4403    if {![info exists selectedline] || !$showneartags} return
4404    after cancel dispnexttag
4405    if {$delay} {
4406        after 200 dispnexttag
4407        set tagphase -1
4408    } else {
4409        after idle dispnexttag
4410        set tagphase 0
4411    }
4412}
4413
4414proc dispnexttag {} {
4415    global selectedline currentid showneartags tagphase ctext
4416
4417    if {![info exists selectedline] || !$showneartags} return
4418    switch -- $tagphase {
4419        0 {
4420            set dtags [desctags $currentid]
4421            if {$dtags ne {}} {
4422                appendrefs precedes $dtags idtags
4423            }
4424        }
4425        1 {
4426            set atags [anctags $currentid]
4427            if {$atags ne {}} {
4428                appendrefs follows $atags idtags
4429            }
4430        }
4431        2 {
4432            set dheads [descheads $currentid]
4433            if {$dheads ne {}} {
4434                if {[appendrefs branch $dheads idheads] > 1
4435                    && [$ctext get "branch -3c"] eq "h"} {
4436                    # turn "Branch" into "Branches"
4437                    $ctext conf -state normal
4438                    $ctext insert "branch -2c" "es"
4439                    $ctext conf -state disabled
4440                }
4441            }
4442        }
4443    }
4444    if {[incr tagphase] <= 2} {
4445        after idle dispnexttag
4446    }
4447}
4448
4449proc selectline {l isnew} {
4450    global canv canv2 canv3 ctext commitinfo selectedline
4451    global displayorder linehtag linentag linedtag
4452    global canvy0 linespc parentlist children curview
4453    global currentid sha1entry
4454    global commentend idtags linknum
4455    global mergemax numcommits pending_select
4456    global cmitmode showneartags allcommits
4457
4458    catch {unset pending_select}
4459    $canv delete hover
4460    normalline
4461    cancel_next_highlight
4462    unsel_reflist
4463    if {$l < 0 || $l >= $numcommits} return
4464    set y [expr {$canvy0 + $l * $linespc}]
4465    set ymax [lindex [$canv cget -scrollregion] 3]
4466    set ytop [expr {$y - $linespc - 1}]
4467    set ybot [expr {$y + $linespc + 1}]
4468    set wnow [$canv yview]
4469    set wtop [expr {[lindex $wnow 0] * $ymax}]
4470    set wbot [expr {[lindex $wnow 1] * $ymax}]
4471    set wh [expr {$wbot - $wtop}]
4472    set newtop $wtop
4473    if {$ytop < $wtop} {
4474        if {$ybot < $wtop} {
4475            set newtop [expr {$y - $wh / 2.0}]
4476        } else {
4477            set newtop $ytop
4478            if {$newtop > $wtop - $linespc} {
4479                set newtop [expr {$wtop - $linespc}]
4480            }
4481        }
4482    } elseif {$ybot > $wbot} {
4483        if {$ytop > $wbot} {
4484            set newtop [expr {$y - $wh / 2.0}]
4485        } else {
4486            set newtop [expr {$ybot - $wh}]
4487            if {$newtop < $wtop + $linespc} {
4488                set newtop [expr {$wtop + $linespc}]
4489            }
4490        }
4491    }
4492    if {$newtop != $wtop} {
4493        if {$newtop < 0} {
4494            set newtop 0
4495        }
4496        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4497        drawvisible
4498    }
4499
4500    if {![info exists linehtag($l)]} return
4501    $canv delete secsel
4502    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4503               -tags secsel -fill [$canv cget -selectbackground]]
4504    $canv lower $t
4505    $canv2 delete secsel
4506    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4507               -tags secsel -fill [$canv2 cget -selectbackground]]
4508    $canv2 lower $t
4509    $canv3 delete secsel
4510    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4511               -tags secsel -fill [$canv3 cget -selectbackground]]
4512    $canv3 lower $t
4513
4514    if {$isnew} {
4515        addtohistory [list selectline $l 0]
4516    }
4517
4518    set selectedline $l
4519
4520    set id [lindex $displayorder $l]
4521    set currentid $id
4522    $sha1entry delete 0 end
4523    $sha1entry insert 0 $id
4524    $sha1entry selection from 0
4525    $sha1entry selection to end
4526    rhighlight_sel $id
4527
4528    $ctext conf -state normal
4529    clear_ctext
4530    set linknum 0
4531    set info $commitinfo($id)
4532    set date [formatdate [lindex $info 2]]
4533    $ctext insert end "Author: [lindex $info 1]  $date\n"
4534    set date [formatdate [lindex $info 4]]
4535    $ctext insert end "Committer: [lindex $info 3]  $date\n"
4536    if {[info exists idtags($id)]} {
4537        $ctext insert end "Tags:"
4538        foreach tag $idtags($id) {
4539            $ctext insert end " $tag"
4540        }
4541        $ctext insert end "\n"
4542    }
4543
4544    set headers {}
4545    set olds [lindex $parentlist $l]
4546    if {[llength $olds] > 1} {
4547        set np 0
4548        foreach p $olds {
4549            if {$np >= $mergemax} {
4550                set tag mmax
4551            } else {
4552                set tag m$np
4553            }
4554            $ctext insert end "Parent: " $tag
4555            appendwithlinks [commit_descriptor $p] {}
4556            incr np
4557        }
4558    } else {
4559        foreach p $olds {
4560            append headers "Parent: [commit_descriptor $p]"
4561        }
4562    }
4563
4564    foreach c $children($curview,$id) {
4565        append headers "Child:  [commit_descriptor $c]"
4566    }
4567
4568    # make anything that looks like a SHA1 ID be a clickable link
4569    appendwithlinks $headers {}
4570    if {$showneartags} {
4571        if {![info exists allcommits]} {
4572            getallcommits
4573        }
4574        $ctext insert end "Branch: "
4575        $ctext mark set branch "end -1c"
4576        $ctext mark gravity branch left
4577        $ctext insert end "\nFollows: "
4578        $ctext mark set follows "end -1c"
4579        $ctext mark gravity follows left
4580        $ctext insert end "\nPrecedes: "
4581        $ctext mark set precedes "end -1c"
4582        $ctext mark gravity precedes left
4583        $ctext insert end "\n"
4584        dispneartags 1
4585    }
4586    $ctext insert end "\n"
4587    set comment [lindex $info 5]
4588    if {[string first "\r" $comment] >= 0} {
4589        set comment [string map {"\r" "\n    "} $comment]
4590    }
4591    appendwithlinks $comment {comment}
4592
4593    $ctext tag remove found 1.0 end
4594    $ctext conf -state disabled
4595    set commentend [$ctext index "end - 1c"]
4596
4597    init_flist "Comments"
4598    if {$cmitmode eq "tree"} {
4599        gettree $id
4600    } elseif {[llength $olds] <= 1} {
4601        startdiff $id
4602    } else {
4603        mergediff $id $l
4604    }
4605}
4606
4607proc selfirstline {} {
4608    unmarkmatches
4609    selectline 0 1
4610}
4611
4612proc sellastline {} {
4613    global numcommits
4614    unmarkmatches
4615    set l [expr {$numcommits - 1}]
4616    selectline $l 1
4617}
4618
4619proc selnextline {dir} {
4620    global selectedline
4621    focus .
4622    if {![info exists selectedline]} return
4623    set l [expr {$selectedline + $dir}]
4624    unmarkmatches
4625    selectline $l 1
4626}
4627
4628proc selnextpage {dir} {
4629    global canv linespc selectedline numcommits
4630
4631    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4632    if {$lpp < 1} {
4633        set lpp 1
4634    }
4635    allcanvs yview scroll [expr {$dir * $lpp}] units
4636    drawvisible
4637    if {![info exists selectedline]} return
4638    set l [expr {$selectedline + $dir * $lpp}]
4639    if {$l < 0} {
4640        set l 0
4641    } elseif {$l >= $numcommits} {
4642        set l [expr $numcommits - 1]
4643    }
4644    unmarkmatches
4645    selectline $l 1
4646}
4647
4648proc unselectline {} {
4649    global selectedline currentid
4650
4651    catch {unset selectedline}
4652    catch {unset currentid}
4653    allcanvs delete secsel
4654    rhighlight_none
4655    cancel_next_highlight
4656}
4657
4658proc reselectline {} {
4659    global selectedline
4660
4661    if {[info exists selectedline]} {
4662        selectline $selectedline 0
4663    }
4664}
4665
4666proc addtohistory {cmd} {
4667    global history historyindex curview
4668
4669    set elt [list $curview $cmd]
4670    if {$historyindex > 0
4671        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4672        return
4673    }
4674
4675    if {$historyindex < [llength $history]} {
4676        set history [lreplace $history $historyindex end $elt]
4677    } else {
4678        lappend history $elt
4679    }
4680    incr historyindex
4681    if {$historyindex > 1} {
4682        .tf.bar.leftbut conf -state normal
4683    } else {
4684        .tf.bar.leftbut conf -state disabled
4685    }
4686    .tf.bar.rightbut conf -state disabled
4687}
4688
4689proc godo {elt} {
4690    global curview
4691
4692    set view [lindex $elt 0]
4693    set cmd [lindex $elt 1]
4694    if {$curview != $view} {
4695        showview $view
4696    }
4697    eval $cmd
4698}
4699
4700proc goback {} {
4701    global history historyindex
4702    focus .
4703
4704    if {$historyindex > 1} {
4705        incr historyindex -1
4706        godo [lindex $history [expr {$historyindex - 1}]]
4707        .tf.bar.rightbut conf -state normal
4708    }
4709    if {$historyindex <= 1} {
4710        .tf.bar.leftbut conf -state disabled
4711    }
4712}
4713
4714proc goforw {} {
4715    global history historyindex
4716    focus .
4717
4718    if {$historyindex < [llength $history]} {
4719        set cmd [lindex $history $historyindex]
4720        incr historyindex
4721        godo $cmd
4722        .tf.bar.leftbut conf -state normal
4723    }
4724    if {$historyindex >= [llength $history]} {
4725        .tf.bar.rightbut conf -state disabled
4726    }
4727}
4728
4729proc gettree {id} {
4730    global treefilelist treeidlist diffids diffmergeid treepending
4731    global nullid nullid2
4732
4733    set diffids $id
4734    catch {unset diffmergeid}
4735    if {![info exists treefilelist($id)]} {
4736        if {![info exists treepending]} {
4737            if {$id eq $nullid} {
4738                set cmd [list | git ls-files]
4739            } elseif {$id eq $nullid2} {
4740                set cmd [list | git ls-files --stage -t]
4741            } else {
4742                set cmd [list | git ls-tree -r $id]
4743            }
4744            if {[catch {set gtf [open $cmd r]}]} {
4745                return
4746            }
4747            set treepending $id
4748            set treefilelist($id) {}
4749            set treeidlist($id) {}
4750            fconfigure $gtf -blocking 0
4751            filerun $gtf [list gettreeline $gtf $id]
4752        }
4753    } else {
4754        setfilelist $id
4755    }
4756}
4757
4758proc gettreeline {gtf id} {
4759    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4760
4761    set nl 0
4762    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4763        if {$diffids eq $nullid} {
4764            set fname $line
4765        } else {
4766            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4767            set i [string first "\t" $line]
4768            if {$i < 0} continue
4769            set sha1 [lindex $line 2]
4770            set fname [string range $line [expr {$i+1}] end]
4771            if {[string index $fname 0] eq "\""} {
4772                set fname [lindex $fname 0]
4773            }
4774            lappend treeidlist($id) $sha1
4775        }
4776        lappend treefilelist($id) $fname
4777    }
4778    if {![eof $gtf]} {
4779        return [expr {$nl >= 1000? 2: 1}]
4780    }
4781    close $gtf
4782    unset treepending
4783    if {$cmitmode ne "tree"} {
4784        if {![info exists diffmergeid]} {
4785            gettreediffs $diffids
4786        }
4787    } elseif {$id ne $diffids} {
4788        gettree $diffids
4789    } else {
4790        setfilelist $id
4791    }
4792    return 0
4793}
4794
4795proc showfile {f} {
4796    global treefilelist treeidlist diffids nullid nullid2
4797    global ctext commentend
4798
4799    set i [lsearch -exact $treefilelist($diffids) $f]
4800    if {$i < 0} {
4801        puts "oops, $f not in list for id $diffids"
4802        return
4803    }
4804    if {$diffids eq $nullid} {
4805        if {[catch {set bf [open $f r]} err]} {
4806            puts "oops, can't read $f: $err"
4807            return
4808        }
4809    } else {
4810        set blob [lindex $treeidlist($diffids) $i]
4811        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4812            puts "oops, error reading blob $blob: $err"
4813            return
4814        }
4815    }
4816    fconfigure $bf -blocking 0
4817    filerun $bf [list getblobline $bf $diffids]
4818    $ctext config -state normal
4819    clear_ctext $commentend
4820    $ctext insert end "\n"
4821    $ctext insert end "$f\n" filesep
4822    $ctext config -state disabled
4823    $ctext yview $commentend
4824}
4825
4826proc getblobline {bf id} {
4827    global diffids cmitmode ctext
4828
4829    if {$id ne $diffids || $cmitmode ne "tree"} {
4830        catch {close $bf}
4831        return 0
4832    }
4833    $ctext config -state normal
4834    set nl 0
4835    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4836        $ctext insert end "$line\n"
4837    }
4838    if {[eof $bf]} {
4839        # delete last newline
4840        $ctext delete "end - 2c" "end - 1c"
4841        close $bf
4842        return 0
4843    }
4844    $ctext config -state disabled
4845    return [expr {$nl >= 1000? 2: 1}]
4846}
4847
4848proc mergediff {id l} {
4849    global diffmergeid diffopts mdifffd
4850    global diffids
4851    global parentlist
4852
4853    set diffmergeid $id
4854    set diffids $id
4855    # this doesn't seem to actually affect anything...
4856    set env(GIT_DIFF_OPTS) $diffopts
4857    set cmd [concat | git diff-tree --no-commit-id --cc $id]
4858    if {[catch {set mdf [open $cmd r]} err]} {
4859        error_popup "Error getting merge diffs: $err"
4860        return
4861    }
4862    fconfigure $mdf -blocking 0
4863    set mdifffd($id) $mdf
4864    set np [llength [lindex $parentlist $l]]
4865    filerun $mdf [list getmergediffline $mdf $id $np]
4866}
4867
4868proc getmergediffline {mdf id np} {
4869    global diffmergeid ctext cflist mergemax
4870    global difffilestart mdifffd
4871
4872    $ctext conf -state normal
4873    set nr 0
4874    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4875        if {![info exists diffmergeid] || $id != $diffmergeid
4876            || $mdf != $mdifffd($id)} {
4877            close $mdf
4878            return 0
4879        }
4880        if {[regexp {^diff --cc (.*)} $line match fname]} {
4881            # start of a new file
4882            $ctext insert end "\n"
4883            set here [$ctext index "end - 1c"]
4884            lappend difffilestart $here
4885            add_flist [list $fname]
4886            set l [expr {(78 - [string length $fname]) / 2}]
4887            set pad [string range "----------------------------------------" 1 $l]
4888            $ctext insert end "$pad $fname $pad\n" filesep
4889        } elseif {[regexp {^@@} $line]} {
4890            $ctext insert end "$line\n" hunksep
4891        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4892            # do nothing
4893        } else {
4894            # parse the prefix - one ' ', '-' or '+' for each parent
4895            set spaces {}
4896            set minuses {}
4897            set pluses {}
4898            set isbad 0
4899            for {set j 0} {$j < $np} {incr j} {
4900                set c [string range $line $j $j]
4901                if {$c == " "} {
4902                    lappend spaces $j
4903                } elseif {$c == "-"} {
4904                    lappend minuses $j
4905                } elseif {$c == "+"} {
4906                    lappend pluses $j
4907                } else {
4908                    set isbad 1
4909                    break
4910                }
4911            }
4912            set tags {}
4913            set num {}
4914            if {!$isbad && $minuses ne {} && $pluses eq {}} {
4915                # line doesn't appear in result, parents in $minuses have the line
4916                set num [lindex $minuses 0]
4917            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4918                # line appears in result, parents in $pluses don't have the line
4919                lappend tags mresult
4920                set num [lindex $spaces 0]
4921            }
4922            if {$num ne {}} {
4923                if {$num >= $mergemax} {
4924                    set num "max"
4925                }
4926                lappend tags m$num
4927            }
4928            $ctext insert end "$line\n" $tags
4929        }
4930    }
4931    $ctext conf -state disabled
4932    if {[eof $mdf]} {
4933        close $mdf
4934        return 0
4935    }
4936    return [expr {$nr >= 1000? 2: 1}]
4937}
4938
4939proc startdiff {ids} {
4940    global treediffs diffids treepending diffmergeid nullid nullid2
4941
4942    set diffids $ids
4943    catch {unset diffmergeid}
4944    if {![info exists treediffs($ids)] ||
4945        [lsearch -exact $ids $nullid] >= 0 ||
4946        [lsearch -exact $ids $nullid2] >= 0} {
4947        if {![info exists treepending]} {
4948            gettreediffs $ids
4949        }
4950    } else {
4951        addtocflist $ids
4952    }
4953}
4954
4955proc addtocflist {ids} {
4956    global treediffs cflist
4957    add_flist $treediffs($ids)
4958    getblobdiffs $ids
4959}
4960
4961proc diffcmd {ids flags} {
4962    global nullid nullid2
4963
4964    set i [lsearch -exact $ids $nullid]
4965    set j [lsearch -exact $ids $nullid2]
4966    if {$i >= 0} {
4967        if {[llength $ids] > 1 && $j < 0} {
4968            # comparing working directory with some specific revision
4969            set cmd [concat | git diff-index $flags]
4970            if {$i == 0} {
4971                lappend cmd -R [lindex $ids 1]
4972            } else {
4973                lappend cmd [lindex $ids 0]
4974            }
4975        } else {
4976            # comparing working directory with index
4977            set cmd [concat | git diff-files $flags]
4978            if {$j == 1} {
4979                lappend cmd -R
4980            }
4981        }
4982    } elseif {$j >= 0} {
4983        set cmd [concat | git diff-index --cached $flags]
4984        if {[llength $ids] > 1} {
4985            # comparing index with specific revision
4986            if {$i == 0} {
4987                lappend cmd -R [lindex $ids 1]
4988            } else {
4989                lappend cmd [lindex $ids 0]
4990            }
4991        } else {
4992            # comparing index with HEAD
4993            lappend cmd HEAD
4994        }
4995    } else {
4996        set cmd [concat | git diff-tree -r $flags $ids]
4997    }
4998    return $cmd
4999}
5000
5001proc gettreediffs {ids} {
5002    global treediff treepending
5003
5004    set treepending $ids
5005    set treediff {}
5006    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5007    fconfigure $gdtf -blocking 0
5008    filerun $gdtf [list gettreediffline $gdtf $ids]
5009}
5010
5011proc gettreediffline {gdtf ids} {
5012    global treediff treediffs treepending diffids diffmergeid
5013    global cmitmode
5014
5015    set nr 0
5016    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5017        set i [string first "\t" $line]
5018        if {$i >= 0} {
5019            set file [string range $line [expr {$i+1}] end]
5020            if {[string index $file 0] eq "\""} {
5021                set file [lindex $file 0]
5022            }
5023            lappend treediff $file
5024        }
5025    }
5026    if {![eof $gdtf]} {
5027        return [expr {$nr >= 1000? 2: 1}]
5028    }
5029    close $gdtf
5030    set treediffs($ids) $treediff
5031    unset treepending
5032    if {$cmitmode eq "tree"} {
5033        gettree $diffids
5034    } elseif {$ids != $diffids} {
5035        if {![info exists diffmergeid]} {
5036            gettreediffs $diffids
5037        }
5038    } else {
5039        addtocflist $ids
5040    }
5041    return 0
5042}
5043
5044# empty string or positive integer
5045proc diffcontextvalidate {v} {
5046    return [regexp {^(|[1-9][0-9]*)$} $v]
5047}
5048
5049proc diffcontextchange {n1 n2 op} {
5050    global diffcontextstring diffcontext
5051
5052    if {[string is integer -strict $diffcontextstring]} {
5053        if {$diffcontextstring > 0} {
5054            set diffcontext $diffcontextstring
5055            reselectline
5056        }
5057    }
5058}
5059
5060proc getblobdiffs {ids} {
5061    global diffopts blobdifffd diffids env
5062    global diffinhdr treediffs
5063    global diffcontext
5064
5065    set env(GIT_DIFF_OPTS) $diffopts
5066    if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5067        puts "error getting diffs: $err"
5068        return
5069    }
5070    set diffinhdr 0
5071    fconfigure $bdf -blocking 0
5072    set blobdifffd($ids) $bdf
5073    filerun $bdf [list getblobdiffline $bdf $diffids]
5074}
5075
5076proc setinlist {var i val} {
5077    global $var
5078
5079    while {[llength [set $var]] < $i} {
5080        lappend $var {}
5081    }
5082    if {[llength [set $var]] == $i} {
5083        lappend $var $val
5084    } else {
5085        lset $var $i $val
5086    }
5087}
5088
5089proc makediffhdr {fname ids} {
5090    global ctext curdiffstart treediffs
5091
5092    set i [lsearch -exact $treediffs($ids) $fname]
5093    if {$i >= 0} {
5094        setinlist difffilestart $i $curdiffstart
5095    }
5096    set l [expr {(78 - [string length $fname]) / 2}]
5097    set pad [string range "----------------------------------------" 1 $l]
5098    $ctext insert $curdiffstart "$pad $fname $pad" filesep
5099}
5100
5101proc getblobdiffline {bdf ids} {
5102    global diffids blobdifffd ctext curdiffstart
5103    global diffnexthead diffnextnote difffilestart
5104    global diffinhdr treediffs
5105
5106    set nr 0
5107    $ctext conf -state normal
5108    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5109        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5110            close $bdf
5111            return 0
5112        }
5113        if {![string compare -length 11 "diff --git " $line]} {
5114            # trim off "diff --git "
5115            set line [string range $line 11 end]
5116            set diffinhdr 1
5117            # start of a new file
5118            $ctext insert end "\n"
5119            set curdiffstart [$ctext index "end - 1c"]
5120            $ctext insert end "\n" filesep
5121            # If the name hasn't changed the length will be odd,
5122            # the middle char will be a space, and the two bits either
5123            # side will be a/name and b/name, or "a/name" and "b/name".
5124            # If the name has changed we'll get "rename from" and
5125            # "rename to" or "copy from" and "copy to" lines following this,
5126            # and we'll use them to get the filenames.
5127            # This complexity is necessary because spaces in the filename(s)
5128            # don't get escaped.
5129            set l [string length $line]
5130            set i [expr {$l / 2}]
5131            if {!(($l & 1) && [string index $line $i] eq " " &&
5132                  [string range $line 2 [expr {$i - 1}]] eq \
5133                      [string range $line [expr {$i + 3}] end])} {
5134                continue
5135            }
5136            # unescape if quoted and chop off the a/ from the front
5137            if {[string index $line 0] eq "\""} {
5138                set fname [string range [lindex $line 0] 2 end]
5139            } else {
5140                set fname [string range $line 2 [expr {$i - 1}]]
5141            }
5142            makediffhdr $fname $ids
5143
5144        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5145                       $line match f1l f1c f2l f2c rest]} {
5146            $ctext insert end "$line\n" hunksep
5147            set diffinhdr 0
5148
5149        } elseif {$diffinhdr} {
5150            if {![string compare -length 12 "rename from " $line] ||
5151                ![string compare -length 10 "copy from " $line]} {
5152                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5153                if {[string index $fname 0] eq "\""} {
5154                    set fname [lindex $fname 0]
5155                }
5156                set i [lsearch -exact $treediffs($ids) $fname]
5157                if {$i >= 0} {
5158                    setinlist difffilestart $i $curdiffstart
5159                }
5160            } elseif {![string compare -length 10 $line "rename to "] ||
5161                      ![string compare -length 8 $line "copy to "]} {
5162                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5163                if {[string index $fname 0] eq "\""} {
5164                    set fname [lindex $fname 0]
5165                }
5166                makediffhdr $fname $ids
5167            } elseif {[string compare -length 3 $line "---"] == 0} {
5168                # do nothing
5169                continue
5170            } elseif {[string compare -length 3 $line "+++"] == 0} {
5171                set diffinhdr 0
5172                continue
5173            }
5174            $ctext insert end "$line\n" filesep
5175
5176        } else {
5177            set x [string range $line 0 0]
5178            if {$x == "-" || $x == "+"} {
5179                set tag [expr {$x == "+"}]
5180                $ctext insert end "$line\n" d$tag
5181            } elseif {$x == " "} {
5182                $ctext insert end "$line\n"
5183            } else {
5184                # "\ No newline at end of file",
5185                # or something else we don't recognize
5186                $ctext insert end "$line\n" hunksep
5187            }
5188        }
5189    }
5190    $ctext conf -state disabled
5191    if {[eof $bdf]} {
5192        close $bdf
5193        return 0
5194    }
5195    return [expr {$nr >= 1000? 2: 1}]
5196}
5197
5198proc changediffdisp {} {
5199    global ctext diffelide
5200
5201    $ctext tag conf d0 -elide [lindex $diffelide 0]
5202    $ctext tag conf d1 -elide [lindex $diffelide 1]
5203}
5204
5205proc prevfile {} {
5206    global difffilestart ctext
5207    set prev [lindex $difffilestart 0]
5208    set here [$ctext index @0,0]
5209    foreach loc $difffilestart {
5210        if {[$ctext compare $loc >= $here]} {
5211            $ctext yview $prev
5212            return
5213        }
5214        set prev $loc
5215    }
5216    $ctext yview $prev
5217}
5218
5219proc nextfile {} {
5220    global difffilestart ctext
5221    set here [$ctext index @0,0]
5222    foreach loc $difffilestart {
5223        if {[$ctext compare $loc > $here]} {
5224            $ctext yview $loc
5225            return
5226        }
5227    }
5228}
5229
5230proc clear_ctext {{first 1.0}} {
5231    global ctext smarktop smarkbot
5232
5233    set l [lindex [split $first .] 0]
5234    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5235        set smarktop $l
5236    }
5237    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5238        set smarkbot $l
5239    }
5240    $ctext delete $first end
5241}
5242
5243proc incrsearch {name ix op} {
5244    global ctext searchstring searchdirn
5245
5246    $ctext tag remove found 1.0 end
5247    if {[catch {$ctext index anchor}]} {
5248        # no anchor set, use start of selection, or of visible area
5249        set sel [$ctext tag ranges sel]
5250        if {$sel ne {}} {
5251            $ctext mark set anchor [lindex $sel 0]
5252        } elseif {$searchdirn eq "-forwards"} {
5253            $ctext mark set anchor @0,0
5254        } else {
5255            $ctext mark set anchor @0,[winfo height $ctext]
5256        }
5257    }
5258    if {$searchstring ne {}} {
5259        set here [$ctext search $searchdirn -- $searchstring anchor]
5260        if {$here ne {}} {
5261            $ctext see $here
5262        }
5263        searchmarkvisible 1
5264    }
5265}
5266
5267proc dosearch {} {
5268    global sstring ctext searchstring searchdirn
5269
5270    focus $sstring
5271    $sstring icursor end
5272    set searchdirn -forwards
5273    if {$searchstring ne {}} {
5274        set sel [$ctext tag ranges sel]
5275        if {$sel ne {}} {
5276            set start "[lindex $sel 0] + 1c"
5277        } elseif {[catch {set start [$ctext index anchor]}]} {
5278            set start "@0,0"
5279        }
5280        set match [$ctext search -count mlen -- $searchstring $start]
5281        $ctext tag remove sel 1.0 end
5282        if {$match eq {}} {
5283            bell
5284            return
5285        }
5286        $ctext see $match
5287        set mend "$match + $mlen c"
5288        $ctext tag add sel $match $mend
5289        $ctext mark unset anchor
5290    }
5291}
5292
5293proc dosearchback {} {
5294    global sstring ctext searchstring searchdirn
5295
5296    focus $sstring
5297    $sstring icursor end
5298    set searchdirn -backwards
5299    if {$searchstring ne {}} {
5300        set sel [$ctext tag ranges sel]
5301        if {$sel ne {}} {
5302            set start [lindex $sel 0]
5303        } elseif {[catch {set start [$ctext index anchor]}]} {
5304            set start @0,[winfo height $ctext]
5305        }
5306        set match [$ctext search -backwards -count ml -- $searchstring $start]
5307        $ctext tag remove sel 1.0 end
5308        if {$match eq {}} {
5309            bell
5310            return
5311        }
5312        $ctext see $match
5313        set mend "$match + $ml c"
5314        $ctext tag add sel $match $mend
5315        $ctext mark unset anchor
5316    }
5317}
5318
5319proc searchmark {first last} {
5320    global ctext searchstring
5321
5322    set mend $first.0
5323    while {1} {
5324        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5325        if {$match eq {}} break
5326        set mend "$match + $mlen c"
5327        $ctext tag add found $match $mend
5328    }
5329}
5330
5331proc searchmarkvisible {doall} {
5332    global ctext smarktop smarkbot
5333
5334    set topline [lindex [split [$ctext index @0,0] .] 0]
5335    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5336    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5337        # no overlap with previous
5338        searchmark $topline $botline
5339        set smarktop $topline
5340        set smarkbot $botline
5341    } else {
5342        if {$topline < $smarktop} {
5343            searchmark $topline [expr {$smarktop-1}]
5344            set smarktop $topline
5345        }
5346        if {$botline > $smarkbot} {
5347            searchmark [expr {$smarkbot+1}] $botline
5348            set smarkbot $botline
5349        }
5350    }
5351}
5352
5353proc scrolltext {f0 f1} {
5354    global searchstring
5355
5356    .bleft.sb set $f0 $f1
5357    if {$searchstring ne {}} {
5358        searchmarkvisible 0
5359    }
5360}
5361
5362proc setcoords {} {
5363    global linespc charspc canvx0 canvy0 mainfont
5364    global xspc1 xspc2 lthickness
5365
5366    set linespc [font metrics $mainfont -linespace]
5367    set charspc [font measure $mainfont "m"]
5368    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5369    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5370    set lthickness [expr {int($linespc / 9) + 1}]
5371    set xspc1(0) $linespc
5372    set xspc2 $linespc
5373}
5374
5375proc redisplay {} {
5376    global canv
5377    global selectedline
5378
5379    set ymax [lindex [$canv cget -scrollregion] 3]
5380    if {$ymax eq {} || $ymax == 0} return
5381    set span [$canv yview]
5382    clear_display
5383    setcanvscroll
5384    allcanvs yview moveto [lindex $span 0]
5385    drawvisible
5386    if {[info exists selectedline]} {
5387        selectline $selectedline 0
5388        allcanvs yview moveto [lindex $span 0]
5389    }
5390}
5391
5392proc incrfont {inc} {
5393    global mainfont textfont ctext canv phase cflist showrefstop
5394    global charspc tabstop
5395    global stopped entries
5396    unmarkmatches
5397    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5398    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5399    setcoords
5400    $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5401    $cflist conf -font $textfont
5402    $ctext tag conf filesep -font [concat $textfont bold]
5403    foreach e $entries {
5404        $e conf -font $mainfont
5405    }
5406    if {$phase eq "getcommits"} {
5407        $canv itemconf textitems -font $mainfont
5408    }
5409    if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5410        $showrefstop.list conf -font $mainfont
5411    }
5412    redisplay
5413}
5414
5415proc clearsha1 {} {
5416    global sha1entry sha1string
5417    if {[string length $sha1string] == 40} {
5418        $sha1entry delete 0 end
5419    }
5420}
5421
5422proc sha1change {n1 n2 op} {
5423    global sha1string currentid sha1but
5424    if {$sha1string == {}
5425        || ([info exists currentid] && $sha1string == $currentid)} {
5426        set state disabled
5427    } else {
5428        set state normal
5429    }
5430    if {[$sha1but cget -state] == $state} return
5431    if {$state == "normal"} {
5432        $sha1but conf -state normal -relief raised -text "Goto: "
5433    } else {
5434        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5435    }
5436}
5437
5438proc gotocommit {} {
5439    global sha1string currentid commitrow tagids headids
5440    global displayorder numcommits curview
5441
5442    if {$sha1string == {}
5443        || ([info exists currentid] && $sha1string == $currentid)} return
5444    if {[info exists tagids($sha1string)]} {
5445        set id $tagids($sha1string)
5446    } elseif {[info exists headids($sha1string)]} {
5447        set id $headids($sha1string)
5448    } else {
5449        set id [string tolower $sha1string]
5450        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5451            set matches {}
5452            foreach i $displayorder {
5453                if {[string match $id* $i]} {
5454                    lappend matches $i
5455                }
5456            }
5457            if {$matches ne {}} {
5458                if {[llength $matches] > 1} {
5459                    error_popup "Short SHA1 id $id is ambiguous"
5460                    return
5461                }
5462                set id [lindex $matches 0]
5463            }
5464        }
5465    }
5466    if {[info exists commitrow($curview,$id)]} {
5467        selectline $commitrow($curview,$id) 1
5468        return
5469    }
5470    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5471        set type "SHA1 id"
5472    } else {
5473        set type "Tag/Head"
5474    }
5475    error_popup "$type $sha1string is not known"
5476}
5477
5478proc lineenter {x y id} {
5479    global hoverx hovery hoverid hovertimer
5480    global commitinfo canv
5481
5482    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5483    set hoverx $x
5484    set hovery $y
5485    set hoverid $id
5486    if {[info exists hovertimer]} {
5487        after cancel $hovertimer
5488    }
5489    set hovertimer [after 500 linehover]
5490    $canv delete hover
5491}
5492
5493proc linemotion {x y id} {
5494    global hoverx hovery hoverid hovertimer
5495
5496    if {[info exists hoverid] && $id == $hoverid} {
5497        set hoverx $x
5498        set hovery $y
5499        if {[info exists hovertimer]} {
5500            after cancel $hovertimer
5501        }
5502        set hovertimer [after 500 linehover]
5503    }
5504}
5505
5506proc lineleave {id} {
5507    global hoverid hovertimer canv
5508
5509    if {[info exists hoverid] && $id == $hoverid} {
5510        $canv delete hover
5511        if {[info exists hovertimer]} {
5512            after cancel $hovertimer
5513            unset hovertimer
5514        }
5515        unset hoverid
5516    }
5517}
5518
5519proc linehover {} {
5520    global hoverx hovery hoverid hovertimer
5521    global canv linespc lthickness
5522    global commitinfo mainfont
5523
5524    set text [lindex $commitinfo($hoverid) 0]
5525    set ymax [lindex [$canv cget -scrollregion] 3]
5526    if {$ymax == {}} return
5527    set yfrac [lindex [$canv yview] 0]
5528    set x [expr {$hoverx + 2 * $linespc}]
5529    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5530    set x0 [expr {$x - 2 * $lthickness}]
5531    set y0 [expr {$y - 2 * $lthickness}]
5532    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5533    set y1 [expr {$y + $linespc + 2 * $lthickness}]
5534    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5535               -fill \#ffff80 -outline black -width 1 -tags hover]
5536    $canv raise $t
5537    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5538               -font $mainfont]
5539    $canv raise $t
5540}
5541
5542proc clickisonarrow {id y} {
5543    global lthickness
5544
5545    set ranges [rowranges $id]
5546    set thresh [expr {2 * $lthickness + 6}]
5547    set n [expr {[llength $ranges] - 1}]
5548    for {set i 1} {$i < $n} {incr i} {
5549        set row [lindex $ranges $i]
5550        if {abs([yc $row] - $y) < $thresh} {
5551            return $i
5552        }
5553    }
5554    return {}
5555}
5556
5557proc arrowjump {id n y} {
5558    global canv
5559
5560    # 1 <-> 2, 3 <-> 4, etc...
5561    set n [expr {(($n - 1) ^ 1) + 1}]
5562    set row [lindex [rowranges $id] $n]
5563    set yt [yc $row]
5564    set ymax [lindex [$canv cget -scrollregion] 3]
5565    if {$ymax eq {} || $ymax <= 0} return
5566    set view [$canv yview]
5567    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5568    set yfrac [expr {$yt / $ymax - $yspan / 2}]
5569    if {$yfrac < 0} {
5570        set yfrac 0
5571    }
5572    allcanvs yview moveto $yfrac
5573}
5574
5575proc lineclick {x y id isnew} {
5576    global ctext commitinfo children canv thickerline curview
5577
5578    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5579    unmarkmatches
5580    unselectline
5581    normalline
5582    $canv delete hover
5583    # draw this line thicker than normal
5584    set thickerline $id
5585    drawlines $id
5586    if {$isnew} {
5587        set ymax [lindex [$canv cget -scrollregion] 3]
5588        if {$ymax eq {}} return
5589        set yfrac [lindex [$canv yview] 0]
5590        set y [expr {$y + $yfrac * $ymax}]
5591    }
5592    set dirn [clickisonarrow $id $y]
5593    if {$dirn ne {}} {
5594        arrowjump $id $dirn $y
5595        return
5596    }
5597
5598    if {$isnew} {
5599        addtohistory [list lineclick $x $y $id 0]
5600    }
5601    # fill the details pane with info about this line
5602    $ctext conf -state normal
5603    clear_ctext
5604    $ctext tag conf link -foreground blue -underline 1
5605    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5606    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5607    $ctext insert end "Parent:\t"
5608    $ctext insert end $id [list link link0]
5609    $ctext tag bind link0 <1> [list selbyid $id]
5610    set info $commitinfo($id)
5611    $ctext insert end "\n\t[lindex $info 0]\n"
5612    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5613    set date [formatdate [lindex $info 2]]
5614    $ctext insert end "\tDate:\t$date\n"
5615    set kids $children($curview,$id)
5616    if {$kids ne {}} {
5617        $ctext insert end "\nChildren:"
5618        set i 0
5619        foreach child $kids {
5620            incr i
5621            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5622            set info $commitinfo($child)
5623            $ctext insert end "\n\t"
5624            $ctext insert end $child [list link link$i]
5625            $ctext tag bind link$i <1> [list selbyid $child]
5626            $ctext insert end "\n\t[lindex $info 0]"
5627            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5628            set date [formatdate [lindex $info 2]]
5629            $ctext insert end "\n\tDate:\t$date\n"
5630        }
5631    }
5632    $ctext conf -state disabled
5633    init_flist {}
5634}
5635
5636proc normalline {} {
5637    global thickerline
5638    if {[info exists thickerline]} {
5639        set id $thickerline
5640        unset thickerline
5641        drawlines $id
5642    }
5643}
5644
5645proc selbyid {id} {
5646    global commitrow curview
5647    if {[info exists commitrow($curview,$id)]} {
5648        selectline $commitrow($curview,$id) 1
5649    }
5650}
5651
5652proc mstime {} {
5653    global startmstime
5654    if {![info exists startmstime]} {
5655        set startmstime [clock clicks -milliseconds]
5656    }
5657    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5658}
5659
5660proc rowmenu {x y id} {
5661    global rowctxmenu commitrow selectedline rowmenuid curview
5662    global nullid nullid2 fakerowmenu mainhead
5663
5664    set rowmenuid $id
5665    if {![info exists selectedline]
5666        || $commitrow($curview,$id) eq $selectedline} {
5667        set state disabled
5668    } else {
5669        set state normal
5670    }
5671    if {$id ne $nullid && $id ne $nullid2} {
5672        set menu $rowctxmenu
5673        $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5674    } else {
5675        set menu $fakerowmenu
5676    }
5677    $menu entryconfigure "Diff this*" -state $state
5678    $menu entryconfigure "Diff selected*" -state $state
5679    $menu entryconfigure "Make patch" -state $state
5680    tk_popup $menu $x $y
5681}
5682
5683proc diffvssel {dirn} {
5684    global rowmenuid selectedline displayorder
5685
5686    if {![info exists selectedline]} return
5687    if {$dirn} {
5688        set oldid [lindex $displayorder $selectedline]
5689        set newid $rowmenuid
5690    } else {
5691        set oldid $rowmenuid
5692        set newid [lindex $displayorder $selectedline]
5693    }
5694    addtohistory [list doseldiff $oldid $newid]
5695    doseldiff $oldid $newid
5696}
5697
5698proc doseldiff {oldid newid} {
5699    global ctext
5700    global commitinfo
5701
5702    $ctext conf -state normal
5703    clear_ctext
5704    init_flist "Top"
5705    $ctext insert end "From "
5706    $ctext tag conf link -foreground blue -underline 1
5707    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5708    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5709    $ctext tag bind link0 <1> [list selbyid $oldid]
5710    $ctext insert end $oldid [list link link0]
5711    $ctext insert end "\n     "
5712    $ctext insert end [lindex $commitinfo($oldid) 0]
5713    $ctext insert end "\n\nTo   "
5714    $ctext tag bind link1 <1> [list selbyid $newid]
5715    $ctext insert end $newid [list link link1]
5716    $ctext insert end "\n     "
5717    $ctext insert end [lindex $commitinfo($newid) 0]
5718    $ctext insert end "\n"
5719    $ctext conf -state disabled
5720    $ctext tag remove found 1.0 end
5721    startdiff [list $oldid $newid]
5722}
5723
5724proc mkpatch {} {
5725    global rowmenuid currentid commitinfo patchtop patchnum
5726
5727    if {![info exists currentid]} return
5728    set oldid $currentid
5729    set oldhead [lindex $commitinfo($oldid) 0]
5730    set newid $rowmenuid
5731    set newhead [lindex $commitinfo($newid) 0]
5732    set top .patch
5733    set patchtop $top
5734    catch {destroy $top}
5735    toplevel $top
5736    label $top.title -text "Generate patch"
5737    grid $top.title - -pady 10
5738    label $top.from -text "From:"
5739    entry $top.fromsha1 -width 40 -relief flat
5740    $top.fromsha1 insert 0 $oldid
5741    $top.fromsha1 conf -state readonly
5742    grid $top.from $top.fromsha1 -sticky w
5743    entry $top.fromhead -width 60 -relief flat
5744    $top.fromhead insert 0 $oldhead
5745    $top.fromhead conf -state readonly
5746    grid x $top.fromhead -sticky w
5747    label $top.to -text "To:"
5748    entry $top.tosha1 -width 40 -relief flat
5749    $top.tosha1 insert 0 $newid
5750    $top.tosha1 conf -state readonly
5751    grid $top.to $top.tosha1 -sticky w
5752    entry $top.tohead -width 60 -relief flat
5753    $top.tohead insert 0 $newhead
5754    $top.tohead conf -state readonly
5755    grid x $top.tohead -sticky w
5756    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5757    grid $top.rev x -pady 10
5758    label $top.flab -text "Output file:"
5759    entry $top.fname -width 60
5760    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5761    incr patchnum
5762    grid $top.flab $top.fname -sticky w
5763    frame $top.buts
5764    button $top.buts.gen -text "Generate" -command mkpatchgo
5765    button $top.buts.can -text "Cancel" -command mkpatchcan
5766    grid $top.buts.gen $top.buts.can
5767    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5768    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5769    grid $top.buts - -pady 10 -sticky ew
5770    focus $top.fname
5771}
5772
5773proc mkpatchrev {} {
5774    global patchtop
5775
5776    set oldid [$patchtop.fromsha1 get]
5777    set oldhead [$patchtop.fromhead get]
5778    set newid [$patchtop.tosha1 get]
5779    set newhead [$patchtop.tohead get]
5780    foreach e [list fromsha1 fromhead tosha1 tohead] \
5781            v [list $newid $newhead $oldid $oldhead] {
5782        $patchtop.$e conf -state normal
5783        $patchtop.$e delete 0 end
5784        $patchtop.$e insert 0 $v
5785        $patchtop.$e conf -state readonly
5786    }
5787}
5788
5789proc mkpatchgo {} {
5790    global patchtop nullid nullid2
5791
5792    set oldid [$patchtop.fromsha1 get]
5793    set newid [$patchtop.tosha1 get]
5794    set fname [$patchtop.fname get]
5795    set cmd [diffcmd [list $oldid $newid] -p]
5796    lappend cmd >$fname &
5797    if {[catch {eval exec $cmd} err]} {
5798        error_popup "Error creating patch: $err"
5799    }
5800    catch {destroy $patchtop}
5801    unset patchtop
5802}
5803
5804proc mkpatchcan {} {
5805    global patchtop
5806
5807    catch {destroy $patchtop}
5808    unset patchtop
5809}
5810
5811proc mktag {} {
5812    global rowmenuid mktagtop commitinfo
5813
5814    set top .maketag
5815    set mktagtop $top
5816    catch {destroy $top}
5817    toplevel $top
5818    label $top.title -text "Create tag"
5819    grid $top.title - -pady 10
5820    label $top.id -text "ID:"
5821    entry $top.sha1 -width 40 -relief flat
5822    $top.sha1 insert 0 $rowmenuid
5823    $top.sha1 conf -state readonly
5824    grid $top.id $top.sha1 -sticky w
5825    entry $top.head -width 60 -relief flat
5826    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5827    $top.head conf -state readonly
5828    grid x $top.head -sticky w
5829    label $top.tlab -text "Tag name:"
5830    entry $top.tag -width 60
5831    grid $top.tlab $top.tag -sticky w
5832    frame $top.buts
5833    button $top.buts.gen -text "Create" -command mktaggo
5834    button $top.buts.can -text "Cancel" -command mktagcan
5835    grid $top.buts.gen $top.buts.can
5836    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5837    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5838    grid $top.buts - -pady 10 -sticky ew
5839    focus $top.tag
5840}
5841
5842proc domktag {} {
5843    global mktagtop env tagids idtags
5844
5845    set id [$mktagtop.sha1 get]
5846    set tag [$mktagtop.tag get]
5847    if {$tag == {}} {
5848        error_popup "No tag name specified"
5849        return
5850    }
5851    if {[info exists tagids($tag)]} {
5852        error_popup "Tag \"$tag\" already exists"
5853        return
5854    }
5855    if {[catch {
5856        set dir [gitdir]
5857        set fname [file join $dir "refs/tags" $tag]
5858        set f [open $fname w]
5859        puts $f $id
5860        close $f
5861    } err]} {
5862        error_popup "Error creating tag: $err"
5863        return
5864    }
5865
5866    set tagids($tag) $id
5867    lappend idtags($id) $tag
5868    redrawtags $id
5869    addedtag $id
5870    dispneartags 0
5871    run refill_reflist
5872}
5873
5874proc redrawtags {id} {
5875    global canv linehtag commitrow idpos selectedline curview
5876    global mainfont canvxmax iddrawn
5877
5878    if {![info exists commitrow($curview,$id)]} return
5879    if {![info exists iddrawn($id)]} return
5880    drawcommits $commitrow($curview,$id)
5881    $canv delete tag.$id
5882    set xt [eval drawtags $id $idpos($id)]
5883    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5884    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5885    set xr [expr {$xt + [font measure $mainfont $text]}]
5886    if {$xr > $canvxmax} {
5887        set canvxmax $xr
5888        setcanvscroll
5889    }
5890    if {[info exists selectedline]
5891        && $selectedline == $commitrow($curview,$id)} {
5892        selectline $selectedline 0
5893    }
5894}
5895
5896proc mktagcan {} {
5897    global mktagtop
5898
5899    catch {destroy $mktagtop}
5900    unset mktagtop
5901}
5902
5903proc mktaggo {} {
5904    domktag
5905    mktagcan
5906}
5907
5908proc writecommit {} {
5909    global rowmenuid wrcomtop commitinfo wrcomcmd
5910
5911    set top .writecommit
5912    set wrcomtop $top
5913    catch {destroy $top}
5914    toplevel $top
5915    label $top.title -text "Write commit to file"
5916    grid $top.title - -pady 10
5917    label $top.id -text "ID:"
5918    entry $top.sha1 -width 40 -relief flat
5919    $top.sha1 insert 0 $rowmenuid
5920    $top.sha1 conf -state readonly
5921    grid $top.id $top.sha1 -sticky w
5922    entry $top.head -width 60 -relief flat
5923    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5924    $top.head conf -state readonly
5925    grid x $top.head -sticky w
5926    label $top.clab -text "Command:"
5927    entry $top.cmd -width 60 -textvariable wrcomcmd
5928    grid $top.clab $top.cmd -sticky w -pady 10
5929    label $top.flab -text "Output file:"
5930    entry $top.fname -width 60
5931    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5932    grid $top.flab $top.fname -sticky w
5933    frame $top.buts
5934    button $top.buts.gen -text "Write" -command wrcomgo
5935    button $top.buts.can -text "Cancel" -command wrcomcan
5936    grid $top.buts.gen $top.buts.can
5937    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5938    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5939    grid $top.buts - -pady 10 -sticky ew
5940    focus $top.fname
5941}
5942
5943proc wrcomgo {} {
5944    global wrcomtop
5945
5946    set id [$wrcomtop.sha1 get]
5947    set cmd "echo $id | [$wrcomtop.cmd get]"
5948    set fname [$wrcomtop.fname get]
5949    if {[catch {exec sh -c $cmd >$fname &} err]} {
5950        error_popup "Error writing commit: $err"
5951    }
5952    catch {destroy $wrcomtop}
5953    unset wrcomtop
5954}
5955
5956proc wrcomcan {} {
5957    global wrcomtop
5958
5959    catch {destroy $wrcomtop}
5960    unset wrcomtop
5961}
5962
5963proc mkbranch {} {
5964    global rowmenuid mkbrtop
5965
5966    set top .makebranch
5967    catch {destroy $top}
5968    toplevel $top
5969    label $top.title -text "Create new branch"
5970    grid $top.title - -pady 10
5971    label $top.id -text "ID:"
5972    entry $top.sha1 -width 40 -relief flat
5973    $top.sha1 insert 0 $rowmenuid
5974    $top.sha1 conf -state readonly
5975    grid $top.id $top.sha1 -sticky w
5976    label $top.nlab -text "Name:"
5977    entry $top.name -width 40
5978    grid $top.nlab $top.name -sticky w
5979    frame $top.buts
5980    button $top.buts.go -text "Create" -command [list mkbrgo $top]
5981    button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5982    grid $top.buts.go $top.buts.can
5983    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5984    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5985    grid $top.buts - -pady 10 -sticky ew
5986    focus $top.name
5987}
5988
5989proc mkbrgo {top} {
5990    global headids idheads
5991
5992    set name [$top.name get]
5993    set id [$top.sha1 get]
5994    if {$name eq {}} {
5995        error_popup "Please specify a name for the new branch"
5996        return
5997    }
5998    catch {destroy $top}
5999    nowbusy newbranch
6000    update
6001    if {[catch {
6002        exec git branch $name $id
6003    } err]} {
6004        notbusy newbranch
6005        error_popup $err
6006    } else {
6007        set headids($name) $id
6008        lappend idheads($id) $name
6009        addedhead $id $name
6010        notbusy newbranch
6011        redrawtags $id
6012        dispneartags 0
6013        run refill_reflist
6014    }
6015}
6016
6017proc cherrypick {} {
6018    global rowmenuid curview commitrow
6019    global mainhead
6020
6021    set oldhead [exec git rev-parse HEAD]
6022    set dheads [descheads $rowmenuid]
6023    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6024        set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6025                        included in branch $mainhead -- really re-apply it?"]
6026        if {!$ok} return
6027    }
6028    nowbusy cherrypick
6029    update
6030    # Unfortunately git-cherry-pick writes stuff to stderr even when
6031    # no error occurs, and exec takes that as an indication of error...
6032    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6033        notbusy cherrypick
6034        error_popup $err
6035        return
6036    }
6037    set newhead [exec git rev-parse HEAD]
6038    if {$newhead eq $oldhead} {
6039        notbusy cherrypick
6040        error_popup "No changes committed"
6041        return
6042    }
6043    addnewchild $newhead $oldhead
6044    if {[info exists commitrow($curview,$oldhead)]} {
6045        insertrow $commitrow($curview,$oldhead) $newhead
6046        if {$mainhead ne {}} {
6047            movehead $newhead $mainhead
6048            movedhead $newhead $mainhead
6049        }
6050        redrawtags $oldhead
6051        redrawtags $newhead
6052    }
6053    notbusy cherrypick
6054}
6055
6056proc resethead {} {
6057    global mainheadid mainhead rowmenuid confirm_ok resettype
6058    global showlocalchanges
6059
6060    set confirm_ok 0
6061    set w ".confirmreset"
6062    toplevel $w
6063    wm transient $w .
6064    wm title $w "Confirm reset"
6065    message $w.m -text \
6066        "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6067        -justify center -aspect 1000
6068    pack $w.m -side top -fill x -padx 20 -pady 20
6069    frame $w.f -relief sunken -border 2
6070    message $w.f.rt -text "Reset type:" -aspect 1000
6071    grid $w.f.rt -sticky w
6072    set resettype mixed
6073    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6074        -text "Soft: Leave working tree and index untouched"
6075    grid $w.f.soft -sticky w
6076    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6077        -text "Mixed: Leave working tree untouched, reset index"
6078    grid $w.f.mixed -sticky w
6079    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6080        -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6081    grid $w.f.hard -sticky w
6082    pack $w.f -side top -fill x
6083    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6084    pack $w.ok -side left -fill x -padx 20 -pady 20
6085    button $w.cancel -text Cancel -command "destroy $w"
6086    pack $w.cancel -side right -fill x -padx 20 -pady 20
6087    bind $w <Visibility> "grab $w; focus $w"
6088    tkwait window $w
6089    if {!$confirm_ok} return
6090    if {[catch {set fd [open \
6091            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6092        error_popup $err
6093    } else {
6094        dohidelocalchanges
6095        set w ".resetprogress"
6096        filerun $fd [list readresetstat $fd $w]
6097        toplevel $w
6098        wm transient $w
6099        wm title $w "Reset progress"
6100        message $w.m -text "Reset in progress, please wait..." \
6101            -justify center -aspect 1000
6102        pack $w.m -side top -fill x -padx 20 -pady 5
6103        canvas $w.c -width 150 -height 20 -bg white
6104        $w.c create rect 0 0 0 20 -fill green -tags rect
6105        pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6106        nowbusy reset
6107    }
6108}
6109
6110proc readresetstat {fd w} {
6111    global mainhead mainheadid showlocalchanges
6112
6113    if {[gets $fd line] >= 0} {
6114        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6115            set x [expr {($m * 150) / $n}]
6116            $w.c coords rect 0 0 $x 20
6117        }
6118        return 1
6119    }
6120    destroy $w
6121    notbusy reset
6122    if {[catch {close $fd} err]} {
6123        error_popup $err
6124    }
6125    set oldhead $mainheadid
6126    set newhead [exec git rev-parse HEAD]
6127    if {$newhead ne $oldhead} {
6128        movehead $newhead $mainhead
6129        movedhead $newhead $mainhead
6130        set mainheadid $newhead
6131        redrawtags $oldhead
6132        redrawtags $newhead
6133    }
6134    if {$showlocalchanges} {
6135        doshowlocalchanges
6136    }
6137    return 0
6138}
6139
6140# context menu for a head
6141proc headmenu {x y id head} {
6142    global headmenuid headmenuhead headctxmenu mainhead
6143
6144    set headmenuid $id
6145    set headmenuhead $head
6146    set state normal
6147    if {$head eq $mainhead} {
6148        set state disabled
6149    }
6150    $headctxmenu entryconfigure 0 -state $state
6151    $headctxmenu entryconfigure 1 -state $state
6152    tk_popup $headctxmenu $x $y
6153}
6154
6155proc cobranch {} {
6156    global headmenuid headmenuhead mainhead headids
6157    global showlocalchanges mainheadid
6158
6159    # check the tree is clean first??
6160    set oldmainhead $mainhead
6161    nowbusy checkout
6162    update
6163    dohidelocalchanges
6164    if {[catch {
6165        exec git checkout -q $headmenuhead
6166    } err]} {
6167        notbusy checkout
6168        error_popup $err
6169    } else {
6170        notbusy checkout
6171        set mainhead $headmenuhead
6172        set mainheadid $headmenuid
6173        if {[info exists headids($oldmainhead)]} {
6174            redrawtags $headids($oldmainhead)
6175        }
6176        redrawtags $headmenuid
6177    }
6178    if {$showlocalchanges} {
6179        dodiffindex
6180    }
6181}
6182
6183proc rmbranch {} {
6184    global headmenuid headmenuhead mainhead
6185    global idheads
6186
6187    set head $headmenuhead
6188    set id $headmenuid
6189    # this check shouldn't be needed any more...
6190    if {$head eq $mainhead} {
6191        error_popup "Cannot delete the currently checked-out branch"
6192        return
6193    }
6194    set dheads [descheads $id]
6195    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6196        # the stuff on this branch isn't on any other branch
6197        if {![confirm_popup "The commits on branch $head aren't on any other\
6198                        branch.\nReally delete branch $head?"]} return
6199    }
6200    nowbusy rmbranch
6201    update
6202    if {[catch {exec git branch -D $head} err]} {
6203        notbusy rmbranch
6204        error_popup $err
6205        return
6206    }
6207    removehead $id $head
6208    removedhead $id $head
6209    redrawtags $id
6210    notbusy rmbranch
6211    dispneartags 0
6212    run refill_reflist
6213}
6214
6215# Display a list of tags and heads
6216proc showrefs {} {
6217    global showrefstop bgcolor fgcolor selectbgcolor mainfont
6218    global bglist fglist uifont reflistfilter reflist maincursor
6219
6220    set top .showrefs
6221    set showrefstop $top
6222    if {[winfo exists $top]} {
6223        raise $top
6224        refill_reflist
6225        return
6226    }
6227    toplevel $top
6228    wm title $top "Tags and heads: [file tail [pwd]]"
6229    text $top.list -background $bgcolor -foreground $fgcolor \
6230        -selectbackground $selectbgcolor -font $mainfont \
6231        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6232        -width 30 -height 20 -cursor $maincursor \
6233        -spacing1 1 -spacing3 1 -state disabled
6234    $top.list tag configure highlight -background $selectbgcolor
6235    lappend bglist $top.list
6236    lappend fglist $top.list
6237    scrollbar $top.ysb -command "$top.list yview" -orient vertical
6238    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6239    grid $top.list $top.ysb -sticky nsew
6240    grid $top.xsb x -sticky ew
6241    frame $top.f
6242    label $top.f.l -text "Filter: " -font $uifont
6243    entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6244    set reflistfilter "*"
6245    trace add variable reflistfilter write reflistfilter_change
6246    pack $top.f.e -side right -fill x -expand 1
6247    pack $top.f.l -side left
6248    grid $top.f - -sticky ew -pady 2
6249    button $top.close -command [list destroy $top] -text "Close" \
6250        -font $uifont
6251    grid $top.close -
6252    grid columnconfigure $top 0 -weight 1
6253    grid rowconfigure $top 0 -weight 1
6254    bind $top.list <1> {break}
6255    bind $top.list <B1-Motion> {break}
6256    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6257    set reflist {}
6258    refill_reflist
6259}
6260
6261proc sel_reflist {w x y} {
6262    global showrefstop reflist headids tagids otherrefids
6263
6264    if {![winfo exists $showrefstop]} return
6265    set l [lindex [split [$w index "@$x,$y"] "."] 0]
6266    set ref [lindex $reflist [expr {$l-1}]]
6267    set n [lindex $ref 0]
6268    switch -- [lindex $ref 1] {
6269        "H" {selbyid $headids($n)}
6270        "T" {selbyid $tagids($n)}
6271        "o" {selbyid $otherrefids($n)}
6272    }
6273    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6274}
6275
6276proc unsel_reflist {} {
6277    global showrefstop
6278
6279    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6280    $showrefstop.list tag remove highlight 0.0 end
6281}
6282
6283proc reflistfilter_change {n1 n2 op} {
6284    global reflistfilter
6285
6286    after cancel refill_reflist
6287    after 200 refill_reflist
6288}
6289
6290proc refill_reflist {} {
6291    global reflist reflistfilter showrefstop headids tagids otherrefids
6292    global commitrow curview commitinterest
6293
6294    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6295    set refs {}
6296    foreach n [array names headids] {
6297        if {[string match $reflistfilter $n]} {
6298            if {[info exists commitrow($curview,$headids($n))]} {
6299                lappend refs [list $n H]
6300            } else {
6301                set commitinterest($headids($n)) {run refill_reflist}
6302            }
6303        }
6304    }
6305    foreach n [array names tagids] {
6306        if {[string match $reflistfilter $n]} {
6307            if {[info exists commitrow($curview,$tagids($n))]} {
6308                lappend refs [list $n T]
6309            } else {
6310                set commitinterest($tagids($n)) {run refill_reflist}
6311            }
6312        }
6313    }
6314    foreach n [array names otherrefids] {
6315        if {[string match $reflistfilter $n]} {
6316            if {[info exists commitrow($curview,$otherrefids($n))]} {
6317                lappend refs [list $n o]
6318            } else {
6319                set commitinterest($otherrefids($n)) {run refill_reflist}
6320            }
6321        }
6322    }
6323    set refs [lsort -index 0 $refs]
6324    if {$refs eq $reflist} return
6325
6326    # Update the contents of $showrefstop.list according to the
6327    # differences between $reflist (old) and $refs (new)
6328    $showrefstop.list conf -state normal
6329    $showrefstop.list insert end "\n"
6330    set i 0
6331    set j 0
6332    while {$i < [llength $reflist] || $j < [llength $refs]} {
6333        if {$i < [llength $reflist]} {
6334            if {$j < [llength $refs]} {
6335                set cmp [string compare [lindex $reflist $i 0] \
6336                             [lindex $refs $j 0]]
6337                if {$cmp == 0} {
6338                    set cmp [string compare [lindex $reflist $i 1] \
6339                                 [lindex $refs $j 1]]
6340                }
6341            } else {
6342                set cmp -1
6343            }
6344        } else {
6345            set cmp 1
6346        }
6347        switch -- $cmp {
6348            -1 {
6349                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6350                incr i
6351            }
6352            0 {
6353                incr i
6354                incr j
6355            }
6356            1 {
6357                set l [expr {$j + 1}]
6358                $showrefstop.list image create $l.0 -align baseline \
6359                    -image reficon-[lindex $refs $j 1] -padx 2
6360                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6361                incr j
6362            }
6363        }
6364    }
6365    set reflist $refs
6366    # delete last newline
6367    $showrefstop.list delete end-2c end-1c
6368    $showrefstop.list conf -state disabled
6369}
6370
6371# Stuff for finding nearby tags
6372proc getallcommits {} {
6373    global allcommits allids nbmp nextarc seeds
6374
6375    if {![info exists allcommits]} {
6376        set allids {}
6377        set nbmp 0
6378        set nextarc 0
6379        set allcommits 0
6380        set seeds {}
6381    }
6382
6383    set cmd [concat | git rev-list --all --parents]
6384    foreach id $seeds {
6385        lappend cmd "^$id"
6386    }
6387    set fd [open $cmd r]
6388    fconfigure $fd -blocking 0
6389    incr allcommits
6390    nowbusy allcommits
6391    filerun $fd [list getallclines $fd]
6392}
6393
6394# Since most commits have 1 parent and 1 child, we group strings of
6395# such commits into "arcs" joining branch/merge points (BMPs), which
6396# are commits that either don't have 1 parent or don't have 1 child.
6397#
6398# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6399# arcout(id) - outgoing arcs for BMP
6400# arcids(a) - list of IDs on arc including end but not start
6401# arcstart(a) - BMP ID at start of arc
6402# arcend(a) - BMP ID at end of arc
6403# growing(a) - arc a is still growing
6404# arctags(a) - IDs out of arcids (excluding end) that have tags
6405# archeads(a) - IDs out of arcids (excluding end) that have heads
6406# The start of an arc is at the descendent end, so "incoming" means
6407# coming from descendents, and "outgoing" means going towards ancestors.
6408
6409proc getallclines {fd} {
6410    global allids allparents allchildren idtags idheads nextarc nbmp
6411    global arcnos arcids arctags arcout arcend arcstart archeads growing
6412    global seeds allcommits
6413
6414    set nid 0
6415    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6416        set id [lindex $line 0]
6417        if {[info exists allparents($id)]} {
6418            # seen it already
6419            continue
6420        }
6421        lappend allids $id
6422        set olds [lrange $line 1 end]
6423        set allparents($id) $olds
6424        if {![info exists allchildren($id)]} {
6425            set allchildren($id) {}
6426            set arcnos($id) {}
6427            lappend seeds $id
6428        } else {
6429            set a $arcnos($id)
6430            if {[llength $olds] == 1 && [llength $a] == 1} {
6431                lappend arcids($a) $id
6432                if {[info exists idtags($id)]} {
6433                    lappend arctags($a) $id
6434                }
6435                if {[info exists idheads($id)]} {
6436                    lappend archeads($a) $id
6437                }
6438                if {[info exists allparents($olds)]} {
6439                    # seen parent already
6440                    if {![info exists arcout($olds)]} {
6441                        splitarc $olds
6442                    }
6443                    lappend arcids($a) $olds
6444                    set arcend($a) $olds
6445                    unset growing($a)
6446                }
6447                lappend allchildren($olds) $id
6448                lappend arcnos($olds) $a
6449                continue
6450            }
6451        }
6452        incr nbmp
6453        foreach a $arcnos($id) {
6454            lappend arcids($a) $id
6455            set arcend($a) $id
6456            unset growing($a)
6457        }
6458
6459        set ao {}
6460        foreach p $olds {
6461            lappend allchildren($p) $id
6462            set a [incr nextarc]
6463            set arcstart($a) $id
6464            set archeads($a) {}
6465            set arctags($a) {}
6466            set archeads($a) {}
6467            set arcids($a) {}
6468            lappend ao $a
6469            set growing($a) 1
6470            if {[info exists allparents($p)]} {
6471                # seen it already, may need to make a new branch
6472                if {![info exists arcout($p)]} {
6473                    splitarc $p
6474                }
6475                lappend arcids($a) $p
6476                set arcend($a) $p
6477                unset growing($a)
6478            }
6479            lappend arcnos($p) $a
6480        }
6481        set arcout($id) $ao
6482    }
6483    if {$nid > 0} {
6484        global cached_dheads cached_dtags cached_atags
6485        catch {unset cached_dheads}
6486        catch {unset cached_dtags}
6487        catch {unset cached_atags}
6488    }
6489    if {![eof $fd]} {
6490        return [expr {$nid >= 1000? 2: 1}]
6491    }
6492    close $fd
6493    if {[incr allcommits -1] == 0} {
6494        notbusy allcommits
6495    }
6496    dispneartags 0
6497    return 0
6498}
6499
6500proc recalcarc {a} {
6501    global arctags archeads arcids idtags idheads
6502
6503    set at {}
6504    set ah {}
6505    foreach id [lrange $arcids($a) 0 end-1] {
6506        if {[info exists idtags($id)]} {
6507            lappend at $id
6508        }
6509        if {[info exists idheads($id)]} {
6510            lappend ah $id
6511        }
6512    }
6513    set arctags($a) $at
6514    set archeads($a) $ah
6515}
6516
6517proc splitarc {p} {
6518    global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6519    global arcstart arcend arcout allparents growing
6520
6521    set a $arcnos($p)
6522    if {[llength $a] != 1} {
6523        puts "oops splitarc called but [llength $a] arcs already"
6524        return
6525    }
6526    set a [lindex $a 0]
6527    set i [lsearch -exact $arcids($a) $p]
6528    if {$i < 0} {
6529        puts "oops splitarc $p not in arc $a"
6530        return
6531    }
6532    set na [incr nextarc]
6533    if {[info exists arcend($a)]} {
6534        set arcend($na) $arcend($a)
6535    } else {
6536        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6537        set j [lsearch -exact $arcnos($l) $a]
6538        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6539    }
6540    set tail [lrange $arcids($a) [expr {$i+1}] end]
6541    set arcids($a) [lrange $arcids($a) 0 $i]
6542    set arcend($a) $p
6543    set arcstart($na) $p
6544    set arcout($p) $na
6545    set arcids($na) $tail
6546    if {[info exists growing($a)]} {
6547        set growing($na) 1
6548        unset growing($a)
6549    }
6550    incr nbmp
6551
6552    foreach id $tail {
6553        if {[llength $arcnos($id)] == 1} {
6554            set arcnos($id) $na
6555        } else {
6556            set j [lsearch -exact $arcnos($id) $a]
6557            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6558        }
6559    }
6560
6561    # reconstruct tags and heads lists
6562    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6563        recalcarc $a
6564        recalcarc $na
6565    } else {
6566        set arctags($na) {}
6567        set archeads($na) {}
6568    }
6569}
6570
6571# Update things for a new commit added that is a child of one
6572# existing commit.  Used when cherry-picking.
6573proc addnewchild {id p} {
6574    global allids allparents allchildren idtags nextarc nbmp
6575    global arcnos arcids arctags arcout arcend arcstart archeads growing
6576    global seeds
6577
6578    lappend allids $id
6579    set allparents($id) [list $p]
6580    set allchildren($id) {}
6581    set arcnos($id) {}
6582    lappend seeds $id
6583    incr nbmp
6584    lappend allchildren($p) $id
6585    set a [incr nextarc]
6586    set arcstart($a) $id
6587    set archeads($a) {}
6588    set arctags($a) {}
6589    set arcids($a) [list $p]
6590    set arcend($a) $p
6591    if {![info exists arcout($p)]} {
6592        splitarc $p
6593    }
6594    lappend arcnos($p) $a
6595    set arcout($id) [list $a]
6596}
6597
6598# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6599# or 0 if neither is true.
6600proc anc_or_desc {a b} {
6601    global arcout arcstart arcend arcnos cached_isanc
6602
6603    if {$arcnos($a) eq $arcnos($b)} {
6604        # Both are on the same arc(s); either both are the same BMP,
6605        # or if one is not a BMP, the other is also not a BMP or is
6606        # the BMP at end of the arc (and it only has 1 incoming arc).
6607        # Or both can be BMPs with no incoming arcs.
6608        if {$a eq $b || $arcnos($a) eq {}} {
6609            return 0
6610        }
6611        # assert {[llength $arcnos($a)] == 1}
6612        set arc [lindex $arcnos($a) 0]
6613        set i [lsearch -exact $arcids($arc) $a]
6614        set j [lsearch -exact $arcids($arc) $b]
6615        if {$i < 0 || $i > $j} {
6616            return 1
6617        } else {
6618            return -1
6619        }
6620    }
6621
6622    if {![info exists arcout($a)]} {
6623        set arc [lindex $arcnos($a) 0]
6624        if {[info exists arcend($arc)]} {
6625            set aend $arcend($arc)
6626        } else {
6627            set aend {}
6628        }
6629        set a $arcstart($arc)
6630    } else {
6631        set aend $a
6632    }
6633    if {![info exists arcout($b)]} {
6634        set arc [lindex $arcnos($b) 0]
6635        if {[info exists arcend($arc)]} {
6636            set bend $arcend($arc)
6637        } else {
6638            set bend {}
6639        }
6640        set b $arcstart($arc)
6641    } else {
6642        set bend $b
6643    }
6644    if {$a eq $bend} {
6645        return 1
6646    }
6647    if {$b eq $aend} {
6648        return -1
6649    }
6650    if {[info exists cached_isanc($a,$bend)]} {
6651        if {$cached_isanc($a,$bend)} {
6652            return 1
6653        }
6654    }
6655    if {[info exists cached_isanc($b,$aend)]} {
6656        if {$cached_isanc($b,$aend)} {
6657            return -1
6658        }
6659        if {[info exists cached_isanc($a,$bend)]} {
6660            return 0
6661        }
6662    }
6663
6664    set todo [list $a $b]
6665    set anc($a) a
6666    set anc($b) b
6667    for {set i 0} {$i < [llength $todo]} {incr i} {
6668        set x [lindex $todo $i]
6669        if {$anc($x) eq {}} {
6670            continue
6671        }
6672        foreach arc $arcnos($x) {
6673            set xd $arcstart($arc)
6674            if {$xd eq $bend} {
6675                set cached_isanc($a,$bend) 1
6676                set cached_isanc($b,$aend) 0
6677                return 1
6678            } elseif {$xd eq $aend} {
6679                set cached_isanc($b,$aend) 1
6680                set cached_isanc($a,$bend) 0
6681                return -1
6682            }
6683            if {![info exists anc($xd)]} {
6684                set anc($xd) $anc($x)
6685                lappend todo $xd
6686            } elseif {$anc($xd) ne $anc($x)} {
6687                set anc($xd) {}
6688            }
6689        }
6690    }
6691    set cached_isanc($a,$bend) 0
6692    set cached_isanc($b,$aend) 0
6693    return 0
6694}
6695
6696# This identifies whether $desc has an ancestor that is
6697# a growing tip of the graph and which is not an ancestor of $anc
6698# and returns 0 if so and 1 if not.
6699# If we subsequently discover a tag on such a growing tip, and that
6700# turns out to be a descendent of $anc (which it could, since we
6701# don't necessarily see children before parents), then $desc
6702# isn't a good choice to display as a descendent tag of
6703# $anc (since it is the descendent of another tag which is
6704# a descendent of $anc).  Similarly, $anc isn't a good choice to
6705# display as a ancestor tag of $desc.
6706#
6707proc is_certain {desc anc} {
6708    global arcnos arcout arcstart arcend growing problems
6709
6710    set certain {}
6711    if {[llength $arcnos($anc)] == 1} {
6712        # tags on the same arc are certain
6713        if {$arcnos($desc) eq $arcnos($anc)} {
6714            return 1
6715        }
6716        if {![info exists arcout($anc)]} {
6717            # if $anc is partway along an arc, use the start of the arc instead
6718            set a [lindex $arcnos($anc) 0]
6719            set anc $arcstart($a)
6720        }
6721    }
6722    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6723        set x $desc
6724    } else {
6725        set a [lindex $arcnos($desc) 0]
6726        set x $arcend($a)
6727    }
6728    if {$x == $anc} {
6729        return 1
6730    }
6731    set anclist [list $x]
6732    set dl($x) 1
6733    set nnh 1
6734    set ngrowanc 0
6735    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6736        set x [lindex $anclist $i]
6737        if {$dl($x)} {
6738            incr nnh -1
6739        }
6740        set done($x) 1
6741        foreach a $arcout($x) {
6742            if {[info exists growing($a)]} {
6743                if {![info exists growanc($x)] && $dl($x)} {
6744                    set growanc($x) 1
6745                    incr ngrowanc
6746                }
6747            } else {
6748                set y $arcend($a)
6749                if {[info exists dl($y)]} {
6750                    if {$dl($y)} {
6751                        if {!$dl($x)} {
6752                            set dl($y) 0
6753                            if {![info exists done($y)]} {
6754                                incr nnh -1
6755                            }
6756                            if {[info exists growanc($x)]} {
6757                                incr ngrowanc -1
6758                            }
6759                            set xl [list $y]
6760                            for {set k 0} {$k < [llength $xl]} {incr k} {
6761                                set z [lindex $xl $k]
6762                                foreach c $arcout($z) {
6763                                    if {[info exists arcend($c)]} {
6764                                        set v $arcend($c)
6765                                        if {[info exists dl($v)] && $dl($v)} {
6766                                            set dl($v) 0
6767                                            if {![info exists done($v)]} {
6768                                                incr nnh -1
6769                                            }
6770                                            if {[info exists growanc($v)]} {
6771                                                incr ngrowanc -1
6772                                            }
6773                                            lappend xl $v
6774                                        }
6775                                    }
6776                                }
6777                            }
6778                        }
6779                    }
6780                } elseif {$y eq $anc || !$dl($x)} {
6781                    set dl($y) 0
6782                    lappend anclist $y
6783                } else {
6784                    set dl($y) 1
6785                    lappend anclist $y
6786                    incr nnh
6787                }
6788            }
6789        }
6790    }
6791    foreach x [array names growanc] {
6792        if {$dl($x)} {
6793            return 0
6794        }
6795        return 0
6796    }
6797    return 1
6798}
6799
6800proc validate_arctags {a} {
6801    global arctags idtags
6802
6803    set i -1
6804    set na $arctags($a)
6805    foreach id $arctags($a) {
6806        incr i
6807        if {![info exists idtags($id)]} {
6808            set na [lreplace $na $i $i]
6809            incr i -1
6810        }
6811    }
6812    set arctags($a) $na
6813}
6814
6815proc validate_archeads {a} {
6816    global archeads idheads
6817
6818    set i -1
6819    set na $archeads($a)
6820    foreach id $archeads($a) {
6821        incr i
6822        if {![info exists idheads($id)]} {
6823            set na [lreplace $na $i $i]
6824            incr i -1
6825        }
6826    }
6827    set archeads($a) $na
6828}
6829
6830# Return the list of IDs that have tags that are descendents of id,
6831# ignoring IDs that are descendents of IDs already reported.
6832proc desctags {id} {
6833    global arcnos arcstart arcids arctags idtags allparents
6834    global growing cached_dtags
6835
6836    if {![info exists allparents($id)]} {
6837        return {}
6838    }
6839    set t1 [clock clicks -milliseconds]
6840    set argid $id
6841    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6842        # part-way along an arc; check that arc first
6843        set a [lindex $arcnos($id) 0]
6844        if {$arctags($a) ne {}} {
6845            validate_arctags $a
6846            set i [lsearch -exact $arcids($a) $id]
6847            set tid {}
6848            foreach t $arctags($a) {
6849                set j [lsearch -exact $arcids($a) $t]
6850                if {$j >= $i} break
6851                set tid $t
6852            }
6853            if {$tid ne {}} {
6854                return $tid
6855            }
6856        }
6857        set id $arcstart($a)
6858        if {[info exists idtags($id)]} {
6859            return $id
6860        }
6861    }
6862    if {[info exists cached_dtags($id)]} {
6863        return $cached_dtags($id)
6864    }
6865
6866    set origid $id
6867    set todo [list $id]
6868    set queued($id) 1
6869    set nc 1
6870    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6871        set id [lindex $todo $i]
6872        set done($id) 1
6873        set ta [info exists hastaggedancestor($id)]
6874        if {!$ta} {
6875            incr nc -1
6876        }
6877        # ignore tags on starting node
6878        if {!$ta && $i > 0} {
6879            if {[info exists idtags($id)]} {
6880                set tagloc($id) $id
6881                set ta 1
6882            } elseif {[info exists cached_dtags($id)]} {
6883                set tagloc($id) $cached_dtags($id)
6884                set ta 1
6885            }
6886        }
6887        foreach a $arcnos($id) {
6888            set d $arcstart($a)
6889            if {!$ta && $arctags($a) ne {}} {
6890                validate_arctags $a
6891                if {$arctags($a) ne {}} {
6892                    lappend tagloc($id) [lindex $arctags($a) end]
6893                }
6894            }
6895            if {$ta || $arctags($a) ne {}} {
6896                set tomark [list $d]
6897                for {set j 0} {$j < [llength $tomark]} {incr j} {
6898                    set dd [lindex $tomark $j]
6899                    if {![info exists hastaggedancestor($dd)]} {
6900                        if {[info exists done($dd)]} {
6901                            foreach b $arcnos($dd) {
6902                                lappend tomark $arcstart($b)
6903                            }
6904                            if {[info exists tagloc($dd)]} {
6905                                unset tagloc($dd)
6906                            }
6907                        } elseif {[info exists queued($dd)]} {
6908                            incr nc -1
6909                        }
6910                        set hastaggedancestor($dd) 1
6911                    }
6912                }
6913            }
6914            if {![info exists queued($d)]} {
6915                lappend todo $d
6916                set queued($d) 1
6917                if {![info exists hastaggedancestor($d)]} {
6918                    incr nc
6919                }
6920            }
6921        }
6922    }
6923    set tags {}
6924    foreach id [array names tagloc] {
6925        if {![info exists hastaggedancestor($id)]} {
6926            foreach t $tagloc($id) {
6927                if {[lsearch -exact $tags $t] < 0} {
6928                    lappend tags $t
6929                }
6930            }
6931        }
6932    }
6933    set t2 [clock clicks -milliseconds]
6934    set loopix $i
6935
6936    # remove tags that are descendents of other tags
6937    for {set i 0} {$i < [llength $tags]} {incr i} {
6938        set a [lindex $tags $i]
6939        for {set j 0} {$j < $i} {incr j} {
6940            set b [lindex $tags $j]
6941            set r [anc_or_desc $a $b]
6942            if {$r == 1} {
6943                set tags [lreplace $tags $j $j]
6944                incr j -1
6945                incr i -1
6946            } elseif {$r == -1} {
6947                set tags [lreplace $tags $i $i]
6948                incr i -1
6949                break
6950            }
6951        }
6952    }
6953
6954    if {[array names growing] ne {}} {
6955        # graph isn't finished, need to check if any tag could get
6956        # eclipsed by another tag coming later.  Simply ignore any
6957        # tags that could later get eclipsed.
6958        set ctags {}
6959        foreach t $tags {
6960            if {[is_certain $t $origid]} {
6961                lappend ctags $t
6962            }
6963        }
6964        if {$tags eq $ctags} {
6965            set cached_dtags($origid) $tags
6966        } else {
6967            set tags $ctags
6968        }
6969    } else {
6970        set cached_dtags($origid) $tags
6971    }
6972    set t3 [clock clicks -milliseconds]
6973    if {0 && $t3 - $t1 >= 100} {
6974        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6975            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6976    }
6977    return $tags
6978}
6979
6980proc anctags {id} {
6981    global arcnos arcids arcout arcend arctags idtags allparents
6982    global growing cached_atags
6983
6984    if {![info exists allparents($id)]} {
6985        return {}
6986    }
6987    set t1 [clock clicks -milliseconds]
6988    set argid $id
6989    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6990        # part-way along an arc; check that arc first
6991        set a [lindex $arcnos($id) 0]
6992        if {$arctags($a) ne {}} {
6993            validate_arctags $a
6994            set i [lsearch -exact $arcids($a) $id]
6995            foreach t $arctags($a) {
6996                set j [lsearch -exact $arcids($a) $t]
6997                if {$j > $i} {
6998                    return $t
6999                }
7000            }
7001        }
7002        if {![info exists arcend($a)]} {
7003            return {}
7004        }
7005        set id $arcend($a)
7006        if {[info exists idtags($id)]} {
7007            return $id
7008        }
7009    }
7010    if {[info exists cached_atags($id)]} {
7011        return $cached_atags($id)
7012    }
7013
7014    set origid $id
7015    set todo [list $id]
7016    set queued($id) 1
7017    set taglist {}
7018    set nc 1
7019    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7020        set id [lindex $todo $i]
7021        set done($id) 1
7022        set td [info exists hastaggeddescendent($id)]
7023        if {!$td} {
7024            incr nc -1
7025        }
7026        # ignore tags on starting node
7027        if {!$td && $i > 0} {
7028            if {[info exists idtags($id)]} {
7029                set tagloc($id) $id
7030                set td 1
7031            } elseif {[info exists cached_atags($id)]} {
7032                set tagloc($id) $cached_atags($id)
7033                set td 1
7034            }
7035        }
7036        foreach a $arcout($id) {
7037            if {!$td && $arctags($a) ne {}} {
7038                validate_arctags $a
7039                if {$arctags($a) ne {}} {
7040                    lappend tagloc($id) [lindex $arctags($a) 0]
7041                }
7042            }
7043            if {![info exists arcend($a)]} continue
7044            set d $arcend($a)
7045            if {$td || $arctags($a) ne {}} {
7046                set tomark [list $d]
7047                for {set j 0} {$j < [llength $tomark]} {incr j} {
7048                    set dd [lindex $tomark $j]
7049                    if {![info exists hastaggeddescendent($dd)]} {
7050                        if {[info exists done($dd)]} {
7051                            foreach b $arcout($dd) {
7052                                if {[info exists arcend($b)]} {
7053                                    lappend tomark $arcend($b)
7054                                }
7055                            }
7056                            if {[info exists tagloc($dd)]} {
7057                                unset tagloc($dd)
7058                            }
7059                        } elseif {[info exists queued($dd)]} {
7060                            incr nc -1
7061                        }
7062                        set hastaggeddescendent($dd) 1
7063                    }
7064                }
7065            }
7066            if {![info exists queued($d)]} {
7067                lappend todo $d
7068                set queued($d) 1
7069                if {![info exists hastaggeddescendent($d)]} {
7070                    incr nc
7071                }
7072            }
7073        }
7074    }
7075    set t2 [clock clicks -milliseconds]
7076    set loopix $i
7077    set tags {}
7078    foreach id [array names tagloc] {
7079        if {![info exists hastaggeddescendent($id)]} {
7080            foreach t $tagloc($id) {
7081                if {[lsearch -exact $tags $t] < 0} {
7082                    lappend tags $t
7083                }
7084            }
7085        }
7086    }
7087
7088    # remove tags that are ancestors of other tags
7089    for {set i 0} {$i < [llength $tags]} {incr i} {
7090        set a [lindex $tags $i]
7091        for {set j 0} {$j < $i} {incr j} {
7092            set b [lindex $tags $j]
7093            set r [anc_or_desc $a $b]
7094            if {$r == -1} {
7095                set tags [lreplace $tags $j $j]
7096                incr j -1
7097                incr i -1
7098            } elseif {$r == 1} {
7099                set tags [lreplace $tags $i $i]
7100                incr i -1
7101                break
7102            }
7103        }
7104    }
7105
7106    if {[array names growing] ne {}} {
7107        # graph isn't finished, need to check if any tag could get
7108        # eclipsed by another tag coming later.  Simply ignore any
7109        # tags that could later get eclipsed.
7110        set ctags {}
7111        foreach t $tags {
7112            if {[is_certain $origid $t]} {
7113                lappend ctags $t
7114            }
7115        }
7116        if {$tags eq $ctags} {
7117            set cached_atags($origid) $tags
7118        } else {
7119            set tags $ctags
7120        }
7121    } else {
7122        set cached_atags($origid) $tags
7123    }
7124    set t3 [clock clicks -milliseconds]
7125    if {0 && $t3 - $t1 >= 100} {
7126        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7127            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7128    }
7129    return $tags
7130}
7131
7132# Return the list of IDs that have heads that are descendents of id,
7133# including id itself if it has a head.
7134proc descheads {id} {
7135    global arcnos arcstart arcids archeads idheads cached_dheads
7136    global allparents
7137
7138    if {![info exists allparents($id)]} {
7139        return {}
7140    }
7141    set aret {}
7142    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7143        # part-way along an arc; check it first
7144        set a [lindex $arcnos($id) 0]
7145        if {$archeads($a) ne {}} {
7146            validate_archeads $a
7147            set i [lsearch -exact $arcids($a) $id]
7148            foreach t $archeads($a) {
7149                set j [lsearch -exact $arcids($a) $t]
7150                if {$j > $i} break
7151                lappend aret $t
7152            }
7153        }
7154        set id $arcstart($a)
7155    }
7156    set origid $id
7157    set todo [list $id]
7158    set seen($id) 1
7159    set ret {}
7160    for {set i 0} {$i < [llength $todo]} {incr i} {
7161        set id [lindex $todo $i]
7162        if {[info exists cached_dheads($id)]} {
7163            set ret [concat $ret $cached_dheads($id)]
7164        } else {
7165            if {[info exists idheads($id)]} {
7166                lappend ret $id
7167            }
7168            foreach a $arcnos($id) {
7169                if {$archeads($a) ne {}} {
7170                    validate_archeads $a
7171                    if {$archeads($a) ne {}} {
7172                        set ret [concat $ret $archeads($a)]
7173                    }
7174                }
7175                set d $arcstart($a)
7176                if {![info exists seen($d)]} {
7177                    lappend todo $d
7178                    set seen($d) 1
7179                }
7180            }
7181        }
7182    }
7183    set ret [lsort -unique $ret]
7184    set cached_dheads($origid) $ret
7185    return [concat $ret $aret]
7186}
7187
7188proc addedtag {id} {
7189    global arcnos arcout cached_dtags cached_atags
7190
7191    if {![info exists arcnos($id)]} return
7192    if {![info exists arcout($id)]} {
7193        recalcarc [lindex $arcnos($id) 0]
7194    }
7195    catch {unset cached_dtags}
7196    catch {unset cached_atags}
7197}
7198
7199proc addedhead {hid head} {
7200    global arcnos arcout cached_dheads
7201
7202    if {![info exists arcnos($hid)]} return
7203    if {![info exists arcout($hid)]} {
7204        recalcarc [lindex $arcnos($hid) 0]
7205    }
7206    catch {unset cached_dheads}
7207}
7208
7209proc removedhead {hid head} {
7210    global cached_dheads
7211
7212    catch {unset cached_dheads}
7213}
7214
7215proc movedhead {hid head} {
7216    global arcnos arcout cached_dheads
7217
7218    if {![info exists arcnos($hid)]} return
7219    if {![info exists arcout($hid)]} {
7220        recalcarc [lindex $arcnos($hid) 0]
7221    }
7222    catch {unset cached_dheads}
7223}
7224
7225proc changedrefs {} {
7226    global cached_dheads cached_dtags cached_atags
7227    global arctags archeads arcnos arcout idheads idtags
7228
7229    foreach id [concat [array names idheads] [array names idtags]] {
7230        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7231            set a [lindex $arcnos($id) 0]
7232            if {![info exists donearc($a)]} {
7233                recalcarc $a
7234                set donearc($a) 1
7235            }
7236        }
7237    }
7238    catch {unset cached_dtags}
7239    catch {unset cached_atags}
7240    catch {unset cached_dheads}
7241}
7242
7243proc rereadrefs {} {
7244    global idtags idheads idotherrefs mainhead
7245
7246    set refids [concat [array names idtags] \
7247                    [array names idheads] [array names idotherrefs]]
7248    foreach id $refids {
7249        if {![info exists ref($id)]} {
7250            set ref($id) [listrefs $id]
7251        }
7252    }
7253    set oldmainhead $mainhead
7254    readrefs
7255    changedrefs
7256    set refids [lsort -unique [concat $refids [array names idtags] \
7257                        [array names idheads] [array names idotherrefs]]]
7258    foreach id $refids {
7259        set v [listrefs $id]
7260        if {![info exists ref($id)] || $ref($id) != $v ||
7261            ($id eq $oldmainhead && $id ne $mainhead) ||
7262            ($id eq $mainhead && $id ne $oldmainhead)} {
7263            redrawtags $id
7264        }
7265    }
7266    run refill_reflist
7267}
7268
7269proc listrefs {id} {
7270    global idtags idheads idotherrefs
7271
7272    set x {}
7273    if {[info exists idtags($id)]} {
7274        set x $idtags($id)
7275    }
7276    set y {}
7277    if {[info exists idheads($id)]} {
7278        set y $idheads($id)
7279    }
7280    set z {}
7281    if {[info exists idotherrefs($id)]} {
7282        set z $idotherrefs($id)
7283    }
7284    return [list $x $y $z]
7285}
7286
7287proc showtag {tag isnew} {
7288    global ctext tagcontents tagids linknum tagobjid
7289
7290    if {$isnew} {
7291        addtohistory [list showtag $tag 0]
7292    }
7293    $ctext conf -state normal
7294    clear_ctext
7295    set linknum 0
7296    if {![info exists tagcontents($tag)]} {
7297        catch {
7298            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7299        }
7300    }
7301    if {[info exists tagcontents($tag)]} {
7302        set text $tagcontents($tag)
7303    } else {
7304        set text "Tag: $tag\nId:  $tagids($tag)"
7305    }
7306    appendwithlinks $text {}
7307    $ctext conf -state disabled
7308    init_flist {}
7309}
7310
7311proc doquit {} {
7312    global stopped
7313    set stopped 100
7314    savestuff .
7315    destroy .
7316}
7317
7318proc doprefs {} {
7319    global maxwidth maxgraphpct diffopts
7320    global oldprefs prefstop showneartags showlocalchanges
7321    global bgcolor fgcolor ctext diffcolors selectbgcolor
7322    global uifont tabstop
7323
7324    set top .gitkprefs
7325    set prefstop $top
7326    if {[winfo exists $top]} {
7327        raise $top
7328        return
7329    }
7330    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7331        set oldprefs($v) [set $v]
7332    }
7333    toplevel $top
7334    wm title $top "Gitk preferences"
7335    label $top.ldisp -text "Commit list display options"
7336    $top.ldisp configure -font $uifont
7337    grid $top.ldisp - -sticky w -pady 10
7338    label $top.spacer -text " "
7339    label $top.maxwidthl -text "Maximum graph width (lines)" \
7340        -font optionfont
7341    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7342    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7343    label $top.maxpctl -text "Maximum graph width (% of pane)" \
7344        -font optionfont
7345    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7346    grid x $top.maxpctl $top.maxpct -sticky w
7347    frame $top.showlocal
7348    label $top.showlocal.l -text "Show local changes" -font optionfont
7349    checkbutton $top.showlocal.b -variable showlocalchanges
7350    pack $top.showlocal.b $top.showlocal.l -side left
7351    grid x $top.showlocal -sticky w
7352
7353    label $top.ddisp -text "Diff display options"
7354    $top.ddisp configure -font $uifont
7355    grid $top.ddisp - -sticky w -pady 10
7356    label $top.diffoptl -text "Options for diff program" \
7357        -font optionfont
7358    entry $top.diffopt -width 20 -textvariable diffopts
7359    grid x $top.diffoptl $top.diffopt -sticky w
7360    frame $top.ntag
7361    label $top.ntag.l -text "Display nearby tags" -font optionfont
7362    checkbutton $top.ntag.b -variable showneartags
7363    pack $top.ntag.b $top.ntag.l -side left
7364    grid x $top.ntag -sticky w
7365    label $top.tabstopl -text "tabstop" -font optionfont
7366    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7367    grid x $top.tabstopl $top.tabstop -sticky w
7368
7369    label $top.cdisp -text "Colors: press to choose"
7370    $top.cdisp configure -font $uifont
7371    grid $top.cdisp - -sticky w -pady 10
7372    label $top.bg -padx 40 -relief sunk -background $bgcolor
7373    button $top.bgbut -text "Background" -font optionfont \
7374        -command [list choosecolor bgcolor 0 $top.bg background setbg]
7375    grid x $top.bgbut $top.bg -sticky w
7376    label $top.fg -padx 40 -relief sunk -background $fgcolor
7377    button $top.fgbut -text "Foreground" -font optionfont \
7378        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7379    grid x $top.fgbut $top.fg -sticky w
7380    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7381    button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7382        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7383                      [list $ctext tag conf d0 -foreground]]
7384    grid x $top.diffoldbut $top.diffold -sticky w
7385    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7386    button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7387        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7388                      [list $ctext tag conf d1 -foreground]]
7389    grid x $top.diffnewbut $top.diffnew -sticky w
7390    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7391    button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7392        -command [list choosecolor diffcolors 2 $top.hunksep \
7393                      "diff hunk header" \
7394                      [list $ctext tag conf hunksep -foreground]]
7395    grid x $top.hunksepbut $top.hunksep -sticky w
7396    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7397    button $top.selbgbut -text "Select bg" -font optionfont \
7398        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7399    grid x $top.selbgbut $top.selbgsep -sticky w
7400
7401    frame $top.buts
7402    button $top.buts.ok -text "OK" -command prefsok -default active
7403    $top.buts.ok configure -font $uifont
7404    button $top.buts.can -text "Cancel" -command prefscan -default normal
7405    $top.buts.can configure -font $uifont
7406    grid $top.buts.ok $top.buts.can
7407    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7408    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7409    grid $top.buts - - -pady 10 -sticky ew
7410    bind $top <Visibility> "focus $top.buts.ok"
7411}
7412
7413proc choosecolor {v vi w x cmd} {
7414    global $v
7415
7416    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7417               -title "Gitk: choose color for $x"]
7418    if {$c eq {}} return
7419    $w conf -background $c
7420    lset $v $vi $c
7421    eval $cmd $c
7422}
7423
7424proc setselbg {c} {
7425    global bglist cflist
7426    foreach w $bglist {
7427        $w configure -selectbackground $c
7428    }
7429    $cflist tag configure highlight \
7430        -background [$cflist cget -selectbackground]
7431    allcanvs itemconf secsel -fill $c
7432}
7433
7434proc setbg {c} {
7435    global bglist
7436
7437    foreach w $bglist {
7438        $w conf -background $c
7439    }
7440}
7441
7442proc setfg {c} {
7443    global fglist canv
7444
7445    foreach w $fglist {
7446        $w conf -foreground $c
7447    }
7448    allcanvs itemconf text -fill $c
7449    $canv itemconf circle -outline $c
7450}
7451
7452proc prefscan {} {
7453    global maxwidth maxgraphpct diffopts
7454    global oldprefs prefstop showneartags showlocalchanges
7455
7456    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7457        set $v $oldprefs($v)
7458    }
7459    catch {destroy $prefstop}
7460    unset prefstop
7461}
7462
7463proc prefsok {} {
7464    global maxwidth maxgraphpct
7465    global oldprefs prefstop showneartags showlocalchanges
7466    global charspc ctext tabstop
7467
7468    catch {destroy $prefstop}
7469    unset prefstop
7470    $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7471    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7472        if {$showlocalchanges} {
7473            doshowlocalchanges
7474        } else {
7475            dohidelocalchanges
7476        }
7477    }
7478    if {$maxwidth != $oldprefs(maxwidth)
7479        || $maxgraphpct != $oldprefs(maxgraphpct)} {
7480        redisplay
7481    } elseif {$showneartags != $oldprefs(showneartags)} {
7482        reselectline
7483    }
7484}
7485
7486proc formatdate {d} {
7487    global datetimeformat
7488    if {$d ne {}} {
7489        set d [clock format $d -format $datetimeformat]
7490    }
7491    return $d
7492}
7493
7494# This list of encoding names and aliases is distilled from
7495# http://www.iana.org/assignments/character-sets.
7496# Not all of them are supported by Tcl.
7497set encoding_aliases {
7498    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7499      ISO646-US US-ASCII us IBM367 cp367 csASCII }
7500    { ISO-10646-UTF-1 csISO10646UTF1 }
7501    { ISO_646.basic:1983 ref csISO646basic1983 }
7502    { INVARIANT csINVARIANT }
7503    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7504    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7505    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7506    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7507    { NATS-DANO iso-ir-9-1 csNATSDANO }
7508    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7509    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7510    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7511    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7512    { ISO-2022-KR csISO2022KR }
7513    { EUC-KR csEUCKR }
7514    { ISO-2022-JP csISO2022JP }
7515    { ISO-2022-JP-2 csISO2022JP2 }
7516    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7517      csISO13JISC6220jp }
7518    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7519    { IT iso-ir-15 ISO646-IT csISO15Italian }
7520    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7521    { ES iso-ir-17 ISO646-ES csISO17Spanish }
7522    { greek7-old iso-ir-18 csISO18Greek7Old }
7523    { latin-greek iso-ir-19 csISO19LatinGreek }
7524    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7525    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7526    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7527    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7528    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7529    { BS_viewdata iso-ir-47 csISO47BSViewdata }
7530    { INIS iso-ir-49 csISO49INIS }
7531    { INIS-8 iso-ir-50 csISO50INIS8 }
7532    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7533    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7534    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7535    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7536    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7537    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7538      csISO60Norwegian1 }
7539    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7540    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7541    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7542    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7543    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7544    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7545    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7546    { greek7 iso-ir-88 csISO88Greek7 }
7547    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7548    { iso-ir-90 csISO90 }
7549    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7550    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7551      csISO92JISC62991984b }
7552    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7553    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7554    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7555      csISO95JIS62291984handadd }
7556    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7557    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7558    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7559    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7560      CP819 csISOLatin1 }
7561    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7562    { T.61-7bit iso-ir-102 csISO102T617bit }
7563    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7564    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7565    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7566    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7567    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7568    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7569    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7570    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7571      arabic csISOLatinArabic }
7572    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7573    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7574    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7575      greek greek8 csISOLatinGreek }
7576    { T.101-G2 iso-ir-128 csISO128T101G2 }
7577    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7578      csISOLatinHebrew }
7579    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7580    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7581    { CSN_369103 iso-ir-139 csISO139CSN369103 }
7582    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7583    { ISO_6937-2-add iso-ir-142 csISOTextComm }
7584    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7585    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7586      csISOLatinCyrillic }
7587    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7588    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7589    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7590    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7591    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7592    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7593    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7594    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7595    { ISO_10367-box iso-ir-155 csISO10367Box }
7596    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7597    { latin-lap lap iso-ir-158 csISO158Lap }
7598    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7599    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7600    { us-dk csUSDK }
7601    { dk-us csDKUS }
7602    { JIS_X0201 X0201 csHalfWidthKatakana }
7603    { KSC5636 ISO646-KR csKSC5636 }
7604    { ISO-10646-UCS-2 csUnicode }
7605    { ISO-10646-UCS-4 csUCS4 }
7606    { DEC-MCS dec csDECMCS }
7607    { hp-roman8 roman8 r8 csHPRoman8 }
7608    { macintosh mac csMacintosh }
7609    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7610      csIBM037 }
7611    { IBM038 EBCDIC-INT cp038 csIBM038 }
7612    { IBM273 CP273 csIBM273 }
7613    { IBM274 EBCDIC-BE CP274 csIBM274 }
7614    { IBM275 EBCDIC-BR cp275 csIBM275 }
7615    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7616    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7617    { IBM280 CP280 ebcdic-cp-it csIBM280 }
7618    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7619    { IBM284 CP284 ebcdic-cp-es csIBM284 }
7620    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7621    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7622    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7623    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7624    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7625    { IBM424 cp424 ebcdic-cp-he csIBM424 }
7626    { IBM437 cp437 437 csPC8CodePage437 }
7627    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7628    { IBM775 cp775 csPC775Baltic }
7629    { IBM850 cp850 850 csPC850Multilingual }
7630    { IBM851 cp851 851 csIBM851 }
7631    { IBM852 cp852 852 csPCp852 }
7632    { IBM855 cp855 855 csIBM855 }
7633    { IBM857 cp857 857 csIBM857 }
7634    { IBM860 cp860 860 csIBM860 }
7635    { IBM861 cp861 861 cp-is csIBM861 }
7636    { IBM862 cp862 862 csPC862LatinHebrew }
7637    { IBM863 cp863 863 csIBM863 }
7638    { IBM864 cp864 csIBM864 }
7639    { IBM865 cp865 865 csIBM865 }
7640    { IBM866 cp866 866 csIBM866 }
7641    { IBM868 CP868 cp-ar csIBM868 }
7642    { IBM869 cp869 869 cp-gr csIBM869 }
7643    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7644    { IBM871 CP871 ebcdic-cp-is csIBM871 }
7645    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7646    { IBM891 cp891 csIBM891 }
7647    { IBM903 cp903 csIBM903 }
7648    { IBM904 cp904 904 csIBBM904 }
7649    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7650    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7651    { IBM1026 CP1026 csIBM1026 }
7652    { EBCDIC-AT-DE csIBMEBCDICATDE }
7653    { EBCDIC-AT-DE-A csEBCDICATDEA }
7654    { EBCDIC-CA-FR csEBCDICCAFR }
7655    { EBCDIC-DK-NO csEBCDICDKNO }
7656    { EBCDIC-DK-NO-A csEBCDICDKNOA }
7657    { EBCDIC-FI-SE csEBCDICFISE }
7658    { EBCDIC-FI-SE-A csEBCDICFISEA }
7659    { EBCDIC-FR csEBCDICFR }
7660    { EBCDIC-IT csEBCDICIT }
7661    { EBCDIC-PT csEBCDICPT }
7662    { EBCDIC-ES csEBCDICES }
7663    { EBCDIC-ES-A csEBCDICESA }
7664    { EBCDIC-ES-S csEBCDICESS }
7665    { EBCDIC-UK csEBCDICUK }
7666    { EBCDIC-US csEBCDICUS }
7667    { UNKNOWN-8BIT csUnknown8BiT }
7668    { MNEMONIC csMnemonic }
7669    { MNEM csMnem }
7670    { VISCII csVISCII }
7671    { VIQR csVIQR }
7672    { KOI8-R csKOI8R }
7673    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7674    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7675    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7676    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7677    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7678    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7679    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7680    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7681    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7682    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7683    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7684    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7685    { IBM1047 IBM-1047 }
7686    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7687    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7688    { UNICODE-1-1 csUnicode11 }
7689    { CESU-8 csCESU-8 }
7690    { BOCU-1 csBOCU-1 }
7691    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7692    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7693      l8 }
7694    { ISO-8859-15 ISO_8859-15 Latin-9 }
7695    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7696    { GBK CP936 MS936 windows-936 }
7697    { JIS_Encoding csJISEncoding }
7698    { Shift_JIS MS_Kanji csShiftJIS }
7699    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7700      EUC-JP }
7701    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7702    { ISO-10646-UCS-Basic csUnicodeASCII }
7703    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7704    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7705    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7706    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7707    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7708    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7709    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7710    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7711    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7712    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7713    { Adobe-Standard-Encoding csAdobeStandardEncoding }
7714    { Ventura-US csVenturaUS }
7715    { Ventura-International csVenturaInternational }
7716    { PC8-Danish-Norwegian csPC8DanishNorwegian }
7717    { PC8-Turkish csPC8Turkish }
7718    { IBM-Symbols csIBMSymbols }
7719    { IBM-Thai csIBMThai }
7720    { HP-Legal csHPLegal }
7721    { HP-Pi-font csHPPiFont }
7722    { HP-Math8 csHPMath8 }
7723    { Adobe-Symbol-Encoding csHPPSMath }
7724    { HP-DeskTop csHPDesktop }
7725    { Ventura-Math csVenturaMath }
7726    { Microsoft-Publishing csMicrosoftPublishing }
7727    { Windows-31J csWindows31J }
7728    { GB2312 csGB2312 }
7729    { Big5 csBig5 }
7730}
7731
7732proc tcl_encoding {enc} {
7733    global encoding_aliases
7734    set names [encoding names]
7735    set lcnames [string tolower $names]
7736    set enc [string tolower $enc]
7737    set i [lsearch -exact $lcnames $enc]
7738    if {$i < 0} {
7739        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7740        if {[regsub {^iso[-_]} $enc iso encx]} {
7741            set i [lsearch -exact $lcnames $encx]
7742        }
7743    }
7744    if {$i < 0} {
7745        foreach l $encoding_aliases {
7746            set ll [string tolower $l]
7747            if {[lsearch -exact $ll $enc] < 0} continue
7748            # look through the aliases for one that tcl knows about
7749            foreach e $ll {
7750                set i [lsearch -exact $lcnames $e]
7751                if {$i < 0} {
7752                    if {[regsub {^iso[-_]} $e iso ex]} {
7753                        set i [lsearch -exact $lcnames $ex]
7754                    }
7755                }
7756                if {$i >= 0} break
7757            }
7758            break
7759        }
7760    }
7761    if {$i >= 0} {
7762        return [lindex $names $i]
7763    }
7764    return {}
7765}
7766
7767# defaults...
7768set datemode 0
7769set diffopts "-U 5 -p"
7770set wrcomcmd "git diff-tree --stdin -p --pretty"
7771
7772set gitencoding {}
7773catch {
7774    set gitencoding [exec git config --get i18n.commitencoding]
7775}
7776if {$gitencoding == ""} {
7777    set gitencoding "utf-8"
7778}
7779set tclencoding [tcl_encoding $gitencoding]
7780if {$tclencoding == {}} {
7781    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7782}
7783
7784set mainfont {Helvetica 9}
7785set textfont {Courier 9}
7786set uifont {Helvetica 9 bold}
7787set tabstop 8
7788set findmergefiles 0
7789set maxgraphpct 50
7790set maxwidth 16
7791set revlistorder 0
7792set fastdate 0
7793set uparrowlen 5
7794set downarrowlen 5
7795set mingaplen 100
7796set cmitmode "patch"
7797set wrapcomment "none"
7798set showneartags 1
7799set maxrefs 20
7800set maxlinelen 200
7801set showlocalchanges 1
7802set datetimeformat "%Y-%m-%d %H:%M:%S"
7803
7804set colors {green red blue magenta darkgrey brown orange}
7805set bgcolor white
7806set fgcolor black
7807set diffcolors {red "#00a000" blue}
7808set diffcontext 3
7809set selectbgcolor gray85
7810
7811catch {source ~/.gitk}
7812
7813font create optionfont -family sans-serif -size -12
7814
7815# check that we can find a .git directory somewhere...
7816if {[catch {set gitdir [gitdir]}]} {
7817    show_error {} . "Cannot find a git repository here."
7818    exit 1
7819}
7820if {![file isdirectory $gitdir]} {
7821    show_error {} . "Cannot find the git directory \"$gitdir\"."
7822    exit 1
7823}
7824
7825set revtreeargs {}
7826set cmdline_files {}
7827set i 0
7828foreach arg $argv {
7829    switch -- $arg {
7830        "" { }
7831        "-d" { set datemode 1 }
7832        "--" {
7833            set cmdline_files [lrange $argv [expr {$i + 1}] end]
7834            break
7835        }
7836        default {
7837            lappend revtreeargs $arg
7838        }
7839    }
7840    incr i
7841}
7842
7843if {$i >= [llength $argv] && $revtreeargs ne {}} {
7844    # no -- on command line, but some arguments (other than -d)
7845    if {[catch {
7846        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7847        set cmdline_files [split $f "\n"]
7848        set n [llength $cmdline_files]
7849        set revtreeargs [lrange $revtreeargs 0 end-$n]
7850        # Unfortunately git rev-parse doesn't produce an error when
7851        # something is both a revision and a filename.  To be consistent
7852        # with git log and git rev-list, check revtreeargs for filenames.
7853        foreach arg $revtreeargs {
7854            if {[file exists $arg]} {
7855                show_error {} . "Ambiguous argument '$arg': both revision\
7856                                 and filename"
7857                exit 1
7858            }
7859        }
7860    } err]} {
7861        # unfortunately we get both stdout and stderr in $err,
7862        # so look for "fatal:".
7863        set i [string first "fatal:" $err]
7864        if {$i > 0} {
7865            set err [string range $err [expr {$i + 6}] end]
7866        }
7867        show_error {} . "Bad arguments to gitk:\n$err"
7868        exit 1
7869    }
7870}
7871
7872set nullid "0000000000000000000000000000000000000000"
7873set nullid2 "0000000000000000000000000000000000000001"
7874
7875
7876set runq {}
7877set history {}
7878set historyindex 0
7879set fh_serial 0
7880set nhl_names {}
7881set highlight_paths {}
7882set searchdirn -forwards
7883set boldrows {}
7884set boldnamerows {}
7885set diffelide {0 0}
7886set markingmatches 0
7887
7888set optim_delay 16
7889
7890set nextviewnum 1
7891set curview 0
7892set selectedview 0
7893set selectedhlview None
7894set viewfiles(0) {}
7895set viewperm(0) 0
7896set viewargs(0) {}
7897
7898set cmdlineok 0
7899set stopped 0
7900set stuffsaved 0
7901set patchnum 0
7902set lookingforhead 0
7903set localirow -1
7904set localfrow -1
7905set lserial 0
7906setcoords
7907makewindow
7908# wait for the window to become visible
7909tkwait visibility .
7910wm title . "[file tail $argv0]: [file tail [pwd]]"
7911readrefs
7912
7913if {$cmdline_files ne {} || $revtreeargs ne {}} {
7914    # create a view for the files/dirs specified on the command line
7915    set curview 1
7916    set selectedview 1
7917    set nextviewnum 2
7918    set viewname(1) "Command line"
7919    set viewfiles(1) $cmdline_files
7920    set viewargs(1) $revtreeargs
7921    set viewperm(1) 0
7922    addviewmenu 1
7923    .bar.view entryconf Edit* -state normal
7924    .bar.view entryconf Delete* -state normal
7925}
7926
7927if {[info exists permviews]} {
7928    foreach v $permviews {
7929        set n $nextviewnum
7930        incr nextviewnum
7931        set viewname($n) [lindex $v 0]
7932        set viewfiles($n) [lindex $v 1]
7933        set viewargs($n) [lindex $v 2]
7934        set viewperm($n) 1
7935        addviewmenu $n
7936    }
7937}
7938getcommits