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