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