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