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