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