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